## paired-lists.pkg
#
# Various analogs of the regular list 'fold_backward' 'fold_forward'
# etc functions which operate in parallel upon two Lists
# instead of on a single list.
#
# For vanilla List ops see:
#
# src/lib/std/src/list.pkg# Compiled by:
# src/lib/std/src/standard-core.sublib### "For the sin they do by two and two
### they must pay for one by one."
###
### -- Rudyard Kipling
package paired_lists
: (weak) Paired_Lists # Paired_Lists is from src/lib/std/src/paired-lists.api{
exception UNEQUAL_LENGTHS;
# For inlining:
#
fun reverse l
=
loop (l, [])
where
fun loop ([], acc) => acc;
loop (a ! r, acc) => loop (r, a ! acc);
end;
end;
# ([a, b, c, ...], [a', b', c', ...]) -> [(a,a'), (b,b'), (c,c'), ...]
#
fun zip (l1, l2)
=
zip' (l1, l2, [])
where
fun zip' ((a ! r1), (b ! r2), l) => zip' (r1, r2, (a, b) ! l);
zip' (_, _, l) => reverse l;
end;
end;
# Same as above, except we complain
# if input lists are different lengths,
# instead of silently ignoring any excess:
#
fun zip_eq (l1, l2)
=
zip' (l1, l2, [])
where
fun zip' ((a ! r1), (b ! r2), l) => zip' (r1, r2, (a, b) ! l);
zip' ([], [], l) => reverse l;
zip' _ => raise exception UNEQUAL_LENGTHS;
end;
end;
# [(a,a'), (b,b'), (c,c')] -> ([a, b, c], [a', b', c'])
#
fun unzip l
=
unzip' (reverse l, [], [])
where
fun unzip' ([], l1, l2) => (l1, l2);
unzip' ((a, b) ! r, l1, l2) => unzip' (r, a ! l1, b ! l2);
end;
end;
fun map f
=
\\ (l1, l2) = mapf (l1, l2, [])
where
fun mapf (a ! r1, b ! r2, l) => mapf (r1, r2, f (a, b) ! l);
mapf (_, _, l) => reverse l;
end;
end;
fun map_eq f
=
\\ (l1, l2) = mapf (l1, l2, [])
where
fun mapf (a ! r1, b ! r2, l) => mapf (r1, r2, f (a, b) ! l);
mapf ([], [], l) => reverse l;
mapf _ => raise exception UNEQUAL_LENGTHS;
end;
end;
fun apply f
=
appf
where
fun appf (a ! r1, b ! r2) => { f (a, b); appf (r1, r2); };
appf _ => ();
end;
end;
fun apply_eq f
=
appf
where
fun appf (a ! r1, b ! r2) => { f (a, b); appf (r1, r2); };
appf ([], [] ) => ();
appf _ => raise exception UNEQUAL_LENGTHS;
end;
end;
fun all prior
=
allp
where
fun allp (a ! r1, b ! r2) => prior (a, b) and allp (r1, r2);
allp _ => TRUE;
end;
end;
fun all_eq prior
=
allp
where
fun allp (a ! r1, b ! r2) => prior (a, b) and allp (r1, r2);
allp ([], [] ) => TRUE;
allp _ => FALSE;
end;
end;
fun fold_forward f init (l1, l2)
=
foldf (l1, l2, init)
where
fun foldf (x ! xs, y ! ys, accum) => foldf (xs, ys, f (x, y, accum));
foldf (_, _, accum) => accum;
end;
end;
fun foldl_eq f init (l1, l2)
=
foldf (l1, l2, init)
where
fun foldf (x ! xs, y ! ys, accum) => foldf (xs, ys, f (x, y, accum));
foldf ([], [], accum) => accum;
foldf _ => raise exception UNEQUAL_LENGTHS;
end;
end;
fun fold_backward f init (l1, l2)
=
foldf (l1, l2)
where
fun foldf (x ! xs, y ! ys) => f (x, y, foldf (xs, ys));
foldf _ => init;
end;
end;
fun foldr_eq f init (l1, l2)
=
foldf (l1, l2)
where
fun foldf (x ! xs, y ! ys) => f (x, y, foldf (xs, ys));
foldf ([], []) => init;
foldf _ => raise exception UNEQUAL_LENGTHS;
end;
end;
fun exists prior
=
existsp
where
fun existsp (a ! r1, b ! r2) => prior (a, b) or existsp (r1, r2);
existsp _ => FALSE;
end;
end;
}; # package paired_lists