DIRECTORY AMBridge, AMTypes, Atom, Convert, FS, IO, List, MessageWindow, OrderedSymbolTableRef, Pausers, Rope, RoseCreate, RoseEvents, RoseRun, RoseTypes, ViewerOps, ViewRec;

RoseCreateImpl: CEDAR PROGRAM
IMPORTS AMBridge, AMTypes, Atom, Convert, FS, IO, List, MessageWindow, OSTR: OrderedSymbolTableRef, Pausers, Rope, RoseEvents, RoseRun, RoseTypes, ViewerOps, ViewRec
EXPORTS RoseCreate, RoseTypes =

BEGIN OPEN RoseCreate, RoseTypes;

InterfaceMismatch: PUBLIC ERROR [cell: Cell,
index: CARDINAL,
expected, got: NodeType] = CODE;

cellClasses: SymbolTable _ OSTR.CreateTable[CompareCellClasses];
roots: SymbolTable _ OSTR.CreateTable[CompareComponents];

CompareCellClasses: -- --OSTR.CompareProc =
BEGIN
ToKey: SAFE PROC [ref: REF ANY] RETURNS [ROPE] =
{RETURN [WITH ref SELECT FROM
r: ROPE => r, cc: CellClass => cc.name, ENDCASE => ERROR]};
RETURN [ToKey[r1].Compare[ToKey[r2]]];
END;

CompareComponents: -- --OSTR.CompareProc =
BEGIN
ToKey: SAFE PROC [ref: REF ANY] RETURNS [ROPE] =
{RETURN [WITH ref SELECT FROM
r: ROPE => r, c: Cell => c.name, ENDCASE => ERROR]};
RETURN [ToKey[r1].Compare[ToKey[r2]]];
END;

CompareNodes: OSTR.CompareProc =
BEGIN
k1, k2: ROPE;
WITH r1 SELECT FROM
r: ROPE => k1 _ r;
n: Node => k1 _ n.name;
ENDCASE => ERROR;
k2 _ WITH r2 SELECT FROM
r: ROPE => r,
n: Node => n.name,
ENDCASE => ERROR;
RETURN [k1.Compare[k2]];
END;

RegisterCellClass: PUBLIC PROC [className: ROPE, expandProc: ExpandProc _ NIL, ioCreator: IOCreator _ NIL, initializer: Initializer _ NIL, evals: EvalProcs, blackBox, stateToo: CellTestProc _ NIL, ports: Ports, drivePrototype: REF ANY _ NIL, classData: REF ANY _ NIL] RETURNS [class: CellClass] =
BEGIN
old: CellClass;
class _ NEW [CellClassRep _ [
name: className,
expand: expandProc,
ioCreator: ioCreator,
initializer: initializer,
evals: evals,
blackBox: blackBox,
stateToo: stateToo,
ports: ports,
ioWordCount: 0,
firstInstance: NIL,
drivePrototype: drivePrototype,
classData: classData]];
old _ NARROW[cellClasses.Delete[className]];
FOR portIndex: CARDINAL IN [0 .. ports.length) DO
port: Port _ class.ports[portIndex];
class.ioWordCount _ MAX[class.ioWordCount, port.firstWord + port.wordCount];
IF port.type = NIL THEN ERROR Error[IO.PutFR["No NodeType given for Port %g", IO.rope[port.name]]];
IF port.special THEN class.hasASpecialPort _ TRUE;
ENDLOOP;
IF old # NIL THEN
BEGIN
FOR instance: Cell _ old.firstInstance, instance.nextInstance WHILE instance # NIL DO
IF instance.class # old THEN ERROR;
instance.class _ class;
IF instance.expansion = Leaf THEN
BEGIN
IF instance.realCellStuff.evals # old.evals THEN ERROR;
instance.realCellStuff.evals _ class.evals;
END;
ENDLOOP;
IF old.firstInstance # NIL THEN
BEGIN
ok: BOOLEAN _ TRUE;
IF old.ports.length # class.ports.length THEN ok _ FALSE
ELSE BEGIN
FOR portIndex: CARDINAL IN [0 .. class.ports.length) DO
IF (
class.ports[portIndex].firstWord # old.ports[portIndex].firstWord OR
class.ports[portIndex].wordCount # old.ports[portIndex].wordCount OR
class.ports[portIndex].type # old.ports[portIndex].type OR
class.ports[portIndex].input # old.ports[portIndex].input OR
class.ports[portIndex].output # old.ports[portIndex].output OR
NOT class.ports[portIndex].name.Equal[old.ports[portIndex].name])
THEN {ok _ FALSE; EXIT};
ENDLOOP;
END;
IF NOT ok THEN ERROR Error[IO.PutFR["Redefinition of Class %g not allowed because of different interface", IO.rope[className]]];
END;
END;
cellClasses.Insert[class];
END;

GetCellClass: PUBLIC PROC [className: ROPE] RETURNS [class: CellClass] =
{class _ NARROW[cellClasses.Lookup[className]]};

CreateSim: PUBLIC PROC [steady: BOOL] RETURNS [sim: Simulation] = {
sim _ NEW [SimulationRep _ [steady: steady, root: NIL]];
RoseEvents.Notify[event: $NewSim, arg: sim];
};

CreateTopCell: PUBLIC PROC [instanceName, className: ROPE, decider: ExpandDeciderClosure, initData: REF ANY _ NIL, steady: BOOL _ TRUE] RETURNS [cell: Cell, osim: Simulation] =
BEGIN
class: CellClass;
class _ NARROW[cellClasses.Lookup[className]];
IF class = NIL THEN ERROR Error[IO.PutFR["No such class: %g", IO.rope[className]]];
osim _ CreateSim[steady];
osim.root _ cell _ NEW [CellRep _ [
name: instanceName, class: class, sim: osim,
parent: NIL, leftChild: NIL, rightSibling: NIL, firstInternalNode: NIL,
internalNodes: OSTR.CreateTable[CompareNodes],
components: OSTR.CreateTable[CompareComponents],
interfaceNodes: NEW [NodeSR[0]],
props: NIL,
type: Shadow, expansion: Inline,
realCellStuff: NIL]];
cell.props _ List.PutAssoc[$ExpandDeciderClosure, decider, cell.props];
FinishCreatingCell[cell, NIL, initData];
roots.Insert[cell !OSTR.DuplicateKey => ERROR Error[IO.PutFR["Duplicated Root name: %g", IO.rope[cell.name]]]];
END;

CreateCell: PUBLIC PROC [within: Cell, instanceName, className, interfaceNodes: ROPE, initData: REF ANY _ NIL] RETURNS [cell: Cell] =
BEGIN
class: CellClass;
class _ NARROW[cellClasses.Lookup[className]];
IF class = NIL THEN ERROR Error[IO.PutFR["No such class: %g", IO.rope[className]]];
cell _ NEW [CellRep _ [
name: instanceName, class: class, sim: within.sim,
parent: within, leftChild: NIL, rightSibling: NIL, firstInternalNode: NIL,
internalNodes: OSTR.CreateTable[CompareNodes],
components: OSTR.CreateTable[CompareComponents],
interfaceNodes: NEW [NodeSR[class.ports.length]],
props: NIL,
type: Shadow, expansion: Inline,
realCellStuff: NIL]];
FinishCreatingCell[cell, interfaceNodes, initData];
IF cell.type = Real THEN RoseRun.ScheduleCell[cell];
END;

FinishCreatingCell: PROC [cell: Cell, interfaceNodes: ROPE, initData: REF ANY _ NIL] =
BEGIN
class: CellClass _ cell.class;
thisChild, lastChild: Cell;
thisNode, lastNode: Node;
IF (cell.parent = NIL) AND (class.ports.length > 0) THEN ERROR Error["Bogosity", cell];
IF cell.parent # NIL THEN
BEGIN
cell.parent.components.Insert[cell !OSTR.DuplicateKey => ERROR Error[IO.PutFR["Duplicated Cell name: %g", IO.rope[cell.name]]]];
cell.rightSibling _ cell.parent.leftChild;
--do it in wrong order for now; parent will fix up after done expanding--
cell.parent.leftChild _ cell;
END;
cell.nextInstance _ class.firstInstance;
class.firstInstance _ cell;
FillInInterfaceNodes[cell, interfaceNodes];
cell.expansion _ FindAndUseExpandDecider[cell];
SELECT cell.expansion FROM
Inline => BEGIN
cell.type _ Shadow;
cell.realCellStuff _ NIL;
FOR index: CARDINAL IN [0 .. class.ports.length) DO
interfaceNode: Node _ cell.interfaceNodes[index];
IF NOT class.ports[index].output THEN interfaceNode.unwriteability _ interfaceNode.unwriteability + 1;
ENDLOOP;
class.expand[thisCell: cell, initData: initData];
FOR index: CARDINAL IN [0 .. class.ports.length) DO
interfaceNode: Node _ cell.interfaceNodes[index];
IF NOT class.ports[index].output THEN interfaceNode.unwriteability _ interfaceNode.unwriteability - 1;
ENDLOOP;
END;
Leaf, Nested => BEGIN
cell.type _ Real;
cell.realCellStuff _ NEW [RealCellStuffRep _ [schedNext: notInCellList,
nextNeeded: notInCellList, nextNoted: notInCellList,
newIO: NIL, oldIO: NIL, switchIO: NIL,
newIOAsWP: NIL, oldIOAsWP: NIL, switchIOAsWP: NIL,
state: NIL,
evals: class.evals]];
FOR portIndex: CARDINAL IN [0..class.ports.length) DO
node: Node _ cell.interfaceNodes[portIndex];
targType: NodeType _ cell.class.ports[portIndex].type;
IF node.type = NIL THEN ERROR--node.type _ targType--;
IF targType # node.type THEN ERROR InterfaceMismatch[cell: cell, index: portIndex, expected: targType, got: node.type];
IF cell.class.ports[portIndex].XPhobic THEN node.XPhobic _ TRUE;
NoteConnection[node, [cell, portIndex], cell.class.ports[portIndex].input, cell.class.ports[portIndex].output];
NoteMaybeVisible[node, [cell, portIndex]];
ENDLOOP;
IF class.ioCreator # NIL THEN class.ioCreator[cell: cell, initData: initData]
ELSE IF class.ioWordCount > 0 THEN ERROR Error[IO.PutFR["No IOCreator for class %g", IO.rope[class.name]]];
cell.realCellStuff.newIOAsWP _ LOOPHOLE[cell.realCellStuff.newIO];
cell.realCellStuff.oldIOAsWP _ LOOPHOLE[cell.realCellStuff.oldIO];
cell.realCellStuff.switchIOAsWP _ LOOPHOLE[cell.realCellStuff.switchIO];
FOR portIndex: CARDINAL IN [0 .. class.ports.length) DO
targType: NodeType _ cell.class.ports[portIndex].type;
node: Node _ cell.interfaceNodes[portIndex];
IF targType.procs.InitPort # NIL THEN targType.procs.InitPort[
node,
SocketToWP[[cell, portIndex]]];
IF node.initialValue # NIL AND node.type.simple THEN
Initialize[node, SocketToWP[[cell, portIndex]]];
ENDLOOP;
IF class.initializer # NIL THEN class.initializer[cell: cell, initData: initData, leafily: cell.expansion = Leaf];
IF cell.expansion = Nested THEN
BEGIN
insides: Structure;
cell.realCellStuff.evals _ RoseRun.StrEvals;
cell.realCellStuff.state _ insides _ NEW [StructureRep _ [
container: cell, mirror: NIL,
schedFirst: NIL, schedLast: NIL,
insideNodes: NEW [NodeSR[class.ports.length]],
nextPerturbed: notInStrList,
nextWasPerturbed: notInStrList ]];
IF cell.parent # NIL THEN insides.mirror _ NEW [CellRep _ [
name: cell.name.Cat["-mirror"],
class: GetMirrorClass[cell.class],
sim: cell.sim,
parent: cell,
leftChild: NIL,
rightSibling: NIL,
firstInternalNode: NIL,
internalNodes: NIL,
components: NIL,
interfaceNodes: insides.insideNodes,
props: NIL,
type: Real,
expansion: Leaf,
realCellStuff: NEW [RealCellStuffRep _ [
schedNext: notInCellList,
nextNeeded: notInCellList,
nextNoted: notInCellList,
newIO: cell.realCellStuff.newIO,
oldIO: cell.realCellStuff.oldIO,
switchIO: cell.realCellStuff.switchIO,
newIOAsWP: cell.realCellStuff.newIOAsWP,
oldIOAsWP: cell.realCellStuff.oldIOAsWP,
switchIOAsWP: cell.realCellStuff.switchIOAsWP,
state: ContainingStr[cell],
evals: RoseRun.StrMirrorEvals]]]];
FOR index: CARDINAL IN [0 .. class.ports.length) DO
outsideNode: Node _ cell.interfaceNodes[index];
insideNode: Node _ CreateNode[within: cell, name: class.ports[index].name, type: outsideNode.type, initialValue: outsideNode.initialValue];
insides.insideNodes[index] _ insideNode;
IF cell.parent # NIL THEN {
NoteMaybeVisible[insideNode, [insides.mirror, index]];
NoteConnection[insideNode, [insides.mirror, index], cell.class.ports[index].output, cell.class.ports[index].input];
};
IF NOT class.ports[index].output THEN insideNode.unwriteability _ insideNode.unwriteability + 1;
ENDLOOP;
class.expand[thisCell: cell, initData: initData];
END;
END;
ENDCASE => ERROR;
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.next;
thisNode.next _ lastNode;
lastNode _ thisNode;
thisNode _ nextNode;
ENDLOOP;
cell.firstInternalNode _ lastNode;
END;

