BiRelsBase.Mesa
Last tweaked by Mike Spreitzer on January 7, 1988 8:53:43 am PST
DIRECTORY AbSets, Atom, BiRelBasics, BiRels, Rope, SetBasics;
BiRelsBase:
CEDAR
MONITOR
IMPORTS AbSets, Atom, BiRelBasics, BiRels, Rope, SetBasics
EXPORTS BiRelBasics, BiRels
=
BEGIN OPEN SetBasics, Sets:AbSets, Sets, BiRelBasics, BiRels;
noPair: PUBLIC Pair ~ ALL[noValue];
noMaybePair: PUBLIC MaybePair ~ [FALSE, noPair];
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] ~ {
RETURN [
WITH v.ra
SELECT
FROM
x: RefSetPair => TRUE,
ENDCASE => FALSE]};
SpacePairsHash:
PROC [data:
REF
ANY, v: Value]
RETURNS [
CARDINAL] ~ {
rsp: REF SpacePair ~ NARROW[v.VA];
RETURN [(spaceSpace.SHash[AV[rsp[left]]]+1) * (spaceSpace.SHash[AV[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[AV[rsp1[left]], AV[rsp2[left]]];
IF cl#equal THEN RETURN [cl];
RETURN spaceSpace.SCompare[AV[rsp1[right]], AV[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]};
CacheStats: TYPE ~ RECORD [probes, misses: CARD ← 0];
lastSets: ARRAY BOOL OF SetPair ← ALL[ALL[nilSet]];
lastRefSets: ARRAY BOOL OF RefSetPair ← ALL[NIL];
mruB: BOOL ← FALSE;
stats: CacheStats ← [];
FromSets:
PUBLIC
ENTRY
PROC [sp: SetPair]
RETURNS [RefSetPair] ~ {
ENABLE UNWIND => NULL;
IF sp = ALL[nilSet] THEN RETURN [refNilSets];
IF sp[left]#nilSet AND sp[left].class.IsSingletonClass[] THEN sp[left].data ← noValue;
IF sp[right]#nilSet AND sp[right].class.IsSingletonClass[] THEN sp[right].data ← noValue;
stats.probes ← stats.probes + 1;
IF sp = lastSets[mruB] THEN RETURN [lastRefSets[mruB]];
mruB ← NOT mruB;
IF sp = lastSets[mruB] THEN RETURN [lastRefSets[mruB]];
stats.misses ← stats.misses + 1;
RETURN [lastRefSets[mruB] ← NEW[SetPair ← lastSets[mruB] ← 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.ra
SELECT
FROM
x: REF Pair => RETURN [rps.sp[left].SContains[x[left]] AND rps.sp[right].SContains[x[right]]];
ENDCASE => NULL;
RETURN [FALSE]};
PairSpaceHash:
PROC [data:
REF
ANY, v: Value]
RETURNS [
CARDINAL] ~ {
rps: REF PairSpace ~ NARROW[data];
WITH v.ra
SELECT
FROM
x: REF Pair => RETURN HashIntI[INT[rps.sp[left].SHash[x[left]]]*259 + rps.sp[right].SHash[x[right]]];
ENDCASE => NULL;
ERROR};
PairSpaceEqual:
PROC [data:
REF
ANY, v1, v2: Value]
RETURNS [
BOOL] ~ {
rps: REF PairSpace ~ NARROW[data];
WITH v1.ra
SELECT
FROM
x:
REF Pair =>
WITH v2.ra
SELECT
FROM
y: REF Pair => RETURN PEqual[rps.sp, x^, y^];
ENDCASE => NULL;
ENDCASE => NULL;
ERROR};
PairSpaceCompare:
PROC [data:
REF
ANY, v1, v2: Value]
RETURNS [Comparison] ~ {
rps: REF PairSpace ~ NARROW[data];
WITH v1.ra
SELECT
FROM
x:
REF Pair =>
WITH v2.ra
SELECT
FROM
y: REF Pair => RETURN rps.tro.RelCompare[rps.sp, x^, y^];
ENDCASE => NULL;
ENDCASE => NULL;
ERROR};
Equal:
PUBLIC
PROC [a, b: BiRel, bounds: SetPair ← []]
RETURNS [
BOOL] ~ {
spaces: SpacePair ~ a.Spaces[];
easy: BOOL ~ bounds=[];
Try:
PROC [x, y: BiRel]
RETURNS [
BOOL] ~ {
LookInX: PROC [p: Pair] RETURNS [BOOL] ~ {RETURN [NOT x.HasPair[p]]};
RETURN [NOT y.ScanRestriction[bounds, LookInX].found]};
IF b.Spaces[]#spaces THEN ERROR;
IF easy AND a.Size[]#b.Size[] THEN RETURN [FALSE];
RETURN [Try[a, b] AND (easy OR Try[b, a])]};
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.ra
SELECT
FROM
y: RefBiRel => y^.Spaces[]=rsp^,
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.