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 ANY _ NIL] 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. ^BiRelCombining2.Mesa Last tweaked by Mike Spreitzer on December 15, 1987 4:41:14 pm PST Κω– "cedar" style˜code™KšœB™B—K˜KšΟk œ2˜;K˜šΟnœœ˜Kšœ˜!Kšœ˜K˜—K˜Kšœœžœ#˜GK˜šž œœœœ˜;Kšœ˜!—K˜šžœœœœ˜GKšœ5œ˜B—K˜šžœœœ œ ˜3K˜0Kšœœœ˜-Kšœ˜—K˜Kšœ œœ œ ˜2Kšœ œœ˜.K˜šž œœœœœœœ˜aKšœœ ˜ šœ˜Kš œSœœœœ˜ŽKš œ œœ$œœ˜KKš œ œœ$œœ˜KKšœœ˜—K˜—K˜šžœœœΟcœ˜IKšœœ ˜ Kšœ˜—K˜šž œœœœ˜;Kšœœ ˜ Kšœœ˜!—K˜šžœœ œ˜0Kšœœ ˜ Kšœ˜—K˜šž œœ œ˜3Kšœœ ˜ Kšœ˜"—K˜šž œœ œ˜5Kšœœ ˜ Kšœ˜$—K˜šž œœ œ˜4Kšœœ ˜ Kšœ˜#—K˜šžœœ˜Kšœœ ˜ Kšœ œ˜—K˜šž œœ#œ˜UKšœœ ˜ Kšœ(˜(Kšœ˜—K˜šžœœ)˜6Kšœœ ˜ Kšœœ˜—K˜šž œœœ˜FKšœœ ˜ Kšœ(˜(Kšœ˜—K˜šž œœ œ˜3Kšœœ ˜ Kšœ˜—K˜šž œœœœ˜=Kšœœ ˜ Kšœ˜—K˜šžœœ˜šœœ ˜$˜Kšž œ˜Kšžœ ˜Kšžœ ˜Kšžœ ˜Kš žœœœ œœ˜4Kš žœœœ œœ˜2Kš žœœœ œœ˜0Kš žœœœ œœ˜,Kš žœœœ œœ˜0Kš žœœœ œœ˜,Kš žœœœ œœ˜0Kšžœ ˜Kšž œ˜Kšœ œœ˜K˜—Kšœ˜—K˜—K˜K˜K˜Kšœ˜—…— ]