ListImpl.mesa
"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
Edited by Paul Rovner on May 13, 1983 10:21 am
DIRECTORY
Atom USING [GetPName],
List USING [AList, DottedPair, DottedPairNode, Comparison, CompareProc, Cons, Memb, Nconc1],
PrincOps USING [zDCOMP],
Rope USING [ROPE, Compare]
;
ListImpl: CEDAR PROGRAM
IMPORTS Atom, List, Rope
EXPORTS List =
BEGIN OPEN List;
Types
ROPE: TYPE = Rope.ROPE;
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]};
EqLists: PUBLIC PROCEDURE [l1, l2: LIST OF REF ANY] 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 RETURN[FALSE];
l1 ← l1.rest;
l2 ← l2.rest;
ENDLOOP;
RETURN[l2 = NIL];
}; -- of EqLists
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
AssocList operations: DotCons Assoc PutAssoc
DotCons: PUBLIC PROCEDURE [key, val: REF ANY] RETURNS [DottedPair] = {
RETURN[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 ← 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 {
PrincOps.zDCOMP };
END.