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

Last change on this file since 4030 was 4030, 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: 12.1 KB
Line 
1// $Id: List2.rf 4030 2008-11-11 16:37:57Z 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? ConcatMapInHelp t.func t.term = e.list;
87ConcatMapInHelp t.func (e.expr) = <Apply t.func e.expr>;
88
89$public $func? ConcatMapIn t.func e.list = e.list;
90ConcatMapIn t.func e.list = <Map (&ConcatMapInHelp t.func) e.list>;
91
92$func FilterHelp t.func t.term = e.term_or_empty;
93FilterHelp t.func t.term = { <Apply t.func t.term> :: e = t.term; ; };
94
95$public $func Filter t.func e.list = e.list;
96Filter t.func e.list = <Map (&FilterHelp t.func) e.list>;
97
98$func? FilterInHelp t.func t.term = e.term_or_empty;
99FilterInHelp t.func t.term = t.term : (e.expr), { <Apply t.func e.expr> :: e = t.term; ; };
100
101$public $func FilterIn t.func e.list = e.list;
102FilterIn t.func e.list = <Map (&FilterInHelp t.func) e.list>;
103
104$func FilterWithContextHelp t.func (e.left) t.term (e.right) = e.term_or_empty;
105FilterWithContextHelp t.func (e.left) t.term (e.right) = { <Apply t.func (e.left) t.term (e.right)> :: e = t.term; ; };
106
107$public $func FilterWithContext t.func e.list = e.list;
108FilterWithContext t.func e.list = <MapWithContext (&FilterWithContextHelp t.func) e.list>;
109
110$public $func Split t.func e.list = (e.true_list) (e.false_list);
111Split t.func e.list =
112  () () e.list $iter {
113    e.list : t.head e.tail, {
114      <Apply t.func t.head> :: e = (e.true_list t.head) (e.false_list) e.tail;
115      = (e.true_list) (e.false_list t.head) e.tail;
116    };
117  } :: (e.true_list) (e.false_list) e.list, e.list : /*empty*/ =
118  (e.true_list) (e.false_list);
119
120
121$public $func Paren e.expr = t.expr_with_paren;
122Paren e.expr = (e.expr);
123
124$public $func Zip (e.list1) (e.list2) = e.list;
125Zip (e.list1) (e.list2) = <ZipWith &Paren (e.list1) (e.list2)>;
126
127$public $func? ZipWith t.func (e.list1) (e.list2) = e.list;
128ZipWith t.func (e.list1) (e.list2) =
129  /*empty*/ (e.list1) (e.list2) $iter {
130    e.list1 : t.first1 e.rest1,
131      e.list2 : t.first2 e.rest2 =
132      e.new_list <Apply t.func t.first1 t.first2> (e.rest1) (e.rest2);
133  } :: e.new_list (e.list1) (e.list2), # \{ e.list1 : v, e.list2 : v; } =
134  e.new_list;
135
136$public $func Transpose e.lists = e.lists;
137Transpose e.lists = <TransposeWith &Paren e.lists>;
138
139$func? TransposeWithHelp e.lists = (e.heads) e.tails;
140TransposeWithHelp e.lists =
141  () () e.lists $iter {
142    e.lists : (e.listsHead) e.listsTail =
143      e.listsHead : t.head e.tail,
144      (e.heads t.head) (e.tails (e.tail)) e.listsTail;
145  } :: (e.heads) (e.tails) e.lists, e.lists : /* empty */ =
146  (e.heads) e.tails;
147 
148$public $func? TransposeWith t.func e.lists = e.list;
149TransposeWith t.func e.lists =
150  (e.lists) $iter {
151    <TransposeWithHelp e.lists> :: (e.heads) e.lists =
152      e.out <Apply t.func e.heads> (e.lists);
153    e.out ();   
154  } :: e.out (e.lists), e.lists : /* empty */ =
155  e.out;
156
157$public $func Product (e.list1) (e.list2) = e.list;
158Product (e.list1) (e.list2) = <ProductWith &Paren (e.list1) (e.list2)>;
159
160$public $func? ProductWith t.func (e.list1) (e.list2) = e.list;
161ProductWith t.func (e.list1) (e.list2) =
162  <Box> :: s.box, {
163    e.list1 : e t.term1 e,
164      e.list2 : e t.term2 e,
165      <Put s.box <Apply t.func t.term1 t.term2>>,
166      $fail;
167    <Get s.box>;
168  };
169
170$public $func DirectProduct e.lists = e.lists;
171DirectProduct e.lists = <DirectProductWith &Paren e.lists>;
172
173$func? DirectProductWithHelp t.func e.lists t.term = e.lists;
174DirectProductWithHelp t.func e.lists t.term = <DirectProductWith (t.func t.term) e.lists>;
175
176$public $func? DirectProductWith t.func e.lists = e.lists;
177DirectProductWith t.func e.lists = e.lists : {
178  /* empty */ = <Apply t.func>;
179  (e.list) e.tail = <Map (&DirectProductWithHelp t.func e.tail) e.list>;
180};
181
182$public $func? IsElem e.list t.item = ;
183IsElem e t.item e t.item;
184
185$public $func Foldl t.func (e.value) e.list = e.value;
186Foldl t.func (e.value) e.list =
187  (e.value) e.list $iter {
188    e.list : t.head e.tail = (<Apply t.func e.value t.head>) e.tail;
189  } :: (e.value) e.list, e.list : /*empty*/ =
190  e.value;
191
192$public $func Foldl1 t.func v.list = e.value;
193Foldl1 t.func t.head e.tail = <Foldr t.func (t.head) e.tail>;
194
195$public $func Foldr t.func (e.value) e.list = e.value;
196Foldr t.func (e.value) e.list =
197  (e.value) e.list $iter {
198    e.list : e.init t.last = (<Apply t.func t.last e.value>) e.init;
199  } :: (e.value) e.list, e.list : /*empty*/ =
200  e.value;
201
202$public $func Foldr1 t.func v.list = e.value;
203Foldr1 t.func e.init t.last = <Foldr t.func (t.last) e.init>;
204
205$public $func? All t.func e.list = ;
206All t.func e.list =
207  e.list $iter {
208    e.list : t.head e.tail = <Apply t.func t.head> :: e, e.tail;
209  } :: e.list, e.list : /*empty*/;
210
211$public $func? Any t.func e.list = ;
212Any t.func e.list = # \{
213  e.list $iter {
214    e.list : t.head e.tail = # \{ <Apply t.func t.head > :: e; }, e.tail;
215  } :: e.list, e.list : /*empty*/;
216};
217
218$public $func Subtract (e.list1) (e.list2) = e.list;
219Subtract (e.list1) (e.list2) =
220  /*empty*/ (e.list1) $iter {
221    e.list1 : term e.rest,
222      {
223        e.list2 : e term e =  e.not (e.rest);
224        = e.not term (e.rest);
225      };
226  } ::  e.not (e.list1), e.list1 : /*empty*/ =
227  e.not;
228
229//$const Concat = (&Map &Deparen_Term);
230//
231//<Const e.list> ~~~ <Apply &Concat e.list>;
232
233//Paren expr = <Map &Paren_Term (expr)>;
234//
235//Reverse {
236//  term e.list = <Reverse e.list> term;
237//  /*empty*/ = /*empty*/;
238//};
239
240$public $func Intersperse (e.sep) e.list = e.list;
241Intersperse {
242  (e.sep) /*empty*/ = /*empty*/;
243  (e.sep) t.head0 = t.head0;
244  (e.sep) t.head0 e.tail0 =
245    (t.head0 e.sep) e.tail0 $iter {
246      e.list : t.head e.tail = (e.new_list t.head e.sep) e.tail;
247    } :: (e.new_list) e.list, e.list : t.last =
248    e.new_list t.last;
249};
250
251$public $func Separate (e.sep) e.list = e.listOfLists;
252Separate (e.sep) e.list =
253  () e.list $iter {
254    e.list : e.before e.sep e.after = (e.ll (e.before)) e.after;
255    = (e.ll (e.list));
256  } :: (e.ll) e.list, e.list : /*empty*/ =
257  e.ll;
258
259$func ConcatHelp t.term = e.expr;
260ConcatHelp {
261  (e.expr) = e.expr;
262  t.term   = t.term;
263};
264
265$public $func Id e.expr = e.expr;
266Id e.expr = e.expr;
267
268$public $func Concat e.lists = e.list;
269Concat e.lists = <Map &ConcatHelp e.lists>;
270
271$public $func? EqTerms t.term t.term = ;
272EqTerms t1 t1;
273
274$public $func Nub e.list = e.list;
275Nub e.list = <NubBy &EqTerms e.list>;
276
277$public $func NubBy t.eqTerms e.list = e.list;
278NubBy t.eqTerms e.list =
279  () e.list $iter {
280    e.list : t.head e.tail, {
281      <Any (t.eqTerms t.head) e.new_list> = (e.new_list) e.tail;
282      = (e.new_list t.head) e.tail;
283    };
284  } :: (e.new_list) e.list, e.list : /*empty*/ =
285  e.new_list;
286
287$func FrequenciesHelp (e.expr) (s.num) = s.num e.expr;
288FrequenciesHelp (e.expr) (s.num) = s.num e.expr;
289 
290$public $func Frequencies e.list = e.list;
291Frequencies e.list =
292  <Table> :: s.table,
293  {
294    e.list : e t.term e,
295      { <Lookup s.table t.term>; 0; } : s.num,
296      <Bind s.table (t.term) (<Add s.num 1>)>,
297      $fail;
298    <Sort <MapIn &FrequenciesHelp <Entries s.table>>>;
299  };
300
301$public $func SumNumbers e.list = e.list;
302SumNumbers e.list =
303  <Table> :: s.table,
304  {
305    e.list : e (s.n e.expr) e,
306      { <Lookup s.table e.expr>; 0; } : s.num,
307      <Bind s.table (e.expr) (<Add s.num s.n>)>,
308      $fail;
309    <Sort <MapIn &FrequenciesHelp <Entries s.table>>>;
310  };
311
312//Replicate s.n e.expr =
313//  s.n /*e.list*/ $iter
314//    <Arithm.Sub s.n 1> e.list e.expr
315//  :: s.n e.list,
316//  <Le (s.n) (0)> =
317//  e.list;
318
319$public $func CompareTerms t.term t.term = s.cmp;
320CompareTerms t.term1 t.term2 = <Compare (t.term1) (t.term2)>;
321
322$func QSort_Split t.cmpTerm e.list = (e.smaller) (e.equal) (e.greater);
323QSort_Split t.cmpTerm e.list,
324  () () () e.list $iter {
325    e.list : t.head e.tail,
326      <Apply t.cmpTerm t.head> : {
327        '<' = (e.smaller) (e.equal) (e.greater t.head) e.tail;
328        '=' = (e.smaller) (e.equal t.head) (e.greater) e.tail;
329        '>' = (e.smaller t.head) (e.equal) (e.greater) e.tail;
330    };
331  } :: (e.smaller) (e.equal) (e.greater) e.list, e.list : /*empty*/ =
332  (e.smaller) (e.equal) (e.greater);
333
334$public $func QSortBy t.cmpTerms e.list = e.list;
335QSortBy t.cmpTerms e.list = e.list : {
336  /* empty */   = /* empty */;
337  t.head e.tail = <QSort_Split (t.cmpTerms t.head) e.tail> :: (e.smaller) (e.equal) (e.greater),
338    <QSort e.smaller> t.head e.equal <QSort e.greater>;
339};
340
341$public $func QSort e.list = e.list;
342QSort e.list = <QSortBy &CompareTerms e.list>;
343
344$public $func QSortAndNubBy t.cmpTerms e.list = e.list;
345QSortAndNubBy t.cmpTerms e.list = e.list : {
346  /* empty */   = /* empty */;
347  t.head e.tail = <QSort_Split (t.cmpTerms t.head) e.tail> :: (e.smaller) t (e.greater),
348    <QSortAndNubBy t.cmpTerms e.smaller> t.head <QSortAndNubBy t.cmpTerms e.greater>;
349};
350
351$public $func QSortAndNub e.list = e.list;
352QSortAndNub e.list = <QSortAndNubBy &CompareTerms e.list>;
353
354$public $func Sort e.list = e.list;
355Sort e.list = <SortBy &CompareTerms e.list>;
356
357$public $func SortBy t.cmpTerms e.list = e.list;
358SortBy t.cmpTerms e.list =
359  <Div <Length e.list> 2> : {
360    0 = e.list;
361    s.k = <Merge t.cmpTerms (<SortBy t.cmpTerms <Left 0 s.k e.list>>) (<SortBy t.cmpTerms <Middle s.k 0 e.list>>)>;
362  };
363
364$func Merge t.cmpTerms (e.left) (e.right) = e.merged_list;
365Merge t.cmpTerms (e.left) (e.right) =
366  (e.left) (e.right) $iter {
367    e.left : t.l e.left_rest, e.right : t.r e.right_rest = {
368     <Apply t.cmpTerms t.l t.r> : '<' = e.merged t.l (e.left_rest) (e.right);
369      = e.merged t.r (e.left) (e.right_rest);
370    };
371  } :: e.merged (e.left) (e.right),
372  \{
373    e.left  : /*empty*/ = e.merged e.right;
374    e.right : /*empty*/ = e.merged e.left;
375  };
376
377$public $func SortAndNub e.list = e.list;
378SortAndNub e.list = <SortBy &CompareTerms e.list>;
379
380$public $func SortAndNubBy t.cmpTerms e.list = e.list;
381SortAndNubBy t.cmpTerms e.list =
382  <Div <Length e.list> 2> : {
383    0 = e.list;
384    s.k = <MergeAndNub t.cmpTerms (<SortAndNubBy t.cmpTerms <Left 0 s.k e.list>>) (<SortAndNubBy t.cmpTerms <Middle s.k 0 e.list>>)>;
385  };
386
387$func MergeAndNub t.cmpTerms (e.left) (e.right) = e.merged_list;
388MergeAndNub t.cmpTerms (e.left) (e.right) =
389  (e.left) (e.right) $iter {
390    e.left : t.l e.left_rest, e.right : t.r e.right_rest = <Apply t.cmpTerms t.l t.r> : {
391     '<' = e.merged t.l (e.left_rest) (e.right);
392     '>' = e.merged t.r (e.left) (e.right_rest);
393     '=' = e.merged (e.left) (e.right_rest);
394    };
395  } :: e.merged (e.left) (e.right),
396  \{
397    e.left  : /*empty*/ = e.merged e.right;
398    e.right : /*empty*/ = e.merged e.left;
399  };
Note: See TracBrowser for help on using the repository browser.