DIRECTORY AbSets, BiRelBasics, BiRels, IntStuff, List, SetBasics; BiRelsIndirect: CEDAR PROGRAM IMPORTS AbSets, BiRels, IntStuff, List, SetBasics EXPORTS BiRels = BEGIN OPEN IntStuff, SetBasics, Sets:AbSets, Sets, BiRelBasics, BiRels; classes1: Function--spaces[left] _ (spaces[right] _ Classes)-- ~ BiRels.CreateHashFn[spaces: [spaceSpace, refs], invable: FALSE]; Classes: TYPE ~ ARRAY --constant--BOOL OF ARRAY --oneToOne--BOOL OF BiRelClass; FnFromProc: PUBLIC PROC [ Apply: PROC [data: REF ANY, v: Value] RETURNS [mv: MaybeValue], spaces: SpacePair _ [basic, basic], data: REF ANY _ NIL, constant, oneToOne: BOOL _ FALSE, ScanInverse: PROC [data: REF ANY, v: Value, Test: Tester] RETURNS [MaybePair] _ NIL ] RETURNS [Function] ~ { classes2: Function--spaces[right] _ Classes-- _ BiRels.DeRef[classes1.ApplyA[spaces[left]].MDA]; IF classes2 = nilBiRel THEN { classes2 _ BiRels.CreateHashFn[spaces: [spaceSpace, refs], invable: FALSE]; classes1.AddNewAA[spaces[left], classes2.Refify]}; {classes3: REF Classes _ NARROW[classes2.ApplyA[spaces[right]].MDA]; IF classes3=NIL THEN { classes3 _ NEW [Classes]; FOR constant: BOOL IN BOOL DO FOR oneToOne: BOOL IN BOOL DO classes3[constant][oneToOne] _ CreateClass[[Apply: PFApply, Spaces: PFSpaces, functional: [TRUE, FALSE], mutability: readonly]]; ENDLOOP ENDLOOP; classes2.AddNewAA[spaces[right], classes3]}; RETURN [[ classes3[constant][oneToOne], NEW [ProcFnPrivate _ [spaces, Apply, ScanInverse, data]] ]]}}; 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 ]; PFApply: PROC [br: BiRel, v: Value, dir: Direction] RETURNS [MaybeValue] ~ { pf: ProcFn ~ NARROW[br.data]; IF dir#leftToRight THEN RETURN DefaultApply[br, v, dir]; RETURN pf.Apply[pf.data, v]}; PFSpaces: PROC [br: BiRel] RETURNS [SpacePair] ~ { pf: ProcFn ~ NARROW[br.data]; RETURN [pf.spaces]}; EnumSeqOfSet: PUBLIC PROC [set: Set, ro: Sets.RelOrder _ no] RETURNS [Sequence] ~ { es: EnumSeq ~ NEW [EnumSeqPrivate _ [set, ro]]; RETURN [[esClasses[set.MutabilityOf[]=constant], es]]}; esClasses: REF ESClasses ~ NEW [ESClasses]; ESClasses: TYPE ~ ARRAY --const--BOOL OF BiRelClass; EnumSeq: TYPE ~ REF EnumSeqPrivate; EnumSeqPrivate: TYPE ~ RECORD [set: Set, ro: Sets.RelOrder]; ESPrimitive: PROC [br: BiRel, op: ATOM, arg1, arg2: REF ANY] RETURNS [PrimitiveAnswer] ~ { es: EnumSeq ~ NARROW[br.data]; SELECT op FROM $ScanRestriction => {sets: RefSetPair ~ ToSets[arg1]; IF sets^#ALL[nilSet] THEN RETURN [no]; {ro: RelOrder ~ ToRO[arg2]; roc: ROChoice ~ ChooseRO[ro, es.ro]; RETURN [IF roc.ok AND es.set.GoodImpl[$Scan] THEN yes ELSE no]}}; $GetBounds => RETURN [IF es.ro#no AND es.set.GoodImpl[$Scan] THEN yes ELSE no]; $ValueOf => RETURN [IF es.set.GoodImpl[op] THEN yes ELSE no]; $SetOn => RETURN [IF es.set.Can[$Size] THEN yes ELSE no]; ENDCASE => RETURN [pass]}; ROChoice: TYPE ~ RECORD [sro: Sets.RelOrder, ok, rev: BOOL]; ChooseRO: PROC [ro: RelOrder, esro: Sets.RelOrder] RETURNS [ROChoice] ~ { SELECT ro.first FROM left => SELECT ro.sub[left] FROM fwd => RETURN [[esro, TRUE, FALSE]]; bwd => RETURN [[esro.ReverseRO, esro#no, TRUE]]; no => RETURN [[esro, TRUE, FALSE]]; ENDCASE => ERROR; right => SELECT ro.sub[right] FROM fwd => RETURN [[fwd, esro#no, esro#fwd]]; bwd => RETURN [[bwd, esro#no, esro#bwd]]; no => RETURN [[esro, TRUE, FALSE]]; ENDCASE => ERROR; ENDCASE => ERROR}; ESScanRestriction: PROC [br: BiRel, sets: SetPair, Test: Tester, ro: RelOrder] RETURNS [mp: MaybePair _ noMaybePair] ~ { IF sets#ALL[nilSet] THEN RETURN br.DefaultScanRestriction[sets, Test, ro]; {es: EnumSeq ~ NARROW[br.data]; roc: ROChoice ~ ChooseRO[ro, es.ro]; i: LNAT _ 0; Pass: PROC [right: Value] RETURNS [BOOL] ~ { IF Test[[[i[i]], right]] THEN RETURN [(mp _ [TRUE, [[i[i]], right]]).found]; i _ IF roc.rev THEN i-1 ELSE i+1; RETURN [FALSE]}; IF NOT roc.ok THEN RETURN DefaultScanRestriction[br, sets, Test, ro]; IF roc.rev THEN i _ es.set.Size.Pred.EN; [] _ es.set.Scan[Pass, roc.sro]; RETURN}}; ESGetBounds: PROC [br: BiRel, want: EndBools, ro: RelOrder] RETURNS [MaybePairInterval] ~ { es: EnumSeq ~ NARROW[br.data]; IF es.set.Empty THEN RETURN [[FALSE, []]]; IF es.ro=no THEN RETURN DefaultGetBounds[br, want, ro]; RETURN [[TRUE, [ min: [[i[0]], es.set.AnElt[es.ro].it], max: [[i[es.set.Size.Pred.EN]], es.set.AnElt[es.ro.ReverseRO].it] ]]]; }; ESValueOf: PROC [br: BiRel] RETURNS [ConstBiRel] ~ { es: EnumSeq ~ NARROW[br.data]; RETURN EnumSeqOfSet[es.set.ValueOf, es.ro].AsConst}; ESSetOn: PROC [br: BiRel, side: Side] RETURNS [UWSet] ~ { es: EnumSeq ~ NARROW[br.data]; SELECT side FROM left => RETURN [IIAsSet[[0, es.set.Size.Pred.EN]]]; right => RETURN [es.set.Insulate]; ENDCASE => ERROR}; ESSpaces: PROC [br: BiRel] RETURNS [SpacePair] ~ { es: EnumSeq ~ NARROW[br.data]; RETURN [[ints, es.set.SpaceOf]]}; GradeUp: PUBLIC PROC [a: IntFn, o: SetBasics.Order] RETURNS [p: Permutation] ~ { indices: LORA _ NIL; i: INT _ 0; AddIndex: PROC [pair: Pair] ~ {indices _ CONS[NEW[INT _ pair[left].VI], indices]}; Compare: PROC[ref1, ref2: REF ANY] RETURNS [c: Basics.Comparison] ~ { i1: REF INT ~ NARROW[ref1]; i2: REF INT ~ NARROW[ref2]; RETURN o.Compare[o.data, a.ApplyI[i1^].Val, a.ApplyI[i2^].Val]}; a.Enumerate[AddIndex]; indices _ List.Sort[indices, Compare]; p _ CreateSimple[oneToOne: TRUE, dense: TRUE, rightSpace: ints]; FOR inds: LORA _ indices, inds.rest WHILE inds#NIL DO p.AddNewPair[[[i[i]], [i[NARROW[inds.first, REF INT]^]]]]; i _ i + 1; ENDLOOP; p _ p.Freeze; RETURN}; TransPermute: PUBLIC PROC [from, to: IntFn, p: Permutation] ~ { PerPair: PROC [pair: Pair] ~ { old: INT ~ pair[right].VI; mv: MaybeValue ~ from.ApplyI[old]; IF mv.found THEN [] _ to.AddPair[[pair[left], mv.it]] ELSE [] _ to.Delete[pair[left]]; RETURN}; p.Enumerate[PerPair]; RETURN}; PermuteInPlace: PUBLIC PROC [a: Sequence, p: Permutation] ~ { done: Set--INT-- ~ CreateHashSet[ints]; PerPair: PROC [pair: Pair] ~ { startToI: INT ~ pair[left].VI; fromI: INT _ pair[right].VI; IF fromI = startToI THEN RETURN; IF done.HasMemI[fromI] THEN RETURN; {startMV: MaybeValue ~ a.ApplyI[startToI]; toI: INT _ startToI; UNTIL fromI = startToI DO moveMV: MaybeValue ~ a.ApplyI[fromI]; IF NOT done.AddI[fromI] THEN ERROR; IF moveMV.found THEN [] _ a.AddPair[[[i[toI]], moveMV.it]] ELSE [] _ a.DeleteI[toI]; toI _ fromI; fromI _ p.ApplyI[toI].MI; ENDLOOP; IF NOT done.AddI[fromI] THEN ERROR; IF startMV.found THEN [] _ a.AddPair[[[i[toI]], startMV.it]] ELSE [] _ a.DeleteI[toI]; RETURN}}; p.Enumerate[PerPair]; RETURN}; Start: PROC ~ { FOR const: BOOL IN BOOL DO esClasses[const] _ CreateClass[[ Primitive: ESPrimitive, ScanRestriction: ESScanRestriction, GetBounds: ESGetBounds, ValueOf: ESValueOf, SetOn: ESSetOn, Spaces: ESSpaces, functional: ALL[TRUE], mutability: IF const THEN constant ELSE readonly]]; ENDLOOP; }; Start[]; END. ^BiRelsIndirect.Mesa Last tweaked by Mike Spreitzer on December 14, 1987 1:15:37 pm PST ‌ت – "cedar" styleکcode™KڑœB™B—KکKڑدk œ8کAKکڑدnœ‌œ‌کKڑ‌œ*ک1Kڑ‌œکKک—KکKڑ‌œ‌œ‍œ#کGKکKڑ œدcذcmں ںœ<‌œکپKکKڑœ ‌œ‌œں‌œ‌œ‌œں‌œ‌œکOKکڑ‍ œ‌œ‌کڑœکKڑ ‍œ‌œ‌œ‌œ‌œک?Kڑœ#ک#Kڑœ‌œ‌œ‌œکKڑœ‌œ‌œک!Kڑ ‍œ‌œ‌œ‌œ‍œ ‌œ‌کSKڑœک—Kڑ‌œکKڑœں ں œ.‌œک`ڑ‌œ‌œکKڑœD‌œکKKڑœ2ک2—Kڑœ‌œ‌œ ‌œکDڑ‌œ ‌œ‌œکKڑœ‌œکڑ‌œ‌œ‌œ‌œ‌œ‌œ‌œ‌œ‌œ‌ک;Kڑ œ,‍œ‍œ‌œ‌œک€Kڑ‌œ‌œک—Kڑœ,ک,—ڑ‌œک KڑœکKڑ‌œ5ک8Kک——KکKڑœ‌œ‌œک!ڑœ‌œ‌œکKڑœکKڑ ‍œ‌œ‌œ‌œ‌œک?Kڑ‍œ‌œ‌œ‌œ‍œ ‌œ کNKڑœ‌œ‌ک Kک—Kکڑ‍œ‌œ'‌œکLKڑœ ‌œ کKڑ‌œ‌œ‌œک8Kڑ‌œک—Kکڑ‍œ‌œ ‌œک2Kڑœ ‌œ کKڑ‌œک—Kکڑ‍œ‌œ‌œ$‌œکSKڑœ‌œک/Kڑ‌œ1ک7—KکKڑœ‌œ ‌œ ک+Kڑ œ‌œ‌œں ‌œ‌œک5KکKڑœ ‌œ‌œک#Kڑœ‌œ‌œک