<> <> DIRECTORY AbSets, Atom, IntStuff, IO, List, Process, Rope, SetBasics, SharedErrors; SetsImpl: CEDAR MONITOR LOCKS lp USING lp: LockPtr IMPORTS AbSets, Atom, IntStuff, IO, List, Process, Rope, SetBasics, SharedErrors EXPORTS SetBasics, AbSets = BEGIN OPEN IntStuff, SetBasics, Sets:AbSets, Sets; LockPtr: TYPE ~ LONG POINTER TO MONITORLOCK; Error: PUBLIC ERROR [msg: ROPE, args: LOV] ~ CODE; Cant: PUBLIC ERROR [set: Set] ~ CODE; notConstant: PUBLIC ROPE ~ R["%g not constant"]; notVariable: PUBLIC ROPE ~ R["%g not variable"]; writeable: PUBLIC ROPE ~ R["%g not unwriteable"]; frozen: PUBLIC ROPE ~ R["%g frozen"]; unfrozen: PUBLIC ROPE ~ R["%g unfrozen"]; notASingleton: PUBLIC ROPE ~ R["%g not a singleton"]; narrowFault: PUBLIC ROPE ~ R["%g not in range"]; notFound: PUBLIC ROPE ~ R["no appropriate value"]; denseSet: PUBLIC ROPE ~ R["%g must remain dense"]; notExpandable: PUBLIC ROPE ~ R["%g not expandable"]; notInts: PUBLIC ROPE ~ R["%g not a set of integers"]; badSet: PUBLIC Set _ [NIL, [ra: $bad]]; refFullInterval: PUBLIC RefInterval ~ NEW [Interval _ fullInterval]; refAllInts: PUBLIC RefInterval ~ NEW [Interval _ [[i:INT.FIRST], [i:INT.LAST]]]; kindKey: ATOM ~ $SetsImplKind; provisionKey: ATOM ~ $SetsImplProvision; relableKey: ATOM ~ $SetsImplRelable; Cons: PUBLIC PROC [class: SetClass, data: Value] RETURNS [Set] ~ {RETURN [[class, data]]}; Proc: TYPE ~ PROC ANY RETURNS ANY; CreateClass: PUBLIC PROC [cp: SetClassPrivate, relable: Relable _ [TRUE, FALSE, FALSE]] RETURNS [class: SetClass] ~ { provs: Atom.PropList _ NARROW[List.Assoc[provisionKey, cp.other]]; Sp: PROC [op: ATOM, proc: Proc] RETURNS [def: BOOL] ~ { provs _ List.PutAssoc[op, IF (def _ proc=NIL) THEN $Default ELSE $Primitive, provs]}; {OPEN cp; IF Sp[$HasMember, HasMember] THEN HasMember _ DefaultHasMember; IF Sp[$Scan, Scan] THEN Scan _ DefaultScan; IF Sp[$TheElt, TheElt] THEN TheElt _ DefaultTheElt; IF Sp[$GetOne, GetOne] THEN GetOne _ DefaultGetOne; IF Sp[$Get3, Get3] THEN Get3 _ DefaultGet3; IF Sp[$Size, Size] THEN Size _ DefaultSize; IF Sp[$IsDense, IsDense] THEN IsDense _ DefaultIsDense; 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[$AddSet, AddSet] THEN AddSet _ DefaultAddSet; IF Sp[$RemSet, RemSet] THEN RemSet _ DefaultRemSet; IF Sp[$QuaBiRel, QuaBiRel] THEN QuaBiRel _ DefaultQuaBiRel; IF Sp[$QuaIntInterval, QuaIntInterval] THEN QuaIntInterval _ DefaultQuaIntInterval; }; cp.other _ List.PutAssoc[provisionKey, provs, cp.other]; cp.other _ List.PutAssoc[relableKey, NEW [Relable _ relable], cp.other]; class _ NEW [SetClassPrivate _ cp]; RETURN}; Primitive: PUBLIC PROC [set: Set, 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--; SELECT kind FROM $class, $classO, $classRO, $classL, $classS, $classW, $classW2, $classW3 => NULL; $classA => RETURN [TRUE]; ENDCASE => ERROR; IF set.class.Primitive#NIL THEN SELECT set.class.Primitive[set, op, arg1, arg2] FROM yes => RETURN [TRUE]; no => RETURN [FALSE]; pass => NULL; ENDCASE => ERROR; {provs: Atom.PropList ~ NARROW[List.Assoc[provisionKey, set.class.other]]; prov: REF ANY ~ List.Assoc[op, provs]; RETURN [SELECT prov FROM $Default => FALSE, $Primitive => SELECT kind FROM $class, $classL, $classS, $classW, $classW2, $classW3 => TRUE, $classO => (NARROW[List.Assoc[relableKey, set.class.other], REF Relable])[ToRO[arg1]], $classRO => (set.MutabilityOf[]#variable AND ToBool[arg1]) OR (NARROW[List.Assoc[relableKey, set.class.other], REF Relable])[ToRO[arg2]], ENDCASE => ERROR, ENDCASE => ERROR]; }}; QualityOf: PUBLIC PROC [set: Set, op: ATOM, arg1, arg2: REF ANY _ NIL] RETURNS [ImplQuality] ~ { SELECT Atom.GetProp[op, kindKey] FROM $class, $classO, $classRO, $classL, $classS, $classW, $classW2, $classW3 => NULL; $classA => RETURN [primitive]; $composite => SELECT op FROM $Enumerate => RETURN set.QualityOf[$Scan, arg1, arg2]; $AnElt => RETURN set.QualityOf[$GetOne, $FALSE, arg1]; $Pop => RETURN set.QualityOf[$GetOne, $TRUE, arg1]; $First => RETURN set.QualityOf[$GetOne, $FALSE, $fwd]; $Last => RETURN set.QualityOf[$GetOne, $FALSE, $bwd]; $Next => RETURN set.QualityOf[$Get3, $FFT]; $Prev => RETURN set.QualityOf[$Get3, $TFF]; $Empty => RETURN set.QualityOf[$Size, refOne]; $QuickSize => RETURN [IF set.Primitive[$Size, refTwo] THEN primitive ELSE poorDefault]; $AddElt => RETURN set.QualityOf[$AddSet, FakeRefSingleton[set.SpaceOf]]; $RemElt => RETURN set.QualityOf[$RemSet, FakeRefSingleton[set.SpaceOf]]; $Erase => RETURN set.QualityOf[$RemoteSet, set.Refify]; $GetIntBounds => RETURN set.QualityOf[$GetBounds, arg1, arg2]; ENDCASE => ERROR; ENDCASE => ERROR; IF Primitive[set, op, arg1, arg2] THEN RETURN [primitive]; SELECT op FROM $HasMember => RETURN [QMin[set.QualityOf[$Scan], poorDefault]]; $Scan => {ro: RelOrder ~ ToRO[arg1]; RETURN [IF ro#no AND Primitive[set, $Scan] THEN poorDefault ELSE cant]}; $TheElt => RETURN [goodDefault]; $GetOne => {remove: BOOL ~ ToBool[arg1]; ro: RelOrder ~ ToRO[arg2]; IF remove AND set.MutabilityOf[]#variable THEN RETURN [goodDefault]; RETURN QMin[QMin[goodDefault, IF ro=no THEN set.QualityOf[$Scan] ELSE set.QualityOf[$GetBounds, FromEB[[min: ro=fwd, max: ro=bwd]]]], IF remove THEN set.QualityOf[$RemElt] ELSE goodDefault]}; $Get3 => { fq: ImplQuality ~ set.QualityOf[$Scan, $fwd]; bq: ImplQuality ~ set.QualityOf[$Scan, $bwd]; nq: ImplQuality ~ set.QualityOf[$Scan, $no]; max: ImplQuality ~ QMax[nq, QMax[fq, bq]]; RETURN QMin[ set.QualityOf[$Scan, IF bq=max AND fq {limit: EINT ~ ToEI[arg1]^; RETURN QMin[ set.QualityOf[$Scan], IF limit.Compare[two]<=equal THEN goodDefault ELSE poorDefault]}; $IsDense => {when: When ~ ToWhen[arg1]; IF when=always AND set.MutabilityOf#constant THEN RETURN [poorDefault]; {space: Space ~ set.SpaceOf[]; pureInts: BOOL ~ space = ints; IF set.GoodImpl[$GetBounds] THEN { bounds: MaybeInterval ~ set.GetBounds[]; IF NOT bounds.found THEN RETURN [goodDefault]; IF bounds.it[min]#noValue AND bounds.it[max]#noValue AND space.SEqual[bounds.it[min], bounds.it[max]] THEN RETURN [goodDefault]; IF pureInts AND Primitive[set, $Size] THEN RETURN [goodDefault]; }; IF NOT pureInts THEN RETURN [poorDefault]; RETURN QMin[poorDefault, QMax[ set.QualityOf[$Scan, $fwd], set.QualityOf[$Scan, $bwd] ]]}}; $GetBounds => {want: EndBools ~ ToEB[arg1]; IF want=ALL[FALSE] THEN RETURN [goodDefault]; IF ((NOT want[min]) OR Primitive[set, $GetOne, $FALSE, $fwd]) AND ((NOT want[max]) OR Primitive[set, $GetOne, $FALSE, $bwd]) THEN RETURN [goodDefault]; RETURN [IF set.Can[$Scan] THEN poorDefault ELSE cant]}; $Copy => RETURN [cant]; $Insulate => RETURN [goodDefault]; $ValueOf => RETURN [IF set.MutabilityOf#constant THEN QMin[goodDefault, QMin[set.QualityOf[$Copy], set.QualityOf[$Freeze]]] ELSE goodDefault]; $Freeze, $Thaw, $addSet, $RemSet => RETURN [IF set.MutabilityOf#variable THEN goodDefault ELSE cant]; $QuaBiRel => RETURN [goodDefault]; $QuaIntInterval => { space: Space ~ set.SpaceOf[]; pureInts: BOOL ~ space = ints; IF NOT pureInts THEN RETURN [goodDefault]; IF set.GoodImpl[$GetBounds] THEN { bounds: MaybeInterval ~ set.GetBounds[]; min, max: INT; IF NOT bounds.found THEN RETURN [goodDefault]; SELECT bounds.it[min].ra FROM NIL => min _ bounds.it[min].i; noRef => min_INT.FIRST; ENDCASE => GOTO Givup; SELECT bounds.it[max].ra FROM NIL => max _ bounds.it[max].i; noRef => max_INT.LAST; ENDCASE => GOTO Givup; IF min=max OR (max>INT.FIRST AND min=max-1) OR (Primitive[set, $Size] AND set.Size[] = ISub[max, min].Succ) OR set.IsDense[] THEN RETURN [goodDefault]; EXITS Givup => op _ op }; RETURN QMin[set.QualityOf[$Scan], poorDefault]}; $SpaceOf => ERROR; ENDCASE => ERROR; }; DefaultHasMember: PROC [set: Set, elt: Value] RETURNS [BOOL] ~ { space: Space ~ set.SpaceOf[]; TestMember: PROC [val: Value] RETURNS [BOOL] ~ {RETURN space.SEqual[elt, val]}; RETURN [set.Scan[TestMember].found]}; Enumerate: PUBLIC PROC [set: Set, Consumer: PROC [Value], ro: RelOrder _ no] ~ { EnumTest: PROC [val: Value] RETURNS [BOOL] ~ {Consumer[val]; RETURN [FALSE]}; IF set.Scan[EnumTest, ro].found THEN ERROR; RETURN}; EnumA: PUBLIC PROC [set: Set, Consumer: PROC [REF ANY], ro: RelOrder _ no] ~ { EnumATest: PROC [val: Value] RETURNS [BOOL] ~ {Consumer[val.VA]; RETURN [FALSE]}; IF set.Scan[EnumATest, ro].found THEN ERROR; RETURN}; EnumI: PUBLIC PROC [set: Set, Consumer: PROC [INT], ro: RelOrder _ no] ~ { EnumITest: PROC [val: Value] RETURNS [BOOL] ~ {Consumer[val.VI]; RETURN [FALSE]}; IF set.Scan[EnumITest, ro].found THEN ERROR; RETURN}; Forked: TYPE ~ REF ForkedPrivate; ForkedPrivate: TYPE ~ RECORD [ set: ARRAY Which OF Set, ready: ARRAY Which OF BOOL _ ALL[FALSE], done: BOOL _ FALSE, change: CONDITION _ [timeout: Process.SecondsToTicks[10]], val: ARRAY Which OF MaybeValue _ ALL[[TRUE, noValue]], lock: MONITORLOCK _ [] ]; InterleavedProduce: PUBLIC PROC [a, b: Set, Consume: InterleavedConsumer, roA, roB: RelOrder _ no] RETURNS [ans: MaybeValue _ noMaybe] ~ { fkd: Forked ~ NEW [ForkedPrivate _ [set: [a, b]]]; GenA: PROC ~ {ForkScan[fkd, a, roA]}; GenB: PROC ~ {ForkScan[fkd, b, roB]}; TestAB: PROC ~ { Produce: PROC [w: Which] RETURNS [MaybeValue] ~ { Wait: ENTRY PROC [lp: LockPtr] RETURNS [MaybeValue] ~ { 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}; ParallelScan: PUBLIC PROC [a, b: Set, Test: ParallelTester, roA, roB: RelOrder _ no] RETURNS [pf: ParallelFind _ [FALSE, noMaybe, noMaybe]] ~ { fkd: Forked ~ NEW [ForkedPrivate _ [set: [a, b] ]]; GenA: PROC ~ {ForkScan[fkd, a, roA]}; GenB: PROC ~ {ForkScan[fkd, b, roB]}; TestAB: PROC ~ TRUSTED { WaitForReq: ENTRY SAFE PROC [lp: LockPtr] RETURNS [continue: BOOL] ~ CHECKED { 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 SAFE PROC [lp: LockPtr] ~ CHECKED { ENABLE UNWIND => NULL; fkd.ready[a] _ fkd.ready[b] _ FALSE; BROADCAST fkd.change; RETURN}; 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, ro: RelOrder] ~ { Mediate: PROC [val: Value] 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] _ noMaybe; 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].Scan[Mediate, ro]; TRUSTED {Finish[@fkd.lock]}; RETURN}; DefaultScan: PUBLIC PROC [set: Set, Test: Tester, ro: RelOrder] RETURNS [MaybeValue] ~ { rro: RelOrder ~ ReverseRelOrder[ro]; IF ro=no THEN set.Cant[]; IF Primitive[set, $Scan, FromRO[rro]] THEN { elts: LOV _ NIL; Addit: PROC [x: Value] ~ {elts _ CONS[x, elts]}; set.Enumerate[Addit, rro]; FOR elts _ elts, elts.rest WHILE elts#NIL DO IF Test[elts.first] THEN RETURN [[TRUE, elts.first]] ENDLOOP; RETURN [noMaybe]; } ELSE IF Primitive[set, $Scan, $no] THEN { space: Space ~ set.SpaceOf[]; elts: LORA _ NIL; Addit: PROC [x: Value] ~ {elts _ CONS[NEW [Value _ x], elts]}; Compare: PROC [ref1, ref2: REF ANY] RETURNS [Comparison] ~ { rv1: REF Value ~ NARROW[ref1]; rv2: REF Value ~ NARROW[ref2]; RETURN space.SCompare[rv1^, rv2^]}; set.Enumerate[Addit, no]; elts _ List.Sort[elts, Compare]; FOR elts _ elts, elts.rest WHILE elts#NIL DO rv: REF Value ~ NARROW[elts.first]; IF Test[rv^] THEN RETURN [[TRUE, rv^]]; ENDLOOP; RETURN [noMaybe]; } ELSE set.Cant[]; }; DefaultTheElt: PROC [set: Set] RETURNS [ans: Value] ~ { n: NATURAL _ 0; TestTheElt: PROC [val: Value] RETURNS [BOOL] ~ {ans _ val; RETURN [(n _ n + 1) > 1]}; mv: MaybeValue ~ set.Scan[TestTheElt]; IF n#1 THEN set.Complain[notASingleton]; RETURN}; DefaultGetOne: PUBLIC PROC [set: Set, remove: BOOL, ro: RelOrder] RETURNS [MaybeValue] ~ { Getit: PROC RETURNS [MaybeValue] ~ { IF ro=no THEN RETURN set.Scan[AcceptAny, ro] ELSE { bounds: MaybeInterval ~ set.GetBounds[want: [min: ro=fwd, max: ro=bwd]]; v: Value ~ IF ro=fwd THEN bounds.it[min] ELSE bounds.it[max]; IF bounds.found THEN RETURN [[TRUE, IF v#noValue THEN v ELSE set.Cant[]]]; RETURN [noMaybe]}}; IF remove AND set.MutabilityOf[]#variable THEN set.Complain[notVariable]; {mv: MaybeValue ~ Getit[]; IF mv.found AND remove AND NOT set.RemElt[mv.it] THEN ERROR; RETURN [mv]}}; DefaultGet3: PROC [set: Set, elt: Value, want: TripleBool] RETURNS [TripleMaybeValue] ~ { fq: ImplQuality ~ set.QualityOf[$Scan, $fwd]; bq: ImplQuality ~ set.QualityOf[$Scan, $bwd]; nq: ImplQuality ~ set.QualityOf[$Scan, $no]; max: ImplQuality ~ QMax[nq, QMax[fq, bq]]; prev, same, next: MaybeValue _ noMaybe; space: Space ~ set.SpaceOf[]; IF fq=max OR bq=max THEN { bwd: BOOL ~ bq=max AND fq IF (NOT prev.found) OR space.SCompare[val, prev.it]=greater THEN prev _ [TRUE, val]; equal => foundSame _ TRUE; greater => IF (NOT next.found) OR space.SCompare[val, next.it]=less THEN next _ [TRUE, val]; ENDCASE => ERROR; RETURN}; IF set.Scan[Get3HardTest, no].found THEN ERROR; RETURN [[prev, IF foundSame THEN [TRUE, elt] ELSE noMaybe, next]]}; }; DefaultSize: PUBLIC PROC [set: Set, limit: EINT] RETURNS [size: EINT _ zero] ~ { SizeTest: PROC [val: Value] RETURNS [pass: BOOL] ~ { TRUSTED {size _ size.Succ[]}; pass _ limit.Compare[size] <= equal; RETURN}; [] _ set.Scan[SizeTest]; RETURN}; DefaultIsDense: PUBLIC PROC [set: Set, when: When] RETURNS [BOOL] ~ { IF when=always AND set.MutabilityOf#constant THEN RETURN [FALSE]; {space: Space ~ set.SpaceOf[]; pureInts: BOOL ~ space = ints; IF set.GoodImpl[$GetBounds] THEN { bounds: MaybeInterval ~ set.GetBounds[]; IF NOT bounds.found THEN RETURN [TRUE]; IF bounds.it[min]#noValue AND bounds.it[max]#noValue AND space.SEqual[bounds.it[min], bounds.it[max]] THEN RETURN [TRUE]; IF pureInts AND Primitive[set, $Size] THEN { min, max: INT; SELECT bounds.it[min].ra FROM NIL => min _ bounds.it[min].i; noRef => IF pureInts THEN min_INT.FIRST ELSE GOTO Givup; ENDCASE => GOTO Givup; SELECT bounds.it[max].ra FROM NIL => max _ bounds.it[max].i; noRef => IF pureInts THEN max_INT.LAST ELSE GOTO Givup; ENDCASE => GOTO Givup; RETURN [set.Size[] = ISub[max, min].Succ]; EXITS Givup => when _ when }; }; IF NOT pureInts THEN RETURN [FALSE]; {fq: ImplQuality ~ set.QualityOf[$Scan, $fwd]; bq: ImplQuality ~ set.QualityOf[$Scan, $bwd]; bwd: BOOL ~ bq > fq; first: BOOL _ TRUE; last: INT _ 0; IsDenseTest: PROC [val: Value] RETURNS [pass: BOOL] ~ { SELECT val.ra FROM noRef => ERROR; #NIL => pass _ TRUE; ENDCASE => {pass _ IF first THEN first _ FALSE ELSE IF bwd THEN val.i+1 # last ELSE val.i-1 # last; last _ val.i}; }; stopped: BOOL _ set.Scan[IsDenseTest, IF bwd THEN bwd ELSE fwd].found; RETURN [NOT stopped]}}}; DefaultGetBounds: PUBLIC PROC [set: Set, want: EndBools] RETURNS [bounds: MaybeInterval _ [TRUE, fullInterval]] ~ { IF want=ALL[FALSE] THEN RETURN; IF ((NOT want[min]) OR Primitive[set, $GetOne, $FALSE, $fwd]) AND ((NOT want[max]) OR Primitive[set, $GetOne, $FALSE, $bwd]) THEN { IF want[min] THEN {mv: MaybeValue ~ set.AnElt[fwd]; IF NOT mv.found THEN RETURN [[FALSE, []]]; bounds.it[min] _ mv.it}; IF want[max] THEN {mv: MaybeValue ~ set.AnElt[bwd]; IF NOT mv.found THEN {IF want[min] THEN ERROR ELSE RETURN [[FALSE, []]]}; bounds.it[max] _ mv.it}; RETURN}; {space: Space ~ set.SpaceOf[]; fq: ImplQuality ~ set.QualityOf[$Scan, $fwd]; bq: ImplQuality ~ set.QualityOf[$Scan, $bwd]; nq: ImplQuality ~ set.QualityOf[$Scan, $no]; max: ImplQuality ~ QMax[nq, QMax[fq, bq]]; IF fq=max OR bq=max THEN { bwd: BOOL ~ fq < bq; quitEarly: BOOL ~ NOT (IF bwd THEN want[min] ELSE want[max]); first: BOOL _ TRUE; GetBoundsEasyTest: PROC [val: Value] RETURNS [BOOL] ~ { IF first THEN {first _ FALSE; bounds.it[min] _ val}; bounds.it[max] _ val; RETURN [quitEarly]}; [] _ set.Scan[GetBoundsEasyTest, IF bwd THEN bwd ELSE fwd]; IF first THEN RETURN [[FALSE, []]]; IF bwd THEN RETURN [[TRUE, [bounds.it[max], bounds.it[min]]]]; RETURN} ELSE { first: BOOL _ TRUE; GetBoundsHardTest: PROC [val: Value] RETURNS [BOOL] ~ { IF first THEN {first _ FALSE; bounds.it _ [val, val]} ELSE { IF want[min] THEN bounds.it[min] _ space.SMin[bounds.it[min], val]; IF want[max] THEN bounds.it[max] _ space.SMax[bounds.it[max], val]}; RETURN [FALSE]}; IF set.Scan[GetBoundsHardTest].found THEN ERROR; IF first THEN RETURN [[FALSE, []]]; RETURN}; }}; GetIntBounds: PUBLIC PROC [set: Set, want: EndBools _ []] RETURNS [IntInterval] ~ { mi: MaybeInterval ~ set.GetBounds[want]; IF NOT mi.found THEN RETURN [IntStuff.anEmptyInterval]; RETURN IIntify[mi.it]}; DefaultCopy: PROC [set: Set] RETURNS [VarSet] ~ {set.Cant[]}; DefaultValueOf: PROC [set: Set] RETURNS [ConstSet] ~ {IF set.MutabilityOf#constant THEN RETURN set.Copy.Freeze[] ELSE RETURN set.AsConst[]}; DefaultFreeze: PROC [set: Set] RETURNS [ConstSet] ~ { IF set.MutabilityOf#variable THEN set.Complain[notVariable] ELSE set.Cant[]; ERROR}; DefaultThaw: PROC [set: Set] ~ { IF set.MutabilityOf#variable THEN set.Complain[notVariable] ELSE set.Cant[]}; NAddElt: PUBLIC PROC [set: Set, elt: Value] RETURNS [new: BOOL] ~ {RETURN set.AddElt[elt]}; DefaultAddSet: PROC [set, other: Set] RETURNS [new: SomeAll _ []] ~ { IF set.MutabilityOf#variable THEN set.Complain[notVariable] ELSE set.Cant[]}; DefaultRemSet: PROC [set, other: Set] RETURNS [had: SomeAll _ []] ~ { IF set.MutabilityOf#variable THEN set.Complain[notVariable] ELSE set.Cant[]}; DefaultQuaIntInterval: PUBLIC PROC [set: Set] RETURNS [MaybeIntInterval] ~ { space: Space ~ set.SpaceOf[]; pureInts: BOOL ~ space = ints; min: INT _ INT.LAST; max: INT _ INT.FIRST; IF NOT pureInts THEN RETURN [[FALSE, []]]; IF set.GoodImpl[$GetBounds] THEN { bounds: MaybeInterval ~ set.GetBounds[]; IF NOT bounds.found THEN RETURN [[TRUE, anEmptyInterval]]; SELECT bounds.it[min].ra FROM NIL => min _ bounds.it[min].i; noRef => IF pureInts THEN min_INT.FIRST ELSE GOTO Givup; ENDCASE => GOTO Givup; SELECT bounds.it[max].ra FROM NIL => max _ bounds.it[max].i; noRef => IF pureInts THEN max_INT.LAST ELSE GOTO Givup; ENDCASE => GOTO Givup; IF min=max OR (max>INT.FIRST AND min=max-1) OR (Primitive[set, $Size] AND set.Size[] = ISub[max, min].Succ) OR set.IsDense[now] THEN RETURN [[TRUE, [min, max]]]; EXITS Givup => min _ min }; {n: EINT _ zero; Per: PROC [v: Value] RETURNS [BOOL] ~ { SELECT v.ra FROM NIL => { min _ MIN[min, v.i]; max _ MAX[max, v.i]; TRUSTED {n _ n.Succ}}; ENDCASE => RETURN [TRUE]; RETURN [FALSE]}; IF set.Scan[Per].found THEN RETURN [[FALSE, []]]; RETURN [[n = ISub[max, min].Succ, [min, max]]]}}; Equal: PUBLIC PROC [a, b: Set] RETURNS [BOOL] ~ { space: Space ~ a.SpaceOf[]; LookInA: PROC [v: Value] RETURNS [BOOL] ~ {RETURN [NOT a.HasMember[v]]}; IF space # b.SpaceOf[] THEN ERROR Cant[a]; IF a.Size[] # b.Size[] THEN RETURN [FALSE]; RETURN [NOT b.Scan[LookInA].found]}; Hash: PUBLIC PROC [set: Set] RETURNS [hash: CARDINAL _ 0] ~ { space: Space ~ set.SpaceOf[]; Per: PROC [v: Value] RETURNS [BOOL] ~ { hash _ hash + space.SHash[v]; RETURN [FALSE]}; [] _ set.Scan[Per]; RETURN}; Compare: PUBLIC PROC [a, b: Set] RETURNS [c: Comparison _ equal] ~ { space: Space ~ a.SpaceOf[]; CompareTest: PROC [a, b: MaybeValue] RETURNS [BOOL] ~ { IF a.found < b.found THEN {c _ less; RETURN [TRUE]}; IF a.found > b.found THEN {c _ greater; RETURN [TRUE]}; c _ space.SCompare[a.it, b.it]; RETURN [c#equal]}; IF space # b.SpaceOf[] THEN ERROR Cant[a]; [] _ ParallelScan[a, b, CompareTest, fwd, fwd]; RETURN}; CreateSetSpace: PUBLIC PROC [eltSpace: Space] RETURNS [Space] ~ { RETURN [NEW [SpacePrivate _ [Contains: SetsContains, Equal: SetsEqual, Hash: SetsHash, Compare: SetsCompare, Print: SetsPrint, name: Rope.Cat["sets of ", eltSpace.name], data: eltSpace]]]}; QuaSetSpace: PUBLIC PROC [ss: Space] RETURNS [found: BOOL, eltSpace: Space] ~ { IF ss.Compare = SetsCompare THEN RETURN [TRUE, NARROW[ss.data]]; RETURN [FALSE, NIL]}; SetsContains: PROC [data: REF ANY, v: Value] RETURNS [BOOL] ~ { es: Space ~ NARROW[data]; IF v.i#0 THEN RETURN [FALSE]; RETURN [WITH v.ra SELECT FROM rs: RefSet => rs^.SpaceOf[]=es, ENDCASE => FALSE]}; SetsHash: PROC [data: REF ANY, v: Value] RETURNS [CARDINAL] ~ { es: Space ~ NARROW[data]; s: RefSet ~ NARROW[v.VA]; IF s^.SpaceOf[]#es THEN ERROR; RETURN s^.Hash}; SetsEqual: PROC [data: REF ANY, v1, v2: Value] RETURNS [BOOL] ~ { es: Space ~ NARROW[data]; s1: RefSet ~ NARROW[v1.VA]; s2: RefSet ~ NARROW[v2.VA]; IF s1^.SpaceOf[]#es THEN ERROR; IF s2^.SpaceOf[]#es THEN ERROR; RETURN s1^.Equal[s2^]}; SetsCompare: PROC [data: REF ANY, v1, v2: Value] RETURNS [Comparison] ~ { es: Space ~ NARROW[data]; s1: RefSet ~ NARROW[v1.VA]; s2: RefSet ~ NARROW[v2.VA]; IF s1^.SpaceOf[]#es THEN ERROR; IF s2^.SpaceOf[]#es THEN ERROR; RETURN s1^.Compare[s2^]}; SetsPrint: PROC [data: REF ANY, v: Value, to: IO.STREAM, depth, length: INT, verbose: BOOL] ~ { set: RefSet ~ NARROW[v.VA]; set^.PrintSet[to, depth, length, verbose]; RETURN}; FormatSet: PUBLIC PROC [set: Set, depth: INT _ 4, length: INT _ 32, verbose: BOOL _ FALSE] RETURNS [ROPE] ~ { out: IO.STREAM ~ IO.ROS[]; set.PrintSet[out, depth, length, verbose]; RETURN [out.RopeFromROS[]]}; AcceptAny: PUBLIC PROC [Value] RETURNS [BOOL] ~ {RETURN [TRUE]}; ToBool: PUBLIC PROC [arg: REF ANY, default: BOOL _ FALSE] RETURNS [BOOL] ~ { RETURN [SELECT arg FROM NIL => default, $FALSE => FALSE, $TRUE => TRUE, ENDCASE => ERROR]}; FromBool: PUBLIC PROC [b: BOOL] RETURNS [ATOM] ~ { RETURN [IF b THEN $TRUE ELSE $FALSE]}; roAtoms: ARRAY RelOrder OF ATOM ~ [no: $no, fwd: $fwd, bwd: $bwd]; ToRO: PUBLIC PROC [arg: REF ANY, default: RelOrder _ no] RETURNS [RelOrder] ~ { RETURN [SELECT arg FROM NIL => default, $no => no, $fwd => fwd, $bwd => bwd, ENDCASE => ERROR]}; FromRO: PUBLIC PROC [ro: RelOrder] RETURNS [ATOM] ~ { RETURN [roAtoms[ro]]}; refZero: RefEINT ~ NEW [EINT _ zero]; refOne: RefEINT ~ NEW [EINT _ one]; refTwo: PUBLIC RefEINT ~ NEW [EINT _ two]; refLastEINT: PUBLIC RefEINT ~ NEW [EINT _ lastEINT]; refNilSet: PUBLIC RefSet ~ NEW [Set _ nilSet]; ToEI: PUBLIC PROC [arg: REF ANY, default: RefEINT _ refLastEINT] RETURNS [RefEINT] ~ { IF arg=NIL THEN RETURN [default]; RETURN [WITH arg SELECT FROM x: RefEINT => x, ENDCASE => ERROR]}; FromEI: PUBLIC PROC [i: EINT] RETURNS [RefEINT] ~ { RETURN [SELECT i FROM zero => refZero, one => refOne, two => refTwo, lastEINT => refLastEINT, ENDCASE => NEW [EINT _ i] ]}; ToSet: PUBLIC PROC [arg: REF ANY, default: RefSet _ refNilSet] RETURNS [RefSet] ~ { RETURN [IF arg=NIL THEN default ELSE WITH arg SELECT FROM x: RefSet => x, ENDCASE => ERROR]}; ToTB: PUBLIC PROC [arg: REF ANY, default: TripleBool _ []] RETURNS [TripleBool] ~ { IF arg=NIL THEN RETURN [default]; SELECT arg FROM tbAtoms[FALSE][FALSE][FALSE] => RETURN [[FALSE, FALSE, FALSE]]; tbAtoms[FALSE][FALSE][TRUE] => RETURN [[FALSE, FALSE, TRUE]]; tbAtoms[FALSE][TRUE][FALSE] => RETURN [[FALSE, TRUE, FALSE]]; tbAtoms[FALSE][TRUE][TRUE] => RETURN [[FALSE, TRUE, TRUE]]; tbAtoms[TRUE][FALSE][FALSE] => RETURN [[TRUE, FALSE, FALSE]]; tbAtoms[TRUE][FALSE][TRUE] => RETURN [[TRUE, FALSE, TRUE]]; tbAtoms[TRUE][TRUE][FALSE] => RETURN [[TRUE, TRUE, FALSE]]; tbAtoms[TRUE][TRUE][TRUE] => RETURN [[TRUE, TRUE, TRUE]]; ENDCASE => ERROR; }; tbAtoms: ARRAY BOOL OF ARRAY BOOL OF ARRAY BOOL OF ATOM ~ [ [[$FFF, $FFT], [$FTF, $FTT]], [[$TFF, $TFT], [$TTF, $TTT]]]; FromTB: PUBLIC PROC [tb: TripleBool] RETURNS [ATOM] ~ { RETURN [tbAtoms[tb.prev][tb.same][tb.next]]}; ebCode: ARRAY --min--BOOL OF ARRAY --max--BOOL OF ATOM ~ [[$None, $Max], [$Min, $Both]]; ToEB: PUBLIC PROC [arg: REF ANY, default: EndBools _ ALL[TRUE]] RETURNS [EndBools] ~ { RETURN [SELECT arg FROM NIL => default, $Both => ALL[TRUE], $Min => [TRUE, FALSE], $Max => [FALSE, TRUE], $None => ALL[FALSE], ENDCASE => ERROR]}; FromEB: PUBLIC PROC [eb: EndBools] RETURNS [ATOM] ~ {RETURN [ebCode[eb[min]][eb[max]]]}; ToInterval: PUBLIC PROC [arg: REF ANY, default: RefInterval _ refFullInterval] RETURNS [RefInterval] ~ { IF arg=NIL THEN RETURN [default]; RETURN [WITH arg SELECT FROM x: RefInterval => x, ENDCASE => ERROR]}; FromInterval: PUBLIC PROC [x: Interval] RETURNS [RefInterval] ~ {RETURN [SELECT x FROM [] => refFullInterval, [min: [i: INT.FIRST], max: [i: INT.LAST]] => refAllInts, ENDCASE => NEW [Interval _ x] ]}; ToWhen: PUBLIC PROC [arg: REF ANY, default: When _ always] RETURNS [When] ~ { RETURN [SELECT arg FROM NIL => default, $now => now, $always => always, ENDCASE => ERROR]}; UpdateSetClassOther: PUBLIC PROC [class: SetClass, Update: PROC [Atom.PropList] RETURNS [Atom.PropList]] ~ { WithLock: ENTRY PROC [lp: LockPtr] ~ { ENABLE UNWIND => NULL; class.other _ Update[class.other]; RETURN}; TRUSTED {WithLock[@class.LOCK]}; RETURN}; Start: PROC ~ { Atom.PutProp[prop: kindKey, val: $composite, atom: $Enumerate]; Atom.PutProp[prop: kindKey, val: $composite, atom: $AnElt]; Atom.PutProp[prop: kindKey, val: $composite, atom: $Pop]; Atom.PutProp[prop: kindKey, val: $composite, atom: $First]; Atom.PutProp[prop: kindKey, val: $composite, atom: $Last]; 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: $QuickSize]; Atom.PutProp[prop: kindKey, val: $composite, atom: $AddElt]; Atom.PutProp[prop: kindKey, val: $composite, atom: $RemElt]; Atom.PutProp[prop: kindKey, val: $composite, atom: $Erase]; Atom.PutProp[prop: kindKey, val: $composite, atom: $GetIntBounds]; Atom.PutProp[prop: kindKey, val: $class , atom: $HasMember]; Atom.PutProp[prop: kindKey, val: $classO , atom: $Scan]; Atom.PutProp[prop: kindKey, val: $class , atom: $TheElt]; Atom.PutProp[prop: kindKey, val: $classRO, atom: $GetOne]; Atom.PutProp[prop: kindKey, val: $classW3, atom: $Get3]; Atom.PutProp[prop: kindKey, val: $classL , atom: $Size]; Atom.PutProp[prop: kindKey, val: $classW , atom: $IsDense]; Atom.PutProp[prop: kindKey, val: $classW2, atom: $GetBounds]; 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: $AddSet]; Atom.PutProp[prop: kindKey, val: $classS , atom: $RemSet]; Atom.PutProp[prop: kindKey, val: $class , atom: $QuaBiRel]; Atom.PutProp[prop: kindKey, val: $class , atom: $QuaIntInterval]; Atom.PutProp[prop: kindKey, val: $classA , atom: $SpaceOf]; }; Start[]; END. <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <>