GListImpl.mesa
Copyright © 1986 by Xerox Corporation. All rights reversed.
Adapted from ListImpl.mesa by Bertrand Serlet, May 12, 1986 10:24:52 am PDT
Bertrand Serlet, May 29, 1986 11:32:13 am PDT
DIRECTORY AllocatorOps, AMTypes, GList, Rope, SafeStorage;
GListImpl: CEDAR PROGRAM
IMPORTS AllocatorOps, AMTypes, Rope, SafeStorage
EXPORTS GList =
BEGIN OPEN GList;
Types
LORA: TYPE = LIST OF REF ANY;
Type: TYPE = SafeStorage.Type;
Errors and signals
IncompatibleType: PUBLIC ERROR [ref: REF ANY] = CODE;
NotAListType: PUBLIC ERROR = CODE;
Internal checking
CheckedTypesArray: TYPE = PACKED ARRAY SafeStorage.TypeIndex OF Type ← ALL [SafeStorage.nullType];
checkedTypesArray: REF CheckedTypesArray ← NEW [CheckedTypesArray];
For a type LORT=LIST OF REF T, there is a type RLORT=RECORD [first: REF T, rest: LORT]. This record holds the correspondence RLORT -> T.
sizeOfListObjects: CARDINAL = 4;
Checks that given type is a variety of RLORT, and fills the caches regarding this type
CheckListType: PROC [type: Type] = {
IF checkedTypesArray[type]#SafeStorage.nullType THEN RETURN;
BEGIN
sonType: Type; -- REF T
IF AMTypes.UnderClass[type]#structure OR
AMTypes.NComponents[type]#2 OR
~Rope.Equal[AMTypes.IndexToName[type, 1], "first"] OR
~Rope.Equal[AMTypes.IndexToName[type, 2], "rest"] OR
AMTypes.Size[type]#sizeOfListObjects
THEN ERROR NotAListType[];
sonType ← AMTypes.IndexToType[type, 1];
sonType ← SafeStorage.GetCanonicalType[sonType];
checkedTypesArray[type] ← SafeStorage.GetCanonicalType[AMTypes.Range[sonType]]; -- we store T
END;
};
CheckIsSon: PROC [ref: REF ANY, type: Type] RETURNS [same: REF ANY] = {
IF ref=NIL THEN RETURN [NIL];
IF SafeStorage.GetCanonicalReferentType[ref]#checkedTypesArray[type]
THEN ERROR IncompatibleType[ref];
same ← ref;
};
CheckIsList: PROC [list: List, type: Type] RETURNS [lora: LORA] = {
IF list=NIL THEN RETURN [NIL];
IF SafeStorage.GetCanonicalReferentType[list]#SafeStorage.GetCanonicalType[type]
THEN ERROR IncompatibleType[list];
TRUSTED {lora ← LOOPHOLE [list]};
};
UnCheckedCons: PROC [ref: REF ANY, list: LORA, type: Type] RETURNS [cons: LORA] = TRUSTED {
cons ← LOOPHOLE [AllocatorOps.NewObject[type, sizeOfListObjects]];
cons.first ← ref;
cons.rest ← list;
};
GetType: PROC [list: List] RETURNS [type: Type] = {
IF list=NIL THEN RETURN [SafeStorage.nullType];
type ← SafeStorage.GetCanonicalReferentType[list];
CheckListType[type];
};
Predicates
Eq: PROC [x, y: REF ANY] RETURNS [BOOL] = INLINE {RETURN [x = y]};
EqLists: PUBLIC PROC [l1, l2: List] RETURNS [BOOL] = {
IF l1 = l2 THEN RETURN [TRUE];
IF l1 = NIL OR l2 = NIL THEN RETURN [FALSE];
BEGIN
type: Type ← GetType[l1];
lora1: LORA ← CheckIsList[l1, type];
lora2: LORA ← CheckIsList[l2, type];
UNTIL lora1 = NIL DO
IF lora2 = NIL THEN RETURN [FALSE];
IF Eq[lora1.first, lora2.first] THEN NULL ELSE RETURN [FALSE];
lora1 ← lora1.rest;
lora2 ← lora2.rest;
ENDLOOP;
RETURN [lora2 = NIL];
END;
};
LoraMember: 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];
};
Member: PUBLIC PROC [ref: REF ANY, list: List] RETURNS [BOOL] = {
type: Type ← GetType[list];
RETURN [LoraMember[ref, CheckIsList[list, type]]];
};
Constructors
Append: PUBLIC PROC [l1: List, l2: List ← NIL] RETURNS [List] = {
IF l1=NIL THEN RETURN [l2];
BEGIN
type: Type ← GetType[l1];
val: LORA;
lora1: LORA ← CheckIsList[l1, type];
lora2: LORA ← CheckIsList[l2, type];
z: LORA ← NIL;
val ← UnCheckedCons[lora1.first, lora2, type];
z ← val;
UNTIL (lora1 ← lora1.rest) = NIL DO
z.rest ← UnCheckedCons[lora1.first, z.rest, type];
z ← z.rest;
ENDLOOP;
RETURN [val];
END;
}; -- of Append
Copy: PUBLIC PROC [list: List] RETURNS [List] = {
RETURN [Append[list, NIL]];
};
Reverse: PUBLIC PROC [list: List] RETURNS [List] = {
type: Type ← GetType[list];
val: LORA ← NIL;
lora: LORA ← CheckIsList[list, type];
UNTIL lora = NIL DO val ← UnCheckedCons[lora.first, val, type]; lora ← lora.rest ENDLOOP;
RETURN [val];
}; -- of Reverse
Remove: PUBLIC PROC [ref: REF ANY, list: List] RETURNS [List] = {
type: Type ← GetType[list];
val: LORA;
lora: LORA ← CheckIsList[list, type];
z: LORA ← NIL;
UNTIL lora = NIL DO
IF ~Eq[lora.first, ref] THEN
{IF val = NIL THEN {val ← UnCheckedCons[lora.first, NIL, type]; z ← val}
ELSE {z.rest ← UnCheckedCons[lora.first, z.rest, type]; z ← z.rest}};
lora ← lora.rest;
ENDLOOP;
RETURN [val];
}; -- of Remove  
Union: PUBLIC PROC [l1, l2: List] RETURNS [List] = {
type: Type ← GetType[IF l1=NIL THEN l2 ELSE l1];
lora1: LORA ← CheckIsList[l1, type];
lora2: LORA ← CheckIsList[l2, type];
list: LORA ← lora2;
UNTIL lora1 = NIL DO
IF ~LoraMember[lora1.first, list] THEN list ← UnCheckedCons[lora1.first, list, type];
lora1 ← lora1.rest;
ENDLOOP;
RETURN [list];
}; -- of Union
Intersection: PUBLIC PROC [l1, l2: List] RETURNS [List] = {
type: Type ← GetType[IF l1=NIL THEN l2 ELSE l1];
lora1: LORA ← CheckIsList[l1, type];
lora2: LORA ← CheckIsList[l2, type];
list: LORA ← NIL;
UNTIL lora1 = NIL DO
IF LoraMember[lora1.first, lora2] THEN list ← UnCheckedCons[lora1.first, list, type];
lora1 ← lora1.rest;
ENDLOOP;
RETURN [list];
}; -- of Intersection
ListDifference: PUBLIC PROC [l1, l2: List] RETURNS [List] = {
type: Type ← GetType[IF l1=NIL THEN l2 ELSE l1];
lora1: LORA ← CheckIsList[l1, type];
lora2: LORA ← CheckIsList[l2, type];
list: LORA ← NIL;
IF lora2 = NIL THEN RETURN [lora1];
UNTIL lora1 = NIL DO
IF ~LoraMember[lora1.first, lora2] THEN list ← LoraNconc[list, UnCheckedCons[lora1.first, NIL, type]];
lora1 ← lora1.rest;
ENDLOOP;
RETURN [list];
}; -- of ListDifference
Constructors, but destructive to structure
LoraNconc: 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];
};
Nconc: PUBLIC PROC [l1, l2: List] RETURNS [List] = {
type: Type ← GetType[IF l1=NIL THEN l2 ELSE l1];
lora1: LORA ← CheckIsList[l1, type];
lora2: LORA ← CheckIsList[l2, type];
RETURN [LoraNconc[lora1, lora2]];
};
DReverse: PUBLIC PROC [list: List] RETURNS [List] = {
type: Type ← GetType[list];
lora: LORA ← CheckIsList[list, type];
l1, l2, l3: LORA ← NIL;
IF list = NIL THEN RETURN [NIL];
l3 ← lora;
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: List] RETURNS [List] = {
type: Type ← GetType[list];
lora: LORA ← CheckIsList[list, type];
l, l1: LORA ← NIL;
l ← lora;
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 [lora];
};
l1 ← l;
l ← l.rest;
ENDLOOP;
RETURN [lora];
}; -- of Dremove;
DSubst: PUBLIC PROC [new, old: REF ANY, list: List] RETURNS [List] = {
type: Type ← GetType[list];
lora: LORA ← CheckIsList[list, type];
IF lora = NIL THEN RETURN [NIL];
new ← CheckIsSon[new, type];
FOR l: LORA ← lora, l.rest UNTIL l = NIL DO
IF Eq[l.first, old] THEN l.first ← new;
ENDLOOP;
RETURN [lora];
}; -- of DSubst
Extractors
NthTail: PUBLIC PROC [list: List, n: INT] RETURNS [List] = {
type: Type ← GetType[list];
lora: LORA ← CheckIsList[list, type];
IF n=0 THEN RETURN [lora];
IF lora = NIL THEN RETURN [NIL];
IF n > 0 THEN THROUGH [0..n) DO
lora ← lora.rest;
IF lora = NIL THEN RETURN [NIL];
REPEAT FINISHED => RETURN [lora];
ENDLOOP
ELSE
{lead: LORA ← CheckIsList[NthTail[lora, -n], type];
UNTIL lead = NIL DO lead ← lead.rest; lora ← lora.rest ENDLOOP;
RETURN [lora];
};
}; -- of NthTail
NthElement: PUBLIC PROC [list: List, n: INT] RETURNS [REF ANY] = {
type: Type ← GetType[list];
tail: List;
IF n=0 THEN ERROR;
tail ← NthTail[list, IF n > 0 THEN n-1 ELSE n];
IF tail = NIL THEN ERROR;
RETURN [CheckIsList[tail, type].first];
}; -- of NthElement
Miscellaneous
Length: PUBLIC PROC [list: List] RETURNS [n: INT ← 0] = {
type: Type ← GetType[list];
lora: LORA ← CheckIsList[list, type];
UNTIL lora = NIL DO n ← n+1; lora ← lora.rest ENDLOOP;
};
Subst: PUBLIC PROC [new, old: REF ANY, list: List] RETURNS [List] = {
type: Type ← GetType[list];
lora: LORA ← CheckIsList[list, type];
head, tail: LORA ← NIL;
new ← CheckIsSon[new, type];
WHILE lora # NIL DO
cons: LORA ← UnCheckedCons[IF lora.first = old THEN new ELSE lora.first, NIL, type];
IF tail = NIL THEN head ← cons ELSE tail.rest ← cons;
tail ← cons;
lora ← lora.rest;
ENDLOOP;
RETURN [head];
};
Kill: PUBLIC PROC [list: List] = {
type: Type ← GetType[list];
lora: LORA ← CheckIsList[list, type];
WHILE lora # NIL
DO next: LORA ← lora.rest; lora.rest ← NIL; lora.first ← NIL; lora ← next ENDLOOP;
};
Sorting
Sort: PUBLIC PROC [list: List, compareProc: CompareProc] RETURNS [List] = {
... 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 ← LoraMerge[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 ← LoraMerge[new, mid, compareProc];
IF next = NIL THEN RETURN;
ENDLOOP;
};
type: Type ← GetType[list];
lora: LORA ← CheckIsList[list, type];
IF lora = NIL OR lora.rest = NIL THEN RETURN [lora];
RETURN [InnerSort[lora, 32].new];
};
LoraMerge: 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: List, compareProc: CompareProc] RETURNS [List] = {
type: Type ← GetType[list];
lora: LORA ← CheckIsList[list, type];
lag: LORA ← lora ← CheckIsList[Sort[lora, compareProc], type];
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 [lora];
};
Merge: PROC [x, y: LORA, compareProc: CompareProc] RETURNS [List] = {
type: Type ← GetType[IF x=NIL THEN y ELSE x];
RETURN [LoraMerge[CheckIsList[x, type], CheckIsList[y, type], compareProc]];
};
END.