BiRelDefaults2.Mesa
Last tweaked by Mike Spreitzer on December 14, 1987 11:39:10 am PST
DIRECTORY AbSets, Atom, BiRelBasics, BiRels, IntStuff, SetBasics;
BiRelDefaults2: CEDAR PROGRAM
IMPORTS AbSets, BiRelBasics, BiRels, IntStuff, SetBasics
EXPORTS BiRels
=
BEGIN OPEN IntStuff, SetBasics, Sets:AbSets, Sets, BiRelBasics, BiRels;
DefaultImage: PUBLIC PROC [br: BiRel, set: Set, dir: Direction] RETURNS [Set] ~ {
src: Side ~ Source[dir];
dst: Side ~ Dest[dir];
spaces: SpacePair ~ br.Spaces[];
easy: BOOL ~ set.Can[$Size] AND set.Size[two].Compare[two]<equal;
is: ImageSet ~ NEW [ImageSetPrivate ← [br, set, easy, dir, src, dst, spaces[src], spaces[dst]]];
mut: Mutability ~ SELECT br.MutabilityOf[] FROM
variable => variable,
readonly => readonly,
constant => IF set.MutabilityOf[]=constant THEN constant ELSE readonly,
ENDCASE => ERROR;
RETURN [[imageClasses[mut], [a[is]]]]};
ImageClasses: TYPE ~ ARRAY Mutability OF SetClass;
imageClasses: REF ImageClasses ~ NEW [ImageClasses];
ImageSet: TYPE ~ REF ImageSetPrivate;
ImageSetPrivate: TYPE ~ RECORD [
br: BiRel,
set: Set,
easy: BOOL,
dir: Direction,
src, dst: Side,
srcSpace, dstSpace: Space];
ImagePrimitive: PROC [set: Set, op: ATOM, arg1, arg2: REF ANY] RETURNS [PrimitiveAnswer] ~ {
is: ImageSet ~ NARROW[set.data.VA];
SELECT op FROM
$Size => RETURN [IF is.easy THEN yes ELSE no];
ENDCASE => RETURN [pass]};
ImageHasMember: PROC [set: Set, elt: Value] RETURNS [BOOL] ~ {
is: ImageSet ~ NARROW[set.data.VA];
RETURN [is.br.ScanRestriction[ConsSets[is.src, is.set, Sets.CreateSingleton[elt, is.dstSpace]], AcceptAny].found]};
ImageScan: PROC [set: Set, Test: Sets.Tester, ro: Sets.RelOrder] RETURNS [MaybeValue] ~ {
is: ImageSet ~ NARROW[set.data.VA];
bro: RelOrder ~ ConsRelOrder[is.dst, ro];
seen: Set ~ IF NOT is.easy THEN CreateHashSet[is.dstSpace] ELSE nilSet;
EasyPass: PROC [pair: Pair] RETURNS [BOOL] ~ {RETURN Test[pair[is.dst]]};
HardPass: PROC [pair: Pair] RETURNS [BOOL] ~ {v: Value ~ pair[is.dst]; RETURN [seen.AddElt[v].new AND Test[v]]};
RETURN is.br.ScanHalfRestriction[is.set, IF is.easy THEN EasyPass ELSE HardPass, is.src, bro].KeepHalf[is.dst]};
ImageGet3: PROC [set: Set, elt: Value, want: TripleBool] RETURNS [TripleMaybeValue] ~ {
is: ImageSet ~ NARROW[set.data.VA];
mv: MaybeValue ~ is.set.AnElt[];
IF NOT mv.found THEN RETURN [[noMaybe, noMaybe, noMaybe]];
{
up: Set ~ IntervalAsSet[is.dstSpace, [elt, noValue]];
dn: Set ~ IntervalAsSet[is.dstSpace, [noValue, elt]];
gsU, gsD: BOOLFALSE;
SearchUp: PROC [pair: Pair] RETURNS [BOOL] ~ {
IF is.dstSpace.SEqual[pair[is.dst], elt] THEN gsU ← TRUE ELSE RETURN [TRUE];
RETURN [FALSE]};
SearchDn: PROC [pair: Pair] RETURNS [BOOL] ~ {
IF is.dstSpace.SEqual[pair[is.dst], elt] THEN gsD ← TRUE ELSE RETURN [TRUE];
RETURN [FALSE]};
{prev: MaybePair ~ is.br.ScanRestriction[ConsSets[is.src, is.set, up], SearchUp, ConsRelOrder[is.dst, fwd, fwd]];
next: MaybePair ~ is.br.ScanRestriction[ConsSets[is.src, is.set, dn], SearchDn, ConsRelOrder[is.dst, bwd, bwd]];
RETURN [[
prev: prev.KeepHalf[is.dst],
same: IF gsU OR gsD THEN [TRUE, elt] ELSE noMaybe,
next: next.KeepHalf[is.dst]
]]}}};
ImagesSize: PROC [set: Set, limit: EINT] RETURNS [EINT] ~ {
is: ImageSet ~ NARROW[set.data.VA];
IF is.easy THEN RETURN is.br.RestrictionSize[ConsSets[is.src, is.set], limit];
RETURN set.DefaultSize[limit]};
ImageCopy: PROC [set: Set] RETURNS [VarSet] ~ {
is: ImageSet ~ NARROW[set.data.VA];
RETURN is.br.Copy.Image[is.set, is.dir].AsVar};
ImageInsulate: PROC [set: Set] RETURNS [UWSet] ~ {
is: ImageSet ~ NARROW[set.data.VA];
IF set.MutabilityOf[]#variable THEN RETURN set.AsUW[];
RETURN is.br.Insulate.Image[is.set, is.dir].AsUW};
ImageValueOf: PROC [set: Set] RETURNS [ConstSet] ~ {
is: ImageSet ~ NARROW[set.data.VA];
IF set.MutabilityOf[]=constant THEN RETURN set.AsConst[];
RETURN is.br.ValueOf.Image[is.set.ValueOf, is.dir].AsConst};
ImageFreeze: PROC [set: Set] RETURNS [ConstSet] ~ {
is: ImageSet ~ NARROW[set.data.VA];
IF set.MutabilityOf[]#variable THEN set.Complain[notVariable];
RETURN is.br.Freeze.Image[is.set.ValueOf, is.dir].AsConst};
ImageThaw: PROC [set: Set] ~ {
is: ImageSet ~ NARROW[set.data.VA];
IF set.MutabilityOf[]#variable THEN set.Complain[notVariable];
is.br.Thaw[];
RETURN};
ImageAddSet: PROC [set, other: Set] RETURNS [new: SomeAll ← []] ~ {
is: ImageSet ~ NARROW[set.data.VA];
IF is.br.Functional[][is.dir] AND is.set.Size[IE[2]]=one AND other.Size[IE[2]]=one THEN {
news: HadPair ~ is.br.AddPair[Cons[is.src, is.set.AnElt.it, other.AnElt.it], addIfNew];
SELECT news[leftToRight] FROM
none => new.some ← TRUE;
same => new.all ← FALSE;
different => set.Cant[];
ENDCASE => ERROR;
}
ELSE {
mv: MaybeValue ~ is.set.AnElt[];
easy: BOOL ~ NOT is.br.Functional[][is.dir];
Addit: PROC [val: Value] ~ {
had: BOOL ~ set.HasMember[val];
FindDom: PROC [dv: Value] RETURNS [BOOL] ~ {
news: HadPair ~ is.br.AddPair[Cons[is.src, dv, val], addIfNew];
RETURN [news[leftToRight]=none]};
IF had THEN new.all ← FALSE ELSE new.some ← TRUE;
IF easy THEN [] ← is.br.AddPair[Cons[is.src, mv.it, val]] ELSE IF NOT is.set.Scan[FindDom].found THEN set.Cant[];
RETURN};
other.Enumerate[Addit];
};
};
ImageRemSet: PROC [set, other: Set] RETURNS [had: SomeAll ← []] ~ {
is: ImageSet ~ NARROW[set.data.VA];
sets: SetPair ← ConsSets[is.src, is.set, [Sets.GetSingletonClass[is.dstSpace], [no[]]]];
Remit: PROC [dst: Value] ~ {
IF set.HasMember[dst] THEN had.some ← TRUE ELSE had.all ← FALSE;
TRUSTED {sets[is.dst].data ← dst};
[] ← is.br.RemSet[CreateProduct[sets]];
RETURN};
other.Enumerate[Remit];
RETURN};
ImageSpaceOf: PROC [set: Set] RETURNS [Space] ~ {
is: ImageSet ~ NARROW[set.data.VA];
RETURN [is.br.Spaces[][is.dst]]};
DefaultReplaceMe: PUBLIC PROC [br, with: IntRel, where: IntInterval] ~ {
clip: IntInterval ~ with.GetIntDom[];
[] ← br.DeleteSet[Sets.IIAsSet[where]];
IF where.min > INT.FIRST THEN where.max ← MAX[where.max, where.min-1];
IF where.max < INT.LAST THEN SubShift[br, [where.max+1, INT.LAST], clip.Length.Sub[where.Length]];
[] ← br.AddSet[with.Shift[ISub[where.min, clip.min]]];
RETURN};
DefaultShiftAndClipMe: PUBLIC PROC [br: BiRel, shift: EINT, clip: IntInterval] ~ {
IF clip.min > INT.FIRST THEN [] ← br.DeleteSet[Sets.IIAsSet[[INT.FIRST, clip.min-1]]];
IF clip.max < INT.LAST THEN [] ← br.DeleteSet[Sets.IIAsSet[[clip.max+1, INT.LAST]]];
SubShift[br, [INT.FIRST, INT.LAST], shift];
RETURN};
SubShift: PROC [br: BiRel, bounds: IntInterval, shift: EINT] ~ {
brBounds: IntInterval ~ br.GetIntDom[];
i: INT;
Movit: PROC [v: Value] RETURNS [BOOL] ~ {
[] ← br.AddPair[[left: [i[shift.AddI[i].EI]], right: v]];
[] ← br.RemPair[[left: [i[i]], right: v]];
RETURN [FALSE]};
bounds ← brBounds.Intersect[bounds];
IF bounds.Empty THEN RETURN;
SELECT shift.Sgn FROM
-1 => {
FOR i IN [bounds.min .. bounds.max] DO
IF br.ScanMapping[[i[i]], Movit].found THEN ERROR;
ENDLOOP;
};
0 => NULL;
1 => {
FOR i DECREASING IN [bounds.min .. bounds.max] DO
IF br.ScanMapping[[i[i]], Movit].found THEN ERROR;
ENDLOOP;
};
ENDCASE => ERROR;
RETURN};
DefaultIsDense: PUBLIC PROC [br: BiRel, when: When, side: Side] RETURNS [BOOL] ~ {
IF when=always AND br.MutabilityOf#constant THEN RETURN [FALSE];
RETURN br.SetOn[side].IsDense[when]};
DefaultSideFixed: PUBLIC PROC [br: BiRel, side: Side] RETURNS [BOOL] ~ {
RETURN [br.MutabilityOf[]=constant]};
Start: PROC ~ {
FOR mut: Mutability IN Mutability DO
imageClasses[mut] ← Sets.CreateClass[[
HasMember: ImageHasMember,
Scan: ImageScan,
Get3: ImageGet3,
Size: ImagesSize,
Copy: ImageCopy,
Insulate: ImageInsulate,
ValueOf: ImageValueOf,
Freeze: ImageFreeze,
Thaw: ImageThaw,
AddSet: ImageAddSet,
RemSet: ImageRemSet,
SpaceOf: ImageSpaceOf,
mutability: mut]];
ENDLOOP;
RETURN};
Start[];
END.