BiRelCombining.Mesa
Last tweaked by Mike Spreitzer on December 14, 1987 4:45:46 pm PST
DIRECTORY AbSets, BiRelBasics, BiRels, IntStuff, SetBasics;
BiRelCombining:
CEDAR
PROGRAM
IMPORTS AbSets, BiRelBasics, BiRels, IntStuff, SetBasics
EXPORTS BiRels
=
BEGIN OPEN IntStuff, SetBasics, Sets:AbSets, Sets, BiRelBasics, BiRels;
Other: ARRAY Which OF Which ~ [a: b, b: a];
Isn: TYPE ~ REF IsnPrivate;
IsnPrivate:
TYPE ~
RECORD [
brs: ARRAY Which OF BiRel,
enumFirst, enumLast, testFirst, testLast, getFirst, getLast: Which ← a
];
Intersection:
PUBLIC
PROC [a, b: BiRel]
RETURNS [UWBiRel] ~ {
const: BOOL ~ a.MutabilityOf=constant AND b.MutabilityOf=constant;
l2r: BOOL ~ a.Functional[][leftToRight] OR b.Functional[][leftToRight];
r2l: BOOL ~ a.Functional[][rightToLeft] OR b.Functional[][rightToLeft];
isn: Isn ~ NEW [IsnPrivate ← [brs: [a, b]]];
eq, tq, ltq, gq: ARRAY Which OF ImplQuality;
size: ARRAY Which OF EINT ← ALL[lastEINT];
IF a.Spaces[] # b.Spaces[] THEN a.Complain["Can't intersect sets from different spaces"];
FOR w: Which
IN Which
DO
eq[w] ← isn.brs[w].QualityOf[$Scan];
tq[w] ← isn.brs[w].QualityOf[$HasPair];
ltq[w] ← QMin[tq[w], goodDefault];
gq[w] ← isn.brs[w].QualityOf[$Get3];
IF isn.brs[w].GoodImpl[$Size] THEN TRUSTED {size[w] ← isn.brs[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.brs[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[l2r][r2l][const], isn]]};
IsnClasses: TYPE ~ ARRAY --l2r--BOOL OF ARRAY --r2l--BOOL OF ARRAY --const--BOOL OF BiRelClass;
isnClasses: REF IsnClasses ~ NEW [IsnClasses];
IsnPrimitive:
PROC [br: BiRel, op:
ATOM, arg1, arg2:
REF
ANY]
RETURNS [PrimitiveAnswer] ~ {
isn: Isn ~ NARROW[br.data];
SELECT op
FROM
$AsSet, $HasPair, $Image, $ValueOf, $SetOn, $CurSetOn, $IsDense, $SideFixed => RETURN [IF isn.brs[a].Can[op, arg1, arg2] AND isn.brs[b].Can[op, arg1, arg2] THEN yes ELSE no];
$ScanRestriction => RETURN [IF isn.brs[isn.enumFirst].Can[op, arg1, arg2] AND isn.brs[isn.enumLast].Can[$HasPair] THEN yes ELSE no];
$Get3 => RETURN [IF isn.brs[isn.getFirst].Can[op, arg1, arg2] AND isn.brs[isn.enumLast].Can[$HasPair] THEN yes ELSE no];
ENDCASE => RETURN [pass];
};
IsnAsSet:
PROC [br: BiRel, ro: RelOrder]
RETURNS [Set
--of REF Pair--] ~ {
isn: Isn ~ NARROW[br.data];
RETURN [isn.brs[a].AsSet[ro].Intersection[isn.brs[b].AsSet[ro]]]};
IsnHasPair:
PROC [br: BiRel, pair: Pair]
RETURNS [
BOOL] ~ {
isn: Isn ~ NARROW[br.data];
RETURN [isn.brs[isn.testFirst].HasPair[pair] AND isn.brs[isn.testLast].HasPair[pair]]};
IsnImage:
PROC [br: BiRel, set: Set, dir: Direction]
RETURNS [Set] ~ {
isn: Isn ~ NARROW[br.data];
RETURN [isn.brs[a].Image[set, dir].Intersection[isn.brs[b].Image[set, dir]]]};
IsnScanRestriction:
PROC [br: BiRel, sets: SetPair,
Test: Tester, ro: RelOrder]
RETURNS [MaybePair] ~ {
isn: Isn ~ NARROW[br.data];
Pass: PROC [x: Pair] RETURNS [BOOL] ~ {RETURN [isn.brs[isn.enumLast].HasPair[x] AND Test[x]]};
RETURN isn.brs[isn.enumFirst].ScanRestriction[sets, Pass, ro]};
IsnGet3:
PROC [br: BiRel, pair: Pair, ro: RelOrder, want: TripleBool]
RETURNS [TripleMaybePair] ~ {
isn: Isn ~ NARROW[br.data];
b2: BiRel ~ isn.brs[isn.getLast];
tmv: TripleMaybePair ← isn.brs[isn.getFirst].Get3[pair, ro, want];
IF tmv.same.found AND NOT b2.HasPair[tmv.same.it] THEN tmv.same ← noMaybePair;
WHILE tmv.prev.found AND NOT b2.HasPair[tmv.prev.it] DO tmv.prev ← b2.Prev[tmv.prev.it, ro] ENDLOOP;
WHILE tmv.next.found AND NOT b2.HasPair[tmv.next.it] DO tmv.next ← b2.Next[tmv.next.it, ro] ENDLOOP;
RETURN [tmv]};
IsnValueOf:
PROC [br: BiRel]
RETURNS [ConstBiRel] ~ {
isn: Isn ~ NARROW[br.data];
RETURN isn.brs[a].ValueOf.Intersection[isn.brs[b].ValueOf].AsConst};
IsnSetOn:
PROC [br: BiRel, side: Side]
RETURNS [UWSet] ~ {
isn: Isn ~ NARROW[br.data];
RETURN isn.brs[a].SetOn[side].Intersection[isn.brs[b].SetOn[side]]};
IsnCurSetOn:
PROC [br: BiRel, side: Side]
RETURNS [ConstSet] ~ {
isn: Isn ~ NARROW[br.data];
RETURN isn.brs[a].CurSetOn[side].Intersection[isn.brs[b].CurSetOn[side]].AsConst};
IsnSpaces:
PROC [br: BiRel]
RETURNS [SpacePair] ~ {
isn: Isn ~ NARROW[br.data];
RETURN isn.brs[a].Spaces[]};
IsnIsDense:
PROC [br: BiRel, when: When, side: Side]
RETURNS [
BOOL] ~ {
isn: Isn ~ NARROW[br.data];
RETURN [isn.brs[a].IsDense[when, side] AND isn.brs[b].IsDense[when, side]]};
IsnSideFixed:
PROC [br: BiRel, side: Side]
RETURNS [
BOOL] ~ {
isn: Isn ~ NARROW[br.data];
RETURN [isn.brs[a].SideFixed[side] AND isn.brs[b].SideFixed[side]]};
Unyn: TYPE ~ REF UnynPrivate;
UnynPrivate: TYPE ~ RECORD [spaces: SpacePair, a, b: BiRel, disjoint: BOOL, ro: RelOrder, canSize: BOOL, canIsDense: ARRAY When OF ARRAY Side OF BOOL];
Union:
PUBLIC
PROC [a, b: BiRel, disjoint:
BOOL ←
FALSE, ro: RelOrder ← []]
RETURNS [UWBiRel] ~ {
const: BOOL ~ a.MutabilityOf=constant AND b.MutabilityOf=constant;
fwd: BOOL ~ ro.sub[ro.first]=fwd;
bwd: BOOL ~ ro.sub[ro.first]=bwd;
canBound:
ARRAY Side
OF
BOOL ~ [
left: a.Can[$GetBounds, FromEB[[min: NOT fwd, max: NOT bwd]], $leftFwdNo] AND b.Can[$GetBounds, FromEB[[min: NOT bwd, max: NOT fwd]], $leftFwdNo],
right: a.Can[$GetBounds, FromEB[[min: NOT fwd, max: NOT bwd]], $rightFwdNo] AND b.Can[$GetBounds, FromEB[[min: NOT bwd, max: NOT fwd]], $rightFwdNo]
];
unn: Unyn ~
NEW [UnynPrivate ← [
spaces: a.Spaces,
a: a,
b: b,
disjoint: disjoint,
ro: ro,
canSize: disjoint AND a.Can[$Size] AND b.Can[$Size],
canIsDense: [
now: [
left: canBound[left]
AND a.Can[$IsDense, $now, $left]
AND b.Can[$IsDense, $now, $left],
right: canBound[right]
AND a.Can[$IsDense, $now, $right]
AND b.Can[$IsDense, $now, $right] ],
always: [
left: const
AND canBound[left]
AND a.Can[$IsDense, $always, $left]
AND b.Can[$IsDense, $always, $left],
right: const
AND canBound[right]
AND a.Can[$IsDense, $always, $right]
AND b.Can[$IsDense, $always, $right] ]]
]];
RETURN AsUW[[unionClasses [const] [unn.canSize] [unn.canIsDense[now][left] OR unn.canIsDense[now][right] OR unn.canIsDense[always][left] OR unn.canIsDense[always][right]], unn]]};
UnionClasses: TYPE ~ ARRAY --const--BOOL OF ARRAY --canSize--BOOL OF ARRAY --canIsDense--BOOL OF BiRelClass;
unionClasses: REF UnionClasses ~ NEW [UnionClasses];
UnionPrimitive:
PROC [br: BiRel, op:
ATOM, arg1, arg2:
REF
ANY]
RETURNS [PrimitiveAnswer] ~ {
unn: Unyn ~ NARROW[br.data];
SELECT op
FROM
$HasPair, $ScanRestriction, $Get3, $GetBounds, $ValueOf => RETURN [IF unn.a.Can[op, arg1, arg2] AND unn.b.Can[op, arg1, arg2] THEN yes ELSE no];
$RestrictionSize => RETURN [IF unn.canSize THEN yes ELSE no];
$IsDense => {when: When ~ ToWhen[arg1];
side: Side ~ ToSide[arg2];
RETURN [IF unn.canIsDense[when][side] THEN yes ELSE no];
};
ENDCASE => RETURN [pass];
};
UnionHasPair:
PROC [br: BiRel, pair: Pair]
RETURNS [
BOOL] ~ {
unn: Unyn ~ NARROW[br.data];
RETURN [unn.a.HasPair[pair] OR unn.b.HasPair[pair]]};
UnionScanRestriction:
PROC [br: BiRel, sets: SetPair,
Test: Tester, ro: RelOrder]
RETURNS [MaybePair] ~ {
unn: Unyn ~ NARROW[br.data];
cro: RelOrder ~ ro.CanonizeRelOrder[br.Functional];
second: Side ~ OtherSide[cro.first];
quot: Sets.RelOrder ~ cro.RODivide[unn.ro];
IF quot=no
THEN {
dro: TotalRelOrder ~ ConsRelOrder[cro.first, cro.sub[cro.first], cro.sub[IF cro.sub[second]=no THEN cro.first ELSE second]];
InterleavedConsume:
PROC [
Produce:
PROC [Which]
RETURNS [MaybePair]]
RETURNS [MaybePair] ~ {
mvA: MaybePair ← Produce[a];
mvB: MaybePair ← Produce[b];
WHILE mvA.found
AND mvB.found
DO
SELECT dro.RelPCompare[unn.spaces, mvB.it, mvA.it]
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]};
notrel => ERROR;
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 [noMaybePair]};
RETURN unn.a.InterleavedProduceRestriction[unn.b, InterleavedConsume, sets, sets, dro, dro]
}
ELSE {
plan: RECORD [s1, s2: BiRel] ~ IF quot=fwd THEN [unn.a, unn.b] ELSE [unn.b, unn.a];
{OPEN plan;
total: BOOL ~ cro.sub[cro.first]#no AND cro.sub[second]#no;
m1: MaybePair ~ s1.ScanRestriction[sets, Test, cro];
past: BOOL ← FALSE;
FilterAndTest:
PROC [v: Pair]
RETURNS [
BOOL] ~ {
IF NOT past THEN {IF s1.HasPair[v] THEN RETURN [FALSE]; past ← total};
RETURN Test[v]};
IF m1.found THEN RETURN [m1];
RETURN s2.ScanRestriction[sets, IF unn.disjoint THEN Test ELSE FilterAndTest, cro]}};
};
UnionGet3:
PROC [br: BiRel, pair: Pair, ro: RelOrder, want: TripleBool]
RETURNS [TripleMaybePair] ~ {
unn: Unyn ~ NARROW[br.data];
tmva: TripleMaybePair ~ unn.a.Get3[pair, ro, want];
tmvb: TripleMaybePair ~ unn.b.Get3[pair, ro, want];
RETURN [[
prev: IF tmva.prev.found THEN IF tmvb.prev.found THEN [TRUE, ro.RMin[unn.spaces, tmva.prev.it, tmvb.prev.it]] ELSE tmva.prev ELSE IF tmvb.prev.found THEN tmvb.prev ELSE noMaybePair,
same: IF tmva.same.found THEN tmva.same ELSE IF tmvb.same.found THEN tmvb.same ELSE noMaybePair,
next: IF tmva.next.found THEN IF tmvb.next.found THEN [TRUE, ro.RMax[unn.spaces, tmva.next.it, tmvb.next.it]] ELSE tmva.next ELSE IF tmvb.next.found THEN tmvb.next ELSE noMaybePair]]};
UnionRestrictionSize:
PROC [br: BiRel, sets: SetPair, limit:
EINT]
RETURNS [
EINT] ~ {
unn: Unyn ~ NARROW[br.data];
s1: EINT ~ unn.a.RestrictionSize[sets, limit];
IF s1.Compare[limit] >= equal THEN RETURN [s1];
{s2: EINT ~ unn.b.RestrictionSize[sets, limit.Sub[s1]];
RETURN s1.Add[s2]}};
UnionIsDense:
PROC [br: BiRel, when: When, side: Side]
RETURNS [
BOOL] ~ {
unn: Unyn ~ NARROW[br.data];
IF NOT unn.canIsDense[when][side] THEN RETURN [FALSE];
IF NOT (unn.a.IsDense[when, side] AND unn.b.IsDense[when, side]) THEN RETURN [FALSE];
{ro: RelOrder ~ ConsRelOrder[side, fwd, no];
fwd: BOOL ~ unn.ro.first=side AND unn.ro.sub[side]=fwd;
bwd: BOOL ~ unn.ro.first=side AND unn.ro.sub[side]=bwd;
ba: MaybeInterval ~ unn.a.GetBounds[[min: NOT fwd, max: NOT bwd], ro].MPISide[side];
bb: MaybeInterval ~ unn.b.GetBounds[[min: NOT bwd, max: NOT fwd], ro].MPISide[side];
IF NOT (ba.found AND bb.found) THEN RETURN [TRUE];
{part:
RECORD [disjoint:
BOOL, ro: Sets.RelOrder] ~
IF unn.disjoint AND (fwd OR bwd) THEN [unn.disjoint, unn.ro.sub[side]]
ELSE
SELECT unn.spaces[side].SCompare[bb.it[min], ba.it[max]]
FROM
greater => [TRUE, fwd],
equal => [FALSE, fwd],
less =>
SELECT unn.spaces[side].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.spaces[side] # 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 [br: BiRel, want: EndBools, ro: RelOrder]
RETURNS [MaybePairInterval] ~ {
unn: Unyn ~ NARROW[br.data];
ba: MaybePairInterval ~ unn.a.GetBounds[want, ro];
bb: MaybePairInterval ~ unn.b.GetBounds[want, ro];
IF NOT ba.found THEN RETURN [bb];
IF NOT bb.found THEN RETURN [ba];
RETURN [[
TRUE, [
min: IF want[min] THEN ro.RMin[unn.spaces, ba.it[min], bb.it[min]] ELSE noPair,
max: IF want[max] THEN ro.RMax[unn.spaces, ba.it[max], bb.it[max]] ELSE noPair]]]};
UnionValueOf:
PROC [br: BiRel]
RETURNS [ConstBiRel] ~ {
unn: Unyn ~ NARROW[br.data];
RETURN unn.a.ValueOf.Union[unn.b.ValueOf, unn.disjoint, unn.ro].AsConst};
UnionSpaces:
PROC [br: BiRel]
RETURNS [SpacePair] ~ {
unn: Unyn ~ NARROW[br.data];
RETURN [unn.spaces]};
Start:
PROC ~ {
FOR l2r:
BOOL
IN
BOOL
DO
FOR r2l:
BOOL
IN
BOOL
DO
FOR const:
BOOL
IN
BOOL
DO
isnClasses[l2r][r2l][const] ← CreateClass[[
Primitive: IsnPrimitive,
AsSet: IsnAsSet,
HasPair: IsnHasPair,
Image: IsnImage,
ScanRestriction: IsnScanRestriction,
Get3: IsnGet3,
ValueOf: IF NOT const THEN IsnValueOf ELSE NIL,
Spaces: IsnSpaces,
IsDense: IsnIsDense,
SideFixed: IsnSideFixed,
functional: [l2r, r2l],
mutability: IF const THEN constant ELSE readonly]];
ENDLOOP ENDLOOP ENDLOOP;
FOR const:
BOOL
IN
BOOL
DO
FOR canSize:
BOOL
IN
BOOL
DO
FOR canIsDense:
BOOL
IN
BOOL
DO
unionClasses[const][canSize][canIsDense] ← CreateClass[[
Primitive: UnionPrimitive,
HasPair: UnionHasPair,
ScanRestriction: UnionScanRestriction,
Get3: UnionGet3,
RestrictionSize: IF canSize THEN UnionRestrictionSize ELSE NIL,
IsDense: IF canIsDense THEN UnionIsDense ELSE NIL,
GetBounds: UnionGetBounds,
ValueOf: IF NOT const THEN UnionValueOf ELSE NIL,
Spaces: UnionSpaces,
mutability: IF const THEN constant ELSE readonly]];
ENDLOOP ENDLOOP ENDLOOP;
};
Start[];
END.