source: to-imperative/trunk/java/refal/refal/plus/List2.rf @ 3993

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