source: to-imperative/trunk/java/refal/refal/plus/List.rf @ 3964

Last change on this file since 3964 was 3964, checked in by yura, 12 years ago
  • Library extentions (after hdd errors).
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.9 KB
Line 
1// $Id: List.rf 3964 2008-10-09 17:57:49Z yura $
2
3$use Apply Access Arithm Compare;
4
5$func Deparen_Term term = expr;
6Deparen_Term {
7  (expr) = expr;
8  term   = term;
9};
10
11$func Paren_Term term = (term);
12Paren_Term term = (term);
13
14Id e1 = e1;
15
16Append (e1) e2 = e2 e1;
17
18Zip (e.list1) (e.list2) =
19  (e.list1) (e.list2) /*empty*/ $iter {
20    e.list1 : t.first1 e.rest1,
21      e.list2 : t.first2 e.rest2 =
22      (e.rest1) (e.rest2) e.new_list (t.first1 t.first2);
23  } :: (e.list1) (e.list2) e.new_list,
24  e.list1 : /*empty*/ =
25  e.new_list;
26
27Map s.Fname e.Fargs (e.list) =
28  () e.list $iter {
29    e.list : t.item e.rest =
30      (e.new_list <Apply s.Fname e.Fargs t.item>) e.rest;
31  } :: (e.new_list) e.list,
32  e.list : /*empty*/ =
33  e.new_list;
34
35MapIn s.Fname e.Fargs (e.list) =
36  () e.list $iter {
37    e.list : (e.item) e.rest =
38      (e.new_list (<Apply s.Fname e.Fargs e.item>)) e.rest;
39  } :: (e.new_list) e.list,
40  e.list : /*empty*/ =
41  e.new_list;
42
43Filter s.Fname e.Fargs (e.list) =
44  () e.list $iter {
45    e.list : t.item e.rest, {
46      <Apply s.Fname e.Fargs t.item> : e =
47        (e.new_list t.item) e.rest;
48      (e.new_list) e.rest;
49    };
50  } :: (e.new_list) e.list,
51  e.list : /*empty*/ =
52  e.new_list;
53
54Split s.Fname e.Fargs (e.list) =
55  () () e.list $iter {
56    e.list : t.item e.rest, {
57      <Apply s.Fname e.Fargs t.item> : e =
58        (e.true_list t.item) (e.false_list) e.rest;
59      (e.true_list) (e.false_list t.item) e.rest;
60    };
61  } :: (e.true_list) (e.false_list) e.list,
62  e.list : /*empty*/ =
63  (e.true_list) (e.false_list);
64
65IsElem e.list t.item =
66  e.list : e t.item e;
67
68Foldr s.Fname e.Fargs (e.value) (e.list) =
69  (e.value) e.list $iter {
70    e.list : e.something t.last =
71      (<Apply s.Fname e.Fargs t.last e.value>) e.something;
72  } :: (e.value) e.list,
73  e.list : /*empty*/ =
74  e.value;
75
76Foldr1 s.Fname e.Fargs (e.list), {
77  e.list : e.something t.last =
78    <Foldr s.Fname e.Fargs (t.last) (e.something)>;
79  /*empty*/;
80};
81
82All s.Fname e.Fargs (e.list) =
83  e.list $iter {
84    e.list : t.item e.rest =
85      <Apply s.Fname e.Fargs t.item> : e,
86      e.rest;
87  } :: e.list,
88  e.list : /*empty*/;
89
90Any s.Fname e.Fargs (e.list) = # \{
91  e.list $iter {
92    e.list : t.item e.rest =
93      # \{ <Apply s.Fname e.Fargs t.item> : e; },
94      e.rest;
95  } :: e.list,
96  e.list : /*empty*/;
97};
98
99Concat e.lists = <Map &Deparen_Term (e.lists)>;
100
101Paren expr = <Map &Paren_Term (expr)>;
102
103Reverse {
104  term e.list = <Reverse e.list> term;
105  /*empty*/ = /*empty*/;
106};
107
108Intersperse {
109  (e.sep) /*empty*/ = /*empty*/;
110  (e.sep) t1 = t1;
111  (e.sep) t1 e.list =
112    (t1 e.sep) e.list $iter {
113      e.list : t2 e.rest =
114        (e.new_list t2 e.sep) e.rest;
115    } :: (e.new_list) e.list,
116    e.list : t2 =
117    e.new_list t2;
118};
119
120Separate (e.sep) e.list =
121  e.list (/*e.ll*/) $iter {
122    e.list : e1 e.sep e2 = e2 (e.ll (e1));
123    (e.ll (e.list));
124  } :: e.list (e.ll),
125  e.list : /*empty*/ =
126  e.ll;
127
128Nub e.expr =
129  e.expr () $iter {
130    e.expr : term e.rest, {
131      e.selected : e term e = e.rest (e.selected);
132      e.rest (e.selected term);
133    };
134  } :: e.expr (e.selected),
135  e.expr : /*empty*/ =
136  e.selected;
137
138Replicate s.n e.expr =
139  s.n /*e.list*/ $iter
140    <Arithm.Sub s.n 1> e.list e.expr
141  :: s.n e.list,
142  <Le (s.n) (0)> =
143  e.list;
144
145
146
147$func QSort_Split t.num e.list = (e.list) (e.list);
148
149QSort_Split t.num e.list,
150  () () (e.list) $iter {
151    e.list : t.head e.tail, {
152      <Le (t.head) (t.num)>,
153        (e.smaller t.head) (e.greater) (e.tail);
154      (e.smaller) (e.greater t.head) (e.tail);
155    };
156  } :: (e.smaller) (e.greater) (e.list),
157  e.list : /*empty*/,
158  (e.smaller) (e.greater);
159
160QSort {
161  /* empty */   = /* empty */;
162  t.head e.tail = <QSort_Split t.head e.tail> :: (e.smaller) (e.greater),
163    <QSort e.smaller> t.head <QSort e.greater>;
164};
165
166/*
167 * Returns number of e.expr entries in e.source and e.source without all e.expr's.
168 */
169//Entries e.expr (e.source) =
170//  0 e.source () $iter {
171//    e.source : e1 e.expr e2 = <"+" s.num 1> e2 (e.res e1);
172//    s.num (e.res e.source);
173//  } :: s.num e.source (e.res),
174//  e.source : /*empty*/ =
175//  s.num e.res;
176
177/*
178 * Add to the first list all new elements from the second one.
179 */
180Or (e.list1) e.list2 =
181  (e.list1) e.list2 $iter {
182    e.list2 : term e.rest,
183      {
184        e.list1 : e term e = (e.list1) e.rest;
185        (e.list1 term) e.rest;
186      };
187  } :: (e.list1) e.list2,
188  e.list2 : /*empty*/ =
189  e.list1;
190
191/*
192 * Choose from the first list all elements present in the second one.
193 */
194And (e.list1) e.list2 =
195  (e.list1) /*empty*/ $iter {
196    e.list1 : term e.rest,
197      {
198        e.list2 : e term e = (e.rest) e.and term;
199        (e.rest) e.and;
200      };
201  } :: (e.list1) e.and,
202  e.list1 : /*empty*/ =
203  e.and;
204
205/*
206 * Choose from the first list all elements not present in the second one.
207 */
208Sub (e.list1) e.list2 =
209  (e.list1) /*empty*/ $iter {
210    e.list1 : term e.rest,
211      {
212        e.list2 : e term e = (e.rest) e.not;
213        (e.rest) e.not term;
214      };
215  } :: (e.list1) e.not,
216  e.list1 : /*empty*/ =
217  e.not;
218
Note: See TracBrowser for help on using the repository browser.