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"]; notFunctional: PUBLIC ROPE ~ R["%g's must be functional %g"]; badBiRel: PUBLIC BiRel ~ [NIL, R["bad BiRel"]]; provisionKey: ATOM ~ $BiRelsImplProvision; dirableKey: ATOM ~ $BiRelsImplDirable; resableKey: ATOM ~ $BiRelsImplRestrictable; kindKey: ATOM ~ $BiRelsImplKind; refTwo: REF EINT ~ FromEI[two]; Proc: TYPE ~ PROC ANY RETURNS ANY; ConsBiRel: PUBLIC PROC [class: BiRelClass, data: REF ANY] RETURNS [BiRel] ~ {RETURN [[class, data]]}; CreateClass: PUBLIC PROC [cp: BiRelClassPrivate, dirable: BoolPair _ [TRUE, FALSE], restrictable: RestrictabilityPair _ ALL[none]] 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[$Update, Update] THEN Update _ DefaultUpdate; 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]; cp.other _ List.PutAssoc[resableKey, NEW [RestrictabilityPair _ restrictable], cp.other]; class _ NEW [BiRelClassPrivate _ cp]; RETURN}; Primitive: PUBLIC PROC [br: BiRel, op: ATOM, arg1, arg2: REF ANY _ NIL] 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, $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]}; $SetPair => {rsp: RefSetPair ~ ToSets[args[i]]; resable: REF RestrictabilityPair ~ NARROW[List.Assoc[resableKey, br.class.other]]; FOR side: Side IN Side DO SELECT resable[From[side]] FROM none => IF rsp[side]#nilSet THEN RETURN [FALSE]; tiny => IF rsp[side]#nilSet AND NOT (rsp[side].GoodImpl[$Size, refTwo] AND rsp[side].Size[two].Compare[two] NULL; ENDCASE => ERROR; ENDLOOP; }; $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 ANY _ NIL] 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]]}; $HasMapping => {from: Side ~ Source[ToDir[arg1]]; RETURN br.QualityOf[$ScanRestriction, FromSets[ConsSets[from, Sets.FakeSingleton[br.Spaces[][from]]]]]}; $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]; os: Side ~ OtherSide[side]; bwd: BOOL ~ ToBool[arg4]; RETURN br.QualityOf[$ScanRestriction, FromSets[ConsSets[side, goal^, IntervalAsSet[br.Spaces[][os], bounds]]], FromRO[ConsRelOrder[os, 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, refTwo] AND set.Size[two].Compare[two] { 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]; $Substitute => {side: Side ~ ToSide[arg1]; RETURN QMin[ br.QualityOf[$Mapping, FromDir[From[side]]], br.QualityOf[$AddSet]] .QMin[IF br.Functional[][To[side]] THEN primitive ELSE br.QualityOf[$Delete, FromSide[side]]]}; $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 => {dir: Direction ~ ToDir[arg1]; IF br.Functional[][dir] AND Primitive[br, $Update, arg1] THEN RETURN [goodDefault]; {src: Side ~ Source[dir]; 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 {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 => { IF br.MutabilityOf[]#variable THEN RETURN [goodDefault]; IF br.Functional[]#ALL[FALSE] THEN FOR dir: Direction IN Direction DO IF br.Functional[][dir] AND NOT Primitive[br, $Update, FromDir[dir]] THEN EXIT; REPEAT FINISHED => RETURN [goodDefault]; ENDLOOP; RETURN [IF Primitive[br, $AddSet, FakeRefSingleton[br.Spaces[]]] THEN goodDefault ELSE cant]; }; $AddSet => { IF br.MutabilityOf[]#variable THEN RETURN [goodDefault]; IF br.Functional[]#ALL[FALSE] THEN FOR dir: Direction IN Direction DO IF br.Functional[][dir] AND NOT Primitive[br, $Update, FromDir[dir]] THEN EXIT; REPEAT FINISHED => RETURN [goodDefault]; ENDLOOP; RETURN [IF Primitive[br, $AddPair] THEN goodDefault ELSE cant]; }; $Swap => {side: Side ~ ToSide[arg1]; dir: Direction ~ From[side]; IF br.MutabilityOf[]#variable THEN RETURN [goodDefault]; RETURN QMin[goodDefault, QMin[QMin[ br.QualityOf[$Mapping, FromDir[dir]], br.QualityOf[$Delete, FromSide[side]]], QMin[ br.QualityOf[$ScanMapping, FromDir[dir]], br.QualityOf[$AddPair]]]]}; $RemPair => {spaces: SpacePair ~ br.Spaces[]; IF br.MutabilityOf[]#variable THEN RETURN [goodDefault]; IF br.Functional[]#ALL[FALSE] THEN FOR dir: Direction IN Direction DO IF br.Functional[][dir] AND NOT Primitive[br, $Update, FromDir[dir]] THEN EXIT; REPEAT FINISHED => RETURN [goodDefault]; ENDLOOP; IF Primitive[br, $RemSet, FakeRefSingleton[spaces]] THEN RETURN [goodDefault]; IF br.Functional[]#ALL[FALSE] THEN { goodDelete: BoolPair _ ALL[FALSE]; FOR dir: Direction IN Direction DO src: Side ~ Source[dir]; IF br.Functional[][dir] THEN { IF br.GoodImpl[$Apply, FromDir[dir]] THEN goodDelete[dir] _ br.Primitive[$Delete, FromSide[src]] OR br.Primitive[$DeleteSet, Sets.FakeRefSingleton[spaces[src]], FromSide[src]] ELSE EXIT}; REPEAT FINISHED => IF goodDelete#ALL[FALSE] THEN RETURN [goodDefault]; ENDLOOP; op _ op}; RETURN [cant]}; $RemSet => { IF br.MutabilityOf[]#variable THEN RETURN [goodDefault]; IF br.Primitive[$RemPair] THEN RETURN [goodDefault]; IF br.Functional[]#ALL[FALSE] THEN { FOR dir: Direction IN Direction DO IF br.Functional[][dir] AND NOT Primitive[br, $Update, FromDir[dir]] THEN EXIT; REPEAT FINISHED => RETURN [goodDefault]; ENDLOOP; {spaces: SpacePair ~ br.Spaces[]; goodDelete: BoolPair _ ALL[FALSE]; FOR dir: Direction IN Direction DO src: Side ~ Source[dir]; IF br.Functional[][dir] THEN { IF br.GoodImpl[$Apply, FromDir[dir]] THEN goodDelete[dir] _ br.Primitive[$Delete, FromSide[src]] OR br.Primitive[$DeleteSet, Sets.FakeRefSingleton[spaces[src]], FromSide[src]] ELSE EXIT}; REPEAT FINISHED => IF goodDelete#ALL[FALSE] THEN RETURN [goodDefault]; ENDLOOP; op _ op}}; RETURN [cant]}; $Update => RETURN QMin[ QMin[goodDefault, br.QualityOf[$Apply, arg1]], QMin[br.QualityOf[$AddPair], br.QualityOf[$RemPair]]]; $Delete => {side: Side ~ ToSide[arg1]; dir: Direction ~ From[side]; IF br.MutabilityOf[]#variable THEN RETURN [goodDefault]; IF br.Functional[][dir] AND Primitive[br, $Update, FromDir[dir]] THEN RETURN [goodDefault]; RETURN QMin[goodDefault, br.QualityOf[$DeleteSet, Sets.FakeRefSingleton[br.Spaces[][side]], FromSide[side]]]}; $DeleteSet => {set: RefSet ~ ToSet[arg1]; side: Side ~ ToSide[arg2]; dir: Direction ~ From[side]; IF br.MutabilityOf[]#variable THEN RETURN [goodDefault]; IF Primitive[br, $Delete, FromSide[side]] OR br.Functional[][dir] AND Primitive[br, $Update, FromDir[dir]] THEN RETURN [goodDefault]; RETURN QMin[QMin[ set^.QualityOf[$Scan], br.QualityOf[$RemPair]], QMin[ br.QualityOf[$ScanMapping, FromDir[dir]], poorDefault]]}; $ReplaceMe => {with: IntRel ~ ToBiRel[arg1]^; IF br.MutabilityOf[]#variable THEN RETURN [goodDefault]; RETURN QMin[QMin[ with.QualityOf[$GetIntDom], br.QualityOf[$DeleteSet, refSetAllInts]], QMin[ SubShiftQuality[br], br.QualityOf[$AddSet, with.Refify]]].QMin[ poorDefault]}; $ShiftAndClipMe => { IF br.MutabilityOf[]#variable THEN RETURN [goodDefault]; RETURN QMin[br.QualityOf[$DeleteSet, refSetAllInts], SubShiftQuality[br]].QMin[poorDefault]}; $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 _ []] ~ { EnumTest: PROC [pair: Pair] RETURNS [BOOL] ~ {Consume[pair]; RETURN [FALSE]}; IF br.Scan[EnumTest, ro].found THEN ERROR}; EnumAA: PUBLIC PROC [br: BiRel, Consume: PROC [REF ANY, REF ANY], ro: RelOrder _ []] ~ { EnumAATest: PROC [pair: Pair] RETURNS [BOOL] ~ {Consume[pair[left].VA, pair[right].VA]; RETURN [FALSE]}; IF br.Scan[EnumAATest, ro].found THEN ERROR}; EnumIA: PUBLIC PROC [br: BiRel, Consume: PROC [INT, REF ANY], ro: RelOrder _ []] ~ { EnumIATest: PROC [pair: Pair] RETURNS [BOOL] ~ {Consume[pair[left].VI, pair[right].VA]; RETURN [FALSE]}; IF br.Scan[EnumIATest, ro].found THEN ERROR}; EnumII: PUBLIC PROC [br: BiRel, Consume: PROC [INT, INT], ro: RelOrder _ []] ~ { EnumIITest: PROC [pair: Pair] RETURNS [BOOL] ~ {Consume[pair[left].VI, pair[right].VI]; RETURN [FALSE]}; IF br.Scan[EnumIITest, 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]; EnumImageTest: PROC [pair: Pair] RETURNS [BOOL] ~ {Consume[pair[dest]]; RETURN [FALSE]}; IF br.ScanHalfRestriction[set, EnumImageTest, 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 BOOL _ ALL[FALSE], done: BOOL _ FALSE, 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: BOOL _ FALSE] ~ { 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}; EnumerateHalfRestriction: PUBLIC PROC [br: BiRel, set: Set, Consume: PROC [Pair], side: Side _ left, ro: RelOrder _ []] ~ { EnumHRTest: PROC [pair: Pair] RETURNS [BOOL] ~ {Consume[pair]; RETURN [FALSE]}; IF br.ScanHalfRestriction[set, EnumHRTest, side, ro].found THEN ERROR; RETURN}; ScanImage: PUBLIC PROC [br: BiRel, set: Set, Test: Sets.Tester, dir: Direction _ leftToRight, ro: Sets.RelOrder _ no] RETURNS [MaybePair] ~ { dest: Side ~ Dest[dir]; ScanImageTest: PROC [pair: Pair] RETURNS [BOOL] ~ {RETURN Test[pair[dest]]}; RETURN br.ScanHalfRestriction[set, ScanImageTest, 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]]]}; RemOldPair: PUBLIC PROC [br: BiRel, pair: Pair] ~ { had: HadPair ~ br.RemPair[pair]; IF br.Functional[][leftToRight] AND had[leftToRight]#same THEN ERROR; IF br.Functional[][rightToLeft] AND had[rightToLeft]#same THEN ERROR; }; RemOldAA: PUBLIC PROC [br: BiRel, left, right: REF ANY] ~ { had: HadPair ~ br.RemPair[[AV[left], AV[right]]]; IF br.Functional[][leftToRight] AND had[leftToRight]#same THEN ERROR; IF br.Functional[][rightToLeft] AND had[rightToLeft]#same THEN ERROR; }; RemOldIA: PUBLIC PROC [br: BiRel, left: INT, right: REF ANY] ~ { had: HadPair ~ br.RemPair[[IV[left], AV[right]]]; IF br.Functional[][leftToRight] AND had[leftToRight]#same THEN ERROR; IF br.Functional[][rightToLeft] AND had[rightToLeft]#same THEN ERROR; }; RemOldII: PUBLIC PROC [br: BiRel, left, right: INT] ~ { had: HadPair ~ br.RemPair[[IV[left], IV[right]]]; IF br.Functional[][leftToRight] AND had[leftToRight]#same THEN ERROR; IF br.Functional[][rightToLeft] AND had[rightToLeft]#same THEN ERROR; }; Substitute: PUBLIC PROC [br: BiRel, old, new: Value, side: Side] ~ { image: Set ~ br.Mapping[old, From[side]]; [] _ br.AddSet[CreateProduct[ConsSets[side, Sets.CreateSingleton[new, br.Spaces[][side]], image]]]; IF NOT br.Functional[][To[side]] THEN [] _ br.Delete[old, side]; RETURN}; 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[$Substitute]; 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]; AddArgfull[$Update, $Dir]; AddArgless[$Delete]; AddArgfull[$DeleteSet, $Set, $Side]; AddArgless[$QuaIntInterval]; AddAlways[$MutabilityOf]; AddAlways[$Spaces]; AddArgfull[$SetOn, $Side]; AddArgfull[$CurSetOn, $Side]; AddAlways[$Functional]; AddAlways[$PreservePair]; RETURN}; Start[]; END. BiRelsImpl.Mesa Last tweaked by Mike Spreitzer on March 4, 1988 5:10:39 pm PST 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, Update: PrefixUpdate, 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], restrictable: [tiny, none] ]; ENDLOOP ENDLOOP ENDLOOP; Κ* – "cedar" style˜code™Kšœ>™>—K˜KšΟk œj˜sK˜šΟn œœ˜Kšœœ ˜Kšœc˜jKšœ˜K˜—K˜Kšœœžœ2˜VK˜Kš œ œœœœ œ˜,K˜Kšžœœœœ˜&K˜Kšœœœ(˜HKšœ œœ%˜;Kšœ œœ'˜=Kšœœœ#˜=K˜Kšœ œ œ˜/K˜Kšœœ˜*Kšœ œ˜&Kšœ œ˜+Kšœ œ˜ Kšœœœ˜K˜Kš œœœœœœ˜"K˜š ž œœœœœœ˜IKšœœ˜—K˜šž œœœ.œœ'œœ˜’K•StartOfExpansion%[key: REF ANY, aList: List.AList]šœœ1˜Nš žœœœœœ˜7Kš œœ œœ œ˜TKšœ˜—Kšœœ˜ Kšœœ˜/Kšœœ˜7Kšœœ˜/Kšœœ˜/Kšœ'œ*˜WKšœœ˜3Kšœœ˜+Kšœœ˜/Kšœ'œ*˜WKšœœ˜?Kšœœ˜+Kšœœ˜;Kšœœ˜7Kšœœ˜3Kšœœ˜+Kšœœ˜/Kšœœ˜;Kšœœ˜7Kšœœ˜3Kšœœ˜+Kšœœ˜7Kšœœ˜3Kšœœ˜3Kšœœ˜3Kšœœ˜?Kšœœ˜?Kšœ%œ(˜SKšœœ˜7Kšœœ˜?K˜Kšœ8˜8Kšœ%œ!˜IKšœ%œ1˜YKšœœ˜%Kšœ˜—K˜šž œœœœœœœœœ˜ZK–[atom: ATOM, prop: REF ANY]šœœœ˜*KšœœœœœœΟcCœ˜qšœœ˜šœœœ˜Kšœ œœ˜Kšœ œ˜Kšœœ˜Kšœœ˜—Kšœœœ˜Kšœœ˜—š œœœœ(˜QKšœœœ˜Kšœœœ˜Kšœœ˜ Kšœœ˜—Kšœœ+˜IKšœœœ˜&šœ˜Kšœ œœ˜šœœœ˜#šœœœ˜Kšœ œœ˜Kšœœ˜Kšœœ˜—šœœ˜Kš œœ œœœ˜/šœœœ ˜Kšœ˜šœ˜KšœXœ˜]˜)Kšœ œ œ)˜GKš œœœœœ˜)—šœ/˜/Kšœ œœ)˜Ršœ œ˜šœ˜Kš œœœœœ˜0Kšœœœœ$œ)œœœ˜‡Kšœœ˜ Kšœœ˜—Kšœ˜—K˜—Kš œ œœœœœ˜PKšœœ˜—Kšœ˜—Kšœœ˜—Kšœœ˜—Kšœœ˜—K˜—K˜Kšœ˜Kšœ0˜0K˜šž œœœœœœœœ˜mKšœœœœœœŸCœ˜qšœœ˜*šœœœ˜Kšœ œ ˜Kšœ œ˜šœœ˜šœ*˜*KšœV˜\—šœ1˜1Kšœb˜h—Kšœœ-˜AKšœ œ2˜AKšœœ2˜Kšœ˜K˜K˜K˜$Kšœf˜l—šœ˜K˜Kšœe˜k—šœ˜K˜Kšœ`˜f—Kšœœ<˜_KšœœV˜tKšœ œ>˜NKšœœ=˜KKšœ œ<˜KKšœ œ<˜Kšœ ˜ K˜K˜%K˜K˜Kšœœ˜Kšœœœœ ˜€—šœ ˜ K˜'K˜KšœT˜Z—Kšœ œ2˜AKšœ œ˜-šœ'˜'Kšœ˜Kšœœœ"˜NKšœœœU˜hKšœœœœ˜(Kšœœœ œ˜J—šœ˜K˜Kšœ`˜f—Kšœœ˜-Kšœœ˜1Kšœ œ"˜2šœ*˜*šœ˜ Kšœ,˜,Kšœ˜Kšœœœ œ)˜_——Kšœœ2˜FKšœœ˜—Kšœœ˜—Kšœœœ˜Kšœœ˜—Kšœœœ ˜9šœ˜Kšœ œ˜šœ-˜-Kšœ„˜Š—šœ%˜%K˜KšœœFœ œ˜t—šœ(˜(Kšœœœœ˜SKšœ˜Kšœ~˜„—šœ˜K˜ K˜