DIRECTORY Atom, IntStuff, List, SetBasics, AbSets;

SetsSimpleImpl: CEDAR PROGRAM
IMPORTS IntStuff, List, SetBasics, AbSets
EXPORTS AbSets
=

BEGIN OPEN IntStuff, SetBasics, Sets:AbSets, Sets;

CreateEmptySet: PUBLIC PROC [space: Space] RETURNS [ConstSet] ~ {
RETURN AsConst[[emptyClass, AV[space]]]};

emptyClass: SetClass ~ CreateClass[
cp: [
HasMember: EmptyHasMember,
Scan: EmptyScan,
Get3: EmptyGet3,
Size: EmptySize,
IsDense: EmptyIsDense,
SpaceOf: EmptySpaceOf,
mutability: constant],
relable: ALL[TRUE]
];

EmptyHasMember: PROC [set: Set, elt: Value] RETURNS [BOOL]
~ {RETURN [FALSE]};

EmptyScan: PROC [set: Set, Test: Tester, ro: RelOrder] RETURNS [MaybeValue]
~ {RETURN [noMaybe]};

EmptyGet3: PROC [set: Set, elt: Value, want: TripleBool] RETURNS [TripleMaybeValue]
~ {RETURN [[noMaybe, noMaybe, noMaybe]]};

EmptySize: PROC [set: Set, limit: EINT] RETURNS [EINT] ~ {RETURN [zero]};

EmptyIsDense: PROC [set: Set, when: When] RETURNS [BOOL] ~ {RETURN [TRUE]};

EmptySpaceOf: PROC [set: Set] RETURNS [Space] ~ {
RETURN [NARROW[set.data.VA]]};

NCreateSingleton: PUBLIC PROC [elt: Value, space: Space] RETURNS [ConstSet]
~ {RETURN CreateSingleton[elt, space]};

IsSingletonClass: PUBLIC PROC [sc: SetClass] RETURNS [BOOL]
~ {RETURN [sc.HasMember = SingletonHasMember]};

singletonKey: ATOM ~ $SetsSimpleImplSingletonClass;
GetSingletonClass: PUBLIC PROC [space: Space] RETURNS [class: SetClass] ~ {
Update: PROC [old: Atom.PropList] RETURNS [new: Atom.PropList] ~ {
new _ old;
class _ NARROW[List.Assoc[key: singletonKey, aList: new]];
IF class=NIL THEN {
class _ CreateClass[
cp: [
HasMember: SingletonHasMember,
Scan: SingletonScan,
TheElt: SingletonTheElt,
GetOne: SingletonGetOne,
Get3: SingeltonGet3,
Size: SingletonSize,
IsDense: SingletonIsDense,
GetBounds: SingletonGetBounds,
SpaceOf: SingletonSpaceOf,
mutability: constant,
data: space],
relable: ALL[TRUE]
];
new _ List.PutAssoc[key: singletonKey, val: class, aList: new];
};
RETURN};
space.UpdateSpaceOther[Update];
RETURN};

SingletonHasMember: PROC [set: Set, elt: Value] RETURNS [BOOL] ~ {
space: Space ~ NARROW[set.class.data];
RETURN space.SEqual[elt, set.data]};

SingletonScan: PROC [set: Set, Test: Tester, ro: RelOrder] RETURNS [MaybeValue] ~ {
space: Space ~ NARROW[set.class.data];
IF Test[set.data] THEN RETURN [[TRUE, set.data]];
RETURN [noMaybe]};

SingletonTheElt: PROC [set: Set] RETURNS [Value] ~ {RETURN [set.data]};

SingletonGetOne: PROC [set: Set, remove: BOOL, ro: RelOrder] RETURNS [MaybeValue] ~ {
IF remove THEN set.Complain[notVariable];
RETURN [[TRUE, set.data]]};

