## list-mergesort.pkg
#
# List sorting routines using a smooth applicative merge sort
# Taken from, ML for the Working Programmer, LCPaulson. pg 99-100
# Compiled by:
# src/lib/std/src/standard-core.sublib### "The middle way cannot be achieved
### by dividing two extremes in half."
###
### -- Eric Maisel
package list_mergesort
: (weak) List_Sort # List_Sort is from src/lib/src/list-sort.api{
fun sort_list ((>) : (X, X) -> Bool) ls
=
case ls
[] => [];
_ => samsorting (ls, [], 0);
esac
where
fun merge ([], ys) => ys;
merge (xs, []) => xs;
merge (x ! xs, y ! ys)
=>
if (x > y) y ! merge (x ! xs, ys);
else x ! merge (xs, y ! ys);
fi;
end;
fun merge_pairs (ls as [l], k)
=>
ls;
merge_pairs (l1 ! l2 ! ls, k)
=>
if (k % 2 == 1) l1 ! l2 ! ls;
else merge_pairs (merge (l1, l2) ! ls, k / 2);
fi;
merge_pairs _
=>
raise exception DIE "ListSort::sort";
end;
fun next_run (run,[]) => (reverse run,[]);
next_run (run, x ! xs) => if (x > head run) next_run (x ! run, xs);
else (reverse run, x ! xs);
fi;
end;
fun samsorting ([], ls, k)
=>
head (merge_pairs (ls, 0));
samsorting (x ! xs, ls, k)
=>
{ (next_run([x], xs))
->
(run, tail);
samsorting (tail, merge_pairs (run ! ls, k+1), k+1);
};
end;
end;
fun sort_list_and_drop_duplicates cmpfn ls
=
case ls
[] => [];
_ => samsorting (ls, [], 0);
esac
where
fun merge ([], ys) => ys;
merge (xs,[]) => xs;
merge (x ! xs, y ! ys)
=>
case (cmpfn (x, y))
#
GREATER => y ! merge (x ! xs, ys);
EQUAL => merge (x ! xs, ys);
_ => x ! merge (xs, y ! ys);
esac;
end;
fun merge_pairs (ls as [l], k)
=>
ls;
merge_pairs (l1 ! l2 ! ls, k)
=>
if (k % 2 == 1) l1 ! l2 ! ls;
else merge_pairs (merge (l1, l2) ! ls, k / 2);
fi;
merge_pairs _
=>
raise exception DIE "ListSort::uniqueSort";
end;
fun next_run (run, [])
=>
(reverse run,[]);
next_run (run, x ! xs)
=>
case (cmpfn (x, head run))
#
GREATER => next_run (x ! run, xs);
EQUAL => next_run (run, xs);
_ => (reverse run, x ! xs);
esac;
end;
fun samsorting ([], ls, k)
=>
head (merge_pairs (ls, 0));
samsorting (x ! xs, ls, k)
=>
{ (next_run([x], xs))
->
(run, tail);
samsorting (tail, merge_pairs (run ! ls, k+1), k+1);
};
end;
end;
fun sort_list_and_find_duplicates compare list
=
{ sorted = sort_list (\\ (a,b) = (compare(a,b)==LESS)) list;
#
find_dups (sorted, [])
where
fun eat_dups (a, b ! rest) # Drop all leading 'a's from second arg.
=>
if (compare (a, b) == EQUAL) eat_dups (a, rest); # Found an 'a' -- drop it and continue.
else rest;
fi;
eat_dups (a, rest)
=>
rest;
end;
fun find_dups (a ! (rest as (b ! _)), dups_found)
=>
if (compare (a,b) == EQUAL) find_dups (eat_dups (a, rest), a ! dups_found);
else find_dups ( rest, dups_found);
fi;
find_dups (_, results)
=>
results; # 'results' will be in ascending order.
end;
end;
};
fun list_is_sorted (>)
=
s
where
fun s (x ! (rest as (y ! _)))
=>
not (x>y) and s rest;
s l => TRUE;
end;
end;
}; # list_mergesort
## COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See SMLNJ-COPYRIGHT file for details.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.