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.
^StdIntFunctions6.Mesa
Last tweaked by Mike Spreitzer on October 19, 1987 1:46:07 pm PDT
ΚG˜
code™Kš
œA™A—K˜KšΟk	œX˜aK˜šΟnœœ
˜Kšœ;˜BKšœ
˜K˜
—K˜Kš
œ
œ
žœžœžœ@˜wK˜šžœœ
œ
œ˜>šœœœ˜5š
œ˜Kš
œ˜Kš
œ˜K˜Kš
œ˜—Kš
œ˜——K˜Kšœœœ
Οcœ
œ
œ
Ÿœ
œ
œ
Ÿœ
œ
œ
Ÿœ
œ˜
Kšœœœ˜?K˜šžœœœœ˜ZKš
œ˜Kšœ%œ
œ˜9šœ˜Kšœeœ˜rKšœœ˜—K˜—K˜šžœœ
œ
Ÿœ˜JKš
œ˜Kšœ˜"—K˜šžœœœœ˜CKš
œ˜Kšœ˜—K˜šžœœœœ˜AKš
œ˜Kšœ˜—K˜šžœœœ˜DKš
œ˜Kšœ˜—K˜š
ž
œœ
žœ3œœ˜tKš
œ˜Kšœ%˜+—K˜šžœœœœ˜OKš
œ˜Kšœœ˜(Kšœ*˜0—K˜šž
œœœ"˜WKš
œ˜Kšœ˜—K˜šžœœ+œœ˜[Kš
œ˜Kšœ!˜'—K˜š
ž
œœ7œœœ˜bKš
œ˜Kšœ ˜&—K˜šžœœ
œ˜;Kš
œ˜Kšœ˜—K˜šžœœœ˜QKš
œ˜Kšœ˜#—K˜šž
œœ
œ˜6Kš
œ˜Kšœ˜—K˜šžœœ
œ˜;Kš
œ˜Kšœ˜—K˜šžœœ
œ
˜?Kš
œ˜Kšœ˜—K˜šžœœ
œ˜:Kš
œ˜Kšœ˜—K˜šžœœ
œ˜9Kš
œ˜Kšœ˜—K˜šžœœ
œœœœ˜_Kšœœ"˜4šœ˜	š
œ˜Kšœ
œ˜Kšœ
œœ
œ˜<—Kš
œ˜—K˜—K˜Kšœœ
Ÿœ
œ
œœ˜UK˜Kšœ
œœ˜%šœœœ˜ Kš
œ˜Kšœœ˜K˜—K˜š
žœœ
žœ3œœ˜wKšœœ
˜Kš	œœœœœ˜.š
žœœœœœ˜8Kš
œœœœœ˜dKšœœœœ˜—K˜K˜&Kšœ˜—K˜š
žœœ7œœœ˜aKšœœ
˜Kšœœ
œ˜šœ
œœ˜'Kšœœ
œ˜ Kšœœ˜*K˜—Kšœ%˜+K˜—K˜šžœœ
œ
˜>Kšœœ
˜Kšœ˜—K˜šžœœ
œ˜9Kšœœ
˜Kšœ˜—K˜šžœœ
œ˜8Kšœœ
˜Kšœ˜—K˜šžœœ
œ
œ˜6Kšœ˜—K˜š
žœœ
œ
œœ˜<šžœœœœ˜6šœœ
˜Kšœœ
œœ˜&Kšœœœ˜—K˜—Kšœœ˜&—K˜šžœœ
œœ˜OKšœ	œœ
˜Kš
žœœœ
œ
œ˜Pš
žœœ
œ
œœ˜EKšœœ
œœ˜Kšœœ
œœ˜Kšœ8˜>—K˜K˜&KšœXœ,˜‰
Kš
œ/˜/Kšœ+œ˜1Kšœ˜	—K˜šžœœ
œ&˜?šžœœ˜ Kš	œœœ
œ
œ˜(Kš
œ!˜!Kšœ
œ$œ˜WKšœ˜—K˜Kšœ˜—K˜šžœœ
œ"˜=Kšœ	Ÿœ˜1šžœœ˜ Kšœ
œ
˜Kšœœ
œœ
˜%Kšœœ
œ
˜"Kšœœ
œ
˜&Kš
œ)˜)Kšœœ˜šœ˜Kš
œ&˜&Kšœ
œœ
œ
˜&Kšœœ!œ˜QKš
œ˜Kšœ	œ˜"Kšœ
˜—Kšœ
œœ
œ
˜&Kšœœ"œ˜SKšœ˜	—K˜Kšœ˜—K˜šžœœ˜š	œ
œ
œ
œ
˜šœ
œ
œ
œ
œ
œ
œ
œ
œ
œ
œœ
œ
œ
˜Zš
œK˜KKšž	œ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšžœ˜Kšž	œ˜Kšž
œ˜&Kšžœ˜Kšžœ˜Kšžœ˜*Kšžœ˜Kšž
œ˜ Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜—Kšœ
œ
œ
˜—š
œ5˜5Kšžœ˜Kšžœ˜Kšžœ˜)Kš
žœœœœ
œ
˜7Kšž
œ˜Kš
œ˜Kšœ	œ
˜Kšœ	œ
˜K˜Kšœ
œ˜—š
œ5˜5Kšžœ˜Kšžœ˜Kšžœ˜)Kš
žœœœœ
œ
˜7Kšž
œ˜Kš
œ˜Kšœ	œ
˜Kšœ	œ
˜K˜Kšœ
œ˜—Kšœ
˜—K˜—K˜K˜K˜Kšœ
˜—…—!>,γ