DIRECTORY Atom, Core, CoreClasses, CoreCreate, CoreOps, CoreProperties, FS, FunsimToCore, IO, PartialOrders, Process, RefTab, RefTabExtras, Rope, ViewerClasses, ViewerIO;

FunsimToCoreImpl: CEDAR PROGRAM
IMPORTS Atom, CoreClasses, CoreCreate, CoreOps, CoreProperties, FS, IO, PartialOrders, Process, RefTab, RefTabExtras, Rope, ViewerIO
EXPORTS FunsimToCore

= BEGIN OPEN CCl: CoreClasses, CCr: CoreCreate, CO: CoreOps, CP: CoreProperties, FunsimToCore;

LORA: TYPE = LIST OF REF ANY;
InstanceList: TYPE = LIST OF CCl.CellInstance;

Binding: TYPE = RECORD [formal, actual: ROPE];

behaviorProp: ATOM = CP.RegisterProperty[$Behavior];
creatorProp: ATOM = CP.RegisterProperty[$Creator];
autoArrayProp: ATOM = CP.RegisterProperty[$AutoArrays];
arrayStyleProp: ATOM = CP.RegisterProperty[$ArrayStyle];
componentsProp: ATOM = CP.RegisterUnprintableProperty[$Components];
privateNetsProp: ATOM = CP.RegisterUnprintableProperty[$PrivateNets];

dirProp: ATOM = CP.RegisterProperty[$FunsimPortDirection];
widthProp: ATOM = CP.RegisterProperty[$FunsimNodeWidth];
initProp: ATOM = CP.RegisterProperty[$FunsimNodeInitialValue];

log: IO.STREAM _ NIL;
logV: ViewerClasses.Viewer _ NIL;
before, after: INT _ noIndex;
cellTypes, widthHints, unusedWidthHints, sequencedCellTypes: Table;
counts: Counts;

noIndex: INT = LAST[INT];

Bitch: PROC [fmt: ROPE, v1, v2, v3, v4, v5: IO.Value _ [null[]]] = {
IF logV=NIL OR logV.destroyed THEN {log _ ViewerIO.CreateViewerStreams["FunsimToCore log"].out; logV _ ViewerIO.GetViewerFromStream[log]};
IF before # noIndex OR after # noIndex THEN log.PutF["[%g..%g] ", [integer[before]], [integer[after]]];
log.PutF[Rope.Cat[fmt, "\n"], v1, v2, v3, v4, v5];
};

BitchL: PROC [fmt: ROPE, vl: LIST OF IO.Value] = {
IF logV=NIL OR logV.destroyed THEN {log _ ViewerIO.CreateViewerStreams["FunsimToCore log"].out; logV _ ViewerIO.GetViewerFromStream[log]};
IF before # noIndex OR after # noIndex THEN log.PutF["[%g..%g] ", [integer[before]], [integer[after]]];
log.PutFL[Rope.Cat[fmt, "\n"], vl];
};

callOrder: PUBLIC PartialOrder;

