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

Last change on this file since 3992 was 3992, checked in by yura, 12 years ago
  • Some experiments with t-representation of function.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.8 KB
Line 
1// $Id: List2.rf 3992 2008-10-22 20:02:29Z 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.list;
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.list;
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 Foldr t.func (e.value) e.list = e.list;
65Foldr t.func (e.value) e.list =
66  (e.value) e.list $iter {
67    e.list : e.init t.last =
68      (<Apply t.func t.last e.value>) e.init;
69  } :: (e.value) e.list,
70  e.list : /*empty*/ =
71  e.value;
72
73Foldr1 s.Fname e.Fargs (e.list), {
74  e.list : e.something t.last =
75    <Foldr s.Fname e.Fargs (t.last) (e.something)>;
76  /*empty*/;
77};
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
96Concat e.lists = <Map &Deparen_Term (e.lists)>;
97
98Paren expr = <Map &Paren_Term (expr)>;
99
100Reverse {
101  term e.list = <Reverse e.list> term;
102  /*empty*/ = /*empty*/;
103};
104
105Intersperse {
106  (e.sep) /*empty*/ = /*empty*/;
107  (e.sep) t1 = t1;
108  (e.sep) t1 e.list =
109    (t1 e.sep) e.list $iter {
110      e.list : t2 e.rest =
111        (e.new_list t2 e.sep) e.rest;
112    } :: (e.new_list) e.list,
113    e.list : t2 =
114    e.new_list t2;
115};
116
117Separate (e.sep) e.list =
118  e.list (/*e.ll*/) $iter {
119    e.list : e1 e.sep e2 = e2 (e.ll (e1));
120    (e.ll (e.list));
121  } :: e.list (e.ll),
122  e.list : /*empty*/ =
123  e.ll;
124
125Nub e.expr = <NubBy &EqTerms e.expr>;
126
127NubBy s.eqTerms e.expr =
128  e.expr () $iter {
129    e.expr : term e.rest, {
130      <Any s.eqTerms term (e.selected)> = e.rest (e.selected);
131      e.rest (e.selected (term));
132    };
133  } :: e.expr (e.selected),
134  e.expr : /*empty*/ =
135  <Concat e.selected>;
136
137Replicate s.n e.expr =
138  s.n /*e.list*/ $iter
139    <Arithm.Sub s.n 1> e.list e.expr
140  :: s.n e.list,
141  <Le (s.n) (0)> =
142  e.list;
143
144
145
146$func QSort_Split t.num e.list = (e.list) (e.list);
147
148QSort_Split t.num e.list,
149  () () (e.list) $iter {
150    e.list : t.head e.tail, {
151      <Le (t.head) (t.num)>,
152        (e.smaller t.head) (e.greater) (e.tail);
153      (e.smaller) (e.greater t.head) (e.tail);
154    };
155  } :: (e.smaller) (e.greater) (e.list),
156  e.list : /*empty*/,
157  (e.smaller) (e.greater);
158
159QSort {
160  /* empty */   = /* empty */;
161  t.head e.tail = <QSort_Split t.head e.tail> :: (e.smaller) (e.greater),
162    <QSort e.smaller> t.head <QSort e.greater>;
163};
164
165SortBy s.cmpTerms e.list =
166  <Length e.list> :: s.len,
167  {
168    <Le (s.len) (1)> = e.list;
169    <Div s.len 2> :: s.k =
170      <Merge s.cmpTerms (<SortBy s.cmpTerms <Left 0 s.k e.list>>) (<SortBy s.cmpTerms <Middle s.k 0 e.list>>)>;
171  };
172
173$func Merge s.cmpTerms (e.left) (e.right) = e.merged_list;
174Merge s.cmpTerms (e.left) (e.right) =
175  (e.left) (e.right) $iter {
176    e.left : t.l e.left_rest, e.right : t.r e.right_rest = {
177      <Apply s.cmpTerms t.l t.r> : '<' = (e.left_rest) (e.right) e.merged t.l;
178      = (e.left) (e.right_rest) e.merged t.r;
179    };
180  } :: (e.left) (e.right) e.merged,
181  \{
182    e.left  : /*empty*/ = e.merged e.right;
183    e.right : /*empty*/ = e.merged e.left;
184  };
185
186Sort e.list = <SortBy &CompareTerms e.list>;
187
188/*
189 * Returns number of e.expr entries in e.source and e.source without all e.expr's.
190 */
191//Entries e.expr (e.source) =
192//  0 e.source () $iter {
193//    e.source : e1 e.expr e2 = <"+" s.num 1> e2 (e.res e1);
194//    s.num (e.res e.source);
195//  } :: s.num e.source (e.res),
196//  e.source : /*empty*/ =
197//  s.num e.res;
198
199/*
200 * Add to the first list all new elements from the second one.
201 */
202Or (e.list1) e.list2 =
203  (e.list1) e.list2 $iter {
204    e.list2 : term e.rest,
205      {
206        e.list1 : e term e = (e.list1) e.rest;
207        (e.list1 term) e.rest;
208      };
209  } :: (e.list1) e.list2,
210  e.list2 : /*empty*/ =
211  e.list1;
212
213/*
214 * Choose from the first list all elements present in the second one.
215 */
216And (e.list1) e.list2 =
217  (e.list1) /*empty*/ $iter {
218    e.list1 : term e.rest,
219      {
220        e.list2 : e term e = (e.rest) e.and term;
221        (e.rest) e.and;
222      };
223  } :: (e.list1) e.and,
224  e.list1 : /*empty*/ =
225  e.and;
226
227/*
228 * Choose from the first list all elements not present in the second one.
229 */
230Sub (e.list1) e.list2 =
231  (e.list1) /*empty*/ $iter {
232    e.list1 : term e.rest,
233      {
234        e.list2 : e term e = (e.rest) e.not;
235        (e.rest) e.not term;
236      };
237  } :: (e.list1) e.not,
238  e.list1 : /*empty*/ =
239  e.not;
240
Note: See TracBrowser for help on using the repository browser.