ListImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Teitelman on October 29, 1982 5:53 pm
Rovner on May 13, 1983 10:21 am
Russ Atkinson (RRA) June 18, 1985 1:37:19 am PDT
DIRECTORY
Atom USING [GetPName],
Basics USING [CompareINT],
List USING [AList, DottedPair, DottedPairNode, Comparison, CompareProc, LORA],
Rope USING [ROPE, Compare];
ListImpl: CEDAR PROGRAM
IMPORTS Atom, Basics, Rope
EXPORTS List =
BEGIN OPEN List, Rope;
Signals: NotATail
NotATail: PUBLIC SIGNAL [list, tailOfList: LORA] RETURNS[LORA] = CODE;
Predicates: Eq, IsAList, IsAListOfRefAny, EqLists, Member
Eq: PROC [x, y: REF ANY] RETURNS[BOOL] = INLINE {RETURN[x = y]};
EqLists: PUBLIC PROC [l1, l2: LORA] RETURNS [BOOL] = {
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];
};
Memb: PUBLIC PROC [ref: REF ANY, list: LORA] RETURNS [BOOL] = {
UNTIL list = NIL DO
IF list.first = ref THEN RETURN[TRUE];
list ← list.rest;
ENDLOOP;
RETURN[FALSE];
};
constructors of lists: Append, Reverse, Remove, Union, Intersection, ListDifference, LDiff
Append: PUBLIC PROC [l1: LORA, l2: LORA ← NIL] RETURNS[val: LORA] = {
z: LORA ← 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 PROC [list: LORA] RETURNS[val: LORA] = {
val ← NIL;
UNTIL list = NIL DO
val ← CONS[list.first, val];
list ← list.rest;
ENDLOOP;
RETURN[val];
}; -- of Reverse
Remove: PUBLIC PROC [ref: REF ANY, list: LORA] RETURNS[val: LORA] = {
z: LORA ← 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 PROC [l1, l2: LORA] RETURNS[LORA] = {
l: LORA ← 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 PROC [l1, l2: LORA] RETURNS[LORA] = {
l: LORA ← 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 PROC [l1, l2: LORA] RETURNS[LORA] = {
all elements in l1 not in l2
l: LORA ← 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 PROC [list, tailOfList: LORA] RETURNS[LORA] = {
tailOflist must be a tail of list, i.e. eq to some number of cdrs of list, or else an error is raised. Returns a list of those elements in list up to tailOflist. If tailOflist is NIL, returns list. Otherwise, always returns new structure
endOfL, l: LORA ← 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]];
};
like some constructors, but destructive to structure: Nconc, DReverse, DRemove, DSubst.
Nconc: PUBLIC PROC [l1, l2: LORA] RETURNS[LORA] = {
z: LORA ← l1;
IF z = NIL THEN RETURN[l2];
UNTIL z.rest = NIL DO
z ← z.rest;
ENDLOOP;
z.rest ← l2;
RETURN[l1];
};
Nconc1: PUBLIC PROC [list: LORA, ref: REF ANY] RETURNS[LORA] = {
z: LORA ← list;
new: LORA = LIST[ref];
IF z = NIL THEN RETURN[new];
UNTIL z.rest = NIL DO
z ← z.rest;
ENDLOOP;
z.rest ← new;
RETURN[list];
};
DReverse: PUBLIC PROC [list: LORA] RETURNS[LORA] = {
destructivell2 reverses list. copied from Lisp DREVERSE function
l1, l2, l3: LORA ← 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 PROC [ref: REF ANY, list: LORA] RETURNS[LORA] = {
l, l1: LORA ← 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: LORA] RETURNS[LORA] = {
IF expr = NIL THEN RETURN[NIL];
FOR l: LORA ← expr, l.rest UNTIL l = NIL DO
IF Eq[l.first, old] THEN
l.first ← new;
WITH l.first SELECT FROM
z: LORA => l.first ← DSubst[new,old,z];
ENDCASE;
ENDLOOP;
RETURN[expr];
}; -- of DSubst
extractors: NthTail NthElement
NthTail: PUBLIC PROC[list: LORA, n: INT] RETURNS[LORA] = {
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: LORA ← NthTail[list, -n];
UNTIL lead = NIL DO
lead ← lead.rest;
list ← list.rest;
ENDLOOP;
RETURN[list];
};
}; -- of NthTail
NthElement: PUBLIC PROC[list: LORA, n: INT] RETURNS[REF ANY] = {
tail: LORA;
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 PROC [key, val: REF ANY] RETURNS [DottedPair] = {
RETURN[NEW[DottedPairNode ← [key, val]]];
};
Assoc: PUBLIC PROC [key: REF ANY, aList: AList] RETURNS[REF ANY ← NIL] = {
UNTIL aList = NIL DO
IF aList.first.key = key THEN RETURN[aList.first.val];
aList ← aList.rest;
ENDLOOP;
};
PutAssoc: PUBLIC PROC [key: REF ANY, val: REF ANY, aList: AList] RETURNS[AList] = {
lag: AList ← NIL;
new: AList ← NIL;
FOR each: AList ← aList, each.rest WHILE each # NIL DO
IF each.first.key = key THEN {each.first.val ← val; RETURN [aList]};
lag ← each;
ENDLOOP;
new ← LIST[DotCons[key, val]];
IF lag = NIL THEN aList ← new ELSE lag.rest ← new;
RETURN [aList];
};
miscellaneous: Length Map Subst
Length: PUBLIC PROC [list: LORA] RETURNS[n: INT ← 0] = {
UNTIL list = NIL DO
n ← n+1;
list ← list.rest;
ENDLOOP;
};
Map: PUBLIC PROC [list: LORA, proc: PROC[REF ANY, LORA] ] = {
WHILE list # NIL DO proc[list.first, list]; list ← list.rest; ENDLOOP;
};
Subst: PUBLIC PROC [new, old: REF ANY, expr: LORA] RETURNS[head: LORA ← NIL] = {
tail: LORA ← NIL;
WHILE expr # NIL DO
first: REF ← expr.first;
cons: LORA ← LIST[IF first = old THEN new ELSE old];
IF tail = NIL THEN head ← cons ELSE tail.rest ← cons;
tail ← cons;
expr ← expr.rest;
ENDLOOP;
};
Kill: PUBLIC PROC [list: LORA] = {
WHILE list # NIL DO
next: LORA ← list.rest;
list.rest ← NIL;
list.first ← NIL;
list ← next;
ENDLOOP;
};
Sorting
Sort: PUBLIC PROC [list: LORA, compareProc: CompareProc] RETURNS [LORA] = {
... destructively sorts the given list in increasing order according to compareProc. The sort is not stable, so order of equal elements is not preserved.
innerSort: PROC [head: LORA, max: NAT] RETURNS [new, next: LORA] = {
First, grab the first pair of elements off the head of the list and make sure that they are sorted. If there is only one element, we return it immediately. If there are only two elements in the list first sort them, then return them.
mid: LORA ← (new ← head).rest;
IF mid = NIL THEN RETURN;
next ← mid.rest;
IF compareProc[new.first, mid.first] = greater THEN {
The first two nodes are in the wrong order, so swap them, leaving new pointing at the lesser of the two, and mid pointing at the greater.
mid.rest ← new; new ← mid; mid ← head;
};
mid.rest ← NIL;
IF next = NIL THEN RETURN;
Second, grab the second pair of elements off the list. We have already checked, and there is at least one.
next ← (mid ← next).rest;
IF next # NIL THEN {
There are two elements for the second pair, so we need to put them in order.
temp: LORA ← next;
next ← temp.rest;
temp.rest ← NIL;
IF compareProc[mid.first, temp.first] = greater THEN {
The first two nodes are in the wrong order, so swap them.
mid.rest ← NIL; temp.rest ← mid; mid ← temp}
};
Third, merge the two lead lists. If this exhausts the original list, then return.
new ← Merge[new, mid, compareProc];
IF next = NIL THEN RETURN;
Finally, build up the tree by progressively building small lists and merging them into larger lists. The size doubles at each level. We start with new holding onto a list of 4 elements, and next holding onto the remainder of the list.
FOR depth: NAT IN [2..max) DO
[mid, next] ← innerSort[next, depth];
new ← Merge[new, mid, compareProc];
IF next = NIL THEN RETURN;
ENDLOOP;
};
IF list = NIL OR list.rest = NIL THEN RETURN [list];
RETURN [innerSort[list, 32].new];
};
Merge: PUBLIC PROC [x,y: LORA, compareProc: CompareProc] RETURNS [new: LORA] = {
... destructively merges two lists according to compareProc. If the input lists are sorted in increasing order, then the output list will be sorted in increasing order.
Implementation notes:
RC assignments are limited by preserving runs of elements in order.
tail: LORA ← NIL;
Test for empty lists
IF x = NIL THEN RETURN [y];
IF y = NIL THEN RETURN [x];
new ← x;
IF compareProc[x.first, y.first] = greater THEN {new ← y; y ← x; x ← new};
Start from y, which we do by swapping x and y.
DO
We first assume that we have just appended from x, but need to advance x to the next element and check for emptiness. Once this is done we try to stay within x as long as the predicate allows. By doing this we reduce the amount of RC assignments of the form "tail.rest ← ...", which speeds things up considerably.
DO
tail ← x; x ← x.rest;
IF x = NIL THEN {tail.rest ← y; RETURN};
IF compareProc[x.first, y.first] = greater THEN EXIT;
ENDLOOP;
tail.rest ← y;
We have just appended from y, so append to the list from y as long as reasonable.
DO
tail ← y; y ← y.rest;
IF y = NIL THEN {tail.rest ← x; RETURN};
IF compareProc[x.first, y.first] = less THEN EXIT;
ENDLOOP;
tail.rest ← x;
ENDLOOP;
};
UniqueSort: PUBLIC PROC [list: LORA, compareProc: CompareProc] RETURNS[LORA] = {
lag: LORA ← list ← Sort[list, compareProc];
WHILE lag # NIL DO
rest: LORA ← lag.rest;
IF rest = NIL THEN EXIT;
IF compareProc[lag.first, rest.first] = equal THEN lag.rest ← rest.rest ELSE lag ← rest;
ENDLOOP;
RETURN[list];
};
Compare: PUBLIC CompareProc = {
WITH ref1 SELECT FROM
rope: ROPE => RETURN[Rope.Compare[s1: rope, s2: NARROW[ref2], case: TRUE]];
rli: REF INT => RETURN[Basics.CompareINT[rli^, NARROW[ref2, REF INT]^]];
atom: ATOM => RETURN[Rope.Compare[s1: Atom.GetPName[atom], s2: Atom.GetPName[NARROW[ref2]], case: TRUE]];
ENDCASE => IF ref1 = NIL
THEN RETURN[Rope.Compare[s1: NARROW[ref1], s2: NARROW[ref2], case: TRUE]]
ELSE ERROR;
};
END.