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;
nameProp: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CoreName, CoreProperties.Props[[CoreProperties.propPrint, CoreProperties.PropDontPrint]]];
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;
};

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, ", "]
};
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;
};

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] ~ {
IF actual.size#public.size THEN RETURN [subActual: 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 [subActual: NIL]; -- not found anywhere
};

CorrespondingActualInternal: PROC [actual, public: Wire, subPublic: Wire] RETURNS [subActual: Wire] ~ {
IF actual.size#public.size THEN RETURN [subActual: NIL]; -- non-conform
IF public=subPublic THEN RETURN [subActual: actual];
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 [subActual: NIL]; -- not found anywhere
};

Conform: PUBLIC PROC [actual, public: Wire] RETURNS [BOOL] = {
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] ~ {
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] = {
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] = {
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]] ~ {
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;
};
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]]];

nameToWireCacheProp: ATOM _ CoreProperties.RegisterProperty[$CoreNameToWireCache, CoreProperties.Props[[CoreProperties.propPrint, CoreProperties.PropDontPrint]]];

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[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];
};
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];
};
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]"]; 
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 ~ {
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.

^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 28, 1987 3:24:47 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

Property
Cell Classes
Cell Types
Wire Creation
Wire Enumeration
Find subActual corresponding to subPublic. Returns NIL if wires don't tree-conform or if not found. Just a speedup on a trivial VisitBindingSeq.
Plain Wire version of CorrespondingActual.
This procedure only checks that the tree structure conforms, not the DAG structure
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 ...
This procedure checks full DAG conformity
Count the number of different wires in wire. visitTab must be non-NIL.
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.
Wire Naming
Association wire -> list of full names
Association full name -> wire
SetName has GetShortWireName[wire] instead of NIL to make full names also work for wires in their own context, as in Sisyph.
Wires Operations
Miscellaneous
Speed up hack for making new wire names

key is the variable name, val is the TV. Both are REF ANY.
Κ7–

"cedar" style˜
codeš
œ™Kš
œB™BK™&K™'K™,K™'K™/K™+K™<K™3K™*K™AK™—KšΟk	œIœF˜š
K˜•StartOfExpansion[]šΟnœœ
˜Kšœ&œE˜tKšœ˜Kšœ
œ˜—
headš
œ™Kšœ
œ
œ~˜“
—™šœœ8˜PK˜—šžœœ
œ*œ˜jKšœLœ˜hKš
œ˜K˜K˜——™
šžœœ
œ+œ
œœœœœœ˜‘
KšœœO˜]Kšœœ
œ,˜<K˜K˜—š
žœœ
œœœ˜bKš
œ9˜9Kš
œ˜K˜K˜—šžœœ
œœœœ˜PKšœœ6˜CK˜K˜—šžœœ
œœœœ˜Tš
˜Kšœœ6˜CKšœœ
œ
œœ
œ
˜8Kš
œ˜Jšœ
˜—K˜K˜—šœœ5˜JK˜—šžœœ
œ"œœœ˜]Kšœœ6˜Bšœœ
œ˜Kš	œœ
œ
œΟc¦
˜Κ
Kš
œ˜Kšœœœ:˜]K˜—K˜K˜—šžœœ
œœ˜TKšœœJ˜Xšœœ
œ˜K˜&šœœ˜Kš
œ>˜>Kš
œN˜NK˜—K˜—K˜K˜—šžœœ
œœ˜QKšœ!œœ
œ
œ
œ
˜SKš
œ˜K˜—šΠbn
œœ
œœœ
œ
œ	˜gKšœœ˜Kšœœ
œœ?˜\šœ
˜K˜Kš
œ"˜"Kš
œ˜K˜—Kšœ ˜"Kš
œ1˜1KšœœWœ
œ.˜€
Kš
œc˜cJ˜K˜—šžœœ
œ
œœœœ˜Hšœ˜šœ˜Kšœœ
œ˜Kšœœ
œ
œ
œ˜:K˜
—Kšœ
œ˜—K˜——™
šž
œœ
œœœœœœ˜sKšœœ˜#Kš
œ&˜&Kš
œ	˜	šœœœ
˜.Kš
œ˜Kš
œ˜Kšœ
˜—K˜K˜—šžœœ
œœœœœœ˜hKšœœ˜Kš
œ˜Kšœœ
œ2˜BK˜K˜—šžœœ
œœœœœœ˜{Kš
œ%˜%šœœ
œ
˜Kš
œ˜Kšœ
˜—Kš
œ˜K˜—šžœœ
œœ˜:Kš
œœœ
œ
œ
œ+œ˜PKš
œ˜K˜—šžœœ
œ-œœœ˜pKšœœ#˜/Kšœœ
œ
œ
˜Kš	œ(œ
œœ
œ˜YKš
œ'˜'šœœ
œ˜ Jš
œ8˜8Jšœ
˜—J˜K˜—šž	œœ
œœœœœ˜pKš
œK˜KKš
œœ
œœœ
˜?Kš
œœ
œœ œ
˜JK˜K˜——™š
ž	œœ
œ&œœ˜TJšœ
œ
˜Jš
œ"˜"Jš
œœ
œ
œ
œ
˜$šœœ
œ˜!Jšœœ
œœ˜3Jšœ
˜—Jšœœ
˜
Jš
œ˜J˜—š
žœœ
œ(œœ˜Yšœœ
œ˜ Jšœœ
œœ˜2Jšœ
˜—Jšœœ
˜
K˜K˜—šžœœœ˜Hšžœœ˜'Jšœ
œ˜#Kšœ
œœ
œœœ
˜IJš
œ˜—Jš
œœ
œœœ
˜DJš
œ˜J˜—š
 œœ
œ8œœ˜iJšœ
œ
˜Jš	œœ
œœŸ˜FJš
œ0˜0Jš
œœ
œ
œ
œ
˜$šœœ
œ˜#Jšœ2œ
œœ˜GJšœ
˜—Jšœœ
˜
Jš
œ˜J˜—š
žœœ
œ;œœ˜oKš	œœ
œœŸ˜Fšœœ
œ˜#Jšœ2œ
œœ˜GJšœ
˜—Jšœœ
˜
K˜K˜—šžœœ
œ,œ˜iKšœ3œZ™
Kš	œœ
œ
œŸ˜Gšœœ
œ˜!Kš
œd˜dKšœœ
œ
œ
˜Kšœ
˜—Kšœ
œŸ˜.K˜K˜—šžœœ)œ˜gK™*Kš	œœ
œ
œŸ˜GKšœœ
œ˜4šœœ
œ˜!Kš
œd˜dKšœœ
œ
œ
˜Kšœ
˜—Kšœ
œŸ˜.K˜K˜—š
žœœ
œœœ˜>K™RKš	œœ
œœŸ˜Cšœœ
œ˜!Kšœ
œœ
œœŸ˜PKšœ
˜—KšœœŸ˜#K˜K˜—šž
œœ)œœ˜KKšœ4œY™
Kšœœœ
œ
˜Kš
œ(˜(Kšœœ
œ
˜!Kš	œ
œ$œ
œŸ˜TKš	œœ
œœŸ˜>šœœ
œ˜!Kšœ
œ'œ
œœŸ˜SKšœ
˜—Kšœœ˜K˜K˜—š
žœœ
œœœ˜HKšœœ™)Kšœ#Ÿ+˜NKš	œœ
œœŸ˜Dšœœ
œ˜!Kš
œ
œ'œ
œœ˜AKšœ
˜—Kšœœ˜K˜K˜—šž	œœ$œœ	˜NKšœBœ
™FKšœ$œ
œŸ˜FKš
œ
œœœ
œ
˜5Kšœ
œ
œ˜%šœœ
œ˜!Kš
œ-˜-Kšœ
˜—K˜K˜—š
žœœ
œœœ˜:Kš
œ(˜(Kš
œ˜K˜—š
žœœ
œœœ	˜CKš
œ'˜'Kš
œœ
œœ+œ
˜SKš
œ˜K˜—šžœœ
œœ˜TKšž
œH˜RKš
œ"˜"Kš
œ,˜,K˜K˜—šžœœ
œ œ˜SK™‚
šžœœ˜7Kšœœ
œŸ˜:Kšœœ˜+š	œ
œœ
œ˜'Kš
œ-˜-Kšœ
˜—K˜—Kšœœ
œ
˜$Kš
œœ
œœ.œ
˜XK˜——™šžœœ
œœœœ˜IKšœœ.˜;K˜K˜—š
žœœ
œœœ˜SKš
œ1˜1Kš
œ˜K˜K˜—šžœœ
œœœœ
˜Lšœœ
œ˜Kšœ-œ
œ˜?Kšœ
˜—K˜K˜—šœœŠ
˜€
K™&K˜—šœœ‰
˜’
K™K˜—šž
œœ
œœ*˜Zšžœœ
œœ˜1Kš	œœ
œ
œœ'˜CKšœœ&˜Aš
œœ
œ
œœ˜5Kšœœ˜Kš
œ,˜,Kš
œ˜—Jš
œœ
œ(œœ
œŸ?˜˜
šœœ
œ˜!Kšœœ˜(šœœ
œ
˜!Kšœœ˜Kšœœ˜Kšœ"˜)—Jšœ
˜—K˜—Kšœœ:˜NKšœ
œ9˜LKšœ
œ
œœ
œ
œ
˜2Kš
œ,˜,Kš
œZ˜ZKš
œ|™|Kš
œ&˜&Jš
œD˜DJš
œB˜BK˜K˜—šžœœ
œœ	œ
œ
œ˜\Kšœœ;˜IK˜K˜—šžœœ
œœœœ˜WKšœœ
œ
œ ˜3šœœ
œ
˜Kšœœ
œœœ,œ-œ'œ˜γ
Kš
œ˜Kšœ
˜—K˜K˜—šžœœ
œ#œœœ˜VKšœ4˜:K˜K˜—šžœœ
œœœœ˜PKšœœ:˜GK˜K˜—šž
œœ
œœœœœ
œ
œœ˜`Jšœ	œœ6˜HJš
œ%˜%Jš
œ"˜"šœ˜šœ˜˜Jšœœ˜'Jšœœ
œŸ˜.Jšœ
œ2˜CJš
œ'˜'J˜—˜Jšœ
œœ6˜IJšœ
œ0˜AJš
œ#˜#J˜—JšœœŸ˜#—Jšœ
˜—J˜*J˜J˜K˜—šž	œœ
œœœ
œ
œ	˜[Kšœœ˜$šž
œœœ	œœœ	œ˜gKš
œ˜Kšœœ˜*Kšœ˜Kš
œ	œœœœ	˜VKšœ
œ
œœ˜EKš
œi˜išœ
œ
œ˜6Kšœ
œ˜š	œ
œœ
œ˜&Kšœ	œ˜*Kšœ	œ
œœ˜,Kšœ3œœ˜[Kšœ
˜——K˜K˜—Kšœœ
œœ?˜[Kš
œœœ
œœœœ˜WK˜K˜—šžœœ
œ
œ˜1šœœ
œ
˜Kš
œœœ
œ
œ˜>Kšœ
˜—Kšœ
œ˜K˜—š
žœœ
œœœ˜Dš
žœœœœ
œ˜,KšœL˜NKš
œ
œ!œœœ˜FK˜—Kš
œœ
œ
œ
œ˜-Kš
œ1˜1K˜—šžœœ
œ˜0Jšœ7œ˜<Jšœ6œ˜;K˜——š
œ™š
žœœ
œœœ˜GKšœœ˜)Jš
œ˜J˜—š
žœœ
œœœ˜Ršœœ
˜Jšœœœ˜AJš
œ˜Jšœ
˜—Jš
œ˜J˜—š
žœœ
œœœ˜AJšœ˜#Jš
œ˜J˜—šžœœ
œœœ
œœ˜Zšž
œ˜šœœ
œœ
˜"Kš
œœ
œœœ˜WKšœ
˜—Kš
œ˜—Kš
œ!˜!Jš
œ˜J˜—š
žœœ
œœœ˜GKšœœ
œœ˜1šœœ
œ˜Kšœ%œ
œœ˜:Kšœ
˜—Kšœœ˜Jš
œ˜——š
œ
™
šœ
œœ
œ˜%Kš
œF˜FKš
œP˜PKš
œP˜PKš
œ˜K™'K™—šžœœ
œœ	œœœ˜Gšœœ
˜Kšœ%Ÿ˜:Kšœœœ˜6Kš
œ˜—K˜K˜—šžœœ
œœ
œœœ˜AKš
œœ
œ
œœ˜šœœœ
˜Kšœœ
œ˜$Kšœœ˜Kšœœ
˜—Kš
œ˜K˜—šžœœ
œœœœ
œ
œ	˜UKšœœ
œœ@˜\šœœ
˜Kš
œ3˜3šœœœ
˜#Kš
œ+˜+Kš
œ˜Kšœ
˜—Kš
œB˜B˜šžœ˜#Kšœ%œœ
œ
™:Kšœ
œœ˜Kšœœœ˜Jšœœœœ˜DKš
œœ
œœ
œ$˜QJšœ˜K˜—Kš
œ#˜#K˜—Kšœœœœ
œ	œ<˜t—K˜——K˜Kšœ
˜K˜—…—Gτf‰