Convert: PUBLIC PROC [fromFileName: ROPE] RETURNS [rt: Table, cs: Counts] = {
from: IO.STREAM _ FS.StreamOpen[fromFileName, read];
FindOrder: PROC [key, val: REF ANY] RETURNS [quit: BOOLEAN _ FALSE] --RefTab.EachPairAction-- = {
cellType: Core.CellType = NARROW[val];
componentsL: LORA = NARROW[CP.GetCellTypeProp[cellType, componentsProp]];
IF componentsL # NIL THEN FindOrderInComponents[componentsL, cellType];
};
MakeInsides: PROC [rank: INT, elt: REF ANY, v: PartialOrders.Vertex] --PartialOrders.Consumer-- = {
cellType: Core.CellType ~ NARROW[elt];
componentsL: LORA ~ NARROW[CP.GetCellTypeProp[cellType, componentsProp]];
privateNetsL: LORA ~ NARROW[CP.GetCellTypeProp[cellType, privateNetsProp]];
isLeaf: BOOL ~ CP.GetCellTypeProp[cellType, behaviorProp] # NIL;
isntLeaf: BOOL ~ componentsL#NIL OR privateNetsL#NIL;
IF isLeaf = isntLeaf THEN ERROR;
IF isLeaf
THEN MakeLeaf[cellType]
ELSE MakeComposite[cellType, IF privateNetsL#NIL THEN privateNetsL ELSE LIST[$PrivateNets], componentsL];
};
Bitch["\nConverting %g", [rope[fromFileName]]];
callOrder _ PartialOrders.Create[];
cellTypes _ RefTab.Create[hash: RefTabExtras.HashRopeCaseless, equal: RefTabExtras.EqualRopeCaseless];
sequencedCellTypes _ RefTab.Create[hash: RefTabExtras.HashRopeCaseless, equal: RefTabExtras.EqualRopeCaseless];
counts _ [];
{first: LORA ~ NARROW[from.GetRefAny[]];
SELECT first.first FROM
$CellType => {widthHints _ unusedWidthHints _ NIL; from.SetIndex[0]};
$WidthHints => GrokWidthHints[first];
ENDCASE => ERROR};
FOR i: INT _ from.SkipWhitespace[], from.SkipWhitespace[] WHILE NOT from.EndOf[] DO
cellTypeName: ROPE;
cellType: Core.CellType = NEW [Core.CellTypeRec _ [
class: NIL,
public: NIL,
data: NIL,
properties: NIL
]];
cellTypeL: LORA;
before _ from.GetIndex[];
cellTypeL _ NARROW[from.GetRefAny[]];
after _ from.GetIndex[];
IF Length[cellTypeL] < 2 THEN {Bitch["Malformed CellType form: %g", [refAny[cellTypeL]]]; LOOP};
IF cellTypeL.first # $CellType THEN {Bitch["CellType keyword missing"]; LOOP};
counts.totalCellTypes _ counts.totalCellTypes + 1;
cellTypeName _ ToName[cellTypeL.rest.first];
[] _ CO.SetCellTypeName[cellType, cellTypeName];
IF NOT cellTypes.Insert[cellTypeName, cellType] THEN Bitch["CellType %g multiply defined", [rope[cellTypeName]]];
SetOV[cellType, callOrder.Insert[cellType]];
FOR assns: LORA _ cellTypeL.rest.rest, assns.rest WHILE assns # NIL DO
assn: LORA = NARROW[assns.first];
a: ATOM = NARROW[assn.first];
SELECT a FROM
$AutoArrays => CP.PutCellTypeProp[cellType, autoArrayProp, $TRUE];
$PublicNets => GrokPublicNets[assn.rest, cellType];
$PrivateNets => CP.PutCellTypeProp[cellType, a, assn];
componentsProp => {
CP.PutCellTypeProp[cellType, a, assn];
counts.composites _ counts.composites + 1;
};
behaviorProp => {
val: ROPE = ToName[assn.rest.first];
CP.PutCellTypeProp[cellType, a, val];
counts.leaves _ counts.leaves + 1;
};
creatorProp => {
val: ROPE = ToName[assn.rest.first];
CP.PutCellTypeProp[cellType, a, val];
};
ENDCASE => {
Bitch["Unrecognized section: %g", [atom[a]]];
CP.PutCellTypeProp[cellType, a, assn.rest];
};
ENDLOOP;
ENDLOOP;
from.Close[];
before _ after _ noIndex;
[] _ cellTypes.Pairs[FindOrder];
callOrder.Enumerate[increasing, NIL, MakeInsides];
RETURN [cellTypes, counts];
};

GrokWidthHints: PROC [lora: LORA] ~ {
widthHints _ RefTab.Create[hash: RefTabExtras.HashRopeCaseless, equal: RefTabExtras.EqualRopeCaseless];
unusedWidthHints _ RefTab.Create[hash: RefTabExtras.HashRopeCaseless, equal: RefTabExtras.EqualRopeCaseless];
FOR lora _ lora.rest, lora.rest WHILE lora # NIL DO
term: LORA ~ NARROW[lora.first];
IF term.rest.rest # NIL THEN ERROR;
IF NOT widthHints.Insert[ToName[term.first], term.rest.first] THEN ERROR;
IF NOT unusedWidthHints.Insert[ToName[term.first], $T] THEN ERROR;
ENDLOOP;
lora _ lora;
};

ovProp: ATOM = CP.RegisterProperty[$FunsimCallOrderVertex,
CP.Props[[CP.propPrint, CP.PropDontPrint]]];

SetOV: PROC [ct: Core.CellType, v: PartialOrders.Vertex] = {
CP.PutCellTypeProp[ct, ovProp, v]};

GetOV: PROC [ct: Core.CellType] RETURNS [v: PartialOrders.Vertex] = {
v _ PartialOrders.NarrowToVertex[CP.GetCellTypeProp[ct, ovProp]]};

FindOrderInComponents: PROC [assn: LORA, cellType: Core.CellType] = {
cellTypeName: ROPE = CO.GetCellTypeName[cellType];
IF assn.first # componentsProp THEN ERROR;
FOR elts: LORA _ assn.rest, elts.rest WHILE elts # NIL DO
elt: LORA = NARROW[elts.first];
instanceName: ROPE = ToName[elt.first];
subTypeName: ROPE = ToName[elt.rest.first];
subType: Core.CellType = NARROW[cellTypes.Fetch[subTypeName].val];
IF subType = NIL THEN Bitch["CellType %g undefined (instance %g in CellType %g)", [rope[subTypeName]], [rope[instanceName]], [rope[cellTypeName]]];
callOrder.Relate[lesser: GetOV[subType], greater: GetOV[cellType]];
ENDLOOP;
assn _ assn;
};

leafClass: Core.CellClass _ NEW [Core.CellClassRec _ [
name: "FunsimLeaf",
layersProps: FALSE]];

GrokPublicNets: PROC [assn: LORA, cellType: Core.CellType] = {
cellTypeName: ROPE = CO.GetCellTypeName[cellType];
autoArrays: BOOL ~ AutoArrays[cellType];
len: INT = Length[assn];
public: Core.WireSeq = NEW [Core.WireRec[len]];
j: INT _ 0;
IF cellType.public # NIL THEN Bitch["Redefinition of public wire of cell Type %g", [rope[cellTypeName]]];
FOR elts: LORA _ assn, elts.rest WHILE elts # NIL DO
elt: LORA = NARROW[elts.first];
wireName: ROPE = ToName[elt.first];
direction: ATOM = NARROW[elt.rest.first];
oldIndex: INT = WSLookup[public, wireName];
IF oldIndex # notFound THEN {Bitch["Public wire %g duplicates some other in cell type %g", [rope[wireName]], [rope[cellTypeName]]]; LOOP};
IF autoArrays # (elt.rest.rest#NIL) THEN ERROR;
public.elements[j] _ CO.CreateWire[name: wireName, props: CP.Props[[dirProp, direction]]];
IF autoArrays THEN {
CP.PutWireProp[public.elements[j], arrayStyleProp, elt.rest.rest.first];
CP.PutWireProp[public.elements[j], widthProp, refOne];
};
j _ j + 1;
ENDLOOP;
cellType.public _ public;
};
refOne: REF INT ~ NEW [INT _ 1];

MakeLeaf: PROC [cellType: Core.CellType] = {
behaviorID: ROPE = NARROW[CP.GetCellTypeProp[cellType, behaviorProp]];
IF behaviorID = NIL OR cellType.data # NIL THEN ERROR;
cellType.class _ leafClass;
cellType.data _ behaviorID;
};

MakeComposite: PROC [cellType: Core.CellType, privates, components: LORA] ~ {
cellTypeName: ROPE = CO.GetCellTypeName[cellType];
lenI: INT ~ Length[privates]-1 + cellType.public.size;
lenC: INT ~ Length[components]-1;
internal: Core.WireSeq ~ NEW [Core.WireRec[lenI]];
recordCellType: CCl.RecordCellType ~ NEW [CCl.RecordCellTypeRec[lenC]];
i: INT _ 0;
IF privates.first # privateNetsProp OR components.first # componentsProp THEN ERROR;
IF CP.GetCellTypeProp[cellType, behaviorProp] # NIL THEN ERROR;
IF cellType.data # NIL THEN ERROR;
recordCellType.internal _ internal;
cellType.data _ recordCellType;
cellType.class _ CCl.recordCellClass;
FOR i _ 0, i+1 WHILE i < cellType.public.size DO
internal[i] _ cellType.public[i] _ SetWidth[cellType.public[i], NIL, cellType];
ENDLOOP;
FOR elts: LORA _ privates.rest, elts.rest WHILE elts # NIL DO
elt: LORA = NARROW[elts.first];
wireName: ROPE = ToName[elt.first];
oldIndex: INT = WSLookup[internal, wireName];
IF oldIndex # notFound THEN {Bitch["Internal wire %g duplicates some other in cell type %g", [rope[wireName]], [rope[cellTypeName]]]; LOOP};
internal[i] _ SetWidth[
CO.CreateWire[name: wireName, props: CP.Props[[initProp, elt.rest.rest.first]]],
NARROW[elt.rest.first],
cellType];
i _ i + 1;
ENDLOOP;
IF i # lenI THEN ERROR;
i _ 0;
FOR elts: LORA _ components.rest, elts.rest WHILE elts # NIL DO
elt: LORA = NARROW[elts.first];
instanceName: ROPE = ToName[elt.first];
subTypeName: ROPE = ToName[elt.rest.first];
subType: Core.CellType = NARROW[cellTypes.Fetch[subTypeName].val];
IF subType # NIL THEN {
ci: CCl.CellInstance = CCl.SetCellInstanceName[
NEW [CCl.CellInstanceRec _ [
actual: NEW [Core.WireRec[subType.public.size]],
type: subType
]],
instanceName
];
recordCellType.instances[i] _ ci;
FillinActuals[elt.rest.rest, ci, cellType];
EnsureConformance[ci, cellType];
}
ELSE ERROR;
i _ i + 1;
ENDLOOP;
};

