BiRelDefaults3.Mesa
Last tweaked by Mike Spreitzer on January 20, 1988 8:32:51 pm PST
DIRECTORY AbSets, Atom, BiRelBasics, BiRels, IntStuff, SetBasics;
BiRelDefaults3:
CEDAR
PROGRAM
IMPORTS AbSets, BiRelBasics, BiRels, SetBasics
EXPORTS BiRels
=
BEGIN OPEN IntStuff, SetBasics, Sets:AbSets, Sets, BiRelBasics, BiRels;
DefaultInsulate:
PUBLIC
PROC [br: BiRel]
RETURNS [UWBiRel] ~ {
fnl: BoolPair ~ br.Functional[];
RETURN AsUW[[insClasses[fnl[leftToRight]][fnl[rightToLeft]], br.Refify]]};
InsClasses: TYPE ~ ARRAY --l2r--BOOL OF ARRAY --r2l--BOOL OF BiRelClass;
insClasses: REF InsClasses ~ NEW [InsClasses];
InsPrimitive:
PROC [br: BiRel, op:
ATOM, arg1, arg2:
REF
ANY ←
NIL]
RETURNS [PrimitiveAnswer] ~ {
rbr: REF BiRel ~ NARROW[br.data];
SELECT op
FROM
$AsSet, $HasPair, $Image, $Apply, $ScanRestriction, $Get3, $Index, $RestrictionSize, $GetBounds, $Copy, $ValueOf, $SetOn, $CurSetOn, $Update, $Spaces, $IsDense, $SideFixed => RETURN [IF rbr^.Primitive[op, arg1, arg2] THEN yes ELSE no];
$GetOne => {
remove: BOOL ~ ToBool[arg1];
RETURN [IF remove OR rbr^.GoodImpl[op, arg1, arg2] THEN yes ELSE no]};
ENDCASE => RETURN [no];
};
InsAsSet:
PROC [br: BiRel, ro: RelOrder]
RETURNS [Set
--of REF Pair--] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.Insulate.AsSet[ro]};
InsHasPair:
PROC [br: BiRel, pair: Pair]
RETURNS [
BOOL] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.HasPair[pair]};
InsImage:
PROC [br: BiRel, set: Set, dir: Direction]
RETURNS [Set] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN [rbr^.Image[set, dir].Insulate]};
InsApply:
PROC [br: BiRel, v: Value, dir: Direction]
RETURNS [MaybeValue] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.Apply[v, dir]};
InsScanRestriction:
PROC [br: BiRel, sets: SetPair,
Test: Tester, ro: RelOrder]
RETURNS [MaybePair] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.ScanRestriction[sets, Test, ro]};
InsGetOne:
PROC [br: BiRel, remove:
BOOL, ro: RelOrder]
RETURNS [MaybePair] ~ {
rbr: REF BiRel ~ NARROW[br.data];
IF remove THEN br.Complain[notVariable];
RETURN rbr^.GetOne[remove, ro]};
InsGet3:
PROC [br: BiRel, pair: Pair, ro: RelOrder, want: TripleBool]
RETURNS [TripleMaybePair] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.Get3[pair, ro, want]};
InsIndex:
PROC [br, goal: IntRel, bounds: IntInterval, bwd:
BOOL]
RETURNS [MaybeValue] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.Index[goal, bounds, bwd]};
InsRestrictionSize:
PROC [br: BiRel, sets: SetPair, limit:
EINT]
RETURNS [
EINT] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.RestrictionSize[sets, limit]};
InsGetBounds:
PROC [br: BiRel, want: EndBools, ro: RelOrder]
RETURNS [MaybePairInterval] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.GetBounds[want, ro]};
InsCopy:
PROC [br: BiRel]
RETURNS [VarBiRel] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.Copy};
InsValueOf:
PROC [br: BiRel]
RETURNS [ConstBiRel] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.ValueOf};
InsSetOn:
PROC [br: BiRel, side: Side]
RETURNS [UWSet] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.SetOn[side]};
InsCurSetOn:
PROC [br: BiRel, side: Side]
RETURNS [ConstSet] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.CurSetOn[side]};
InsUpdate:
PROC [br: BiRel, val: Value, dir: Direction,
Decide: UpdateDecider] ~ {
rbr: REF BiRel ~ NARROW[br.data];
InsulateDecide:
PROC [old: MaybeValue]
RETURNS [new: MaybeValue] ~ {
new ← Decide[old];
IF NOT (new=old OR new.found AND old.found AND rbr^.Spaces[][Dest[dir]].SEqual[old.it, new.it] OR (NOT new.found) AND (NOT old.found)) THEN br.Complain[notVariable];
RETURN};
rbr^.Update[val, dir, InsulateDecide];
RETURN};
InsSpaces:
PROC [br: BiRel]
RETURNS [SpacePair] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.Spaces[]};
InsIsDense:
PROC [br: BiRel, when: When, side: Side]
RETURNS [
BOOL] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.IsDense[when, side]};
InsSideFixed:
PROC [br: BiRel, side: Side]
RETURNS [
BOOL] ~ {
rbr: REF BiRel ~ NARROW[br.data];
RETURN rbr^.SideFixed[side]};
DefaultRemPair:
PUBLIC
PROC [br: BiRel, pair: Pair]
RETURNS [had: HadPair ←
ALL[same]] ~ {
spaces: SpacePair ~ br.Spaces[];
IF br.MutabilityOf[]#variable THEN br.Complain[notVariable];
IF br.Functional[] #
ALL[
FALSE]
THEN
FOR dir: Direction
IN Direction
DO
IF NOT br.Functional[][dir] THEN NULL
ELSE
IF Primitive[br, $Update, FromDir[dir]]
THEN {
dest: Side ~ Dest[dir];
DecideToRem:
PROC [omv: MaybeValue]
RETURNS [MaybeValue] ~ {
had[dir] ← IF omv.found THEN IF spaces[dest].SEqual[pair[dest], omv.it] THEN same ELSE different ELSE none;
IF dir=Direction.FIRST AND br.Functional[][Direction.LAST] THEN RETURN [omv];
RETURN [IF had[dir]=same THEN noMaybe ELSE omv]};
br.Update[pair[Source[dir]], dir, DecideToRem];
had ← had}
ELSE EXIT;
REPEAT FINISHED => RETURN;
ENDLOOP;
IF Primitive[br, $RemSet, FakeRefSingleton[spaces]] THEN RETURN [UnSetHads[br.class.RemSet[br, CreateSingleton[pair, spaces]]]];
IF br.Functional[]#
ALL[
FALSE]
THEN {
goodDelete: BoolPair ← ALL[FALSE];
FOR dir: Direction
IN Direction
DO
src: Side ~ Source[dir];
dst: Side ~ Dest[dir];
IF br.Functional[][dir]
THEN {
IF br.GoodImpl[$Apply, FromDir[dir]]
THEN {
map: MaybeValue ~ br.Apply[pair[src], dir];
had[dir] ← IF map.found THEN IF spaces[dst].SEqual[pair[dst], map.it] THEN same ELSE different ELSE none;
goodDelete[dir] ← br.Primitive[$Delete, FromSide[src]] OR br.Primitive[$DeleteSet, Sets.FakeRefSingleton[spaces[src]], FromSide[src]]}
ELSE {had ← had; GOTO NoGood}};
ENDLOOP;
IF goodDelete=ALL[FALSE] THEN GOTO NoGood;
{side: Side ~ IF goodDelete[leftToRight] THEN left ELSE right;
IF had[From[side]]=same THEN {IF NOT br.Delete[pair[side], side] THEN ERROR};
RETURN};
EXITS NoGood => had ← had};
br.Cant[]};
DefaultRemSet:
PUBLIC
PROC [br, other: BiRel]
RETURNS [some: HadSetPair ←
ALL[
ALL[
FALSE]]] ~ {
RemThisPair:
PROC [pair: Pair]
RETURNS [
BOOL] ~ {
had: HadPair ~ br.RemPair[pair];
some[leftToRight][had[leftToRight]] ← TRUE;
some[rightToLeft][had[rightToLeft]] ← TRUE;
RETURN [FALSE]};
IF br.MutabilityOf[]#variable THEN br.Complain[notVariable];
IF br.Primitive[$RemPair] THEN {IF other.Scan[RemThisPair].found THEN ERROR; RETURN};
IF br.Functional[]#
ALL[
FALSE]
THEN {
FOR dir: Direction
IN Direction
DO
IF br.Functional[][dir] AND NOT Primitive[br, $Update, FromDir[dir]] THEN EXIT;
REPEAT FINISHED => {IF other.Scan[RemThisPair].found THEN ERROR; RETURN};
ENDLOOP;
{spaces: SpacePair ~ br.Spaces[];
goodDelete: BoolPair ← ALL[FALSE];
FOR dir: Direction
IN Direction
DO
src: Side ~ Source[dir];
IF br.Functional[][dir]
THEN {
IF br.GoodImpl[$Apply, FromDir[dir]] THEN goodDelete[dir] ← br.Primitive[$Delete, FromSide[src]] OR br.Primitive[$DeleteSet, Sets.FakeRefSingleton[spaces[src]], FromSide[src]]
ELSE EXIT};
REPEAT FINISHED => IF goodDelete#ALL[FALSE] THEN {IF other.Scan[RemThisPair].found THEN ERROR; RETURN};
ENDLOOP;
some ← some}};
br.Cant[]};
DefaultDelete:
PUBLIC
PROC [br: BiRel, val: Value, side: Side]
RETURNS [hadSome:
BOOL ←
FALSE] ~ {
srcSpace: Space ~ br.Spaces[][side];
dir: Direction ~ From[side];
IF br.MutabilityOf[]#variable THEN br.Complain[notVariable];
IF br.Functional[][dir]
AND Primitive[br, $Update, FromDir[dir]]
THEN {
DecideToDelete:
PROC [omv: MaybeValue]
RETURNS [MaybeValue] ~ {
hadSome ← omv.found;
RETURN [noMaybe]};
br.Update[val, dir, DecideToDelete];
RETURN};
IF Primitive[br, $DeleteSet, Sets.FakeRefSingleton[srcSpace], FromSide[side]]
THEN RETURN [br.class.DeleteSet[br, Sets.CreateSingleton[val, srcSpace], side].had.some];
{other: Side ~ OtherSide[side];
pair: Pair ← ALL[val];
KillPair:
PROC [v2: Value]
RETURNS [
BOOL] ~ {
pair[other] ← v2;
[] ← br.RemPair[pair];
hadSome ← TRUE;
RETURN [FALSE]};
IF br.ScanMapping[val, KillPair, dir].found THEN ERROR;
RETURN}};
DefaultDeleteSet:
PUBLIC
PROC [br: BiRel, set: Set, side: Side]
RETURNS [had: SomeAll ← []] ~ {
other: Side ~ OtherSide[side];
dir: Direction ~ From[side];
easy: BOOL ~ Primitive[br, $Delete, FromSide[side]] OR br.Functional[][dir] AND Primitive[br, $Update, FromDir[dir]];
EasyKill:
PROC [val: Value]
RETURNS [
BOOL] ~ {
IF br.Delete[val, side] THEN had.some ← TRUE ELSE had.all ← FALSE;
RETURN [FALSE]};
HardKill:
PROC [val: Value]
RETURNS [
BOOL] ~ {
pair: Pair ← ALL[val];
HardKillPair:
PROC [v2: Value]
RETURNS [
BOOL] ~ {
pair[other] ← v2;
[] ← br.RemPair[pair];
some ← TRUE;
RETURN [FALSE]};
some: BOOL ← FALSE;
IF br.ScanMapping[val, HardKillPair, dir].found THEN ERROR;
IF some THEN had.some ← TRUE ELSE had.all ← FALSE;
RETURN [FALSE]};
IF br.MutabilityOf[]#variable THEN br.Complain[notVariable];
IF set.Scan[IF easy THEN EasyKill ELSE HardKill].found THEN ERROR;
RETURN};
DefaultUpdate:
PUBLIC
PROC [br: BiRel, val: Value, dir: Direction,
Decide: UpdateDecider] ~ {
IF NOT br.class.functional[dir] THEN br.Complain[notFunctional, LIST[AV[NEW [Direction ← dir]]]];
{old: MaybeValue ~ br.Apply[val, dir];
new: MaybeValue ~ Decide[old];
dest: Side ~ Dest[dir];
IF old=new THEN RETURN;
IF new.found THEN {IF NOT (old.found AND br.Spaces[][dest].SEqual[old.it, new.it]) THEN [] ← br.AddPair[Cons[dest, new.it, val]]}
ELSE IF old.found THEN [] ← br.RemPair[Cons[dest, old.it, val]];
RETURN}};
Start:
PROC ~ {
FOR l2r:
BOOL
IN
BOOL
DO
FOR r2l:
BOOL
IN
BOOL
DO
insClasses[l2r][r2l] ← CreateClass[[
Primitive: InsPrimitive,
AsSet: InsAsSet,
HasPair: InsHasPair,
Image: InsImage,
Apply: InsApply,
ScanRestriction: InsScanRestriction,
GetOne: InsGetOne,
Get3: InsGet3,
Index: InsIndex,
RestrictionSize: InsRestrictionSize,
GetBounds: InsGetBounds,
Copy: InsCopy,
ValueOf: InsValueOf,
SetOn: InsSetOn,
CurSetOn: InsCurSetOn,
Update: InsUpdate,
Spaces: InsSpaces,
IsDense: InsIsDense,
SideFixed: InsSideFixed,
functional: [l2r, r2l],
mutability: readonly]];
ENDLOOP ENDLOOP;
RETURN};
Start[];
END.