SetsByBiRels.Mesa
Last tweaked by Mike Spreitzer on January 25, 1988 9:39:12 am PST
DIRECTORY AbSets, BiRelBasics, BiRels, IntStuff, SetBasics;
SetsByBiRels:
CEDAR
PROGRAM
IMPORTS AbSets, BiRelBasics, BiRels, SetBasics
EXPORTS BiRels
=
BEGIN OPEN IntStuff, SetBasics, BiRelBasics, BiRels, Sets:AbSets, Sets;
SeqSet: TYPE ~ REF SeqSetPrivate;
SeqSetPrivate:
TYPE ~
RECORD [
seq: Sequence,
addat: SeqAddPlace,
closeGaps: BOOL,
space: Space,
empty: BiRel,
afterLast: INT ← 0
];
ImplementSetBySequence:
PUBLIC
PROC [seq: Sequence, addat: SeqAddPlace, closeGaps:
BOOL]
RETURNS [Set] ~ {
ss: SeqSet ~
NEW [SeqSetPrivate ← [
seq: seq,
addat: addat,
closeGaps: closeGaps,
space: seq.Spaces[][right],
empty: CreateEmptyBiRel[seq.Spaces]
]];
RETURN [[ssClasses[seq.MutabilityOf], AV[ss] ]]};
SSClasses: TYPE ~ ARRAY Mutability OF SetClass;
ssClasses: REF SSClasses ~ NEW [SSClasses];
SSHasMember:
PROC [set: Set, elt: Value]
RETURNS [
BOOL] ~ {
ss: SeqSet ~ NARROW[set.data.VA];
RETURN [ss.seq.Apply[elt, rightToLeft].found]};
SSScan:
PROC [set: Set,
Test: Tester, ro: RelOrder]
RETURNS [MaybeValue] ~ {
ss: SeqSet ~ NARROW[set.data.VA];
RETURN ss.seq.SetOn[right].Scan[Test, ro]};
SSGet3:
PROC [set: Set, elt: Value, want: TripleBool]
RETURNS [TripleMaybeValue] ~ {
ss: SeqSet ~ NARROW[set.data.VA];
tmp: TripleMaybePair ~ ss.seq.Get3[[IV[0], elt], [[no, fwd], right], [want.prev, FALSE, want.next]];
RETURN [[
prev: tmp.prev.KeepHalf[right],
same: IF ss.seq.Apply[elt, rightToLeft].found THEN [TRUE, elt] ELSE noMaybe,
next: tmp.next.KeepHalf[right]
]]};
SSSize:
PROC [set: Set, limit:
EINT]
RETURNS [
EINT] ~ {
ss: SeqSet ~ NARROW[set.data.VA];
RETURN ss.seq.Size[limit]};
SSCopy:
PROC [set: Set]
RETURNS [VarSet] ~ {
ss: SeqSet ~ NARROW[set.data.VA];
RETURN ss.seq.Copy.ImplementSetBySequence[ss.addat, ss.closeGaps].AsVar};
SSInsulate:
PROC [set: Set]
RETURNS [UWSet] ~ {
ss: SeqSet ~ NARROW[set.data.VA];
RETURN ss.seq.Insulate.ImplementSetBySequence[ss.addat, ss.closeGaps].AsUW};
SSValueOf:
PROC [set: Set]
RETURNS [ConstSet] ~ {
ss: SeqSet ~ NARROW[set.data.VA];
RETURN ss.seq.ValueOf.ImplementSetBySequence[ss.addat, ss.closeGaps].AsConst};
SSFreeze:
PROC [set: Set]
RETURNS [ConstSet] ~ {
ss: SeqSet ~ NARROW[set.data.VA];
RETURN ss.seq.Freeze.ImplementSetBySequence[ss.addat, ss.closeGaps].AsConst};
SSThaw:
PROC [set: Set] ~ {
ss: SeqSet ~ NARROW[set.data.VA];
ss.seq.Thaw[];
RETURN};
SSAddSet:
PROC [set, other: Set]
RETURNS [new: SomeAll ← []] ~ {
ss: SeqSet ~ NARROW[set.data.VA];
PerElt:
PROC [elt: Value]
RETURNS [
BOOL] ~ {
had: BOOL ~ set.HasMember[elt];
IF had
THEN new.all ←
FALSE
ELSE {
i0: INT ~ IF ss.addat=front THEN 0 ELSE ss.afterLast;
ss.seq.Insert[elt, i0];
IF ss.addat=back THEN ss.afterLast ← ss.afterLast.SUCC;
new.some ← TRUE};
RETURN [FALSE]};
IF other.Scan[PerElt].found THEN ERROR;
RETURN};
SSRemSet:
PROC [set, other: Set]
RETURNS [had: SomeAll ← []] ~ {
ss: SeqSet ~ NARROW[set.data.VA];
IF other.data = set.data
THEN {
hadSome: HadSet ~ ss.seq.RemSet[ss.seq][rightToLeft];
had ← [some: hadSome[same], all: TRUE];
ss.afterLast ← 0;
RETURN}
ELSE
IF ss.closeGaps
THEN {
PerElt:
PROC [elt: Value]
RETURNS [
BOOL] ~ {
index: MaybeValue ~ ss.seq.Apply[elt, rightToLeft];
IF index.found
THEN {
i0: INT ~ index.it.VI;
ss.seq.ReplaceMe[ss.empty, [i0, i0]];
IF ss.addat=back THEN ss.afterLast ← ss.afterLast.PRED;
had.some ← TRUE}
ELSE had.all ← FALSE;
RETURN [FALSE]};
IF other.Scan[PerElt].found THEN ERROR;
RETURN}
ELSE {
had ← ss.seq.DeleteSet[other, right];
IF ss.addat=back
THEN {
bi: MaybePairInterval ~ ss.seq.GetBounds[[FALSE, TRUE]];
ss.afterLast ← IF bi.found THEN bi.it[max][left].VI+1 ELSE 0};
RETURN};
};
SSSpaceOf:
PROC [set: Set]
RETURNS [Space] ~ {
ss: SeqSet ~ NARROW[set.data.VA];
RETURN [ss.space]};
ImplementSetByIDSubset:
PUBLIC
PROC [ids: BiRel]
RETURNS [Set] ~ {
RETURN [[isClasses[ids.MutabilityOf], AV[ids.Refify] ]]};
ISClasses: TYPE ~ ARRAY Mutability OF SetClass;
isClasses: REF ISClasses ~ NEW [ISClasses];
ISHasMember:
PROC [set: Set, elt: Value]
RETURNS [
BOOL] ~ {
ri: REF BiRel ~ NARROW[set.data.VA];
RETURN ri^.HasPair[ALL[elt]]};
ISScan:
PROC [set: Set,
Test: Tester, ro: RelOrder]
RETURNS [MaybeValue] ~ {
ri: REF BiRel ~ NARROW[set.data.VA];
Pass: PROC [pair: Pair] RETURNS [BOOL] ~ {RETURN Test[pair[left]]};
RETURN ri^.Scan[Pass, [[ro, no]]].KeepHalf[left]};
ISGetOne:
PROC [set: Set, remove:
BOOL, ro: RelOrder]
RETURNS [MaybeValue] ~ {
ri: REF BiRel ~ NARROW[set.data.VA];
RETURN ri^.GetOne[remove, [[ro, no]]].KeepHalf[left]};
ISGet3:
PROC [set: Set, elt: Value, want: TripleBool]
RETURNS [TripleMaybeValue] ~ {
ri: REF BiRel ~ NARROW[set.data.VA];
tmp: TripleMaybePair ~ ri^.Get3[ALL[elt], [[fwd, no]], want];
RETURN [[
prev: tmp.prev.KeepHalf[left],
same: tmp.same.KeepHalf[left],
next: tmp.next.KeepHalf[left] ]]};
ISSize:
PROC [set: Set, limit:
EINT]
RETURNS [
EINT] ~ {
ri: REF BiRel ~ NARROW[set.data.VA];
RETURN ri^.Size[limit]};
ISGetBounds:
PROC [set: Set, want: EndBools]
RETURNS [MaybeInterval] ~ {
ri: REF BiRel ~ NARROW[set.data.VA];
RETURN ri^.GetBounds[want].MPISide[left]};
ISCopy:
PROC [set: Set]
RETURNS [VarSet] ~ {
ri: REF BiRel ~ NARROW[set.data.VA];
RETURN ri^.Copy.ImplementSetByIDSubset.AsVar};
ISInsulate:
PROC [set: Set]
RETURNS [UWSet] ~ {
ri: REF BiRel ~ NARROW[set.data.VA];
RETURN ri^.Insulate.ImplementSetByIDSubset.AsUW};
ISValueOf:
PROC [set: Set]
RETURNS [ConstSet] ~ {
ri: REF BiRel ~ NARROW[set.data.VA];
RETURN ri^.ValueOf.ImplementSetByIDSubset.AsConst};
ISFreeze:
PROC [set: Set]
RETURNS [ConstSet] ~ {
ri: REF BiRel ~ NARROW[set.data.VA];
RETURN ri^.Freeze.ImplementSetByIDSubset.AsConst};
ISThaw:
PROC [set: Set] ~ {
ri: REF BiRel ~ NARROW[set.data.VA];
ri^.Thaw;
RETURN};
ISAddSet:
PROC [set, other: Set]
RETURNS [new: SomeAll] ~ {
ri: REF BiRel ~ NARROW[set.data.VA];
some: HadSetPair ~ ri^.AddSet[CreateIDSubset[other]];
IF some[leftToRight][different] THEN ERROR;
RETURN [[some: some[leftToRight][none], all: NOT some[leftToRight][same]]]};
ISRemSet:
PROC [set, other: Set]
RETURNS [had: SomeAll] ~ {
ri: REF BiRel ~ NARROW[set.data.VA];
some: HadSet ~ ri^.RemSet[CreateIDSubset[other]][leftToRight];
IF some[different] THEN ERROR;
RETURN [[some: some[same], all: NOT some[none] ]]};
ISSpaceOf:
PROC [set: Set]
RETURNS [Space] ~ {
ri: REF BiRel ~ NARROW[set.data.VA];
RETURN [ri^.Spaces[][left]]};
Start:
PROC ~ {
FOR mut: Mutability
IN Mutability
DO
ssClasses[mut] ← CreateClass[
cp: [
HasMember: SSHasMember,
Scan: SSScan,
Get3: SSGet3,
Size: SSSize,
Copy: SSCopy,
Insulate: IF mut=variable THEN SSInsulate ELSE NIL,
ValueOf: IF mut#constant THEN SSValueOf ELSE NIL,
Freeze: IF mut=variable THEN SSFreeze ELSE NIL,
Thaw: IF mut=variable THEN SSThaw ELSE NIL,
AddSet: IF mut=variable THEN SSAddSet ELSE NIL,
RemSet: IF mut=variable THEN SSRemSet ELSE NIL,
SpaceOf: SSSpaceOf,
mutability: mut
],
relable: ALL[TRUE]
];
isClasses[mut] ← CreateClass[
cp: [
HasMember: ISHasMember,
Scan: ISScan,
GetOne: ISGetOne,
Get3: ISGet3,
Size: ISSize,
GetBounds: ISGetBounds,
Copy: ISCopy,
Insulate: IF mut=variable THEN ISInsulate ELSE NIL,
ValueOf: IF mut#constant THEN ISValueOf ELSE NIL,
Freeze: IF mut=variable THEN ISFreeze ELSE NIL,
Thaw: IF mut=variable THEN ISThaw ELSE NIL,
AddSet: IF mut=variable THEN ISAddSet ELSE NIL,
RemSet: IF mut=variable THEN ISRemSet ELSE NIL,
SpaceOf: ISSpaceOf,
mutability: mut
],
relable: ALL[TRUE]
];
ENDLOOP;
};
Start[];
END.