SingeltonGet3: PROC [set: Set, elt: Value, want: TripleBool] RETURNS [TripleMaybeValue] ~ {
space: Space ~ NARROW[set.class.data];
RETURN [SELECT space.SCompare[elt, set.data] FROM
less => [noMaybe, noMaybe, [TRUE, set.data]],
equal => [noMaybe, [TRUE, set.data], noMaybe],
greater => [[TRUE, set.data], noMaybe, noMaybe],
ENDCASE => ERROR];
};

SingletonSize: PROC [set: Set, limit: EINT] RETURNS [EINT] ~ {RETURN [one]};

SingletonIsDense: PROC [set: Set, when: When] RETURNS [BOOL]
~ {RETURN [TRUE]};

SingletonGetBounds: PROC [set: Set, want: EndBools] RETURNS [MaybeInterval] ~ {
RETURN [[TRUE, [set.data, set.data]]]};

SingletonSpaceOf: PROC [set: Set] RETURNS [Space] ~ {
RETURN [NARROW[set.class.data]]};

CreateFullSet: PUBLIC PROC [space: Space] RETURNS [ConstSet] ~ {
RETURN AsConst[[fullClass, AV[space] ]]};

fullClass: SetClass ~ CreateClass[
cp: [
HasMember: FullHasMember,
IsDense: FullIsDense,
GetBounds: FullGetBounds,
SpaceOf: FullSpaceOf,
mutability: constant],
relable: ALL[TRUE]];

FullHasMember: PROC [set: Set, elt: Value] RETURNS [BOOL]
~ {RETURN [TRUE]};

FullIsDense: PROC [set: Set, when: When] RETURNS [BOOL] ~ {RETURN [TRUE]};

FullGetBounds: PROC [set: Set, want: EndBools] RETURNS [MaybeInterval] ~ {
RETURN [[TRUE, fullInterval]]};

FullSpaceOf: PROC [set: Set] RETURNS [Space] ~ {
RETURN [NARROW[set.data.VA]]};

IntervalSet: TYPE ~ REF IntervalSetPrivate;
IntervalSetPrivate: TYPE ~ RECORD [
space: Space,
i: Interval,
ii: IntInterval _ []
];

IntervalAsSet: PUBLIC PROC [space: Space, i: Interval] RETURNS [ConstSet] ~ {
is: IntervalSet ~ NEW [IntervalSetPrivate _ [space, i]];
integral: BOOL ~ space=ints;
IF integral THEN is.ii _ IIntify[i];
RETURN AsConst[[intervalClasses[integral], AV[is] ]]};

IIAsSet: PUBLIC PROC [ii: IntInterval] RETURNS [ConstSet] ~ {
RETURN IntervalAsSet[ints, IValify[ii]]};

IntervalClasses: TYPE ~ ARRAY --integral--BOOL OF SetClass;
intervalClasses: REF IntervalClasses ~ NEW [IntervalClasses];

IntervalHasMember: PROC [set: Set, elt: Value] RETURNS [BOOL] ~ {
is: IntervalSet ~ NARROW[set.data.VA];
space: Space ~ NARROW[set.class.data];
RETURN is.space.IContains[is.i, elt]};

IntervalScan: PROC [set: Set, Test: Tester, ro: RelOrder] RETURNS [MaybeValue] ~ {
is: IntervalSet ~ NARROW[set.data.VA];
SELECT ro FROM
no, fwd => FOR i: INT IN [is.ii.min .. is.ii.max] DO
IF Test[IV[i]] THEN RETURN [[TRUE, IV[i] ]];
ENDLOOP;
bwd => FOR i: INT DECREASING IN [is.ii.min .. is.ii.max] DO
IF Test[IV[i]] THEN RETURN [[TRUE, IV[i] ]];
ENDLOOP;
ENDCASE => ERROR;
RETURN [noMaybe]};

IntervalGet3: PROC [set: Set, elt: Value, want: TripleBool] RETURNS [TripleMaybeValue] ~ {
is: IntervalSet ~ NARROW[set.data.VA];
ei: INT ~ elt.VI;
IF is.ii.Empty THEN RETURN [[noMaybe, noMaybe, noMaybe]];
RETURN [[
prev: IF is.ii.min >= ei THEN noMaybe ELSE IF is.ii.max < ei THEN [TRUE, IV[is.ii.max]] ELSE [TRUE, IV[ei-1]],
same: IF ei IN [is.ii.min .. is.ii.max] THEN [TRUE, elt] ELSE noMaybe,
next: IF is.ii.max <= ei THEN noMaybe ELSE IF is.ii.min > ei THEN [TRUE, IV[is.ii.min]] ELSE [TRUE, IV[ei+1]]
]];
};

