## list.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_right, fold_left, 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 ! @
# See also:
# src/lib/src/list-fns.pkg### "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 SUBSCRIPT if list is not long enough.
=
{ fun loop ((e ! _), 0) => e;
loop ([], _) => raise exception SUBSCRIPT;
loop ((_ ! t), n) => loop (t, n - 1);
end;
if (n >= 0 ) loop (l, n); else raise exception SUBSCRIPT;fi;
};
fun take_n (l, n) # Return first N elements from list. Raise SUBSCRIPT if list is not long enough.
=
if (n >= 0) loop (l, n);
else raise exception SUBSCRIPT;
fi
where
fun loop (l, 0) => [];
loop ([], _) => raise exception SUBSCRIPT;
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 SUBSCRIPT if list is not long enough.
=
if (n >= 0) loop (l, n);
else raise exception SUBSCRIPT;
fi
where
fun loop (l, 0) => l;
loop ([], _) => raise exception SUBSCRIPT;
loop ((_ ! t), n) => loop (t, n - 1);
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_right (!) l2 l1;
fun cat [] => [];
cat (l ! r) => l @ cat r;
end;
fun reverse_and_prepend ([], l) => l;
reverse_and_prepend (h ! t, l) => reverse_and_prepend (t, h ! l);
end;
apply = apply;
map = map;
apply' = apply';
map' = map';
fun map_partial_fn func l
=
mapp (l, [])
where
fun mapp ([], l)
=>
reverse l;
mapp (x ! r, l)
=>
case (func x)
#
THE y => mapp (r, y ! l);
NULL => mapp (r, l);
esac;
end;
end;
fun find predicate []
=>
NULL;
find predicate (a ! rest)
=>
if (predicate a) THE a;
else find predicate rest;
fi;
end;
# Construct a return list
# containing only elements of
# given list satisfying given
# predicate:
#
fun filter predicate []
=>
[];
filter predicate (element ! rest)
=>
if (predicate element) element ! (filter predicate rest);
else (filter 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;
fold_right = fold_right;
fold_left = fold_left;
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 tabulate (len, genfn)
=
if (len < 0)
#
raise exception SIZE;
else
loop 0
where
fun loop n
=
if (n == len) [];
else (genfn n) ! (loop (n+1));
fi;
end;
fi;
fun collate 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 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