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

Last change on this file since 4074 was 4074, checked in by orlov, 12 years ago
  • Include Ints function in the List library.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.0 KB
Line 
1// $Id: List.rf 4074 2009-02-11 22:41:08Z orlov $
2
3$use Apply Access Arithm Compare List2;
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
18Ints s.start s.end = <List2.Ints s.start s.end>;
19
20EqTerms t1 t1;
21
22CompareTerms t1 t2 = <Compare (t1) (t2)>;
23
24Zip (e.list1) (e.list2) =
25  (e.list1) (e.list2) /*empty*/ $iter {
26    e.list1 : t.first1 e.rest1,
27      e.list2 : t.first2 e.rest2 =
28      (e.rest1) (e.rest2) e.new_list (t.first1 t.first2);
29  } :: (e.list1) (e.list2) e.new_list,
30  e.list1 : /*empty*/ =
31  e.new_list;
32
33Unzip e.list =
34  () () e.list $iter {
35    e.list : (t1 e2) e.tail =
36      (e.list1 t1) (e.list2 e2) e.tail;
37  } :: (e.list1) (e.list2) e.list,
38  e.list : /*empty*/ =
39  (e.list1) (e.list2);
40
41Map s.Fname e.Fargs (e.list) =
42  () e.list $iter {
43    e.list : t.item e.rest =
44      (e.new_list <Apply.Apply s.Fname e.Fargs t.item>) e.rest;
45  } :: (e.new_list) e.list,
46  e.list : /*empty*/ =
47  e.new_list;
48
49MapIn s.Fname e.Fargs (e.list) =
50  () e.list $iter {
51    e.list : (e.item) e.rest =
52      (e.new_list (<Apply.Apply s.Fname e.Fargs e.item>)) e.rest;
53  } :: (e.new_list) e.list,
54  e.list : /*empty*/ =
55  e.new_list;
56
57Filter s.Fname e.Fargs (e.list) =
58  () e.list $iter {
59    e.list : t.item e.rest, {
60      <Apply.Apply s.Fname e.Fargs t.item> : e =
61        (e.new_list t.item) e.rest;
62      (e.new_list) e.rest;
63    };
64  } :: (e.new_list) e.list,
65  e.list : /*empty*/ =
66  e.new_list;
67
68Split s.Fname e.Fargs (e.list) =
69  () () e.list $iter {
70    e.list : t.item e.rest, {
71      <Apply.Apply s.Fname e.Fargs t.item> : e =
72        (e.true_list t.item) (e.false_list) e.rest;
73      (e.true_list) (e.false_list t.item) e.rest;
74    };
75  } :: (e.true_list) (e.false_list) e.list,
76  e.list : /*empty*/ =
77  (e.true_list) (e.false_list);
78
79IsElem e.list t.item =
80  e.list : e t.item e;
81
82Foldr s.Fname e.Fargs (e.value) (e.list) =
83  (e.value) e.list $iter {
84    e.list : e.something t.last =
85      (<Apply.Apply s.Fname e.Fargs t.last e.value>) e.something;
86  } :: (e.value) e.list,
87  e.list : /*empty*/ =
88  e.value;
89
90Foldr1 s.Fname e.Fargs (e.list), {
91  e.list : e.something t.last =
92    <Foldr s.Fname e.Fargs (t.last) (e.something)>;
93  /*empty*/;
94};
95
96All s.Fname e.Fargs (e.list) =
97  e.list $iter {
98    e.list : t.item e.rest =
99      <Apply.Apply s.Fname e.Fargs t.item> : e,
100      e.rest;
101  } :: e.list,
102  e.list : /*empty*/;
103
104Any s.Fname e.Fargs (e.list) = # \{
105  e.list $iter {
106    e.list : t.item e.rest =
107      # \{ <Apply.Apply s.Fname e.Fargs t.item> : e; },
108      e.rest;
109  } :: e.list,
110  e.list : /*empty*/;
111};
112
113Concat e.lists = <Map &Deparen_Term (e.lists)>;
114
115Paren expr = <Map &Paren_Term (expr)>;
116
117Reverse {
118  term e.list = <Reverse e.list> term;
119  /*empty*/ = /*empty*/;
120};
121
122Intersperse {
123  (e.sep) /*empty*/ = /*empty*/;
124  (e.sep) t1 = t1;
125  (e.sep) t1 e.list =
126    (t1 e.sep) e.list $iter {
127      e.list : t2 e.rest =
128        (e.new_list t2 e.sep) e.rest;
129    } :: (e.new_list) e.list,
130    e.list : t2 =
131    e.new_list t2;
132};
133
134Separate (e.sep) e.list =
135  e.list (/*e.ll*/) $iter {
136    e.list : e1 e.sep e2 = e2 (e.ll (e1));
137    (e.ll (e.list));
138  } :: e.list (e.ll),
139  e.list : /*empty*/ =
140  e.ll;
141
142Nub e.expr = <NubBy &EqTerms e.expr>;
143
144NubBy s.eqTerms e.expr =
145  e.expr () $iter {
146    e.expr : term e.rest, {
147      <Any s.eqTerms term (e.selected)> = e.rest (e.selected);
148      e.rest (e.selected (term));
149    };
150  } :: e.expr (e.selected),
151  e.expr : /*empty*/ =
152  <Concat e.selected>;
153
154Replicate s.n e.expr =
155  s.n /*e.list*/ $iter
156    <Arithm.Sub s.n 1> e.list e.expr
157  :: s.n e.list,
158  <Le (s.n) (0)> =
159  e.list;
160
161
162
163$func QSort_Split t.num e.list = (e.list) (e.list);
164
165QSort_Split t.num e.list,
166  () () (e.list) $iter {
167    e.list : t.head e.tail, {
168      <Le (t.head) (t.num)>,
169        (e.smaller t.head) (e.greater) (e.tail);
170      (e.smaller) (e.greater t.head) (e.tail);
171    };
172  } :: (e.smaller) (e.greater) (e.list),
173  e.list : /*empty*/,
174  (e.smaller) (e.greater);
175
176QSort {
177  /* empty */   = /* empty */;
178  t.head e.tail = <QSort_Split t.head e.tail> :: (e.smaller) (e.greater),
179    <QSort e.smaller> t.head <QSort e.greater>;
180};
181
182SortBy s.cmpTerms e.list =
183  <Length e.list> :: s.len,
184  {
185    <Le (s.len) (1)> = e.list;
186    <Div s.len 2> :: s.k =
187      <Merge s.cmpTerms (<SortBy s.cmpTerms <Left 0 s.k e.list>>) (<SortBy s.cmpTerms <Middle s.k 0 e.list>>)>;
188  };
189
190$func Merge s.cmpTerms (e.left) (e.right) = e.merged_list;
191Merge s.cmpTerms (e.left) (e.right) =
192  (e.left) (e.right) $iter {
193    e.left : t.l e.left_rest, e.right : t.r e.right_rest = {
194      <Apply.Apply s.cmpTerms t.l t.r> : '<' = (e.left_rest) (e.right) e.merged t.l;
195      = (e.left) (e.right_rest) e.merged t.r;
196    };
197  } :: (e.left) (e.right) e.merged,
198  \{
199    e.left  : /*empty*/ = e.merged e.right;
200    e.right : /*empty*/ = e.merged e.left;
201  };
202
203Sort e.list = <SortBy &CompareTerms e.list>;
204
205/*
206 * Returns number of e.expr entries in e.source and e.source without all e.expr's.
207 */
208//Entries e.expr (e.source) =
209//  0 e.source () $iter {
210//    e.source : e1 e.expr e2 = <"+" s.num 1> e2 (e.res e1);
211//    s.num (e.res e.source);
212//  } :: s.num e.source (e.res),
213//  e.source : /*empty*/ =
214//  s.num e.res;
215
216/*
217 * Add to the first list all new elements from the second one.
218 */
219Or (e.list1) e.list2 =
220  (e.list1) e.list2 $iter {
221    e.list2 : term e.rest,
222      {
223        e.list1 : e term e = (e.list1) e.rest;
224        (e.list1 term) e.rest;
225      };
226  } :: (e.list1) e.list2,
227  e.list2 : /*empty*/ =
228  e.list1;
229
230/*
231 * Choose from the first list all elements present in the second one.
232 */
233And (e.list1) e.list2 =
234  (e.list1) /*empty*/ $iter {
235    e.list1 : term e.rest,
236      {
237        e.list2 : e term e = (e.rest) e.and term;
238        (e.rest) e.and;
239      };
240  } :: (e.list1) e.and,
241  e.list1 : /*empty*/ =
242  e.and;
243
244/*
245 * Choose from the first list all elements not present in the second one.
246 */
247Sub (e.list1) e.list2 =
248  (e.list1) /*empty*/ $iter {
249    e.list1 : term e.rest,
250      {
251        e.list2 : e term e = (e.rest) e.not;
252        (e.rest) e.not term;
253      };
254  } :: (e.list1) e.not,
255  e.list1 : /*empty*/ =
256  e.not;
257
Note: See TracBrowser for help on using the repository browser.