IntervalSize: PROC [set: Set, limit: EINT] RETURNS [EINT] ~ {
is: IntervalSet ~ NARROW[set.data.VA];
RETURN is.ii.Length};

IntervalIsDense: PROC [set: Set, when: When] RETURNS [BOOL] ~ {
RETURN [TRUE]};

IntervalGetBounds: PROC [set: Set, want: EndBools] RETURNS [MaybeInterval] ~ {
is: IntervalSet ~ NARROW[set.data.VA];
RETURN [[NOT is.space.IEmpty[is.i], is.i]]};

IntervalQuaIntInterval: PROC [set: Set] RETURNS [MaybeIntInterval] ~ {
is: IntervalSet ~ NARROW[set.data.VA];
RETURN [[TRUE, is.ii]]};

IntervalSpaceOf: PROC [set: Set] RETURNS [Space] ~ {
is: IntervalSet ~ NARROW[set.data.VA];
RETURN [is.space]};

Cond: TYPE ~ REF CondPrivate;
CondPrivate: TYPE ~ RECORD [cond, subj: Set];

CreateConditional: PUBLIC PROC [cond, subj: Set] RETURNS [UWSet] ~ {
IF cond.MutabilityOf[]=constant THEN RETURN [IF cond.Empty[] THEN CreateEmptySet[subj.SpaceOf] ELSE subj.Insulate];
RETURN AsUW[[condClass, AV[NEW [CondPrivate _ [cond, subj] ]] ]]};

condClass: SetClass ~ CreateClass[[
Primitive: CondPrimitive,
HasMember: CondHasMember,
Scan: CondScan,
TheElt: CondTheElt,
GetOne: CondGetOne,
Get3: CondGet3,
Size: CondSize,
IsDense: CondIsDense,
GetBounds: CondGetBounds,
ValueOf: CondValueOf,
QuaIntInterval: CondQuaIntInterval,
SpaceOf: CondSpaceOf,
mutability: readonly]];

CondPrimitive: PROC [set: Set, op: ATOM, arg1, arg2: REF ANY] RETURNS [PrimitiveAnswer] ~ {
c: Cond ~ NARROW[set.data.VA];
RETURN [SELECT op FROM
$HasMember, $Scan, $TheElt, $Get3, $Size, $IsDense, $GetBounds, $ValueOf, $QuaIntInterval => IF c.cond.Empty[] OR c.subj.Can[op, arg1, arg2] THEN yes ELSE no,
$GetOne => IF ToBool[arg1] OR c.cond.Empty[] OR c.subj.Can[op, arg1, arg2] THEN yes ELSE no,
ENDCASE => no]};

CondHasMember: PROC [set: Set, elt: Value] RETURNS [BOOL] ~ {
c: Cond ~ NARROW[set.data.VA];
RETURN [(NOT c.cond.Empty[]) AND c.subj.HasMember[elt]]};

CondScan: PROC [set: Set, Test: Tester, ro: RelOrder] RETURNS [MaybeValue] ~ {
c: Cond ~ NARROW[set.data.VA];
IF c.cond.Empty[] THEN RETURN [noMaybe];
RETURN c.subj.Scan[Test, ro]};

CondTheElt: PROC [set: Set] RETURNS [Value] ~ {
c: Cond ~ NARROW[set.data.VA];
IF c.cond.Empty[] THEN set.Complain[notASingleton];
RETURN c.subj.TheElt[]};

CondGetOne: PROC [set: Set, remove: BOOL, ro: RelOrder] RETURNS [MaybeValue] ~ {
c: Cond ~ NARROW[set.data.VA];
IF remove THEN set.Complain[notVariable];
IF c.cond.Empty[] THEN RETURN [noMaybe];
RETURN c.subj.GetOne[remove, ro]};

