StdIntFunctions6.Mesa
Last tweaked by Mike Spreitzer on October 19, 1987 1:46:07 pm PDT
DIRECTORY Atom, Basics, Collections, IntFunctions, IntStuff, PairCollections, List, RuntimeError;
StdIntFunctions6:
CEDAR
PROGRAM
IMPORTS Collections, IntFunctions, IntStuff, PairCollections, List
EXPORTS IntFunctions
=
BEGIN OPEN PCs:PairCollections, Colls:Collections, Ints:IntStuff, Collections, PairCollections, IntStuff, IntFunctions;
DefaultInsulate:
PUBLIC
PROC [fn: IntFn]
RETURNS [UWIntFn] ~ {
RETURN [AsUW[
IF fn.MutabilityOf#variable
THEN fn
ELSE
[insulatorClasses
[fn.IsOneToOne]
[fn.DomainIsDense]
[fn.Ordered]
[fn.DomainIsFixed],
fn.Refify]]]};
InsulatorClasses: TYPE ~ ARRAY --isOneToOne--BOOL OF ARRAY --isDense--BOOL OF ARRAY --ordered--BOOL OF ARRAY --domainFixed--BOOL OF IntFnClass;
insulatorClasses: REF InsulatorClasses ~ NEW[InsulatorClasses];
InsulatePrimitive:
PROC [fn: IntFn, op:
ATOM, args: ArgList]
RETURNS [PrimitiveAnswer] ~ {
subj: IntFn ~ DeRef[fn.data];
IF QualityOf[subj, op, args]=primitive THEN RETURN [yes];
SELECT op
FROM
$Insulate, $Freeze, $Thaw, $AddColl, $RemoveColl, $RightDeleteColl, $ReplaceMe, $ReshapeMe, $Swap => RETURN [yes];
ENDCASE => RETURN [no];
};
InsulatedWiden:
PROC [fn: IntFn]
RETURNS [Function
--[left]: REF INT--] ~ {
subj: IntFn ~ DeRef[fn.data];
RETURN [subj.Widen[].Insulate[]]};
InsulatedHasPair:
PROC [fn: IntFn, pair: IVPair]
RETURNS [
BOOL] ~ {
subj: IntFn ~ DeRef[fn.data];
RETURN subj.HasPair[pair]};
InsulatedApply:
PROC [fn: IntFn, i:
INT]
RETURNS [MaybeValue] ~ {
subj: IntFn ~ DeRef[fn.data];
RETURN subj.Apply[i]};
InsulatedInvApply:
PROC [fn: IntFn, v: Value]
RETURNS [MaybeInt] ~ {
subj: IntFn ~ DeRef[fn.data];
RETURN subj.InvApply[v]};
InsulatedScan:
PROC [fn: IntFn,
Test: Tester, left: Interval, right: Collection, bkwd:
BOOL]
RETURNS [MaybePair] ~ {
subj: IntFn ~ DeRef[fn.data];
RETURN subj.Scan[Test, left, right, bkwd]};
InsulatedExtremum:
PROC [fn: IntFn, bkwd, remove:
BOOL]
RETURNS [MaybePair] ~ {
subj: IntFn ~ DeRef[fn.data];
IF remove THEN fn.Complain[notVariable];
RETURN subj.class.Extremum[subj, bkwd, remove]};
InsulatedGet3:
PROC [fn: IntFn, pair: IVPair]
RETURNS [prev, same, next: MaybePair] ~ {
subj: IntFn ~ DeRef[fn.data];
RETURN subj.Get3[pair]};
InsulatedIndex:
PROC [fn, goal: IntFn, bounds: Interval, bkwd:
BOOL]
RETURNS [MaybeInt] ~ {
subj: IntFn ~ DeRef[fn.data];
RETURN subj.Index[goal, bounds, bkwd]};
InsulatedSize:
PROC [fn: IntFn, left: Interval, right: Collection, limit:
LNAT]
RETURNS [
LNAT] ~ {
subj: IntFn ~ DeRef[fn.data];
RETURN subj.Size[left, right, limit]};
InsulatedGetBounds:
PROC [fn: IntFn]
RETURNS [Interval] ~ {
subj: IntFn ~ DeRef[fn.data];
RETURN subj.GetBounds[]};
InsulatedImproveBounds:
PROC [fn: IntFn, bounds: Interval]
RETURNS [Interval] ~ {
subj: IntFn ~ DeRef[fn.data];
RETURN subj.ImproveBounds[bounds]};
InsulatedCopy:
PROC [fn: IntFn]
RETURNS [VarIntFn] ~ {
subj: IntFn ~ DeRef[fn.data];
RETURN subj.Copy[]};
InsulatedValueOf:
PROC [fn: IntFn]
RETURNS [ConstIntFn] ~ {
subj: IntFn ~ DeRef[fn.data];
RETURN subj.ValueOf[]};
InsulatedRightCollection:
PROC [fn: IntFn]
RETURNS [UWColl] ~ {
subj: IntFn ~ DeRef[fn.data];
RETURN subj.RightCollection[]};
InsulatedCurRange:
PROC [fn: IntFn]
RETURNS [ConstSet] ~ {
subj: IntFn ~ DeRef[fn.data];
RETURN subj.CurRange[]};
InsulatedRightSpace:
PROC [fn: IntFn]
RETURNS [Space] ~ {
subj: IntFn ~ DeRef[fn.data];
RETURN subj.RightSpace[]};
CreateFromCollection:
PUBLIC
PROC [coll: Collection, bkwd:
BOOL ←
FALSE]
RETURNS [Sequence] ~ {
fc: FromColl ~ NEW [FromCollPrivate ← [coll, bkwd]];
RETURN [[
fromCollClasses
[NOT coll.MayDuplicate]
[IF coll.MutabilityOf=constant THEN constant ELSE readonly],
fc]];
};
fromCollClasses: ARRAY --oneToOne--BOOL OF ARRAY UnwriteableMutability OF IntFnClass;
FromColl: TYPE ~ REF FromCollPrivate;
FromCollPrivate:
TYPE ~
RECORD [
coll: Collection,
bkwd: BOOL ← FALSE
];
FromCollScan:
PROC [fn: IntFn,
Test: Tester, left: Interval, right: Collection, bkwd:
BOOL]
RETURNS [mp: MaybePair] ~ {
fc: FromColl ~ NARROW[fn.data];
i: INT ← IF bkwd THEN fc.coll.Size[]-1 ELSE 0;
Pass:
PROC [val: Value]
RETURNS [pass:
BOOL ←
FALSE] ~ {
IF (pass ← left.Contains[i] AND right.HasMember[val] AND Test[[i, val]]) THEN mp ← [TRUE, [i, val]];
i ← IF bkwd THEN i-1 ELSE i+1};
mp ← noMaybePair;
[] ← fc.coll.Scan[Pass, fc.bkwd#bkwd];
RETURN};
FromCollSize:
PROC [fn: IntFn, left: Interval, right: Collection, limit:
LNAT]
RETURNS [
LNAT] ~ {
fc: FromColl ~ NARROW[fn.data];
IF left.Empty THEN RETURN [0];
IF left.min<=0
AND right=passAll
THEN {
IF left.max < 0 THEN RETURN [0];
RETURN fc.coll.Size[MIN[limit, left.max]];
};
RETURN DefaultSize[fn, left, right, limit];
};
FromCollRightCollection:
PROC [fn: IntFn]
RETURNS [UWColl] ~ {
fc: FromColl ~ NARROW[fn.data];
RETURN fc.coll.Insulate};
FromCollCurRange:
PROC [fn: IntFn]
RETURNS [ConstSet] ~ {
fc: FromColl ~ NARROW[fn.data];
RETURN fc.coll.ValueOf};
FromCollRightSpace:
PROC [fn: IntFn]
RETURNS [Space] ~ {
fc: FromColl ~ NARROW[fn.data];
RETURN fc.coll.SpaceOf};
Invert:
PUBLIC
PROC [fn: IntFn]
RETURNS [Relation] ~ {
RETURN fn.Widen.Invert};
IsIdentitySubset:
PUBLIC
PROC [fn: IntFn]
RETURNS [
BOOL] ~ {
TestPair:
PROC [pair: IVPair]
RETURNS [pass:
BOOL] ~ {
WITH pair.right
SELECT
FROM
x: REF INT => RETURN [pair.left # x^];
ENDCASE => RETURN [TRUE];
};
RETURN [NOT fn.Scan[TestPair].found]};
GradeUp:
PUBLIC
PROC [a: IntFn, o: Colls.Ordering]
RETURNS [p: Permutation] ~ {
indices: LOV ← NIL;
AddIndex: PROC [pair: IVPair] ~ {indices ← CONS[NEW[INT ← pair.left], indices]};
Compare:
PROC[ref1, ref2:
REF
ANY]
RETURNS [c: Basics.Comparison] ~ {
i1: REF INT ~ NARROW[ref1];
i2: REF INT ~ NARROW[ref2];
RETURN o.Compare[o.data, a.Apply[i1^].Val, a.Apply[i2^].Val]};
a.Enumerate[AddIndex];
indices ← List.Sort[indices, Compare];
{coll: Colls.Collection ~ Colls.CreateList[vals: indices, space: refInts, mayDuplicate: FALSE, mutability: constant, orderStyle: client];
pBad: Permutation ~ CreateFromCollection[coll];
p ← CreateSimpleCopy[array: pBad, invable: TRUE];
RETURN}};
TransPermute:
PUBLIC
PROC [from, to: IntFn, p: Permutation] ~ {
PerPair:
PROC [pair: IVPair] ~ {
old: INT ~ NARROW[pair.right, REF INT]^;
mv: MaybeValue ~ from.Apply[old];
IF mv.found THEN [] ← to.Store[[pair.left, mv.val]] ELSE [] ← to.LeftDelete[pair.left];
RETURN};
p.Enumerate[PerPair];
RETURN};
PermuteInPlace:
PUBLIC
PROC [a: Sequence, p: Permutation] ~ {
done: Set--of REF INT-- ~ CreateHashSet[refInts];
PerPair:
PROC [pair: IVPair] ~ {
startToI: INT ~ pair.left;
fromRI: REF INT ← NARROW[pair.right];
IF fromRI^ = startToI THEN RETURN;
IF done.HasMember[fromRI] THEN RETURN;
{startMV: MaybeValue ~ a.Apply[startToI];
toI: INT ← startToI;
UNTIL fromRI^ = startToI
DO
moveMV: MaybeValue ~ a.Apply[fromRI^];
IF NOT done.AddElt[fromRI] THEN ERROR;
IF moveMV.found THEN [] ← a.Store[[toI, moveMV.val]] ELSE [] ← a.LeftDelete[toI];
toI ← fromRI^;
fromRI ← NARROW[p.Apply[toI].val];
ENDLOOP;
IF NOT done.AddElt[fromRI] THEN ERROR;
IF startMV.found THEN [] ← a.Store[[toI, startMV.val]] ELSE [] ← a.LeftDelete[toI];
RETURN}};
p.Enumerate[PerPair];
RETURN};
Start:
PROC ~ {
FOR isOneToOne:
BOOL
IN
BOOL
DO
FOR ordered:
BOOL
IN
BOOL
DO
FOR isDense:
BOOL
IN
BOOL
DO
FOR domainFixed:
BOOL
IN
BOOL
DO
insulatorClasses[isOneToOne][isDense][ordered][domainFixed] ← CreateClass[[
Primitive: InsulatePrimitive,
Widen: InsulatedWiden,
HasPair: InsulatedHasPair,
Apply: InsulatedApply,
InvApply: InsulatedInvApply,
Scan: InsulatedScan,
Extremum: InsulatedExtremum,
Get3: InsulatedGet3,
Index: InsulatedIndex,
Size: InsulatedSize,
GetBounds: InsulatedGetBounds,
ImproveBounds: InsulatedImproveBounds,
Copy: InsulatedCopy,
ValueOf: InsulatedValueOf,
RightCollection: InsulatedRightCollection,
CurRange: InsulatedCurRange,
RightSpace: InsulatedRightSpace,
isOneToOne: isOneToOne,
isDense: isDense,
ordered: ordered,
mutability: readonly,
domainFixed: domainFixed]];
ENDLOOP ENDLOOP ENDLOOP;
fromCollClasses[isOneToOne][constant] ← CreateClass[[
Scan: FromCollScan,
Size: FromCollSize,
RightCollection: FromCollRightCollection,
CurRange: IF isOneToOne THEN FromCollCurRange ELSE NIL,
RightSpace: FromCollRightSpace,
isOneToOne: isOneToOne,
isDense: TRUE,
ordered: TRUE,
mutability: constant,
domainFixed: FALSE]];
fromCollClasses[isOneToOne][readonly] ← CreateClass[[
Scan: FromCollScan,
Size: FromCollSize,
RightCollection: FromCollRightCollection,
CurRange: IF isOneToOne THEN FromCollCurRange ELSE NIL,
RightSpace: FromCollRightSpace,
isOneToOne: isOneToOne,
isDense: TRUE,
ordered: TRUE,
mutability: readonly,
domainFixed: FALSE]];
ENDLOOP;
};
Start[];
END.