/* any l: or all the elements of list l together
 *
 * any (map (equal 0) list) == true, if any element of list is zero.
 * any :: [bool] -> bool
 */
any = foldr logical_or false;

/* all l: and all the elements of list l together
 *
 * all (map (==0) list) == true, if every element of list is zero.
 * all :: [bool] -> bool
 */
all = foldr logical_and true;

/* concat l: join a list of lists together
 *
 * concat ["abc","def"] == "abcdef".
 * concat :: [[*]] -> [*]
 */
concat l = foldr join [] l;

/* delete eq a l: delete the first a from l
 *
 * delete equal 'b' "abcdb" == "acdb"
 * delete :: (* -> bool) -> * -> [*] -> [*]
 */
delete eq a [] = [];
delete eq a b:y
    = y, eq a b
    = b : delete eq a y;

/* difference eq a b: delete b from a
 *
 * difference equal "asdf" "ad" == "sf"
 * difference :: (* -> bool) -> [*] -> [*] -> [*]
 */
difference = foldr @ delete;

/* drop n l: drop the first n elements from list l
 *
 * drop 3 "abcd" == "d"
 * drop :: num -> [*] -> [*]
 */
drop n [] = [];
drop n a:x
    = a:x, n <= 0
    = drop (n - 1) x;

/* dropwhile fn l: drop while fn is true
 *
 * dropwhile is_digit "1234pigs" == "pigs"
 * dropwhile :: (* -> bool) -> [*] -> [*]
 */
dropwhile fn [] = [];
dropwhile fn a:x
    = dropwhile fn x, fn a
    = a:x;

/* extract n l: extract element at index n from list l
 *
 * extract 1 [1, 2] == 2
 * extract :: num -> [*] -> *
 */
extract = converse subscript;

/* filter fn l: return all elements of l for which predicate fn holds
 *
 * filter is_digit "1one2two3three" == "123"
 * filter :: (* -> bool) -> [*] -> [*]
 */
filter fn l
    = foldr addif [] l
{
    addif x l
        = x : l, fn x;
        = l;
}

/* flatten x: flatten a tree of lists into a flat list
 *
 * flatten [[[1, 2]], 3] == [1, 2, 3]
 * flatten :: [[*]] -> [*]
 */
flatten x
    = foldr flat [] x, is_list x
    = x
{
    flat x sofar
        = foldr flat sofar x, is_list x
        = x : sofar;
}

/* foldl fn st l: fold list l from the left with function fn and start st
 *
 * Start from the left hand end of the list (unlike foldr, see below).
 * foldl is less useful (and much slower).
 *
 * foldl fn start [a,b .. z] = ((((st fn a) fn b) ..) fn z)
 * foldl :: (* -> ** -> *) -> * -> [**] -> *
 */
foldl fn st [] = st;
foldl fn st a:x = foldl fn (fn st a) x;

/* foldl1 fn l: like foldl, but use the 1st element as the start value
 *
 * foldl1 fn [1,2,3] == ((1 fn 2) fn 3)
 * foldl1 :: (* -> * -> *) -> [*] -> *
 */
foldl1 fn [] = [];
foldl1 fn a:x = foldl fn a x;

/* foldr fn st l: fold list l from the right with function fn and start st
 *
 * foldr fn st [a,b..z] = (a fn (b fn (.. (z fn st))))
 * foldr :: (* -> ** -> **) -> ** -> [*] -> **
 */
foldr fn st [] = st;
foldr fn st a:x = fn a (foldr fn st x);

/* foldr1 fn l: like foldr, but use the last element as the start value
 *
 * foldr1 fn [1,2,3,4] == (1 fn (2 fn (3 fn 4)))
 * foldr1 :: (* -> * -> *) -> [*] -> *
 */
foldr1 fn [] = [];
foldr1 fn [a] = a;
foldr1 fn a:x = fn a (foldr1 fn x);

/* Search a list for an element, returning its index (or -1)
 *
 * index (equal 12) [13,12,11] == 1
 * index :: (* -> bool) -> [*] -> real
 */
index fn list
    = search list 0
{
    search [] n = -1;
    search a:x n
        = n, fn a
        = search x (n + 1);
}

