## list-indexing.pkg
#
# Utility functions for managing lists indexed by integers.
# Compiled by:
# src/lib/x-kit/widget/xkit-widget.sublib### "There is no excellent beauty
### that hath not some strangeness
### in the proportion."
###
### -- Francis Bacon
# This package gets used in:
#
# src/lib/x-kit/widget/old/lib/button-group.pkg# src/lib/x-kit/widget/old/wrapper/choice-of-widgets.pkg# src/lib/x-kit/widget/old/leaf/item-list.pkg# src/lib/x-kit/widget/old/layout/line-of-widgets.pkgstipulate
package lms = list_mergesort; # list_mergesort is from src/lib/src/list-mergesort.pkgherein
package list_indexing
: (weak) List_Indexing # List_Indexing is from src/lib/x-kit/widget/old/lib/list-indexing.api {
exception BAD_INDEX;
fun find prior cl
=
gv (0, cl)
where
fun gv (_,[])
=>
[];
gv (i, w ! rest)
=>
case (prior (i, w))
THE v => v ! (gv (i+1, rest));
NULL => gv (i+1, rest);
esac;
end;
end;
fun is_valid (l, index)
=
if (index < 0) FALSE;
else check (0, l);
fi
where
fun check (j,[]) => j == index;
check (j, _ ! rest) => j == index or check (j+1, rest);
end;
end;
fun keyed_find (l, i)
=
f (l, 0)
where
fun f ([], _)
=>
raise exception BAD_INDEX;
f (a ! rest, j)
=>
i == j ?? a
:: f (rest, j+1);
end;
end;
fun compare (i, j: Int)
=
if (i < j) LESS;
elif (i == j) EQUAL;
else GREATER;
fi;
sort = lms::sort_list int::(>);
sorted = lms::list_is_sorted int::(>);
#
usort = lms::sort_list_and_drop_duplicates compare;
fun usorted [] => TRUE;
usorted [_ : Int] => TRUE;
#
usorted (x ! (rest as (y ! _))) => x < y and usorted rest;
end;
fun check_sort [] => [];
check_sort (l as [_]) => l;
check_sort (l as [i, j]) => if (i <= j ) l; else [j, i];fi;
check_sort l => if (sorted l) l; else sort l;fi;
end;
fun check_usort []
=>
[];
check_usort (l as [_])
=>
l;
check_usort (l as [i, j])
=>
if (i < j ) l;
elif (i == j) [i];
else [j, i];
fi;
check_usort l
=>
usorted l ?? l
:: usort l;
end;
# do_map: List(X) * (X -> X) * List( Int ) -> List(X)
# Apply mapfn to items whose index is in index list
# Assume il is sorted in non-decreasing order
#
fun do_map (cl, mapfn, il)
=
domap (0, cl, il)
where
fun domap (_, l, [])
=>
l;
domap (_, [], _)
=>
raise exception BAD_INDEX;
domap (j, c ! cl', il as i ! il')
=>
if (i < j) raise exception BAD_INDEX;
elif (i == j) (mapfn c) ! (domap (j+1, cl', il'));
else c ! (domap (j+1, cl', il));
fi;
end;
end;
# delete: List(X) * List( Int ) -> List(X) * List(X)
# Remove all items whose index appears in the
# list of integers.
#
fun delete (cl, il)
=
del (0, cl, il)
where
fun del (_, l, []) => (l, []);
del(_, [], _) => raise exception BAD_INDEX;
del (j, c ! cl', il as i ! il')
=>
if (i < j) raise exception BAD_INDEX;
elif (i == j)
my (l, d) = del (j+1, cl', il');
(l, c ! d);
else
my (l, d) = del (j+1, cl', il);
(c ! l, d);
fi;
end;
end;
fun set (cl, index, boxel)
=
if (index < 0)
raise exception BAD_INDEX;
else
ins (index, cl)
where
fun ins (0, l) => boxel @ l;
ins (i, x ! r) => x ! (ins (i - 1, r));
ins (i, []) => raise exception BAD_INDEX;
end;
end;
fi;
fun pre_indices (index: Int, il)
=
loop (0, il)
where
fun loop (count, []) => THE count;
loop (count, i ! l)
=>
if (i < index) loop (count+1, l);
elif (i == index) NULL;
else THE count;
fi;
end;
end;
};
end;
## COPYRIGHT (c) 1992 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.