LichenData2Impl:
CEDAR
PROGRAM
IMPORTS AMBridge, Asserting, Convert, InterpreterOps, IO, LichenDataStructure, LichenSetTheory, Rope, StructuredStreams, TiogaAccess, UnparserBuffer
EXPORTS LichenDataStructure =
BEGIN OPEN LichenSetTheory, LichenDataStructure, SS:StructuredStreams, UB:UnparserBuffer;
nyet: PUBLIC ERROR = CODE;
Warning: PUBLIC SIGNAL [msg: ROPE ← NIL, v1, v2, v3, v4, v5: REF ANY ← NIL] = CODE;
Error: PUBLIC ERROR [msg: ROPE, v1, v2, v3, v4, v5: REF ANY ← NIL] = CODE;
nameReln: PUBLIC ATOM ← $LichenName;
partsByNameKey: PUBLIC ATOM ← $LichenNameToPart;
DimName: ARRAY Dim OF ROPE = [Foo: "Foo", Bar: "Bar"];
EndName: ARRAY End OF ROPE = [low: "low", high: "high"];
step: ROPE = ".";
Describe:
PUBLIC
PROC [subject:
REF
ANY, relativeTo:
REF
ANY ←
NIL, nameGen: NameGenerator ←
NIL]
RETURNS [name:
ROPE] = {
GetShort:
PROC [oldAssns: Assertions]
RETURNS [newAssns: Assertions, name:
ROPE] = {
name ← NARROW[Asserting.FnVal[nameReln, newAssns ← oldAssns]];
IF name =
NIL
THEN {
name ← nameGen.GenerateName[nameGen.data, subject];
newAssns ← Asserting.Assert[nameReln, LIST[name], newAssns];
};
};
IF nameGen = NIL THEN nameGen ← defaultNameGen;
IF subject = relativeTo
THEN name ←
NIL
ELSE
WITH subject
SELECT
FROM
d: Design => {
short: ROPE;
[d.other, short] ← GetShort[d.other];
name ← short;
};
ct: CellType => {
short: ROPE;
[ct.otherPublic, short] ← GetShort[ct.otherPublic];
name ← IF ct.designs.HasMember[relativeTo] OR ct.designs.Size[]=0 THEN short ELSE Describe[GetADesign[ct], relativeTo, nameGen].Cat[step, short];
};
v: Vertex => {
short: ROPE;
parent: REF ANY;
[v.other, short] ← GetShort[v.other];
WITH v
SELECT
FROM
ci: CellInstance => parent ← v.containingCT;
im: Intermediary => parent ← ImParent[im];
w: Wire => parent ← WireContainer[w];
ENDCASE => ERROR;
name ← IF relativeTo = parent OR parent = NIL THEN short ELSE Describe[parent, relativeTo, nameGen].Cat[step, short];
};
port: Port => {
short: ROPE;
parent: REF ANY = port.parent;
[port.other, short] ← GetShort[port.other];
name ← IF relativeTo = parent OR parent = NIL THEN short ELSE Describe[parent, relativeTo, nameGen].Cat[step, short];
};
ENDCASE => ERROR;
};
GetADesign:
PROC [ct: CellType]
RETURNS [d: Design] = {
See: PROC [ra: REF ANY] = {d ← NARROW[ra]};
IF ct.designs.Size[] = 0 THEN RETURN [NIL];
ct.designs.Enumerate[See];
};
WireContainer:
PROC [w: Wire]
RETURNS [container:
REF
ANY] = {
container ←
SELECT w.containingWire
FROM
NIL => w.containingCT,
ENDCASE => w.containingWire;
};
defaultNameGen: NameGenerator =
NEW [NameGeneratorPrivate ← [
GenerateBlandName,
NEW [NameCountsPrivate ← []]
]];
NameCounts: TYPE = REF NameCountsPrivate;
NameCountsPrivate:
TYPE =
RECORD [
design, cellType, port, vertex: INT ← 0
];
GenerateBlandName:
PROC [data, subject:
REF
ANY]
RETURNS [name:
ROPE] = {
nc: NameCounts = NARROW[data];
name ← GenByCount[nc, subject];
};
TVNameGenerator: TYPE = REF TVNameGeneratorPrivate;
TVNameGeneratorPrivate:
TYPE =
RECORD [
nc: NameCounts,
symTab: SymTab.Ref
];
MakeTVNameGen:
PROC [symTab: SymTab.Ref]
RETURNS [ng: NameGenerator] = {
ng ←
NEW [NameGeneratorPrivate ← [
GenerateTVName,
NEW [TVNameGeneratorPrivate ← [
nc: NEW [NameCountsPrivate ← []],
symTab: symTab
]]
]];
};
GenerateTVName:
PROC [data, subject:
REF
ANY]
RETURNS [name:
ROPE] = {
tvng: TVNameGenerator = NARROW[data];
name ← Rope.Concat["&", GenByCount[tvng.nc, subject]];
TRUSTED {InterpreterOps.RegisterTV[
name: name,
tv: AMBridge.TVForReferent[
WITH subject
SELECT
FROM
d: Design => NEW [Design ← d],
ct: CellType => NEW [CellType ← ct],
p: Port => NEW [Port ← p],
v: Vertex => NEW [Vertex ← v],
ENDCASE => ERROR],
symTab: tvng.symTab]};
};
GenByCount:
PROC [nc: NameCounts, subject:
REF
ANY]
RETURNS [name:
ROPE] = {
n: INT ← 0;
WITH subject
SELECT
FROM
d: Design => {n ← nc.design ← nc.design + 1; name ← "D"};
ct: CellType => {n ← nc.cellType ← nc.cellType + 1; name ← "CT"};
p: Port => {n ← nc.port ← nc.port + 1; name ← "P"};
v: Vertex => {n ← nc.vertex ← nc.vertex + 1; name ← "V"};
ENDCASE => ERROR;
name ← name.Concat[Convert.RopeFromInt[n]];
};
PrintObject:
PROC [to:
IO.
STREAM, united:
BOOL,
PrintIt:
PROC] = {
SS.Bp[to, united, printStep];
SS.Begin[to];
PrintIt[!UNWIND => SS.End[to]];
SS.End[to];
};
printStep: INT ← 2;
printWidth: INT ← 65;
PrintDesignOnFile:
PROC [design: Design, nameGen: NameGenerator ←
NIL, fileName:
ROPE ←
NIL] = {
taw: TiogaAccess.Writer = TiogaAccess.Create[];
realFileName: ROPE = IF fileName # NIL THEN fileName ELSE Rope.Cat[NARROW[Asserting.FnVal[nameReln, design.other]], ".design"];
ss: IO.STREAM = SS.Create[UB.NewHandle[[access[taw, NIL, printStep]], printWidth]];
PrintDesign[ss, design, nameGen];
TiogaAccess.WriteFile[taw, realFileName];
ss.Close[];
};
PrintDesign:
PROC [to:
IO.
STREAM, design: Design, nameGen: NameGenerator ←
NIL] = {
Filter: PROC [CellType] RETURNS [BOOL] = {RETURN [TRUE]};
PrintDesignSubset[to, design, nameGen, Filter];
};
PrintDesignSubset:
PROC [to:
IO.
STREAM, design: Design, nameGen: NameGenerator, Filter:
PROC [CellType]
RETURNS [
BOOL]] = {
CTPrint:
PROC [ra:
REF
ANY] = {
ct: CellType = NARROW[ra];
Inner: PROC = {PrintCellType[to, ct, nameGen]};
IF Filter[ct] THEN PrintObject[to, TRUE, Inner];
};
IF NOT SS.IsAnSS[to] THEN to ← SS.Create[UB.NewHandle[[stream[to]], printWidth]];
to.PutF["%g: Design {", [rope[Describe[design, NIL, nameGen]]]];
design.cellTypes.Enumerate[CTPrint];
to.PutF["}"];
};
PrintCellType:
PROC [to:
IO.
STREAM, ct: CellType, nameGen: NameGenerator ←
NIL] = {
Main:
PROC = {
to.PutF["%g: CellType[", [rope[Describe[ct, GetADesign[ct], nameGen]]]];
PrintObject[to, TRUE, PortPrint];
IF ct.asUnorganized #
NIL
THEN {
to.PutRope[", "]; PrintObject[to, TRUE, IWPrint];
to.PutRope[", "]; PrintObject[to, TRUE, CIPrint];
};
IF ct.asArray #
NIL
THEN {
to.PutRope[", "]; PrintObject[to, TRUE, AyPrint];
};
to.PutRope["]"];
};
PortPrint:
PROC = {
to.PutF["port: "];
PrintPort[to, ct.port, nameGen];
};
IWPrint:
PROC = {
to.PutF["internal wire: "];
PrintWire[to, ct.asUnorganized.internalWire, nameGen];
};
CIPrint:
PROC = {
to.PutF["contained instances: "];
PrintInstances[to, ct.asUnorganized.containedInstances, ct.asUnorganized.mirror, nameGen];
};
AyPrint:
PROC = {
to.PutRope["asArray: "];
PrintArray[to, ct, nameGen]
};
IF NOT SS.IsAnSS[to] THEN to ← SS.Create[UB.NewHandle[[stream[to]], printWidth]];
--PrintObject[to, TRUE, Main]--Main[];
};
portLimit: NAT ← 69;
PrintPort:
PROC [to:
IO.
STREAM, port: Port, nameGen: NameGenerator] = {
first: BOOL ← TRUE;
i: INT ← 0;
to.PutRope[Describe[port, port.parent, nameGen]];
IF port.FirstChildPort[] = NIL THEN RETURN;
to.PutRope["["];
FOR subPort: Port ← port.FirstChildPort[], subPort.NextChildPort[]
WHILE subPort #
NIL
DO
PortPrint: PROC = {PrintPort[to, subPort, nameGen]};
PrintElipsis: PROC = {to.PutRope["..."]};
IF i < portLimit
OR subPort.NextChildPort[] =
NIL
THEN {
IF first THEN first ← FALSE ELSE to.PutRope[", "];
PrintObject[to, FALSE, PortPrint]
}
ELSE
IF i = portLimit
THEN {
to.PutRope[", "];
PrintObject[to, FALSE, PrintElipsis]
};
i ← i + 1;
ENDLOOP;
to.PutRope["]"];
};
PrintWire:
PROC [to:
IO.
STREAM, wire: Wire, nameGen: NameGenerator] = {
first: BOOL ← TRUE;
to.PutRope[Describe[wire, WireContainer[wire], nameGen]];
IF wire.FirstChildWire[] = NIL THEN RETURN;
to.PutRope["["];
FOR subWire: Wire ← wire.FirstChildWire[], subWire.NextChildWire[]
WHILE subWire #
NIL
DO
WirePrint: PROC = {PrintWire[to, subWire, nameGen]};
IF first THEN first ← FALSE ELSE to.PutRope[", "];
PrintObject[to, FALSE, WirePrint];
ENDLOOP;
to.PutRope["]"];
};
PrintInstances:
PROC [to:
IO.
STREAM, set: Set
--OF CellInstance--, mirror: CellInstance, nameGen: NameGenerator] = {
first: BOOL ← TRUE;
PrintIt:
PROC [ra:
REF
ANY] = {
ci: CellInstance = NARROW[ra];
IPrint: PROC = {PrintInstance[to, ci, nameGen]};
IF first THEN first ← FALSE ELSE to.PutRope[", "];
PrintObject[to, TRUE, IPrint];
};
to.PutRope["["];
set.Enumerate[PrintIt];
PrintIt[mirror];
to.PutRope["]"];
};
PrintInstance:
PROC [to:
IO.
STREAM, ci: CellInstance, nameGen: NameGenerator] = {
PrintConnections:
PROC [v: Vertex] = {
first: BOOL ← TRUE;
PrintConnection:
PROC [port: Port, w: Vertex] = {
CPrint:
PROC = {
to.PutF["%g: ", [rope[Describe[port, port.parent, nameGen]]]];
WITH w
SELECT
FROM
im: Intermediary => {
PrintConnections[im];
};
wire: Wire => {
to.PutRope[Describe[wire, WireContainer[wire], nameGen]];
};
ci: CellInstance => ERROR;
ENDCASE => ERROR;
};
IF first THEN first ← FALSE ELSE to.PutRope[", "];
PrintObject[to, FALSE, CPrint];
};
to.PutRope["["];
EnumerateImmediateConnections[v, PrintConnection, [cellward: FALSE, wireward: TRUE]];
to.PutRope["]"];
};
to.PutF["%g: %g", [rope[Describe[ci, ci.containingCT, nameGen]]], [rope[Describe[ci.type, GetADesign[ci.type], nameGen]]] ];
PrintConnections[ci];
};
PrintArray:
PROC [to:
IO.
STREAM, ct: CellType, nameGen: NameGenerator] = {
a: Array = ct.asArray;
to.PutF["{%g BY %g OF %g (joints period is %g by %g)",
[integer[a.size[Foo]]], [integer[a.size[Bar]]],
[rope[Describe[a.eltType, GetADesign[ct], nameGen]]],
[integer[a.jointsPeriod[Foo]]], [integer[a.jointsPeriod[Bar]]]
];
FOR d: Dim
IN Dim
DO
PrintJoints:
PROC = {
first: BOOL ← TRUE;
to.PutF["joints[%g] = [", [rope[DimName[d]]]];
FOR
f
f:
INT
IN [0 .. a.jointsPeriod[Foo])
DO
FOR
f
b:
INT
IN [0 .. a.jointsPeriod[Bar])
DO
JPrint:
PROC = {
to.PutF["[%g,%g]: ", [integer[ff]], [integer[fb]]];
PrintJoint[to, ct, GetArrayJoint[a, d, [ff, fb]], nameGen];
};
IF first THEN first ← FALSE ELSE to.PutRope[", "];
PrintObject[to, TRUE, JPrint];
ENDLOOP;
ENDLOOP;
to.PutRope["]"];
};
to.PutRope[", "];
PrintObject[to, TRUE, PrintJoints];
ENDLOOP;
to.PutRope["}"];
};
PrintJoint:
PROC [to:
IO.
STREAM, act: CellType, j: Joint, nameGen: NameGenerator] = {
first: BOOL ← TRUE;
PerTie:
PROC [ra:
REF
ANY] = {
tie: Tie = NARROW[ra];
TPrint: PROC = {PrintTie[to, act, j, tie, nameGen]};
IF first THEN first ← FALSE ELSE to.PutRope[", "];
PrintObject[to, FALSE, TPrint];
};
to.PutRope["["];
[] ← j.ties.Enumerate[PerTie];
to.PutRope["]"];
};
printIncompleteness: BOOL ← TRUE;
PrintTie:
PROC [to:
IO.
STREAM, act: CellType, j: Joint, tie: Tie, nameGen: NameGenerator] = {
PrintJI:
PROC [to:
IO.
STREAM, cji:
INT] = {
jif: INT = cji/j.size2[Bar];
jib: INT = cji - jif*j.size2[Bar];
to.PutF["[%g, %g]", [integer[jif]], [integer[jib]]];
};
PrintRP:
PROC [to:
IO.
STREAM, rpd: RoledPortData] = {
to.PutF["%g/%g", [rope[EndName[rpd.side]]], [rope[Describe[rpd.port, act.asArray.eltType.port, nameGen]]]];
};
LowPrint: PROC = {PrintPorts[to, act, tie, low, nameGen]};
HighPrint: PROC = {to.PutRope["—"]; PrintPorts[to, act, tie, high, nameGen]};
Bitch:
PROC = {
to.PutF["(%g/%g incomplete", [integer[tie.completion.nIncomplete]], [integer[tie.completion.length]]];
IF printIncompleteness
THEN {
showCon: BOOL = tie.completion.nIncomplete >= j.size/2;
firstPair: BOOL ← TRUE;
rowPattern: BoolSeq ← CreateBoolSeq[j.size2[Bar]];
thisRow: BoolSeq ← CreateBoolSeq[j.size2[Bar]];
to.PutRope[IF showCon THEN " - connected:" ELSE " - disconnected:"];
FOR li: RoledPortDataList ← tie.ports, li.rest
WHILE li #
NIL
DO
FOR lj: RoledPortDataList ← li.rest, lj.rest
WHILE lj #
NIL
DO
PrintPair:
PROC = {
firstRow: INT ← 0;
reportRow, reportCurrent: BOOL ← FALSE;
rowSep: ROPE ← "";
PrintRow:
PROC [lastRow:
INT] = {
bst: BoolSeq = rowPattern;
IF lastRow >= firstRow
AND reportRow
THEN {
firstCol: INT ← 0;
reporting: BOOL ← FALSE;
colSep: ROPE ← " ";
See:
PROC [ji
b:
INT, report:
BOOL] = {
IF report = reporting THEN RETURN;
reporting ← report;
IF report THEN {firstCol ← jib; RETURN};
to.PutRope[colSep]; colSep ← ", ";
SS.Bp[to, FALSE, printStep];
to.PutRope[FmtRange[firstCol, jib-1]];
};
to.PutRope[rowSep]; rowSep ← ", ";
to.PutF["[%g;", [rope[FmtRange[firstRow, lastRow]]]];
FOR ji
b:
INT
IN [0 .. j.size2[Bar])
DO
See[jib, rowPattern[jib]];
ENDLOOP;
See[j.size2[Bar], FALSE];
to.PutRope["]"];
};
rowPattern ← thisRow;
thisRow ← bst;
firstRow ← lastRow+1;
reportRow ← reportCurrent;
};
cji: INT ← 0;
to.PutRope["{"];
PrintRP[to, li.first];
to.PutRope[" & "];
PrintRP[to, lj.first];
to.PutRope[": "];
FOR ji
f:
INT
IN [0 .. j.size2[Foo])
DO
rowSame: BOOL ← jif > 0;
reportCurrent ← FALSE;
FOR ji
b:
INT
IN [0 .. j.size2[Bar])
DO
ir: NAT = GetRoot[j, li.first, cji];
jr: NAT = GetRoot[j, lj.first, cji];
connected: BOOL = ir = jr;
IF thisRow[jib] ← (connected = showCon) THEN reportCurrent ← TRUE;
IF thisRow[jib] # rowPattern[jib] THEN rowSame ← FALSE;
cji ← cji + 1;
ENDLOOP;
IF NOT rowSame THEN PrintRow[jif-1];
ENDLOOP;
PrintRow[j.size2[Foo]-1];
to.PutRope["}"];
};
IF firstPair THEN firstPair ← FALSE ELSE to.PutRope[", "];
PrintObject[to, TRUE, PrintPair];
ENDLOOP ENDLOOP;
};
to.PutRope[")"];
};
to.PutRope["("];
PrintObject[to, TRUE, LowPrint];
PrintObject[to, TRUE, HighPrint];
IF tie.completion # NIL THEN PrintObject[to, TRUE, Bitch];
to.PutRope[")"];
};
PrintPorts:
PROC [to:
IO.
STREAM, act: CellType, tie: Tie, side: End, nameGen: NameGenerator] = {
first: BOOL ← TRUE;
to.PutRope["{"];
FOR rpl: RoledPortDataList ← tie.ports, rpl.rest
WHILE rpl #
NIL
DO
IF rpl.first.side = side
THEN {
PPrint:
PROC = {
to.PutRope[Describe[rpl.first.port, act.asArray.eltType.port, nameGen]];
};
IF first THEN first ← FALSE ELSE to.PutRope[", "];
PrintObject[to, FALSE, PPrint];
};
ENDLOOP;
to.PutRope["}"];
};
PrintGraph:
PROC [to:
IO.
STREAM, act: CellType, j: Joint, tie: Tie, cji:
INT, defsToo:
BOOL ←
TRUE] = {
IF defsToo
THEN {
FOR rpl: RoledPortDataList ← tie.ports, rpl.rest
WHILE rpl #
NIL
DO
to.PutF["%g: %g/%g\n", [integer[rpl.first.index]], [rope[EndName[rpl.first.side]]], [rope[Describe[rpl.first.port, act.asArray.eltType.port, NIL]]]];
ENDLOOP;
};
FOR rpl: RoledPortDataList ← tie.ports, rpl.rest
WHILE rpl #
NIL
DO
to.PutF[" %g -> %g", [integer[rpl.first.index]], [integer[GetNext[j, rpl.first, cji]]]];
ENDLOOP;
};
FmtRange:
PROC [first, last:
INT]
RETURNS [asRope:
ROPE] = {
asRope ← IF first = last THEN IO.PutFR["%g", [integer[first]]] ELSE IO.PutFR["%g~%g", [integer[first]], [integer[last]]];
};
PrintIncompletes:
PROC [to:
IO.
STREAM, design: Design, nameGen: NameGenerator ←
NIL] = {
Filter:
PROC [ct: CellType]
RETURNS [pass:
BOOL] = {
a: Array = ct.asArray;
pass ← FALSE;
IF a = NIL THEN RETURN;
FOR d: Dim
IN Dim
DO
FOR cphase:
INT
IN [0 .. a.joints[d].length)
DO
j: Joint = NARROW[a.joints[d][cphase]];
TestTie:
PROC [ra:
REF
ANY] = {
tie: Tie = NARROW[ra];
IF tie.completion # NIL THEN pass ← TRUE;
};
j.ties.Enumerate[TestTie];
IF pass THEN RETURN;
ENDLOOP;
ENDLOOP;
pass ← pass;
};
PrintDesignSubset[to, design, nameGen, Filter];
};
END.