SetWidth: PROC [wire: Core.Wire, width: REF INT, cellType: Core.CellType] RETURNS [ww: Core.Wire] ~ {
name: ROPE ~ CO.GetShortWireName[wire];
IF width=NIL THEN {
width _ NARROW[widthHints.Fetch[name].val];
IF unusedWidthHints.Delete[name] AND (width=NIL) THEN ERROR;
};
IF width=NIL THEN Bitch["No width hint for %g (in %g)", [rope[name]], [rope[CO.GetCellTypeName[cellType]]]];
IF CP.GetWireProp[wire, widthProp] # NIL THEN ERROR;
CP.PutWireProp[wire, widthProp, width];
IF width=NIL OR width^=1 THEN RETURN [wire];
ww _ CCr.Seq[size: width^];
ww.properties _ wire.properties;
};

FillinActuals: PROC [actualsL: LORA, ci: CCl.CellInstance, cellType: Core.CellType] = {
cellTypeName: ROPE = CO.GetCellTypeName[cellType];
subTypeName: ROPE = CO.GetCellTypeName[ci.type];
instanceName: ROPE = CCl.GetCellInstanceName[ci];
recordCellType: CCl.RecordCellType = NARROW[cellType.data];
aLen: INT = Length[actualsL];
style: {positional, sameName, impossible};
nSpec, nMatch, nDiff: INT _ 0;
someMatch: BOOL _ FALSE;
matches, diffs: ROPE _ NIL;
counts.totalInstances _ counts.totalInstances + 1;
FOR as: LORA _ actualsL, as.rest WHILE as # NIL DO
binding: Binding = ToBinding[as.first];
formalName: ROPE = binding.formal;
actualName: ROPE = binding.actual;
publicIndex: INT _ WSLookup[ci.type.public, IF formalName # NIL THEN formalName ELSE actualName];
internalIndex: INT _ WSLookup[recordCellType.internal, actualName];
SELECT TRUE FROM
formalName # NIL => nSpec _ nSpec + 1;
publicIndex = notFound => {nDiff _ nDiff + 1; diffs _ diffs.Cat[" ", actualName]};
ENDCASE => {nMatch _ nMatch + 1; matches _ matches.Cat[" ", actualName]};
IF internalIndex = notFound THEN {
AddPublic[cellType, actualName, callOrder.IsSource[GetOV[cellType], decreasing]];
internalIndex _ WSLookup[recordCellType.internal, actualName];
};
IF formalName # NIL THEN {
IF publicIndex = notFound
THEN {
Bitch[
"Couldn't find %g.%g: %g[%g: %g, ...]",
[rope[cellTypeName]],
[rope[instanceName]],
[rope[subTypeName]],
[rope[formalName]],
[rope[actualName]]
];
}
ELSE {
ci.actual[publicIndex] _ recordCellType.internal[internalIndex];
};
};
ENDLOOP;
IF nSpec + nMatch + nDiff # aLen THEN ERROR;
SELECT TRUE FROM
nSpec+nMatch = aLen => style _ sameName;
aLen = ci.actual.size AND nDiff#0 => style _ positional;
ENDCASE => style _ impossible;
SELECT style FROM
positional => {
j: INT _ 0;
counts.positional _ counts.positional + 1;
Bitch[
"%g%gPositional for %g.%g: %g",
[rope[IF aLen > 5 THEN "*" ELSE ""]],
[rope[IF nMatch#0 THEN "!" ELSE ""]],
[rope[cellTypeName]],
[rope[instanceName]],
[rope[subTypeName]]
];
FOR as: LORA _ actualsL, as.rest WHILE as # NIL DO
binding: Binding = ToBinding[as.first];
formalName: ROPE = binding.formal;
actualName: ROPE = binding.actual;
IF formalName=NIL THEN {
internalIndex: INT = WSLookup[recordCellType.internal, actualName];
ci.actual[j] _ recordCellType.internal[internalIndex];
};
j _ j + 1;
ENDLOOP;
FOR ai: INT IN [0 .. ci.actual.size) DO
IF ci.actual[ai] = NIL THEN {
Bitch["%g.%g:%g[%g] missing",
[rope[cellTypeName]],
[rope[instanceName]],
[rope[subTypeName]],
[rope[CO.GetShortWireName[ci.type.public[ai]]]]
];
EXIT;
};
ENDLOOP;
ci _ ci;
};
sameName => {
counts.sameName _ counts.sameName + 1;
FOR j: INT IN [0 .. ci.actual.size) DO
IF ci.actual[j] = NIL THEN {
actualName: ROPE = CO.GetShortWireName[ci.type.public[j]];
internalIndex: INT _ WSLookup[recordCellType.internal, actualName];
IF internalIndex = notFound THEN {
AddPublic[cellType, actualName, callOrder.IsSource[GetOV[cellType], decreasing]];
internalIndex _ WSLookup[recordCellType.internal, actualName];
};
ci.actual[j] _ recordCellType.internal[internalIndex];
};
ci _ ci;
ENDLOOP;
ci _ ci;
};
impossible => {
data: ROPE = IO.PutFR[
"aLen=%g, public.size=%g, nMatch=%g, nDiff=%g%g",
[integer[aLen]],
[integer[ci.actual.size]],
[integer[nMatch]],
[integer[nDiff]],
[rope[IF nMatch#0 AND nDiff#0
THEN IO.PutFR[
", matches=(%g), diffs=(%g))",
[rope[matches]],
[rope[diffs]]
]
ELSE ""
]]
];
Bitch[
"Can't fill in actuals on instance %g in %g because [%g]",
[rope[instanceName]],
[rope[cellTypeName]],
[rope[data]]
];
};
ENDCASE => ERROR;
ci _ ci;
};

AddPublic: PROC [cellType: Core.CellType, wireName: ROPE, notPublic: BOOL] = {
cellTypeName: ROPE = CO.GetCellTypeName[cellType];
recordCellType: CCl.RecordCellType = NARROW[cellType.data];
oldInternal: Core.Wire = recordCellType.internal;
newInternal: Core.Wire = NEW [Core.WireRec[oldInternal.size+1]];
newWire: Core.Wire ~ SetWidth[CO.CreateWire[name: wireName, props: NIL], NIL, cellType];
Bitch["Inferring %g wire %g in CellType %g", [rope[IF notPublic THEN "internal" ELSE "public"]], [rope[wireName]], [rope[cellTypeName]]];
FOR i: INT _ 0, i+1 WHILE i < oldInternal.size DO newInternal[i] _ oldInternal[i] ENDLOOP;
newInternal[oldInternal.size] _ newWire;
recordCellType.internal _ newInternal;
IF notPublic THEN RETURN;
{
oldPublic: Core.Wire = cellType.public;
newPublic: Core.Wire = NEW [Core.WireRec[oldPublic.size+1]];
FOR i: INT _ 0, i+1 WHILE i < oldPublic.size DO newPublic[i] _ oldPublic[i] ENDLOOP;
newPublic[oldPublic.size] _ newWire;
cellType.public _ newPublic;
RETURN}};

AddPrivate: PROC [cellType: Core.CellType, wire: Core.Wire] = {
cellTypeName: ROPE = CO.GetCellTypeName[cellType];
wireName: ROPE ~ CO.GetShortWireName[wire];
recordCellType: CCl.RecordCellType = NARROW[cellType.data];
oldInternal: Core.Wire = recordCellType.internal;
newInternal: Core.Wire = NEW [Core.WireRec[oldInternal.size+1]];
i: INT _ 0;
Bitch["Inferring private wire %g in CellType %g", [rope[wireName]], [rope[cellTypeName]]];
FOR i _ 0, i+1 WHILE i < oldInternal.size DO newInternal[i] _ oldInternal[i] ENDLOOP;
newInternal.elements[oldInternal.size] _ wire;
recordCellType.internal _ newInternal;
};

EnsureConformance: PROC [ci: CCl.CellInstance, parent: Core.CellType] ~ {
autoArrays: BOOL ~ AutoArrays[ci.type];
count: INT _ 1;
nSeq: INT _ 0;
IF ci.actual.size # ci.type.public.size THEN ERROR;
FOR i: NAT IN [0 .. ci.actual.size) DO
a: Core.Wire ~ ci.actual[i];
p: Core.Wire ~ ci.type.public[i];
aSize: INT ~ IF a.size>1 THEN a.size ELSE IF a.size=0 THEN 1 ELSE ERROR;
aw: REF INT ~ NARROW[CP.GetWireProp[a, widthProp]];
pw: REF INT ~ NARROW[CP.GetWireProp[p, widthProp]];
IF aw=NIL OR aSize # aw^ THEN ERROR;
IF autoArrays THEN {
constant: BOOL ~ SELECT CP.GetWireProp[p, arrayStyleProp] FROM
$c => TRUE,
$a => FALSE,
ENDCASE => ERROR;
IF NOT constant THEN nSeq _ nSeq+1;
SELECT TRUE FROM
constant => IF aw^ # pw^ THEN BitchL["Constant mismatch in %g: %g (is %g) <-> (%g:%g).%g (is %g)", LIST[
[rope[CO.GetCellTypeName[parent]]],
[rope[CO.GetShortWireName[a]]],
[integer[aw^]],
[rope[CCl.GetCellInstanceName[ci]]],
[rope[CO.GetCellTypeName[ci.type]]],
[rope[CO.GetShortWireName[p]]],
[integer[pw^]]
]];
aw^ = 1 => NULL;
count=1 => count _ aw^;
count#aw^ => Bitch["Disagreement (%g vs %g) on count for %g.%g:%g", [integer[count]], [integer[aw^]], [rope[CO.GetCellTypeName[parent]]], [rope[CCl.GetCellInstanceName[ci]]], [rope[CO.GetCellTypeName[ci.type]]]];
ENDCASE => NULL;
}
ELSE {
SELECT TRUE FROM
pw=NIL => ci.type.public[i] _ SetWidth[p, aw, ci.type];
pw#NIL => IF aw^#pw^ THEN {
BitchL["Mismatch in %g: %g (is %g) <-> (%g:%g).%g (is %g)", LIST[
[rope[CO.GetCellTypeName[parent]]],
[rope[CO.GetShortWireName[a]]],
[integer[aw^]],
[rope[CCl.GetCellInstanceName[ci]]],
[rope[CO.GetCellTypeName[ci.type]]],
[rope[CO.GetShortWireName[p]]],
[integer[pw^]]
]];
};
ENDCASE => ERROR;
};
ENDLOOP;
IF autoArrays AND count#1 THEN {
baseType: Core.CellType ~ ci.type;
arrayType: Core.CellType ~ GetArrayType[baseType, count, nSeq];
IF arrayType.public.size # ci.actual.size THEN ERROR;
ci.type _ arrayType;
callOrder.Relate[lesser: GetOV[arrayType], greater: GetOV[parent]];
FOR i: NAT IN [0 .. arrayType.public.size) DO
constant: BOOL ~ SELECT CP.GetWireProp[baseType.public[i], arrayStyleProp] FROM
$c => TRUE,
$a => FALSE,
ENDCASE => ERROR;
a: Core.Wire ~ ci.actual[i];
p: Core.Wire ~ arrayType.public[i];
aSize: INT ~ IF a.size>1 THEN a.size ELSE IF a.size=0 THEN 1 ELSE ERROR;
pSize: INT ~ IF p.size>1 THEN p.size ELSE IF p.size=0 THEN 1 ELSE ERROR;
IF NOT Rope.Equal[CO.GetShortWireName[baseType.public[i]], CO.GetShortWireName[arrayType.public[i]]] THEN ERROR;
IF (NOT constant) AND pSize#count THEN ERROR;
SELECT TRUE FROM
aSize = pSize => NULL;
constant => NULL--we've already complained--;
aSize#1 => NULL--we've already complained--;
aSize=1 => {
arrayedWire: Core.Wire ~ GetArrayWire[a, count, parent];
ci.actual[i] _ arrayedWire;
};
ENDCASE => ERROR;
ENDLOOP;
};
};

