SetCombining.Mesa
Last tweaked by Mike Spreitzer on December 14, 1987 11:42:43 am PST
DIRECTORY BiRels, IntStuff, SetBasics, AbSets;
SetCombining:
CEDAR
PROGRAM
IMPORTS BiRels, IntStuff, SetBasics, AbSets
EXPORTS AbSets
=
BEGIN OPEN IntStuff, SetBasics, BiRels, Sets:AbSets, Sets;
Other: ARRAY Which OF Which ~ [a: b, b: a];
Difference:
PUBLIC
PROC [a, b: Set]
RETURNS [UWSet] ~ {
RETURN a.Intersection[b.Negate]};
Intersection:
PUBLIC
PROC [a, b: Set]
RETURNS [UWSet] ~ {
const: BOOL ~ a.MutabilityOf=constant AND b.MutabilityOf=constant;
isn: Isn ~ NEW [IsnPrivate ← [sets: [a, b]]];
eq, tq, ltq, gq: ARRAY Which OF ImplQuality;
size: ARRAY Which OF EINT ← ALL[lastEINT];
IF a.SpaceOf[] # b.SpaceOf[] THEN a.Complain["Can't intersect sets from different spaces"];
FOR w: Which
IN Which
DO
eq[w] ← isn.sets[w].QualityOf[$Scan];
tq[w] ← isn.sets[w].QualityOf[$HasMember];
ltq[w] ← QMin[tq[w], goodDefault];
gq[w] ← isn.sets[w].QualityOf[$Get3];
IF isn.sets[w].GoodImpl[$Size] THEN TRUSTED {size[w] ← isn.sets[w].Size[]};
ENDLOOP;
isn.testFirst ←
SELECT
INTEGER[ltq[a].
ORD] -
INTEGER[ltq[b].
ORD]
FROM
<0 => b,
=0 =>
SELECT size[a].Compare[size[b]]
FROM
less => a,
greater => b,
equal => IF tq[b]>tq[a] THEN b ELSE a,
ENDCASE => ERROR,
>0 => a,
ENDCASE => ERROR;
isn.testLast ← Other[isn.testFirst];
isn.enumFirst ←
SELECT size[a].Compare[size[b]]
FROM
less => a,
greater => b,
equal => IF eq[b]>eq[a] THEN b ELSE a,
ENDCASE => ERROR;
IF NOT isn.sets[isn.enumFirst].Can[$Scan] THEN isn.enumFirst ← Other[isn.enumFirst];
isn.enumLast ← Other[isn.enumFirst];
isn.getFirst ← IF gq[b]>gq[a] THEN b ELSE a;
isn.getLast ← Other[isn.getFirst];
RETURN AsUW[[isnClasses[const], [a[isn]] ]]};
Isn: TYPE ~ REF IsnPrivate;
IsnPrivate:
TYPE ~
RECORD [
sets: ARRAY Which OF Set,
enumFirst, enumLast, testFirst, testLast, getFirst, getLast: Which ← a
];
IsnClasses: TYPE ~ ARRAY BOOL OF SetClass;
isnClasses: REF IsnClasses ~ NEW [IsnClasses];
IsnPrimitive:
PROC [set: Set, op:
ATOM, arg1, arg2:
REF
ANY]
RETURNS [PrimitiveAnswer] ~ {
isn: Isn ~ NARROW[set.data.VA];
SELECT op
FROM
$HasMember, $ValueOf, $QuaBiRel, $QuaIntInterval => RETURN [IF isn.sets[a].Can[op, arg1, arg2] AND isn.sets[b].Can[op, arg1, arg2] THEN yes ELSE no];
$Scan => RETURN [IF isn.sets[isn.enumFirst].Can[op, arg1, arg2] AND isn.sets[isn.enumLast].Can[$HasMember] THEN yes ELSE no];
$Get3 => RETURN [IF isn.sets[isn.getFirst].Can[op, arg1, arg2] AND isn.sets[isn.enumLast].Can[$HasMember] THEN yes ELSE no];
ENDCASE => RETURN [pass];
};
IsnHasMember:
PROC [set: Set, elt: Value]
RETURNS [
BOOL] ~ {
isn: Isn ~ NARROW[set.data.VA];
RETURN [isn.sets[isn.testFirst].HasMember[elt] AND isn.sets[isn.testLast].HasMember[elt]]};
IsnScan:
PROC [set: Set,
Test: Tester, ro: RelOrder]
RETURNS [MaybeValue] ~ {
isn: Isn ~ NARROW[set.data.VA];
Pass: PROC [v: Value] RETURNS [BOOL] ~ {RETURN [isn.sets[isn.enumLast].HasMember[v] AND Test[v]]};
RETURN isn.sets[isn.enumFirst].Scan[Pass, ro]};
IsnGet3:
PROC [set: Set, elt: Value, want: TripleBool]
RETURNS [TripleMaybeValue] ~
TRUSTED {
isn: Isn ~ NARROW[set.data.VA];
s2: Set ~ isn.sets[isn.getLast];
tmv: TripleMaybeValue ← isn.sets[isn.getFirst].Get3[elt, want];
IF tmv.same.found AND NOT s2.HasMember[tmv.same.it] THEN tmv.same ← noMaybe;
WHILE tmv.prev.found AND NOT s2.HasMember[tmv.prev.it] DO tmv.prev ← s2.Prev[tmv.prev.it] ENDLOOP;
WHILE tmv.next.found AND NOT s2.HasMember[tmv.next.it] DO tmv.next ← s2.Next[tmv.next.it] ENDLOOP;
RETURN [tmv]};
IsnValueOf:
PROC [set: Set]
RETURNS [ConstSet] ~ {
isn: Isn ~ NARROW[set.data.VA];
RETURN isn.sets[a].ValueOf.Intersection[isn.sets[b].ValueOf].AsConst};
IsnQuaBiRel:
PROC [set: Set]
RETURNS [found:
BOOL, class, data:
REF
ANY] ~ {
isn: Isn ~ NARROW[set.data.VA];
brA: MaybeBiRel ~ SetQuaBiRel[isn.sets[a]];
brB: MaybeBiRel ~ SetQuaBiRel[isn.sets[b]];
IF brA.found
AND brB.found
THEN {
brI: BiRel ~ brA.it.Intersection[brB.it];
RETURN [TRUE, brI.class, brI.data]};
RETURN [FALSE, NIL, NIL]};
IsnQuaIntInterval:
PROC [set: Set]
RETURNS [MaybeIntInterval] ~ {
isn: Isn ~ NARROW[set.data.VA];
miA: MaybeIntInterval ~ isn.sets[a].QuaIntInterval[];
miB: MaybeIntInterval ~ isn.sets[b].QuaIntInterval[];
RETURN [[miA.found AND miB.found, miA.it.Intersect[miB.it]]]};
IsnSpaceOf:
PROC [set: Set]
RETURNS [Space] ~ {
isn: Isn ~ NARROW[set.data.VA];
RETURN isn.sets[a].SpaceOf};
Unyn: TYPE ~ REF UnynPrivate;
UnynPrivate: TYPE ~ RECORD [space: Space, a, b: Set, disjoint: BOOL, ro: RelOrder, canSize, canIsDense: BOOL];
Union:
PUBLIC
PROC [a, b: Set, disjoint:
BOOL ←
FALSE, ro: RelOrder ← no]
RETURNS [UWSet] ~ {
const: BOOL ~ a.MutabilityOf=constant AND b.MutabilityOf=constant;
unn: Unyn ~
NEW [UnynPrivate ← [
space: a.SpaceOf,
a: a,
b: b,
disjoint: disjoint,
ro: ro,
canSize: disjoint AND a.Can[$Size] AND b.Can[$Size],
canIsDense: a.Can[$IsDense] AND b.Can[$IsDense] AND a.Can[$GetBounds, FromEB[[min: ro#fwd, max: ro#bwd]]] AND b.Can[$GetBounds, FromEB[[min: ro#bwd, max: ro#fwd]]]
]];
RETURN AsUW[[unionClasses[const][unn.canSize][unn.canIsDense], [a[unn]] ]]};
UnionClasses: TYPE ~ ARRAY --const--BOOL OF ARRAY --canSize--BOOL OF ARRAY --canIsDense--BOOL OF SetClass;
unionClasses: REF UnionClasses ~ NEW [UnionClasses];
UnionPrimitive:
PROC [set: Set, op:
ATOM, arg1, arg2:
REF
ANY]
RETURNS [PrimitiveAnswer] ~ {
unn: Unyn ~ NARROW[set.data.VA];
SELECT op
FROM
$HasMember, $Scan, $Get3, $GetBounds, $ValueOf, $QuaBiRel, $QuaIntInterval => RETURN [IF unn.a.Can[op, arg1, arg2] AND unn.b.Can[op, arg1, arg2] THEN yes ELSE no];
$Size => RETURN [IF unn.canSize THEN yes ELSE no];
$IsDense => RETURN [IF unn.canIsDense THEN yes ELSE no];
ENDCASE => RETURN [pass];
};
UnionHasMember:
PROC [set: Set, elt: Value]
RETURNS [
BOOL] ~ {
unn: Unyn ~ NARROW[set.data.VA];
RETURN [unn.a.HasMember[elt] OR unn.b.HasMember[elt]]};
UnionScan:
PROC [set: Set,
Test: Tester, ro: RelOrder]
RETURNS [MaybeValue] ~ {
unn: Unyn ~ NARROW[set.data.VA];
InterleavedConsume:
PROC [
Produce:
PROC [Which]
RETURNS [MaybeValue]]
RETURNS [MaybeValue] ~ {
mvA: MaybeValue ← Produce[a];
mvB: MaybeValue ← Produce[b];
WHILE mvA.found
AND mvB.found
DO
c: Comparison ~ IF ro=bwd THEN unn.space.SCompare[mvB.it, mvA.it] ELSE unn.space.SCompare[mvA.it, mvB.it];
SELECT c
FROM
less => {IF Test[mvA.it] THEN RETURN [mvA]; mvA ← Produce[a]};
greater => {IF Test[mvB.it] THEN RETURN [mvB]; mvB ← Produce[b]};
equal => {IF Test[mvA.it] THEN RETURN [mvA]; mvA ← Produce[a]; mvB ← Produce[b]};
ENDCASE => ERROR;
ENDLOOP;
WHILE mvA.found
DO
IF Test[mvA.it] THEN RETURN [mvA];
mvA ← Produce[a];
ENDLOOP;
WHILE mvB.found
DO
IF Test[mvB.it] THEN RETURN [mvB];
mvB ← Produce[b];
ENDLOOP;
RETURN [noMaybe]};
IF ro#no AND unn.ro=no
THEN RETURN unn.a.InterleavedProduce[unn.b, InterleavedConsume, ro, ro]
ELSE {
plan: RECORD [s1, s2: Set] ~ IF ro=no OR ro=unn.ro THEN [unn.a, unn.b] ELSE [unn.b, unn.a];
{OPEN plan;
m1: MaybeValue ~ s1.Scan[Test, ro];
left: BOOL ← FALSE;
FilterAndTest:
PROC [v: Value]
RETURNS [
BOOL] ~ {
IF left THEN RETURN Test[v];
IF s1.HasMember[v] THEN RETURN [FALSE];
left ← TRUE;
RETURN Test[v]};
IF m1.found THEN RETURN [m1];
RETURN s2.Scan[IF unn.disjoint THEN Test ELSE FilterAndTest, ro]}};
};
UnionGet3:
PROC [set: Set, elt: Value, want: TripleBool]
RETURNS [TripleMaybeValue] ~ {
unn: Unyn ~ NARROW[set.data.VA];
tmva: TripleMaybeValue ~ unn.a.Get3[elt, want];
tmvb: TripleMaybeValue ~ unn.b.Get3[elt, want];
RETURN [[
prev: IF tmva.prev.found THEN IF tmvb.prev.found THEN [TRUE, unn.space.SMin[tmva.prev.it, tmvb.prev.it]] ELSE tmva.prev ELSE IF tmvb.prev.found THEN tmvb.prev ELSE noMaybe,
same: IF tmva.same.found THEN tmva.same ELSE IF tmvb.same.found THEN tmvb.same ELSE noMaybe,
next: IF tmva.next.found THEN IF tmvb.next.found THEN [TRUE, unn.space.SMax[tmva.next.it, tmvb.next.it]] ELSE tmva.next ELSE IF tmvb.next.found THEN tmvb.next ELSE noMaybe]]};
UnionSize:
PROC [set: Set, limit:
EINT]
RETURNS [
EINT] ~ {
unn: Unyn ~ NARROW[set.data.VA];
s1: EINT ~ unn.a.Size[limit];
IF s1.Compare[limit] >= equal THEN RETURN [s1];
{s2: EINT ~ unn.b.Size[limit.Sub[s1]];
RETURN s1.Add[s2]}};
UnionIsDense:
PROC [set: Set, when: When]
RETURNS [
BOOL] ~ {
unn: Unyn ~ NARROW[set.data.VA];
IF (when=always AND set.MutabilityOf[]#constant) OR NOT (unn.a.IsDense[when] AND unn.b.IsDense[when]) THEN RETURN [FALSE];
{
ba: MaybeInterval ~ unn.a.GetBounds[[min: unn.ro#fwd, max: unn.ro#bwd]];
bb: MaybeInterval ~ unn.b.GetBounds[[min: unn.ro#bwd, max: unn.ro#fwd]];
IF NOT (ba.found AND bb.found) THEN RETURN [TRUE];
{part:
RECORD [disjoint:
BOOL, ro: RelOrder] ~
IF unn.disjoint AND unn.ro#no THEN [unn.disjoint, unn.ro]
ELSE
SELECT unn.space.SCompare[bb.it[min], ba.it[max]]
FROM
greater => [TRUE, fwd],
equal => [FALSE, fwd],
less =>
SELECT unn.space.SCompare[ba.it[min], bb.it[max]]
FROM
greater => [TRUE, bwd],
equal => [FALSE, bwd],
less => [FALSE, no],
ENDCASE => ERROR,
ENDCASE => ERROR;
IF NOT part.disjoint THEN RETURN [TRUE];
IF unn.space # ints THEN RETURN [FALSE];
{pair: RECORD [lh, hl: INT] ~ IF part.ro=fwd THEN [ba.it[max].VI, bb.it[min].VI] ELSE [bb.it[max].VI, ba.it[min].VI];
RETURN [pair.lh#INT.LAST AND pair.lh.SUCC=pair.hl]}}}};
UnionGetBounds:
PROC [set: Set, want: EndBools]
RETURNS [MaybeInterval] ~ {
unn: Unyn ~ NARROW[set.data.VA];
ba: MaybeInterval ~ unn.a.GetBounds[want];
bb: MaybeInterval ~ unn.b.GetBounds[want];
IF NOT ba.found THEN RETURN [bb];
IF NOT bb.found THEN RETURN [ba];
RETURN [[
TRUE, [
min: IF want[min] THEN unn.space.SMin[ba.it[min], bb.it[min]] ELSE noValue,
max: IF want[max] THEN unn.space.SMax[ba.it[max], bb.it[max]] ELSE noValue]]]};
UnionValueOf:
PROC [set: Set]
RETURNS [ConstSet] ~ {
unn: Unyn ~ NARROW[set.data.VA];
RETURN unn.a.ValueOf.Union[unn.b.ValueOf, unn.disjoint, unn.ro].AsConst};
UnionQuaBiRel:
PROC [set: Set]
RETURNS [found:
BOOL, class, data:
REF
ANY] ~ {
unn: Unyn ~ NARROW[set.data.VA];
qa: MaybeBiRel ~ SetQuaBiRel[unn.a];
qb: MaybeBiRel ~ SetQuaBiRel[unn.b];
IF NOT (qa.found AND qb.found) THEN RETURN [FALSE, NIL, NIL];
{u: BiRel ~ qa.it.Union[qb.it, unn.disjoint];
RETURN [TRUE, u.class, u.data]}};
UnionQuaIntInterval:
PROC [set: Set]
RETURNS [MaybeIntInterval] ~ {
unn: Unyn ~ NARROW[set.data.VA];
qa: MaybeIntInterval ~ unn.a.QuaIntInterval[];
qb: MaybeIntInterval ~ unn.b.QuaIntInterval[];
IF qa.found AND qb.found THEN RETURN [[TRUE, qa.it.MBI[qb.it]]];
RETURN [[FALSE, []]]};
UnionSpaceOf:
PROC [set: Set]
RETURNS [Space] ~ {
unn: Unyn ~ NARROW[set.data.VA];
RETURN [unn.space]};
Negate:
PUBLIC
PROC [set: Set]
RETURNS [Set] ~ {
class: SetClass ~ negClasses[set.MutabilityOf];
IF set.class = class THEN RETURN DeRef[set.data.VA];
RETURN [[class, [a[set.Refify]] ]]};
NegClasses: TYPE ~ ARRAY Mutability OF SetClass;
negClasses: REF NegClasses ~ NEW [NegClasses];
NegPrimitive:
PROC [set: Set, op:
ATOM, arg1, arg2:
REF
ANY]
RETURNS [PrimitiveAnswer] ~ {
rs: RefSet ~ NARROW[set.data.VA];
SELECT op
FROM
$AddSet => RETURN [IF rs^.GoodImpl[$RemSet, arg1, arg2] THEN yes ELSE no];
$RemSet => RETURN [IF rs^.GoodImpl[$AddSet, arg1, arg2] THEN yes ELSE no];
$QuaIntInterval => RETURN [IF rs^.SpaceOf#ints OR rs^.GoodImpl[op, arg1, arg2] THEN yes ELSE no];
ENDCASE => RETURN [IF rs^.GoodImpl[op, arg1, arg2] THEN yes ELSE no];
};
NegHasMember:
PROC [set: Set, elt: Value]
RETURNS [
BOOL] ~ {
rs: RefSet ~ NARROW[set.data.VA];
RETURN [NOT rs^.HasMember[elt]]};
NegCopy:
PROC [set: Set]
RETURNS [VarSet] ~ {
rs: RefSet ~ NARROW[set.data.VA];
RETURN rs^.Copy.Negate.AsVar};
NegInsulate:
PROC [set: Set]
RETURNS [UWSet] ~ {
rs: RefSet ~ NARROW[set.data.VA];
RETURN rs^.Insulate.Negate.AsUW};
NegValueOf:
PROC [set: Set]
RETURNS [ConstSet] ~ {
rs: RefSet ~ NARROW[set.data.VA];
RETURN rs^.ValueOf.Negate.AsConst};
NegFreeze:
PROC [set: Set]
RETURNS [ConstSet] ~ {
rs: RefSet ~ NARROW[set.data.VA];
RETURN rs^.Freeze.Negate.AsConst};
NegThaw:
PROC [set: Set] ~ {
rs: RefSet ~ NARROW[set.data.VA];
rs^.Thaw; RETURN};
NegAddSet:
PROC [set, other: Set]
RETURNS [new: SomeAll] ~ {
rs: RefSet ~ NARROW[set.data.VA];
negHad: SomeAll ~ rs^.RemSet[other];
RETURN [new: [some: NOT negHad.all, all: NOT negHad.some]]};
NegRemSet:
PROC [set, other: Set]
RETURNS [had: SomeAll] ~ {
rs: RefSet ~ NARROW[set.data.VA];
negNew: SomeAll ~ rs^.AddSet[other];
RETURN [had: [some: NOT negNew.all, all: NOT negNew.some]]};
NegQuaBiRel:
PROC [set: Set]
RETURNS [found:
BOOL, class, data:
REF
ANY] ~ {
rs: RefSet ~ NARROW[set.data.VA];
mbr: MaybeBiRel ~ SetQuaBiRel[rs^];
IF NOT mbr.found THEN RETURN [mbr.found, mbr.it.class, mbr.it.data];
{neg: BiRel ~ mbr.it.Negate[];
RETURN [TRUE, neg.class, neg.data]}};
NegQuaIntInterval:
PROC [set: Set]
RETURNS [MaybeIntInterval] ~ {
rs: RefSet ~ NARROW[set.data.VA];
IF rs^.SpaceOf # ints THEN RETURN [[FALSE, []]];
{neg: MaybeIntInterval ~ rs^.QuaIntInterval[];
IF NOT neg.found THEN RETURN [neg];
IF neg.it.min = INT.FIRST THEN RETURN [[TRUE, ClipBot[[], neg.it.max]]];
IF neg.it.max = INT.LAST THEN RETURN [[TRUE, ClipTop[[], neg.it.min]]];
RETURN [[FALSE, []]]}};
NegSpaceOf:
PROC [set: Set]
RETURNS [Space] ~ {
rs: RefSet ~ NARROW[set.data.VA];
RETURN rs^.SpaceOf};
Start:
PROC ~ {
FOR mut: Mutability
IN Mutability
DO
negClasses[mut] ← CreateClass[[
Primitive: NegPrimitive,
HasMember: NegHasMember,
Copy: NegCopy,
Insulate: IF mut=variable THEN NegInsulate ELSE NIL,
ValueOf: IF mut#constant THEN NegValueOf ELSE NIL,
Freeze: IF mut=variable THEN NegFreeze ELSE NIL,
Thaw: IF mut=variable THEN NegThaw ELSE NIL,
AddSet: IF mut=variable THEN NegAddSet ELSE NIL,
RemSet: IF mut=variable THEN NegRemSet ELSE NIL,
QuaBiRel: NegQuaBiRel,
QuaIntInterval: NegQuaIntInterval,
SpaceOf: NegSpaceOf,
mutability: mut]];
ENDLOOP;
FOR const:
BOOL
IN
BOOL
DO
isnClasses[const] ← CreateClass[[
Primitive: IsnPrimitive,
HasMember: IsnHasMember,
Scan: IsnScan,
Get3: IsnGet3,
ValueOf: IF NOT const THEN IsnValueOf ELSE NIL,
QuaBiRel: IsnQuaBiRel,
QuaIntInterval: IsnQuaIntInterval,
SpaceOf: IsnSpaceOf,
mutability: IF const THEN constant ELSE readonly]];
FOR canSize:
BOOL
IN
BOOL
DO
FOR canIsDense:
BOOL
IN
BOOL
DO
unionClasses[const][canSize][canIsDense] ← CreateClass[[
Primitive: UnionPrimitive,
HasMember: UnionHasMember,
Scan: UnionScan,
Get3: UnionGet3,
Size: IF canSize THEN UnionSize ELSE NIL,
IsDense: IF canIsDense THEN UnionIsDense ELSE NIL,
GetBounds: UnionGetBounds,
ValueOf: IF NOT const THEN UnionValueOf ELSE NIL,
QuaBiRel: UnionQuaBiRel,
QuaIntInterval: UnionQuaIntInterval,
SpaceOf: UnionSpaceOf,
mutability: IF const THEN constant ELSE readonly]];
ENDLOOP ENDLOOP;
ENDLOOP;
};
Start[];
END.