DIRECTORY AbSets, Atom, BiRelBasics, BiRels, BiRelsPrivate, IntStuff, SetBasics; BiRelRestriction: CEDAR PROGRAM IMPORTS AbSets, BiRelBasics, BiRels, SetBasics EXPORTS BiRels = BEGIN OPEN SetBasics, Sets:AbSets, Sets, BiRelBasics, BiRels; Restriction: PUBLIC PROC [br: BiRel, sets: SetPair, functional: BoolPair _ ALL[FALSE]] RETURNS [UWBiRel] ~ { rsn: Rsn ~ NEW [RsnPrivate _ [br.Spaces[], br, sets, [sets[left]=nilSet, sets[right]=nilSet]]]; mut: Mutability ~ MIN[readonly, MAX[ IF rsn.sn[left] THEN constant ELSE sets[left].MutabilityOf, IF rsn.sn[left] THEN constant ELSE sets[left].MutabilityOf, br.MutabilityOf]]; functional[leftToRight] _ functional[leftToRight] OR br.Functional[][leftToRight]; functional[rightToLeft] _ functional[rightToLeft] OR br.Functional[][rightToLeft]; IF NOT ((rsn.sn[left] OR rsn.spaces[left]=sets[left].SpaceOf) AND (rsn.sn[right] OR rsn.spaces[right]=sets[right].SpaceOf)) THEN br.Complain["Can't restrict by set using different space"]; IF NOT ((rsn.sn[left] OR sets[left].Can[$HasMember]) AND (rsn.sn[right] OR sets[right].Can[$HasMember])) THEN br.Complain["How the heck am I supposed to restrict to a set that can't test membership?"]; RETURN AsUW[[ classes [mut] [functional[leftToRight]] [functional[rightToLeft]], rsn]]}; Classes: TYPE ~ ARRAY UnwriteableMutability OF ARRAY BOOL OF ARRAY BOOL OF BiRelClass; classes: REF Classes ~ NEW [Classes]; Rsn: TYPE ~ REF RsnPrivate; RsnPrivate: TYPE ~ RECORD [ spaces: SpacePair, base: BiRel, sets: SetPair, sn: ARRAY Side OF BOOL ]; RsnPrimitive: PROC [br: BiRel, op: ATOM, arg1, arg2: REF ANY _ NIL] RETURNS [PrimitiveAnswer] ~ { rsn: Rsn ~ NARROW[br.data]; SELECT op FROM $HasPair, $ValueOf, $SetOn, $CurSetOn, $IsDense, $SideFixed => RETURN [IF rsn.base.Can[op, arg1, arg2] THEN yes ELSE no]; $Apply => {dir: Direction ~ ToDir[arg1]; RETURN [IF rsn.base.Can[IF rsn.base.Functional[][dir] THEN $Apply ELSE $ScanRestriction] THEN yes ELSE no]}; $ScanRestriction, $RestrictionSize => {sets: SetPair _ ToSets[arg1]^; IF sets[left]#nilSet AND NOT rsn.sn[left] THEN sets[left] _ sets[left].Intersection[rsn.sets[left]]; IF sets[right]#nilSet AND NOT rsn.sn[right] THEN sets[right] _ sets[right].Intersection[rsn.sets[right]]; RETURN [IF rsn.base.Can[op, FromSets[sets], arg2] THEN yes ELSE no]}; ENDCASE => RETURN [pass]; }; RsnHasPair: PROC [br: BiRel, pair: Pair] RETURNS [BOOL] ~ { rsn: Rsn ~ NARROW[br.data]; RETURN [(rsn.sn[left] OR rsn.sets[left].HasMember[pair[left]]) AND (rsn.sn[right] OR rsn.sets[right].HasMember[pair[right]]) AND rsn.base.HasPair[pair]]}; RsnApply: PROC [br: BiRel, v: Value, dir: Direction] RETURNS [mv: MaybeValue] ~ { rsn: Rsn ~ NARROW[br.data]; src: Side ~ Source[dir]; dst: Side ~ Dest[dir]; IF NOT (rsn.sn[src] OR rsn.sets[src].HasMember[v]) THEN RETURN [noMaybe]; IF rsn.base.Functional[][dir] THEN { mv _ rsn.base.Apply[v, dir]; IF mv.found AND NOT (rsn.sn[dst] OR rsn.sets[dst].HasMember[mv.it]) THEN mv _ noMaybe; RETURN} ELSE { some: BOOL _ FALSE; See: PROC [pair: Pair] RETURNS [BOOL] ~ { IF NOT (rsn.sn[dst] OR rsn.sets[dst].HasMember[pair[dst]]) THEN RETURN [FALSE]; IF some THEN RETURN [TRUE]; mv _ [some _ TRUE, pair[dst]]; RETURN [FALSE]}; IF rsn.base.ScanRestriction[ConsSets[src, Sets.CreateSingleton[v, rsn.spaces[src]], rsn.sets[dst]], See].found THEN br.Complain[mappingNotSingleton, LIST[v]]; RETURN}; }; RsnScanRestriction: PROC [br: BiRel, sets: SetPair, Test: Tester, ro: RelOrder] RETURNS [MaybePair] ~ { rsn: Rsn ~ NARROW[br.data]; IF sets[left]#nilSet AND NOT rsn.sn[left] THEN sets[left] _ sets[left].Intersection[rsn.sets[left]]; IF sets[right]#nilSet AND NOT rsn.sn[right] THEN sets[right] _ sets[right].Intersection[rsn.sets[right]]; RETURN rsn.base.ScanRestriction[sets, Test, ro]}; RsnRestrictionSize: PROC [br: BiRel, sets: SetPair, limit: EINT] RETURNS [EINT] ~ { rsn: Rsn ~ NARROW[br.data]; IF sets[left]#nilSet AND NOT rsn.sn[left] THEN sets[left] _ sets[left].Intersection[rsn.sets[left]]; IF sets[right]#nilSet AND NOT rsn.sn[right] THEN sets[right] _ sets[right].Intersection[rsn.sets[right]]; RETURN rsn.base.RestrictionSize[sets, limit]}; RsnValueOf: PROC [br: BiRel] RETURNS [ConstBiRel] ~ { rsn: Rsn ~ NARROW[br.data]; sets: SetPair _ rsn.sets; IF rsn.sn[left] THEN sets[left] _ sets[left].ValueOf; IF rsn.sn[right] THEN sets[right] _ sets[right].ValueOf; RETURN rsn.base.ValueOf.Restriction[sets, br.Functional].AsConst}; RsnSetOn: PROC [br: BiRel, side: Side] RETURNS [UWSet] ~ { rsn: Rsn ~ NARROW[br.data]; seton: UWSet _ rsn.base.SetOn[side]; IF NOT rsn.sn[side] THEN seton _ seton.Intersection[rsn.sets[side]]; RETURN [seton]}; RsnCurSetOn: PROC [br: BiRel, side: Side] RETURNS [ConstSet] ~ { rsn: Rsn ~ NARROW[br.data]; seton: ConstSet _ rsn.base.CurSetOn[side]; IF NOT rsn.sn[side] THEN seton _ seton.Intersection[rsn.sets[side].ValueOf].AsConst; RETURN [seton]}; RsnSpaces: PROC [br: BiRel] RETURNS [SpacePair] ~ { rsn: Rsn ~ NARROW[br.data]; RETURN [rsn.spaces]}; RsnIsDense: PROC [br: BiRel, when: When, side: Side] RETURNS [BOOL] ~ { rsn: Rsn ~ NARROW[br.data]; RETURN [(rsn.sn[side] OR rsn.sets[side].IsDense[when]) AND rsn.base.IsDense[when, side]]}; RsnSideFixed: PROC [br: BiRel, side: Side] RETURNS [BOOL] ~ { rsn: Rsn ~ NARROW[br.data]; RETURN [(rsn.sn[side] OR rsn.sets[side].MutabilityOf=constant) AND rsn.base.SideFixed[side]]}; Start: PROC ~ { FOR mut: UnwriteableMutability IN UnwriteableMutability DO FOR l2r: BOOL IN BOOL DO FOR r2l: BOOL IN BOOL DO classes[mut][l2r][r2l] _ CreateClass[[ Primitive: RsnPrimitive, HasPair: RsnHasPair, Apply: RsnApply, ScanRestriction: RsnScanRestriction, RestrictionSize: RsnRestrictionSize, ValueOf: IF mut#constant THEN RsnValueOf ELSE NIL, SetOn: RsnSetOn, CurSetOn: RsnCurSetOn, Spaces: RsnSpaces, IsDense: RsnIsDense, SideFixed: RsnSideFixed, functional: [l2r, r2l], mutability: mut]]; ENDLOOP ENDLOOP; ENDLOOP; RETURN}; Start[]; END. \BiRelRestriction.Mesa Last tweaked by Mike Spreitzer on March 3, 1988 6:04:03 pm PST Κμ– "cedar" style˜code™Kšœ>™>—K˜KšΟk œG˜PK˜šΟnœœ˜Kšœ'˜.Kšœ˜K˜—K˜Kšœœ žœ#˜=K˜š ž œœœ3œœœ˜lKšœ œQ˜_šœœ œ˜$Kšœœ œ˜;Kšœœ œ˜;Kšœ˜—Kšœ2œ˜RKšœ2œ˜RKš œœœ&œœ)œ<˜ΌKš œœœœœœ\˜Ιšœ˜ KšœB˜BKšœ˜——K˜Kšœ œœœœœœœœœ ˜VKšœ œ œ ˜%K˜Kšœœœ ˜šœ œœ˜K˜Kšœ ˜ Kšœ˜Kšœœœ˜K˜—K˜šž œœœœœœœ˜aKšœ œ ˜šœ˜Kš œ?œœœœ˜y˜(Kšœœœœœœœ˜l—˜EKšœœœœ6˜dKšœœœœ9˜iKšœœ(œœ˜E—Kšœœ˜—K˜—K˜šž œœœœ˜;Kšœ œ ˜Kš œœ'œœ)œ˜š—K˜šžœœ'œ˜QKšœ œ ˜K˜K˜Kš œœœœœ ˜Išœœ˜$K˜Kš œ œœœ!œ˜VKšœ˜—šœ˜Kšœœœ˜šžœœœœ˜)Kš œœœ%œœœ˜OKšœœœœ˜Kšœ œ ˜Kšœœ˜—Kšœmœ"œ˜žKšœ˜—K˜—K˜šžœœžœœ˜gKšœ œ ˜Kšœœœœ6˜dKšœœœœ9˜iKšœ+˜1—K˜š žœœ#œœœ˜SKšœ œ ˜Kšœœœœ6˜dKšœœœœ9˜iKšœ(˜.—K˜šž œœ œ˜5Kšœ œ ˜K˜Kšœœ!˜5Kšœœ#˜8Kšœ<˜B—K˜šžœœœ ˜:Kšœ œ ˜K˜$Kšœœœ,˜DKšœ ˜—K˜šž œœœ˜@Kšœ œ ˜Kšœ*˜*Kšœœœ<˜TKšœ ˜—K˜šž œœ œ˜3Kšœ œ ˜Kšœ˜—K˜šž œœ%œœ˜GKšœ œ ˜Kšœœœ ˜Z—K˜šž œœœœ˜=Kšœ œ ˜Kšœœ'œ˜^—K˜šžœœ˜šœœ˜:šœœœœœœœœœ˜1˜&Kšž œ˜Kšžœ ˜Kšžœ ˜Kšžœ˜$Kšžœ˜$Kš žœœœ œœ˜2Kšžœ ˜Kšžœ˜Kšžœ ˜Kšžœ ˜Kšž œ˜K˜K˜—Kšœœ˜—Kšœ˜—Kšœ˜—K˜K˜K˜Kšœ˜—…—φ>