GetArrayType: PROC [baseType: Core.CellType, count, nSeq: INT] RETURNS [arrayType: Core.CellType] ~ {
baseName: ROPE ~ CO.GetCellTypeName[baseType];
arrayName: ROPE ~ IO.PutFR["%g*%g", [rope[baseName]], [integer[count]]];
arrayType _ NARROW[cellTypes.Fetch[arrayName].val];
IF arrayType = NIL THEN {
seq: CCl.SequenceCellType ~ NEW [CCl.SequenceCellTypeRec _ [
base: baseType,
count: count,
sequence: NEW [CCl.SequenceSetRec[nSeq]]
]];
n: NAT _ 0;
FOR i: NAT IN [0 .. baseType.public.size) DO
constant: BOOL ~ SELECT CP.GetWireProp[baseType.public[i], arrayStyleProp] FROM
$c => TRUE,
$a => FALSE,
ENDCASE => ERROR;
IF NOT constant THEN {
seq.sequence[n] _ i;
n _ n+1;
};
ENDLOOP;
IF n # nSeq THEN ERROR;
arrayType _ CCl.CreateSequence[seq, arrayName];
IF NOT cellTypes.Insert[arrayName, arrayType] THEN ERROR;
[] _ sequencedCellTypes.Store[baseName, baseType];
{v: PartialOrders.Vertex ~ callOrder.Insert[arrayType];
SetOV[arrayType, v];
callOrder.Relate[lesser: GetOV[baseType], greater: v];
}};
{seq: CCl.SequenceCellType ~ NARROW[arrayType.data];
IF seq.base # baseType OR seq.count # count THEN ERROR;
}};