NoteConnection: PROC [node: Node, socket: Socket, input, output: BOOLEAN] =
BEGIN
IF input THEN
BEGIN
IF output THEN node.bidirs _ CONS[socket, node.bidirs]
ELSE node.readers _ CONS[socket, node.readers];
END
ELSE IF output THEN node.writers _ CONS[socket, node.writers]
ELSE ERROR;
END;

FillInInterfaceNodes: PROC [cell: Cell, interfaceNodes: ROPE] =
BEGIN
index: CARDINAL _ 0;
in: IO.STREAM _ IO.RIS[interfaceNodes];
[] _ in.GetIndex[];	--wake up generic GetIndex impl
[] _ in.SkipWhitespace[];
IF NOT in.EndOf[] THEN DO
name: ROPE _ in.GetTokenRope[IDBreak].token;
key: ROPE;
this: CARDINAL;
[] _ in.SkipWhitespace[];
IF (IF in.EndOf[] THEN FALSE ELSE in.PeekChar[] = ':) THEN
BEGIN
key _ name;
IF in.GetChar[] # ': THEN ERROR;
IF in.EndOf[] THEN ERROR Error[IO.PutFR["Interface spec syntax error, at %g", IO.int[in.GetIndex[]]]];
name _ in.GetTokenRope[IDBreak].token;
IF (this _ GetIndex[cell.class.ports, key]) = notFound THEN ERROR Error[IO.PutFR["No such port (%g) for CellClass %g", IO.rope[key], IO.rope[cell.class.name]]];
END
ELSE BEGIN
IF index >= cell.interfaceNodes.length THEN ERROR Error[IO.PutFR["No %g'th element in %g's Interface", IO.int[index], IO.rope[cell.class.name]]];
key _ cell.class.ports[this _ index].name;
END;
IF cell.interfaceNodes[this] # NIL THEN ERROR Error[IO.PutFR["Port %g specified twice in \"%g\"", IO.rope[key], IO.rope[interfaceNodes]]];
cell.interfaceNodes[this] _ LookupCellNode[cell.parent, name];
IF cell.interfaceNodes[this] = NIL THEN ERROR Error[IO.PutFR["Node %g not found", IO.rope[name]]];
IF cell.class.ports[this].output AND cell.interfaceNodes[this].unwriteability > 0 THEN SIGNAL Warning[IO.PutFR["Node %g is, but shouldn't be, written to by port %g of cell %g", IO.rope[cell.interfaceNodes[this].name], IO.rope[cell.class.ports[this].name], IO.rope[cell.name]]];
index _ index + 1;
[] _ in.SkipWhitespace[];
IF in.EndOf[] THEN EXIT;
IF in.GetChar[] # ', THEN ERROR Error[IO.PutFR["Interface spec syntax error (missing comma), at %g", IO.int[in.GetIndex[]]]];
ENDLOOP;
FOR this: CARDINAL IN [0 .. cell.interfaceNodes.length) DO
IF cell.interfaceNodes[this] = NIL THEN
BEGIN
name: ROPE _ cell.class.ports[this].name;
cell.interfaceNodes[this] _ LookupCellNode[cell.parent, name];
IF cell.interfaceNodes[this] = NIL THEN ERROR Error[IO.PutFR["Port %g not specified in \"%g\"", IO.rope[name], IO.rope[interfaceNodes]]]
ELSE IF cell.class.ports[this].output AND cell.interfaceNodes[this].unwriteability > 0 THEN SIGNAL Warning[IO.PutFR["Node %g is, but shouldn't be, written to by port %g of cell %g", IO.rope[cell.interfaceNodes[this].name], IO.rope[cell.class.ports[this].name], IO.rope[cell.name]]];
END;
ENDLOOP;
in.Close[];
END;

IDBreak: IO.BreakProc =
{RETURN [SELECT char FROM
IO.SP, IO.CR, IO.LF, IO.TAB => sepr,
',, ': => break,
ENDCASE => other]};

LookupCellNode: PROC [cell: Cell, name: ROPE] RETURNS [node: Node] =
BEGIN
index: CARDINAL;
IF (node _ NARROW[cell.internalNodes.Lookup[name]]) # NIL THEN RETURN [node];
IF (index _ GetIndex[cell.class.ports, name]) # notFound THEN RETURN [cell.interfaceNodes[index]];
node _ NIL;
END;

GetIndex: PUBLIC PROC [ports: Ports, key: ROPE] RETURNS [index: CARDINAL] =
BEGIN
FOR i: CARDINAL IN [0..ports.length) DO
IF key.Equal[ports[i].name] THEN RETURN [i];
ENDLOOP;
RETURN [notFound];
END;

FindAndUseExpandDecider: PROC [cell: Cell] RETURNS [ExpandDecision] =
BEGIN
ed: ExpandDecision;
possibilities: [0..3];
[ed, possibilities] _ PickOne[cell];
IF possibilities = 1 THEN RETURN [ed];
IF possibilities = 0 THEN ERROR Error[IO.PutFR["Can't do anything with class %g", IO.rope[cell.class.name]]];
FOR temp: Cell _ cell, temp.parent WHILE temp # NIL DO
asAny: REF ANY _ List.Assoc[$ExpandDeciderClosure, temp.props];
edc: ExpandDeciderClosure;
try: ExpandDecision;
IF asAny = NIL THEN LOOP;
edc _ NARROW[asAny];
try _ edc.Decide[cell, edc.otherData];
RETURN [IF Possible[cell, try] THEN try ELSE ed];
ENDLOOP;
RETURN [ed];
END;

PickOne: PROC [cell: Cell] RETURNS [whatToDo: ExpandDecision, possibilities: [0..3]] =
BEGIN
possibilities _ 0;
FOR i: [1..3] IN [1..3] DO
d: ExpandDecision _ orderedChoices[i];
IF Possible[cell, d] THEN {whatToDo _ d; possibilities _ possibilities + 1};
ENDLOOP;
END;

orderedChoices: ARRAY [1..3] OF ExpandDecision = [Leaf, Nested, Inline];

NoteMaybeVisible: PROC [node: Node, socket: Socket] = INLINE
BEGIN
IF node.visible.cell = NIL THEN node.visible _ socket
ELSE IF node.visible.cell.class.ports[node.visible.index].output THEN RETURN
ELSE node.visible _ socket;
END;

MakeMirrorIO: PUBLIC PROC [cell: Cell] RETURNS [a, b: REF ANY] = TRUSTED
BEGIN
org, aTV, bTV: AMTypes.TypedVariable;
type: AMTypes.Type;
IF cell.realCellStuff.newIO = NIL THEN RETURN [NIL, NIL];
org _ AMBridge.TVForReferent[cell.realCellStuff.newIO];
type _ AMTypes.TVType[org];
aTV _ AMTypes.New[type];
AMTypes.Assign[aTV, org];
a _ AMBridge.RefFromTV[aTV];
bTV _ AMTypes.New[type];
AMTypes.Assign[bTV, org];
b _ AMBridge.RefFromTV[bTV];
END;

GetMirrorClass: PROC [class: CellClass] RETURNS [mirrorClass: CellClass] =
BEGIN
name: ROPE _ class.name.Concat["-mirror"];
asAny: REF ANY;
IF (asAny _ cellClasses.Lookup[name]) # NIL THEN RETURN [NARROW[asAny]];
mirrorClass _ RegisterCellClass[
className: name,
evals: RoseRun.StrMirrorEvals,
ports: MirrorPorts[class.ports]];
END;

MirrorPorts: PUBLIC PROC [fwd: Ports, alwaysOutput, alwaysInput: BOOL _ FALSE] RETURNS [bkwd: Ports] =
BEGIN
bkwd _ NEW [PortsRep[fwd.length]];
FOR i: CARDINAL IN [0 .. fwd.length) DO
bkwd[i] _ fwd[i];
bkwd[i].input _ alwaysInput OR fwd[i].output;
bkwd[i].output _ alwaysOutput OR fwd[i].input;
ENDLOOP;
END;

Possible: PUBLIC PROC [cell: Cell, whatToDo: ExpandDecision] RETURNS [possible: BOOLEAN] =
BEGIN
evalable: BOOLEAN _ cell.class.evals.EvalSimple # NIL OR cell.class.evals.PropUD # NIL;
RETURN [SELECT whatToDo FROM
Leaf => evalable AND (IF cell.class.ioWordCount > 0 THEN cell.class.ioCreator # NIL ELSE TRUE),
Nested => cell.class.expand # NIL AND (IF cell.class.ioWordCount > 0 THEN cell.class.ioCreator # NIL ELSE TRUE),
Inline => cell.class.expand # NIL AND cell.parent # NIL,
ENDCASE => ERROR];
END;

CreateNode: PUBLIC PROC [within: Cell, name: ROPE, type: NodeType, initialValue: ROPE _ NIL, initData: REF ANY _ NIL] RETURNS [node: Node] =
BEGIN
bits: CARDINAL _ type.procs.Bits[type];
words: CARDINAL _ (bits + 15)/16;
node _ NEW [NodeRep _ [
name: name,
type: type,
cellIn: within,
initialValue: initialValue,
nextPerturbed: notInNodeList,
nextAffected: notInNodeList,
nextX: notInNodeList,
prevX: notInNodeList,
next: within.firstInternalNode
]];
node.name _ name;
node.type _ type;
within.internalNodes.Insert[node !OSTR.DuplicateKey => ERROR Error[IO.PutFR["Duplicated Node name: %g", IO.rope[name]]]];
within.firstInternalNode _ node;
--link in wrong order now; fix up when done expanding--
IF type.procs.InitNode # NIL THEN type.procs.InitNode[node, initData, within.sim.steady];
IF initialValue # NIL AND NOT node.type.simple THEN Initialize[node, NIL];
IF NOT node.type.simple THEN RoseRun.PerturbNode[node, within];
END;

Initialize: PROC [node: Node, wp: WordPtr] =
BEGIN
ivs: IO.STREAM _ IO.RIS[node.initialValue];
fmt: Format _ node.type.procs.GetFormat[node.type, NIL];
ok: BOOLEAN _ fmt.ParseValue[
node,
fmt,
wp,
ivs];
ivs.Close[];
IF NOT ok THEN {
SIGNAL Warning[IO.PutFR[
"Unable to parse %g by default format (%g) for node %g (of type %g)",
IO.rope[Convert.RopeFromRope[node.initialValue]],
IO.rope[fmt.key],
IO.rope[node.name],
IO.rope[node.type.procs.UserDescription[node.type]]]];
node.initialValue _ NIL};
END;

SplitJoin: PUBLIC PROC [within: Cell, a, b: StretchList, writeA, writeB: BOOLEAN] =
BEGIN
IF (a = NIL) # (b = NIL) THEN ERROR;
IF a = NIL THEN RETURN;
[] _ a.first.node.type.procs.MakeSplitJoin[within, a, b, writeA, writeB];
END;

ChangeReps: PUBLIC PROC [within: Cell, a, b: Node, writeA, writeB: BOOLEAN] =
BEGIN
IF a.type.procs.MakeTransducer # NIL THEN [] _ a.type.procs.MakeTransducer[a, b, within, writeA, writeB] ELSE
IF b.type.procs.MakeTransducer # NIL THEN [] _ b.type.procs.MakeTransducer[b, a, within, writeA, writeB] ELSE
ERROR;
END;

DecideFromFile: PUBLIC PROC [fileName: ROPE] RETURNS [dff: ExpandDeciderClosure] =
BEGIN
file: IO.STREAM _ NIL;
top: LORA;
file _ FS.StreamOpen[fileName: fileName];
top _ LIST[NIL, NIL, IO.GetRefAny[file]];
file.Close[];
dff _ NEW [ExpandDeciderClosureRep _ [Decide: DecideByName, otherData: top]];
END;

Name: TYPE = LIST OF ROPE;
LORA: TYPE = LIST OF REF ANY;
ExpandDecisionRef: TYPE = REF ExpandDecision;

decisionProp: ATOM _ Atom.MakeAtom["Spreitzer January 6, 1984 8:33 pm"];

ExpandQuery: TYPE = REF ExpandQueryRep;
ExpandQueryRep: TYPE = RECORD [
instanceName, className: ROPE _ NIL,
whatToDo: ExpandDecision _ Nested];

qp: Pausers.Pauser _ NIL;
eq: ExpandQuery _ NEW [ExpandQueryRep _ []];

Ask: ExpandDecider --PROC [cell: Cell, otherData: REF ANY] RETURNS [ExpandDecision]-- =
BEGIN
first: BOOLEAN _ TRUE;
eq.instanceName _ cell.name;
eq.className _ cell.class.name;
IF qv # NIL AND qv.iconic THEN ViewerOps.OpenIcon[qv];
WHILE first OR NOT Possible[cell, eq.whatToDo] DO qp.Pause[]; first _ FALSE ENDLOOP;
RETURN [eq.whatToDo];
END;

DecideByName: ExpandDecider =
BEGIN
Yelp: PROC [problem: ROPE] RETURNS [ExpandDecision] = TRUSTED
BEGIN
RETURN [Ask[cell, problem]];
END;
decisionsByName: LORA _ NARROW[otherData];
name: Name _ GetName[cell];
descr: LORA _ GetDescr[name, decisionsByName];
decAt: ATOM;
asAny: REF ANY;
IF descr = NIL THEN RETURN [Yelp["no decision given"]];
IF descr.rest = NIL THEN
BEGIN
IF Possible[cell, Leaf] THEN RETURN [Leaf];
RETURN [Yelp["cant make it a Leaf"]];
END;
IF NOT ISTYPE[descr.rest.first, ATOM] THEN RETURN [Yelp["decision not an Atom"]];
IF (asAny _ Atom.GetProp[atom: (decAt _ NARROW[descr.rest.first]), prop: decisionProp]) = NIL THEN RETURN [Yelp["atom not a decision"]];
IF (IF asAny = NIL THEN TRUE ELSE NOT ISTYPE[asAny, ExpandDecisionRef]) THEN RETURN [Yelp["atom not a decision"]];
RETURN [NARROW[asAny, ExpandDecisionRef]^];
END;

GetName: PROC [cell: Cell] RETURNS [name: Name] =
BEGIN
name _ NIL;
WHILE cell # NIL DO
name _ CONS[cell.name, name];
cell _ cell.parent;
ENDLOOP;
END;

GetDescr: PROC [name: Name, dbn: LORA] RETURNS [LORA] =
BEGIN
Matches: PROC [name: ROPE, asAny: REF ANY] RETURNS [BOOLEAN] =
BEGIN
dbn: LORA;
s2: ROPE;
IF NOT ISTYPE[asAny, LORA] THEN TRUSTED
BEGIN
MessageWindow.Append[message: "Ill formed decisions!", clearFirst: TRUE];
RETURN [FALSE];
END;
dbn _ NARROW[asAny];
IF (IF dbn = NIL THEN TRUE ELSE (IF dbn.first = NIL THEN TRUE ELSE (NOT ISTYPE[dbn.first, ROPE] AND NOT ISTYPE[dbn.first, ATOM]))) THEN TRUSTED
BEGIN
MessageWindow.Append[message: "Ill formed decisions!", clearFirst: TRUE];
RETURN [FALSE];
END;
s2 _ WITH dbn.first SELECT FROM
r: ROPE => r,
a: ATOM => Atom.GetPName[a],
ENDCASE => ERROR;
RETURN [Rope.Equal[s1: name, s2: s2, case: FALSE]];
END;
WHILE name # NIL DO
tail: LORA;
IF (IF dbn = NIL THEN TRUE ELSE dbn.rest = NIL) THEN TRUSTED
BEGIN
MessageWindow.Append[message: "Ill formed decisions!", clearFirst: TRUE];
RETURN [NIL];
END;
FOR tail _ dbn.rest.rest, tail.rest WHILE tail # NIL DO
IF Matches[name.first, tail.first] THEN EXIT;
ENDLOOP;
IF tail = NIL THEN TRUSTED
BEGIN
MessageWindow.Append[message: "No decsion", clearFirst: TRUE];
RETURN [NIL];
END;
name _ name.rest;
dbn _ NARROW[tail.first];
ENDLOOP;
RETURN [dbn];
END;

LookupCell: PUBLIC PROC [path: LIST OF ROPE, from: Cell _ NIL] RETURNS [cell: Cell] =
BEGIN
sofar: LIST OF ROPE _ NIL;
cell _ from;
WHILE path # NIL DO
next: Cell _ NARROW[(IF cell = NIL THEN roots ELSE cell.components). Lookup[path.first]];
IF next = NIL THEN
{SIGNAL Warning[IO.PutFR["Not found: %g %g %g", IO.refAny[sofar], IO.rope[Convert.RopeFromRope[path.first]], IO.refAny[path.rest]]]; RETURN [NIL]};
sofar _ CONS[path.first, sofar];
path _ path.rest;
cell _ next;
ENDLOOP;
END;

LookupNode: PUBLIC PROC [path: LIST OF ROPE, from: Cell _ NIL] RETURNS [node: Node] =
BEGIN
sofar: LIST OF ROPE _ NIL;
cell: Cell _ from;
WHILE path.rest # NIL DO
next: Cell _ NARROW[(IF cell = NIL THEN roots ELSE cell.components). Lookup[path.first]];
IF next = NIL THEN
{SIGNAL Warning[IO.PutFR["Not found: %g %g %g", IO.refAny[sofar], IO.rope[Convert.RopeFromRope[path.first]], IO.refAny[path.rest]]]; RETURN [NIL]};
sofar _ CONS[path.first, sofar];
path _ path.rest;
cell _ next;
ENDLOOP;
node _ LookupCellNode[cell, path.first];
END;

qerv: ViewRec.RecordViewer;
qv: ViewRec.Viewer _ NIL;

MakeQueryPauser: ViewRec.OtherStuffProc =
BEGIN
v: ViewRec.Viewer;
[qp, v] _ Pausers.CreatePauser[enabledName: "Answer Query", disabledName: "", viewerInit: [parent: in, border: FALSE], paint: FALSE];
RETURN [LIST[v]];
END;

Setup: PROC =
BEGIN
Atom.PutProp[atom: $N, prop: decisionProp, val: NEW [ExpandDecision _ Nested]];
Atom.PutProp[atom: $I, prop: decisionProp, val: NEW [ExpandDecision _ Inline]];
Atom.PutProp[atom: $L, prop: decisionProp, val: NEW [ExpandDecision _ Leaf]];
qerv _ ViewRec.ViewRef[
agg: eq,
otherStuff: MakeQueryPauser,
viewerInit: [iconic: TRUE, column: right, name: "ExpandQuery"]];
qv _ qerv.RVQuaViewer[];
END;

Setup[];

END.
t[Indigo]<Rosemary>2.3>Rosemary.df=>RoseCreateImpl.Mesa
Last Edited by: Spreitzer, May 1, 1984 4:10:06 pm PDT
ส–

"cedar" style˜J™6J™5J˜Icodešฯk	œฅ
˜ฎ
K˜šะbxœœ
˜Kšœž
˜ฅ
Kšœ˜—K˜Kšœ
œ˜!K˜šฯbœœ
œ
˜,Kšœœ
˜Kšœœ
˜ —K˜Kšœœ!˜@Kšœœ ˜9K˜šฯnœฯcœ˜+Kš
˜š œœ
œœ
œœœ˜0šœ
œœœ
˜Kšœœ!œœ˜;——Kšœ ˜&Kšœ
˜—K˜š œกœ˜*Kš
˜š œœ
œœ
œœœ˜0šœ
œœœ
˜Kšœœœœ˜4——Kšœ ˜&Kšœ
˜—K˜š œœ˜ Kš
˜Kšœœ
˜
šœœ
˜Kšœœ˜Kš
œ˜Kšœœ
˜—šœœœ
˜Kšœœ˜
K˜Kšœœ
˜—Kšœ˜Kšœ
˜—K˜š œœ
œ
œœœœ7œ œ
œœ
œ
œœœ˜จKš
˜Kš
œ˜šœœ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ
˜
K˜K˜Kš
œ
˜
K˜Kšœœ
˜Kš
œ˜Kš
œ˜—Kšœœ ˜,šœœ
œ˜1K˜$Kšœœ5˜LKšœ
œ
œ
œœ(œ˜cKšœœœ
˜2Kšœ
˜—šœœ
˜Kš
˜šœ;œœ
˜UKšœœ
œ
˜#K˜šœ˜!Kš
˜Kšœ*œ
œ
˜7Kš
œ+˜+Kšœ
˜—Kšœ
˜—šœœ
˜Kš
˜Kšœœœ
˜Kšœ'œ˜8šœ
˜
šœœ
œ˜7šœ˜KšœB˜DKšœB˜DKšœ8˜:Kšœ:˜<Kšœ<˜>Kšœ>˜A—Kšœœœ˜Kšœ
˜—Kšœ
˜—Kšœ
œœ
œœNœ˜€
Kšœ
˜—Kšœ
˜—K˜Kšœ
˜—K˜š
 œœ
œ
œœ˜HKšœ	œ!˜0—K˜š
 	œœ
œ
œœ˜CKšœœ)œ˜8Kš
œ,˜,Kš
œ˜—K˜š 
œœ
œœ+œ
œœ
œœœ!˜ฐ
Kš
˜K˜Kšœœ ˜.Kšœ	œ
œ
œœœ˜SKš
œ˜šœœ
˜#K˜,Kš	œœ
œœœ
˜GKšœœ˜.Kšœœ ˜0Kšœœ
˜ Kšœœ
˜Kš
œ ˜ Kšœœ˜—K˜GKšœœ˜(Kš	œœœœ#œ˜oKšœ
˜—K˜š 
œœ
œ9œœ
œœœ˜…
Kš
˜K˜Kšœœ ˜.Kšœ	œ
œ
œœœ˜Sšœœ
˜K˜2Kšœœœœ
˜JKšœœ˜.Kšœœ ˜0Kšœœ˜1Kšœœ
˜Kš
œ ˜ Kšœœ˜—K˜3Kšœœ˜4Kšœ
˜—K˜š œœœœ
œœ˜VKš
˜K˜K˜K˜Kš
œœœœ
œ˜Wšœœ
˜Kš
˜Kš	œ$œœœ#œ˜€
K˜*Kš
กI˜IK˜Kšœ
˜—K˜(K˜K˜+Kš
œ/˜/šœ˜šœ
˜K˜Kšœœ
˜šœœ
œ˜3Kš
œ1˜1Kšœ
œœA˜fKšœ
˜—K˜1šœœ
œ˜3Kš
œ1˜1Kšœ
œœA˜fKšœ
˜—Kšœ
˜—šœ˜K˜š
œG˜GKš
œ4˜4Kšœœ	œœ
˜&Kšœœ
œœ
˜2Kšœœ
˜Kš
œ˜—šœœ
œ˜5Kš
œ,˜,K˜6Kš	œ
œ
œ
กœ
˜6Kšœœ
œU˜wKšœ%œœ
˜@Kš
œo˜oKš
œ*˜*Kšœ
˜—Kšœœ
œ0˜MKšœ
œœ
œœ$œ˜kKšœœ˜BKšœœ˜BKšœ"œ˜Hšœœ
œ˜7K˜6Kš
œ,˜,šœœ
œ˜>Kš
œ˜Kš
œ˜—šœœ
œ˜4Kš
œ0˜0—Kšœ
˜—Kšœœ
œS˜ršœ˜Kš
˜Kš
œ˜K˜,šœ%œ˜:Kšœœ
˜Kšœœ
œ
˜ Kšœ
œ˜.Kš
œ˜Kš
œ"˜"—šœœ
œœ
˜;Kš
œ˜Kš
œ"˜"K˜Kš
œ
˜
Kšœœ
˜Kšœœ
˜Kšœœ
˜Kšœœ
˜Kšœœ
˜Kš
œ$˜$Kšœœ
˜Kš
œ˜K˜šœœ˜(Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ ˜ Kš
œ ˜ Kš
œ&˜&Kš
œ(˜(Kš
œ(˜(Kš
œ.˜.Kš
œ˜Kš
œ"˜"——šœœ
œ˜3Kš
œ/˜/Kš
œ‹
˜‹
Kš
œ(˜(šœœ
œ˜Kš
œ6˜6Kš
œs˜sKš
œ˜—Kšœ
œœ;˜`Kšœ
˜—K˜1Kšœ
˜—Kšœ
˜—Kšœœ
˜—Kšœœ
˜K˜šœ
œ
˜K˜)K˜#K˜K˜Kšœ
˜—K˜Kšœœ
˜K˜"šœœ
˜K˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœ
˜—Kš
œ"˜"Kšœ
˜—K˜š œœ-œ˜KKš
˜šœ˜
Kš
˜Kšœœœ˜6Kšœœ˜/Kš
˜—Kšœ
œœœ˜=Kšœ
œ
˜Kšœ
˜—K˜š œœœ˜?Kš
˜Kšœœ˜Kš	œœ
œœ
œ˜'Kšœก˜3Kš
œ˜šœ
œœ
˜Kšœœ"˜,Kšœœ
˜
Kšœœ
˜Kš
œ˜šœœœ
œ
œ˜:Kš
˜K˜Kšœœ
œ
˜ Kš
œœ
œœ-œ˜fKš
œ&˜&Kšœ5œ
œœ-œœ˜ 
Kš
˜—šœ
˜
Kšœ%œ
œœ-œ
œ˜‘
Kš
œ*˜*Kšœ
˜—Kšœœ
œ
œœ,œœ˜Š
K˜>Kšœœ
œ
œœœ˜bKšœœ.œ
œ	œIœ'œ$œ˜•K˜Kš
œ˜Kšœœ
œ
˜Kš
œœ
œœ=œ˜}Kšœ
˜—šœœ
œ#˜:šœœ
˜'Kš
˜Kšœœ˜)K˜>Kšœœ
œ
œœ*œ
œ˜ˆ
Kšœ
œœ.œ
œ	œIœ'œ$œ˜šKšœ
˜—Kšœ
˜—K˜Kšœ
˜—K˜š œœ˜šœ
œœ˜Kšœ
œœ
œœ
œœ
œ	˜$Kš
œ˜Kšœ˜——K˜š œœœœ˜DKš
˜Kšœœ
˜Kš
œ	œ%œ
œ
œ˜MKšœ7œ
œ˜bKšœœ
˜Kšœ
˜—K˜š œœ
œœœ	œ˜KKš
˜šœœ
œ˜'Kšœœ
œ˜,Kšœ
˜—Kšœ˜Kšœ
˜—K˜š œœœ˜EKš
˜K˜K˜K˜$Kšœœ
œ˜&Kš
œœ
œœ*œ˜mšœ œœ
˜6Kšœœ
œ1˜?K˜Kš
œ˜Kšœ	œ
œ
œ
˜Kšœœ˜Kš
œ&˜&Kšœœœœ˜1Kšœ
˜—Kšœ˜Kšœ
˜—K˜š œœœ4˜VKš
˜K˜šœœ˜Kš
œ&˜&Kšœœ3˜LKšœ
˜—Kšœ
˜—K˜Kšœœœ)˜HK˜š œœ ˜<Kš
˜Kšœœ
œ˜5Kšœ
œ:œ
˜LKšœ˜Kšœ
˜—K˜š
 œœ
œœœ
œ˜HKš
˜K˜%K˜Kšœœ
œ
œœœ˜9K˜7K˜K˜K˜K˜K˜K˜K˜Kšœ
˜—K˜š œœœ˜JKš
˜Kšœœ ˜*Kšœœ
œ
˜Kš
œ&œ
œ
œœ	˜Hš
œ ˜ Kš
œ˜Kš
œ˜Kš
œ!˜!—Kšœ
˜—K˜š œœ
œ)œœœ˜fKš
˜Kšœœ˜"šœœ
œ˜'K˜Kšœœ˜-Kšœœ˜.Kšœ
˜—Kšœ
˜—K˜š
 œœ
œ(œœ˜ZKš
˜Kš	œ
œ!œ
œœ
˜Wšœœ
˜Kš
œœœœœ
œ
œ˜_Kšœœ
œœœœ
œ
œ˜pKšœœ
œœ
˜8Kšœœ˜—Kšœ
˜—K˜š 
œœ
œœ œœœ
œœœ˜Œ
Kš
˜Kšœœ˜'Kšœœ˜!šœœ
˜K˜K˜K˜Kš
œ˜K˜K˜K˜K˜K˜Kš
œ˜—K˜K˜Kš	œ"œœœ#œ˜y˜ Kš
ก7˜7—Kšœœ
œ8˜YKšœœ
œ
œœœ˜JKšœ
œœ#˜?Kšœ
˜—K˜š 
œœ˜,Kš
˜Kš	œœ
œœ
œ˜+Kšœ3œ˜8šœœ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜—K˜šœ
œœ˜šœ	œ˜K˜EKšœ/˜1Kšœ˜Kšœ˜Kšœ4˜6—Kšœœ˜—Kšœ
˜—K˜š 	œœ
œ3œ˜SKš
˜Kš
œœ	œœ
œ
˜$Kšœœ
œ
œ
˜Kš
œI˜IKšœ
˜—K˜š 
œœ
œ,œ˜MKš
˜Kšœœ
œ@˜mKšœœ
œ@˜mKšœ
˜Kšœ
˜—K˜š
 œœ
œœœ˜RKš
˜Kšœœ
œœ
˜Kšœœ
˜
Kš
œ)˜)Kš	œœ
œœœ˜)K˜
KšœœD˜MKšœ
˜—K˜Kš	œœœ
œ
œ
˜Kšœœœ
œ
œ
œ
˜Kšœœœ˜-K˜Kšœœ6˜HK˜Kšœ
œœ˜'šœœœ˜Kšœœœ
˜$Kš
œ#˜#—K˜Kšœœ
˜Kšœœ˜,K˜š œกBœ˜WKš
˜Kšœœœ
˜K˜K˜Kšœœ
œœ˜6Kšœœ
œœœ
œ
˜TKšœ˜Kšœ
˜—K˜š œ˜Kš
˜š	 œœœœ˜=Kš
˜Kšœ˜Kšœ
˜—Kšœœœ˜*K˜Kšœœ#˜.Kšœœ
˜Kšœœ
œ
˜Kšœ	œ
œ
œ˜7šœœ
˜Kš
˜Kšœœ
œ˜+Kšœ˜%Kšœ
˜—Kšœ
œ
œœœ
œ ˜QKš
œ&œ,œ
œ
œ˜ˆ
Kšœœ	œ
œ
œ
œ
œ
œœ
œ˜rKšœœ˜+Kšœ
˜—K˜š œœœ˜1Kš
˜Kšœœ
˜šœœ
˜Kšœœ˜K˜Kšœ
˜—Kšœ
˜—K˜š
 œœœœœ˜7Kš
˜š œœœ	œ
œœœ˜>Kš
˜Kšœœ
˜
Kšœœ
˜	šœ
œ
œœœ
˜'Kš
˜KšœCœ˜IKšœœ˜Kšœ
˜—Kšœœ˜š'œœœ
œ
œ
œœ
œ
œ
œ
œœ
œœœ
œ
œœœ
˜
Kš
˜KšœCœ˜IKšœœ˜Kšœ
˜—šœœœ
˜Kšœœ˜
Kšœœ˜Kšœœ
˜—Kšœ%œ˜3Kšœ
˜—šœœ
˜Kšœœ
˜šœœœ
œ
œ
œœœ
˜<Kš
˜KšœCœ˜IKšœœ˜
Kšœ
˜—šœ!œœ
˜7Kšœ!œ
œ
˜-Kšœ
˜—šœœ
œ
˜Kš
˜Kšœ8œ˜>Kšœœ˜
Kšœ
˜—K˜Kšœœ
˜Kšœ
˜—Kšœ˜
Kšœ
˜—K˜š 
œœ
œœ
œ
œœœ˜UKš
˜Kš	œœ
œ
œœ
˜Kš
œ˜šœœ
˜Kšœ
œœœ
œœ'˜Yšœœ
˜Kš	œ
œ	œsœœ˜“
—Kšœœ˜ K˜K˜Kšœ
˜—Kšœ
˜—K˜š 
œœ
œœ
œ
œœœ˜UKš
˜Kš	œœ
œ
œœ
˜K˜šœ
œ
˜Kšœ
œœœ
œœ'˜Yšœœ
˜Kšœ
œ	œœœ)œœœ˜“
—Kšœœ˜ K˜K˜Kšœ
˜—K˜(Kšœ
˜—K˜K˜Kšœœ
˜K˜š œ˜)Kš
˜Kš
œ˜Kšœoœ
œ˜…
Kšœœ˜Kšœ
˜—K˜š œœ˜
Kš
˜Kšœ0œ˜OKšœ0œ˜OKšœ0œ˜M˜Kš
œ˜K˜Kšœœ'˜@—K˜Kšœ
˜—K˜K˜K˜Kšœ
˜—…—\ฦ{X