StdCollections.Mesa
Last tweaked by Mike Spreitzer on October 19, 1987 1:45:28 pm PDT
DIRECTORY Basics, Collections, List;
StdCollections:
CEDAR
PROGRAM
IMPORTS Collections, List
EXPORTS Collections
=
BEGIN OPEN Collections;
LexicalOrdering: TYPE ~ REF LexicalOrderingPrivate;
LexicalOrderingPrivate: TYPE ~ RECORD [prefix, repeat: OrderingList];
LexOrdering:
PUBLIC
PROC [prefix, repeat: OrderingList]
RETURNS [Ordering] ~ {
lo: LexicalOrdering ~ NEW [LexicalOrderingPrivate ← [prefix, repeat]];
RETURN [[LexicalCompare, lo]]};
LexicalCompare:
PROC [data:
REF
ANY, elt1, elt2: Value]
RETURNS [c: Basics.Comparison] ~ {
lo: LexicalOrdering ~ NARROW[data];
l1: LOV ← NARROW[elt1];
l2: LOV ← NARROW[elt2];
ol: OrderingList ← lo.prefix;
WHILE l1#
NIL
AND l2#
NIL
DO
IF ol=NIL THEN {ol ← lo.repeat; IF ol=NIL THEN ERROR};
IF (c ← ol.first.Compare[ol.first.data, l1.first, l2.first])#equal THEN RETURN;
l1 ← l1.rest;
l2 ← l2.rest;
ol ← ol.rest;
ENDLOOP;
RETURN [
SELECT
TRUE
FROM
l1#NIL => greater,
l2#NIL => less,
ENDCASE => equal];
};
Negate:
PUBLIC
PROC [pos: Collection]
RETURNS [neg: Collection] ~ {
neg ← [negClasses[pos.MutabilityOf], pos.Refify];
RETURN};
NegClasses: TYPE ~ ARRAY Mutability OF CollectionClass;
negClasses: REF NegClasses ~ NEW [NegClasses];
NegPrimitive:
PROC [coll: Collection, op:
ATOM, args: ArgList]
RETURNS [PrimitiveAnswer] ~ {
pos: Collection ~ DeRef[coll.data];
SELECT op
FROM
$HasMember, $Copy, $Insulate, $ValueOf, $SpaceOf => RETURN[IF pos.QualityOf[op, args]>cant THEN yes ELSE no];
$AddColl => RETURN[IF pos.QualityOf[$RemoveColl]>cant THEN yes ELSE no];
$RemoveColl => RETURN[IF pos.QualityOf[$AddColl]>cant THEN yes ELSE no];
ENDCASE => RETURN[pass];
};
NegHasMember:
PROC [coll: Collection, elt: Value]
RETURNS [
BOOL] ~ {
pos: Collection ~ DeRef[coll.data];
RETURN [NOT pos.HasMember[elt]]};
NegCopy:
PROC [coll: Collection]
RETURNS [VarColl] ~ {
pos: Collection ~ DeRef[coll.data];
RETURN pos.Copy.Negate.AsVar};
NegInsulate:
PROC [coll: Collection]
RETURNS [UWColl] ~ {
pos: Collection ~ DeRef[coll.data];
RETURN pos.Insulate.Negate.AsUW};
NegValueOf:
PROC [coll: Collection]
RETURNS [ConstColl] ~ {
pos: Collection ~ DeRef[coll.data];
RETURN pos.ValueOf.Negate.AsConst};
NegFreeze:
PROC [coll: Collection]
RETURNS [const: ConstColl] ~ {
pos: Collection ~ DeRef[coll.data];
RETURN pos.Freeze.Negate.AsConst};
NegThaw:
PROC [coll: Collection] ~ {
pos: Collection ~ DeRef[coll.data];
pos.Thaw[];
RETURN};
NegAddColl:
PROC [coll, other: Collection, where: Where]
RETURNS [someNew, allNew:
BOOL] ~ {
pos: Collection ~ DeRef[coll.data];
hadSome, hadAll: BOOL;
[hadSome, hadAll] ← pos.RemoveColl[other];
someNew ← hadSome;
allNew ← hadAll;
RETURN};
NegRemoveColl:
PROC [coll, other: Collection, style: RemoveStyle]
RETURNS [hadSome, hadAll:
BOOL] ~ {
pos: Collection ~ DeRef[coll.data];
someNew, allNew: BOOL;
[someNew, allNew] ← pos.AddColl[other];
hadSome ← someNew;
hadAll ← allNew;
RETURN};
NegSpaceOf:
PROC [coll: Collection]
RETURNS [Space] ~ {
pos: Collection ~ DeRef[coll.data];
RETURN pos.SpaceOf[]};
CreateConditional:
PUBLIC
PROC [cond: Condition, coll: Collection]
RETURNS [UWColl] ~ {
cc: CondColl ~ NEW [CondCollPrivate ← [cond, coll]];
RETURN [[[condClasses[coll.MayDuplicate[]], cc]]]};
CondClasses: TYPE ~ ARRAY --mayDuplicate--BOOL OF CollectionClass;
condClasses: REF CondClasses ~ NEW [CondClasses];
CondColl: TYPE ~ REF CondCollPrivate;
CondCollPrivate: TYPE ~ RECORD [cond: Condition, coll: Collection];
CondPrimitive:
PROC [coll: Collection, op:
ATOM, args: ArgList]
RETURNS [PrimitiveAnswer] ~ {
cc: CondColl ~ NARROW[coll.data];
SELECT op
FROM
$HasMember, $Scan, $Size, $ValueOf, $PreserveValue => RETURN [IF cc.coll.QualityOf[op, args]>=goodDefault THEN yes ELSE no];
ENDCASE => RETURN [pass];
};
CondHasMember:
PROC [coll: Collection, elt: Value]
RETURNS [
BOOL] ~ {
cc: CondColl ~ NARROW[coll.data];
RETURN [cc.cond.Eval[] AND cc.coll.HasMember[elt]]};
CondScan:
PROC [coll: Collection,
Test: Tester, bkwd:
BOOL]
RETURNS [MaybeValue] ~ {
cc: CondColl ~ NARROW[coll.data];
IF NOT cc.cond.Eval[] THEN RETURN [noMaybe];
RETURN cc.coll.Scan[Test, bkwd]};
CondSize:
PROC [coll: Collection, limit:
LNAT ←
LNAT.
LAST]
RETURNS [
LNAT] ~ {
cc: CondColl ~ NARROW[coll.data];
IF NOT cc.cond.Eval[] THEN RETURN [0];
RETURN cc.coll.Size[limit]};
CondValueOf:
PROC [coll: Collection]
RETURNS [ConstColl] ~ {
cc: CondColl ~ NARROW[coll.data];
IF NOT cc.cond.Eval[] THEN RETURN [emptySet];
RETURN cc.coll.ValueOf[]};
CondSpaceOf:
PROC [coll: Collection]
RETURNS [Space] ~ {
cc: CondColl ~ NARROW[coll.data];
RETURN cc.coll.SpaceOf[]};
CondPreserveValue:
PROC [coll: Collection, val: Value]
RETURNS [Value] ~ {
cc: CondColl ~ NARROW[coll.data];
RETURN cc.coll.PreserveValue[val]};
TList: TYPE ~ RECORD [head, tail: LOV];
Lyst: TYPE ~ REF LystPrivate;
LystPrivate:
TYPE ~
RECORD [
size: LNAT,
space: Space,
ordering: Ordering,
vals: TList,
freezeCount: NATURAL ← 0
];
CreateList:
PUBLIC
PROC [vals:
LOV, space: Space ← refs, mayDuplicate:
BOOL ←
TRUE, mutability: Mutability ← variable, orderStyle: OrderStyle ← none, ordering: Ordering ← unordered]
RETURNS [coll: Collection] ~ {
realOrder: Ordering ~ IF orderStyle#value OR ordering#unordered THEN ordering ELSE SpaceOrdering[space];
l: Lyst ~
NEW [LystPrivate ← [
size: 0,
space: space,
ordering: realOrder,
vals: [vals, NIL]]];
tail: LOV ← NIL;
FOR vals ← vals, vals.rest WHILE vals#NIL DO l.size ← l.size+1; tail ← vals ENDLOOP;
l.vals.tail ← tail;
coll ← [listClasses[mayDuplicate][orderStyle][variable], l];
SELECT mutability
FROM
variable => NULL;
readonly => ERROR Error["you turkey, I told you not to try to make a readonly list, but you did it anyway, so now you pay", NIL];
constant => coll ← coll.Freeze;
ENDCASE => ERROR;
RETURN};
ListClasses: TYPE ~ ARRAY --mayDuplicate--BOOL OF ARRAY OrderStyle OF ARRAY Mutability OF CollectionClass;
listClasses: REF ListClasses ~ NEW [ListClasses];
LystHasMember:
PROC [coll: Collection, elt: Value]
RETURNS [
BOOL] ~ {
l: Lyst ~ NARROW[coll.data];
IF coll.MutabilityOf=constant AND l.freezeCount=0 THEN Complain[coll, unfrozen];
FOR vals:
LOV ← l.vals.head, vals.rest
WHILE vals#
NIL
DO
IF l.space.SpaceEqual[elt, vals.first] THEN RETURN [TRUE];
ENDLOOP;
RETURN [FALSE]};
ScanLyst:
PROC [coll: Collection,
Test: Tester, bkwd:
BOOL]
RETURNS [MaybeValue] ~ {
l: Lyst ~ NARROW[coll.data];
IF coll.MutabilityOf=constant AND l.freezeCount=0 THEN Complain[coll, unfrozen];
FOR vals:
LOV ← l.vals.head, vals.rest
WHILE vals#
NIL
DO
IF Test[vals.first] THEN RETURN [[TRUE, vals.first]];
ENDLOOP;
RETURN [noMaybe]};
LystSize:
PROC [coll: Collection, limit:
LNAT ←
LNAT.
LAST]
RETURNS [
LNAT] ~ {
l: Lyst ~ NARROW[coll.data];
IF coll.MutabilityOf=constant AND l.freezeCount=0 THEN Complain[coll, unfrozen];
RETURN [l.size]};
LystCopy:
PROC [coll: Collection]
RETURNS [VarColl] ~ {
l: Lyst ~ NARROW[coll.data];
IF coll.MutabilityOf=constant AND l.freezeCount=0 THEN Complain[coll, unfrozen];
RETURN CreateList[List.Append[l.vals.head, NIL], l.space, coll.MayDuplicate, variable, coll.OrderStyleOf, l.ordering].AsVar;
};
InsulateLyst:
PROC [coll: Collection]
RETURNS [UWColl] ~ {
l: Lyst ~ NARROW[coll.data];
IF coll.MutabilityOf=constant AND l.freezeCount=0 THEN Complain[coll, unfrozen];
RETURN AsUW[[listClasses[coll.MayDuplicate][coll.OrderStyleOf][readonly], l]];
};
ValueOfLyst:
PROC [coll: Collection]
RETURNS [ConstColl] ~ {
l: Lyst ~ NARROW[coll.data];
IF coll.MutabilityOf=constant AND l.freezeCount=0 THEN Complain[coll, unfrozen];
RETURN CreateList[List.Append[l.vals.head, NIL], l.space, coll.MayDuplicate, constant, coll.OrderStyleOf, l.ordering].AsConst;
};
FreezeLyst:
PROC [coll: Collection]
RETURNS [const: ConstColl] ~ {
l: Lyst ~ NARROW[coll.data];
l.freezeCount ← l.freezeCount+1;
RETURN AsConst[[listClasses[coll.MayDuplicate][coll.OrderStyleOf][constant], l]]};
ThawLyst:
PROC [coll: Collection] ~ {
l: Lyst ~ NARROW[coll.data];
SELECT l.freezeCount
FROM
>0 => l.freezeCount ← l.freezeCount-1;
=0 => Complain[coll, "attempt to thaw a non-frozen variable collection %g"];
ENDCASE => ERROR;
RETURN};
LystAddColl:
PROC [coll, other: Collection, where: Where]
RETURNS [someNew, allNew:
BOOL] ~ {
l: Lyst ~ NARROW[coll.data];
GetT:
PROC
RETURNS [tl: TList
--with bogus first element--] ~ {
Addit:
PROC [val: Value] ~ {
tl.tail ← tl.tail.rest ← LIST[other.PreserveValue[val]];
l.size ← l.size+1};
tl.head ← tl.tail ← LIST[NIL];
other.Enumerate[Addit];
IF tl.head#tl.tail THEN someNew ← TRUE;
RETURN};
AddToFront:
PROC ~ {
tl: TList ~ GetT[];
tl.tail.rest ← l.vals.head;
IF l.vals.tail=NIL AND tl.tail#tl.head THEN l.vals.tail ← tl.tail;
l.vals.head ← tl.head.rest;
RETURN};
IF l.freezeCount>0 THEN Complain[coll, frozen];
someNew ← FALSE;
allNew ← TRUE;
SELECT coll.OrderStyleOf
FROM
none => AddToFront[];
client =>
WITH where
SELECT
FROM
x: Where[any] => AddToFront[];
x: Where[end] =>
SELECT x.end
FROM
front => AddToFront[];
back => {
tl: TList ~ GetT[];
IF l.vals.tail#NIL THEN l.vals.tail.rest ← tl.head.rest ELSE l.vals.head ← tl.head.rest;
IF tl.head#tl.tail THEN l.vals.tail ← tl.tail;
RETURN};
ENDCASE => ERROR;
x: Where[rel] => {
prev: LOV ← NIL;
cur: LOV ← l.vals.head;
space: Space ~ l.space;
tl: TList ~ GetT[];
WHILE cur#NIL AND NOT space.SpaceEqual[cur.first, x.elt] DO prev ← cur; cur ← cur.rest ENDLOOP;
IF cur=NIL THEN ERROR;
SELECT x.reln
FROM
before => {
tl.tail.rest ← cur;
IF prev#NIL THEN prev.rest ← tl.head.rest ELSE l.vals.head ← tl.head.rest;
RETURN};
after => {
IF cur.rest=NIL AND tl.head#tl.tail THEN l.vals.tail ← tl.tail;
tl.tail.rest ← cur.rest;
cur.rest ← tl.head.rest;
RETURN};
ENDCASE => ERROR;
};
ENDCASE => ERROR;
value => {
o: Ordering ~ l.ordering;
oldSize: NATURAL ~ l.size;
this, prev: LOV ← NIL;
cur: LOV ← l.vals.head;
Addit:
PROC [val: Value ←] ~
INLINE {
this: LOV ~ CONS[other.PreserveValue[val], cur];
IF prev#NIL THEN prev.rest ← this ELSE l.vals.head ← this;
prev ← this;
l.size ← l.size+1;
IF cur=NIL THEN l.vals.tail ← this;
};
MergeElt:
PROC [val: Value] ~ {
WHILE cur#
NIL
DO
SELECT o.Compare[o.data, val, cur.first]
FROM
less => {Addit[val]; RETURN};
equal => {
eq: BOOL ~ l.space.SpaceEqual[val, cur.first];
IF NOT eq THEN allNew ← FALSE;
IF coll.MayDuplicate OR NOT eq THEN Addit[val];
RETURN};
greater => NULL;
ENDCASE => ERROR;
prev ← cur; cur ← cur.rest;
ENDLOOP;
Addit[val];
RETURN};
AddElt:
PROC [val: Value] ~ {
prev ← NIL;
cur ← l.vals.head;
WHILE cur#
NIL
DO
SELECT o.Compare[o.data, val, cur.first]
FROM
less => {Addit[val]; RETURN};
equal => {
eq: BOOL ~ l.space.SpaceEqual[val, cur.first];
IF NOT eq THEN allNew ← FALSE;
IF coll.MayDuplicate OR NOT eq THEN Addit[val];
RETURN};
greater => NULL;
ENDCASE => ERROR;
prev ← cur; cur ← cur.rest;
ENDLOOP;
Addit[val];
RETURN};
other.Enumerate[IF other.OrderStyleOf=value AND other.OrderingOf=o THEN MergeElt ELSE AddElt];
IF l.size#oldSize THEN someNew ← TRUE;
RETURN};
ENDCASE => ERROR;
};
LystRemoveColl:
PROC [coll, other: Collection, style: RemoveStyle]
RETURNS [hadSome, hadAll:
BOOL] ~ {
l: Lyst ~ NARROW[coll.data];
goners: NATURAL ← 0;
FilterVals:
PROC ~ {
prev: LOV ← NIL;
FOR cur:
LOV ← l.vals.head, cur.rest
WHILE cur#
NIL
DO
IF other.HasMember[cur.first]
THEN {
IF prev=NIL THEN l.vals.head ← cur.rest ELSE prev.rest ← cur.rest;
goners ← goners+1}
ELSE prev ← cur;
ENDLOOP;
l.vals.tail ← prev;
l.size ← l.size-goners;
hadSome ← goners#0;
hadAll ← other.Can[$Size] AND other.Size[]=goners;
RETURN};
RemoveElts:
PROC ~ {
RemoveElt:
PROC [val: Value] ~ {
prev: LOV ← NIL;
gone: BOOL ← FALSE;
FOR cur:
LOV ← l.vals.head, cur.rest
WHILE cur#
NIL
DO
IF l.space.SpaceEqual[val, cur.first]
THEN {
IF prev=NIL THEN l.vals.head ← cur.rest ELSE prev.rest ← cur.rest;
gone ← TRUE;
goners ← goners+1;
IF cur=l.vals.tail THEN l.vals.tail ← prev;
SELECT style FROM any, one, first => EXIT; all => NULL; ENDCASE => ERROR;
}
ELSE prev ← cur;
ENDLOOP;
IF gone THEN hadSome ← TRUE ELSE hadAll ← FALSE;
RETURN};
other.Enumerate[RemoveElt];
l.size ← l.size - goners;
RETURN};
IF l.freezeCount>0 THEN Complain[coll, frozen];
hadSome ← FALSE;
hadAll ← TRUE;
IF other.data=l
THEN {
hadSome ← l.size#0;
l.size ← 0;
l.vals ← [NIL, NIL];
RETURN};
IF coll.MayDuplicate AND style IN [one..first] OR other.MayDuplicate THEN RemoveElts[] ELSE FilterVals[];
RETURN};
SpaceOfLyst:
PROC [coll: Collection]
RETURNS [Space] ~ {
l: Lyst ~ NARROW[coll.data];
RETURN [l.space]};
OrderingOfLyst:
PROC [coll: Collection]
RETURNS [Ordering] ~ {
l: Lyst ~ NARROW[coll.data];
RETURN [l.ordering]};
Isn: TYPE ~ REF IsnPrivate;
IsnPrivate:
TYPE ~
RECORD [
a, b: Collection,
scanA: BB ← ALL[TRUE]];
isnClasses: ARRAY --mayDuplicate--BOOL OF ARRAY OrderStyle OF ARRAY UnwriteableMutability OF CollectionClass;
Intersection:
PUBLIC
PROC [a, b: Collection]
RETURNS [Collection] ~ {
IF a=passAll THEN RETURN [b];
IF b=passAll THEN RETURN [a];
{i: Isn ~ NEW [IsnPrivate ← [a, b]];
mayDuplicate: BOOL ← FALSE;
orderStyle: OrderStyle;
mutability: Mutability ~ IF a.MutabilityOf=constant AND b.MutabilityOf=constant THEN constant ELSE readonly;
FOR bkwd:
BOOL
IN
BOOL
DO
qA: ImplQuality ~ i.a.QualityOf[$Scan, LIST[FromBool[bkwd]]];
qB: ImplQuality ~ i.b.QualityOf[$Scan, LIST[FromBool[bkwd]]];
scanee: Collection ~ IF qA >= qB THEN a ELSE b;
i.scanA[bkwd] ← qA >= qB;
IF scanee.MayDuplicate THEN mayDuplicate ← TRUE;
IF bkwd=BOOL.FIRST THEN orderStyle ← scanee.OrderStyleOf ELSE IF orderStyle#scanee.OrderStyleOf THEN orderStyle ← none;
ENDLOOP;
RETURN [[isnClasses[mayDuplicate][orderStyle][mutability], i]]}};
IsnHasMember:
PROC [coll: Collection, elt: Value]
RETURNS [
BOOL] ~ {
i: Isn ~ NARROW[coll.data];
RETURN [i.a.HasMember[elt] AND i.b.HasMember[elt]]};
IsnScan:
PROC [coll: Collection,
Test: Tester, bkwd:
BOOL]
RETURNS [MaybeValue] ~ {
i: Isn ~ NARROW[coll.data];
Doit:
PROC [scan, test: Collection]
RETURNS [MaybeValue] ~ {
Pass:
PROC [val: Value]
RETURNS [pass:
BOOL ←
FALSE] ~ {
pass ← test.HasMember[val] AND Test[val];
RETURN};
RETURN scan.Scan[Pass, bkwd]};
IF i.scanA[bkwd] THEN RETURN Doit[i.a, i.b] ELSE RETURN Doit[i.b, i.a]};
IsnValueOf:
PROC [coll: Collection]
RETURNS [ConstColl] ~ {
i: Isn ~ NARROW[coll.data];
RETURN i.a.ValueOf.Intersection[i.b.ValueOf].AsConst};
IsnSpaceOf:
PROC [coll: Collection]
RETURNS [space: Space] ~ {
i: Isn ~ NARROW[coll.data];
IF (space ← i.a.SpaceOf)#NIL THEN RETURN;
space ← i.b.SpaceOf;
RETURN};
IsnOrderingOf:
PROC [coll: Collection]
RETURNS [Ordering] ~ {
i: Isn ~ NARROW[coll.data];
RETURN i.a.OrderingOf[];
};
IsnPreserveValue:
PROC [coll: Collection, val: Value]
RETURNS [Value] ~ {
i: Isn ~ NARROW[coll.data];
RETURN i.a.PreserveValue[val]};
Start:
PROC ~ {
FOR m: Mutability
IN Mutability
DO
negClasses[m] ← CreateClass[[
Primitive: NegPrimitive,
HasMember: NegHasMember,
Copy: NegCopy,
Insulate: IF m=variable THEN NegInsulate ELSE NIL,
ValueOf: IF m#constant THEN NegValueOf ELSE NIL,
Freeze: IF m=variable THEN NegFreeze ELSE NIL,
Thaw: IF m=variable THEN NegThaw ELSE NIL,
AddColl: IF m=variable THEN NegAddColl ELSE NIL,
RemoveColl: IF m=variable THEN NegRemoveColl ELSE NIL,
SpaceOf: NegSpaceOf,
mutability: m]];
ENDLOOP;
FOR mayDuplicate:
BOOL
IN
BOOL
DO
condClasses[mayDuplicate] ← CreateClass[[
Primitive: CondPrimitive,
HasMember: CondHasMember,
Scan: CondScan,
Size: CondSize,
ValueOf: CondValueOf,
PreserveValue: CondPreserveValue,
mayDuplicate: mayDuplicate,
mutability: readonly]];
FOR orderStyle: OrderStyle
IN OrderStyle
DO
FOR m: UnwriteableMutability
IN UnwriteableMutability
DO
isnClasses[mayDuplicate][orderStyle][m] ← CreateClass[[
HasMember: IsnHasMember,
Scan: IsnScan,
ValueOf: IF m#constant THEN IsnValueOf ELSE NIL,
SpaceOf: IsnSpaceOf,
OrderingOf: IsnOrderingOf,
PreserveValue: IsnPreserveValue,
mayDuplicate: mayDuplicate,
orderStyle: orderStyle,
mutability: m]];
ENDLOOP;
FOR m: Mutability
IN Mutability
DO
listClasses[mayDuplicate][orderStyle][m] ← CreateClass[[
HasMember: LystHasMember,
Scan: ScanLyst,
Size: LystSize,
Copy: LystCopy,
Insulate: IF m=variable THEN InsulateLyst ELSE NIL,
ValueOf: IF m#constant THEN ValueOfLyst ELSE NIL,
Freeze: IF m=variable THEN FreezeLyst ELSE NIL,
Thaw: IF m=variable THEN ThawLyst ELSE NIL,
AddColl: IF m=variable THEN LystAddColl ELSE NIL,
RemoveColl: IF m=variable THEN LystRemoveColl ELSE NIL,
SpaceOf: SpaceOfLyst,
OrderingOf: OrderingOfLyst,
mayDuplicate: mayDuplicate,
orderStyle: orderStyle,
mutability: m]];
ENDLOOP;
ENDLOOP;
ENDLOOP;
};
Start[];
END.