GetArrayWire: PROC [base: Core.Wire, count: INT, parent: Core.CellType] RETURNS [array: Core.Wire] ~ {
baseName: ROPE ~ CO.GetShortWireName[base];
arrayName: ROPE ~ IO.PutFR["%g*%g", [rope[baseName]], [integer[count]]];
record: CCl.RecordCellType ~ NARROW[parent.data];
index: INT ~ WSLookup[record.internal, arrayName];
IF base.size # 0 THEN ERROR;
IF index # notFound THEN RETURN [record.internal[index]];
array _ CCr.Seq[arrayName, count, base];
AddPrivate[parent, array];
};

AutoArrays: PROC [ct: Core.CellType] RETURNS [BOOL] ~ {
RETURN [SELECT CP.GetCellTypeProp[ct, autoArrayProp] FROM
$TRUE => TRUE,
NIL => FALSE,
ENDCASE => ERROR]};

notFound: INT = LAST[INT];
WSLookup: PROC [wire: Core.Wire, name: ROPE] RETURNS [index: INT] = {
FOR index _ 0, index + 1 WHILE index < wire.size DO
IF wire[index] # NIL AND CO.GetShortWireName[wire[index]].Equal[name, FALSE] THEN RETURN;
ENDLOOP;
index _ notFound;
};

