"List" routines: facilities for creating objects which carry an indication of their type along with them, especially typed lists.
Edited by Teitelman on October 29, 1982 5:53 pm
DIRECTORY
AMBridge USING [TVForReferent],
AMTypes USING [Class, IndexToType, NComponents, Range, TVType, TypeClass, UnderType],
Atom USING [GetPName],
List USING [AList, Comparison, CompareProc, Cons, DottedPair, DottedPairNode, Memb, Nconc1],
Mopcodes USING [zDCOMP],
RefAnyOps USING [EqualRefs],
Rope USING [ROPE, Compare],
RTTypesBasic USING [Type, EquivalentTypes, nullType],
SafeStorage USING [NewZone]
;
ListImpl: CEDAR PROGRAM
IMPORTS AMBridge, AMTypes, Atom, RefAnyOps, List, Rope, RTTypesBasic, SafeStorage
EXPORTS List =
BEGIN OPEN RefAnyOps, List;
Types
ROPE: TYPE = Rope.ROPE;
Zone: PUBLIC ZONE ← SafeStorage.NewZone[quantized]; -- quantized zone used for storing new ListNodes, such as those created by append, reverse, etc.
NotATail: PUBLIC SIGNAL [list, tailOfList: LIST OF REF ANY] RETURNS[LIST OF REF ANY] = CODE;
Predicates: Eq, IsAList, IsAListOfRefAny, EqLists, Member
Eq: PROC [x, y: REF ANY] RETURNS[BOOLEAN] = INLINE {RETURN[x = y]};
IsAList:
PUBLIC
PROC [ref:
REF
ANY ←
NIL, underType: RTTypesBasic.Type ← RTTypesBasic.nullType]
RETURNS [result:
BOOLEAN] = {
uses TVs Interface to test whthere or not ref is a list type. UnderType is the type of the referent of ref. If underType is supplied, ref is ignored. If UnderType=NIL and ref is not-NIL, undertype will be computed. If both ref and undertype are NIL, IsAList returns True.
IF ref = NIL AND underType = RTTypesBasic.nullType THEN RETURN[TRUE];
TRUSTED -- AMBridge
{
OPEN AMTypes;
IF underType = RTTypesBasic.nullType THEN underType ← UnderType[TVType[AMBridge.TVForReferent[ref]]];
RETURN[TypeClass[underType] = structure
AND
(NComponents[underType] = 2) AND
RTTypesBasic.EquivalentTypes[Range[IndexToType[underType, 2]], underType]
-- checks whether the rest field points to an object whose type is the same as the referrent of ref. Note that it is nnecessary to check to see whether TypeClass[IndexToType[underType, 2]] = list since this is a stronger test, i.e. that it is equivalent to the type of the first list node.
];
};
}; -- of IsAList
IsAListOfRefAny:
PUBLIC
PROC [ref:
REF
ANY, underType: RTTypesBasic.Type ← RTTypesBasic.nullType]
RETURNS [result:
BOOLEAN, list:
LIST
OF
REF
ANY ] =
{
IF ref = NIL THEN RETURN[TRUE, NIL];
WITH ref
SELECT
FROM
l: LIST OF REF ANY => RETURN[TRUE, l]; -- most common case. worth a special check
ENDCASE =>
TRUSTED {
OPEN AMTypes;
IF underType = RTTypesBasic.nullType THEN underType ← UnderType[TVType[AMBridge.TVForReferent[ref]]];
IF TypeClass[underType] = structure
AND
(NComponents[underType] = 2) AND
RTTypesBasic.EquivalentTypes[Range[IndexToType[underType, 2]], underType] -- checks whether the rest field points to an object whose type is the same as the referrent of ref. Note that it is nnecessary to check to see whether TypeClass[IndexToType[underType, 2]] = list since this is a stronger test, i.e. that it is equivalent to the type of the first list node.
AND
TypeClass[UnderType[IndexToType[underType,1]]] = ref -- LIST OF INTEGER would satisfy all of the tests up to here but is not polymorphic to LIST OF REF ANY
THEN RETURN[TRUE, LOOPHOLE[ref, LIST OF REF ANY]];
};
RETURN[FALSE, NIL];
}; -- of IsAListOfRefAny
EqLists:
PUBLIC
PROCEDURE [l1, l2:
LIST
OF
REF
ANY, compareLists:
BOOLEAN ←
FALSE]
RETURNS [
BOOLEAN] =
{
IF l1 = l2 THEN RETURN[TRUE];
IF l1 = NIL OR l2 = NIL THEN RETURN[FALSE];
UNTIL l1 =
NIL
DO
IF l2 = NIL THEN RETURN[FALSE];
IF Eq[l1.first, l2.first] THEN NULL
ELSE
IF compareLists
THEN
BEGIN
flg1, flg2: BOOLEAN;
l1, l2: LIST OF REF ANY;
[flg1, l1] ← IsAListOfRefAny[l1.first];
IF ~flg1 THEN RETURN[FALSE];
[flg2, l2] ← IsAListOfRefAny[l2.first];
IF ~flg2 OR ~EqLists[l1, l2] THEN RETURN[FALSE];
END
ELSE RETURN[FALSE];
l1 ← l1.rest;
l2 ← l2.rest;
ENDLOOP;
RETURN[l2 = NIL];
}; -- of EqLists
Member:
PUBLIC
PROCEDURE [ref:
REF
ANY, list:
LIST
OF
REF
ANY]
RETURNS[
BOOLEAN] =
{
UNTIL list =
NIL
DO
IF EqualRefs[list.first, ref] THEN RETURN[TRUE];
list ← list.rest;
ENDLOOP;
RETURN[FALSE];
}; -- of Member
constructors of lists: Append, Reverse, Remove, Union, Intersection, ListDifference, LDiff
Append:
PUBLIC
PROCEDURE [l1:
LIST
OF
REF
ANY, l2:
LIST
OF
REF
ANY ←
NIL]
RETURNS[val:
LIST
OF
REF
ANY] = {
z: LIST OF REF ANY ← NIL;
val ← l2;
IF l1 = NIL THEN RETURN[val];
val ← Cons[l1.first, val];
z ← val;
UNTIL (l1 ← l1.rest) =
NIL
DO
z.rest ← Cons[l1.first, z.rest];
z ← z.rest;
ENDLOOP;
RETURN[val];
}; -- of Append
Reverse:
PUBLIC
PROCEDURE [list:
LIST
OF
REF
ANY]
RETURNS[val:
LIST
OF
REF
ANY] = {
val ← NIL;
UNTIL list =
NIL
DO
val ← Cons[list.first, val];
list ← list.rest;
ENDLOOP;
RETURN[val];
}; -- of Reverse
Remove:
PUBLIC
PROCEDURE [ref:
REF
ANY, list:
LIST
OF
REF
ANY]
RETURNS[val:
LIST
OF
REF
ANY] = {
z: LIST OF REF ANY ← NIL;
val ← NIL;
UNTIL list =
NIL
DO
IF ~Eq[list.first, ref]
THEN
{IF val = NIL THEN {val ← Cons[list.first, NIL]; z ← val}
ELSE {z.rest ← Cons[list.first, z.rest]; z ← z.rest}};
list ← list.rest;
ENDLOOP;
}; -- of Remove
Union:
PUBLIC
PROCEDURE [l1, l2:
LIST
OF
REF
ANY]
RETURNS[
LIST
OF
REF
ANY] = {
l: LIST OF REF ANY ← l2;
UNTIL l1 =
NIL
DO
IF ~Memb[l1.first, l] THEN l ← Cons[l1.first, l];
l1 ← l1.rest;
ENDLOOP;
RETURN[l];
}; -- of Union
Intersection:
PUBLIC
PROCEDURE [l1, l2:
LIST
OF
REF
ANY]
RETURNS[
LIST
OF
REF
ANY] = {
l: LIST OF REF ANY ← NIL;
UNTIL l1 =
NIL
DO
IF Memb[l1.first, l2] THEN l ← Cons[l1.first, l];
l1 ← l1.rest;
ENDLOOP;
RETURN[l];
}; -- of Intersection
ListDifference:
PUBLIC
PROCEDURE [l1, l2:
LIST
OF
REF
ANY]
RETURNS[
LIST
OF
REF
ANY] = {
all elements in l1 not in l2
l: LIST OF REF ANY ← NIL;
IF l2 = NIL THEN RETURN[l1];
UNTIL l1 =
NIL
DO
IF ~Memb[l1.first, l2] THEN l ← Nconc1[l, l1.first];
l1 ← l1.rest;
ENDLOOP;
RETURN[l];
}; -- of ListDifference
LDiff:
PUBLIC
PROCEDURE [list, tailOfList:
LIST
OF
REF
ANY]
RETURNS[
LIST
OF
REF
ANY] = {
tailOfx must be a tail of x, i.e. eq to some number of cdrs of x, or else an error is raised. Returns a x of those elements in x up to tailOfx. If tailOfx is NIL, returns x. Otherwise, always returns new structure
endOfL, l: LIST OF REF ANY ← NIL;
IF tailOfList = NIL THEN RETURN[list];
UNTIL list =
NIL
DO
IF list = tailOfList THEN RETURN[l];
IF endOfL =
NIL
THEN {l ← Cons[list.first,
NIL]; endOfL ← l}
ELSE {endOfL.rest ← Cons[list.first, NIL]; endOfL ← endOfL.rest};
list ← list.rest;
ENDLOOP;
RETURN[SIGNAL NotATail[list, tailOfList]];
}; -- of LDiff
like some constructors, but destructive to structure: Nconc, DReverse, DRemove, DSubst.
Nconc:
PUBLIC
PROCEDURE [l1, l2:
LIST
OF
REF
ANY]
RETURNS[
LIST
OF
REF
ANY] = {
z: LIST OF REF ANY ← l1;
IF z = NIL THEN RETURN[l2];
UNTIL z.rest =
NIL
DO
z ← z.rest;
ENDLOOP;
z.rest ← l2;
RETURN[l1];
}; -- of Nconc
DReverse:
PUBLIC
PROCEDURE [list:
LIST
OF
REF
ANY]
RETURNS[
LIST
OF
REF
ANY] = {
destructivell2 reverses list. copied from Lisp DREVERSE function
l1, l2, l3:
LIST
OF
REF
ANY ←
NIL;
IF list = NIL THEN RETURN[NIL];
l3 ← list;
UNTIL (l1 ← l3) =
NIL
DO
l3 ← l3.rest;
l1.rest ← l2;
l2 ← l1;
ENDLOOP;
RETURN[l2];
}; -- of Dreverse
DRemove:
PUBLIC
PROCEDURE [ref:
REF
ANY, list:
LIST
OF
REF
ANY]
RETURNS[
LIST
OF
REF
ANY] = {
l, l1: LIST OF REF ANY ← NIL;
l ← list;
UNTIL l =
NIL
DO
IF Eq[l.first, ref]
THEN {
IF l1 = NIL THEN RETURN[l.rest]; -- ref was first object on list
l1.rest ← l.rest;
RETURN[list];
};
l1 ← l;
l ← l.rest;
ENDLOOP;
RETURN [list];
}; -- of Dremove;
DSubst:
PUBLIC
PROC [new, old:
REF
ANY, expr:
LIST
OF
REF
ANY]
RETURNS[
LIST
OF
REF
ANY] = {
IF expr = NIL THEN RETURN[NIL];
FOR l: LIST OF REF ANY ← expr, l.rest UNTIL l = NIL DO
IF Eq[l.first, old]
THEN
l.first ← new;
WITH l.first
SELECT
FROM
z: LIST OF REF ANY => l.first ← DSubst[new,old,z];
ENDCASE;
ENDLOOP;
RETURN[expr];
}; -- of DSubst
extractors: NthTail NthElement
NthTail:
PUBLIC
PROCEDURE[list:
LIST
OF
REF
ANY, n:
INT]
RETURNS[
LIST
OF
REF
ANY] = {
IF n=0 THEN RETURN[list];
IF list = NIL THEN RETURN[NIL];
IF n > 0
THEN
THROUGH [0..n)
DO
list ← list.rest;
IF list = NIL THEN RETURN[NIL];
REPEAT
FINISHED => RETURN[list];
ENDLOOP
ELSE
{lead: LIST OF REF ANY ← NthTail[list, -n];
UNTIL lead =
NIL
DO
lead ← lead.rest;
list ← list.rest;
ENDLOOP;
RETURN[list];
};
}; -- of NthTail
NthElement:
PUBLIC
PROCEDURE[list:
LIST
OF
REF
ANY, n:
INT]
RETURNS[
REF
ANY] = {
tail: LIST OF REF ANY;
IF n=0 THEN ERROR;
IF n > 0
THEN
{tail ← NthTail[list, n-1];
IF tail = NIL THEN ERROR;
RETURN[tail.first];
}
ELSE tail ← NthTail[list, n];
IF tail = NIL THEN ERROR;
RETURN[tail.first];
}; -- of NthElement
Alist operations: DotCons Assoc PutAssoc
DotCons:
PUBLIC
PROCEDURE [key, val:
REF
ANY]
RETURNS [DottedPair] =
{
RETURN[Zone.NEW[DottedPairNode ← [key, val]]];
}; -- of DotCons
Assoc:
PUBLIC
PROCEDURE [key:
REF
ANY, aList: AList]
RETURNS[
REF
ANY] =
{
UNTIL aList =
NIL
DO
IF Eq[aList.first.key , key] THEN RETURN[aList.first.val];
aList ← aList.rest;
ENDLOOP;
RETURN[NIL];
}; -- of Assoc
PutAssoc:
PUBLIC
PROCEDURE [key:
REF
ANY, val:
REF
ANY, aList: AList]
RETURNS[AList] =
{
x, x1: AList ← NIL;
x ← aList;
UNTIL x =
NIL
DO
IF Eq[x.first.key, key]
THEN
BEGIN
x.first.val ← val;
RETURN[aList];
END;
x1←x;
x ← x.rest;
ENDLOOP;
key not found on x
x ← Zone.CONS[DotCons[key, val], NIL];
IF x1 =
NIL
THEN
RETURN[x]
ELSE IF x1.rest = NIL THEN x1.rest ← x -- add at end
ELSE ERROR ; -- defensive programming
RETURN[aList];
}; -- of PutAssoc
miscellaneous: Length Map Subst
Length:
PUBLIC
PROCEDURE [list:
LIST
OF
REF
ANY]
RETURNS[
INT] = {
n: INT ← 0;
UNTIL list =
NIL
DO
n ← n+1;
list ← list.rest;
ENDLOOP;
RETURN[n];
}; -- of Length
Map:
PUBLIC
PROC [list:
LIST
OF
REF
ANY, proc:
PROCEDURE[
REF
ANY,
LIST
OF
REF
ANY] ] = {
FOR l:
LIST
OF
REF
ANY ← list, l.rest
UNTIL l =
NIL
DO
proc[l.first, l];
ENDLOOP;
}; -- of Map
Subst:
PUBLIC
PROC [new, old:
REF
ANY, expr:
LIST
OF
REF
ANY]
RETURNS[
LIST
OF
REF
ANY] = {
IF expr = NIL THEN RETURN[NIL]
ELSE
RETURN[Cons
[
IF Eq[old, expr.first] THEN new
ELSE
WITH expr.first
SELECT
FROM
l: LIST OF REF ANY => Subst[new, old, l],
ENDCASE => expr.first, -- should copy
IF expr.rest = NIL THEN NIL ELSE Subst[new, old, expr.rest]
]
];
}; -- of Subst
Sorting:
Sort:
PUBLIC
PROC [list:
LIST
OF
REF
ANY, compareProc: CompareProc]
RETURNS [LIST OF REF ANY] = {
The sort is destructive and NOT stable, that is, the relative positions in the result of
nodes with equal keys is unpredictible. For a nondestructive sort, copy l first.
The sort does one CONS.
a, b, mergeTo: LIST OF REF ANY;
mergeToCons: LIST OF REF ANY = CONS[NIL, NIL];
max: CARDINAL = 22; --number of bits in word-address space minus 2
lists:
ARRAY [0..max)
OF
LIST
OF
REF
ANY ←
ALL [
NIL];
lists[0] is a sorted list of length 2 or NIL, lists[1] is a sorted list of length
4 or NIL, lists[2] is a sorted list of length 8 or NIL, etc.
When Sort returns, lists = ALL [NIL] again (we do some extra work to assure this).
x: CARDINAL; --[0..max]
xMax: CARDINAL ← 0; --[0..max)
make each pair of consecutive elements of l into a sorted list of length 2,
then merge it into lists.
UNTIL (a ← list) =
NIL
OR (b ← a.rest) =
NIL
DO
list ← b.rest;
IF compareProc[a.first, b.first] = less
THEN {
a.rest ← b;
b.rest ← NIL;
}
ELSE {
b.rest ← a;
a.rest ← NIL;
a ← b;
};
x ← 0;
DO
IF (b ← lists[x]) =
NIL
THEN {
lists[x] ← a; EXIT }
ELSE {
--merge (equal length) lists a and b
lists[x] ← NIL;
mergeTo ← mergeToCons;
DO
--assert a#NIL, b#NIL
IF compareProc[a.first, b.first] = less
THEN {
mergeTo.rest ← a; mergeTo ← a;
IF (a ← a.rest) = NIL THEN { mergeTo.rest ← b; EXIT } }
ELSE {
mergeTo.rest ← b; mergeTo ← b;
IF (b ← b.rest) = NIL THEN { mergeTo.rest ← a; EXIT } }
ENDLOOP;
a ← mergeToCons.rest;
x ← x+1;
IF x > xMax AND (xMax ← x) = max THEN ERROR }
ENDLOOP;
ENDLOOP;
xMax now contains the largest x such that lists[x] # NIL.
if l's length was even, a = NIL; if l's length was odd, a = single element list.
merge a and elements of lists into result (held in a).
x ← 0;
IF a =
NIL
THEN {
try to make a # NIL.
UNTIL (lists[x] # NIL OR x = xMax) DO x ← x+1 ENDLOOP;
a ← lists[x]; lists[x] ← NIL; x ← x+1 };
a # NIL OR x > xMax.
UNTIL x > xMax
DO
IF (b ← lists[x]) #
NIL
THEN {
lists[x] ← NIL;
mergeTo ← mergeToCons;
DO
a#NIL AND b#NIL
IF compareProc[a.first, b.first] = less
THEN {
mergeTo.rest ← a; mergeTo ← a;
IF (a ← a.rest) = NIL THEN { mergeTo.rest ← b; EXIT } }
ELSE {
mergeTo.rest ← b; mergeTo ← b;
IF (b ← b.rest) = NIL THEN { mergeTo.rest ← a; EXIT } }
ENDLOOP;
a ← mergeToCons.rest };
x ← x+1;
ENDLOOP;
RETURN [a]
}; --Sort
UniqueSort:
PUBLIC
PROC [list:
LIST
OF
REF
ANY, compareProc: CompareProc]
RETURNS[
LIST
OF
REF
ANY] = {
l: LIST OF REF ANY;
IF list = NIL THEN RETURN[NIL];
l ← list ← Sort[list, compareProc];
DO
IF l.rest = NIL THEN EXIT;
IF compareProc[l.first, l.rest.first] = equal THEN l.rest ← l.rest.rest
ELSE l ← l.rest;
ENDLOOP;
RETURN[list];
};
Compare:
PUBLIC CompareProc = {
IF ref1 =
NIL
THEN
RETURN[Rope.Compare[s1: NARROW[ref1, ROPE], s2: NARROW[ref2, ROPE], case: TRUE]];
WITH ref1
SELECT
FROM
rope: ROPE => RETURN[Rope.Compare[s1: rope, s2: NARROW[ref2, ROPE], case: TRUE]];
rli: REF INT => RETURN[CompareINT[rli^, NARROW[ref2, REF INT]^]];
atom: ATOM => RETURN[Rope.Compare[s1: Atom.GetPName[atom], s2: Atom.GetPName[NARROW[ref2, ATOM]], case: TRUE]];
ENDCASE => ERROR
};
CompareINT:
PROC [int1, int2:
INT]
RETURNS [Comparison] =
TRUSTED
MACHINE
CODE {
Mopcodes.zDCOMP };
END.
26-Mar-82 10:44:56 Changed calls to EqRefs to Eq, which is defined as an inline =. (except Member, in which EqRefs -> EqualRefs).
June 29, 1982 10:56 am extended Compare to handle atoms.