PairCollectionsImpl.Mesa
Last tweaked by Mike Spreitzer on October 16, 1987 10:23:28 am PDT
DIRECTORY Atom, Basics, Collections, PairCollections, List, Process;
PairCollectionsImpl:
CEDAR
MONITOR
LOCKS par USING par: Parallel
IMPORTS Atom, Collections, PairCollections, List, Process
EXPORTS PairCollections
=
BEGIN OPEN Colls:Collections, Collections, PairCollections;
Cant: PUBLIC ERROR [pc: PairColl] ~ CODE;
Cons:
PUBLIC
PROC [class: PairCollClass, data:
REF
ANY]
RETURNS [PairColl] ~ {
RETURN [[class, data]]};
notNew: PUBLIC ROPE ~ BeRope["function %g already had mapping for domain of %g"];
noPair: PUBLIC Pair ~ [Collections.noValue, Collections.noValue];
noMaybePair: PUBLIC MaybePair ~ [FALSE, noPair];
Escape: ERROR = CODE;
provisionKey: ATOM ~ $PairCollectionsImplProvision;
bkwdableKey: ATOM ~ $PairCollectionsImplBkwdable;
dirableKey: ATOM ~ $PairCollectionsImplDirable;
kindKey: ATOM ~ $PairCollectionsImplKind;
CreateClass:
PUBLIC
PROC [cp: PairCollClassPrivate,
bkwdable: BB ← [TRUE, FALSE],
dirable: BoolPair ← [TRUE, FALSE]]
RETURNS [class: PairCollClass] ~ {
provs: Atom.PropList ← NARROW[List.Assoc[key: provisionKey, aList: cp.other]];
Sp:
PROC [op:
ATOM, def:
BOOL]
RETURNS [
BOOL] ~ {
provs ← List.PutAssoc[op, IF def THEN $Default ELSE $Primitive, provs];
RETURN [def]};
{OPEN cp;
IF Sp[$Widen, Widen=NIL] THEN Widen ← DefaultWiden;
IF Sp[$HasPair, HasPair=NIL] THEN HasPair ← DefaultHasPair;
IF Sp[$Image, Image=NIL] THEN Image ← DefaultImage;
IF Sp[$Apply, Apply=NIL] THEN Apply ← DefaultApply;
IF Sp[$Scan, Scan=NIL] THEN Scan ← DefaultScan;
IF Sp[$ScanHalfRestriction, ScanHalfRestriction=NIL] THEN ScanHalfRestriction ← DefaultScanHalfRestriction;
IF Sp[$Extremum, Extremum=NIL] THEN Extremum ← DefaultExtremum;
IF Sp[$Get3, Get3=NIL] THEN Get3 ← DefaultGet3;
IF Sp[$Size, Size=NIL] THEN Size ← DefaultSize;
IF Sp[$ImageSize, ImageSize=NIL] THEN ImageSize ← DefaultImageSize;
IF Sp[$Copy, Copy=NIL] THEN Copy ← DefaultCopy;
IF Sp[$Insulate, Insulate=NIL] THEN Insulate ← DefaultInsulate;
IF Sp[$ValueOf, ValueOf=NIL] THEN ValueOf ← DefaultValueOf;
IF Sp[$Freeze, Freeze=NIL] THEN Freeze ← DefaultFreeze;
IF Sp[$Thaw, Thaw=NIL] THEN Thaw ← DefaultThaw;
IF Sp[$CollectionOn, CollectionOn=NIL] THEN CollectionOn ← DefaultCollectionOn;
IF Sp[$CurSetOn, CurSetOn=NIL] THEN CurSetOn ← DefaultCurSetOn;
IF Sp[$AddColl, AddColl=NIL] THEN AddColl ← DefaultAddColl;
IF Sp[$RemColl, RemColl=NIL] THEN RemColl ← DefaultRemColl;
IF Sp[$DeleteColl, DeleteColl=NIL] THEN DeleteColl ← DefaultDeleteColl;
IF Sp[$QuaIntFn, QuaIntFn=NIL] THEN QuaIntFn ← DefaultQuaIntFn;
IF Sp[$OrderingOf, OrderingOf=NIL] THEN OrderingOf ← DefaultOrderingOf;
};
cp.other ← List.PutAssoc[provisionKey, provs, cp.other];
cp.other ← List.PutAssoc[bkwdableKey, NEW [BB ← bkwdable], cp.other];
cp.other ← List.PutAssoc[dirableKey, NEW [BoolPair ← dirable], cp.other];
class ← NEW [PairCollClassPrivate ← cp];
};
Primitive:
PROC [pc: PairColl, op:
ATOM, args: ArgList ←
NIL]
RETURNS [
BOOL] ~ {
kind: REF ANY ~ Atom.GetProp[atom: op, prop: kindKey];
SELECT kind
FROM
$class, $classD, $classB, $classBR, $classSB, $classS => NULL;
ENDCASE => ERROR;
IF pc.class.Primitive #
NIL
THEN
SELECT pc.class.Primitive[pc, op, args]
FROM
yes => RETURN [TRUE];
no => RETURN [FALSE];
pass => NULL;
ENDCASE => ERROR;
{provs: Atom.PropList ~ NARROW[List.Assoc[key: provisionKey, aList: pc.class.other]];
prov: REF ANY ~ List.Assoc[op, provs];
bkwdable: REF BB ~ NARROW[List.Assoc[bkwdableKey, pc.class.other]];
dirable: REF BoolPair ~ NARROW[List.Assoc[dirableKey, pc.class.other]];
RETURN [
SELECT prov
FROM
$Default => FALSE,
$Primitive =>
SELECT kind
FROM
$class => TRUE,
$classD => dirable[GetDir[args, 1]],
$classB => bkwdable[GetBool[args, 1]],
$classBR => (pc.MutabilityOf[]#variable AND GetBool[args, 2]) OR bkwdable[GetBool[args, 1]],
$classSB => dirable[From[GetSide[args, 1]]] AND bkwdable[GetBool[args, 2]],
$classS => dirable[From[GetSide[args, 1]]],
ENDCASE => ERROR,
ENDCASE => ERROR];
}};
QualityOf:
PUBLIC
PROC [pc: PairColl, op:
ATOM, args: ArgList ←
NIL]
RETURNS [ImplQuality] ~ {
SELECT Atom.GetProp[atom: op, prop: kindKey]
FROM
$class, $classD, $classB, $classBR, $classSB, $classS => NULL;
$composite =>
SELECT op
FROM
$Mapping => RETURN QualityOf[pc, $Image, args];
$Enumerate => RETURN QualityOf[pc, $Scan, args];
$EnumerateImage => RETURN QualityOf[pc, $ScanImage, args];
$EnumerateMapping => RETURN QualityOf[pc, $ScanImage, args];
$EnumerateHalfRestriction => RETURN QualityOf[pc, $ScanHalfRestriction, args];
$ScanImage => RETURN QualityOf[pc, $ScanHalfRestriction, IF args#NIL THEN CONS[FromSide[Source[GetDir[args, 1]]], args.rest] ELSE NIL];
$ScanMapping => RETURN QualityOf[pc, $ScanImage, args];
$First => RETURN QualityOf[pc, $Extremum, LIST[$FALSE, $FALSE]];
$Last => RETURN QualityOf[pc, $Extremum, LIST[$TRUE, $FALSE]];
$Pop => RETURN QualityOf[pc, $Extremum, LIST[FromBool[GetBool[args, 1]], $TRUE]];
$Next => RETURN QMin[QualityOf[pc, $Get3], goodDefault];
$Prev => RETURN QMin[QualityOf[pc, $Get3], goodDefault];
$Empty =>
RETURN [
SELECT QualityOf[pc, $Size, args]
FROM
primitive => primitive,
goodDefault, poorDefault => goodDefault,
cant => cant,
ENDCASE => ERROR];
$MappingSize => RETURN QualityOf[pc, $ImageSize, args];
$AddPair => RETURN QualityOf[pc, $AddColl, args];
$Store => RETURN QualityOf[pc, $AddColl, args];
$Replace => RETURN QualityOf[pc, $AddColl, args];
$Insert => RETURN QualityOf[pc, $AddColl, args];
$Inserted => RETURN QualityOf[pc, $AddColl, args];
$RemPair => RETURN QualityOf[pc, $RemColl, args];
$Delete => RETURN QualityOf[pc, $DeleteColl, args];
$IsIntFn => RETURN QualityOf[pc, $QuaIntFn, args];
$AsIntFn => RETURN QualityOf[pc, $QuaIntFn, args];
ENDCASE => ERROR;
ENDCASE => ERROR;
IF Primitive[pc, op, args] THEN RETURN [primitive];
RETURN [
SELECT op
FROM
$Widen => cant,
$HasPair =>
IF pc.Functional[][leftToRight] AND Primitive[pc, $Apply, LIST[$leftToRight]] OR pc.Functional[][rightToLeft] AND Primitive[pc, $Apply, LIST[$rightToLeft]] THEN goodDefault
ELSE IF pc.Spaces[][left]#NIL AND pc.Spaces[][right]#NIL THEN poorDefault
ELSE cant,
$Image => QMin[poorDefault, QualityOf[pc, $Enumerate]],
$Apply => QMin[goodDefault, QualityOf[pc, $Mapping, args]],
$Scan => IF Primitive[pc, $Scan, LIST[FromBool[NOT GetBool[args, 1]]]] THEN poorDefault ELSE cant,
$ScanHalfRestriction => QMax[
QMin[QualityOf[pc, $Image, LIST[FromDir[From[GetSide[args, 1]]]]], goodDefault],
QMin[QualityOf[pc, $Scan, LIST[FromBool[GetBool[args, 2]]]], poorDefault]],
$Extremum => QMin[IF pc.QualityOf[$Scan, args] >= goodDefault THEN goodDefault ELSE poorDefault, IF GetBool[args, 2] THEN pc.QualityOf[$RemPair] ELSE goodDefault],
$Get3 => IF QualityOf[pc, $Spaces]=cant THEN cant ELSE QMin[poorDefault, QMax[QualityOf[pc, $Scan, LIST[$TRUE]], QualityOf[pc, $Scan, LIST[$FALSE]]]],
$Size => QMin[QualityOf[pc, $Scan], poorDefault],
$ImageSize => QMin[QualityOf[pc, $ScanImage, args], poorDefault],
$Copy => cant,
$Insulate => goodDefault,
$ValueOf => IF pc.class.mutability=constant THEN goodDefault ELSE QMin[poorDefault, QMin[QualityOf[pc, $Copy], QualityOf[pc, $Freeze]]],
$Freeze, $Thaw => IF pc.MutabilityOf=variable THEN cant ELSE ERROR,
$CollectionOn => QMin[QualityOf[pc, $Enumerate], poorDefault],
$CurSetOn => IF pc.MutabilityOf=constant THEN QMin[goodDefault, QualityOf[pc, $CollectionOn, args]] ELSE cant,
$AddColl, $RemoveColl, $DeleteColl => IF pc.MutabilityOf=variable THEN cant ELSE goodDefault,
$QuaIntFn => goodDefault,
$Spaces => cant,
$OrderingOf => IF pc.class.orderStyle#value THEN goodDefault ELSE QMin[goodDefault, QualityOf[pc, $Spaces]],
ENDCASE => ERROR];
};
DefaultHasPair:
PUBLIC
PROC [pc: PairColl, pair: Pair]
RETURNS [has:
BOOL] ~ {
goal: Pair ~ pair;
spaces: SpacePair ~ pc.Spaces[];
Has:
PROC [pair: Pair]
RETURNS [pass:
BOOL ←
FALSE]
--Tester-- ~ {
pass ← spaces[left].SpaceEqual[goal[left], pair[left]] AND spaces[right].SpaceEqual[goal[right], pair[right]];
};
IF pc.Functional[][leftToRight] AND Primitive[pc, $Apply, LIST[$leftToRight]] THEN {appl: MaybeValue ~ pc.Apply[pair[left], leftToRight]; has ← appl.found AND spaces[right].SpaceEqual[appl.val, pair[right]]}
ELSE IF pc.Functional[][rightToLeft] AND Primitive[pc, $Apply, LIST[$rightToLeft]] THEN {appl: MaybeValue ~ pc.Apply[pair[right], rightToLeft]; has ← appl.found AND spaces[left].SpaceEqual[appl.val, pair[left]]}
ELSE IF spaces[left]#NIL AND spaces[right]#NIL THEN has ← pc.Scan[Has].found
ELSE Cant[pc];
RETURN};
DefaultImage:
PUBLIC
PROC [pc: PairColl, coll: Collection, dir: Direction]
RETURNS [UWColl] ~ {
ic: ImageColl ~ NEW [ImageCollPrivate ← [pc, coll, dir]];
RETURN Colls.CreateEnumerator[e: [EnumerateImageColl, pc.Spaces[][Dest[dir]], NIL, ic], mayDuplicate: FALSE].AsUW[];
};
ImageColl: TYPE ~ REF ImageCollPrivate;
ImageCollPrivate: TYPE ~ RECORD [pc: PairColl, coll: Collection, dir: Direction];
EnumerateImageColl:
PROC [
Consume:
PROC [val: Value], data:
REF
ANY ←
NIL] ~ {
ic: ImageColl ~ NARROW[data];
Pass:
PROC [pair: Pair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
Consume[pair[Dest[ic.dir]]]; RETURN};
TestAndPass:
PROC [pair: Pair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
IF ic.coll.HasMember[pair[Source[ic.dir]]] THEN Consume[pair[Dest[ic.dir]]];
RETURN};
IF Primitive[ic.pc, $ScanHalfRestriction, LIST[FromSide[Source[ic.dir]]]] THEN [] ← ic.pc.ScanHalfRestriction[ic.coll, Pass, Source[ic.dir]] ELSE [] ← ic.pc.Scan[TestAndPass];
RETURN};
DefaultApply:
PUBLIC
PROC [pc: PairColl, v: Value, dir: Direction]
RETURNS [mv: MaybeValue ← noMaybe] ~ {
IF NOT pc.Functional[][dir] THEN pc.Complain["%g not functional in this direction"];
{map: UWColl ~ pc.Mapping[v, dir];
SELECT map.Size[2]
FROM
0 => RETURN;
1 => RETURN [[TRUE, map.TheElt[]]];
ENDCASE => ERROR;
}};
Enumerate:
PUBLIC
PROC [pc: PairColl,
Consume:
PROC [pair: Pair], bkwd:
BOOL ←
FALSE] ~ {
Pass: PROC [x: Pair] RETURNS [pass: BOOL ← FALSE] ~ {Consume[x]};
[] ← pc.Scan[Pass, bkwd];
RETURN};
DefaultScan:
PUBLIC
PROC [pc: PairColl,
Test: Tester, bkwd:
BOOL]
RETURNS [mv: MaybePair ← noMaybePair] ~ {
pl: BOOL ~ Primitive[pc, $ScanHalfRestriction, LIST[$left, FromBool[bkwd]]];
pr: BOOL ~ Primitive[pc, $ScanHalfRestriction, LIST[$right, FromBool[bkwd]]];
IF pl
OR pr
THEN {
s: Side ~ IF NOT pl THEN right ELSE IF NOT pr THEN left ELSE IF pc.Functional[] = [FALSE, TRUE] THEN right ELSE left;
mv ← pc.ScanHalfRestriction[passAll, Test, s, bkwd];
}
ELSE
IF Primitive[pc, $Scan,
LIST[FromBool[
NOT bkwd]]]
THEN {
elts: LOP ← NIL;
Addit: PROC [x: Pair] ~ {elts ← CONS[x, elts]};
pc.Enumerate[Addit, NOT bkwd];
FOR elts ← elts, elts.rest WHILE elts # NIL DO IF Test[elts.first] THEN RETURN [[TRUE, elts.first]] ENDLOOP;
}
ELSE Cant[pc];
RETURN};
EnumerateImage:
PUBLIC
PROC [pc: PairColl, coll: Collection,
Consume:
PROC [v: Value], dir: Direction ← leftToRight, bkwd:
BOOL ←
FALSE] ~ {
Pass: PROC [x: Pair] RETURNS [pass: BOOL ← FALSE] ~ {Consume[x[Dest[dir]]]};
[] ← pc.ScanHalfRestriction[coll, Pass, Source[dir], bkwd];
RETURN};
EnumerateHalfRestriction:
PUBLIC
PROC [pc: PairColl, coll: Collection,
Consume:
PROC [pair: Pair], side: Side ← left, bkwd:
BOOL ←
FALSE] ~ {
Pass: PROC [pair: Pair] RETURNS [pass: BOOL ← FALSE] ~ {Consume[pair]};
[] ← pc.ScanHalfRestriction[coll, Pass, side, bkwd];
RETURN};
ScanImage:
PUBLIC
PROC [pc: PairColl, coll: Collection,
Test: Colls.Tester, dir: Direction ← leftToRight, bkwd:
BOOL ←
FALSE]
RETURNS [mp: MaybePair ← noMaybePair] ~ {
Mid: PROC [pair: Pair] RETURNS [pass: BOOL ← FALSE] ~ {pass ← Test[pair[Dest[dir]]]};
mp ← pc.ScanHalfRestriction[coll, Mid, Source[dir], bkwd];
RETURN};
DefaultScanHalfRestriction:
PUBLIC
PROC [pc: PairColl, side: Side, coll: Collection,
Test: Tester, bkwd:
BOOL]
RETURNS [MaybePair] ~ {
ImageColl:
PROC
RETURNS [mp: MaybePair ← noMaybePair] ~ {
PerDom:
PROC [v: Value]
RETURNS [pass:
BOOL] ~ {
image: Collection ~ pc.Mapping[v, From[side]];
pair: Pair ← ALL[v];
PerRange:
PROC [w: Value]
RETURNS [pass:
BOOL] ~ {
pair[OtherSide[side]] ← w;
IF (pass ← Test[pair]) THEN mp ← [TRUE, pair];
RETURN};
pass ← image.Scan[PerRange, bkwd].found;
RETURN};
[] ← coll.Scan[PerDom, bkwd];
RETURN};
ScanPC:
PROC
RETURNS [mp: MaybePair] ~ {
PerPair:
PROC [pair: Pair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
pass ← coll.HasMember[pair[side]] AND Test[pair];
RETURN};
mp ← pc.Scan[PerPair, bkwd];
RETURN};
pcCanScan: BOOL ~ pc.Can[$Scan, LIST[FromBool[bkwd]]];
collCanScan: BOOL ~ coll.Can[$Scan, LIST[FromBool[bkwd]]];
pcGoodSize: BOOL ~ pc.QualityOf[$Size] >= goodDefault;
collGoodSize: BOOL ~ coll.QualityOf[$Size] >= goodDefault;
pcGoodImage: BOOL ~ pc.QualityOf[$Image] >= goodDefault;
collGoodMemb: BOOL ~ coll.QualityOf[$HasMember] >= goodDefault;
IF (NOT pcCanScan) AND (NOT collCanScan) THEN Cant[pc];
IF NOT pcCanScan THEN RETURN ImageColl[];
IF NOT collCanScan THEN RETURN ScanPC[];
IF pcGoodSize AND collGoodSize THEN RETURN (IF (IF coll.Size[] < pc.Size[] THEN pcGoodImage ELSE NOT collGoodMemb) THEN ImageColl ELSE ScanPC)[];
RETURN (IF pcGoodImage THEN ImageColl ELSE ScanPC)[];
};
DefaultExtremum:
PUBLIC
PROC [pc: PairColl, bkwd, remove:
BOOL]
RETURNS [m: MaybePair] ~ {
Easy: PROC [val: Pair] RETURNS [pass: BOOL ← FALSE] ~ {pass ← TRUE};
Hard: PROC [val: Pair] RETURNS [pass: BOOL ← FALSE] ~ {m ← [TRUE, val]};
IF pc.QualityOf[$Scan, LIST[FromBool[bkwd]]] >= goodDefault THEN m ← pc.Scan[Easy, bkwd]
ELSE [] ← pc.Scan[Hard, NOT bkwd];
IF m.found
AND remove
THEN {
had: BoolPair ~ pc.RemPair[m.pair, IF bkwd THEN last ELSE first];
FOR dir: Direction
IN Direction
DO
IF pc.Functional[][dir] AND NOT had[dir] THEN ERROR;
ENDLOOP;
};
RETURN};
DefaultGet3:
PUBLIC
PROC [pc: PairColl, pair: Pair]
RETURNS [prev, same, next: MaybePair] ~ {
fq: ImplQuality ~ pc.QualityOf[$Scan, LIST[$FALSE]];
bq: ImplQuality ~ pc.QualityOf[$Scan, LIST[$TRUE]];
bkwd: BOOL ~ bq > fq;
take: BOOL ← FALSE;
spaces: SpacePair ~ pc.Spaces[];
Pass:
PROC [val: Pair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
IF spaces[left].SpaceEqual[val[left], pair[left]] AND spaces[right].SpaceEqual[val[right], pair[right]] THEN same ← [take ← TRUE, pair]
ELSE IF take THEN pass ← TRUE
ELSE prev ← [TRUE, val];
};
IF spaces[left]=NIL OR spaces[right]=NIL THEN Cant[pc];
prev ← same ← noMaybePair;
next ← pc.Scan[Pass, bkwd];
IF bkwd THEN RETURN [next, same, prev];
RETURN};
DefaultSize:
PUBLIC
PROC [pc: PairColl, limit:
LNAT]
RETURNS [size:
LNAT] ~ {
Pass: PROC [Pair] RETURNS [pass: BOOL] ~ {pass ← limit <= (size ← size+1)};
size ← 0;
[] ← pc.Scan[Pass];
RETURN};
DefaultImageSize:
PUBLIC
PROC [pc: PairColl, coll: Collection, dir: Direction, limit:
LNAT]
RETURNS [size:
LNAT] ~ {
Pass: PROC [Value] RETURNS [pass: BOOL] ~ {pass ← limit <= (size ← size+1)};
size ← 0;
[] ← pc.ScanImage[coll, Pass, dir];
RETURN};
DefaultCopy: PUBLIC PROC [pc: PairColl] RETURNS [VarPairColl] ~ {Cant[pc]};
DefaultValueOf: PUBLIC PROC [pc: PairColl] RETURNS [ConstPairColl] ~ {IF pc.class.mutability#constant THEN RETURN pc.Copy.Freeze[] ELSE RETURN AsConst[pc]};
DefaultFreeze: PROC [pc: PairColl] RETURNS [const: ConstPairColl] ~ {IF pc.MutabilityOf#variable THEN Complain[pc, notVariable] ELSE Cant[pc]};
DefaultThaw: PROC [pc: PairColl] ~ {IF pc.MutabilityOf#variable THEN Complain[pc, notVariable] ELSE Cant[pc]};
DefaultCollectionOn:
PUBLIC
PROC [pc: PairColl, side: Side]
RETURNS [UWColl] ~ {
coc: CollectionOnColl ~ NEW [CollectionOnCollPrivate ← [pc, side]];
mut: Mutability ~
SELECT pc.MutabilityOf
FROM
variable, readonly => readonly,
constant => constant,
ENDCASE => ERROR;
RETURN Colls.CreateEnumerator[[EnumerateCollectionOn, pc.Spaces[][side], NIL, coc], pc.class.mayDuplicate OR NOT pc.class.functional[From[side]], none, mut].AsUW[];
};
CollectionOnColl: TYPE ~ REF CollectionOnCollPrivate;
CollectionOnCollPrivate: TYPE ~ RECORD [pc: PairColl, side: Side];
EnumerateCollectionOn:
PROC [
Consume:
PROC [val: Value], data:
REF
ANY ←
NIL] ~ {
coc: CollectionOnColl ~ NARROW[data];
Pass: PROC [pair: Pair] ~ {Consume[pair[coc.side]]};
coc.pc.Enumerate[Pass];
RETURN};
DefaultCurSetOn:
PUBLIC
PROC [pc: PairColl, side: Side]
RETURNS [ConstSet] ~ {
IF pc.MutabilityOf=constant THEN RETURN pc.CollectionOn[side].AsConst ELSE Cant[pc];
};
AddPair:
PUBLIC
PROC [pc: PairColl, pair: Pair, if: IfNewsPair ←
ALL[
ALL[
TRUE]], where: Where ← []]
RETURNS [news: NewsPair] ~ {
some: NewsSetPair ~ pc.AddColl[CreateSingleton[pair, pc.Spaces], if, where];
news ← ALL[different];
FOR dir: Direction
IN Direction
DO
IF pc.Functional[][dir]
THEN news[dir] ←
SELECT
TRUE
FROM
some[dir][new] => new,
some[dir][same] => same,
some[dir][different] => different,
ENDCASE => ERROR;
ENDLOOP;
RETURN};
AddNewPair:
PUBLIC
PROC [pc: PairColl, pair: Pair, where: Where ← []] ~ {
some: NewsSetPair ~ pc.AddColl[CreateSingleton[pair, pc.Spaces], addIfNew, where];
FOR dir: Direction
IN Direction
DO
IF pc.Functional[][dir] AND (some[dir][same] OR some[dir][different]) THEN ERROR;
ENDLOOP;
RETURN};
AddNewColl:
PUBLIC
PROC [pc, other: PairColl, where: Where ← []] ~ {
some: NewsSetPair ~ AddColl[pc, other, addIfNew, where];
FOR dir: Direction
IN Direction
DO
IF pc.Functional[][dir] AND (some[dir][same] OR some[dir][different]) THEN ERROR;
ENDLOOP;
RETURN};
DefaultAddColl: PUBLIC PROC [pc, other: PairColl, if: IfNewsPair, where: Where] RETURNS [some: NewsSetPair] ~ {IF pc.MutabilityOf#variable THEN Complain[pc, notVariable] ELSE Cant[pc]};
DefaultRemColl: PUBLIC PROC [pc, other: PairColl, style: RemoveStyle] RETURNS [hadSome, hadAll: BoolPair] ~ {IF pc.MutabilityOf#variable THEN Complain[pc, notVariable] ELSE Cant[pc]};
DefaultDeleteColl: PUBLIC PROC [pc: PairColl, coll: Collection, side: Side, style: RemoveStyle] RETURNS [hadSome, hadAll: BOOL] ~ {IF pc.MutabilityOf#variable THEN Complain[pc, notVariable] ELSE Cant[pc]};
DefaultSpaces: PUBLIC PROC [pc: PairColl] RETURNS [SpacePair] ~ {RETURN[[NIL, NIL]]};
DefaultOrderingOf:
PUBLIC
PROC [pc: PairColl]
RETURNS [Ordering] ~ {
IF pc.class.orderStyle#value THEN RETURN [unordered];
{spaces: SpacePair ~ pc.Spaces[];
IF spaces[left]=NIL OR spaces[right]=NIL OR spaces[left].Compare=CantCompare OR spaces[right].Compare=CantCompare THEN Cant[pc];
RETURN [[SpacesCompare, NEW [SpacePair ← spaces], both]];
}};
IsDefaultOrdering:
PUBLIC
PROC [o: Ordering]
RETURNS [
BOOL]
~ {RETURN [o.Compare=SpacesCompare]};
SpacesCompare:
PROC [data:
REF
ANY, elt1, elt2: Pair]
RETURNS [Basics.Comparison] ~ {
spaces: REF SpacePair ~ NARROW[data];
c: Basics.Comparison ← spaces[left].SpaceCompare[elt1[left], elt1[left]];
IF c=equal THEN c ← spaces[right].SpaceCompare[elt1[right], elt1[right]];
RETURN[c]};
ParallelScanHalfRestriction:
PUBLIC
PROC [a, b: PairColl, coll: Collection,
Test: ParallelTester, side: Side ← left, bkwd:
BOOL ←
FALSE]
RETURNS [pf: ParallelFind] ~
TRUSTED {
par: Parallel ~ NEW [ParallelPrivate ← [pc: [a, b] ]];
pa: PROCESS ~ FORK Par[par, a, coll, side, bkwd];
pb: PROCESS ~ FORK Par[par, b, coll, side, bkwd];
WaitForReq:
ENTRY
SAFE
PROC [par: Parallel]
RETURNS [continue:
BOOL] ~
TRUSTED {
ENABLE UNWIND => NULL;
DO
IF NOT par.ready[a] THEN {WAIT par.change; LOOP};
IF NOT par.ready[b] THEN {WAIT par.change; LOOP};
RETURN [par.pair[a].found OR par.pair[b].found];
ENDLOOP;
};
Satisfy:
ENTRY
SAFE
PROC [par: Parallel] ~
TRUSTED {
ENABLE UNWIND => NULL;
par.ready[a] ← par.ready[b] ← FALSE;
BROADCAST par.change;
RETURN};
pf ← [FALSE, noMaybePair, noMaybePair];
DO
IF NOT WaitForReq[par] THEN EXIT;
IF (par.pass ← Test[par.pair[a], par.pair[b]]) THEN pf ← [TRUE, par.pair[a], par.pair[b]];
Satisfy[par];
IF par.pass THEN EXIT;
ENDLOOP;
JOIN pa;
JOIN pb;
RETURN};
Which: TYPE ~ {a, b};
Parallel: TYPE ~ REF ParallelPrivate;
ParallelPrivate:
TYPE ~
MONITORED
RECORD [
pc: ARRAY Which OF PairColl,
ready: ARRAY Which OF BOOL ← ALL[FALSE],
pass: BOOL ← FALSE,
change: CONDITION ← [timeout: Process.SecondsToTicks[10]],
pair: ARRAY Which OF MaybePair ← ALL[[TRUE, noPair]]
];
Par:
PROC [par: Parallel, which: Which, coll: Collection, side: Side, bkwd:
BOOL] ~ {
Mediate:
PROC [pair: Pair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
WithLock:
ENTRY
PROC [par: Parallel] ~ {
ENABLE UNWIND => NULL;
par.pair[which].pair ← pair;
par.ready[which] ← TRUE;
BROADCAST par.change;
UNTIL NOT par.ready[which] DO WAIT par.change ENDLOOP;
pass ← par.pass;
RETURN};
WithLock[par];
RETURN};
Finish:
ENTRY
PROC [par: Parallel] ~ {
ENABLE UNWIND => NULL;
par.pair[which].found ← FALSE;
par.ready[which] ← TRUE;
BROADCAST par.change;
RETURN};
IF coll=passAll
THEN [] ← par.pc[which].Scan[Mediate, bkwd]
ELSE [] ← par.pc[which].ScanHalfRestriction[coll, Mediate, side, bkwd];
Finish[par];
RETURN};
refPairColls:
PUBLIC Space ~
NEW [SpacePrivate ← [
Equal: RefPairCollsEqual,
Hash: HashRefPairColl,
Compare: CompareRefPairColls,
other: List.PutAssoc[$Name, "ref PairColls", NIL]
]];
RefPairCollsEqual:
PROC [data:
REF
ANY, elt1, elt2: Value]
RETURNS [
BOOL] ~ {
pc1: REF PairColl ~ NARROW[elt1];
pc2: REF PairColl ~ NARROW[elt2];
RETURN [pc1^.Equal[pc2^]]};
HashRefPairColl:
PROC [data:
REF
ANY, elt: Value]
RETURNS [
CARDINAL] ~ {
pc: REF PairColl ~ NARROW[elt];
RETURN pc^.Hash[]};
CompareRefPairColls:
PROC [data:
REF
ANY, elt1, elt2: Value]
RETURNS [Basics.Comparison] ~ {
pc1: REF PairColl ~ NARROW[elt1];
pc2: REF PairColl ~ NARROW[elt2];
RETURN [pc1^.Compare[pc2^]]};
Equal:
PUBLIC
PROC [a, b: PairColl, bounds: CollPair ← [passAll, passAll]]
RETURNS [
BOOL] ~ {
minSide: Side ~ IF bounds[left]=passAll THEN right ELSE left;
maxSide: Side ~ OtherSide[minSide];
minColl: Collection ~ bounds[minSide];
maxColl: Collection ~ bounds[maxSide];
mayDup: BOOL ~ a.MayDuplicate[];
spaces: SpacePair ~ a.Spaces[];
ByBound:
PROC [side: Side]
RETURNS [
BOOL] ~ {
otherSide: Side ~ OtherSide[side];
otherBound: Collection ~ bounds[otherSide];
applDir: Direction ~ From[side];
Test:
PROC [val: Value]
RETURNS [pass:
BOOL] ~ {
pass ← NOT a.Mapping[val, applDir].Intersection[otherBound].Equal[b.Mapping[val, applDir].Intersection[otherBound]];
RETURN};
RETURN [NOT bounds[side].Scan[Test].found];
};
IF mayDup # b.MayDuplicate THEN ERROR Cant[a];
IF spaces # b.Spaces[] THEN ERROR Cant[a];
IF spaces[left]=NIL OR spaces[right]=NIL THEN ERROR Cant[a];
IF mayDup
THEN {
Test:
PROC [a, b: MaybePair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
IF a.found#b.found THEN RETURN [TRUE];
IF NOT a.found THEN ERROR;
pass ← NOT (spaces[left].SpaceEqual[a.pair[left], b.pair[left]] AND spaces[right].SpaceEqual[a.pair[right], b.pair[right]]);
RETURN};
IF maxColl # passAll THEN ERROR;
RETURN [NOT ParallelScanHalfRestriction[a, b, minColl, Test, minSide].found];
}
ELSE
IF a.Can[$Enumerate]
AND b.Can[$Enumerate]
THEN {
Try:
PROC [a, b: PairColl]
RETURNS [
BOOL] ~ {
Test:
PROC [pair: Pair]
RETURNS [pass:
BOOL] ~ {
pass ← maxColl.HasMember[pair[maxSide]] AND NOT b.HasPair[pair];
RETURN};
RETURN [NOT a.ScanHalfRestriction[minColl, Test, minSide].found];
};
RETURN [Try[a, b] AND Try[b, a]];
}
ELSE IF bounds[left].Can[$Enumerate] AND a.Can[$Image, LIST[$leftToRight]] AND b.Can[$Image, LIST[$leftToRight]] THEN RETURN ByBound[left]
ELSE IF bounds[right].Can[$Enumerate] AND a.Can[$Image, LIST[$rightToLeft]] AND b.Can[$Image, LIST[$rightToLeft]] THEN RETURN ByBound[right]
ELSE
IF bounds[left].Can[$Enumerate]
AND bounds[right].Can[$Enumerate]
THEN {
Mid:
PROC [left: Value]
RETURNS [pass:
BOOL] ~ {
Inner:
PROC [right: Value]
RETURNS [pass:
BOOL] ~ {
pass ← a.HasPair[[left, right]] # b.HasPair[[left, right]];
RETURN};
pass ← bounds[right].Scan[Inner].found;
RETURN};
RETURN [NOT bounds[left].Scan[Mid].found];
}
ELSE ERROR Cant[a];
};
Hash:
PUBLIC
PROC [pc: PairColl, bounds: CollPair ← [passAll, passAll]]
RETURNS [hash:
CARDINAL] ~ {
minSide: Side ~ IF bounds[left]=passAll THEN right ELSE left;
maxSide: Side ~ OtherSide[minSide];
minColl: Collection ~ bounds[minSide];
maxColl: Collection ~ bounds[maxSide];
spaces: SpacePair ~ pc.Spaces[];
PerPair:
PROC [pair: Pair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
IF NOT maxColl.HasMember[pair[maxSide]] THEN RETURN;
hash ← hash + spaces[left].SpaceHash[pair[left]] + spaces[right].SpaceHash[pair[right]];
RETURN};
hash ← 0;
IF spaces[left]=NIL OR spaces[right]=NIL OR spaces[left].Hash=CantHash OR spaces[right].Hash=CantHash THEN Cant[pc];
[] ← pc.ScanHalfRestriction[minColl, PerPair, minSide];
RETURN};
Compare:
PUBLIC
PROC [a, b: PairColl, bounds: CollPair ← [passAll, passAll]]
RETURNS [c: Basics.Comparison] ~ {
minSide: Side ~ IF bounds[left]=passAll THEN right ELSE left;
maxSide: Side ~ OtherSide[minSide];
minColl: Collection ~ bounds[minSide];
maxColl: Collection ~ bounds[maxSide];
mayDup: BOOL ~ a.MayDuplicate[];
spaces: SpacePair ~ a.Spaces[];
orderStyle: OrderStyle ~ a.OrderStyleOf;
IF mayDup # b.MayDuplicate THEN ERROR Cant[a];
IF spaces # b.Spaces[] THEN ERROR Cant[a];
IF spaces[left]=NIL OR spaces[right]=NIL OR spaces[left].Compare=CantCompare OR spaces[right].Compare=CantCompare THEN ERROR Cant[a];
IF orderStyle # b.OrderStyleOf[] THEN ERROR Cant[a];
IF mayDup
OR orderStyle#none
THEN {
Test:
PROC [a, b: MaybePair]
RETURNS [pass:
BOOL ←
FALSE] ~ {
IF a.found#b.found
THEN {
c ← IF a.found THEN greater ELSE less;
RETURN [TRUE]};
IF NOT a.found THEN ERROR;
c ← spaces[left].SpaceCompare[a.pair[left], b.pair[left]];
IF c=equal THEN c ← spaces[right].SpaceCompare[a.pair[right], b.pair[right]];
pass ← c#equal;
RETURN};
IF maxColl#passAll THEN ERROR;
c ← equal;
[] ← ParallelScanHalfRestriction[a, b, minColl, Test, minSide];
RETURN};
ERROR Cant[a];
};
OrderBySide:
PUBLIC
PROC [side: Side, o: Colls.Ordering]
RETURNS [Ordering] ~ {
RETURN OrderByBoth[side, o, Colls.unordered]};
OrderByBoth:
PUBLIC
PROC [highSide: Side, high, low: Colls.Ordering]
RETURNS [Ordering] ~ {
po: PairedOrdering ~ NEW [PairedOrderingPrivate ← [highSide, high, low]];
care:
CARDINAL ~
(IF high#Colls.unordered THEN highSide.ORD+1 ELSE 0) +
(IF low#Colls.unordered THEN OtherSide[highSide].ORD+1 ELSE 0);
RETURN [[PairedCompare, po, VAL[care]]];
};
PairedOrdering: TYPE ~ REF PairedOrderingPrivate;
PairedOrderingPrivate: TYPE ~ RECORD [highSide: Side, high, low: Colls.Ordering];
PairedCompare:
PROC [data:
REF
ANY, elt1, elt2: Pair]
RETURNS [c: Basics.Comparison ← equal]
--PairCompareProc-- ~ {
po: PairedOrdering ~ NARROW[data];
lowSide: Side ~ OtherSide[po.highSide];
IF po.high#Colls.unordered THEN c ← po.high.Compare[po.high.data, elt1[po.highSide], elt2[po.highSide]];
IF c=equal AND po.low#Colls.unordered THEN c ← po.low.Compare[po.low.data, elt1[lowSide], elt2[lowSide]];
RETURN};
FnFromProc:
PUBLIC
PROC [
Apply:
PROC [data:
REF
ANY, v: Value]
RETURNS [mv: MaybeValue], spaces: SpacePair ← [refs, refs], data:
REF
ANY ←
NIL, constant, oneToOne:
BOOL ←
FALSE,
ScanInverse:
PROC [data:
REF
ANY, v: Value,
Test: Tester]
RETURNS [MaybePair] ←
NIL]
RETURNS [Function] ~ {
pf: ProcFn ~ NEW [ProcFnPrivate ← [spaces, Apply, ScanInverse, data]];
RETURN [[procClass[constant][oneToOne], pf]];
};
procClass:
ARRAY
--constant--
BOOL
OF
ARRAY
--oneToOne--
BOOL
OF PairCollClass ~ [
FALSE: [
FALSE: CreateClass[[
Primitive: ProcPrimitive,
Apply: ProcApply,
ScanHalfRestriction: ProcScanHalfRestriction,
Spaces: ProcSpaces,
functional: [TRUE, FALSE],
mayDuplicate: FALSE,
mutability: readonly]],
TRUE: CreateClass[[
Primitive: ProcPrimitive,
Apply: ProcApply,
ScanHalfRestriction: ProcScanHalfRestriction,
Spaces: ProcSpaces,
functional: [TRUE, TRUE],
mayDuplicate: FALSE,
mutability: readonly]]],
TRUE: [
FALSE: CreateClass[[
Primitive: ProcPrimitive,
Apply: ProcApply,
ScanHalfRestriction: ProcScanHalfRestriction,
Spaces: ProcSpaces,
functional: [TRUE, FALSE],
mayDuplicate: FALSE,
mutability: constant]],
TRUE: CreateClass[[
Primitive: ProcPrimitive,
Apply: ProcApply,
ScanHalfRestriction: ProcScanHalfRestriction,
Spaces: ProcSpaces,
functional: [TRUE, TRUE],
mayDuplicate: FALSE,
mutability: constant]]]
];
ProcFn: TYPE ~ REF ProcFnPrivate;
ProcFnPrivate:
TYPE ~
RECORD [
spaces: SpacePair,
Apply: PROC [data: REF ANY, v: Value] RETURNS [mv: MaybeValue],
ScanInverse: PROC [data: REF ANY, v: Value, Test: Tester] RETURNS [MaybePair],
data: REF ANY
];
ProcPrimitive:
PROC [pc: PairColl, op:
ATOM, args: ArgList ←
NIL]
RETURNS [PrimitiveAnswer] ~ {
pf: ProcFn ~ NARROW[pc.data];
SELECT op
FROM
$Apply => RETURN [IF GetDir[args, 1]=leftToRight THEN yes ELSE no];
$ScanHalfRestriction => RETURN [IF GetSide[args, 1]=right AND pf.ScanInverse#NIL AND NOT GetBool[args, 2] THEN yes ELSE no];
ENDCASE => RETURN [pass];
};
ProcApply:
PROC [pc: PairColl, v: Value, dir: Direction]
RETURNS [MaybeValue] ~ {
pf: ProcFn ~ NARROW[pc.data];
SELECT dir
FROM
leftToRight => RETURN pf.Apply[pf.data, v];
rightToLeft => RETURN DefaultApply[pc, v, dir];
ENDCASE => ERROR;
};
ProcScanHalfRestriction:
PROC [pc: PairColl, side: Side, coll: Collection,
Test: Tester, bkwd:
BOOL]
RETURNS [mp: MaybePair] ~ {
pf: ProcFn ~ NARROW[pc.data];
IF side=right
AND pf.ScanInverse#
NIL
AND
NOT bkwd
THEN {
PerRight:
PROC [val: Value]
RETURNS [pass:
BOOL] ~ {
pass ← (mp ← pf.ScanInverse[pf.data, val, Test]).found;
RETURN};
[] ← coll.Scan[PerRight];
RETURN};
RETURN DefaultScanHalfRestriction[pc, side, coll, Test, bkwd];
};
ProcSpaces:
PROC [pc: PairColl]
RETURNS [SpacePair] ~ {
pf: ProcFn ~ NARROW[pc.data];
RETURN [pf.spaces];
};
GetSide:
PUBLIC
PROC [args: ArgList, i:
NAT, default: Side ← left]
RETURNS [Side] ~ {
IF i<1 THEN ERROR;
WHILE i>1 AND args#NIL DO args ← args.rest; i ← i - 1 ENDLOOP;
RETURN [
IF args=
NIL
THEN default
ELSE
SELECT args.first
FROM
$left => left,
$right => right,
ENDCASE => ERROR]};
FromSide:
PUBLIC
PROC [x: Side]
RETURNS [
ATOM]
~ {RETURN [IF x=left THEN $left ELSE $right]};
ReverseOrdering:
PUBLIC
PROC [o: Ordering]
RETURNS [ro: Ordering] ~ {
RETURN [[CompareReversal, NEW [Ordering ← o], o.sideCare]];
};
CompareReversal:
PROC [data:
REF
ANY, elt1, elt2: Pair]
RETURNS [Basics.Comparison] ~ {
o: REF Ordering ~ NARROW[data];
RETURN o.Compare[o.data, elt2, elt1]};
BeRope: PROC [r: ROPE] RETURNS [ROPE] ~ INLINE {RETURN[r]};
Start:
PROC ~ {
Atom.PutProp[prop: kindKey, val: $composite, atom: $Mapping];
Atom.PutProp[prop: kindKey, val: $composite, atom: $Enumerate];
Atom.PutProp[prop: kindKey, val: $composite, atom: $EnumerateImage];
Atom.PutProp[prop: kindKey, val: $composite, atom: $EnumerateMapping];
Atom.PutProp[prop: kindKey, val: $composite, atom: $EnumerateHalfRestriction];
Atom.PutProp[prop: kindKey, val: $composite, atom: $ScanImage];
Atom.PutProp[prop: kindKey, val: $composite, atom: $ScanMapping];
Atom.PutProp[prop: kindKey, val: $composite, atom: $First];
Atom.PutProp[prop: kindKey, val: $composite, atom: $Last];
Atom.PutProp[prop: kindKey, val: $composite, atom: $Pop];
Atom.PutProp[prop: kindKey, val: $composite, atom: $Next];
Atom.PutProp[prop: kindKey, val: $composite, atom: $Prev];
Atom.PutProp[prop: kindKey, val: $composite, atom: $Empty];
Atom.PutProp[prop: kindKey, val: $composite, atom: $MappingSize];
Atom.PutProp[prop: kindKey, val: $composite, atom: $AddPair];
Atom.PutProp[prop: kindKey, val: $composite, atom: $Store];
Atom.PutProp[prop: kindKey, val: $composite, atom: $Replace];
Atom.PutProp[prop: kindKey, val: $composite, atom: $Insert];
Atom.PutProp[prop: kindKey, val: $composite, atom: $Inserted];
Atom.PutProp[prop: kindKey, val: $composite, atom: $RemPair];
Atom.PutProp[prop: kindKey, val: $composite, atom: $Delete];
Atom.PutProp[prop: kindKey, val: $composite, atom: $IsIntFn];
Atom.PutProp[prop: kindKey, val: $composite, atom: $AsIntFn];
Atom.PutProp[prop: kindKey, val: $class , atom: $Widen];
Atom.PutProp[prop: kindKey, val: $class , atom: $HasPair];
Atom.PutProp[prop: kindKey, val: $classD , atom: $Image];
Atom.PutProp[prop: kindKey, val: $classD , atom: $Apply];
Atom.PutProp[prop: kindKey, val: $classB , atom: $Scan];
Atom.PutProp[prop: kindKey, val: $classSB, atom: $ScanHalfRestriction];
Atom.PutProp[prop: kindKey, val: $classBR, atom: $Extremum];
Atom.PutProp[prop: kindKey, val: $class , atom: $Get3];
Atom.PutProp[prop: kindKey, val: $class , atom: $Size];
Atom.PutProp[prop: kindKey, val: $classD , atom: $ImageSize];
Atom.PutProp[prop: kindKey, val: $class , atom: $Copy];
Atom.PutProp[prop: kindKey, val: $class , atom: $Insulate];
Atom.PutProp[prop: kindKey, val: $class , atom: $ValueOf];
Atom.PutProp[prop: kindKey, val: $class , atom: $Freeze];
Atom.PutProp[prop: kindKey, val: $class , atom: $Thaw];
Atom.PutProp[prop: kindKey, val: $classS , atom: $CollectionOn];
Atom.PutProp[prop: kindKey, val: $classS , atom: $CurSetOn];
Atom.PutProp[prop: kindKey, val: $class , atom: $AddColl];
Atom.PutProp[prop: kindKey, val: $class , atom: $RemColl];
Atom.PutProp[prop: kindKey, val: $classS , atom: $DeleteColl];
Atom.PutProp[prop: kindKey, val: $class , atom: $QuaIntFn];
Atom.PutProp[prop: kindKey, val: $class , atom: $Spaces];
Atom.PutProp[prop: kindKey, val: $class , atom: $OrderingOf];
};
Start[];
END.