BiRelsImpl.Mesa
Last tweaked by Mike Spreitzer on December 21, 1987 3:58:03 pm PST
DIRECTORY AbSets, Atom, BiRelBasics, BiRels, BiRelsPrivate, IntStuff, List, Process, Rope, SetBasics, SharedErrors;
BiRelsImpl: CEDAR MONITOR
LOCKS lp USING lp: LockPtr
IMPORTS AbSets, Atom, BiRelBasics, BiRels, BiRelsPrivate, IntStuff, List, Process, SetBasics, SharedErrors
EXPORTS BiRels
=
BEGIN OPEN IntStuff, SetBasics, Sets:AbSets, Sets, BiRelBasics, BiRels, BiRelsPrivate;
LockPtr: TYPE ~ LONG POINTER TO MONITORLOCK;
Cant: PUBLIC ERROR [br: BiRel] ~ CODE;
mappingNotSingleton: PUBLIC ROPE ~ R["mapping of %g isn't a singleton"];
fixedSide: PUBLIC ROPE ~ R["%g's %g side can't be varied"];
denseSide: PUBLIC ROPE ~ R["%g's %g side must remain dense"];
badBiRel: PUBLIC BiRel ~ [NIL, R["bad BiRel"]];
provisionKey: ATOM ~ $BiRelsImplProvision;
dirableKey: ATOM ~ $BiRelsImplDirable;
kindKey: ATOM ~ $BiRelsImplKind;
Proc: TYPE ~ PROC ANY RETURNS ANY;
CreateClass: PUBLIC PROC [cp: BiRelClassPrivate, dirable: BoolPair ← [TRUE, FALSE]] RETURNS [class: BiRelClass] ~ {
provs: Atom.PropList ← NARROW[List.Assoc[key: provisionKey, aList: cp.other]];
Sp: PROC [op: ATOM, proc: Proc] RETURNS [def: BOOL] ~ {
provs ← List.PutAssoc[op, IF (def ← proc=NIL) THEN $Default ELSE $Primitive, provs];
RETURN};
{OPEN cp;
IF Sp[$AsSet, AsSet] THEN AsSet ← DefaultAsSet;
IF Sp[$HasPair, HasPair] THEN HasPair ← DefaultHasPair;
IF Sp[$Image, Image] THEN Image ← DefaultImage;
IF Sp[$Apply, Apply] THEN Apply ← DefaultApply;
IF Sp[$ScanRestriction, ScanRestriction] THEN ScanRestriction ← DefaultScanRestriction;
IF Sp[$GetOne, GetOne] THEN GetOne ← DefaultGetOne;
IF Sp[$Get3, Get3] THEN Get3 ← DefaultGet3;
IF Sp[$Index, Index] THEN Index ← DefaultIndex;
IF Sp[$RestrictionSize, RestrictionSize] THEN RestrictionSize ← DefaultRestrictionSize;
IF Sp[$GetBounds, GetBounds] THEN GetBounds ← DefaultGetBounds;
IF Sp[$Copy, Copy] THEN Copy ← DefaultCopy;
IF Sp[$Insulate, Insulate] THEN Insulate ← DefaultInsulate;
IF Sp[$ValueOf, ValueOf] THEN ValueOf ← DefaultValueOf;
IF Sp[$Freeze, Freeze] THEN Freeze ← DefaultFreeze;
IF Sp[$Thaw, Thaw] THEN Thaw ← DefaultThaw;
IF Sp[$SetOn, SetOn] THEN SetOn ← DefaultSetOn;
IF Sp[$CurSetOn, CurSetOn] THEN CurSetOn ← DefaultCurSetOn;
IF Sp[$AddPair, AddPair] THEN AddPair ← DefaultAddPair;
IF Sp[$AddSet, AddSet] THEN AddSet ← DefaultAddSet;
IF Sp[$Swap, Swap] THEN Swap ← DefaultSwap;
IF Sp[$RemPair, RemPair] THEN RemPair ← DefaultRemPair;
IF Sp[$RemSet, RemSet] THEN RemSet ← DefaultRemSet;
IF Sp[$Delete, Delete] THEN Delete ← DefaultDelete;
IF Sp[$DeleteSet, DeleteSet] THEN DeleteSet ← DefaultDeleteSet;
IF Sp[$ReplaceMe, ReplaceMe] THEN ReplaceMe ← DefaultReplaceMe;
IF Sp[$ShiftAndClipMe, ShiftAndClipMe] THEN ShiftAndClipMe ← DefaultShiftAndClipMe;
IF Sp[$IsDense, IsDense] THEN IsDense ← DefaultIsDense;
IF Sp[$SideFixed, SideFixed] THEN SideFixed ← DefaultSideFixed;
};
cp.other ← List.PutAssoc[provisionKey, provs, cp.other];
cp.other ← List.PutAssoc[dirableKey, NEW [BoolPair ← dirable], cp.other];
class ← NEW [BiRelClassPrivate ← cp];
RETURN};
Primitive: PUBLIC PROC [br: BiRel, op: ATOM, arg1, arg2: REF ANYNIL] RETURNS [BOOL] ~ {
kind: REF ANY ~ Atom.GetProp[op, kindKey];
IF arg1#NIL AND ISTYPE[arg1, LORA] THEN ERROR--somebody called with one LIST of args rather than separate args--;
WITH kind SELECT FROM
a: ATOM => SELECT a FROM
$always => RETURN [TRUE];
$argless => NULL;
$composite => ERROR;
ENDCASE => ERROR;
a: REF ArgTyping => NULL;
ENDCASE => ERROR;
IF br.class.Primitive#NIL THEN SELECT br.class.Primitive[br, op, arg1, arg2] FROM
yes => RETURN [TRUE];
no => RETURN [FALSE];
pass => NULL;
ENDCASE => ERROR;
{provs: Atom.PropList ~ NARROW[List.Assoc[provisionKey, br.class.other]];
prov: REF ANY ~ List.Assoc[op, provs];
SELECT prov FROM
$Default => RETURN [FALSE];
$Primitive => WITH kind SELECT FROM
a: ATOM => SELECT a FROM
$argless => RETURN [TRUE];
$always, $composite => ERROR;
ENDCASE => ERROR;
types: REF ArgTyping => {
args: ARRAY [1 .. 2] OF REF ANY ~ [arg1, arg2];
FOR i: NATURAL IN [1 .. 2] DO
type: ArgType ~ types[i];
SELECT type FROM
$None, $Set, $SetPair, $RelOrder, $RelOrderFN, $Want3, $limit, $When, $Side, $EndBools, $BiRel => NULL;
$Dir => {dir: Direction ~ ToDir[args[i]];
dirable: REF BoolPair ~ NARROW[List.Assoc[dirableKey, br.class.other]];
IF NOT dirable[dir] THEN RETURN [FALSE]};
$remove => IF br.MutabilityOf[]#variable AND ToBool[args[i]] THEN RETURN [TRUE];
ENDCASE => ERROR;
ENDLOOP;
RETURN [TRUE]};
ENDCASE => ERROR;
ENDCASE => ERROR;
}};
refOne: RefEINT ~ FromEI[one];
refSetAllInts: RefSet ~ Sets.IIAsSet[[]].Refify;
QualityOf: PUBLIC PROC [br: BiRel, op: ATOM, arg1, arg2, arg3, arg4: REF ANYNIL] RETURNS [ImplQuality] ~ {
IF arg1#NIL AND ISTYPE[arg1, LORA] THEN ERROR--somebody called with one LIST of args rather than separate args--;
WITH Atom.GetProp[op, kindKey] SELECT FROM
a: ATOM => SELECT a FROM
$always => RETURN [primitive];
$argless => NULL;
$composite => SELECT op FROM
$Mapping => {dir: Direction ~ ToDir[arg1];
RETURN br.QualityOf[$Image, Sets.FakeRefSingleton[br.Spaces[][Source[dir]]], FromDir[dir]]};
$Enumerate => RETURN br.QualityOf[$Scan, arg1, arg2, arg3, arg4];
$Scan => RETURN br.QualityOf[$ScanRestriction, refNilSets, arg1];
$EnumerateImage => RETURN br.QualityOf[$ScanImage, arg1, arg2, arg3, arg4];
$ScanImage => {
set: RefSet ~ ToSet[arg1];
dir: Direction ~ ToDir[arg2];
ro: Sets.RelOrder ~ Sets.ToRO[arg3];
RETURN br.QualityOf[$ScanHalfRestriction, set, FromSide[Source[dir]], FromRO[ConsRelOrder[Dest[dir], ro]]]};
$EnumerateMapping => {
dir: Direction ~ ToDir[arg1];
RETURN br.QualityOf[$EnumerateImage, Sets.FakeRefSingleton[br.Spaces[][Source[dir]]], FromDir[dir], arg2]};
$ScanMapping => {
dir: Direction ~ ToDir[arg1];
RETURN br.QualityOf[$ScanImage, Sets.FakeRefSingleton[br.Spaces[][Source[dir]]], FromDir[dir], arg2]};
$EnumerateHalfRestriction => RETURN br.QualityOf[$ScanHalfRestriction, arg1, arg2, arg3, arg4];
$ScanHalfRestriction => RETURN br.QualityOf[$ScanRestriction, FromSets[ConsSets[ToSide[arg2], ToSet[arg1]^]], arg3];
$APair => RETURN QMin[br.QualityOf[$GetOne, $FALSE, arg1, arg2], goodDefault];
$Pop => RETURN QMin[br.QualityOf[$GetOne, $TRUE, arg1, arg2], goodDefault];
$Next => RETURN br.QualityOf[$Get3, FromRO[ToRO[arg1, [[fwd, no]]]], $FFT];
$Prev => RETURN br.QualityOf[$Get3, FromRO[ToRO[arg1, [[fwd, no]]]], $TFF];
$SkipTo => {
goal: RefSet ~ ToSet[arg1];
bounds: Interval ~ ToInterval[arg2]^;
side: Side ~ ToSide[arg3];
bwd: BOOL ~ ToBool[arg4];
RETURN br.QualityOf[$ScanRestriction, FromSets[ConsSets[side, IntervalAsSet[br.Spaces[][side], bounds], goal^]], FromRO[ConsRelOrder[side, IF bwd THEN bwd ELSE fwd]]]};
$Lookup => {
bounds: RefInterval ~ ToInterval[arg1];
side: Side ~ ToSide[arg2];
RETURN br.QualityOf[$SkipTo, Sets.FakeRefSingleton[br.Spaces[][side]], arg1, arg2, arg3]};
$Size => RETURN br.QualityOf[$RestrictionSize, refNilSets, arg1];
$Empty => RETURN br.QualityOf[$Size, refOne];
$ImageSize => {set: Set ~ ToSet[arg1]^;
limit: RefEINT ~ ToEI[arg3];
easy: BOOL ~ set.GoodImpl[$Size] AND set.Size[two].Compare[two]<equal;
IF easy THEN RETURN br.QualityOf[$RestrictionSize, FromSets[ConsSets[Source[ToDir[arg2]], set]], limit];
IF NOT br.Can[$Scan] THEN RETURN [cant];
RETURN [IF limit^.Compare[two]<=equal THEN goodDefault ELSE poorDefault]};
$MappingSize => {
dir: Direction ~ ToDir[arg1];
RETURN br.QualityOf[$ImageSize, Sets.FakeRefSingleton[br.Spaces[][Source[dir]]], FromDir[dir], arg2]};
$AddNewPair => RETURN br.QualityOf[$AddPair];
$AddNewSet => RETURN br.QualityOf[$AddSet, arg1];
$Erase => RETURN br.QualityOf[$RemSet, br.Refify];
$GetIntDom => RETURN br.QualityOf[$GetBounds, arg1, arg2, arg3, arg4];
ENDCASE => ERROR;
ENDCASE => ERROR;
a: REF ArgTyping => NULL;
ENDCASE => ERROR;
IF Primitive[br, op, arg1, arg2] THEN RETURN [primitive];
SELECT op FROM
$AsSet => RETURN [goodDefault];
$HasPair => {spaces: SpacePair ~ br.Spaces[];
RETURN br.QualityOf[$ScanRestriction, FromSets[[Sets.FakeSingleton[spaces[left]], Sets.FakeSingleton[spaces[right]]]]].QMin[goodDefault]};
$Image => {set: RefSet ~ ToSet[arg1];
dir: Direction ~ ToDir[arg2];
RETURN [IF br.GoodImpl[$ScanRestriction, FromSets[ConsSets[Source[dir], set^]]] THEN goodDefault ELSE poorDefault]};
$Apply => {src: Side ~ Source[ToDir[arg1]];
RETURN br.QualityOf[$ScanRestriction, FromSets[ConsSets[src, Sets.CreateSingleton[noValue, br.Spaces[][src]]]]].QMin[goodDefault]};
$ScanRestriction => {
sets: RefSetPair ~ ToSets[arg1];
ro: RelOrder ~ ToRO[arg2].CanonizeRelOrder[br.Functional[]];
plan: BiRelsPrivate.Analysis;
can: BOOL;
[can, plan] ← BiRelsPrivate.PlanDefaultScanRestriction[br, sets^, ro];
IF NOT can THEN RETURN [cant];
RETURN [IF plan.cost.sort = ALL[asIs] THEN goodDefault ELSE poorDefault]};
$GetOne => {remove: BOOL ~ ToBool[arg1];
ro: RelOrder ~ ToRO[arg2];
IF remove AND br.MutabilityOf[]#variable THEN RETURN [goodDefault];
IF Primitive[br, $ScanRestriction, refNilSets, arg2] THEN RETURN [goodDefault];
RETURN br.QualityOf[$Scan].QMin[
IF remove THEN br.QualityOf[$RemPair].QMin[poorDefault] ELSE poorDefault]};
$Get3 => {
ro: RelOrder ~ ToRO[arg1, [[fwd, no]]].CanonizeRelOrder[br.Functional];
fq, bq, nq: ImplQuality ← br.QualityOf[$Scan, FromRO[ro]];
rro: RelOrder;
IF ro.sub # ALL[no] THEN {
rro ← ro.ReverseRO[];
bq ← br.QualityOf[$Scan, FromRO[rro]];
nq ← br.QualityOf[$Scan]};
{max: ImplQuality ~ QMax[nq, QMax[fq, bq]];
uro: RelOrder ~ IF bq=max AND fq<max THEN rro ELSE IF fq=max THEN ro ELSE [];
RETURN br.QualityOf[$Scan, FromRO[uro]].QMin[goodDefault]}};
$Index => {goal: IntRel ~ ToBiRel[arg1]^;
RETURN QMin[QMin[poorDefault, goal.QualityOf[$GetIntDom]],
QMin[br.QualityOf[$Mapping], goal.QualityOf[$Mapping]]]};
$RestrictionSize => {
sets: RefSetPair ~ ToSets[arg1];
limit: EINT ~ ToEI[arg2]^;
RETURN br.QualityOf[$ScanRestriction, sets].QMin[IF limit.Compare[two]<=equal THEN goodDefault ELSE poorDefault]};
$GetBounds => {
want: EndBools ~ ToEB[arg1];
ro: RelOrder ~ ToRO[arg2, [[fwd, no]]].CanonizeRelOrder[br.Functional];
rro: RelOrder ~ ro.ReverseRO[];
IF
((NOT want[min]) OR Primitive[br, $ScanRestriction, refNilSets, FromRO[ro]]) AND
((NOT want[max]) OR Primitive[br, $ScanRestriction, refNilSets, FromRO[rro]])
THEN {q: ImplQuality ← goodDefault;
FOR e: End IN End DO
IF want[e] THEN {
uro: RelOrder ~ IF e=min THEN ro ELSE rro;
q ← q.QMin[br.QualityOf[$APair, FromRO[uro]]]};
ENDLOOP;
RETURN [q]}
ELSE RETURN br.QualityOf[$Scan].QMin[poorDefault]};
$Copy => RETURN [cant];
$Insulate => RETURN [goodDefault];
$ValueOf => RETURN [IF br.MutabilityOf#constant THEN QMin[br.QualityOf[$Copy], br.QualityOf[$Freeze]].QMin[goodDefault] ELSE goodDefault];
$Freeze, $Thaw => RETURN [IF br.MutabilityOf#variable THEN goodDefault ELSE cant];
$SetOn => RETURN [poorDefault];
$CurSetOn => RETURN [IF br.MutabilityOf=constant THEN poorDefault ELSE cant];
$AddPair => RETURN [IF Primitive[br, $AddSet, FakeRefSingleton[br.Spaces[]]] THEN goodDefault ELSE cant];
$AddSet => RETURN [IF Primitive[br, $AddPair] THEN goodDefault ELSE cant];
$Swap => {side: Side ~ ToSide[arg1]; dir: Direction ~ From[side];
RETURN QMin[QMin[
br.QualityOf[$Mapping, FromDir[dir]],
br.QualityOf[$Delete, FromSide[side]]], QMin[
br.QualityOf[$ScanMapping, FromDir[dir]],
br.QualityOf[$AddPair]]].QMin[
goodDefault]};
$RemPair => RETURN [IF Primitive[br, $RemSet, FakeRefSingleton[br.Spaces[]]] THEN goodDefault ELSE cant];
$RemSet => RETURN [IF Primitive[br, $RemPair] THEN goodDefault ELSE cant];
$Delete => {side: Side ~ ToSide[arg1];
RETURN br.QualityOf[$DeleteSet, Sets.FakeRefSingleton[br.Spaces[][side]], FromSide[side]].QMin[goodDefault]};
$DeleteSet => {set: RefSet ~ ToSet[arg1];
side: Side ~ ToSide[arg2];
IF Primitive[br, $Delete, FromSide[side]] THEN RETURN [goodDefault];
RETURN QMin[QMin[
set^.QualityOf[$Scan],
br.QualityOf[$RemPair]], QMin[
br.QualityOf[$ScanMapping, FromDir[From[side]]],
poorDefault]]};
$ReplaceMe => {with: IntRel ~ ToBiRel[arg1]^;
RETURN QMin[QMin[
with.QualityOf[$GetIntDom],
br.QualityOf[$DeleteSet, refSetAllInts]], QMin[
SubShiftQuality[br],
br.QualityOf[$AddSet, with.Refify]]].QMin[
poorDefault]};
$ShiftAndClipMe => RETURN QMin[QMin[poorDefault,
br.QualityOf[$DeleteSet, refSetAllInts]],
SubShiftQuality[br]];
$IsDense => RETURN [poorDefault];
$SideFixed => RETURN [IF br.MutabilityOf[]=constant THEN goodDefault ELSE poorDefault];
ENDCASE => ERROR;
};
SubShiftQuality: PROC [br: BiRel] RETURNS [ImplQuality] ~ {
RETURN QMin[QMin[
br.QualityOf[$GetIntDom],
br.QualityOf[$ScanMapping]], QMin[
br.QualityOf[$AddPair],
br.QualityOf[$RemPair]]]};
Enumerate: PUBLIC PROC [br: BiRel, Consume: PROC [Pair], ro: RelOrder ← []] ~ {
Pass: PROC [pair: Pair] RETURNS [BOOL] ~ {Consume[pair]; RETURN [FALSE]};
IF br.Scan[Pass, ro].found THEN ERROR};
EnumAA: PUBLIC PROC [br: BiRel, Consume: PROC [REF ANY, REF ANY], ro: RelOrder ← []] ~ {
Pass: PROC [pair: Pair] RETURNS [BOOL] ~ {Consume[pair[left].VA, pair[right].VA]; RETURN [FALSE]};
IF br.Scan[Pass, ro].found THEN ERROR};
EnumIA: PUBLIC PROC [br: BiRel, Consume: PROC [INT, REF ANY], ro: RelOrder ← []] ~ {
Pass: PROC [pair: Pair] RETURNS [BOOL] ~ {Consume[pair[left].VI, pair[right].VA]; RETURN [FALSE]};
IF br.Scan[Pass, ro].found THEN ERROR};
EnumII: PUBLIC PROC [br: BiRel, Consume: PROC [INT, INT], ro: RelOrder ← []] ~ {
Pass: PROC [pair: Pair] RETURNS [BOOL] ~ {Consume[pair[left].VI, pair[right].VI]; RETURN [FALSE]};
IF br.Scan[Pass, ro].found THEN ERROR};
EnumerateImage: PUBLIC PROC [br: BiRel, set: Set, Consume: PROC [Value], dir: Direction ← leftToRight, ro: Sets.RelOrder ← no] ~ {
dest: Side ~ Dest[dir];
Pass: PROC [pair: Pair] RETURNS [BOOL] ~ {Consume[pair[dest]]; RETURN [FALSE]};
IF br.ScanHalfRestriction[set, Pass, Source[dir], ConsRelOrder[dest, ro]].found THEN ERROR;
RETURN};
Forked: TYPE ~ REF ForkedPrivate;
ForkedPrivate: TYPE ~ RECORD [
set: ARRAY Which OF BiRel,
ready: ARRAY Which OF BOOLALL[FALSE],
done: BOOLFALSE,
change: CONDITION ← [timeout: Process.SecondsToTicks[10]],
val: ARRAY Which OF MaybePair ← ALL[[TRUE, noPair]],
lock: MONITORLOCK ← []
];
InterleavedProduceRestriction: PUBLIC PROC [a, b: BiRel, Consume: InterleavedConsumer, setsA, setsB: SetPair ← [], roA, roB: RelOrder ← []] RETURNS [ans: MaybePair ← noMaybePair] ~ {
fkd: Forked ~ NEW [ForkedPrivate ← [set: [a, b]]];
GenA: PROC ~ {ForkScan[fkd, a, setsA, roA]};
GenB: PROC ~ {ForkScan[fkd, b, setsB, roB]};
TestAB: PROC ~ {
Produce: PROC [w: Which] RETURNS [MaybePair] ~ {
Wait: ENTRY PROC [lp: LockPtr] RETURNS [MaybePair] ~ {
ENABLE UNWIND => NULL;
UNTIL fkd.ready[w] DO WAIT fkd.change ENDLOOP;
RETURN [fkd.val[w]]};
TRUSTED {RETURN Wait[@fkd.lock]}};
Finish: ENTRY PROC [lp: LockPtr] ~ {
ENABLE UNWIND => NULL;
fkd.done ← TRUE;
fkd.ready ← ALL[FALSE];
BROADCAST fkd.change;
RETURN};
ans ← Consume[Produce];
TRUSTED {Finish[@fkd.lock]};
RETURN};
TRUSTED {
Process.EnableAborts[@fkd.change];
SharedErrors.Fork[LIST[GenA, GenB, TestAB]]};
RETURN};
ParallelScanRestriction: PUBLIC PROC [a, b: BiRel, Test: ParallelTester, setsA, setsB: SetPair ← [], roA, roB: RelOrder ← []] RETURNS [pf: ParallelFind ← [FALSE, noMaybePair, noMaybePair]] ~ {
fkd: Forked ~ NEW [ForkedPrivate ← [set: [a, b] ]];
GenA: PROC ~ {ForkScan[fkd, a, setsA, roA]};
GenB: PROC ~ {ForkScan[fkd, b, setsB, roB]};
TestAB: PROC ~ {
WaitForReq: ENTRY PROC [lp: LockPtr] RETURNS [continue: BOOL] ~ {
ENABLE UNWIND => NULL;
DO
IF NOT fkd.ready[a] THEN {WAIT fkd.change; LOOP};
IF NOT fkd.ready[b] THEN {WAIT fkd.change; LOOP};
RETURN [fkd.val[a].found OR fkd.val[b].found];
ENDLOOP;
};
Satisfy: ENTRY PROC [lp: LockPtr] ~ {
ENABLE UNWIND => NULL;
fkd.ready[a] ← fkd.ready[b] ← FALSE;
BROADCAST fkd.change;
RETURN};
TRUSTED {UNTIL fkd.done DO
IF NOT WaitForReq[@fkd.lock]
THEN fkd.done ← TRUE
ELSE {IF (fkd.done ← Test[fkd.val[a], fkd.val[b]]) THEN pf ← [TRUE, fkd.val[a], fkd.val[b]]};
Satisfy[@fkd.lock];
ENDLOOP};
RETURN};
TRUSTED {
Process.EnableAborts[@fkd.change];
SharedErrors.Fork[LIST[GenA, GenB, TestAB]]};
RETURN};
ForkScan: PROC [fkd: Forked, which: Which, sets: SetPair, ro: RelOrder] ~ {
Mediate: PROC [val: Pair] RETURNS [pass: BOOLFALSE] ~ {
WithLock: ENTRY PROC [lp: LockPtr] ~ {
ENABLE UNWIND => NULL;
fkd.val[which].it ← val;
fkd.ready[which] ← TRUE;
BROADCAST fkd.change;
UNTIL NOT fkd.ready[which] DO WAIT fkd.change ENDLOOP;
pass ← fkd.done;
RETURN};
TRUSTED {WithLock[@fkd.lock]};
RETURN};
Finish: ENTRY PROC [lp: LockPtr] ~ {
ENABLE UNWIND => NULL;
fkd.val[which] ← noMaybePair;
UNTIL fkd.done DO
fkd.ready[which] ← TRUE;
BROADCAST fkd.change;
UNTIL NOT fkd.ready[which] DO WAIT fkd.change ENDLOOP;
ENDLOOP;
RETURN};
[] ← fkd.set[which].ScanRestriction[sets, Mediate, ro];
TRUSTED {Finish[@fkd.lock]};
RETURN};
ScanImage: PUBLIC PROC [br: BiRel, set: Set, Test: Sets.Tester, dir: Direction ← leftToRight, ro: Sets.RelOrder ← no] RETURNS [MaybePair] ~ {
dest: Side ~ Dest[dir];
Pass: PROC [pair: Pair] RETURNS [BOOL] ~ {RETURN Test[pair[dest]]};
RETURN br.ScanHalfRestriction[set, Pass, Source[dir], ConsRelOrder[dest, ro]]};
Has: PUBLIC PROC [br, other: BiRel, want: BoolPair] RETURNS [hsp: HadSetPair ← []] ~ {
spaces: SpacePair ~ br.Spaces[];
Per: PROC [pair: Pair] RETURNS [BOOL] ~ {
IF want[leftToRight] THEN {
mv: MaybeValue ~ br.Apply[pair[left], leftToRight];
SELECT TRUE FROM
NOT mv.found => hsp[leftToRight][none] ← TRUE;
spaces[right].SEqual[pair[right], mv.it] => hsp[leftToRight][same] ← TRUE;
ENDCASE => hsp[leftToRight][different] ← TRUE};
IF want[rightToLeft] THEN {
mv: MaybeValue ~ br.Apply[pair[right], rightToLeft];
SELECT TRUE FROM
NOT mv.found => hsp[rightToLeft][none] ← TRUE;
spaces[left].SEqual[pair[left], mv.it] => hsp[rightToLeft][same] ← TRUE;
ENDCASE => hsp[rightToLeft][different] ← TRUE};
RETURN [FALSE]};
IF want#ALL[FALSE] AND other.Scan[Per].found THEN ERROR;
RETURN};
AddAA: PUBLIC PROC [br: BiRel, left, right: REF ANY, if: IfHadPair ← alwaysAdd] RETURNS [had: HadPair]
~ {RETURN br.AddPair[[AV[left], AV[right]], if]};
AddIA: PUBLIC PROC [br: BiRel, left: INT, right: REF ANY, if: IfHadPair ← alwaysAdd] RETURNS [had: HadPair]
~ {RETURN br.AddPair[[IV[left], AV[right]], if]};
AddII: PUBLIC PROC [br: BiRel, left, right: INT, if: IfHadPair ← alwaysAdd] RETURNS [had: HadPair]
~ {RETURN br.AddPair[[IV[left], IV[right]], if]};
AddNewPair: PUBLIC PROC [br: BiRel, pair: Pair] ~ {
had: HadPair ~ br.AddPair[pair, addIfNew];
IF br.Functional[][leftToRight] AND had[leftToRight]#none THEN ERROR;
IF br.Functional[][rightToLeft] AND had[rightToLeft]#none THEN ERROR;
RETURN};
AddNewAA: PUBLIC PROC [br: BiRel, left, right: REF ANY] ~ {
had: HadPair ~ br.AddPair[[AV[left], AV[right]], addIfNew];
IF br.Functional[][leftToRight] AND had[leftToRight]#none THEN ERROR;
IF br.Functional[][rightToLeft] AND had[rightToLeft]#none THEN ERROR;
RETURN};
AddNewIA: PUBLIC PROC [br: BiRel, left: INT, right: REF ANY] ~ {
had: HadPair ~ br.AddPair[[IV[left], AV[right]], addIfNew];
IF br.Functional[][leftToRight] AND had[leftToRight]#none THEN ERROR;
IF br.Functional[][rightToLeft] AND had[rightToLeft]#none THEN ERROR;
RETURN};
AddNewII: PUBLIC PROC [br: BiRel, left, right: INT] ~ {
had: HadPair ~ br.AddPair[[IV[left], IV[right]], addIfNew];
IF br.Functional[][leftToRight] AND had[leftToRight]#none THEN ERROR;
IF br.Functional[][rightToLeft] AND had[rightToLeft]#none THEN ERROR;
RETURN};
RemAA: PUBLIC PROC [br: BiRel, left, right: REF ANY] RETURNS [had: HadPair]
~ {RETURN br.RemPair[[AV[left], AV[right]]]};
RemIA: PUBLIC PROC [br: BiRel, left: INT, right: REF ANY] RETURNS [had: HadPair]
~ {RETURN br.RemPair[[IV[left], AV[right]]]};
RemII: PUBLIC PROC [br: BiRel, left, right: INT] RETURNS [had: HadPair]
~ {RETURN br.RemPair[[IV[left], IV[right]]]};
refNilSets: REF ANY ~ FromSets[ALL[nilSet]];
AddComposite: PROC [op: ATOM] ~ {
Atom.PutProp[prop: kindKey, val: $composite, atom: op];
};
AddAlways: PROC [op: ATOM] ~ {
Atom.PutProp[prop: kindKey, val: $always, atom: op];
};
AddArgless: PROC [op: ATOM] ~ {
Atom.PutProp[prop: kindKey, val: $argless, atom: op];
};
AddArgfull: PROC [op: ATOM, arg1, arg2: ArgType ← None] ~ {
Atom.PutProp[prop: kindKey, val: NEW [ArgTyping ← [arg1, arg2]], atom: op];
};
Start: PROC ~ {
AddComposite[$Mapping];
AddComposite[$Enumerate];
AddComposite[$Scan];
AddComposite[$EnumerateImage];
AddComposite[$ScanImage];
AddComposite[$EnumerateMapping];
AddComposite[$ScanMapping];
AddComposite[$EnumerateHalfRestriction];
AddComposite[$ScanHalfRestriction];
AddComposite[$APair];
AddComposite[$Pop];
AddComposite[$Next];
AddComposite[$Prev];
AddComposite[$SkipTo];
AddComposite[$Lookup];
AddComposite[$Size];
AddComposite[$Empty];
AddComposite[$ImageSize];
AddComposite[$MappingSize];
AddComposite[$AddNewPair];
AddComposite[$AddNewSet];
AddComposite[$Erase];
AddComposite[$GetIntDom];
AddArgless[$AsSet];
AddArgless[$HasPair];
AddArgfull[$Image, $Set, $Dir];
AddArgfull[$Apply, $Dir];
AddArgfull[$ScanRestriction, $SetPair, $RelOrder];
AddArgfull[$GetOne, $remove, $RelOrder];
AddArgfull[$Get3, $RelOrderFN, $Want3];
AddArgfull[$RestrictionSize, $SetPair, $limit];
AddArgfull[$IsDense, $When, $Side];
AddArgfull[$SideFixed, $Side];
AddArgfull[$GetBounds, $EndBools, $RelOrderFN];
AddArgless[$Copy];
AddArgless[$Insulate];
AddArgless[$ValueOf];
AddArgless[$Freeze];
AddArgless[$Thaw];
AddArgless[$AddPair];
AddArgfull[$AddSet, $BiRel];
AddArgfull[$Swap, $Side];
AddArgless[$RemPair];
AddArgfull[$RemSet, $BiRel];
AddArgless[$Delete];
AddArgfull[$DeleteSet, $Set, $Side];
AddArgless[$QuaIntInterval];
AddAlways[$MutabilityOf];
AddAlways[$Spaces];
AddArgfull[$SetOn, $Side];
AddArgfull[$CurSetOn, $Side];
AddAlways[$Functional];
AddAlways[$PreservePair];
RETURN};
FOR l2r: BOOL IN BOOL DO FOR r2l: BOOL IN BOOL DO FOR mut: Mutability IN Mutability DO
classes[l2r][r2l][mut] ← CreateClass[
cp: [
Primitive: PrefixPrimitive,
AsSet: PrefixAsSet,
HasPair: PrefixHasPair,
Image: PrefixImage,
Apply: PrefixApply,
ScanRestriction: PrefixScanRestriction,
GetOne: PrefixGetOne,
Get3: PrefixGet3,
Index: PrefixIndex,
RestrictionSize: PrefixRestrictionSize,
GetBounds: PrefixGetBounds,
Copy: PrefixCopy,
Insulate: IF mut=variable THEN PrefixInsulate ELSE NIL,
ValueOf: IF mut#constant THEN PrefixValueOf ELSE NIL,
Freeze: IF mut=variable THEN PrefixFreeze ELSE NIL,
Thaw: IF mut=variable THEN PrefixThaw ELSE NIL,
SetOn: PrefixSetOn,
CurSetOn: PrefixCurSetOn,
AddPair: IF mut=variable THEN PrefixAddPair ELSE NIL,
AddSet: IF mut=variable THEN PrefixAddSet ELSE NIL,
Swap: IF mut=variable THEN PrefixSwap ELSE NIL,
RemPair: IF mut=variable THEN PrefixRemPair ELSE NIL,
RemSet: IF mut=variable THEN PrefixRemSet ELSE NIL,
Delete: IF mut=variable THEN PrefixDelete ELSE NIL,
DeleteSet: IF mut=variable THEN PrefixDeleteSet ELSE NIL,
ReplaceMe: IF mut=variable THEN PrefixReplaceMe ELSE NIL,
ShiftAndClipMe: IF mut=variable THEN PrefixShiftAndClipMe ELSE NIL,
Spaces: PrefixSpaces,
IsDense: PrefixIsDense,
SideFixed: PrefixSideFixed,
functional: [l2r, r2l],
mutability: mut]],
dirable: ALL[TRUE]
];
ENDLOOP ENDLOOP ENDLOOP;
Start[];
END.