SetsSimpleImpl.Mesa
Last tweaked by Mike Spreitzer on January 6, 1988 4:22:02 pm PST
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]]};
singletonKey: ATOM ~ $SetsSimpleImplSingletonClass;
IsSingletonClass:
PUBLIC
PROC [sc: SetClass]
RETURNS [
BOOL]
~ {RETURN [sc.HasMember = SingletonHasMember]};
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.