ToBinding: PROC [ra: REF ANY] RETURNS [b: Binding] = {
WITH ra SELECT FROM
lora: LORA => {
IF Length[lora] # 2
THEN Bitch["Binding %g not of length 2", [refAny[lora]]]
ELSE {
b.formal _ ToName[lora.first];
b.actual _ ToName[lora.rest.first];
};
};
ENDCASE => b _ [NIL, ToName[ra]];
ra _ ra;
};

ToName: PROC [ra: REF ANY] RETURNS [rope: ROPE] = {
WITH ra SELECT FROM
a: ATOM => rope _ Atom.GetPName[a];
r: ROPE => rope _ r;
ENDCASE => Bitch["Not a name: %g", [refAny[ra]]];
ra _ ra;
};

ToInt: PROC [ra: REF ANY] RETURNS [int: INT] = {
WITH ra SELECT FROM
ri: REF INT => int _ ri^;
ENDCASE => Bitch["Not an INT: %g", [refAny[ra]]];
ra _ ra;
};

Length: PROC [list: LORA] RETURNS [length: INT] = {
length _ 0;
FOR list _ list, list.rest WHILE list # NIL DO length _ length + 1 ENDLOOP;
length _ length;
};

GetPriority: PROC RETURNS [Process.Priority]
~ {RETURN [Process.GetPriority[]]};

GetProcess: PROC RETURNS [UNSAFE PROCESS]
~ {RETURN [Process.GetCurrent[]]};

END.
ΜFunsimToCoreImpl.Mesa
Last munged by Mike Spreitzer on March 10, 1987 1:44:17 pm PST
Last tweaked by Mike Spreitzer on November 30, 1988 9:10:55 am PST
Greatest is root of design; leaves are small.
Κˆ–

