1/* any l: or all the elements of list l together
2 *
3 * any (map (equal 0) list) == true, if any element of list is zero.
4 * any :: [bool] -> bool
5 */
6any = foldr logical_or false;
7
8/* all l: and all the elements of list l together
9 *
10 * all (map (==0) list) == true, if every element of list is zero.
11 * all :: [bool] -> bool
12 */
13all = foldr logical_and true;
14
15/* concat l: join a list of lists together
16 *
17 * concat ["abc","def"] == "abcdef".
18 * concat :: [[*]] -> [*]
19 */
20concat l = foldr join [] l;
21
22/* delete eq x l: delete the first x from l
23 *
24 * delete equal 'b' "abcdb" == "acdb"
25 * delete :: (* -> bool) -> * -> [*] -> [*]
26 */
27delete eq a l
28	= [], l == []
29	= y, eq a b
30	= b : delete eq a y
31{
32	b:y = l;
33}
34
35/* difference eq a b: delete b from a
36 *
37 * difference equal "asdf" "ad" == "sf"
38 * difference :: (* -> bool) -> [*] -> [*] -> [*]
39 */
40difference = foldl @ converse @ delete;
41
42/* drop n l: drop the first n elements from list l
43 *
44 * drop 3 "abcd" == "d"
45 * drop :: num -> [*] -> [*]
46 */
47drop n l
48	= l, n <= 0 || l == []
49	= drop (n - 1) (tl l);
50
51/* dropwhile fn l: drop while fn is true
52 *
53 * dropwhile is_digit "1234pigs" == "pigs"
54 * dropwhile :: (* -> bool) -> [*] -> [*]
55 */
56dropwhile fn l
57	= [], l == []
58	= dropwhile fn x, fn a
59	= l
60{
61	a:x = l;
62}
63
64/* extract n l: extract element at index n from list l
65 */
66extract = converse subscript;
67
68/* filter fn l: return all elements of l for which predicate fn holds
69 *
70 * filter is_digit "1one2two3three" = "123"
71 * filter :: (* -> bool) -> [*] -> [*]
72 */
73filter fn l
74	= foldr addif [] l
75{
76	addif x l
77		= x : l, fn x;
78		= l;
79}
80
81/* foldl fn st l: fold list l from the left with function fn and start st
82 *
83 * Start from the left hand end of the list (unlike foldr, see below).
84 * foldl is less useful (and much slower).
85 *
86 * foldl fn start [a,b .. z] = ((((st fn a) fn b) ..) fn z)
87 * foldl :: (* -> ** -> *) -> * -> [**] -> *
88 */
89foldl fn st l
90	= st, l == []
91	= foldl fn (fn st (hd l)) (tl l);
92
93/* foldl1 fn l: like foldl, but use the 1st element as the start value
94 *
95 * foldl1 fn [1,2,3] == ((1 fn 2) fn 3)
96 * foldl1 :: (* -> * -> *) -> [*] -> *
97 */
98foldl1 fn l
99	= [], l == []
100	= foldl fn (hd l) (tl l);
101
102/* foldr fn st l: fold list l from the right with function fn and start st
103 *
104 * foldr fn st [a,b..z] = (a fn (b fn (.. (z fn st))))
105 * foldr :: (* -> ** -> **) -> ** -> [*] -> **
106 */
107foldr fn st l
108	= st, l == []
109	= fn (hd l) (foldr fn st (tl l));
110
111/* foldrl fn l: like foldr, but use the 1st element as the start value
112 *
113 * foldr1 fn [1,2,3,4] == (2 fn (3 fn (4 fn 1)))
114 * foldr1 :: (* -> * -> *) -> [*] -> *
115 */
116foldr1 fn l
117	= [], l == []
118	= foldr fn (hd l) (tl l);
119
120/* Search a list for an element, returning its index (or -1)
121 *
122 * index (equal 12) [13,12,11] == 1
123 * index :: (* -> bool) -> [*] -> real
124 */
125index fn list
126	= search list 0
127{
128	search l n
129		= -1, l == []
130		= n, fn (hd l)
131		= search (tl l) (n + 1);
132}
133
134/* init l: remove last element of list l
135 *
136 * The dual of tl.
137 * init [1,2,3] == [1,2]
138 * init :: [*] -> [*]
139 */
140init l
141	= error "init of []", l == [];
142	= [], tl l == [];
143	= hd l : init (tl l);
144
145/* iterate f x: repeatedly apply f to x
146 *
147 * return the infinite list [x, f x, f (f x), ..].
148 * iterate (multiply 2) 1 == [1, 2, 4, 8, 16, 32, 64 ... ]
149 * iterate :: (* -> *) -> * -> [*]
150 */
151iterate f x = x : iterate f (f x);
152
153/* join_sep sep l: join a list with a separator
154 *
155 * join_sep ", " (map print [1 .. 4]) == "1, 2, 3, 4"
156 * join_sep :: [*] -> [[*]] -> [*]
157 */
158join_sep sep l
159	= foldl1 fn l
160{
161	fn a b = a ++ sep ++ b;
162}
163
164/* last l: return the last element of list l
165 *
166 * The dual of hd. last [1,2,3] == 3
167 * last :: [*] -> [*]
168 */
169last l
170	= error "last of []", l == []
171	= hd l, tl l == []
172	= last (tl l);
173
174/* len l: length of list l
175 * (see also is_list_len and friends in predicate.def)
176 *
177 * len :: [*] -> num
178 */
179len l
180	= 0, l == []
181	= 1 + len (tl l);
182
183/* limit l: return the first element of l which is equal to its predecessor
184 *
185 * useful for checking for convergence
186 * limit :: [*] -> *
187 */
188limit l
189	= error "incorrect use of limit",
190		l == [] || tl l == [] || tl (tl l) == []
191	= a, a == b
192	= limit (b : x)
193{
194	a:b:x = l;
195}
196
197/* Turn a function of n args into a function which takes a single arg of an
198 * n-element list.
199 */
200list_1ary fn x = fn x?0;
201list_2ary fn x = fn x?0 x?1;
202list_3ary fn x = fn x?0 x?1 x?2;
203list_4ary fn x = fn x?0 x?1 x?2 x?3;
204list_5ary fn x = fn x?0 x?1 x?2 x?3 x?4;
205list_6ary fn x = fn x?0 x?1 x?2 x?3 x?4 x?5;
206list_7ary fn x = fn x?0 x?1 x?2 x?3 x?4 x?5 x?6;
207
208/* map fn l: map function fn over list l
209 *
210 * map :: (* -> **) -> [*] -> [**]
211 */
212map f l
213	= [], l == [];
214	= f (hd l) : map f (tl l);
215
216/* map2 fn l1 l2: map two lists together with fn
217 *
218 * map2 :: (* -> ** -> ***) -> [*] -> [**] -> [***]
219 */
220map2 fn l1 l2 = map (list_2ary fn) (zip2 l1 l2);
221
222/* map3 fn l1 l2 l3: map three lists together with fn
223 *
224 * map3 :: (* -> ** -> *** -> ****) -> [*] -> [**] -> [***] -> [****]
225 */
226map3 fn l1 l2 l3 = map (list_3ary fn) (zip3 l1 l2 l3);
227
228/* member l x: true if x is a member of list l
229 *
230 * is_digit == member "0123456789"
231 * member :: [*] -> * -> bool
232 */
233member l x = any (map (equal x) l);
234
235/* merge b l r: merge two lists based on a bool list
236 *
237 * merge :: [bool] -> [*] -> [*] -> [*]
238 */
239merge p l r
240	= [], p == [] || l == [] || r == []
241	= a : merge z x y, c
242	= b : merge z x y
243{
244	a:x = l;
245	b:y = r;
246	c:z = p;
247}
248
249/* mkset eq l: remove duplicates from list l using equality function
250 *
251 * mkset :: (* -> bool) -> [*] -> [*]
252 */
253mkset eq l
254	= [], l == []
255	= a : filter (not @ eq a) (mkset eq x)
256{
257	a:x = l;
258}
259
260/* postfix l r: add r to the end of list l
261 *
262 * The dual of ':'.
263 * postfix :: [*] -> ** -> [*,**]
264 */
265postfix l r = l ++ [r];
266
267/* repeat x: make an infinite list of xes
268 *
269 * repeat :: * -> [*]
270 */
271repeat x = map (const x) [1..];
272
273/* replicate n x: make n copies of x in a list
274 *
275 * replicate :: num -> * -> [*]
276 */
277replicate n x = take n (repeat x);
278
279/* reverse l: reverse list l
280 *
281 * reverse :: [*] -> [*]
282 */
283reverse l = foldl (converse cons) [] l;
284
285/* scan fn st l: apply (fold fn r) to every initial segment of a list
286 *
287 * scan add 0 [1,2,3] == [1,3,6]
288 * scan :: (* -> ** -> *) -> * -> [**] -> [*]
289 */
290scan fn
291	= g
292{
293	g st l
294		= [st], l == []
295		= st : g (fn st a) x
296	{
297		a:x = l;
298	}
299}
300
301/* sort l: sort list l into ascending order
302 *
303 * sort :: [*] -> [*]
304 */
305sort l = sortc less_equal l;
306
307/* sortc comp l: sort list l into order using a comparision function
308 *
309 * Uses merge sort (n log n behaviour)
310 * sortc :: (* -> * -> bool) -> [*] -> [*]
311 */
312sortc comp l
313	= l, n <= 1
314	= merge (sortc comp (take n2 l)) (sortc comp (drop n2 l))
315{
316	n = len l;
317	n2 = (int) (n / 2);
318
319	/* merge l1 l2: merge sorted lists l1 and l2 to make a single
320	 * sorted list
321	 */
322	merge l1 l2
323		= l2, l1 == []
324		= l1, l2 == []
325		= a : merge x (b : y), comp a b
326		= b : merge (a : x) y
327	{
328		a:x = l1;
329		b:y = l2;
330	}
331}
332
333/* sortpl pl l: sort by a list of predicates
334 *
335 * sortpl :: (* -> bool) -> [*] -> [*]
336 */
337sortpl pl l
338	= sortc (test pl) l
339{
340	/* Comparision function ... put true before false, if equal move on to
341	 * the next predicate.
342	 */
343	test pl a b
344		= true, pl == []
345		= ta, ta != tb
346		= test (tl pl) a b
347	{
348		ta = pl?0 a;
349		tb = pl?0 b;
350	}
351}
352
353/* sortr l: sort list l into descending order
354 *
355 * sortr :: [*] -> [*]
356 */
357sortr l = sortc more l;
358
359/* split fn l: break a list into sections separated by many fn
360 *
361 * split is_space "  hello world " == ["hello", "world"]
362 * split is_space "  " == []
363 * split :: (* -> bool) -> [*] -> [[*]]
364 */
365split fn l
366        = [], l == [] || l' == []
367        = head : split fn tail
368{
369        nfn = not @ fn;
370
371        l' = dropwhile fn l;
372        head = takewhile nfn l';
373        tail = dropwhile nfn l';
374}
375
376/* splits fn l: break a list into sections separated by a single fn
377 *
378 * split (equal ',') ",,1" == ["", "", "1"]
379 * split :: (* -> bool) -> [*] -> [[*]]
380 */
381splits fn l
382        = [], l == []
383        = head : splits fn tail
384{
385        fn' = not @ fn;
386	dropif x
387		= [], x == []
388		= tl x;
389
390        head = takewhile fn' l;
391        tail = dropif (dropwhile fn' l);
392}
393
394/* splitpl fnl l: split a list up with a list of predicates
395 *
396 * splitpl [is_digit, is_letter, is_digit] "123cat" == ["123", "cat", []]
397 * splitpl :: [* -> bool] -> [*] -> [[*]]
398 */
399splitpl fnl l
400        = l, fnl == []
401        = head : splitpl (tl fnl) tail
402{
403        head = takewhile (hd fnl) l;
404        tail = dropwhile (hd fnl) l;
405}
406
407/* split_lines n l: split a list into equal length lines
408 *
409 * split_lines 4 "1234567" == ["1234", "567"]
410 * splitl :: int -> [*] -> [[*]]
411 */
412split_lines n l
413        = [], l == []
414        = take n l : split_lines n (drop n l);
415
416/* take n l: take the first n elements from list l
417 * take :: num -> [*] -> [*]
418 */
419take n l
420	= [], n <= 0
421	= [], l == []
422	= hd l : take (n-1) (tl l);
423
424/* takewhile fn l: take from the front of a list while predicate fn holds
425 *
426 * takewhile is_digit "123onetwothree" == "123"
427 * takewhile :: (* -> bool) -> [*] -> [*]
428 */
429takewhile fn l
430	= [], l == []
431	= hd l : takewhile fn (tl l), fn (hd l)
432	= [];
433
434/* zip2 l1 l2: zip two lists together
435 *
436 * zip2 [1,2] ['a', 'b', 'c'] == [[1,'a'],[2,'b']]
437 * zip2 :: [*] -> [**] -> [[*,**]]
438 */
439zip2 l1 l2
440	= [], l1 == [] || l2 == []
441	= [hd l1, hd l2] : zip2 (tl l1) (tl l2);
442
443/* zip3 l1 l2 l3: zip three lists together
444 *
445 * zip3 [1,2] ['a', 'b', 'c'] [true] == [[1,'a',true]]
446 * zip3 :: [*] -> [**] ->[***] -> [[*,**,***]]
447 */
448zip3 l1 l2 l3
449	= [], l1 == [] || l2 == [] || l3 == []
450	= [hd l1, hd l2, hd l3] : zip3 (tl l1) (tl l2) (tl l3);
451