BiRelCombining2.Mesa
Last tweaked by Mike Spreitzer on December 15, 1987 4:41:14 pm PST
DIRECTORY AbSets, BiRelBasics, BiRels, IntStuff, SetBasics;
BiRelCombining2: CEDAR PROGRAM
IMPORTS AbSets, BiRels, SetBasics
EXPORTS BiRels
=
BEGIN OPEN IntStuff, SetBasics, Sets:AbSets, Sets, BiRelBasics, BiRels;
Difference: PUBLIC PROC [a, b: BiRel] RETURNS [UWBiRel] ~ {
RETURN a.Intersection[b.Negate]};
SymmetricDifference: PUBLIC PROC [a, b: BiRel] RETURNS [c: UWBiRel] ~ {
RETURN a.Difference[b].Union[b: b.Difference[a], disjoint: TRUE]};
Negate: PUBLIC PROC [br: BiRel] RETURNS [BiRel] ~ {
class: BiRelClass ~ negClasses[br.MutabilityOf];
IF br.class=class THEN RETURN DeRef[br.data];
RETURN [[class, br.Refify]]};
NegClasses: TYPE ~ ARRAY Mutability OF BiRelClass;
negClasses: REF NegClasses ~ NEW [NegClasses];
NegPrimitive: PROC [br: BiRel, op: ATOM, arg1, arg2: REF ANYNIL] RETURNS [PrimitiveAnswer] ~ {
rbr: RefBiRel ~ NARROW[br.data];
SELECT op FROM
$AsSet, $HasPair, $Copy, $Insulate, $ValueOf, $Freeze, $Thaw, $Swap, $SideFixed => RETURN [IF rbr^.GoodImpl[op, arg1, arg2] THEN yes ELSE no];
$AddSet => RETURN [IF rbr^.GoodImpl[$RemSet, arg1, arg2] THEN yes ELSE no];
$RemSet => RETURN [IF rbr^.GoodImpl[$AddSet, arg1, arg2] THEN yes ELSE no];
ENDCASE => RETURN [no];
};
NegAsSet: PROC [br: BiRel, ro: RelOrder] RETURNS [Set--of REF Pair--] ~ {
rbr: RefBiRel ~ NARROW[br.data];
RETURN rbr^.AsSet[ro].Negate};
NegHasPair: PROC [br: BiRel, pair: Pair] RETURNS [BOOL] ~ {
rbr: RefBiRel ~ NARROW[br.data];
RETURN [NOT rbr^.HasPair[pair]]};
NegCopy: PROC [br: BiRel] RETURNS [VarBiRel] ~ {
rbr: RefBiRel ~ NARROW[br.data];
RETURN rbr^.Copy.Negate.AsVar};
NegInsulate: PROC [br: BiRel] RETURNS [UWBiRel] ~ {
rbr: RefBiRel ~ NARROW[br.data];
RETURN rbr^.Insulate.Negate.AsUW};
NegValueOf: PROC [br: BiRel] RETURNS [ConstBiRel] ~ {
rbr: RefBiRel ~ NARROW[br.data];
RETURN rbr^.ValueOf.Negate.AsConst};
NegFreeze: PROC [br: BiRel] RETURNS [ConstBiRel] ~ {
rbr: RefBiRel ~ NARROW[br.data];
RETURN rbr^.Freeze.Negate.AsConst};
NegThaw: PROC [br: BiRel] ~ {
rbr: RefBiRel ~ NARROW[br.data];
rbr^.Thaw; RETURN};
NegAddSet: PROC [br, other: BiRel, if: IfHadPair] RETURNS [some: HadSetPair ← []] ~ {
rbr: RefBiRel ~ NARROW[br.data];
negHad: HadSetPair ~ rbr^.RemSet[other];
RETURN};
NegSwap: PROC [br: BiRel, a, b: Value, side: Side] ~ {
rbr: RefBiRel ~ NARROW[br.data];
rbr^.Swap[a, b, side]; RETURN};
NegRemSet: PROC [br, other: BiRel] RETURNS [some: HadSetPair ← []] ~ {
rbr: RefBiRel ~ NARROW[br.data];
negHad: HadSetPair ~ rbr^.AddSet[other];
RETURN};
NegSpaces: PROC [br: BiRel] RETURNS [SpacePair] ~ {
rbr: RefBiRel ~ NARROW[br.data];
RETURN rbr^.Spaces};
NegSideFixed: PROC [br: BiRel, side: Side] RETURNS [BOOL] ~ {
rbr: RefBiRel ~ NARROW[br.data];
RETURN rbr^.SideFixed[side]};
Start: PROC ~ {
FOR mut: Mutability IN Mutability DO
negClasses[mut] ← CreateClass[[
Primitive: NegPrimitive,
AsSet: NegAsSet,
HasPair: NegHasPair,
Copy: NegCopy,
Insulate: IF mut=variable THEN NegInsulate ELSE NIL,
ValueOf: IF mut#constant THEN NegValueOf ELSE NIL,
Freeze: IF mut=variable THEN NegFreeze ELSE NIL,
Thaw: IF mut=variable THEN NegThaw ELSE NIL,
AddSet: IF mut=variable THEN NegAddSet ELSE NIL,
Swap: IF mut=variable THEN NegSwap ELSE NIL,
RemSet: IF mut=variable THEN NegRemSet ELSE NIL,
Spaces: NegSpaces,
SideFixed: NegSideFixed,
functional: ALL[FALSE],
mutability: mut]];
ENDLOOP;
};
Start[];
END.