CondGet3: PROC [set: Set, elt: Value, want: TripleBool] RETURNS [TripleMaybeValue] ~ {
c: Cond ~ NARROW[set.data.VA];
IF c.cond.Empty[] THEN RETURN [[noMaybe, noMaybe, noMaybe]];
RETURN c.subj.Get3[elt, want]};

CondSize: PROC [set: Set, limit: EINT] RETURNS [EINT] ~ {
c: Cond ~ NARROW[set.data.VA];
IF c.cond.Empty[] THEN RETURN [zero];
RETURN c.subj.Size[limit]};

CondIsDense: PROC [set: Set, when: When] RETURNS [BOOL] ~ {
c: Cond ~ NARROW[set.data.VA];
IF c.cond.Empty[] THEN RETURN [TRUE];
RETURN c.subj.IsDense[when]};

CondGetBounds: PROC [set: Set, want: EndBools] RETURNS [MaybeInterval] ~ {
c: Cond ~ NARROW[set.data.VA];
IF c.cond.Empty[] THEN RETURN [[FALSE, []]];
RETURN c.subj.GetBounds[want]};

CondValueOf: PROC [set: Set] RETURNS [ConstSet] ~ {
c: Cond ~ NARROW[set.data.VA];
IF c.cond.Empty[] THEN RETURN CreateEmptySet[c.subj.SpaceOf];
RETURN c.subj.ValueOf[]};

CondQuaIntInterval: PROC [set: Set] RETURNS [MaybeIntInterval] ~ {
c: Cond ~ NARROW[set.data.VA];
space: Space ~ c.subj.SpaceOf[];
IF c.cond.Empty[] THEN RETURN [IF space=ints THEN [TRUE, [INT.LAST, INT.FIRST]] ELSE [FALSE, []]];
RETURN c.subj.QuaIntInterval[]};

CondSpaceOf: PROC [set: Set] RETURNS [Space] ~ {
c: Cond ~ NARROW[set.data.VA];
RETURN c.subj.SpaceOf};

CreateEnumerator: PUBLIC PROC [e: EnumerateClosure, mutability: UnwriteableMutability _ readonly] RETURNS [Enumerator] ~ {
RETURN [[enumClasses[mutability], AV[NEW [EnumerateClosure _ e] ] ]]};

EnumClasses: TYPE ~ ARRAY UnwriteableMutability OF SetClass;
enumClasses: REF EnumClasses ~ NEW [EnumClasses];

EnumScan: PROC [set: Set, Test: Tester, ro: RelOrder] RETURNS [MaybeValue] ~ {
ec: REF EnumerateClosure ~ NARROW[set.data.VA];
IF ro#no THEN RETURN set.DefaultScan[Test, ro];
RETURN ec.Scan[Test, ec.data]};

EnumSpaceOf: PROC [set: Set] RETURNS [Space] ~ {
ec: REF EnumerateClosure ~ NARROW[set.data.VA];
RETURN [ec.space]};

filterClasses: PUBLIC ARRAY UnwriteableMutability OF SetClass;

FilterHasMember: PROC [set: Set, elt: Value] RETURNS [BOOL] ~ {
rfc: REF FilterClosure ~ NARROW[set.data.VA];
RETURN rfc.Test[elt, rfc.data]};

FilterSpaceOf: PROC [set: Set] RETURNS [Space] ~ {
rfc: REF FilterClosure ~ NARROW[set.data.VA];
RETURN [rfc.space]};

