BiRelComposition.Mesa
Last tweaked by Mike Spreitzer on December 14, 1987 2:01:27 pm PST
DIRECTORY BiRelBasics, BiRels, IntStuff, SetBasics, AbSets;
BiRelComposition:
CEDAR
PROGRAM
IMPORTS BiRelBasics, BiRels, SetBasics, AbSets
EXPORTS BiRels
=
BEGIN OPEN SetBasics, Sets:AbSets, Sets, BiRelBasics, BiRels;
Composition: TYPE ~ REF CompositionPrivate;
CompositionPrivate:
TYPE ~
RECORD [
brs: ARRAY Side OF BiRel,
restricts: ARRAY Side OF BOOL,
spaces: SpacePair,
hasFirst: Side ← left,
easyScan: BOOL ← FALSE,
scanMappable: BoolPair ← [TRUE, FALSE]
];
Compose:
PUBLIC
PROC [left, right: BiRel, restricts:
ARRAY Side
OF
BOOL ← [
TRUE,
TRUE]]
RETURNS [BiRel] ~ {
constant: BOOL ~ left.MutabilityOf[]=constant AND right.MutabilityOf[]=constant;
fnl: BoolPair ~ [
left.Functional[][leftToRight] AND right.Functional[][leftToRight],
left.Functional[][rightToLeft] AND right.Functional[][rightToLeft]];
c: Composition ~
NEW [CompositionPrivate ← [
brs: [left, right],
restricts: restricts,
spaces: [left.Spaces[][left], right.Spaces[][right]]
]];
{q:
ARRAY Side
OF ImplQuality ~ [
QMin[QualityOf[c.brs[left], $ScanMapping, $leftToRight], QualityOf[c.brs[right], $HasPair]],
QMin[QualityOf[c.brs[right], $ScanMapping, $rightToLeft], QualityOf[c.brs[left], $HasPair]]];
c.hasFirst ← IF q[right] > q[left] THEN right ELSE left};
IF left.Functional[][leftToRight] OR right.Functional[][rightToLeft] THEN c.easyScan ← TRUE;
IF (NOT c.easyScan) AND fnl = [FALSE, TRUE] THEN c.scanMappable ← [FALSE, TRUE];
RETURN [[compClasses[IF constant THEN constant ELSE readonly][fnl[leftToRight]][fnl[rightToLeft]], c]]};
CompClasses: TYPE ~ ARRAY UnwriteableMutability OF ARRAY --fnl[l2r]--BOOL OF ARRAY --fnl[r2l]--BOOL OF BiRelClass;
compClasses: REF CompClasses ~ NEW [CompClasses];
CompPrimitive:
PROC [br: BiRel, op:
ATOM, arg1, arg2:
REF
ANY ←
NIL]
RETURNS [PrimitiveAnswer] ~ {
c: Composition ~ NARROW[br.data];
SELECT op
FROM
$Index => RETURN [IF c.brs[left].IsOneToOne THEN yes ELSE no];
$SetOn, $CurSetOn => {side: Side ~ ToSide[arg1];
RETURN [IF NOT c.restricts[OtherSide[side]] THEN yes ELSE no]};
$IsDense => {side: Side ~ ToSide[arg2];
RETURN [IF NOT c.restricts[OtherSide[side]] THEN yes ELSE no]};
$SideFixed => {side: Side ~ ToSide[arg1];
RETURN [IF br.MutabilityOf[]=constant OR NOT c.restricts[OtherSide[side]] THEN yes ELSE no]};
ENDCASE => RETURN [pass];
};
CompHasPair:
PROC [br: BiRel, pair: Pair]
RETURNS [has:
BOOL] ~ {
c: Composition ~ NARROW[br.data];
s1: Side ~ c.hasFirst;
s2: Side ~ OtherSide[s1];
PerMap:
PROC [val: Value]
RETURNS [pass:
BOOL] ~
TRUSTED {
pair[s1] ← val;
pass ← c.brs[s2].HasPair[pair];
RETURN};
has ← c.brs[s1].ScanMapping[pair[s1], PerMap, From[s1]].found;
RETURN};
CompImage:
PROC [br: BiRel, set: Set, dir: Direction]
RETURNS [Set] ~ {
c: Composition ~ NARROW[br.data];
RETURN c.brs[Dest[dir]].Image[c.brs[Source[dir]].Image[set, dir], dir]};
CompApply:
PROC [br: BiRel, v: Value, dir: Direction]
RETURNS [MaybeValue] ~ {
c: Composition ~ NARROW[br.data];
mid: MaybeValue ~ c.brs[Source[dir]].Apply[v, dir];
IF NOT mid.found THEN RETURN [noMaybe];
RETURN c.brs[Dest[dir]].Apply[mid.it, dir]};
CompScanRestriction:
PROC [br: BiRel, sets: SetPair,
Test: Tester, ro: RelOrder]
RETURNS [mp: MaybePair ← noMaybePair] ~ {
c: Composition ~ NARROW[br.data];
q: ARRAY Side OF ImplQuality;
seen: BiRel ← nilBiRel;
IF NOT c.easyScan THEN seen ← CreateHashReln[spaces: br.Spaces[], functional: br.Functional[], mappable: c.scanMappable];
FOR s1: Side
IN Side
DO
s2: Side ~ OtherSide[s1];
dir: Direction ~ From[s1];
iro: RelOrder ~ ConsRelOrder[s2, ro.sub[s2]];
set2: Set ~ sets[s2];
q[s1] ← QMin[
c.brs[s1].QualityOf[$ScanRestriction, FromSets[ConsSets[s1, sets[s1]]], FromRO[ConsRelOrder[s1, ro.sub[s1]]]],
QMin[
c.brs[s2].QualityOf[$ScanMapping, FromDir[dir], Sets.FromRO[ro.sub[s2]]],
IF IsNil[set2] THEN primitive ELSE set2.QualityOf[$HasMember]]];
ENDLOOP;
IF q=ALL[cant] THEN br.Cant[];
{
s1: Side ~ IF q[right]>q[left] THEN right ELSE left;
s2: Side ~ OtherSide[s1];
dir: Direction ~ From[s1];
set2: Set ~ sets[s2];
Outer:
PROC [pair: Pair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
test: Pair ← ALL[pair[s1]];
mapping: Set ~ c.brs[s2].Mapping[pair[s2], dir];
Inner:
PROC [val: Value]
RETURNS [pass:
BOOL ←
FALSE] ~
TRUSTED {
IF NOT (IsNil[set2] OR set2.HasMember[val]) THEN RETURN;
test[s2] ← val;
IF c.easyScan
OR
NOT seen.HasPair[test]
THEN {
IF NOT c.easyScan THEN [] ← seen.AddPair[test];
IF (pass ← Test[test]) THEN mp ← [TRUE, test];
};
RETURN};
pass ← mapping.Scan[Inner, ro.sub[s2]].found;
RETURN};
[] ← c.brs[s1].ScanRestriction[ConsSets[s1, sets[s1]], Outer, ConsRelOrder[s1, ro.sub[s1]]];
RETURN}};
CompGet3:
PROC [br: BiRel, pair: Pair, ro: RelOrder, want: TripleBool]
RETURNS [tmp: TripleMaybePair ← [noMaybePair, noMaybePair, noMaybePair]] ~
TRUSTED {
c: Composition ~ NARROW[br.data];
ro ← ro.CanonizeRelOrder[br.Functional[]];
IF ro.sub[ro.first]=no
THEN {
IF NOT br.Empty[] THEN tmp.same ← [TRUE, pair];
RETURN};
{s1: Side ~ ro.first;
s2: Side ~ OtherSide[s1];
dir: Direction ~ From[s1];
ro1: RelOrder ~ ConsRelOrder[s1, ro.sub[s1]];
pNext, pPrev: MaybePair ← [TRUE, pair];
mNext, mPrev: Set ← br.Mapping[pair[s1], dir];
tmp.same ←
IF ro.sub[s2]=no
THEN IF mNext.Empty[] THEN noMaybePair ELSE [TRUE, pair]
ELSE IF mNext.HasMember[pair[s2]] THEN [TRUE, pair] ELSE noMaybePair;
IF want.prev
THEN
DO
this: MaybeValue ~ IF ro.sub[s2]=fwd THEN mPrev.Get3[pair[s2], [TRUE, FALSE, FALSE]].prev ELSE mPrev.Get3[pair[s2], [FALSE, FALSE, TRUE]].next;
IF this.found THEN {tmp.prev ← [TRUE, Cons[s1, pair[s1], this.it]]; EXIT};
pPrev ← c.brs[s1].Get3[pPrev.it, ro1, [TRUE, FALSE, FALSE]].prev;
IF NOT pPrev.found THEN EXIT;
mPrev ← br.Mapping[pPrev.it[s1], dir];
ENDLOOP;
IF want.next
THEN
DO
this: MaybeValue ~ IF ro.sub[s2]=fwd THEN mNext.Get3[pair[s2], [FALSE, FALSE, TRUE]].next ELSE mNext.Get3[pair[s2], [TRUE, FALSE, FALSE]].prev;
IF this.found THEN {tmp.next ← [TRUE, Cons[s1, pair[s1], this.it]]; EXIT};
pNext ← c.brs[s1].Get3[pNext.it, ro1, [TRUE, FALSE, FALSE]].next;
IF NOT pNext.found THEN EXIT;
mNext ← br.Mapping[pNext.it[s1], dir];
ENDLOOP;
RETURN}};
CompIndex:
PROC [br, goal: IntRel, bounds: IntInterval, bwd:
BOOL]
RETURNS [MaybeValue] ~ {
c: Composition ~ NARROW[br.data];
IF c.brs[left].IsOneToOne THEN RETURN c.brs[left].Index[goal.Compose[c.brs[right].Invert[]], bounds, bwd];
RETURN DefaultIndex[br, goal, bounds, bwd]};
CompRestrictionSize:
PROC [br: BiRel, sets: SetPair, limit:
EINT]
RETURNS [
EINT] ~ {
c: Composition ~ NARROW[br.data];
FOR dir: Direction
IN Direction
DO
s2: Side ~ Dest[dir];
IF IsNil[sets[s2]] AND c.brs[s2].Functional[][dir] AND NOT c.restricts[s2] THEN RETURN c.brs[Source[dir]].RestrictionSize[sets, limit];
ENDLOOP;
FOR dir: Direction
IN Direction
DO
s1: Side ~ Source[dir];
s2: Side ~ Dest[dir];
IF c.brs[s2].IsOneToOne AND NOT c.restricts[s2] AND (NOT IsNil[sets[s2]]) THEN RETURN c.brs[s1].RestrictionSize[ConsSets[s1, sets[s1], c.brs[s2].Invert[].Image[sets[s2], From[s2]]], limit];
ENDLOOP;
FOR dir: Direction
DECREASING
IN Direction
DO
s1: Side ~ Source[dir];
s2: Side ~ Dest[dir];
IF br.Functional[][dir] OR dir=leftToRight THEN RETURN c.brs[s2].ImageSize[IF IsNil[sets[s1]] THEN c.brs[s1].SetOn[s2] ELSE c.brs[s1].Image[sets[s1], dir], dir, limit];
ENDLOOP;
ERROR};
CompValueOf:
PROC [br: BiRel]
RETURNS [ConstBiRel] ~ {
c: Composition ~ NARROW[br.data];
RETURN c.brs[left].Compose[c.brs[right], c.restricts].AsConst};
CompSetOn:
PROC [br: BiRel, side: Side]
RETURNS [UWSet] ~ {
c: Composition ~ NARROW[br.data];
IF NOT c.restricts[OtherSide[side]] THEN RETURN c.brs[side].SetOn[side];
RETURN DefaultSetOn[br, side]};
CompCurSetOn:
PROC [br: BiRel, side: Side]
RETURNS [ConstSet] ~ {
c: Composition ~ NARROW[br.data];
IF NOT c.restricts[OtherSide[side]] THEN RETURN c.brs[side].CurSetOn[side];
RETURN DefaultCurSetOn[br, side]};
CompSpaces:
PROC [br: BiRel]
RETURNS [SpacePair] ~ {
c: Composition ~ NARROW[br.data];
RETURN [c.spaces]};
CompIsDense:
PROC [br: BiRel, when: When, side: Side]
RETURNS [
BOOL] ~ {
c: Composition ~ NARROW[br.data];
IF NOT c.restricts[OtherSide[side]] THEN RETURN c.brs[side].IsDense[when, side];
RETURN DefaultIsDense[br, when, side]};
CompSideFixed:
PROC [br: BiRel, side: Side]
RETURNS [
BOOL] ~ {
c: Composition ~ NARROW[br.data];
IF br.MutabilityOf[]=constant THEN RETURN [TRUE];
IF NOT c.restricts[OtherSide[side]] THEN RETURN c.brs[side].SideFixed[side];
RETURN DefaultSideFixed[br, side]};
Start:
PROC ~ {
FOR mut: UnwriteableMutability
IN UnwriteableMutability
DO
FOR l2r:
BOOL
IN
BOOL
DO
FOR r2l:
BOOL
IN
BOOL
DO
compClasses[mut][l2r][r2l] ← CreateClass[[
Primitive: CompPrimitive,
HasPair: CompHasPair,
Image: CompImage,
Apply: CompApply,
ScanRestriction: CompScanRestriction,
Get3: CompGet3,
Index: CompIndex,
RestrictionSize: CompRestrictionSize,
ValueOf: CompValueOf,
SetOn: CompSetOn,
CurSetOn: CompCurSetOn,
Spaces: CompSpaces,
IsDense: CompIsDense,
SideFixed: CompSideFixed,
functional: [l2r, r2l],
mutability: mut]];
ENDLOOP ENDLOOP ENDLOOP;
};
Start[];
END.