BiRelsBase.Mesa
Last tweaked by Mike Spreitzer on December 14, 1987 1:49:08 pm PST
DIRECTORY AbSets, Atom, BiRelBasics, BiRels, Rope, SetBasics;
BiRelsBase: CEDAR PROGRAM
IMPORTS AbSets, Atom, BiRelBasics, BiRels, Rope, SetBasics
EXPORTS BiRelBasics, BiRels
=
BEGIN OPEN SetBasics, Sets:AbSets, Sets, BiRelBasics, BiRels;
AcceptAny: PUBLIC PROC [Pair] RETURNS [BOOL] ~ {RETURN [TRUE]};
refNilSets: PUBLIC RefSetPair ~ NEW [SetPair ← ALL[nilSet]];
refSpacePairs: PUBLIC Space ~ NEW [SpacePrivate ← [
Contains: SpacePairsContains,
Hash: SpacePairsHash,
Equal: SpacePairsEqual,
Compare: SpacePairsCompare,
name: "SpacePairs"]];
SpacePairsContains: PROC [data: REF ANY, v: Value] RETURNS [BOOL] ~ TRUSTED {
RETURN [WITH v SELECT FROM
a => a#NIL AND ISTYPE[a, REF SetPair],
ENDCASE => FALSE]};
SpacePairsHash: PROC [data: REF ANY, v: Value] RETURNS [CARDINAL] ~ {
rsp: REF SpacePair ~ NARROW[v.VA];
RETURN [(spaceSpace.SHash[[a[rsp[left]]]]+1) * (spaceSpace.SHash[[a[rsp[right]]]]+109)]};
SpacePairsEqual: PROC [data: REF ANY, v1, v2: Value] RETURNS [BOOL] ~ {
rsp1: REF SpacePair ~ NARROW[v1.VA];
rsp2: REF SpacePair ~ NARROW[v2.VA];
RETURN [rsp1^ = rsp2^]};
SpacePairsCompare: PROC [data: REF ANY, v1, v2: Value] RETURNS [Comparison] ~ {
rsp1: REF SpacePair ~ NARROW[v1.VA];
rsp2: REF SpacePair ~ NARROW[v2.VA];
cl: Comparison ~ spaceSpace.SCompare[[a[rsp1[left]]], [a[rsp2[left]]]];
IF cl#equal THEN RETURN [cl];
RETURN spaceSpace.SCompare[[a[rsp1[right]]], [a[rsp2[right]]]]};
CanonizeRelOrder: PUBLIC PROC [ro: RelOrder, functional: BoolPair] RETURNS [RelOrder] ~ {
IF functional[From[ro.first]] THEN ro.sub[OtherSide[ro.first]] ← no;
IF ro.sub[ro.first]=no THEN ro.sub ← ALL[no];
RETURN [ro]};
ReverseRO: PUBLIC PROC [ro: RelOrder] RETURNS [RelOrder] ~ {
ro.sub[left] ← ro.sub[left].ReverseRO[];
ro.sub[right] ← ro.sub[right].ReverseRO[];
RETURN [ro]};
RODivide: PUBLIC PROC [num, den: --Canonical--RelOrder] RETURNS [Sets.RelOrder] ~ {
IF num.sub[num.first]=no THEN RETURN [fwd];
IF num.first#den.first OR den.sub[num.first]=no THEN RETURN [no];
{second: Side ~ OtherSide[num.first];
IF num.sub[num.first]=den.sub[num.first]
THEN RETURN [IF num.sub[second]=no OR num.sub[second]=den.sub[second] THEN fwd ELSE no]
ELSE RETURN [IF num.sub[second]=no OR num.sub[second].ReverseRO[]=den.sub[second] THEN bwd ELSE no];
}};
ToSide: PUBLIC PROC [arg: REF ANY, default: Side ← left] RETURNS [Side] ~ {
RETURN [SELECT arg FROM
NIL => default,
$left => left,
$right => right,
ENDCASE => ERROR]};
ToDir: PUBLIC PROC [arg: REF ANY, default: Direction ← leftToRight] RETURNS [Direction] ~ {
RETURN [SELECT arg FROM
NIL => default,
$leftToRight => leftToRight,
$rightToLeft => rightToLeft,
ENDCASE => ERROR]};
ToBiRel: PUBLIC PROC [arg: REF ANY] RETURNS [RefBiRel] ~ {
RETURN [WITH arg SELECT FROM
x: RefBiRel => x,
ENDCASE => ERROR]};
FromSets: PUBLIC PROC [sp: SetPair] RETURNS [RefSetPair] ~ {
IF sp = ALL[nilSet] THEN RETURN [refNilSets];
RETURN [NEW[SetPair ← sp]]};
ToSets: PUBLIC PROC [arg: REF ANY, default: RefSetPair ← refNilSets] RETURNS [RefSetPair] ~ {
IF arg=NIL THEN RETURN [default];
RETURN [NARROW[arg]]};
roCode: ARRAY Side OF ARRAY Sets.RelOrder OF ARRAY Sets.RelOrder OF ATOM ~ [
left: [
no: [$leftNoNo, $leftNoFwd, $leftNoBwd],
fwd: [$leftFwdNo, $leftFwdFwd, $leftFwdBwd],
bwd: [$leftBwdNo, $leftBwdFwd, $leftBwdBwd]],
right: [
no: [$rightNoNo, $rightNoFwd, $rightNoBwd],
fwd: [$rightFwdNo, $rightFwdFwd, $rightFwdBwd],
bwd: [$rightBwdNo, $rightBwdFwd, $rightBwdBwd]]
];
FromRO: PUBLIC PROC [ro: RelOrder] RETURNS [ATOM] ~ {
RETURN [roCode[ro.first][ro.sub[left]][ro.sub[right]]]};
ToRO: PUBLIC PROC [arg: REF ANY, default: RelOrder ← []] RETURNS [RelOrder] ~ {
IF arg=NIL THEN RETURN [default];
{a: ATOM ~ NARROW[arg];
val: REF RelOrder ~ NARROW[Atom.GetProp[atom: a, prop: roValKey]];
RETURN [val^]}};
roValKey: ATOM ~ $BiRelsImplROVal;
sideName: ARRAY Side OF ROPE ~ [left: "left", right: "right"];
sroName: ARRAY Sets.RelOrder OF ROPE ~ [no: "No", fwd: "Fwd", bwd: "Bwd"];
WidenPairSpace: PUBLIC PROC [ps: PairSpace] RETURNS [s: Space] ~ {
RETURN [NEW [SpacePrivate ← [
Contains: PairSpaceContains,
Equal: PairSpaceEqual,
Hash: PairSpaceHash,
Compare: PairSpaceCompare,
name: Rope.Cat["pairs[", ps.sp[left].name, ", ", ps.sp[right].name, "]"],
data: NEW [PairSpace ← ps]
]]];
};
QuaPairSpace: PUBLIC PROC [s: Space] RETURNS [MaybePairSpace] ~ {
WITH s.data SELECT FROM
x: REF PairSpace => IF
s.Contains = PairSpaceContains AND
s.Equal = PairSpaceEqual AND
s.Hash = PairSpaceHash AND
s.Compare = PairSpaceCompare
THEN RETURN [[TRUE, x^]];
ENDCASE => NULL;
RETURN [[FALSE, [[NIL, NIL], []]]]};
PairSpaceContains: PROC [data: REF ANY, v: Value] RETURNS [BOOL] ~ {
rps: REF PairSpace ~ NARROW[data];
WITH v SELECT FROM
x: RefAnyValue => WITH x.a SELECT FROM
x: REF Pair => RETURN [rps.sp[left].SContains[x[left]] AND rps.sp[right].SContains[x[right]]];
ENDCASE => NULL;
ENDCASE => NULL;
RETURN [FALSE]};
PairSpaceHash: PROC [data: REF ANY, v: Value] RETURNS [CARDINAL] ~ {
rps: REF PairSpace ~ NARROW[data];
WITH v SELECT FROM
x: RefAnyValue => WITH x.a SELECT FROM
x: REF Pair => RETURN HashIntI[INT[rps.sp[left].SHash[x[left]]]*259 + rps.sp[right].SHash[x[right]]];
ENDCASE => NULL;
ENDCASE => NULL;
ERROR};
PairSpaceEqual: PROC [data: REF ANY, v1, v2: Value] RETURNS [BOOL] ~ {
rps: REF PairSpace ~ NARROW[data];
WITH v1 SELECT FROM
x: RefAnyValue => WITH x.a SELECT FROM
x: REF Pair => WITH v2 SELECT FROM
y: RefAnyValue => WITH y.a SELECT FROM
y: REF Pair => RETURN PEqual[rps.sp, x^, y^];
ENDCASE => NULL;
ENDCASE => NULL;
ENDCASE => NULL;
ENDCASE => NULL;
ERROR};
PairSpaceCompare: PROC [data: REF ANY, v1, v2: Value] RETURNS [Comparison] ~ {
rps: REF PairSpace ~ NARROW[data];
WITH v1 SELECT FROM
x: RefAnyValue => WITH x.a SELECT FROM
x: REF Pair => WITH v2 SELECT FROM
y: RefAnyValue => WITH y.a SELECT FROM
y: REF Pair => RETURN rps.tro.RelCompare[rps.sp, x^, y^];
ENDCASE => NULL;
ENDCASE => NULL;
ENDCASE => NULL;
ENDCASE => NULL;
ERROR};
Equal: PUBLIC PROC [a, b: BiRel, bounds: SetPair ← []] RETURNS [BOOL] ~ {
spaces: SpacePair ~ a.Spaces[];
IF b.Spaces[]#spaces THEN ERROR;
{bound: BiRel ~ IF bounds[left]#nilSet THEN
IF bounds[right]#nilSet THEN CreateProduct[bounds] ELSE CreateProduct[[bounds[left], CreateFullSet[spaces[right]]]]
ELSE IF bounds[right]#nilSet THEN CreateProduct[[CreateFullSet[spaces[left]], bounds[right]]] ELSE nilBiRel;
ra: BiRel ~ IF bound#nilBiRel THEN a.Intersection[bound] ELSE a;
rb: BiRel ~ IF bound#nilBiRel THEN b.Intersection[bound] ELSE b;
RETURN ra.SymmetricDifference[rb].Empty}};
Hash: PUBLIC PROC [br: BiRel, bounds: SetPair ← []] RETURNS [hash: CARDINAL ← 0] ~ {
spaces: SpacePair ~ br.Spaces[];
Per: PROC [pair: Pair] RETURNS [BOOL] ~ {
hash ← hash + (spaces[left].SHash[pair[left]]+1) * (spaces[right].SHash[pair[right]]+1);
RETURN [FALSE]};
IF br.ScanRestriction[bounds, Per].found THEN ERROR;
RETURN};
Compare: PUBLIC PROC [a, b: BiRel, bounds: SetPair ← [], tro: TotalRelOrder ← [ALL[fwd]]] RETURNS [c: Comparison ← equal] ~ {
spaces: SpacePair ~ a.Spaces[];
Test: PROC [a, b: MaybePair] RETURNS [BOOL] ~ {
IF a.found < b.found THEN {c ← less; RETURN [TRUE]};
IF a.found > b.found THEN {c ← greater; RETURN [TRUE]};
c ← Totalify[tro.RelPCompare[spaces, a.it, b.it]];
RETURN [c#equal]};
IF b.Spaces[]#spaces THEN ERROR;
[] ← ParallelScanRestriction[a, b, Test, bounds, bounds, tro, tro];
RETURN};
CreateBiRelSpace: PUBLIC PROC [eltSpaces: SpacePair] RETURNS [Space] ~ {
RETURN [NEW [SpacePrivate ← [
Contains: BiRelsContains,
Equal: BiRelsEqual,
Hash: BiRelsHash,
Compare: BiRelsCompare,
name: Rope.Cat["birels between ", eltSpaces[left].name, " and ", eltSpaces[right].name],
data: NEW [SpacePair ← eltSpaces]
]]]};
QuaBiRelSpace: PUBLIC PROC [bs: Space] RETURNS [found: BOOL, eltSpaces: SpacePair] ~ {
IF bs.Compare = BiRelsCompare THEN RETURN [TRUE, NARROW[bs.data, REF SpacePair]^];
RETURN [FALSE, ALL[NIL]]};
BiRelsContains: PROC [data: REF ANY, v: Value] RETURNS [BOOL] ~ {
rsp: REF SpacePair ~ NARROW[data];
RETURN [WITH v SELECT FROM
x: RefAnyValue => WITH x.a SELECT FROM
y: RefBiRel => y^.Spaces[]=rsp^,
ENDCASE => FALSE,
ENDCASE => FALSE]};
BiRelsEqual: PROC [data: REF ANY, v1, v2: Value] RETURNS [BOOL] ~ {
rsp: REF SpacePair ~ NARROW[data];
rbr1: RefBiRel ~ NARROW[v1.VA];
rbr2: RefBiRel ~ NARROW[v2.VA];
IF rsp^ # rbr1^.Spaces[] THEN ERROR;
IF rsp^ # rbr2^.Spaces[] THEN ERROR;
RETURN rbr1^.Equal[rbr2^]};
BiRelsHash: PROC [data: REF ANY, v: Value] RETURNS [CARDINAL] ~ {
rsp: REF SpacePair ~ NARROW[data];
rbr: RefBiRel ~ NARROW[v.VA];
IF rsp^ # rbr^.Spaces[] THEN ERROR;
RETURN rbr^.Hash[]};
BiRelsCompare: PROC [data: REF ANY, v1, v2: Value] RETURNS [Comparison] ~ {
rsp: REF SpacePair ~ NARROW[data];
rbr1: RefBiRel ~ NARROW[v1.VA];
rbr2: RefBiRel ~ NARROW[v2.VA];
IF rsp^ # rbr1^.Spaces[] THEN ERROR;
IF rsp^ # rbr2^.Spaces[] THEN ERROR;
RETURN rbr1^.Compare[rbr2^]};
GetIntDom: PUBLIC PROC [br: BiRel, want: EndBools ← []] RETURNS [IntInterval] ~ {
mpi: MaybePairInterval ~ br.GetBounds[want];
RETURN IIntify[PISide[mpi.it, left]]};
Start: PROC ~ {
FOR first: Side IN Side DO FOR lo: Sets.RelOrder IN Sets.RelOrder DO FOR ro: Sets.RelOrder IN Sets.RelOrder DO
a: ATOM ~ Atom.MakeAtom[sideName[first].Cat[sroName[lo], sroName[ro]]];
Atom.PutProp[atom: a, prop: roValKey, val: NEW [RelOrder ← [[lo, ro], first]]];
ENDLOOP ENDLOOP ENDLOOP;
};
Start[];
END.