BiRelsInverting.Mesa
Last tweaked by Mike Spreitzer on December 15, 1987 4:35:42 pm PST
DIRECTORY AbSets, Atom, BiRelBasics, BiRels, BiRelsPrivate, IntStuff, SetBasics;
BiRelsInverting:
CEDAR
PROGRAM
IMPORTS AbSets, Atom, BiRelBasics, BiRels, SetBasics
EXPORTS BiRels
=
BEGIN OPEN SetBasics, Sets:AbSets, Sets, BiRelBasics, BiRels;
Invert:
PUBLIC
PROC [br: BiRel]
RETURNS [BiRel] ~ {
IF br.class = invClasses [br.Functional[][leftToRight]] [br.Functional[][rightToLeft]] [br.MutabilityOf] THEN RETURN DeRef[br.data];
RETURN [[
invClasses
[br.Functional[][rightToLeft]]
[br.Functional[][leftToRight]]
[br.MutabilityOf],
br.Refify]]};
InvClasses: TYPE ~ ARRAY BOOL OF ARRAY BOOL OF ARRAY Mutability OF BiRelClass;
invClasses: REF InvClasses ~ NEW [InvClasses];
kindKey: ATOM ~ $BiRelsImplKind;
InvPrimitive:
PROC [br: BiRel, op:
ATOM, arg1, arg2:
REF
ANY]
RETURNS [PrimitiveAnswer] ~ {
SELECT op
FROM
$HasPair, $Image, $Apply, $ScanRestriction, $GetOne, $Get3, $RestrictionSize, $GetBounds, $Copy, $Insulate, $ValueOf, $Freeze, $Thaw, $SetOn, $CurSetOn, $AddPair, $AddSet, $Swap, $RemPair, $RemSet, $Delete, $DeleteSet, $Spaces, $IsDense, $SideFixed => {
rbr: REF BiRel ~ NARROW[br.data];
WITH Atom.GetProp[op, kindKey]
SELECT
FROM
a:
ATOM =>
SELECT a
FROM
$always => ERROR;
$argless => IF arg1#NIL THEN ERROR;
$composite => ERROR;
ENDCASE => ERROR;
types:
REF BiRelsPrivate.ArgTyping => {
arg1 ← InvArg[arg1, types[1]];
arg2 ← InvArg[arg2, types[2]];
};
ENDCASE => ERROR;
RETURN [IF rbr^.GoodImpl[op, arg1, arg2] THEN yes ELSE no];
};
ENDCASE => RETURN [no];
};
InvArg:
PROC [arg:
REF
ANY, type: BiRelsPrivate.ArgType]
RETURNS [
REF
ANY] ~ {
this:
REF
ANY ~
SELECT type
FROM
$EndBools, $limit, $remove, $Set, $Want3, $When => arg,
$BiRel => ToBiRel[arg]^.Invert.Refify,
$Dir => FromDir[OtherDirection[ToDir[arg]]],
$None => IF arg=NIL THEN arg ELSE ERROR,
$RelOrder, $RelOrderFN => FromRO[InvertRelOrder[ToRO[arg]]],
$SetPair => FromSets[InvertSetPair[ToSets[arg]^]],
$Side => FromSide[OtherSide[ToSide[arg]]],
ENDCASE => ERROR;
RETURN [this]};
InvHasPair:
PROC [br: BiRel, pair: Pair]
RETURNS [
BOOL] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.HasPair[InvertPair[pair]]};
InvImage:
PROC [br: BiRel, set: Set, dir: Direction]
RETURNS [Set] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.Image[set, OtherDirection[dir]]};
InvApply:
PROC [br: BiRel, v: Value, dir: Direction]
RETURNS [MaybeValue] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.Apply[v, OtherDirection[dir]]};
InvScanRestriction:
PROC [br: BiRel, sets: SetPair,
Test: Tester, ro: RelOrder]
RETURNS [MaybePair] ~ {
rbr: REF BiRel ~ NARROW[br.data];
Pass: PROC [pair: Pair] RETURNS [BOOL] ~ {RETURN Test[InvertPair[pair]]};
RETURN rbr^.ScanRestriction[InvertSetPair[sets], Pass, ro.InvertRelOrder].InvertMaybe};
InvGetOne:
PROC [br: BiRel, remove:
BOOL, ro: RelOrder]
RETURNS [MaybePair] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.GetOne[remove, ro.InvertRelOrder].InvertMaybe};
InvGet3:
PROC [br: BiRel, pair: Pair, ro: RelOrder, want: TripleBool]
RETURNS [TripleMaybePair] ~ {
rbr: REF BiRel ~ NARROW[br.data];
tmp: TripleMaybePair ~ rbr^.Get3[InvertPair[pair], InvertRelOrder[ro], want];
RETURN [[tmp.prev.InvertMaybe, tmp.same.InvertMaybe, tmp.next.InvertMaybe]]};
InvRestrictionSize:
PROC [br: BiRel, sets: SetPair, limit:
EINT]
RETURNS [
EINT] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.RestrictionSize[InvertSetPair[sets], limit]};
InvGetBounds:
PROC [br: BiRel, want: EndBools, ro: RelOrder]
RETURNS [MaybePairInterval] ~ {
rbr: REF BiRel ~ NARROW[br.data];
mpi: MaybePairInterval ~ rbr^.GetBounds[want, InvertRelOrder[ro]];
RETURN [[mpi.found, [InvertPair[mpi.it[min]], InvertPair[mpi.it[max]]]]]};
InvCopy:
PROC [br: BiRel]
RETURNS [VarBiRel] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.Copy.Invert.AsVar};
InvInsulate:
PROC [br: BiRel]
RETURNS [UWBiRel] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.Insulate.Invert.AsUW};
InvValueOf:
PROC [br: BiRel]
RETURNS [ConstBiRel] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.ValueOf.Invert.AsConst};
InvFreeze:
PROC [br: BiRel]
RETURNS [ConstBiRel] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.Freeze.Invert.AsConst};
InvThaw:
PROC [br: BiRel] ~ {
rbr: REF BiRel ~ NARROW[br.data];
rbr^.Thaw[];
RETURN};
InvSetOn:
PROC [br: BiRel, side: Side]
RETURNS [UWSet] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.SetOn[OtherSide[side]]};
InvCurSetOn:
PROC [br: BiRel, side: Side]
RETURNS [ConstSet] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.CurSetOn[OtherSide[side]]};
InvAddPair:
PROC [br: BiRel, pair: Pair, if: IfHadPair ← alwaysAdd]
RETURNS [had: HadPair] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN [InvertHadPair[rbr^.AddPair[pair, InvertIfHadPair[if]]]]};
InvAddSet:
PROC [br, other: BiRel, if: IfHadPair]
RETURNS [some: HadSetPair] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN [InvertHadSetPair[rbr^.AddSet[other.Invert, InvertIfHadPair[if]]]]};
InvSwap:
PROC [br: BiRel, a, b: Value, side: Side] ~ {
rbr: REF BiRel ~ NARROW[br.data];
rbr^.Swap[a, b, OtherSide[side]];
RETURN};
InvRemPair:
PROC [br: BiRel, pair: Pair]
RETURNS [had: HadPair] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN [InvertHadPair[rbr^.RemPair[pair]]]};
InvRemSet:
PROC [br, other: BiRel]
RETURNS [some: HadSetPair] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN [InvertHadSetPair[rbr^.RemSet[other.Invert]]]};
InvDelete:
PROC [br: BiRel, val: Value, side: Side ← left]
RETURNS [hadSome:
BOOL] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.Delete[val, OtherSide[side]]};
InvDeleteSet:
PROC [br: BiRel, set: Set, side: Side]
RETURNS [had: SomeAll] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.DeleteSet[set, OtherSide[side]]};
InvSpaces:
PROC [br: BiRel]
RETURNS [SpacePair] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN InvertSpacePair[rbr^.Spaces]};
InvIsDense:
PROC [br: BiRel, when: When, side: Side]
RETURNS [
BOOL] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.IsDense[when, OtherSide[side]]};
InvSideFixed:
PROC [br: BiRel, side: Side]
RETURNS [
BOOL] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.SideFixed[OtherSide[side]]};
Start:
PROC ~ {
FOR l2r:
BOOL
IN
BOOL
DO
FOR r2l:
BOOL
IN
BOOL
DO
FOR mut: Mutability
IN Mutability
DO
invClasses[l2r][r2l][mut] ← CreateClass[[
Primitive: InvPrimitive,
HasPair: InvHasPair,
Image: InvImage,
Apply: InvApply,
ScanRestriction: InvScanRestriction,
GetOne: InvGetOne,
Get3: InvGet3,
RestrictionSize: InvRestrictionSize,
GetBounds: InvGetBounds,
Copy: InvCopy,
Insulate: IF mut=variable THEN InvInsulate ELSE NIL,
ValueOf: IF mut#constant THEN InvValueOf ELSE NIL,
Freeze: IF mut=variable THEN InvFreeze ELSE NIL,
Thaw: IF mut=variable THEN InvThaw ELSE NIL,
SetOn: InvSetOn,
CurSetOn: InvCurSetOn,
AddPair: IF mut=variable THEN InvAddPair ELSE NIL,
AddSet: IF mut=variable THEN InvAddSet ELSE NIL,
Swap: IF mut=variable THEN InvSwap ELSE NIL,
RemPair: IF mut=variable THEN InvRemPair ELSE NIL,
RemSet: IF mut=variable THEN InvRemSet ELSE NIL,
Delete: IF mut=variable THEN InvDelete ELSE NIL,
DeleteSet: IF mut=variable THEN InvDeleteSet ELSE NIL,
Spaces: InvSpaces,
IsDense: InvIsDense,
SideFixed: InvSideFixed,
functional: [l2r, r2l],
mutability: mut]];
ENDLOOP ENDLOOP ENDLOOP;
RETURN};
Start[];
END.