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

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