"cedar" style˜
code™Kš
œ>™>K™B—K˜KšΟk	œ?œœN˜ͺ
K˜šΡbnxœœ
˜Kšœ9œœ>˜„
Kšœ
˜—K˜Kš
œœ
œ
ΟnœŸœœœ˜^K˜Kšœœœ
œ
œ
œ
˜Kšœœœ
œ˜.K˜Kšœ	œœœ˜.K˜Kšœœœ˜4Kšœ
œœ˜2Kšœœœ˜7Kšœœœ˜8Kšœœœ*˜CKšœœœ+˜EK˜Kšœ	œœ(˜:Kšœœœ$˜8Kšœ
œœ+˜>K˜Kšœœ
œœ
˜Kšœœ
˜!Kšœœ˜Kš
œC˜CK˜K˜Kšœ	œœ
œ˜K˜šŸœœœœ˜DKšœœ
œœh˜Š
Kšœœœ<˜gK˜2K˜K˜—šŸœœœœ
œ
œ˜2Kšœœ
œœh˜Š
Kšœœœ<˜gKš
œ#˜#K˜K˜—šœœ˜K™-—K˜š
Ÿœœ
œœœ˜MKšœœ
œœ ˜4šŸ	œœœ
œœœœΟcœ˜aKšœœ˜&Kšœ
œœ
œ,˜IKšœœ
œ.˜GK˜—šŸœœœœ
œ œ˜cKšœœ˜&Kšœ
œœ
œ,˜IKšœœœ
œ-˜KKšœœœ+œ
˜@Kš	œ
œœ
œœ
˜5Kšœœ
œ
˜ šœ˜	Kšœ˜Kšœœœ
œœ
œ˜i—K˜—Kš
œ/˜/Kš
œ#˜#Kš
œf˜fKš
œo˜oK˜Kšœœœ˜(šœ
˜Kšœ.œ˜EK˜%Kšœœ˜—š	œœ0œ
œ˜SKšœœ
˜šœœ˜3Kšœœ
˜Kšœœ
˜Kšœœ
˜
Kšœ˜Kš
œ˜—Kšœœ
˜Kš
œ˜Kšœœ˜%Kš
œ˜Kšœœ=œ˜`Kšœœ%œ˜NK˜2Kš
œ,˜,Kšœœ)˜0Kšœ
œ*œ=˜qK˜,š	œœ#œ	œ
˜FKšœœœ˜!Kšœœœ
˜šœ˜
Kšœœ1˜BKš
œ3˜3Kšœœ$˜6š
œ˜Kšœ$˜&K˜*K˜—š
œ˜Kšœœ˜$Kšœ#˜%K˜"K˜—š
œ˜Kšœœ˜$Kšœ#˜%K˜—šœ˜K˜-Kšœ)˜+K˜——Kšœ
˜—Kšœ
˜—K˜
Kš
œ˜Kš
œ ˜ Kšœ œ˜2Kšœ˜K˜—K˜šŸœœœ˜%Kš
œg˜gKš
œm˜mšœœœ
˜3Kšœœœ
˜ Kšœœ
œ
œ
˜#Kšœ
œ8œ
œ
˜IKšœ
œ1œ
œ
˜BKšœ
˜—K˜K˜K˜—šœœœ)˜:Kšœœœ˜,—K˜šŸœœ1˜<Kšœ!˜#—K˜šŸœœœ˜EKšœ!œ˜B—K˜šŸœœœ˜EKšœœœ˜2Kšœœ
œ
˜*š	œœœœ
˜9Kšœœœ
˜Kšœœ˜'Kšœ
œ˜+Kšœœ#˜BKšœœ
œ~˜“
Kš
œC˜CKšœ
˜—K˜K˜—K˜šœœ˜6K˜Kšœ
œ˜K˜—šŸœœœ˜>Kšœœœ˜2Kšœœ˜(Kšœœ˜Kšœœ˜/Kšœœ˜Kšœœ
œL˜iš	œœœœ
˜4Kšœœœ
˜Kšœ
œ˜#Kšœœœ˜)Kšœ
œ˜+Kšœœiœ˜Š
Kšœœœ
œ
˜/Kšœœ#œ˜Zšœœ˜KšœF˜HKšœ4˜6K˜—K˜
Kšœ
˜—K˜K˜Kš	œœ
œœœ˜ —K˜šŸœœ˜,Kšœœœ
œ*˜FKšœœ
œœ
œ
œ
˜6K˜K˜K˜K˜—šŸ
œœ1œ˜MKšœœœ˜2Kšœœ-˜6Kšœœ˜!Kšœœ˜2Kšœ%œ˜GKšœœ˜Kšœ"œ#œ
œ
˜TKš
œ
œ+œ
œ
œ
˜?Kšœœ
œ
œ
˜"Kš
œ#˜#Kš
œ˜Kš
œ%˜%šœœ˜0Kšœ@œ˜OKšœ
˜—š	œœœœ
˜=Kšœœœ
˜Kšœ
œ˜#Kšœ
œ ˜-Kšœœkœ˜Œ
š
œ˜Kšœ#œ)˜PKšœ˜K˜
—K˜
Kšœ
˜—Kšœ
œ
œ
˜Kš
œ˜š	œœœœ
˜?Kšœœœ
˜Kšœœ˜'Kšœ
œ˜+Kšœœ#˜Bšœœ
œ˜š
œ/˜/šœ˜Kšœœ%˜0Kš
œ
˜
K˜—Kš
œ˜K˜—Kš
œ!˜!Kš
œ+˜+Kš
œ ˜ Kš
œ
˜
—Kšœ
œ
˜K˜
Kšœ
˜—K˜K˜—š
Ÿœœœ
œœ˜eKšœœœ˜'šœœ
œ˜Kšœœ˜+Kš
œœœœ
œ
˜<Kš
œ˜—Kšœœ
œ;œ˜lKš
œ
œ œ
œ
œ
˜4Kšœ%˜'Kš
œœ
œ
œ
œ˜,Kš
œ˜K˜ K˜K˜—šŸ
œœœ4˜WKšœœœ˜2Kšœ
œœ˜0Kšœœ˜1Kšœ%œ˜;Kšœœ˜K˜*Kšœœ˜Kšœœœ
˜Kšœœœ
˜K˜2š	œœœœ
˜2K˜'Kšœœ˜"Kšœœ˜"Kšœ
œœœ
œœ
˜aKšœœ1˜Cšœ
œ
˜Kšœ
œ˜&Kš
œR˜RKšœB˜I—šœœ˜"Kš
œQ˜QKš
œ>˜>K˜—šœœ
œ˜šœ˜šœ˜˜K˜'K˜K˜Kš
œ˜Kš
œ˜K˜K˜—K˜
—šœ˜Kš
œ@˜@K˜——Kš
œ˜—Kšœ
˜—Kšœœ
œ
˜,šœ
œ
˜Kš
œ(˜(Kšœœ˜8Kšœ˜—šœ˜˜Kšœœ˜K˜*˜K˜Kšœœ
œœ˜%Kšœœ
œœ˜%Kš
œ˜Kš
œ˜Kš
œ˜K˜—š	œœœœ
˜2K˜'Kšœœ˜"Kšœœ˜"šœœ
œ˜Kšœœ1˜CKš
œ6˜6Kš
œ˜—K˜
Kšœ
˜—šœœ
œ˜'šœœ
œ˜˜K˜K˜K˜Kšœœ'˜/K˜—Kšœ
˜K˜—Kšœ
˜—K˜K˜—˜
K˜&šœœ
œ˜&šœœ
œ˜Kšœœœ%˜:Kšœœ1˜Cšœœ˜"Kš
œQ˜QKš
œ>˜>K˜—Kš
œ6˜6K˜—K˜Kšœ
˜—K˜K˜—˜šœœœ˜K˜1Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜šœœ
œ˜šœ
œ˜K˜K˜K˜
K˜
—Kšœ˜Kš
œ˜—K˜—˜K˜:K˜K˜K˜K˜—K˜—Kšœœ
˜—K˜K˜—K˜šŸ	œœ%œ
œ˜NKšœœœ˜2Kšœ%œ˜;Kš
œ1˜1Kšœœ$˜@Kšœœ#œœ˜XKšœ3œœœ5˜‰
Kš
œœ
œœ!œ
˜ZKš
œ(˜(Kš
œ&˜&Kšœœ
œ
˜Kš
œ
˜
K˜'Kšœœ"˜<Kš
œœ
œœœ
˜TKš
œ$˜$Kš
œ˜Kšœ˜	—K˜šŸ
œœ/˜?Kšœœœ˜2Kšœ
œœ˜+Kšœ%œ˜;Kš
œ1˜1Kšœœ$˜@Kšœœ˜Kš
œZ˜ZKšœœœ!œ
˜UKš
œ.˜.Kš
œ&˜&K˜K˜—šŸœœ2˜IKšœœ˜'Kšœœ˜Kšœœ˜Kšœ&œ
œ
˜3šœœ
œ˜&K˜K˜!Kšœœœ
œœ
œ
œœ
œ
˜HKš	œœ
œœ
œ˜3Kš	œœ
œœ
œ˜3Kš
œœ
œ
œ
œ
˜$šœœ˜šœ
œœ
œ ˜>Kšœœ
˜Kšœœ
˜Kšœœ
˜—Kšœ
œ
œ˜#šœ
œ
˜šœœœFœ
˜hKšœœ˜#Kšœœ˜K˜Kš
œ$˜$Kšœœ˜$Kšœœ˜K˜K˜—Kšœœ
˜K˜KšœlœGœ˜Τ
Kšœœ
˜—K˜
—šœ˜šœ
œ
˜Kšœœ1˜7šœœœ	œ˜šœ<œ
˜AKšœœ˜#Kšœœ˜K˜Kš
œ$˜$Kšœœ˜$Kšœœ˜K˜K˜—K˜—Kšœœ
˜—K˜—Kšœ
˜—šœœ	œ˜ K˜"K˜?Kšœ(œ
œ
˜5K˜Kš
œC˜Cšœœ
œ˜-šœ
œœ
œ1˜OKšœœ
˜Kšœœ
˜Kšœœ
˜—K˜K˜#Kšœœœ
œœ
œ
œœ
œ
˜HKšœœœ
œœ
œ
œœ
œ
˜HKšœ
œœ'œ(œ
œ
˜pKš
œœœ
œ
œ
˜-šœ
œ
˜Kšœœ
˜Kšœ œ
˜-Kšœ œ
˜,˜K˜8K˜K˜—Kšœœ
˜—Kšœ
˜—K˜—K˜K˜—šŸœœ(œœ˜eKšœ
œœ˜.Kšœœœ4˜HKšœœ!˜3šœ
œ
œ˜šœœ˜<K˜K˜
Kšœ
œ˜(K˜—Kšœœ˜šœœ
œ˜,šœ
œœ
œ1˜OKšœœ
˜Kšœœ
˜Kšœœ
˜—šœ
œ
œ˜K˜K˜K˜—Kšœ
˜—Kšœ
œ
œ
˜Kš
œ/˜/Kšœ
œ(œ
œ
˜9K˜2Kš
œ7˜7Kš
œ˜Kš
œ6˜6K˜—Kšœœ˜4Kšœœœ
œ
˜7K˜K˜—šŸœœœœ˜fKšœ
œœ˜+Kšœœœ4˜HKšœœ˜1Kšœœ(˜2Kšœœ
œ
˜Kšœœ
œ˜9K˜(K˜K˜K˜—šŸ
œœœœ˜7šœœ
œ$˜9Kšœ	œ
˜Kšœœ
˜
Kšœœ˜—K˜—Kšœ
œœ
œ˜š
Ÿœœœœ	œ˜Ešœœ˜3Kšœœ
œ
œ+œœ
œ
˜YKšœ
˜—K˜K˜—K˜š
Ÿ	œœœ
œœ˜6šœœ
˜šœœ˜šœ˜Kšœ4˜8šœ˜K˜K˜#K˜——K˜—Kšœ	œ˜!—Kš
œ˜K˜—K˜šŸœœœ
œœœ˜3šœœ
˜Kšœœ˜#Kšœœ
˜Kšœ*˜1—Kš
œ˜K˜—K˜šŸœœœ
œœœ˜0šœœ
˜Kšœœ
œ˜Kšœ*˜1—Kš
œ˜K˜—K˜š
Ÿœœœœ
œ˜3K˜Kš
œœœ
œœ
˜KK˜K˜—K˜šŸœœ
œ˜,Kšœœ˜#—K˜š
Ÿ
œœ
œœ
œ
˜)Kšœœ˜"—K˜Kšœ
˜—…—TRn¦