Start: PROC ~ {
intervalClasses[TRUE] _ CreateClass[
cp: [
HasMember: IntervalHasMember,
Scan: IntervalScan,
Get3: IntervalGet3,
Size: IntervalSize,
IsDense: IntervalIsDense,
GetBounds: IntervalGetBounds,
QuaIntInterval: IntervalQuaIntInterval,
SpaceOf: IntervalSpaceOf,
mutability: constant],
relable: ALL[TRUE]];
intervalClasses[FALSE] _ CreateClass[
cp: [
HasMember: IntervalHasMember,
IsDense: IntervalIsDense,
GetBounds: IntervalGetBounds,
SpaceOf: IntervalSpaceOf,
mutability: constant],
relable: ALL[TRUE]];
FOR mut: UnwriteableMutability IN UnwriteableMutability DO
enumClasses[mut] _ CreateClass[[
Scan: EnumScan,
SpaceOf: EnumSpaceOf,
mutability: mut]];
filterClasses[mut] _ CreateClass[[
HasMember: FilterHasMember,
SpaceOf: FilterSpaceOf,
mutability: mut]];
ENDLOOP;
RETURN};

Start[];

END.
^SetsSimpleImpl.Mesa
Last tweaked by Mike Spreitzer on February 27, 1988 12:27:17 pm PST
ΚZ–

"cedar" style˜
code™Kš
œC™C—K˜KšΟk	œ)˜2K˜šΟnœœ
˜Kšœ"˜)Kšœ˜K˜
—K˜Kšœ
œžœ˜2K˜šžœœ
œœ˜AKšœœ˜)—K˜˜#˜Kšž	œ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšžœ˜K˜—Kšœ	œ
œ
˜K˜—K˜šžœœœœ
˜:Kšœœœ˜—K˜šž	œœžœœ
˜KKšœœ˜—K˜šž	œœ*œ˜SKšœœ ˜)—K˜Kšž	œœœœœœ	˜IK˜Kšžœœœœœœ˜KK˜šžœœœ˜1Kšœœ
œ˜—K˜šžœœ
œœ˜KKšœœ˜'—K˜š
žœœ
œœœ
˜;Kšœœ&˜/—K˜Kšœœ!˜3šžœœ
œœ˜Kšžœœœ˜BK˜
K•StartOfExpansion%[key: 
REF ANY, aList: 
List.AList]šœœ,˜:šœœ
œ˜˜˜Kšž	œ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšž	œ˜Kšžœ˜K˜K˜
—Kšœ	œ
œ
˜K˜—K–5[key: 
REF ANY, val: 
REF ANY, aList: 
List.AList]š
œ?˜?K˜—Kšœ˜—Kš
œ˜Kšœ˜—K˜šžœœœœ˜BKšœœ˜&Kšœ˜$—K˜šž
œœžœœ˜SKšœœ˜&Kšœœ
œœ
˜1Kšœ˜—K˜Kšžœœœœ
˜GK˜šžœœœœ˜UKšœœ˜)Kšœœ˜—K˜šž
œœ*œ˜[Kšœœ˜&šœœ˜1Kšœœ
˜-Kšœœ˜.Kšœ
œ˜0Kšœœ˜—K˜—K˜Kšž
œœœœœœ˜LK˜šžœœœœ
˜<Kšœœœ˜—K˜šžœœœ˜OKšœœ˜'—K˜šžœœœ˜5Kšœœ˜!—K˜šž
œœ
œœ˜@Kšœœ˜)—K˜˜"˜Kšž	œ˜Kšžœ˜Kšž	œ˜Kšžœ˜K˜—Kšœ	œ
œ˜—K˜šž
œœœœ
˜9Kšœœœ˜—K˜Kšžœœœœœœ˜JK˜šž
œœœ˜JKšœœ˜—K˜šžœœœ˜0Kšœœ
œ˜—K˜Kšœ
œœ˜+šœœœ˜#Kš
œ
˜
Kš
œ˜Kš
œ˜Kš
œ˜—K˜šž
œœ
œœ˜MKšœœ#˜8Kšœ
œ˜Kšœ
œ˜$Kšœ%œ	˜6—K˜šžœœ
œœ˜=Kšœ#˜)—K˜Kš
œœœ
Οcœ
œ
˜;Kšœœœ˜=K˜šžœœœœ˜AKšœœ
œ˜&Kšœœ˜&Kšœ ˜&—K˜šžœœžœœ˜RKšœœ
œ˜&šœ˜šœœœ
œ˜4Kšœœœ
œœœ˜,Kšœ
˜—š
œœœ

