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

Last change on this file since 4012 was 4012, 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: 8.1 KB
Line 
1// $Id: List2.rf 4012 2008-10-30 17:28:51Z yura $
2
3$module "refal.plus.List2";
4
5$use Apply Access Arithm Box Compare Table;
6
7$func SimplifyFunction t.func e.arg = s.func e.arg;
8SimplifyFunction t.func e.arg =
9  t.func e.arg $iter {
10    t.func : (t.func1 e.arg1) = t.func1 e.arg1 e.arg;
11  } :: t.func e.arg, t.func : s.funcRef =
12  s.funcRef e.arg;
13
14$public $func TryFunc t.func e.res = e.res;
15TryFunc t.func e.res = { <Apply t.func>; e.res; };
16
17$public $func? Apply t.func e.arg = e.res;
18Apply t.func e.arg = <Apply.Apply <SimplifyFunction t.func e.arg>>;
19
20$public $func PApply t.func e.arg = t.func;
21PApply t.func e.arg = <SimplifyFunction t.func e.arg> :: s.func e.arg,
22  {
23    e.arg : /* empty */ = s.func;
24    = (s.func e.arg);
25  };
26
27$public $func Ints s.start s.end = e.list;
28Ints s.start s.end =
29  {
30    <Le (s.start) (s.end)> =
31      s.start $iter e.list s.start <Add s.start 1> :: e.list s.start,
32      s.start : s.end =
33      e.list;
34    = s.start $iter e.list s.start <Sub s.start 1> :: e.list s.start,
35      s.start : s.end =
36      e.list;
37  };
38
39$public $func MapWithContext t.func e.list = e.list;
40MapWithContext t.func e.list =
41  <Box> :: s.box,
42  {
43    e.list : e.left t.term e.right,
44      <Put s.box <Apply t.func (e.left) t.term (e.right)>>,
45      $fail;
46    <Get s.box>;
47  };
48
49$public $func? Head e.list = t.elem;
50Head t.elem e.tail = t.elem;
51
52$public $func? Tail e.list = e.list;
53Tail t.elem e.tail = e.tail;
54
55$public $func? Init e.list = e.list;
56Init e.init t.last = e.init;
57
58$public $func? Last e.list = t.elem;
59Last e.init t.last = t.last;
60
61$public $func SwapR e.list = e.list;
62SwapR {
63  e.init t.last = t.last e.init;
64  e.list = e.list;
65};
66
67$public $func SwapL e.list = e.list;
68SwapL {
69  t.head e.tail = e.tail t.head;
70  e.list = e.list;
71};
72
73$public $func? Map t.func e.list = e.list;
74Map t.func e.list =
75  () e.list $iter {
76    e.list : t.head e.tail = (e.new_list <Apply t.func t.head>) e.tail;
77  } :: (e.new_list) e.list, e.list : /*empty*/ =
78  e.new_list;
79
80$func? MapInHelp t.func t.term = t.term;
81MapInHelp t.func (e.expr) = (<Apply t.func e.expr>);
82
83$public $func? MapIn t.func e.list = e.list;
84MapIn t.func e.list = <Map (&MapInHelp t.func) e.list>;
85
86$func FilterHelp t.func t.term = e.term_or_empty;
87FilterHelp t.func t.term = { <Apply t.func t.term> :: e = t.term; ; };
88
89$public $func Filter t.func e.list = e.list;
90Filter t.func e.list = <Map (&FilterHelp t.func) e.list>;
91
92$func FilterWithContextHelp t.func (e.left) t.term (e.right) = e.term_or_empty;
93FilterWithContextHelp t.func (e.left) t.term (e.right) = { <Apply t.func (e.left) t.term (e.right)> :: e = t.term; ; };
94
95$public $func FilterWithContext t.func e.list = e.list;
96FilterWithContext t.func e.list = <MapWithContext (&FilterWithContextHelp t.func) e.list>;
97
98$public $func Split t.func e.list = (e.true_list) (e.false_list);
99Split t.func e.list =
100  () () e.list $iter {
101    e.list : t.head e.tail, {
102      <Apply t.func t.head> :: e = (e.true_list t.head) (e.false_list) e.tail;
103      = (e.true_list) (e.false_list t.head) e.tail;
104    };
105  } :: (e.true_list) (e.false_list) e.list, e.list : /*empty*/ =
106  (e.true_list) (e.false_list);
107
108
109$public $func Paren e.expr = t.expr_with_paren;
110Paren e.expr = (e.expr);
111
112$public $func Zip (e.list1) (e.list2) = e.list;
113Zip (e.list1) (e.list2) = <ZipWith &Paren (e.list1) (e.list2)>;
114
115$public $func? ZipWith t.func (e.list1) (e.list2) = e.list;
116ZipWith t.func (e.list1) (e.list2) =
117  /*empty*/ (e.list1) (e.list2) $iter {
118    e.list1 : t.first1 e.rest1,
119      e.list2 : t.first2 e.rest2 =
120      e.new_list <Apply t.func t.first1 t.first2> (e.rest1) (e.rest2);
121  } :: e.new_list (e.list1) (e.list2), # \{ e.list1 : v, e.list2 : v; } =
122  e.new_list;
123
124$public $func? IsElem e.list t.item = ;
125IsElem e t.item e t.item;
126
127$public $func Foldl t.func (e.value) e.list = e.value;
128Foldl t.func (e.value) e.list =
129  (e.value) e.list $iter {
130    e.list : t.head e.tail = (<Apply t.func e.value t.head>) e.tail;
131  } :: (e.value) e.list, e.list : /*empty*/ =
132  e.value;
133
134$public $func Foldl1 t.func v.list = e.value;
135Foldl1 t.func t.head e.tail = <Foldr t.func (t.head) e.tail>;
136
137$public $func Foldr t.func (e.value) e.list = e.value;
138Foldr t.func (e.value) e.list =
139  (e.value) e.list $iter {
140    e.list : e.init t.last = (<Apply t.func t.last e.value>) e.init;
141  } :: (e.value) e.list, e.list : /*empty*/ =
142  e.value;
143
144$public $func Foldr1 t.func v.list = e.value;
145Foldr1 t.func e.init t.last = <Foldr t.func (t.last) e.init>;
146
147$public $func? All t.func e.list = ;
148All t.func e.list =
149  e.list $iter {
150    e.list : t.head e.tail = <Apply t.func t.head> :: e, e.tail;
151  } :: e.list, e.list : /*empty*/;
152
153$public $func? Any t.func e.list = ;
154Any t.func e.list = # \{
155  e.list $iter {
156    e.list : t.head e.tail = # \{ <Apply t.func t.head > :: e; }, e.tail;
157  } :: e.list, e.list : /*empty*/;
158};
159
160//$const Concat = (&Map &Deparen_Term);
161//
162//<Const e.list> ~~~ <Apply &Concat e.list>;
163
164//Paren expr = <Map &Paren_Term (expr)>;
165//
166//Reverse {
167//  term e.list = <Reverse e.list> term;
168//  /*empty*/ = /*empty*/;
169//};
170
171$public $func Intersperse (e.sep) e.list = e.list;
172Intersperse {
173  (e.sep) /*empty*/ = /*empty*/;
174  (e.sep) t.head0 = t.head0;
175  (e.sep) t.head0 e.tail0 =
176    (t.head0 e.sep) e.tail0 $iter {
177      e.list : t.head e.tail = (e.new_list t.head e.sep) e.tail;
178    } :: (e.new_list) e.list, e.list : t.last =
179    e.new_list t.last;
180};
181
182$public $func Separate (e.sep) e.list = e.listOfLists;
183Separate (e.sep) e.list =
184  () e.list $iter {
185    e.list : e.before e.sep e.after = (e.ll (e.before)) e.after;
186    = (e.ll (e.list));
187  } :: (e.ll) e.list, e.list : /*empty*/ =
188  e.ll;
189
190$func ConcatHelp t.term = e.expr;
191ConcatHelp {
192  (e.expr) = e.expr;
193  t.term   = t.term;
194};
195
196$public $func Id e.expr = e.expr;
197Id e.expr = e.expr;
198
199$public $func Concat e.lists = e.list;
200Concat e.lists = <Map &ConcatHelp e.lists>;
201
202$public $func? EqTerms t.term t.term = ;
203EqTerms t1 t1;
204
205$public $func Nub e.list = e.list;
206Nub e.list = <NubBy &EqTerms e.list>;
207
208$public $func NubBy t.eqTerms e.list = e.list;
209NubBy t.eqTerms e.list =
210  () e.list $iter {
211    e.list : t.head e.tail, {
212      <Any (t.eqTerms t.head) e.new_list> = (e.new_list) e.tail;
213      = (e.new_list t.head) e.tail;
214    };
215  } :: (e.new_list) e.list, e.list : /*empty*/ =
216  e.new_list;
217
218$public $func Frequencies e.list = e.list;
219Frequencies e.list =
220  <Table> :: s.table,
221  {
222    e.list : e t.term e,
223      { <Lookup s.table t.term>; 0; } : s.num,
224      <Bind s.table (t.term) (<Add s.num 1>)>,
225      $fail;
226    <MapIn &Concat <Entries s.table>>;
227  };
228
229$public $func SumNumbers e.list = e.list;
230SumNumbers e.list =
231  <Table> :: s.table,
232  {
233    e.list : e (e.expr s.n) e,
234      { <Lookup s.table e.expr>; 0; } : s.num,
235      <Bind s.table (e.expr) (<Add s.num s.n>)>,
236      $fail;
237    <MapIn &Concat <Entries s.table>>;
238  };
239
240//Replicate s.n e.expr =
241//  s.n /*e.list*/ $iter
242//    <Arithm.Sub s.n 1> e.list e.expr
243//  :: s.n e.list,
244//  <Le (s.n) (0)> =
245//  e.list;
246
247$func QSort_Split t.num e.list = (e.list) (e.list);
248QSort_Split t.num e.list,
249  () () e.list $iter {
250    e.list : t.head e.tail, {
251      <Le (t.head) (t.num)> = (e.smaller t.head) (e.greater) e.tail;
252      = (e.smaller) (e.greater t.head) e.tail;
253    };
254  } :: (e.smaller) (e.greater) e.list, e.list : /*empty*/ =
255  (e.smaller) (e.greater);
256
257$public $func QSort e.list = e.list;
258QSort {
259  /* empty */   = /* empty */;
260  t.head e.tail = <QSort_Split t.head e.tail> :: (e.smaller) (e.greater),
261    <QSort e.smaller> t.head <QSort e.greater>;
262};
263
264$public $func CompareTerms t.term t.term = s.cmp;
265CompareTerms t.term1 t.term2 = <Compare (t.term1) (t.term2)>;
266
267$public $func Sort e.list = e.list;
268Sort e.list = <SortBy &CompareTerms e.list>;
269
270$public $func SortBy t.cmpTerms e.list = e.list;
271SortBy t.cmpTerms e.list =
272  <Div <Length e.list> 2> : {
273    0 = e.list;
274    s.k = <Merge t.cmpTerms (<SortBy t.cmpTerms <Left 0 s.k e.list>>) (<SortBy t.cmpTerms <Middle s.k 0 e.list>>)>;
275  };
276
277$func Merge t.cmpTerms (e.left) (e.right) = e.merged_list;
278Merge t.cmpTerms (e.left) (e.right) =
279  (e.left) (e.right) $iter {
280    e.left : t.l e.left_rest, e.right : t.r e.right_rest = {
281     <Apply t.cmpTerms t.l t.r> : '<' = e.merged t.l (e.left_rest) (e.right);
282      = e.merged t.r (e.left) (e.right_rest);
283    };
284  } :: e.merged (e.left) (e.right),
285  \{
286    e.left  : /*empty*/ = e.merged e.right;
287    e.right : /*empty*/ = e.merged e.left;
288  };
Note: See TracBrowser for help on using the repository browser.