/* init l: remove last element of list l
 *
 * The dual of tl.
 *
 * init [1,2,3] == [1,2]
 * init :: [*] -> [*]
 */
init [] = error "init of []";
init [a] = [];
init a:x = a : init x;

/* iterate f x: repeatedly apply f to x
 *
 * return the infinite list [x, f x, f (f x), ..].
 *
 * iterate (multiply 2) 1 == [1, 2, 4, 8, 16, 32, 64 ... ]
 * iterate :: (* -> *) -> * -> [*]
 */
iterate f x = x : iterate f (f x);

/* joinsep sep l: join a list with a separator
 *
 * joinsep ", " (map print [1 .. 4]) == "1, 2, 3, 4"
 * joinsep :: [*] -> [[*]] -> [*]
 */
joinsep sep l = foldr1 (\a\b a ++ sep ++ b) l;

/* last l: return the last element of list l
 *
 * The dual of hd. last [1,2,3] == 3
 *
 * last :: [*] -> [*]
 */
last [] = error "last of []";
last [a] = a;
last a:x = last x;

/* len l: length of list l
 * (see also is_list_len and friends in predicate.def)
 *
 * len :: [*] -> num
 */
len [] = 0;
len a:x = 1 + len x;

/* limit l: return the first element of l which is equal to its predecessor
 *
 * useful for checking for convergence
 *
 * limit :: [*] -> *
 */
limit [] = error "limit of []";
limit [a] = error "limit of [a]";
limit a:b:x
    = a, a == b
    = limit (b : x);

/* Turn a function of n args into a function which takes a single arg of an
 * n-element list.
 */
list_1ary fn [a] = fn a;
list_2ary fn [a, b] = fn a b;
list_3ary fn [a, b, c] = fn a b c;
list_4ary fn [a, b, c, d] = fn a b c d;
list_5ary fn [a, b, c, d, e] = fn a b c d e;
list_6ary fn [a, b, c, d, e, f] = fn a b c d e f;
list_7ary fn [a, b, c, d, e, f, g] = fn a b c d e f g;

/* map fn l: map function fn over list l
 *
 * map :: (* -> **) -> [*] -> [**]
 */
map f [] = [];
map f a:x = f a : map f x;

/* map2 fn l1 l2: map two lists together with fn
 *
 * map2 :: (* -> ** -> ***) -> [*] -> [**] -> [***]
 */
map2 fn l1 l2 = map (list_2ary fn) (zip2 l1 l2);

/* map3 fn l1 l2 l3: map three lists together with fn
 *
 * map3 :: (* -> ** -> *** -> ****) -> [*] -> [**] -> [***] -> [****]
 */
map3 fn l1 l2 l3 = map (list_3ary fn) (zip3 l1 l2 l3);

/* member l x: true if x is a member of list l
 *
 * is_digit == member "0123456789"
 * member :: [*] -> * -> bool
 */
member l x = any (map (equal x) l);

/* mkset eq l: remove duplicates from list l using equality function
 *
 * mkset :: (* -> bool) -> [*] -> [*]
 */
mkset eq [] = [];
mkset eq a:x = a : filter (not @ eq a) (mkset eq x);

/* postfix l r: add r to the end of list l
 *
 * The dual of ':'.
 * postfix :: [*] -> ** -> [*,**]
 */
postfix l r = l ++ [r];

/* repeat x: make an infinite list of xes
 *
 * repeat :: * -> [*]
 */
repeat x = map (const x) [1..];

/* replicate n x: make n copies of x in a list
 *
 * replicate :: num -> * -> [*]
 */
replicate n x = take n (repeat x);

/* reverse l: reverse list l
 *
 * reverse :: [*] -> [*]
 */
reverse l = foldl (converse cons) [] l;

/* scanl fn st l: apply (foldl fn r) to every initial segment of a list
 *
 * scanl add 0 [1,2,3] == [1,3,6]
 * scanl :: (* -> ** -> *) -> * -> [**] -> [*]
 */
scanl fn st [] = st;
scanl fn st a:x
    = st' : scanl fn st' x
{
    st' = fn st a;
}