œ
œ˜;Kšœœœ
œœœ˜,Kšœ
˜—Kšœœ
˜—Kšœ˜—K˜šžœœ*œ˜ZKšœœ
œ˜&Kšœœœ
˜Kšœ
œ
œ˜9šœ˜	Kšœœœ	œ
œœœœ
œœœ˜nKšœœœœœœ	˜FKšœœœ	œ
œœœœ
œœœ˜mK˜—K˜—K˜š
žœœœœœ˜=Kšœœ
œ˜&Kšœ˜—K˜šžœœœœ˜?Kšœœ˜—K˜šžœœœ˜NKšœœ
œ˜&Kšœœ ˜,—K˜šžœœœ˜FKšœœ
œ˜&Kšœœ˜—K˜šžœœœ˜4Kšœœ
œ˜&Kšœ
˜—K˜Kšœœœ
˜Kšœ
œœ˜-K˜šžœœ
œœ˜DKšœœ
œœœœ˜sKšœœ
œ$˜B—K˜š
œ#˜#Kšž	œ˜Kšž	œ˜Kšžœ˜Kšžœ
˜Kšžœ
˜Kšžœ˜Kšžœ˜Kšžœ˜Kšž	œ˜Kšžœ˜Kšžœ˜#Kšžœ˜K˜—K˜šž
œœœœ
œœ˜[Kšœ
œ
œ˜šœœ˜Kš	œ]œœœœ˜ž
Kšœœœœœœ˜\Kšœ	˜——K˜šž
œœœœ˜=Kšœ
œ
œ˜Kšœœœ˜9—K˜šžœœžœœ˜NKšœ
œ
œ˜Kšœœ
œ˜(Kšœ˜—K˜šž
œœœ˜/Kšœ
œ
œ˜Kšœœ˜3Kšœ˜—K˜šž
œœœœ˜PKšœ
œ
œ˜Kšœœ˜)Kšœœ
œ˜(Kšœ˜"—K˜šžœœ*œ˜VKšœ
œ
œ˜Kšœœ
œ˜<Kšœ˜—K˜š
žœœœœœ˜9Kšœ
œ
œ˜Kšœœ
œ˜%Kšœ˜—K˜šžœœœœ˜;Kšœ
œ
œ˜Kšœœ
œœ˜%Kšœ˜—K˜šž
œœœ˜JKšœ
œ
œ˜Kšœœ
œœ˜,Kšœ˜—K˜šžœœœ˜3Kšœ
œ
œ˜Kšœœ
œ ˜=Kšœ˜—K˜šžœœœ˜BKšœ
œ
œ˜K˜ Kšœœ
œœœœœ
œœ
œœœ˜bKšœ˜ —K˜šžœœœ˜0Kšœ
œ
œ˜Kšœ˜—K˜šžœœ
œEœ˜zKšœœ
œ˜F—K˜Kšœ
œœœ
˜<Kšœ
œœ˜1K˜šžœœžœœ˜NKšœœœ
œ˜/Kšœœ
œ˜/Kšœ˜—K˜šžœœœ˜0Kšœœœ
œ˜/Kšœ
˜—K˜Kšœœ
œœ
˜>K˜šžœœœœ˜?Kšœœœ
œ˜-Kšœ˜ —K˜šž
œœœ˜2Kšœœœ
œ˜-Kšœ˜—K˜šžœœ˜šœœ˜$˜Kšž	œ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšž	œ˜Kšžœ˜'Kšžœ˜K˜—Kšœ	œ
œ˜—šœœ˜%˜Kšž	œ˜Kšžœ˜Kšž	œ˜Kšžœ˜K˜—Kšœ	œ
œ˜—šœœ˜:š
œ ˜ Kšžœ˜Kšžœ˜Kš
œ˜—š
œ"˜"Kšž	œ˜Kšžœ˜Kš
œ˜—Kšœ
˜—Kšœ˜—K˜K˜K˜Kšœ
˜—…—+6;ξ