## list.pkg
#
# List(X) type and core operations on lists.
#
# See also:
#
# src/lib/std/src/paired-lists.pkg# src/lib/src/list-mergesort.pkg# Compiled by:
# src/lib/std/src/standard-core.sublib# The following are defined in
#
# src/lib/core/init/pervasive.pkg#
# and consequently available unqualified
# at top level:
#
# type List
# my NIL, ! , hd, tl, null, length, @, apply, map, fold_backward, fold_forward, reverse
#
# The following are defined in this file
# and consequently not available unqualified
# at top level:
#
# exception EMPTY
# my last, nth, take_n, drop_n, cat, reverse_and_prepend, map_partial_fn, find, filter,
# partition, exists, all, tabulate
#
# The following infix declarations will hold at top level:
# infixr 60 ! @
### "One can even conjecture that Lisp
### owes its survival specifically to
### the fact that its programs are lists,
### which everyone, including me,
### has regarded as a disadvantage."
###
### -- John McCarthy, "Early History of Lisp"
package list
: (weak) List # List is from src/lib/std/src/list.api{ # inline_t is from src/lib/core/init/built-in.pkg my (+) = inline_t::default_int::(+);
my (-) = inline_t::default_int::(-);
my (<) = inline_t::default_int::(<);
my (<=) = inline_t::default_int::(<=);
my (>) = inline_t::default_int::(>);
my (>=) = inline_t::default_int::(>=);
# op = = inline_t::(=)
List == List; # Import List into this package from src/lib/core/init/pervasive.pkg exception EMPTY = EMPTY;
null = null;
head = head;
tail = tail;
fun last [] => raise exception EMPTY; # Return last element in list. Raise EMPTY if list is empty.
last [x] => x;
last (_ ! r) => last r;
end;
fun get_item [] => NULL;
get_item (x ! r) => THE (x, r);
end;
fun nth (l, n) # Return n-th element from list. Raise INDEX_OUT_OF_BOUNDS if list is not long enough.
=
{ fun loop ((e ! _), 0) => e;
loop ([], _) => raise exception INDEX_OUT_OF_BOUNDS;
loop ((_ ! t), n) => loop (t, n - 1);
end;
if (n >= 0) loop (l, n);
else raise exception INDEX_OUT_OF_BOUNDS;
fi;
};
fun take_n (l, n) # Return first N elements from list. Raise INDEX_OUT_OF_BOUNDS if list is not long enough.
=
if (n >= 0) loop (l, n);
else raise exception INDEX_OUT_OF_BOUNDS;
fi
where
fun loop (l, 0) => [];
loop ([], _) => raise exception INDEX_OUT_OF_BOUNDS;
loop ((x ! t), n) => x ! loop (t, n - 1);
end;
end;
fun drop_n (l, n) # Drop first N elements from list, return remainder. Raise INDEX_OUT_OF_BOUNDS if list is not long enough.
=
if (n >= 0) loop (l, n);
else raise exception INDEX_OUT_OF_BOUNDS;
fi
where
fun loop (l, 0) => l;
loop ([], _) => raise exception INDEX_OUT_OF_BOUNDS;
loop ((_ ! t), n) => loop (t, n - 1);
end;
end;
fun split_n (l, n)
=
{ if (n < 0) raise exception INDEX_OUT_OF_BOUNDS; fi;
#
split_n' (l, n);
}
where
fun split_n' (l, 0)
=>
([], l);
split_n' (a ! rest, n)
=>
{ (split_n' (rest, n - 1))
->
(p, s);
(a ! p, s);
};
split_n' _ => raise exception INDEX_OUT_OF_BOUNDS;
end;
end;
length = length;
reverse = reverse;
# my op (@) = op (@);
#
# The above stopped working, so the below replicates the original definition XXX BUGGO FIXME
#
fun l1 @ l2
=
fold_backward (!) l2 l1;
fun cat [] => [];
cat (l ! r) => l @ cat r;
end;
# list-fns had the following as its equivalent
# to 'cat' -- is it fundamentally more efficient
# than (or just more vebose than) the above? -- 2012-03-19 CrT
#
# fun flatten []
# =>
# [];
#
# flatten [l]
# =>
# l;
#
# flatten ll
# =>
# flat (ll, [])
# where
# fun flat ([], l) => reverse l;
# flat (ll ! r, l) => flat (r, flat2 (ll, l));
# end
#
# also
# fun flat2 ([], l) => l;
# flat2 (x ! r, l) => flat2 (r, x ! l);
# end;
# end;
# end;
fun reverse_and_prepend ([], l) => l; # Return result of prepending reversed first arg to untouched second arg.
reverse_and_prepend (h ! t, l) => reverse_and_prepend (t, h ! l);
end;
fun repeat (list: List(X), i: Int): List(X) # Return result of concatenating 'i' copies of 'list'.
=
repeat' (i, [])
where
fun repeat' (i, result)
=
if (i <= 0) cat result;
else repeat' (i - 1, list ! result);
fi;
end;
apply = apply;
map = map;
apply' = apply';
map' = map';
fun map_partial_fn fn l
=
mapp (l, [])
where
fun mapp ([], l)
=>
reverse l;
mapp (x ! r, l)
=>
case (fn x)
#
THE y => mapp (r, y ! l);
NULL => mapp (r, l);
esac;
end;
end;
# Return first list element satisfying given predicate else NULL:
#
fun find predicate []
=>
NULL;
find predicate (a ! rest)
=>
if (predicate a) THE a;
else find predicate rest;
fi;
end;
# Return all list elements EXCEPT first element satisfying given predicate:
#
fun remove_first predicate
=
rm
where
fun rm [] => [];
rm (a ! l)
=>
if (predicate a) l;
else a ! (rm l);
fi;
end;
end;
# Return list elements satisfying given predicate:
#
fun filter predicate []
=>
[];
filter predicate (element ! rest)
=>
if (predicate element) element ! (filter predicate rest);
else (filter predicate rest);
fi;
end;
# Return list elements NOT satisfying given predicate:
#
fun remove predicate []
=>
[];
remove predicate (element ! rest)
=>
if (predicate element) (remove predicate rest);
else element ! (remove predicate rest);
fi;
end;
fun partition predicate l
=
loop (l,[],[])
where
fun loop ([], true_list, false_list)
=>
(reverse true_list, reverse false_list);
loop (h ! t, true_list, false_list)
=>
if (predicate h) loop (t, h ! true_list, false_list);
else loop (t, true_list, h ! false_list);
fi;
end;
end;
fun split_at_first predicate
=
spl
where
fun spl (l as a ! rest)
=>
if (predicate a)
#
([], l);
else
(spl rest) -> (p, s);
(a ! p, s);
fi;
spl [] => ([], []) ;
end;
end;
fun prefix_to_first predicate l # All elements up to first matching predicate.
=
#1 (split_at_first predicate l);
fun suffix_from_first predicate [] # All elements after first matching predicate.
=>
[];
suffix_from_first predicate (a ! rest)
=>
if (predicate a) rest;
else suffix_from_first predicate rest;
fi;
end;
fold_backward = fold_backward;
fold_forward = fold_forward;
fun exists predicate
=
f
where
fun f [] => FALSE;
f (h ! t) => predicate h or f t;
end;
end;
fun all predicate
=
f
where
fun f [] => TRUE;
f (h ! t) => predicate h and f t;
end;
end;
fun from_fn (len, genfn)
=
{ if (len < 0) raise exception SIZE; fi;
#
loop 0
where
fun loop n
=
if (n == len) [];
else (genfn n) ! (loop (n+1));
fi;
end;
};
fun compare_sequences compare
=
loop
where
fun loop ([], []) => EQUAL;
loop ([], _) => LESS;
loop (_, []) => GREATER;
loop (x ! xs, y ! ys)
=>
case (compare (x, y))
#
EQUAL => loop (xs, ys);
unequal => unequal;
esac;
end;
end;
fun drop (dropme, list) # Return given list with all copies of 'dropme' removed.
=
drop' list
where
fun drop' []
=>
[];
drop' (x ! rest)
=>
if (x == dropme) drop' rest;
else x ! drop' rest;
fi;
end;
end;
fun a in [] => FALSE;
a in (this ! rest) => (a == this) or (a in rest);
end;
#
# 2008-03-25 CrT:
# This function is inspired by the similar Python operator;
# I changed Mythryl syntax to make 'in' not be a reserved
# word specifically for this function. :)
# I was originally going to put the above fun def in
# src/lib/core/init/pervasive.pkg # but that resulted in
# bin/mythryl-runtime-intel32: Fatal error -- unable to find picklehash (compiledfile identifier) '[4500880824c70d26c741e5b186aad4c1]'
# sh/make-compiler-executable: Compiler link failed, no mythryld executable
# which I didn't feel like trying to understand.
# So I settled for defining 'in' as infix in pervasive.pkg,
# defining it here, and exporting it as a scripting global in
# src/app/makelib/main/makelib-g.pkg # I'd still rather have it in pervasive.pkg, though,
# or otherwise made generally available as a global: XXX SUCKO FIXME.
#
# 2009-09-15 CrT:
# The core issue appears to be the attempt to use
# typeagnostic in/equality testing in pervasive.pkg.
}; # package list