[Indigo]<Rosemary>®>Rosemary.DF=>RoseCreateImplA.Mesa
Last Edited by: Spreitzer, July 2, 1985 6:29:04 pm PDT
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]]]];
do it in wrong order for now; parent will fix up after done expanding:
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]]]];
link in wrong order now; fix up when done expanding:
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.