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