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

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