StdIntFunctions5.Mesa
Last tweaked by Mike Spreitzer on October 16, 1987 10:21:02 am PDT
DIRECTORY Basics, Collections, IntFunctions, IntStuff, PairCollections;
StdIntFunctions5:
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]]};
Wp:
PROC [pair: IVPair]
RETURNS [Pair]
~ INLINE {RETURN [[NEW [INT ← pair.left], pair.right]]};
Wmi:
PROC [mi: MaybeInt]
RETURNS [MaybeValue]
~ INLINE {RETURN [IF mi.found THEN [TRUE, Wi[mi.i]] ELSE noMaybe]};
Wmp:
PROC [mp: MaybePair]
RETURNS [PCs.MaybePair]
~ INLINE {RETURN [IF mp.found THEN [TRUE, Wp[mp.pair]] ELSE PCs.noMaybePair]};
Ni:
PROC [i: Value]
RETURNS [
INT]
~ INLINE {RETURN [NARROW[i, REF INT]^]};
Np:
PROC [pair: Pair]
RETURNS [IVPair]
~ INLINE {RETURN [[Ni[pair[left]], pair[right]]]};
Nmi:
PROC [mv: MaybeValue]
RETURNS [MaybeInt]
~ INLINE {RETURN [IF mv.found THEN [TRUE, Ni[mv.val]] ELSE noInt]};
Nmp:
PROC [mp: PCs.MaybePair]
RETURNS [MaybePair]
~ INLINE {RETURN [IF mp.found THEN [TRUE, Np[mp.pair]] ELSE noMaybePair]};
DefaultWiden:
PUBLIC
PROC [fn: IntFn]
RETURNS [Function
--[left]: REF INT--] ~ {
w: Wide ~ NEW [WidePrivate ← [fn]];
RETURN [[wideClasses[fn.IsOneToOne][fn.Ordered][fn.MutabilityOf], w]];
};
Wide: TYPE ~ REF WidePrivate;
WidePrivate:
TYPE ~
RECORD [
fn: IntFn
];
WideClasses: TYPE ~ ARRAY --oneToOne--BOOL OF ARRAY --ordered--BOOL OF ARRAY Mutability OF PairCollClass;
wideClasses: REF WideClasses ~ NEW[WideClasses];
WidePrimitive:
PROC [pc: PairColl, op:
ATOM, args: ArgList ←
NIL]
RETURNS [PrimitiveAnswer] ~ {
w: Wide ~ NARROW[pc.data];
SELECT op
FROM
$HasPair, $Scan, $Extremum, $Get3, $Size, $Copy, $Insulate, $ValueOf, $Freeze, $Thaw, $AddColl, $RemColl => RETURN [IF w.fn.QualityOf[op, args]>=goodDefault THEN yes ELSE no];
$Apply =>
SELECT GetDir[args, 1]
FROM
leftToRight => RETURN [IF w.fn.QualityOf[$Apply]>=goodDefault THEN yes ELSE no];
rightToLeft => RETURN [IF w.fn.QualityOf[$InvApply]>=goodDefault THEN yes ELSE no];
ENDCASE => ERROR;
$ScanHalfRestriction =>
RETURN [
SELECT GetSide[args, 1]
FROM
right => IF w.fn.QualityOf[$Scan, LIST[$unrestricted, $restricted]]>=goodDefault THEN yes ELSE no,
left => IF w.fn.QualityOf[$Scan, LIST[$restricted]]>=goodDefault THEN yes ELSE no,
ENDCASE => ERROR];
$ImageSize =>
RETURN [
SELECT GetDir[args, 1]
FROM
rightToLeft => IF w.fn.QualityOf[$Size, LIST[$unrestricted, $restricted]]>=goodDefault THEN yes ELSE no,
leftToRight => IF w.fn.QualityOf[$Size, LIST[$restricted]]>=goodDefault THEN yes ELSE no,
ENDCASE => ERROR];
$CollectionOn =>
RETURN [
SELECT GetSide[args, 1]
FROM
left => IF w.fn.class.isDense AND w.fn.MutabilityOf=constant AND w.fn.QualityOf[$GetBounds]>=goodDefault THEN yes ELSE no,
right => IF w.fn.QualityOf[$RightCollection]>=goodDefault THEN yes ELSE no,
ENDCASE => ERROR];
$CurSetOn =>
RETURN [
SELECT GetSide[args, 1]
FROM
left => IF w.fn.class.isDense AND w.fn.QualityOf[$GetBounds]>=goodDefault THEN yes ELSE no,
right => IF w.fn.QualityOf[$CurRange]>=goodDefault THEN yes ELSE no,
ENDCASE => ERROR];
$DeleteColl =>
RETURN [
SELECT GetSide[args, 1]
FROM
right => IF w.fn.QualityOf[$RightDeleteColl]>=goodDefault THEN yes ELSE no,
left => yes,
ENDCASE => ERROR];
$QuaIntFn =>
RETURN [
SELECT GetDir[args, 1]
FROM
leftToRight => yes,
rightToLeft => no,
ENDCASE => ERROR];
$Spaces => RETURN [IF w.fn.QualityOf[$RightSpace]>=goodDefault THEN yes ELSE no];
ENDCASE => RETURN[pass];
};
WideHasPair:
PROC [pc: PairColl, pair: Pair]
RETURNS [
BOOL] ~ {
w: Wide ~ NARROW[pc.data];
RETURN w.fn.HasPair[Np[pair]]};
WideApply:
PROC [pc: PairColl, v: Value, dir: Direction]
RETURNS [MaybeValue] ~ {
w: Wide ~ NARROW[pc.data];
SELECT dir
FROM
leftToRight => RETURN w.fn.Apply[Ni[v]];
rightToLeft => RETURN Wmi[w.fn.InvApply[v]];
ENDCASE => ERROR};
WideScan:
PROC [pc: PairColl,
Test: PCs.Tester, bkwd:
BOOL]
RETURNS [PCs.MaybePair] ~ {
w: Wide ~ NARROW[pc.data];
Pass: PROC [pair: IVPair] RETURNS [pass: BOOL ← FALSE] ~ {pass ← Test[Wp[pair]]};
RETURN Wmp[w.fn.Scan[Test: Pass, bkwd: bkwd]]};
WideScanHalfRestriction:
PROC [pc: PairColl, side: Side, coll: Collection,
Test: PCs.Tester, bkwd:
BOOL]
RETURNS [PCs.MaybePair] ~ {
w: Wide ~ NARROW[pc.data];
Pass: PROC [pair: IVPair] RETURNS [pass: BOOL ← FALSE] ~ {pass ← Test[Wp[pair]]};
TestAndPass:
PROC [pair: IVPair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
wp: Pair ~ Wp[pair];
pass ← coll.HasMember[wp[left]] AND Test[wp]};
test: BOOL ← FALSE;
lb: Interval ← [];
rb: Collection ← passAll;
SELECT side
FROM
right => rb ← coll;
left =>
IF coll.OrderStyleOf=value
AND coll.QualityOf[$First]>=goodDefault
AND coll.QualityOf[$Last]>=goodDefault
AND coll.OrderingOf=intOrder
THEN {
IF coll.Empty THEN RETURN [PCs.noMaybePair];
{min: INT ~ Ni[coll.First[].Val];
max: INT ~ Ni[coll.Last[].Val];
lb ← BoundsOfInts[min, max];
}}
ELSE test ← TRUE;
ENDCASE => ERROR;
RETURN Wmp[w.fn.Scan[IF test THEN TestAndPass ELSE Pass, lb, rb, bkwd]]};
intOrder: Colls.Ordering ~ [refInts.Compare, refInts.data];
WideExtremum:
PROC [pc: PairColl, bkwd, remove:
BOOL]
RETURNS [PCs.MaybePair] ~ {
w: Wide ~ NARROW[pc.data];
RETURN Wmp[w.fn.Extremum[bkwd, remove]]};
WideGet3:
PROC [pc: PairColl, pair: Pair]
RETURNS [prev, same, next: PCs.MaybePair] ~ {
w: Wide ~ NARROW[pc.data];
wPrev, wSame, wNext: MaybePair;
[wPrev, wSame, wNext] ← w.fn.Get3[Np[pair]];
prev ← Wmp[wPrev];
same ← Wmp[wSame];
next ← Wmp[wNext];
RETURN};
WideSize:
PROC [pc: PairColl, limit:
LNAT]
RETURNS [
LNAT] ~ {
w: Wide ~ NARROW[pc.data];
RETURN w.fn.Size[limit: limit]};
WideImageSize:
PROC [pc: PairColl, coll: Collection, dir: Direction, limit:
LNAT]
RETURNS [
LNAT] ~ {
w: Wide ~ NARROW[pc.data];
lb: Interval ← [];
rb: Collection ← passAll;
SELECT dir
FROM
rightToLeft => rb ← coll;
leftToRight =>
IF coll.OrderStyleOf=value
AND coll.QualityOf[$First]>=goodDefault
AND coll.QualityOf[$Last]>=goodDefault
AND coll.OrderingOf=intOrder
THEN {
IF coll.Empty THEN RETURN [0];
{min: INT ~ Ni[coll.First[].Val];
max: INT ~ Ni[coll.Last[].Val];
lb ← BoundsOfInts[min, max];
}}
ELSE RETURN DefaultImageSize[pc, coll, dir, limit];
ENDCASE => ERROR;
RETURN w.fn.Size[lb, rb, limit]};
WideCopy:
PROC [pc: PairColl]
RETURNS [VarPairColl] ~ {
w: Wide ~ NARROW[pc.data];
RETURN w.fn.Copy.Widen.AsVar};
WideInsulate:
PROC [pc: PairColl]
RETURNS [UWPairColl] ~ {
w: Wide ~ NARROW[pc.data];
RETURN w.fn.Insulate.Widen.AsUW};
WideValueOf:
PROC [pc: PairColl]
RETURNS [ConstPairColl] ~ {
w: Wide ~ NARROW[pc.data];
RETURN w.fn.ValueOf.Widen.AsConst};
WideFreeze:
PROC [pc: PairColl]
RETURNS [ConstPairColl] ~ {
w: Wide ~ NARROW[pc.data];
RETURN w.fn.Freeze.Widen.AsConst};
WideThaw:
PROC [pc: PairColl] ~ {
w: Wide ~ NARROW[pc.data];
w.fn.Thaw[];
RETURN};
WideCollectionOn:
PROC [pc: PairColl, side: Side]
RETURNS [UWColl] ~ {
w: Wide ~ NARROW[pc.data];
SELECT side
FROM
right => RETURN w.fn.RightCollection[];
left => {
IF w.fn.class.isDense AND w.fn.MutabilityOf=constant THEN RETURN [CollectInterval[w.fn.GetBounds].AsUW];
RETURN DefaultCollectionOn[pc, side]};
ENDCASE => ERROR};
WideCurSetOn:
PROC [pc: PairColl, side: Side]
RETURNS [ConstSet] ~ {
w: Wide ~ NARROW[pc.data];
SELECT side
FROM
right => RETURN w.fn.CurRange[];
left => {
IF w.fn.class.isDense THEN RETURN CollectInterval[w.fn.GetBounds];
RETURN DefaultCurSetOn[pc, side]};
ENDCASE => ERROR};
WideAddColl:
PROC [pc, other: PairColl, if: IfNewsPair, where: Where]
RETURNS [some: NewsSetPair] ~ {
w: Wide ~ NARROW[pc.data];
RETURN w.fn.AddColl[DeRef[other.AsIntFn], if]};
WideRemColl:
PROC [pc, other: PairColl, style: RemoveStyle]
RETURNS [hadSome, hadAll: BoolPair] ~ {
w: Wide ~ NARROW[pc.data];
RETURN w.fn.RemColl[DeRef[other.AsIntFn]]};
WideDeleteColl:
PROC [pc: PairColl, coll: Collection, side: Side, style: RemoveStyle]
RETURNS [hadSome, hadAll:
BOOL] ~ {
w: Wide ~ NARROW[pc.data];
SELECT side
FROM
right => RETURN w.fn.RightDeleteColl[coll, style];
left =>
IF coll.OrderStyleOf=value
AND coll.QualityOf[$First]>=goodDefault
AND coll.QualityOf[$Last]>=goodDefault
AND coll.OrderingOf=intOrder
THEN {
IF coll.Empty THEN RETURN [FALSE, TRUE];
{min: INT ~ Ni[coll.First[].Val];
max: INT ~ Ni[coll.Last[].Val];
lb: Interval ~ BoundsOfInts[min, max];
RETURN w.fn.LeftDeleteInterval[lb];
}}
ELSE RETURN DefaultDeleteColl[pc, coll, side, style];
ENDCASE => ERROR;
};
WideQuaIntFn:
PROC [pc: PairColl, dir: Direction]
RETURNS [MaybeValue] ~ {
w: Wide ~ NARROW[pc.data];
IF dir=leftToRight THEN RETURN [[TRUE, w.fn.Refify]] ELSE RETURN DefaultQuaIntFn[pc, dir]};
WideSpaces:
PROC [pc: PairColl]
RETURNS [SpacePair] ~ {
w: Wide ~ NARROW[pc.data];
RETURN [[left: refInts, right: w.fn.RightSpace]]};
Start:
PROC ~ {
FOR isOneToOne:
BOOL
IN
BOOL
DO
FOR ordered:
BOOL
IN
BOOL
DO
wideClasses[isOneToOne][ordered][constant] ← PCs.CreateClass[[
Primitive: WidePrimitive,
HasPair: WideHasPair,
Apply: WideApply,
Scan: WideScan,
ScanHalfRestriction: WideScanHalfRestriction,
Extremum: WideExtremum,
Get3: WideGet3,
Size: WideSize,
ImageSize: WideImageSize,
Copy: WideCopy,
CollectionOn: WideCollectionOn,
CurSetOn: WideCurSetOn,
QuaIntFn: WideQuaIntFn,
Spaces: WideSpaces,
functional: [TRUE, isOneToOne],
mayDuplicate: FALSE,
orderStyle: IF ordered THEN value ELSE none,
mutability: constant
]];
wideClasses[isOneToOne][ordered][readonly] ← PCs.CreateClass[[
Primitive: WidePrimitive,
HasPair: WideHasPair,
Apply: WideApply,
Scan: WideScan,
ScanHalfRestriction: WideScanHalfRestriction,
Extremum: WideExtremum,
Get3: WideGet3,
Size: WideSize,
ImageSize: WideImageSize,
Copy: WideCopy,
ValueOf: WideValueOf,
CollectionOn: WideCollectionOn,
CurSetOn: WideCurSetOn,
QuaIntFn: WideQuaIntFn,
Spaces: WideSpaces,
functional: [TRUE, isOneToOne],
mayDuplicate: FALSE,
orderStyle: IF ordered THEN value ELSE none,
mutability: readonly
]];
wideClasses[isOneToOne][ordered][variable] ← PCs.CreateClass[[
Primitive: WidePrimitive,
HasPair: WideHasPair,
Apply: WideApply,
Scan: WideScan,
ScanHalfRestriction: WideScanHalfRestriction,
Extremum: WideExtremum,
Get3: WideGet3,
Size: WideSize,
ImageSize: WideImageSize,
Copy: WideCopy,
Insulate: WideInsulate,
ValueOf: WideValueOf,
Freeze: WideFreeze,
Thaw: WideThaw,
CollectionOn: WideCollectionOn,
CurSetOn: WideCurSetOn,
AddColl: WideAddColl,
RemColl: WideRemColl,
DeleteColl: WideDeleteColl,
QuaIntFn: WideQuaIntFn,
Spaces: WideSpaces,
functional: [TRUE, isOneToOne],
mayDuplicate: FALSE,
orderStyle: IF ordered THEN value ELSE none,
mutability: variable
]];
ENDLOOP ENDLOOP;
};
Start[];
END.