StdIntFunctions3.Mesa
Last tweaked by Mike Spreitzer on October 16, 1987 10:20:09 am PDT
DIRECTORY Basics, Collections, IntFunctions, IntStuff, PairCollections;
StdIntFunctions3:
CEDAR
PROGRAM
IMPORTS Collections, IntFunctions, IntStuff, PairCollections
EXPORTS IntFunctions
=
BEGIN OPEN PCs:PairCollections, Colls:Collections, Ints:IntStuff, Collections, PairCollections, IntStuff, IntFunctions;
Wi:
PROC [i:
INT]
RETURNS [Value]
~ INLINE {RETURN [NEW [INT ← i]]};
Ni:
PROC [i: Value]
RETURNS [
INT]
~ INLINE {RETURN [NARROW[i, REF INT]^]};
IC: TYPE ~ REF Interval;
icClass: CollectionClass ~ Colls.CreateClass[[
HasMember: ICHasMember,
Scan: ICScan,
Extremum: ICExtremum,
Get3: ICGet3,
Size: ICSize,
mayDuplicate: FALSE,
orderStyle: value,
mutability: constant],
ALL[TRUE]];
CollectInterval:
PUBLIC
PROC [i: Interval]
RETURNS [ConstSet] ~ {
RETURN [Colls.AsConst[[icClass, NEW [Interval ← i]]]];
};
ICHasMember:
PROC [coll: Collection, elt: Value]
RETURNS [
BOOL] ~ {
ic: IC ~ NARROW[coll.data];
i: INT ~ Ni[elt];
RETURN [ic^.Contains[i]]};
ICScan:
PROC [coll: Collection,
Test: Colls.Tester, bkwd:
BOOL]
RETURNS [MaybeValue] ~ {
ic: IC ~ NARROW[coll.data];
ri: REF INT ~ NEW [INT];
IF bkwd
THEN {
FOR i:
INT
DECREASING
IN [ic.min .. ic.max]
DO
ri^ ← i;
IF Test[ri] THEN RETURN [[TRUE, ri]];
ENDLOOP;
}
ELSE {
FOR i:
INT
IN [ic.min .. ic.max]
DO
ri^ ← i;
IF Test[ri] THEN RETURN [[TRUE, ri]];
ENDLOOP;
};
RETURN [noMaybe]};
ICExtremum:
PROC [coll: Collection, bkwd, remove:
BOOL]
RETURNS [MaybeValue] ~ {
ic: IC ~ NARROW[coll.data];
IF ic^.Empty THEN RETURN [noMaybe];
IF remove THEN coll.Complain[notVariable];
RETURN [[TRUE, Wi[IF bkwd THEN ic.max ELSE ic.min]]]};
ICGet3:
PROC [coll: Collection, elt: Value]
RETURNS [prev, same, next: MaybeValue] ~ {
ic: IC ~ NARROW[coll.data];
i: INT ~ Ni[elt];
prev ← same ← next ← noMaybe;
IF ic^.Contains[i] THEN same ← [TRUE, elt];
IF i>ic.min AND i <= ic.max THEN prev ← [TRUE, Wi[i-1]];
IF i<ic.max AND i >= ic.min THEN next ← [TRUE, Wi[i+1]];
RETURN};
ICSize:
PROC [coll: Collection, limit:
LNAT ←
LNAT.
LAST]
RETURNS [
LNAT] ~ {
ic: IC ~ NARROW[coll.data];
size: EINT ~ ic^.Length;
RETURN [size.Min[IE[limit]].EN]};
Resh: TYPE ~ REF ReshPrivate;
ReshPrivate:
TYPE ~
RECORD [
base: IntFn,
lt: XForm,
lb: Interval,
rt: OneToOne,
rb: Collection
];
ReshClasses: TYPE ~ ARRAY --isOneToOne--BOOL OF ARRAY --isDense--BOOL OF ARRAY --ordered--BOOL OF ARRAY Mutability OF ARRAY --domainFixed--BOOL OF IntFnClass;
reshClasses: REF ReshClasses ~ NEW [ReshClasses];
Reshape:
PUBLIC
PROC [fn: IntFn, lt: XForm ← [], lb: Interval ← [], rt: OneToOne ← PCs.id, rb: Collection ← passAll]
RETURNS [IntFn] ~ {
r: Resh ~ NEW [ReshPrivate ← [fn, lt, lb, rt, rb]];
isOneToOne: BOOL ~ fn.IsOneToOne;
isDense: BOOL ~ ABS[lt.d]=1 AND fn.class.isDense;
ordered: BOOL ~ lt.d=1 AND fn.Ordered[];
mutability: Mutability ~ fn.MutabilityOf;
domainFixed: BOOL ~ fn.DomainIsFixed;
RETURN [[reshClasses[isOneToOne][isDense][ordered][mutability][domainFixed], r]];
};
ReshHasPair:
PROC [fn: IntFn, pair: IVPair]
RETURNS [
BOOL] ~ {
r: Resh ~ NARROW[fn.data];
k: EINT ~ r.lt.EInverseXFormInt[pair.left];
mv: MaybeValue ~ r.rt.Apply[pair.right, rightToLeft];
IF k.Compare[firstINT] >= greater
AND k.Compare[lastINT] <= less
AND mv.found
THEN {
ik: INT ~ k.EI;
IF r.lb.Contains[ik] AND r.rb.HasMember[mv.val] THEN RETURN r.base.HasPair[[ik, mv.val]];
};
RETURN [FALSE]};
ReshApply:
PROC [fn: IntFn, i:
INT]
RETURNS [MaybeValue] ~ {
r: Resh ~ NARROW[fn.data];
k: EINT ~ r.lt.EInverseXFormInt[i];
IF k.Compare[firstINT] >= greater
AND k.Compare[lastINT] <= less
THEN {
ik: INT ~ k.EI;
IF r.lb.Contains[ik]
THEN {
mv: MaybeValue ~ r.base.Apply[ik];
IF mv.found AND r.rb.HasMember[mv.val] THEN RETURN [[TRUE, r.rt.Apply[mv.val].Val]];
};
};
RETURN [noMaybe];
};
ReshInvApply:
PROC [fn: IntFn, v: Value]
RETURNS [MaybeInt] ~ {
r: Resh ~ NARROW[fn.data];
mv: MaybeValue ~ r.rt.Apply[v, rightToLeft];
IF mv.found
AND r.rb.HasMember[mv.val]
THEN {
mi: MaybeInt ~ r.base.InvApply[mv.val];
IF mi.found AND r.lb.Contains[mi.i] THEN RETURN [[TRUE, r.lt.XFormInt[mi.i]]];
};
RETURN [noInt]};
ReshScan:
PROC [fn: IntFn,
Test: Tester, left: Interval, right: Collection, bkwd:
BOOL]
RETURNS [mp: MaybePair] ~ {
r: Resh ~ NARROW[fn.data];
Pass:
PROC [pair: IVPair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
p2: IVPair ~ [left: r.lt.XFormInt[pair.left], right: r.rt.Apply[pair.right].Val];
IF (pass ← Test[p2]) THEN mp ← [TRUE, p2];
};
mp ← noMaybePair;
[] ← r.base.Scan[Pass, r.lb, r.rb, bkwd];
RETURN};
ReshSize:
PROC [fn: IntFn, left: Interval, right: Collection, limit:
LNAT]
RETURNS [
LNAT] ~ {
r: Resh ~ NARROW[fn.data];
tLeft: Interval ~ r.lt.ClipInverseXFormInterval[left];
tRight: Collection ~ r.rt.Image[right, rightToLeft];
RETURN r.base.Size[r.lb.Intersect[tLeft], r.rb.Intersection[tRight], limit]};
ReshCopy:
PROC [fn: IntFn]
RETURNS [VarIntFn] ~ {
r: Resh ~ NARROW[fn.data];
RETURN r.base.Copy.Reshape[r.lt, r.lb, r.rt, r.rb].AsVar};
ReshInsulate:
PROC [fn: IntFn]
RETURNS [UWIntFn] ~ {
r: Resh ~ NARROW[fn.data];
RETURN r.base.Insulate.Reshape[r.lt, r.lb, r.rt, r.rb].AsUW};
ReshValueOf:
PROC [fn: IntFn]
RETURNS [ConstIntFn] ~ {
r: Resh ~ NARROW[fn.data];
RETURN r.base.ValueOf.Reshape[r.lt, r.lb, r.rt, r.rb].AsConst};
ReshFreeze:
PROC [fn: IntFn]
RETURNS [const: ConstIntFn] ~ {
r: Resh ~ NARROW[fn.data];
RETURN r.base.Freeze.Reshape[r.lt, r.lb, r.rt, r.rb].AsConst};
ReshThaw:
PROC [fn: IntFn] ~ {
r: Resh ~ NARROW[fn.data];
r.base.Thaw[];
RETURN};
ReshAddColl:
PROC [fn, other: IntFn, if: IfNewsPair]
RETURNS [some: NewsSetPair] ~ {
r: Resh ~ NARROW[fn.data];
RETURN r.base.AddColl[other.Reshape[r.lt.InvertXForm, r.lt.XFormInterval[r.lb], r.rt.Invert, r.rt.Image[r.rb]], if]};
ReshRemColl:
PROC [fn, other: IntFn]
RETURNS [hadSome, hadAll: BoolPair] ~ {
r: Resh ~ NARROW[fn.data];
RETURN r.base.RemColl[other.Reshape[r.lt.InvertXForm, r.lt.XFormInterval[r.lb], r.rt.Invert, r.rt.Image[r.rb]]]};
ReshRightDeleteColl:
PROC [fn: IntFn, coll: Collection, style: RemoveStyle]
RETURNS [hadSome, hadAll:
BOOL] ~ {
r: Resh ~ NARROW[fn.data];
RETURN r.base.RightDeleteColl[r.rt.Image[coll, rightToLeft], style]};
ReshReplaceMe:
PROC [fn, with: IntFn, where, clip: Interval]
RETURNS [losses, gains:
EINT] ~ {
r: Resh ~ NARROW[fn.data];
RETURN r.base.ReplaceMe[with.Reshape[r.lt.InvertXForm, r.lt.XFormInterval[r.lb], r.rt.Invert, r.rt.Image[r.rb]], r.lt.InverseXFormInterval[where], r.lt.InverseXFormInterval[clip]]};
ReshReshapeMe:
PROC [fn: IntFn, lt: XForm, lb: Interval, rt: OneToOne, rb: Collection] ~ {
r: Resh ~ NARROW[fn.data];
tlb: Interval ~ r.lt.ClipInverseXFormInterval[lb];
clb: Interval ~ tlb.Intersect[r.lb];
IF lt=[] AND clb=r.lb AND rt=PCs.id AND rb=Colls.passAll THEN RETURN;
{clt: XForm ~ r.lt.Concat[lt];
crt: OneToOne ~ PCs.Compose[[r.rt, rt]];
trb: Collection ~ r.rt.Image[rb, rightToLeft];
crb: Collection ~ trb.Intersection[r.rb];
r^ ← [r.base, clt, clb, crt, crb];
RETURN}};
ReshRightSpace:
PROC [fn: IntFn]
RETURNS [Space] ~ {
r: Resh ~ NARROW[fn.data];
RETURN [r.rt.Spaces[][right]]};
Start:
PROC ~ {
FOR isOneToOne:
BOOL
IN
BOOL
DO
FOR isDense:
BOOL
IN
BOOL
DO
FOR ordered:
BOOL
IN
BOOL
DO
FOR domainFixed:
BOOL
IN
BOOL
DO
reshClasses[isOneToOne][isDense][ordered][constant][domainFixed] ← CreateClass[[
HasPair: ReshHasPair,
Apply: ReshApply,
InvApply: ReshInvApply,
Scan: ReshScan,
Size: ReshSize,
Copy: ReshCopy,
RightSpace: ReshRightSpace,
isOneToOne: isOneToOne,
isDense: isDense,
ordered: ordered,
mutability: constant,
domainFixed: domainFixed]];
reshClasses[isOneToOne][isDense][ordered][readonly][domainFixed] ← CreateClass[[
HasPair: ReshHasPair,
Apply: ReshApply,
InvApply: ReshInvApply,
Scan: ReshScan,
Size: ReshSize,
Copy: ReshCopy,
ValueOf: ReshValueOf,
RightSpace: ReshRightSpace,
isOneToOne: isOneToOne,
isDense: isDense,
ordered: ordered,
mutability: readonly,
domainFixed: domainFixed]];
reshClasses[isOneToOne][isDense][ordered][variable][domainFixed] ← CreateClass[[
HasPair: ReshHasPair,
Apply: ReshApply,
InvApply: ReshInvApply,
Scan: ReshScan,
Size: ReshSize,
Copy: ReshCopy,
Insulate: ReshInsulate,
ValueOf: ReshValueOf,
Freeze: ReshFreeze,
Thaw: ReshThaw,
AddColl: ReshAddColl,
RemColl: ReshRemColl,
RightDeleteColl: ReshRightDeleteColl,
ReplaceMe: ReshReplaceMe,
ReshapeMe: ReshReshapeMe,
RightSpace: ReshRightSpace,
isOneToOne: isOneToOne,
isDense: isDense,
ordered: ordered,
mutability: variable,
domainFixed: domainFixed]];
ENDLOOP ENDLOOP ENDLOOP ENDLOOP;
};
Start[];
END.