<<[Indigo]®>Rosemary.DF=>RoseCreateImplA.Mesa>> <> DIRECTORY Asserting, Basics, BitTwiddling, Convert, IO, OrderedSymbolTableRef, PrincOps, PrincOpsUtils, Rope, RoseCreate, RoseRun, RoseTypes; RoseCreateImplA: CEDAR PROGRAM IMPORTS Asserting, BitTwiddling, Convert, IO, OSTR: OrderedSymbolTableRef, PrincOpsUtils, Rope, RoseCreate, RoseRun, RoseTypes EXPORTS RoseCreate = BEGIN OPEN RoseCreate, RoseTypes; roots: PUBLIC SymbolTable _ OSTR.CreateTable[CompareComponents]; bogosityKey: ATOM = $bogosityKey; survey: ERClass _ NEW [ERClassRep _ [ CellInstance: SurveyCellInstance, NodeInstance: NodeInstance, Equivalence: Equivalence ]]; CreateTopCell: PUBLIC PROC [instanceName, typeName: ROPE, decider: ExpandDeciderClosure, sim: Simulation] = BEGIN bbTableSpace: PrincOps.BBTableSpace; bbTable: PrincOps.BitBltTablePtr; Optimize: PROC [item: REF ANY] RETURNS [stop: BOOL] = { cell: Cell _ NARROW[item]; stop _ FALSE; SELECT cell.expansion FROM Expand => { cell.internalNodes.EnumerateIncreasing[OptimizePieces]; cell.components.EnumerateIncreasing[Optimize]; }; Leaf => NULL; ENDCASE => ERROR; }; FinishLinkingCell: PROC [item: REF ANY] RETURNS [stop: BOOL] = { cell: Cell _ NARROW[item]; type: CellType _ cell.type; stop _ FALSE; SELECT cell.expansion FROM Expand => { cell.components.EnumerateIncreasing[FinishLinkingCell]; }; Leaf => { drive: Drive _ cell.realCellStuff.newDrive; [cell.realCellStuff.effectivePorts, cell.realCellStuff.implNodes, cell.realCellStuff.hasTransducedPort] _ EffectiveInterface[cell]; IF cell.type.ioCreator # NIL THEN { IF cell.type.hasASwitchPort OR cell.realCellStuff.hasTransducedPort THEN cell.realCellStuff.switchIO _ type.ioCreator[ct: cell.type, switch: TRUE]; }; cell.realCellStuff.switchIOAsWP _ LOOPHOLE[cell.realCellStuff.switchIO]; FOR epi: EffectivePortIndex IN [0 .. cell.realCellStuff.effectivePorts.length) DO ep: EffectivePort _ cell.realCellStuff.effectivePorts[epi]; targType: NodeType _ ep.implType; node: Node _ cell.realCellStuff.implNodes[epi]; portPtr: Ptr _ SlotToPtr[[cell, epi], NOT targType.simple]; IF targType.procs.InitPort # NIL THEN targType.procs.InitPort[node, portPtr]; BitTwiddling.Copy[from: node.valPtr, to: portPtr, bitCount: node.bitCount, bbTable: bbTable]; IF TransduceNeeded[ep.type, ep.implType] THEN { modelPtr: Ptr _ SlotToPtr[[cell, epi], NOT ep.type.simple]; targType.procs.Transduce[ fromS: FIRST[Strength], fromT: targType, toT: ep.type, fromP: portPtr, toP: modelPtr]; targType.procs.Transduce[ fromS: drive.drives[ep.containingPort], fromT: ep.type, toT: targType, fromP: modelPtr, toP: portPtr]; }; ENDLOOP; IF type.initializer # NIL THEN type.initializer[cell: cell]; FOR epi: EffectivePortIndex IN [0 .. cell.realCellStuff.effectivePorts.length) DO ep: EffectivePort _ cell.realCellStuff.effectivePorts[epi]; node: Node _ cell.realCellStuff.implNodes[epi]; SELECT node.type.simple FROM FALSE => node.switchConnections _ CONS[[cell, epi], node.switchConnections]; TRUE => StrengthLink[node, drive.drives[ep.containingPort], [cell, epi]]; ENDCASE => ERROR; ENDLOOP; }; ENDCASE => ERROR; }; type: CellType; TRUSTED {bbTable _ PrincOpsUtils.AlignedBBTable[@bbTableSpace]}; type _ GetCellType[typeName]; IF type = NIL THEN ERROR Error[IO.PutFR["No such type: %g", IO.rope[typeName]]]; sim.root _ NEW [CellRep _ [ name: instanceName, type: type, sim: sim, parent: NIL, leftChild: NIL, rightSibling: NIL, firstInternalNode: NIL, internalNodes: OSTR.CreateTable[CompareNodes], components: OSTR.CreateTable[CompareComponents], interfaceNodes: NEW [NodeSR[0]], other: Asserting.AssertFn1[$ExpandDeciderClosure, decider, NIL], substantiality: Shadow, expansion: Expand, realCellStuff: NIL]]; sim.str _ NEW [StructureRep _ [root: sim.root, sim: sim]]; FinishSurveyingCell[sim.root, NIL]; [] _ Optimize[sim.root]; [] _ FinishLinkingCell[sim.root]; FOR in: Node _ sim.str.firstImplNode, in.implNext WHILE in # NIL DO SELECT in.type.simple FROM FALSE => RoseRun.PerturbNode[in, nilSlot]; TRUE => RoseRun.UpdateCurrent[in, bbTable, nilSlot]; ENDCASE => ERROR; ENDLOOP; END; StrengthLink: PROC [node: Node, str: Strength, slot: Slot] = { next: Slot _ node.byStrength[str].first; slot.cell.realCellStuff.effectivePorts[slot.effectivePortIndex].strengthPrev _ head; slot.cell.realCellStuff.effectivePorts[slot.effectivePortIndex].strengthNext _ next; node.byStrength[str].first _ slot; IF next = head THEN node.byStrength[str].last _ slot ELSE next.cell.realCellStuff.effectivePorts[next.effectivePortIndex].strengthPrev _ slot; slot.cell.realCellStuff.effectivePorts[slot.effectivePortIndex].curStrength _ str; }; LevelList: TYPE = LIST OF Level; Level: TYPE = RECORD [ s: Selector, pl: PieceList]; OptimizePieces: PROC [item: REF ANY] RETURNS [stop: BOOL] = { n: Node _ NARROW[item]; Optimize: PROC [ll: LevelList] RETURNS [opt: PieceList] = { FOR ll _ ll, ll.rest WHILE ll # NIL AND ll.first.pl = NIL DO NULL ENDLOOP; IF ll = NIL THEN opt _ NIL ELSE { in: Node _ ll.first.pl.first.twardImpl; s: Selector _ Compose[ll.first.s, ll.first.pl.first.reln]; ll.first.pl _ ll.first.pl.rest; IF in.significances[inImpl] THEN { p: Piece _ [n, in, s]; ImplLink[in]; in.parentPieces _ CONS[p, in.parentPieces]; opt _ CONS[p, Optimize[ll]]; } ELSE { IF in.significances[fromDesign] THEN ERROR; IF in.childPieces = NIL THEN ERROR; opt _ Optimize[CONS[[s, in.childPieces], ll]]; }; }; }; stop _ FALSE; IF NOT n.significances[fromDesign] THEN ERROR; SELECT n.significances[inImpl] FROM TRUE => ImplLink[n]; FALSE => n.childPieces _ Optimize[LIST[[[whole[]], n.childPieces]]]; ENDCASE => ERROR; }; ImplLink: PROC [n: Node] = { IF n.implNext = notInNodeList THEN { n.implNext _ n.strIn.firstImplNode; n.strIn.firstImplNode _ n; n.parentPieces _ NIL; }; }; EffectiveInterface: PROC [cell: Cell] RETURNS [effectivePorts: EffectivePorts, implNodes: NodeS, hasTransducedPort: BOOL] = { n: CARDINAL _ 0; hasTransducedPort _ FALSE; FOR pi: PortIndex IN [0 .. cell.type.ports.length) DO node: Node _ cell.interfaceNodes[pi]; IF node.significances[inImpl] THEN n _ n + 1 ELSE { FOR pl: PieceList _ node.childPieces, pl.rest WHILE pl # NIL DO IF NOT pl.first.twardImpl.significances[inImpl] THEN ERROR; n _ n + 1; ENDLOOP; }; ENDLOOP; effectivePorts _ NEW [EffectivePortsRep[n]]; implNodes _ NEW [NodeSR[n]]; n _ 0; FOR pi: PortIndex IN [0 .. cell.type.ports.length) DO node: Node _ cell.interfaceNodes[pi]; port: Port _ cell.type.ports[pi]; children: PieceList _ IF node.childPieces # NIL THEN node.childPieces ELSE LIST[[node, node, [whole[]]]]; firstEffectivePortIndex: EffectivePortIndex _ n; simpleType, switchType: NodeType; simpleField, switchField: Field _ noField; doSimple, doSwitch: BOOL; Able: PROC [simple: BOOL] RETURNS [can: BOOL] = {can _ IF simple THEN doSimple ELSE doSwitch}; [simpleType, switchType] _ BothTypes[port.type]; IF doSimple _ (simpleType # NIL AND port.simple # noField) THEN simpleField _ SubField[port.simple, simpleType.procs.Bits[simpleType].leftPad, simpleType.procs.Bits[simpleType].data]; IF doSwitch _ (switchType # NIL AND port.switch # noField) THEN switchField _ SubField[port.switch, switchType.procs.Bits[switchType].leftPad, switchType.procs.Bits[switchType].data]; IF NOT Able[port.type.simple] THEN ERROR Error[IO.PutFR["No field given for port %g", IO.rope[LongPortName[cell.type, pi]]]]; FOR pl: PieceList _ children, pl.rest WHILE pl # NIL DO implNode: Node _ pl.first.twardImpl; subSimple, subSwitch, subType: NodeType _ NIL; subSimpleField, subSwitchField: Field _ noField; mod: ROPE _ SelectorToRope[pl.first.reln]; subType _ port.type.procs.SubType[port.type, pl.first.reln]; IF doSimple THEN { subSimple _ simpleType.procs.SubType[simpleType, pl.first.reln]; subSimpleField _ SubField[ simpleField, simpleType.procs.SelectorOffset[simpleType, pl.first.reln], subSimple.procs.Bits[subSimple].data]; }; IF doSwitch THEN { subSwitch _ switchType.procs.SubType[switchType, pl.first.reln]; subSwitchField _ SubField[ switchField, switchType.procs.SelectorOffset[switchType, pl.first.reln], subSwitch.procs.Bits[subSwitch].data]; }; IF NOT Able[implNode.type.simple] THEN Error[IO.PutFR["Switch field needed but not given for port %g", IO.rope[LongPortName[c: cell.type, epi: n]]]]; IF NOT Conforming[subType, implNode.type] THEN ERROR --should have been caught in FillInInterfaceNodes--; effectivePorts[n] _ [ simple: subSimpleField, switch: subSwitchField, name: port.name.Cat[mod], type: subType, input: port.input, output: port.output, XPhobic: port.XPhobic, other: port.other, implType: implNode.type, containingPort: pi ]; implNodes[n] _ pl.first.twardImpl; IF TransduceNeeded[subType, implNode.type] THEN hasTransducedPort _ TRUE; n _ n + 1; ENDLOOP; effectivePorts[pi].firstEffectivePortIndex _ firstEffectivePortIndex; ENDLOOP; IF n # implNodes.length THEN ERROR; }; SubField: PROC [f: Field, offset, size: INT] RETURNS [sf: Field] = { bo: INT _ offset + f.bitOffset; wo: INT _ bo / Basics.bitsPerWord; IF offset < 0 OR size < 0 THEN ERROR; IF offset + size > f.bitCount THEN ERROR; sf _ [ wordOffset: f.wordOffset + wo, bitOffset: bo - wo * Basics.bitsPerWord, bitCount: size]; }; SurveyCellInstance: PROC [erInstance: REF ANY, instanceName, typeName, interfaceNodes: ROPE, other: Assertions _ NIL] RETURNS [cell: Cell] = BEGIN within: Cell _ NARROW[erInstance]; type: CellType; type _ GetCellType[typeName]; IF type = NIL THEN ERROR Error[IO.PutFR["No such type: %g", IO.rope[typeName]]]; IF within = NIL THEN ERROR; cell _ NEW [CellRep _ [ name: instanceName, type: type, sim: within.sim, parent: within, leftChild: NIL, rightSibling: NIL, firstInternalNode: NIL, internalNodes: OSTR.CreateTable[CompareNodes], components: OSTR.CreateTable[CompareComponents], interfaceNodes: NEW [NodeSR[type.ports.length]], other: other, substantiality: Shadow, expansion: Expand, realCellStuff: NIL]]; FinishSurveyingCell[cell, interfaceNodes]; END; FinishSurveyingCell: PROC [cell: Cell, interfaceNodes: ROPE] = BEGIN type: CellType _ cell.type; thisChild, lastChild: Cell; thisNode, lastNode: Node; IF cell.parent = NIL THEN { IF type.ports.length > 0 THEN ERROR Error["Can't make root with non-empty interface", cell]; } ELSE { cell.parent.components.Insert[cell !OSTR.DuplicateKey => ERROR Error[IO.PutFR["Duplicated Cell name: %g", IO.rope[cell.name]]]]; <> cell.rightSibling _ cell.parent.leftChild; cell.parent.leftChild _ cell; }; FillInInterfaceNodes[cell, interfaceNodes]; cell.expansion _ FindAndUseExpandDecider[cell]; SELECT cell.expansion FROM Expand => BEGIN cell.substantiality _ Shadow; cell.realCellStuff _ NIL; type.expand[thisCell: cell, to: [cell, survey]]; END; Leaf => BEGIN cell.substantiality _ Real; cell.realCellStuff _ NEW [RealCellStuffRep _ [ effectivePorts: NIL, implNodes: NIL, schedNext: notInCellList, nextNeeded: notInCellList, nextNoted: notInCellList, newIO: NIL, oldIO: NIL, switchIO: NIL, newDriveAsAny: NIL, oldDriveAsAny: NIL, newIOAsWP: NIL, oldIOAsWP: NIL, switchIOAsWP: NIL, newDrive: NIL, oldDrive: NIL, state: NIL, evals: type.evals]]; FOR portIndex: PortIndex IN [0..type.ports.length) DO NoteConnection[ cell.interfaceNodes[portIndex], cell.type.ports[portIndex].type, cell.type.ports[portIndex].XPhobic]; ENDLOOP; IF type.ioCreator # NIL THEN { cell.realCellStuff.newIO _ type.ioCreator[ct: type, switch: FALSE]; cell.realCellStuff.oldIO _ type.ioCreator[ct: type, switch: FALSE]; cell.realCellStuff.newDriveAsAny _ type.driveCreator[ct: type]; cell.realCellStuff.oldDriveAsAny _ type.driveCreator[ct: type]; } ELSE IF type.simpleWordCount > 0 OR type.switchWordCount > 0 THEN ERROR Error[IO.PutFR["No IOCreator for type %g", IO.rope[type.name]]]; cell.realCellStuff.newIOAsWP _ LOOPHOLE[cell.realCellStuff.newIO]; cell.realCellStuff.oldIOAsWP _ LOOPHOLE[cell.realCellStuff.oldIO]; TRUSTED { cell.realCellStuff.newDrive _ LOOPHOLE[cell.realCellStuff.newDriveAsAny]; cell.realCellStuff.oldDrive _ LOOPHOLE[cell.realCellStuff.oldDriveAsAny]; }; FOR portIndex: PortIndex IN [0..type.ports.length) DO port: Port _ cell.type.ports[portIndex]; IF port.type.simple THEN cell.realCellStuff.newDrive.drives[portIndex] _ IF port.input THEN ignore ELSE drive; ENDLOOP; END; ENDCASE => ERROR; cell.nextInstance _ type.firstInstance; type.firstInstance _ cell; lastChild _ NIL; thisChild _ cell.leftChild; WHILE thisChild # NIL DO nextChild: Cell _ thisChild.rightSibling; thisChild.rightSibling _ lastChild; lastChild _ thisChild; thisChild _ nextChild; ENDLOOP; cell.leftChild _ lastChild; lastNode _ NIL; thisNode _ cell.firstInternalNode; WHILE thisNode # NIL DO nextNode: Node _ thisNode.designNext; thisNode.designNext _ lastNode; lastNode _ thisNode; thisNode _ nextNode; ENDLOOP; cell.firstInternalNode _ lastNode; IF cell.parent = NIL THEN roots.Insert[cell !OSTR.DuplicateKey => ERROR Error[IO.PutFR["Duplicated Root name: %g", IO.rope[cell.name]]]] ELSE IF cell.substantiality = Real THEN RoseRun.ScheduleCell[cell]; END; NumberOfExpandDecisions: INTEGER = (ORD[LAST[ExpandDecision]] - ORD[FIRST[ExpandDecision]]) + 1; FindAndUseExpandDecider: PROC [cell: Cell] RETURNS [ExpandDecision] = BEGIN ed: ExpandDecision; possibilities: [0 .. NumberOfExpandDecisions]; [ed, possibilities] _ PickOne[cell]; IF possibilities = 1 THEN RETURN [ed]; IF possibilities = 0 THEN ERROR Error[IO.PutFR["Can't do anything with type %g", IO.rope[cell.type.name]]]; FOR temp: Cell _ cell, temp.parent WHILE temp # NIL DO asAny: REF ANY _ Asserting.FnVal[$ExpandDeciderClosure, temp.other]; edc: ExpandDeciderClosure; try: ExpandDecision; IF asAny = NIL THEN LOOP; edc _ NARROW[asAny]; try _ edc.Decide[cell, edc.otherData]; IF Possible[cell, try] THEN RETURN [try]; ENDLOOP; RETURN [ed]; END; PickOne: PROC [cell: Cell] RETURNS [whatToDo: ExpandDecision, possibilities: [0..3]] = BEGIN possibilities _ 0; FOR i: [1..NumberOfExpandDecisions] IN [1..NumberOfExpandDecisions] DO d: ExpandDecision _ orderedChoices[i]; IF Possible[cell, d] THEN {whatToDo _ d; possibilities _ possibilities + 1}; ENDLOOP; END; orderedChoices: ARRAY [1..2] OF ExpandDecision = [Leaf, Expand]; Words: TYPE = REF WordSeq; WordSeq: TYPE = RECORD [words: SEQUENCE length: CARDINAL OF CARDINAL]; NodeInstance: PROC [erInstance: REF ANY, name: ROPE, type: NodeType, initialValue, initialValueFormat: ROPE _ NIL, initData: REF ANY _ NIL, other: Assertions _ NIL] RETURNS [node: Node] = { cellIn: Cell _ NARROW[erInstance]; s: Strength _ charge; xPhobic: BOOL _ NOT Asserting.Test[$XPhillic, NIL, other]; IF NOT xPhobic THEN other _ Asserting.Filter[$XPhillic, other].notAbout; IF Asserting.Test[$XPhobic, NIL, other] THEN { IF NOT xPhobic THEN ERROR Error["Make up your mind"]; other _ Asserting.Filter[$XPhobic, other].notAbout; }; IF initData # NIL THEN WITH initData SELECT FROM rs: REF Strength => s _ rs^; ENDCASE => ERROR; IF initialValue = NIL THEN { IF initialValueFormat # NIL THEN ERROR; initialValueFormat _ "init"; initialValue _ IF cellIn.sim.steady THEN "steady" ELSE "initial"; }; node _ CreateNode[strIn: CellToStr[cellIn], cellIn: cellIn, name: name, type: type, initialValue: initialValue, initialValueFormat: initialValueFormat, strength: s, xPhobic: xPhobic, other: other, significance: fromDesign]; }; CreateNode: PROC [strIn: Structure, cellIn: Cell, name: ROPE, type: NodeType, initialValue, initialValueFormat: ROPE _ NIL, strength: Strength, xPhobic: BOOL, other: Assertions _ NIL, significance: NodeSignificance, parent: Node _ NIL, reln: Selector _ [whole[]]] RETURNS [node: Node] = BEGIN ctnBits, dataBits, leftPad, ctnWords: NAT; val: Words; sigs: NodeSignificances _ implOnly; [ctnBits, dataBits, leftPad] _ type.procs.Bits[type]; ctnWords _ (ctnBits + Basics.bitsPerWord - 1)/Basics.bitsPerWord; val _ NEW [WordSeq[ctnWords]]; sigs[significance] _ TRUE; node _ NEW [NodeRep _ [ name: name, type: type, valRef: val, valPtr: nilPtr, ctnPtr: nilPtr, bitCount: dataBits, strength: strength, currentStrength: strength, cellIn: cellIn, strIn: strIn, XPhobic: xPhobic, nextPerturbed: notInNodeList, nextAffected: notInNodeList, nextDelayed: notInNodeList, prevDelayed: notInNodeList, significances: sigs, designNext: notInNodeList, implNext: notInNodeList, parentPieces: NIL, other: other ]]; TRUSTED {node.ctnPtr _ [word: @val[0], bit: 0]}; node.valPtr _ BitTwiddling.OffsetPtr[node.ctnPtr, leftPad]; SELECT significance FROM fromDesign => { cellIn.internalNodes.Insert[node !OSTR.DuplicateKey => ERROR Error[IO.PutFR["Duplicated Node name: %g", IO.rope[name]]]]; <> node.designNext _ cellIn.firstInternalNode; cellIn.firstInternalNode _ node; }; inImpl => { parentVal: Ptr _ SubPtr[parent.type, parent.valPtr, reln]; bbTableSpace: PrincOps.BBTableSpace; bbTable: PrincOps.BitBltTablePtr; TRUSTED {bbTable _ PrincOpsUtils.AlignedBBTable[@bbTableSpace]}; BitTwiddling.Copy[from: parentVal, to: node.valPtr, bitCount: dataBits, bbTable: bbTable]; node.parentPieces _ LIST[[parent, node, reln]]; }; ENDCASE => ERROR; IF type.procs.InitNode # NIL THEN type.procs.InitNode[node, strIn.sim.steady]; IF initialValue # NIL THEN { ivf: Format _ type.procs.GetFormat[type, initialValueFormat]; valStream: IO.STREAM _ IO.RIS[initialValue]; ok: BOOL; IF ivf = NIL THEN ERROR Error[IO.PutFR["Bad initialValueFormat %g for %g", IO.rope[initialValueFormat], IO.rope[name]]]; ok _ ivf.ParseValue[node, ivf, node.valPtr, valStream]; [] _ valStream.SkipWhitespace[]; IF NOT (ok AND valStream.EndOf[]) THEN SIGNAL Warning[IO.PutFR[ "Unable to parse %g by format (%g) for node %g (of type %g)", IO.rope[Convert.RopeFromRope[initialValue]], IO.rope[initialValueFormat], IO.rope[node.name], IO.rope[node.type.procs.UserDescription[node.type]]]]; }; END; NodeTList: TYPE = RECORD [head, tail: NodeList]; Equivalence: PROC [erInstance: REF ANY, a, b: NodeExpression] = BEGIN within: Cell _ NARROW[erInstance]; la, lb: NodeList; [[la,]] _ ToNodes[[NIL, NIL], a]; [[lb,]] _ ToNodes[[NIL, NIL], b]; EquivNodeLists[la, lb]; END; ToNodes: PROC [prefix: NodeTList, ne: NodeExpression] RETURNS [ul: NodeTList] = { ul _ prefix; WITH ne SELECT FROM x: PrimaryNE => { IF x.node.childPieces = NIL AND NOT x.node.significances[inImpl] THEN ERROR; IF x.node.significances[inImpl] THEN ul _ EndCat[ul, SelectNode[x.node, x.selector].at] ELSE ul _ Select[ul, x.node.childPieces, x.selector]; }; x: UnnamedConsNE => { FOR l: LIST OF PrimaryNE _ x.elts, l.rest WHILE l # NIL DO ul _ ToNodes[ul, l.first]; ENDLOOP; }; x: CatenateNE => { FOR l: LIST OF NodeExpression _ x.pieces, l.rest WHILE l # NIL DO ul _ ToNodes[ul, l.first]; ENDLOOP; }; ENDCASE => ERROR; }; Select: PROC [prefix: NodeTList, pl: PieceList, s: Selector] RETURNS [ul: NodeTList] = { first, count, direction, last, min, max: INT; up: BOOL; endPiece: PieceList; ol, prevList, el: NodeList _ NIL; firstSize, endSize: INT; [first, count, up] _ StandardSelectorRep[s, PieceListLength[pl]]; IF count < 2 THEN up _ TRUE; direction _ UpToInt[up]; IF NOT up THEN ERROR--lazy implementor--; last _ first + (count-1)*direction; min _ MIN[first, last]; max _ MAX[first, last]; DO pl _ Implify[pl]; firstSize _ NodeLength[pl.first.twardImpl]; IF min < firstSize THEN EXIT; min _ min - firstSize; max _ max - firstSize; pl _ pl.rest; ENDLOOP; endPiece _ pl; DO endPiece _ Implify[endPiece]; el _ LIST[endPiece.first.twardImpl]; endSize _ NodeLength[endPiece.first.twardImpl]; IF prevList = NIL THEN ol _ el ELSE prevList.rest _ el; IF max < endSize THEN EXIT; max _ max - endSize; prevList _ el; endPiece _ endPiece.rest; ENDLOOP; ul _ Append[prefix, [ol, el]]; IF min > 0 OR max+1 < endSize THEN { IF ol = el THEN ol.first _ SelectNode[ol.first, [range[min, 1+max-min, TRUE]]].at ELSE { IF min > 0 THEN ol.first _ SelectNode[ol.first, [range[min, firstSize-min, TRUE]]].at; IF max+1 < endSize THEN el.first _ SelectNode[el.first, [range[0, max+1, TRUE]]].at; }; }; }; EndCat: PROC [tl: NodeTList, n: Node] RETURNS [ul: NodeTList] = { this: NodeList _ LIST[n]; IF tl.tail = NIL THEN RETURN [[this, this]]; tl.tail.rest _ this; ul _ [tl.head, this]; }; Append: PROC [tl, ul: NodeTList] RETURNS [vl: NodeTList] = { IF tl = [NIL, NIL] THEN RETURN [ul]; IF ul = [NIL, NIL] THEN RETURN [tl]; tl.tail.rest _ ul.head; vl _ [tl.head, ul.tail]; }; UpToInt: ARRAY BOOL OF INT = [FALSE: -1, TRUE: 1]; Implify: PROC [il: PieceList, tail: PieceList _ NIL] RETURNS [ol: PieceList] = { Append: PROC [l1, l2: PieceList] RETURNS [l: PieceList] = { IF l2 = NIL THEN RETURN [l1]; IF l1 = NIL THEN RETURN [l2]; l _ CONS[l1.first, Append[l1.rest, l2]]}; IF il.first.twardImpl.significances[inImpl] THEN RETURN [Append[il, tail]]; IF il.first.twardImpl.significances[fromDesign] THEN ERROR; ol _ Append[Implify[il.first.twardImpl.childPieces, il.rest], tail]; }; EquivNodeLists: PROC [a, b: NodeList] = { Munch: PROC [pl: PieceList, nl: NodeList] RETURNS [ans: NodeList] = { IF pl = NIL THEN RETURN [nl]; ans _ CONS[pl.first.twardImpl, Munch[pl.rest, nl]]; }; WHILE a#NIL AND b#NIL DO na, nb: Node; la, lb: INT; WHILE NOT a.first.significances[inImpl] DO a _ Munch[a.first.childPieces, a.rest] ENDLOOP; WHILE NOT b.first.significances[inImpl] DO b _ Munch[b.first.childPieces, b.rest] ENDLOOP; la _ NodeLength[na _ a.first]; lb _ NodeLength[nb _ b.first]; IF la = lb THEN { JoinNodes[na, nb]; a _ a.rest; b _ b.rest; } ELSE IF la < lb THEN { before, at, rest: Node; [before: before, at: at, after: rest] _ SelectNode[nb, [range[0, la, TRUE]]]; IF before # NIL THEN ERROR; JoinNodes[na, at]; a _ a.rest; b.first _ rest; } ELSE IF lb < la THEN { before, at, rest: Node; [before: before, at: at, after: rest] _ SelectNode[na, [range[0, lb, TRUE]]]; IF before # NIL THEN ERROR; JoinNodes[nb, at]; b _ b.rest; a.first _ rest; } ELSE ERROR; ENDLOOP; IF a#NIL OR b#NIL THEN ERROR Error["Non-corresponding node expressions equivalenced"]; }; StandardSelectorRep: PROC [s: Selector, len: INT _ -1] RETURNS [first, count: INT, up: BOOL] = { WITH x: s SELECT FROM whole => {first _ 0; count _ len; up _ TRUE}; number => {first _ x.index; count _ 1; up _ TRUE}; range => {first _ x.first; count _ x.count; up _ x.up}; ENDCASE => ERROR; }; SelectNode: PROC [n: Node, s: Selector] RETURNS [before, at, after: Node] = { first, count: INT; up: BOOL; nl: INT _ NodeLength[n]; firstSel, lastSel: Selector.range; nn: ROPE _ n.name; Add: PROC [in: Node, s: Selector] = { n.childPieces _ CONS[[n, in, s], n.childPieces]; }; First: PROC = { IF first > 0 THEN { firstSel _ [range[0, first, TRUE]]; before _ CreateNode[ strIn: n.strIn, cellIn: n.cellIn, name: nn.Cat[SelectorToRope[firstSel]], type: n.type.procs.SubType[n.type, firstSel], strength: n.strength, xPhobic: n.XPhobic, significance: inImpl, parent: n, reln: firstSel ]; Add[before, firstSel]; } ELSE before _ NIL; }; Mid: PROC = { at _ CreateNode[ strIn: n.strIn, cellIn: n.cellIn, name: nn.Cat[SelectorToRope[s]], type: n.type.procs.SubType[n.type, s], strength: n.strength, xPhobic: n.XPhobic, significance: inImpl, parent: n, reln: s ]; Add[at, s]; }; Last: PROC = { IF first + count < nl THEN { lastSel _ [range[first + count, nl - (first + count), TRUE]]; after _ CreateNode[ strIn: n.strIn, cellIn: n.cellIn, name: nn.Cat[SelectorToRope[lastSel]], type: n.type.procs.SubType[n.type, lastSel], strength: n.strength, xPhobic: n.XPhobic, significance: inImpl, parent: n, reln: lastSel ]; Add[after, lastSel]; } ELSE after _ NIL; }; IF NOT n.significances[inImpl] THEN ERROR; IF n.childPieces # NIL THEN ERROR; IF s = [whole[]] THEN RETURN [NIL, n, NIL]; [first, count, up] _ StandardSelectorRep[s]; IF NOT up THEN ERROR--lazy implementor--; IF nl < count THEN ERROR; IF nl = count THEN RETURN [NIL, n, NIL]; IF up --make sure n.childPieces come out in right order-- THEN {Last[]; Mid[]; First[]} ELSE {First[]; Mid[]; Last[]}; n.significances[inImpl] _ FALSE; IF n.childPieces.rest = NIL THEN ERROR; }; SubPtr: PROC [parent: NodeType, p: Ptr, s: Selector] RETURNS [sp: Ptr] = { sp _ BitTwiddling.OffsetPtr[p, parent.procs.SelectorOffset[parent, s]]; }; NoteConnection: PROC [n: Node, nt: NodeType, xPhobic: BOOL] = { SELECT n.significances[inImpl] FROM FALSE => { IF n.childPieces = NIL THEN ERROR; FOR pl: PieceList _ n.childPieces, pl.rest WHILE pl # NIL DO NoteConnection[pl.first.twardImpl, nt.procs.SubType[nt, pl.first.reln], xPhobic]; ENDLOOP; }; TRUE => { IF NOT Conforming[n.type, nt] THEN ERROR; IF NOT Equivalent[n.type, nt] THEN { SELECT TRUE FROM n.type.simple AND NOT nt.simple => ReduceType[n]; nt.simple AND NOT n.type.simple => nt _ nt.procs.SwitchEquivalent[nt]; ENDCASE => ERROR; IF NOT Equivalent[n.type, nt] THEN ERROR; }; IF xPhobic THEN n.XPhobic _ TRUE; }; ENDCASE => ERROR; }; JoinNodes: PROC [n1, n2: Node] = { keep, lose: Node; lca: Cell; IF n1.strIn # n2.strIn THEN ERROR Error[IO.PutFR["Can't equivalence nodes %g and %g because they're in different structures", IO.rope[LongNodeName[n1]], IO.rope[LongNodeName[n2]]]]; IF (NOT n1.significances[inImpl]) OR (NOT n2.significances[inImpl]) THEN ERROR; IF n1.significances[fromDesign] THEN n1 _ DummyDown[n1]; IF n2.significances[fromDesign] THEN n2 _ DummyDown[n2]; IF n1.significances # implOnly OR n2.significances # implOnly THEN ERROR; IF NOT Conforming[n1.type, n2.type] THEN ERROR Error[IO.PutFR["Can't equivalence nodes %g and %g because their types don't match", IO.rope[LongNodeName[n1]], IO.rope[LongNodeName[n2]]]]; IF NOT Equivalent[n1.type, n2.type] THEN { IF n1.type.simple = n2.type.simple THEN ERROR; SELECT TRUE FROM n1.type.simple => ReduceType[n1]; n2.type.simple => ReduceType[n2]; ENDCASE => ERROR; IF NOT Equivalent[n1.type, n2.type] THEN ERROR; }; SELECT TRUE FROM n1.strength >= n2.strength => {keep _ n1; lose _ n2}; n1.strength <= n2.strength => {keep _ n2; lose _ n1}; ENDCASE => ERROR; lca _ LowestCommonAncestor[keep.cellIn, lose.cellIn]; keep.name _ LongNodeName[keep, lca].Cat["&", LongNodeName[lose, lca]]; keep.cellIn _ lca; IF keep.strength = lose.strength AND NOT BitTwiddling.Equal[keep.valPtr, lose.valPtr, keep.bitCount] THEN ERROR; IF keep.bitCount # lose.bitCount THEN ERROR; IF keep.currentStrength # keep.strength OR lose.currentStrength # lose.strength THEN ERROR; keep.cap _ keep.cap + lose.cap; IF keep.strIn # lose.strIn THEN ERROR; IF keep.switchConnections # NIL OR lose.switchConnections # NIL THEN ERROR; IF keep.byStrength # ALL[emptyHead] OR lose.byStrength # ALL[emptyHead] THEN ERROR; IF keep.found OR lose.found THEN ERROR; keep.XPhobic _ keep.XPhobic OR lose.XPhobic; IF keep.watchers # ALL[NIL] OR lose.watchers # ALL[NIL] THEN ERROR; IF keep.designNext # notInNodeList OR lose.designNext # notInNodeList THEN ERROR; IF keep.implNext # notInNodeList OR lose.implNext # notInNodeList THEN ERROR; IF keep.childPieces # NIL OR lose.childPieces # NIL THEN ERROR; IF keep.other # NIL OR lose.other # NIL THEN ERROR; keep.parentPieces _ CONS[[lose, keep, [whole[]]], keep.parentPieces]; lose.childPieces _ LIST[[lose, keep, [whole[]]]]; lose.significances[inImpl] _ FALSE; }; DummyDown: PROC [dn: Node] RETURNS [in: Node] = { IF dn.childPieces # NIL THEN ERROR; in _ CreateNode[strIn: dn.strIn, cellIn: dn.cellIn, name: Rope.Cat["{", dn.name, "}"], type: dn.type, strength: dn.strength, xPhobic: dn.XPhobic, significance: inImpl, parent: dn, reln: [whole[]]]; dn.significances[inImpl] _ FALSE; dn.childPieces _ LIST[[dn, in, [whole[]]]]; }; ReduceType: PROC [n: Node] = { IF NOT n.type.simple THEN RETURN; ReallyReduceType[n]; IF NOT n.significances[fromDesign] THEN { IF n.parentPieces = NIL THEN ERROR; FOR pl: PieceList _ n.parentPieces, pl.rest WHILE pl # NIL DO ReduceType[pl.first.twardDesign]; ENDLOOP; }; IF NOT n.significances[inImpl] THEN { IF n.childPieces = NIL THEN ERROR; FOR cl: PieceList _ n.childPieces, cl.rest WHILE cl # NIL DO ReduceType[cl.first.twardImpl]; ENDLOOP; }; }; ReallyReduceType: PROC [n: Node] = { old: NodeType _ n.type; new: NodeType _ n.type.procs.SwitchEquivalent[old]; oldValRef: REF ANY _ n.valRef; oldValPtr: Ptr _ n.valPtr; newCtnBits, newDataBits, newLeftPad, newCtnWords: NAT; newValRef: Words; newCtnPtr, newValPtr: Ptr; [newCtnBits, newDataBits, newLeftPad] _ new.procs.Bits[new]; newCtnWords _ (newCtnBits + Basics.bitsPerWord-1)/Basics.bitsPerWord; newValRef _ NEW [WordSeq[newCtnWords]]; TRUSTED {newCtnPtr _ [word: @newValRef[0], bit: 0]}; newValPtr _ BitTwiddling.OffsetPtr[newCtnPtr, newLeftPad]; IF NOT old.simple THEN ERROR; IF new.simple THEN ERROR; IF NOT Conforming[old, new] THEN ERROR; n.type _ new; n.valRef _ newValRef; n.valPtr _ newValPtr; n.ctnPtr _ newCtnPtr; n.bitCount _ newDataBits; new.procs.Transduce[fromS: n.strength, fromT: old, toT: new, fromP: oldValPtr, toP: newValPtr]; }; PieceListLength: PROC [pl: PieceList] RETURNS [len: INT] = { len _ 0; FOR pl _ pl, pl.rest WHILE pl # NIL DO len _ len + NodeLength[pl.first.twardImpl]; ENDLOOP; }; NodeLength: PROC [n: Node] RETURNS [l: INTEGER] = { WITH n.type SELECT FROM x: AtomNodeType => l _ 1; x: ArrayNodeType => l _ x.length; ENDCASE => ERROR; }; Compose: PROC [s1, s2: Selector] RETURNS [s: Selector] = { xFirst, yFirst, zFirst, xCount, yCount, zCount: INTEGER; xUp, yUp, zUp, scalar: BOOL; IF s1 = [whole[]] THEN RETURN [s2]; IF s2 = [whole[]] THEN RETURN [s1]; scalar _ s1.kind = number OR s2.kind = number; [xFirst, xCount, xUp] _ StandardSelectorRep[s1]; [yFirst, yCount, yUp] _ StandardSelectorRep[s2]; zFirst _ xFirst + yFirst*UpToInt[xUp]; zCount _ yCount; zUp _ xUp = yUp; IF scalar AND zCount # 1 THEN ERROR; IF scalar THEN RETURN [[number[zFirst]]] ELSE RETURN [[range[zFirst, zCount, zUp]]]; }; END.