BiRelRestriction.Mesa
Last tweaked by Mike Spreitzer on March 3, 1988 6:04:03 pm PST
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.