BiRelDefaults2.Mesa
Last tweaked by Mike Spreitzer on January 21, 1988 9:43:34 pm 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[];
whole: BOOL ~ set=nilSet;
sg: BOOL ~ NOT whole;
easy: BOOL ~ sg AND set.Can[$Size] AND set.Size[two].Compare[two]<equal;
setEnumable: BOOL ~ sg AND set.Can[$Scan];
addable: BOOL ~ setEnumable AND NOT br.Functional[][dir];
is: ImageSet ~ NEW [ImageSetPrivate ← [br, set, whole, easy, setEnumable, addable, dir, OtherDirection[dir], src, dst, spaces[src], spaces[dst]]];
mut: Mutability ~
SELECT br.MutabilityOf[]
FROM
variable => variable,
readonly => readonly,
constant => IF whole OR set.MutabilityOf[]=constant THEN constant ELSE readonly,
ENDCASE => ERROR;
RETURN [[imageClasses[mut], AV[is]]]};
ImageClasses: TYPE ~ ARRAY Mutability OF SetClass;
imageClasses: REF ImageClasses ~ NEW [ImageClasses];
ImageSet: TYPE ~ REF ImageSetPrivate;
ImageSetPrivate:
TYPE ~
RECORD [
br: BiRel,
set: Set,
whole, easy, setEnumable, addable: BOOL,
dir, invDir: 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];
$AddSet => RETURN [IF is.addable THEN yes ELSE no];
ENDCASE => RETURN [pass]};
ImageHasMember:
PROC [set: Set, elt: Value]
RETURNS [
BOOL] ~ {
is: ImageSet ~ NARROW[set.data.VA];
IF is.br.Functional[][is.invDir]
THEN {
mv: MaybeValue ~ is.br.Apply[elt, is.invDir];
RETURN [mv.found AND (is.whole OR is.set.HasMember[mv.it])]};
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];
IF is.setEnumable
THEN {
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: BOOL ← FALSE;
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 DefaultImage[is.br.Insulate, 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 NOT is.addable THEN set.Cant[];
{mv: MaybeValue ~ is.set.AnElt[];
Addit:
PROC [val: Value] ~ {
had: BOOL ~ set.HasMember[val];
IF had THEN {new.all ← FALSE; RETURN} ELSE new.some ← TRUE;
[] ← is.br.AddPair[Cons[is.src, mv.it, val]];
RETURN};
other.Enumerate[Addit];
RETURN}};
ImageRemSet:
PROC [set, other: Set]
RETURNS [had: SomeAll ← []] ~ {
is: ImageSet ~ NARROW[set.data.VA];
sets: SetPair ← ConsSets[is.src, is.set, Sets.FakeSingleton[is.dstSpace]];
Remit:
PROC [dst: Value] ~ {
IF set.HasMember[dst] THEN had.some ← TRUE ELSE had.all ← FALSE;
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[];
IF br.MutabilityOf[]#variable THEN br.Complain[notVariable];
[] ← 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 br.MutabilityOf[]#variable THEN br.Complain[notVariable];
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: IV[shift.AddI[i].EI], right: v]];
[] ← br.RemPair[[left: IV[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[IV[i], Movit].found THEN ERROR;
ENDLOOP;
};
0 => NULL;
1 => {
FOR i
DECREASING
IN [bounds.min .. bounds.max]
DO
IF br.ScanMapping[IV[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.