CoreOpsImpl.mesa
Copyright Ó 1985, 1987 by Xerox Corporation. All rights reserved.
Barth, December 4, 1986 5:04:52 pm PST
Spreitzer, April 8, 1986 4:34:16 pm PST
Bertrand Serlet July 16, 1987 8:06:11 pm PDT
Louis Monier May 1, 1986 4:44:41 pm PDT
Pradeep Sindhu February 24, 1986 6:48:20 pm PST
Mike Spreitzer March 6, 1987 1:34:44 pm PST
Last Edited by: Louis Monier January 16, 1987 1:16:31 pm PST
Jean-Marc Frailong December 26, 1987 8:11:48 pm PST
Don Curry November 6, 1987 10:06:18 am PST
Last tweaked by Mike Spreitzer on November 2, 1987 3:41:25 pm PST
DIRECTORY AMTypes, CedarProcess, Commander, Core, CoreOps, CoreProperties, GList, IO, PrintTV, ProcessProps, RefTab, RefTabExtras, SymTab, Rope, RopeList;
CoreOpsImpl: CEDAR PROGRAM
IMPORTS CedarProcess, CoreProperties, GList, IO, PrintTV, ProcessProps, RefTab, RefTabExtras, SymTab, Rope, RopeList
EXPORTS CoreOps =
BEGIN OPEN Core, CoreOps;
Property
nameProp: PUBLIC ATOM ← CoreProperties.RegisterProperty[$CoreName, CoreProperties.Props[[CoreProperties.propPrint, CoreProperties.PropDontPrint]]];
Cell Classes
printClassProcProp: ATOM ← CoreProperties.RegisterProperty[$CorePrintClassProc];
SetClassPrintProc: PUBLIC PROC [class: CellClass, proc: PrintClassProc] RETURNS [sameClass: CellClass] = {
CoreProperties.PutCellClassProp[on: class, prop: printClassProcProp, value: NEW[PrintClassProc ← proc]];
sameClass ← class;
};
Cell Types
CreateCellType: PUBLIC PROC [class: CellClass, public: WireSeq, data: REF ANY ← NIL, name: ROPE ← NIL, props: Properties ← NIL] RETURNS [cellType: CellType] = {
cellType ← NEW [CellTypeRec ← [class: class, public: public, data: data, properties: props]];
IF name#NIL THEN cellType ← SetCellTypeName[cellType, name];
};
SetCellTypeName: PUBLIC PROC [cellType: CellType, name: ROPE] RETURNS [sameCellType: CellType] = {
CoreProperties.PutCellTypeProp[cellType, nameProp, name];
sameCellType ← cellType;
};
GetCellTypeName: PUBLIC PROC [cellType: CellType] RETURNS [name: ROPE ← NIL] = {
name ← NARROW [CoreProperties.GetCellTypeProp[cellType, nameProp]];
};
InheritCellTypeName: PUBLIC PROC [cellType: CellType] RETURNS [name: ROPE ← NIL] = {
DO
name ← NARROW [CoreProperties.GetCellTypeProp[cellType, nameProp]];
IF name#NIL OR NOT cellType.class.layersProps THEN EXIT;
cellType ← Recast[cellType];
ENDLOOP;
};
recastCacheProp: ATOM ← CoreProperties.RegisterProperty[$CoreRecastCache];
Recast: PUBLIC PROC [me: CellType, fillCacheIfEmpty: BOOL ← TRUE] RETURNS [new: CellType] = {
new ← NARROW[CoreProperties.GetCellTypeProp[me, recastCacheProp]];
IF new=NIL THEN {
IF me.class.recast=NIL THEN ERROR; -- Caller error. No recast proc on this class. Trap it here so that this comment is obvious to a user instead of getting an error window with a control fault in it.
new ← me.class.recast[me];
IF new#me AND fillCacheIfEmpty THEN CoreProperties.PutCellTypeProp[me, recastCacheProp, new];
};
};
RecastBindingTable: PUBLIC PROC [cellType: CellType] RETURNS [table: RefTab.Ref] = {
table ← NARROW [CoreProperties.GetCellTypeProp[cellType, $CoreRecastBindingTableCache]];
IF table=NIL THEN {
recasted: CellType ← Recast[cellType];
IF recasted#cellType THEN {
table ← CreateBindingTable[cellType.public, recasted.public];
CoreProperties.PutCellTypeProp[cellType, $CoreRecastBindingTableCache, table];
};
};
};
ToBasic: PUBLIC PROC [cellType: Core.CellType] RETURNS [basic: Core.CellType] = {
FOR basic ← cellType, Recast[basic] UNTIL basic.class.recast = NIL DO NULL ENDLOOP;
};
PrintCellType: PUBLIC PROC [cellType: CellType, out: STREAM ← NIL, indent: NAT ← 0, level: NAT ← 2] = {
classProc: REF PrintClassProc;
IF out=NIL THEN out ← NARROW [ProcessProps.GetProp[$CommanderHandle], Commander.Handle].out;
IO.PutF[out,
"\n\n%g: %g Cell Type",
[rope[GetCellTypeName[cellType]]],
[rope[cellType.class.name]]
];
IO.PutRope[out, "\nPublic wire:"];
PrintWire[cellType.public, out, indent+1, level];
IF (classProc ← NARROW [CoreProperties.GetProp[from: cellType.class.properties, prop: printClassProcProp]]) # NIL THEN classProc[cellType.data, out, indent, level];
CoreProperties.PrintProperties[props: cellType.properties, out: out, indent: indent, level: level];
};
PrintIndent: PUBLIC PROC [indent: NAT, out: STREAM, cr: BOOL ← TRUE] = {
IF cr
THEN {
IO.PutChar[out, IO.CR];
FOR i: NAT IN [0..indent) DO IO.PutRope[out, " "] ENDLOOP
}
ELSE IO.PutRope[out, ", "]
};
Wire Creation
CreateWire: PUBLIC PROC [elements: Wires ← NIL, name: ROPE ← NIL, props: Properties ← NIL] RETURNS [wire: Wire] = {
size: NAT ← GList.Length[elements];
wire ← CreateWires[size, name, props];
size ← 0;
FOR c: Wires ← elements, c.rest UNTIL c=NIL DO
wire[size] ← c.first;
size ← size + 1;
ENDLOOP;
};
CreateWires: PUBLIC PROC [size: NAT, name: ROPE ← NIL, props: Properties ← NIL] RETURNS [wire: Wire] = {
wire ← NEW [WireRec[size]];
wire.properties ← props;
IF name#NIL THEN CoreProperties.PutWireProp[wire, nameProp, name];
};
SubrangeWire: PUBLIC PROC [wire: Wire, start, size: NAT, name: ROPE ← NIL, props: Properties ← NIL] RETURNS [sub: Wire] = {
sub ← CreateWires[size, name, props];
FOR i: NAT IN [0 .. size) DO
sub[i] ← wire[start+i];
ENDLOOP;
};
CopyWire: PUBLIC PROC [wire: Wire] RETURNS [new: Wire] = {
new ← IF wire=NIL THEN NIL ELSE CopyWireUsingTable[wire, RefTab.Create[], TRUE];
};
CopyWireUsingTable: PUBLIC PROC [old: Wire, oldToNew: RefTab.Ref, copyName: BOOL ← TRUE] RETURNS [new: Wire] = {
new ← NARROW [RefTab.Fetch[oldToNew, old].val];
IF new#NIL THEN RETURN;
new ← CreateWires[size: old.size, name: IF copyName THEN GetShortWireName[old] ELSE NIL];
[] ← RefTab.Insert[oldToNew, old, new];
FOR i: NAT IN [0 .. old.size) DO
new[i] ← CopyWireUsingTable[old[i], oldToNew, copyName];
ENDLOOP;
};
UnionWire: PUBLIC PROC [wire1, wire2: Wire, name: ROPE ← NIL, props: Properties ← NIL] RETURNS [union: Wire] = {
union ← CreateWires[size: wire1.size+wire2.size, name: name, props: props];
FOR i: NAT IN [0 .. wire1.size) DO union[i] ← wire1[i] ENDLOOP;
FOR i: NAT IN [0 .. wire2.size) DO union[wire1.size+i] ← wire2[i] ENDLOOP;
};
Wire Enumeration
VisitWire: PUBLIC PROC [wire: Wire, eachWire: EachWireProc] RETURNS [quit: BOOL] = {
subWires: BOOL;
[subWires, quit] ← eachWire[wire];
IF quit OR NOT subWires THEN RETURN;
FOR i: NAT IN [0 .. wire.size) DO
IF VisitWire[wire[i], eachWire] THEN RETURN [TRUE];
ENDLOOP;
quit ← FALSE;
};
VisitWireSeq: PUBLIC PROC [seq: WireSeq, eachWire: EachWireProc] RETURNS [quit: BOOL] = {
FOR i: NAT IN [0 .. seq.size) DO
IF VisitWire[seq[i], eachWire] THEN RETURN [TRUE];
ENDLOOP;
quit ← FALSE;
};
VisitRootAtomics: PUBLIC PROC [root: WireSeq, eachWire: PROC [Wire]] = {
VisitAtomicWires: PROC [wire: Wire] = {
IF wire.size=0 THEN eachWire[wire]
ELSE FOR i: NAT IN [0 .. wire.size) DO VisitAtomicWires[wire[i]] ENDLOOP;
};
FOR i: NAT IN [0 .. root.size) DO VisitAtomicWires[root[i]] ENDLOOP;
};
VisitBinding: PUBLIC PROC [actual, public: Wire, eachWirePair: EachWirePairProc] RETURNS [quit: BOOL] = {
subWires: BOOL;
IF actual.size#public.size THEN RETURN [TRUE]; -- wires do not conform
[subWires, quit] ← eachWirePair[actual, public];
IF quit OR NOT subWires THEN RETURN;
FOR i: NAT IN [0 .. actual.size) DO
IF VisitBinding[actual[i], public[i], eachWirePair] THEN RETURN [TRUE];
ENDLOOP;
quit ← FALSE;
};
VisitBindingSeq: PUBLIC PROC [actual, public: WireSeq, eachWirePair: EachWirePairProc] RETURNS [quit: BOOL] = {
IF actual.size#public.size THEN RETURN [TRUE]; -- wires do not conform
FOR i: NAT IN [0 .. actual.size) DO
IF VisitBinding[actual[i], public[i], eachWirePair] THEN RETURN [TRUE];
ENDLOOP;
quit ← FALSE;
};
CorrespondingActual: PUBLIC PROC [actual, public: WireSeq, subPublic: Wire] RETURNS [subActual: Wire] ~ {
Find subActual corresponding to subPublic. Returns NIL if wires don't tree-conform or if not found. Just a speedup on a trivial VisitBindingSeq.
IF actual.size#public.size THEN RETURN [NIL]; -- non-conform
FOR i: NAT IN [0..actual.size) DO
subActual ← CorrespondingActualInternal[actual: actual[i], public: public[i], subPublic: subPublic];
IF subActual#NIL THEN RETURN;
ENDLOOP;
RETURN [NIL]; -- not found anywhere
};
CorrespondingActualInternal: PROC [actual, public: Wire, subPublic: Wire] RETURNS [subActual: Wire] ~ {
Plain Wire version of CorrespondingActual.
IF actual.size#public.size THEN RETURN [NIL]; -- non-conform
FOR i: NAT IN [0..actual.size) DO
subActual ← CorrespondingActualInternal[actual: actual[i], public: public[i], subPublic: subPublic];
IF subActual#NIL THEN RETURN;
ENDLOOP;
RETURN [NIL]; -- not found anywhere
};
Conform: PUBLIC PROC [actual, public: Wire] RETURNS [BOOL] = {
This procedure only checks that the tree structure conforms, not the DAG structure
IF actual.size#public.size THEN RETURN [FALSE]; -- non conform root
FOR i: NAT IN [0..actual.size) DO
IF NOT Conform[actual[i], public[i]] THEN RETURN [FALSE]; -- non conform subwire
ENDLOOP;
RETURN [TRUE]; -- the wires conform
};
DAGConform: PROC [actual, public: Wire, p2a: RefTab.Ref] RETURNS [BOOL] ~ {
Conform wires as DAGs (as Conform). p2a must be non-NIL (normally empty on top-level call). actual may be more tightly connected than public ...
found: BOOL; ra: REF ANY;
[found, ra] ← RefTab.Fetch[p2a, public];
IF found THEN RETURN [ra=actual];
IF NOT RefTab.Insert[p2a, public, actual] THEN ERROR; -- cannot happen (not found !)
IF actual.size#public.size THEN RETURN [FALSE]; -- root failed
FOR i: NAT IN [0..actual.size) DO
IF NOT DAGConform[actual[i], public[i], p2a] THEN RETURN [FALSE]; -- subwire failed
ENDLOOP;
RETURN [TRUE];
};
CorrectConform: PUBLIC PROC [actual, public: WireSeq] RETURNS [BOOL] = {
This procedure checks full DAG conformity
p2a: RefTab.Ref ← RefTab.Create[]; -- must go public->actual (not reverse !!!)
IF actual.size#public.size THEN RETURN [FALSE]; -- non-conform roots
FOR i: NAT IN [0..actual.size) DO
IF NOT DAGConform[actual[i], public[i], p2a] THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE];
};
CountBits: PROC [wire: Wire, visitTab: RefTab.Ref] RETURNS [bits: NAT ← 0] = {
Count the number of different wires in wire. visitTab must be non-NIL.
IF RefTab.Fetch[visitTab, wire].found THEN RETURN; -- no new bits here
IF NOT RefTab.Insert[visitTab, wire, NIL] THEN ERROR;
IF wire.size=0 THEN RETURN [bits: 1];
FOR sub: NAT IN [0..wire.size) DO
bits ← bits + CountBits[wire[sub], visitTab];
ENDLOOP;
};
WireBits: PUBLIC PROC [wire: Wire] RETURNS [bits: NAT] = {
bits ← CountBits[wire, RefTab.Create[]];
};
WireSeqBits: PUBLIC PROC [seq: WireSeq] RETURNS [bits: NAT ← 0] = {
visitTab: RefTab.Ref ← RefTab.Create[];
FOR i: NAT IN [0 .. seq.size) DO bits ← bits + CountBits[seq[i], visitTab] ENDLOOP;
};
CreateBindingTable: PUBLIC PROC [wire1, wire2: Wire] RETURNS [table: RefTab.Ref] = {
AddInTable: EachWirePairProc = {[] ← RefTab.Store[table, actualWire, publicWire]};
table ← RefTab.Create[wire1.size];
[] ← VisitBinding[wire1, wire2, AddInTable];
};
VisitAtomicPairs: PUBLIC PROC [wire1, wire2: Wire, eachPair: PROC [Wire, Wire]] ~ {
Visit the two wires in parallel as trees and call back for each pair of atomics. Raise error if the wires do not conform as trees.
VisitAtomicPairsInternal: PROC [wire1, wire2: Wire] ~ {
IF wire1.size#wire2.size THEN ERROR; -- structure mismatch
IF wire1.size=0 THEN eachPair[wire1, wire2]
ELSE FOR i: NAT IN [0 .. wire1.size) DO
VisitAtomicPairsInternal[wire1[i], wire2[i]];
ENDLOOP;
};
IF wire1.size#wire2.size THEN ERROR;
FOR i: NAT IN [0 .. wire1.size) DO VisitAtomicPairsInternal[wire1[i], wire2[i]] ENDLOOP;
};
Wire Naming
GetShortWireName: PUBLIC PROC [wire: Wire] RETURNS [name: ROPE ← NIL] = {
name ← NARROW [CoreProperties.GetWireProp[wire, nameProp]];
};
SetShortWireName: PUBLIC PROC [wire: Wire, name: ROPE] RETURNS [sameWire: Wire] = {
CoreProperties.PutWireProp[wire, nameProp, name];
sameWire ← wire;
};
GetWireIndex: PUBLIC PROC [wire: Wire, name: ROPE] RETURNS [n: INT ← -1] ~ {
FOR i: NAT IN [0..wire.size) DO
IF Rope.Equal[name, GetShortWireName[wire[i]]] THEN RETURN [i];
ENDLOOP;
};
wireToNamesCacheProp: ATOM ← CoreProperties.RegisterProperty[$CoreWireToNamesCache, CoreProperties.Props[[CoreProperties.propPrint, CoreProperties.PropDontPrint]]];
Association wire -> list of full names
nameToWireCacheProp: ATOM ← CoreProperties.RegisterProperty[$CoreNameToWireCache, CoreProperties.Props[[CoreProperties.propPrint, CoreProperties.PropDontPrint]]];
Association full name -> wire
FullWireNames: PRIVATE PROC [root: Wire] RETURNS [wireToNames, nameToWire: RefTab.Ref] = {
SetName: PUBLIC PROC [wire: Wire, name: ROPE] = {
names: LIST OF ROPE ← NARROW [RefTab.Fetch[wireToNames, wire].val];
previousWire: Wire ← NARROW [RefTab.Fetch[nameToWire, name].val];
IF name#NIL AND NOT RopeList.Memb[names, name] THEN {
names ← CONS [name, names];
[] ← RefTab.Store[wireToNames, wire, names];
};
IF name#NIL AND ~RefTab.Insert[nameToWire, name, wire] AND previousWire#wire THEN ERROR; -- two different wires have the same name relative to this root
FOR i: NAT IN [0 .. wire.size) DO
short: ROPE ← GetShortWireName[wire[i]];
SetName[wire[i], SELECT TRUE FROM
short=NIL   => Index[name, i],
name=NIL   => short,
ENDCASE   => Rope.Cat[name, ".", short]];
ENDLOOP;
};
wireToNames ← NARROW [CoreProperties.GetWireProp[root, wireToNamesCacheProp]];
nameToWire ← NARROW [CoreProperties.GetWireProp[root, nameToWireCacheProp]];
IF wireToNames#NIL AND nameToWire#NIL THEN RETURN;
wireToNames ← RefTab.Create[WireBits[root]];
nameToWire ← RefTab.Create[WireBits[root], RefTabExtras.EqualRope, RefTabExtras.HashRope];
SetName has GetShortWireName[wire] instead of NIL to make full names also work for wires in their own context, as in Sisyph.
SetName[root, GetShortWireName[root]];
CoreProperties.PutWireProp[root, wireToNamesCacheProp, wireToNames];
CoreProperties.PutWireProp[root, nameToWireCacheProp, nameToWire];
};
GetFullWireNames: PUBLIC PROC [root: WireSeq, wire: Wire] RETURNS [names: LIST OF ROPE ] = {
names ← NARROW [RefTab.Fetch[FullWireNames[root].wireToNames, wire].val];
};
GetFullWireName: PUBLIC PROC [root: WireSeq, wire: Wire] RETURNS [name: ROPE ← NIL] = {
names: LIST OF ROPE ← GetFullWireNames[root, wire];
WHILE names#NIL DO
IF name=NIL OR (Rope.Fetch[name]='[ AND Rope.Fetch[names.first]#'[) OR Rope.Length[names.first]<Rope.Length[name] OR (Rope.Length[names.first]=Rope.Length[name] AND Rope.Compare[names.first, name]=less) THEN name ← names.first;
names ← names.rest;
ENDLOOP;
};
IsFullWireName: PUBLIC PROC [root: WireSeq, wire: Wire, name: ROPE] RETURNS [BOOL] = {
RETURN [RopeList.Memb[GetFullWireNames[root, wire], name]]
};
FindWire: PUBLIC PROC [root: WireSeq, name: ROPE] RETURNS [wire: Wire ← NIL] = {
wire ← NARROW [RefTab.Fetch[FullWireNames[root].nameToWire, name].val];
};
ParseWireName: PUBLIC PROC [name: ROPE] RETURNS [base: ROPE, components: LIST OF ROPE ← NIL] = {
endBase: INT ← MIN [Rope.Index[name, 0, "."], Rope.Index[name, 0, "["]];
base ← Rope.Substr[name, 0, endBase];
name ← Rope.Substr[name, endBase];
WHILE Rope.Length[name]#0 DO
SELECT Rope.Fetch[name] FROM
'[  => {
endBracket: INT ← Rope.Find[name, "]"];
IF endBracket=-1 THEN ERROR; -- malformed name
components ← CONS [Rope.Substr[name, 1, endBracket-1], components];
name ← Rope.Substr[name, endBracket+1];
};
'.  => {
endField: INT ← MIN [Rope.Index[name, 1, "."], Rope.Index[name, 1, "["]];
components ← CONS [Rope.Substr[name, 1, endField-1], components];
name ← Rope.Substr[name, endField];
};
ENDCASE => ERROR; -- malformed name
ENDLOOP;
components ← RopeList.Reverse[components];
};
PrintWire: PUBLIC PROC [wire: Wire, out: STREAM ← NIL, indent: NAT ← 0, level: NAT ← 2] = {
name: ROPE ← GetShortWireName[wire];
PrintAWire: PROC [wire: Wire, indent: NAT, level: NAT, name: ROPE, cr, firstWire: BOOL, recur: NAT] = {
CedarProcess.CheckAbort[];
PrintIndent[indent, out, cr OR firstWire];
IO.PutRope[out, name];
IF recur=1 AND Rope.Match["[*]", name] THEN out.PutF["(%g^)", IO.int[LOOPHOLE[wire]]];
IF wire.size#0 THEN IO.PutF[out, ", %g elements", IO.int[wire.size]];
CoreProperties.PrintProperties[props: wire.properties, out: out, indent: indent+1, cr: cr, level: level];
IF wire.size#0 AND (level=0 OR AllSimpleAtomics[wire])
THEN IO.PutRope[out, " [...] "]
ELSE FOR i: NAT IN [0 .. wire.size) DO
subName: ROPE ← GetShortWireName[wire[i]];
IF subName=NIL THEN subName ← Index[NIL, i];
PrintAWire[wire[i], indent+1, level-1, subName, cr AND wire.size<=32, cr AND i=0, recur+1];
ENDLOOP;
};
IF out=NIL THEN out ← NARROW[ProcessProps.GetProp[$CommanderHandle], Commander.Handle].out;
PrintAWire[wire, indent, level, IF name#NIL THEN name ELSE "<no name>", TRUE, TRUE, 0];
};
AllSimpleAtomics: PROC[w: Wire] RETURNS[BOOL] = {
FOR ii: NAT IN [0..w.size) DO
IF w[ii].size#0 OR HasPrintableProp[w[ii]] THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE]};
HasPrintableProp: PROC[w: Wire] RETURNS[printable: BOOL ← FALSE] = {
Consume: PROC [prop: ATOM, val: REF ANY] = {
PP: CoreProperties.PropPrintProc ~ CoreProperties.GetPropPrintProc[prop, val];
IF PP # CoreProperties.PropDontPrint^ THEN {printable ← TRUE; RETURN};
};
IF GetShortWireName[w]#NIL THEN RETURN[TRUE];
CoreProperties.Enumerate[w.properties, Consume]};
FlushNameCaches: PUBLIC PROC [root: WireSeq] = {
CoreProperties.PutWireProp[root, wireToNamesCacheProp, NIL];
CoreProperties.PutWireProp[root, nameToWireCacheProp, NIL];
};
Wires Operations
Reverse: PUBLIC PROC [wires: Wires] RETURNS [revWires: Wires ← NIL] = {
revWires ← NARROW [GList.Reverse[wires]];
};
Delete: PUBLIC PROC [wires: Wires, wire: Wire] RETURNS [newWires: Wires ← NIL] = {
WHILE wires#NIL DO
IF wires.first#wire THEN newWires ← CONS [wires.first, newWires];
wires ← wires.rest;
ENDLOOP;
};
Member: PUBLIC PROC [wires: Wires, wire: Wire] RETURNS [BOOL] = {
RETURN [GList.Member[wire, wires]];
};
ParentWires: PUBLIC PROC [root, candidate: Wire] RETURNS [parents: LIST OF Wire ← NIL] = {
FindActual: EachWireProc = {
FOR i: NAT IN [0 .. wire.size) DO
IF wire[i]=candidate AND NOT Member[parents, wire] THEN parents ← CONS [wire, parents];
ENDLOOP;
};
[] ← VisitWire[root, FindActual];
};
RecursiveMember: PUBLIC PROC [wire, candidate: Wire] RETURNS [BOOL] = {
IF wire=candidate THEN RETURN [TRUE]; -- found it
FOR i: NAT IN [0..wire.size) DO
IF RecursiveMember[wire[i], candidate] THEN RETURN [TRUE];
ENDLOOP;
RETURN [FALSE];
};
Miscellaneous
brackets: ARRAY [0 .. 32) OF ROPE = [
"[0]", "[1]", "[2]", "[3]", "[4]", "[5]", "[6]", "[7]", "[8]", "[9]",
"[10]", "[11]", "[12]", "[13]", "[14]", "[15]", "[16]", "[17]", "[18]", "[19]",
"[20]", "[21]", "[22]", "[23]", "[24]", "[25]", "[26]", "[27]", "[28]", "[29]",
"[30]", "[31]"];
Speed up hack for making new wire names
Index: PUBLIC PROC [rope: ROPE, index: NAT] RETURNS [indexed: ROPE] = {
RETURN [IF index<32
THEN Rope.Concat[rope, brackets[index]]  -- speed up hack!
ELSE Rope.Cat[rope, "[", IO.PutR1[IO.int[index]], "]"]
];
};
FixStupidRef: PUBLIC PROC [ref: REF ANY] RETURNS [rope: ROPE] = {
IF ref=NIL THEN RETURN [NIL];
rope ← WITH ref SELECT FROM
r: REF TEXT  => Rope.FromRefText[r],
r: ROPE  => r,
ENDCASE   => ERROR;
};
Print: PUBLIC PROC [ref: REF, out: STREAM ← NIL, indent: NAT ← 0, level: NAT ← 2] = {
IF out=NIL THEN out ← NARROW [ProcessProps.GetProp[$CommanderHandle], Commander.Handle].out;
WITH ref SELECT FROM
wire: Wire  => PrintWire[wire, out, indent, level];
wires: Wires  => WHILE wires#NIL DO
PrintWire[wires.first, out, indent, level];
wires ← wires.rest;
ENDLOOP;
cellType: CellType => PrintCellType[cellType, out, indent, level];
table: SymTab.Ref => {
EachItem: SymTab.EachPairAction ~ {
key is the variable name, val is the TV. Both are REF ANY.
var: Rope.ROPE = NARROW [key];
tv: AMTypes.TV = NARROW [val];
IO.PutF[out, "%l%g%l : ", IO.rope["b"], IO.rope[var], IO.rope["B"]];
IF tv#NIL THEN PrintTV.Print[tv, out] ELSE IO.PutF[out, "-- Not initialized --"];
IO.PutF[out, "\n"];
};
[] ← SymTab.Pairs[table, EachItem];
};
ENDCASE  => IO.PutRope[out, IF ref=NIL THEN "NIL\n" ELSE "*** CoreOps.Print Does not know how to print argument\n"];
};
END.