nip2 7.26.3-1build1 / usr / share / nip2 / compat / 7.8 / _list.def

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

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

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

/* extract n l: extract element at index n from list l
 */
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;
}

/* foldl fn st l: fold list l up from the left using function fn and start value 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 l
	= st, l == []
	= foldl fn (fn st (hd l)) (tl l);

/* 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 l
	= [], l == []
	= foldl fn (hd l) (tl l);

/* foldr fn st l: fold up list l, right to left, with function fn and start 
 *
 * foldr fn st [a,b..z] = (a fn (b fn (.. (z fn st))))
 * foldr :: (* -> ** -> **) -> ** -> [*] -> **
 */
foldr fn st l
	= st, l == []
	= fn (hd l) (foldr fn st (tl l));

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

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

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

/* 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);

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

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

/* len l: length of list l
 *
 * len :: [*] -> num
 */
len l
	= 0, l == []
	= 1 + len (tl l);

/* limit l: return the first element of l which is equal to its predecessor
 *
 * useful for checking for convergence
 * limit :: [*] -> *
 */
limit l
	= error "incorrect use of limit", 
		l == [] || tl l == [] || tl (tl l) == []
	= a, a == b
	= limit (b : x)
{
	a = l?0;
	b = l?1;
	x = tl (tl l);
}

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

/* map fn l: map function fn over list l
 *
 * map :: (* -> **) -> [*] -> [**]
 */
map f l
	= [], l == [];
	= f (hd l) : map f (tl l);

/* map2 fn l1 l2: map two lists together with fn 
 *
 * map2 :: (* -> ** -> ***) -> [*] -> [**] -> [***]
 */
map2 fn l1 l2
	= map fn' (zip2 l1 l2)
{
	fn' p = fn p?0 p?1;
}

/* map3 fn l1 l2 l3: map three lists together with fn 
 *
 * map3 :: (* -> ** -> *** -> ****) -> [*] -> [**] -> [***] -> [****]
 */
map3 fn l1 l2 l3
	= map fn' (zip3 l1 l2 l3)
{
	fn' p = fn p?0 p?1 p?2;
}

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

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

/* 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;

/* scan fn st l: apply (fold fn r) to every initial segment of a list
 *
 * scan add 0 [1,2,3] == [1,3,6]
 * scan :: (* -> ** -> *) -> * -> [**] -> [*]
 */
scan fn 
	= g 
{
	g st l
		= [st], l == []
		= st : g (fn st (hd l)) (tl l);
}

/* 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 l2
		= l2, l1 == []
		= l1, l2 == []
		= a : merge x (b : y), comp a b
		= b : merge (a : x) y
	{
		a = hd l1;
		x = tl l1;
		b = hd l2;
		y = tl l2;
	}
}

/* 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 pl a b
		= true, pl == []
		= ta, ta != tb
		= test (tl pl) a b
	{
		ta = pl?0 a;
		tb = pl?0 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 fn
 *
 * split is_space "hello world" == ["hello", "world"]
 * split :: (* -> bool) -> [*] -> [[*]]
 */
split fn l
        = [], l == []
        = head : split fn tail
{ 
        nfn = not @ fn;
  
        l' = dropwhile fn l;
        head = takewhile nfn l';
        tail = dropwhile nfn 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 fnl l 
        = l, fnl == []
        = head : splitpl (tl fnl) tail
{
        head = takewhile (hd fnl) l;
        tail = dropwhile (hd fnl) l;
}

/* split_lines n l: split a list into equal length lines
 *
 * split_lines 4 "1234567" == ["1234", "567"]
 * splitl :: int -> [*] -> [[*]]
 */
split_lines n l
        = [], 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 l 
	= [], n <= 0
	= [], l == []
	= hd l : take (n-1) (tl l);

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

/* zip2 l1 l2: zip two lists together
 *
 * zip2 [1,2] ['a', 'b', 'c'] == [[1,'a'],[2,'b']]
 * zip2 :: [*] -> [**] -> [[*,**]]
 */
zip2 l1 l2
	= [], l1 == [] || l2 == []
	= [hd l1, hd l2] : zip2 (tl l1) (tl l2);

/* zip3 l1 l2 l3: zip three lists together
 *
 * zip3 [1,2] ['a', 'b', 'c'] [true] == [[1,'a',true]]
 * zip3 :: [*] -> [**] ->[***] -> [[*,**,***]]
 */
zip3 l1 l2 l3
	= [], l1 == [] || l2 == [] || l3 == []
	= [hd l1, hd l2, hd l3] : zip3 (tl l1) (tl l2) (tl l3);