/* sort l: sort list l into ascending order
 *
 * sort :: [*] -> [*]
 */
sort l = sortc less_equal l;

/* sortc comp l: sort list l into order using a comparision function
 *
 * Uses merge sort (n log n behaviour)
 *
 * sortc :: (* -> * -> bool) -> [*] -> [*]
 */
sortc comp l
    = l, n <= 1
    = merge (sortc comp (take n2 l)) (sortc comp (drop n2 l))
{
    n = len l;
    n2 = (int) (n / 2);

    /* merge l1 l2: merge sorted lists l1 and l2 to make a single
     * sorted list
     */
    merge l1 [] = l1;
    merge [] l2 = l2;
    merge a:x b:y
        = a : merge x (b : y), comp a b
        = b : merge (a : x) y;
}

/* sortpl pl l: sort by a list of predicates
 *
 * sortpl :: [* -> bool] -> [*] -> [*]
 */
sortpl pl l
    = sortc (test pl) l
{
    /* Comparision function ... put true before false, if equal move on to
     * the next predicate.
     */
    test [] a b = true;
    test p:l a b
        = p a, p a != p b
        = test l a b;
}

/* sortr l: sort list l into descending order
 *
 * sortr :: [*] -> [*]
 */
sortr l = sortc more l;

/* split fn l: break a list into sections separated by many fn
 *
 * split is_space "  hello world " == ["hello", "world"]
 * split is_space "  " == []
 * split :: (* -> bool) -> [*] -> [[*]]
 */
split fn [] = [];
split fn l
    = [], l' == []
    = head : split fn tail
{
    nfn = not @ fn;

    l' = dropwhile fn l;
    head = takewhile nfn l';
    tail = dropwhile nfn l';
}

/* splits fn l: break a list into sections separated by a single fn
 *
 * splits (equal ',') ",,1" == ["", "", "1"]
 * splits :: (* -> bool) -> [*] -> [[*]]
 */
splits fn [] = [];
splits fn l
    = head : splits fn tail
{
    fn' = not @ fn;

    dropif [] = [];
    dropif x = tl x;

    head = takewhile fn' l;
    tail = dropif (dropwhile fn' l);
}

/* splitpl fnl l: split a list up with a list of predicates
 *
 * splitpl [is_digit, is_letter, is_digit] "123cat" == ["123", "cat", []]
 * splitpl :: [* -> bool] -> [*] -> [[*]]
 */
splitpl [] l = l;
splitpl p:x l
    = head : splitpl x tail
{
    head = takewhile p l;
    tail = dropwhile p l;
}

/* split_lines n l: split a list into equal length lines
 *
 * split_lines 4 "1234567" == ["1234", "567"]
 * splitl :: int -> [*] -> [[*]]
 */
split_lines n [] = [];
split_lines n l = take n l : split_lines n (drop n l);

/* take n l: take the first n elements from list l
 * take :: num -> [*] -> [*]
 */
take n [] = [];
take n a:x
	= [], n <= 0
	= a : take (n - 1) x;

/* takewhile fn l: take from the front of a list while predicate fn holds
 *
 * takewhile is_digit "123onetwothree" == "123"
 * takewhile :: (* -> bool) -> [*] -> [*]
 */
takewhile fn [] = [];
takewhile fn a:x
    = a : takewhile fn x, fn a
    = [];

/* zip2 l1 l2: zip two lists together
 *
 * zip2 [1,2] ['a', 'b', 'c'] == [[1,'a'],[2,'b']]
 * zip2 :: [*] -> [**] -> [[*,**]]
 */
zip2 [] l2 = [];
zip2 l1 [] = [];
zip2 a:x b:y = [a, b] : zip2 x y;

/* zip3 l1 l2 l3: zip three lists together
 *
 * zip3 [1,2] ['a', 'b', 'c'] [true] == [[1,'a',true]]
 * zip3 :: [*] -> [**] ->[***] -> [[*,**,***]]
 */
zip3 [] l2 l3 = [];
zip3 l1 [] l3 = [];
zip3 l1 l2 [] = [];
zip3 a:x b:y c:z = [a, b, c] : zip3 x y z;
