SaffronContextShowImpl.Mesa
Copyright Ó 1987 by Xerox Corporation. All rights reserved.
Sturgis, July 15, 1987 12:56:40 pm PDT
Bill Jackson (bj) August 12, 1987 5:17:21 pm PDT
Lucy Hederman August 14, 1987 4:47:52 pm PDT
Last edited by: James Rauen August 25, 1988 4:27:14 pm PDT
DIRECTORY
BigCardinals USING [BigCARD, BigFromSmall, BigSubtract, BigToRope, TwoToTheNth],
IO USING [ bool, char, int, PutF, PutRope, rope, STREAM, Value ],
Rope USING [Concat, ROPE],
SaffronBaseDef USING [CompilerStateNode, ValueNode],
SaffronContext USING [ShowDependencyGraph, ShowProgramGraph, ShowValue],
SaffronContextPrivateTypes,
SaffronErrorHandling USING [InternalError],
SaffronGenericDef USING [ IdNode ];
SaffronContextShowImpl: CEDAR PROGRAM
IMPORTS BigCardinals, SaffronContext, IO, Rope
EXPORTS SaffronBaseDef, SaffronContext ~ {
OPEN
BC: BigCardinals,
BD: SaffronBaseDef,
EH: SaffronErrorHandling,
PT: SaffronContextPrivateTypes,
GEN: SaffronGenericDef;
TypeGraphNodeNode: TYPE ~ REF TypeGraphNodeNodeBody;
TypeGraphNodeNodeBody: PUBLIC TYPE ~ PT.TypeGraphNodeNodeBody;
Environment Operations
EnvironmentNode: TYPE ~ REF EnvironmentNodeBody;
EnvironmentNodeBody: PUBLIC TYPE ~ PT.EnvironmentNodeBody;
ShowEnvironment: PUBLIC PROC [on: IO.STREAM, nest: INT, env: EnvironmentNode, cs: BD.CompilerStateNode] = BEGIN
IO.PutF[on, "\n\n%gEnvironment:\n", Indentation[nest]];
FOR cell: PT.IncludedFileCell ← env.firstIncludedFile, cell.next WHILE (cell # NIL) DO
IO.PutF[on, "\n%gFile: %g\n", Indentation[nest+2], IO.rope[cell.fileName]];
on.PutF["%g", Indentation[nest+4]];
RealShowTree[on, nest+4, cell.contextTree, cs];
WITH cell SELECT FROM
c: REF definitions PT.IncludedFileCellBody => NULL;
c: REF implementation PT.IncludedFileCellBody => {
IO.PutF[on, "\n%gCode: \n", Indentation[nest+4]];
IO.PutF[on, "%g", Indentation[nest+6]];
SaffronContext.ShowProgramGraph[on, nest+6, c.code];
};
ENDCASE => ERROR;
ENDLOOP;
END;
ShowEnvironment: PUBLIC PROC [on: IO.STREAM, nest: INT, env: EnvironmentNode, cs: BD.CompilerStateNode] =
BEGIN
OneInterface: PROC[name: Rope.ROPE, raif: REF ANY] =
BEGIN
IO.PutF[on, "%g interface\N", IO.rope[name]];
ShowNested[on, nest];
ShowInterface[on, nest, NARROW[raif], cs];
END;
IO.PutRope[on, "\n\n"];
ShowNested[on, nest]; IO.PutF[on, "Environment\N"];
PT.GenRopeNames[env.interfaces, OneInterface];
END;
Interface Operations
ShowInterface: PROC [on: IO.STREAM, nest: INT, if: InterfaceValNode, cs: BD.CompilerStateNode] = BEGIN
IO.PutRope[on, "\n\n"];
ShowNested[on, nest]; IO.PutF[on, "Interface\N"];
ShowNested[on, nest];
ShowContextTree[on, nest, if.ct, cs];
IO.PutRope[on, "\n\n"];
ShowNested[on, nest]; IO.PutF[on, "types visible in interface\N"];
ShowNested[on, nest];
ShowLocallyVisibleNames[on, nest, if.entries, cs];
END;
Context Operations
DependencyGraphNode: TYPE = REF DependencyGraphNodeBody;
DependencyGraphNodeBody: PUBLIC TYPE = PT.DependencyGraphNodeBody;
RealShowLocalContext: PROC [on: IO.STREAM, nest: INT, lc: LocalContextNode, cs: BD.CompilerStateNode] ~ {
FOR tgn: TypeGraphNodeNode ← lc.tgNodes, tgn.next WHILE ( tgn # NIL ) DO
tgn.shown ← FALSE;
ENDLOOP;
FOR fl: FrozenFieldListNode ← lc.fieldLists, fl.next WHILE ( fl # NIL ) DO
fl.shown ← FALSE;
ENDLOOP;
IO.PutF[on, "\n%gLocal context contents: ", Indentation[nest]];
ShowTGN[on, nest+2, NARROW[lc.contents, REF frozen PT.LocalContextContentsBody].block];
IO.PutF[on, "\n%gOther type graph nodes in local context: \n", Indentation[nest]];
FOR tgn: TypeGraphNodeNode ← lc.tgNodes, tgn.next WHILE ( tgn # NIL ) DO
IF NOT tgn.shown THEN {
IO.PutRope[on, "\n\n"]; ShowNested[on, nest+2];
ShowTGN[on, nest+2, tgn];
}
ENDLOOP;
IO.PutF[on, "\n\n%gDependency Graph: \n", Indentation[nest]];
IF lc.dependencyGraph = NIL
THEN on.PutF["%g(no dependency graph)", Indentation[nest+2]]
ELSE SaffronContext.ShowDependencyGraph[on, nest+2, lc.dependencyGraph];
IO.PutRope[on, "\n\n"];
};
none of the internal nodes are visible from outside, so just trees
ShowLocallyVisibleNames: PROC [ on: IO.STREAM, nest: INT, lvtn: VisibleNames, cs: BD.CompilerStateNode ] ~ {
first: BOOLEAN ← TRUE;
ShowOneLVTGN: PT.TypeProc ~ {
primitiveType: BOOLEAN ← NOT ISTYPE[type.body, NamedTGN];
IF NOT first THEN { IO.PutRope[on, "\n\n"]; ShowNested[on, nest] };
first ← FALSE;
IO.PutF[on, "%g: %g %gTYPE\n", IORopeForId[name], IORopeFromAVN[access], IO.rope[IF primitiveType THEN "INTERNAL " ELSE ""]];
ShowNested[on, nest+2];
IF primitiveType
THEN ShowTGN[on, nest+4, type]
ELSE ShowNamedTGNTree[on, nest+4, type];
};
ShowOneConstant: PT.ConstantProc ~ {
IF NOT first THEN { IO.PutRope[on, "\n\n"]; ShowNested[on, nest] };
first ← FALSE;
IO.PutF[on, "%g: %g CONSTANT\n", IORopeForId[name], IORopeFromAVN[access]];
IO.PutF[on, "%gType ==\n", Indentation[nest + 2]];
ShowNested[on, nest+4];
ShowTGN[on, nest+4, BD.Type[value]];
IO.PutF[on, "\n%gValue == %g\n", Indentation[nest + 2], IO.rope[BD.RopeFromInstance[value]]];
};
ShowOneVariable: PT.VarProc ~ {
IF NOT first THEN { IO.PutRope[on, "\n\n"]; ShowNested[on, nest] };
first ← FALSE;
IO.PutF[on, "%g: %g VARIABLE\n", IORopeForId[name], IORopeFromAVN[access]];
IO.PutF[on, "%gType ==\n", Indentation[nest + 2]];
ShowNested[on, nest+4];
ShowTGN[on, nest+4, BD.Type[value]];
IO.PutF[on, "\n%gValue == %g\n", Indentation[nest + 2], IO.rope[BD.RopeFromInstance[value]]];
};
IO.PutRope[on, "\n"]; ShowNested[on, nest];
PT.MapOntoLocalNames[lvtn, ShowOneLVTGN, ShowOneConstant, ShowOneVariable];
};
Idea is that this routine will print out address of node on current line, and allow called routine to put more info on that line, or on subsequent lines.
Nodes will be marked to show that they have been printed, so we do not progress any deaper on previously printed nodes.
We do not proceed passed a named node in any case. (ShowNamedTGNTree will do that)
We assume that we have been positioned on current line, and that the caller will supply the final carriage return.
ShowTGN: PROC [on: IO.STREAM, nest: INT, tgn: TypeGraphNodeNode, short: BOOLEAN ← FALSE] ~ {
IO.PutF[on, "[%g](%g): ", IO.int[tgn.index], IO.int[LOOPHOLE[tgn, INT]]];
IF NOT short THEN
BEGIN
IF tgn.shown THEN
WITH tgn.body SELECT FROM
ntgn: PT.NamedTGN => ShowNamedTGN[on, nest, ntgn, TRUE];
ENDCASE => NULL
ELSE {
tgn.shown ← TRUE;
WITH tgn.body SELECT FROM
u: PT.ArrayTGN  => ShowArrayTGN[on, nest, u];
u: PT.AtomTGN  => ShowAtomTGN[on, nest, u];
u: PT.BlockTGN  => ShowBlockTGN[on, nest, u];
u: PT.ConditionTGN  => ShowConditionTGN[on, nest, u];
u: PT.DescriptorTGN  => ShowDescriptorTGN[on, nest, u];
u: PT.ElementTGN  => ShowElementTGN[on, nest, u];
u: PT.IdentifierTGN => ShowIdentifierTGN[on, nest, u];
u: PT.ImplementationTGN => ShowImplementationTGN[on, nest, u];
u: PT.InterfaceTGN  => ShowInterfaceTGN[on, nest, u];
u: PT.InterfaceContentsTGN => ShowInterfaceContentsTGN[on, nest, u];
u: PT.LinkTGN  => ShowLinkTGN[on, nest, u];
u: PT.ListTGN  => ShowListTGN[on, nest, u];
u: PT.LongTGN  => ShowLongTGN[on, nest, u];
u: PT.ModuleTGN => ShowModuleTGN[on, nest, u];
u: PT.MonitorlockTGN  => ShowMonitorlockTGN[on, nest, u];
u: PT.NamedTGN  => ShowNamedTGN[on, nest, u, FALSE];
u: PT.OpaqueTGN  => ShowOpaqueTGN[on, nest, u];
u: PT.PointerTGN  => ShowPointerTGN[on, nest, u];
u: PT.RealTGN  => ShowRealTGN[on, nest, u];
u: PT.RecordTGN  => ShowRecordTGN[on, nest, u];
u: PT.RefTGN  => ShowRefTGN[on, nest, u];
u: PT.ReferentTGN  => ShowReferentTGN[on, nest, u];
u: PT.RelativeTGN  => ShowRelativeTGN[on, nest, u];
u: PT.SequenceTGN  => ShowSequenceTGN[on, nest, u];
u: PT.StringTGN  => ShowStringTGN[on, nest, u];
u: PT.TopTGN  => ShowTopTGN[on, nest, u];
u: PT.BottomTGN  => ShowBottomTGN[on, nest, u];
u: PT.TransferTGN  => ShowTransferTGN[on, nest, u];
u: PT.UnspecifiedTGN  => ShowMonitorlockTGN[on, nest, u];
u: PT.VarTGN  => ShowVarTGN[on, nest, u];
u: PT.VariantPartTGN  => ShowVariantPartTGN[on, nest, u];
u: PT.ZoneTGN  => ShowZoneTGN[on, nest, u];
stgn: PT.SpecianatedTGN  => ShowSpecianatedTGN[on, nest, stgn];
ENDCASE => ERROR;
}
END;
};
ShowNamedTGNTree: PROC [ on: IO.STREAM, nest: INT, tgn: TypeGraphNodeNode ] ~ {
ntgn: PT.NamedTGN ← NARROW[tgn.body];
ShowNamedTGN[on, nest, ntgn, FALSE];
tgn.shown ← TRUE;
};
ShowTGNAsNamedSubstructure: PROC [ on: IO.STREAM, nest: INT, name: Rope.ROPE,
tgn: TypeGraphNodeNode ] ~ {
IO.PutF[on, "\n"]; ShowNested[on, nest+2]; IO.PutF[on, "%g ", IO.rope[name]];
ShowTGN[on, nest+2, tgn];
};
Now for the assorted body types
Array
ShowArrayTGN: PROC [on: IO.STREAM, nest: INT, atgn: PT.ArrayTGN] ~ {
IO.PutF[on, "%garray\n", IO.rope[IF atgn.packed THEN "packed " ELSE ""]];
ShowTGNAsNamedSubstructure[on, nest+2, "indexType", atgn.indexType];
ShowTGNAsNamedSubstructure[on, nest+2, "itemType", atgn.itemType];
};
Atom
ShowAtomTGN: PROC [on: IO.STREAM, nest: INT, atgn: PT.AtomTGN] ~ {
IO.PutF[on, "ATOM"];
};
Block
ShowBlockTGN: PROC [on: IO.STREAM, nest: INT, btgn: PT.BlockTGN] ~ {
IO.PutF[on, "BLOCK\n"];
on.PutF["%gFields: ", Indentation[nest+2]];
ShowFrozenFieldList[on, nest+4, btgn.ffl];
};
Condition
ShowConditionTGN: PROC [on: IO.STREAM, nest: INT, ctgn: PT.ConditionTGN] ~ {
IO.PutF[on, "CONDITION"];
};
Descriptor
ShowDescriptorTGN: PROC [ on: IO.STREAM, nest: INT, dtgn: PT.DescriptorTGN ] ~ {
IO.PutF[on, "%descriptor\n", IO.rope[IF dtgn.readonly THEN "ReadOnly " ELSE ""]];
ShowTGNAsNamedSubstructure[on, nest+2, "itemType", dtgn.itemType];
};
Element
ShowElementTGN: PROC [on: IO.STREAM, nest: INT, etgn: PT.ElementTGN] ~ {
WITH etgn SELECT FROM
v: REF base PT.ElementTGNBody => {
on.PutF["Basic Element Type\n"];
on.PutF["%gElements: ", Indentation[nest+2]];
WITH v SELECT FROM
vv: REF boolean base PT.ElementTGNBody =>
on.PutF["FALSE, TRUE"];
vv: REF character base PT.ElementTGNBody =>
on.PutF["["];
vv: REF enumerated base PT.ElementTGNBody =>
on.PutF["[%g..%g]", IO.char[0C], IO.char[377C]];
vv: REF integer base PT.ElementTGNBody => {
moby: BC.BigCARD ← BC.TwoToTheNth[vv.body.nBits];
moby1: BC.BigCARD ← BC.BigSubtract[moby, BC.BigFromSmall[1]];
mobyRope: Rope.ROPE ← BC.BigToRope[moby];
moby1Rope: Rope.ROPE ← BC.BigToRope[moby1];
IF vv.body.signed
THEN on.PutF["(-2^%g)..(2^%g - 1)", IO.int[vv.body.nBits], IO.int[vv.body.nBits]]
ELSE on.PutF["0..(2^%g - 1)", IO.int[vv.body.nBits]]
};
ENDCASE => ERROR;
};
v: REF subrange PT.ElementTGNBody => {
on.PutF["Subrange Element Type"];
on.PutF["\n%gBase Type: ", Indentation[nest+2]];
ShowTGN[on, nest+2, v.body.baseType];
on.PutF["\n%gFirst Element: ", Indentation[nest+2]];
SaffronContext.ShowValue[on, nest+2, v.body.firstElement];
on.PutF["\n%gLast Element: ", Indentation[nest+2]];
SaffronContext.ShowValue[on, nest+2, v.body.lastElement];
};
ENDCASE => ERROR;
};
ShowEnumTypeTGN: PROC [ on: IO.STREAM, nest: INT, etgn: PT.EnumTGN ] ~ {
IO.PutF[on, "Enumerated Type %g {", IO.rope[IF etgn.machineDependent THEN "(MachineDependent)" ELSE ""]];
ShowPaint[on, nest, etgn.paint];
FOR cell: EnumElementCell ← etgn.firstElement, cell.next WHILE ( cell # NIL ) DO
IO.PutF[on, " %g %g", IF cell.id # NIL THEN IO.rope[RopeForId[cell.id]] ELSE IO.rope[""], IF cell.rep # NIL THEN IO.rope[Rope.Cat["(", TextForExpPTree[cell.rep], ")"]] ELSE IO.rope[""]];
IF cell = etgn.lastElement THEN EXIT;
ENDLOOP;
IO.PutF[on, " }"];
};
ShowSubrangeTGN: PROC [ on: IO.STREAM, nest: INT, srtgn: PT.SubrangeTGN ] ~ {
IO.PutF[on, " sub range of\n"]; ShowNested[on, nest+2];
ShowTGN[on, nest+2, srtgn.subrangeOf];
IO.PutF[on, "\n"]; ShowNested[on, nest+2];
ShowBVN[on, nest+2, srtgn.bounds];
};
Identifier
ShowIdentifierTGN: PROC [ on: IO.STREAM, nest: INT, itgn: PT.IdentifierTGN ] = BEGIN
on.PutF["Identifier \"%g\"", IO.rope[itgn.id.text]];
ERROR EH.InternalError["IdentifierTGN in type graph"];
note: none of these should appear in a complete type graph!!
END;
Implementation
ShowImplementationTGN: PROC [ on: IO.STREAM, nest: INT, itgn: PT.ImplementationTGN ] = BEGIN
on.PutF["IMPLEMENTATION\n"];
on.PutF["%gCedar: %g\n", Indentation[nest+2], IO.rope[IF itgn.cedar THEN "Yes" ELSE "No"]];
on.PutF["%gKind: %g\n", Indentation[nest+2], IO.rope[SELECT itgn.kind FROM monitor => "Monitor", program => "Program", ENDCASE => ERROR]];
on.PutF["%gLocks: %g\n", Indentation[nest+2], IO.rope[itgn.locks]];
on.PutF["%gImports: %g\n", Indentation[nest+2], IO.rope[itgn.imports]];
on.PutF["%gExports: %g\n", Indentation[nest+2], IO.rope[itgn.exports]];
on.PutF["%gShares: %g\n", Indentation[nest+2], IO.rope[itgn.shares]];
on.PutF["%gType:", Indentation[nest+2]];
ShowTGN[on, nest+2, itgn.type];
END;
Interface
ShowInterfaceTGN: PROC [ on: IO.STREAM, nest: INT, itgn: PT.InterfaceTGN ] = BEGIN
IO.PutF[on, "INTERFACE\n"];
on.PutF["%gCedar: %g\n", Indentation[nest+2], IO.rope[IF itgn.cedar THEN "Yes" ELSE "No"]];
on.PutF["%gLocks: %g\n", Indentation[nest+2], IO.rope[itgn.locks]];
on.PutF["%gImports: %g\n", Indentation[nest+2], IO.rope[itgn.imports]];
on.PutF["%gShares: %g\n", Indentation[nest+2], IO.rope[itgn.shares]];
END;
ShowInterfaceTGN: PROC [ on: IO.STREAM, nest: INT, itgn: PT.InterfaceTGN ] =
BEGIN
first: BOOLEAN ← TRUE;
ShowOneInterfaceItem: PROC[name: GEN.IdNode, access: AccessValNode, value: REF ANY] =
BEGIN
IF NOT first THEN { IO.PutRope[on, "\n\n"]; ShowNested[on, nest] };
first ← FALSE;
IO.PutRope[on, RopeForId[name]];
ShowAVN[on, nest, access];
IO.PutRope[on, "\n"]; ShowNested[on, nest+2];
ShowNamedTGNTree[on, nest+4, NARROW[value]];
END;
IO.PutF[on, " interfaceTGN %g ", IO.rope[IF itgn.sharedAccess THEN "sharedAccess" ELSE "unSharedAccess"]];
GenVisibleNames[itgn.typeNames, ShowOneInterfaceItem];
END;
Interface Contents
ShowInterfaceContentsTGN: PROC [ on: IO.STREAM, nest: INT, ictgn: PT.InterfaceContentsTGN ] = BEGIN
on.PutF["INTERFACE CONTENTS\n"];
on.PutF["%gFields: ", Indentation[nest+2]];
ShowFrozenFieldList[on, nest+4, ictgn.ffl];
END;
Link
ShowLinkTGN: PROC [ on: IO.STREAM, nest: INT, linktgn: PT.LinkTGN ] = BEGIN
IO.PutF[on, "link to external module \N", ];
ShowNested[on, nest+2];
IO.PutF[on, "interface to external module\N"];
ShowNested[on, nest+2];
IO.PutF[on, "external type name: %g\N", IO.rope[RopeForId[linktgn.itemName]]];
ShowTGN[on, nest+2, linktgn.tgn, TRUE];
END;
List
ShowListTGN: PROC [ on: IO.STREAM, nest: INT, ltgn: PT.ListTGN ] ~ {
IO.PutF[on, "LIST %Gof \n", IO.rope[IF ltgn.readOnly THEN "(readOnly)" ELSE ""]];
ShowNested[on, nest+1]; IO.PutF[on, "item type = "];
ShowTGN[on, nest+2, ltgn.elementType];
};
Long
ShowLongTGN: PROC [ on: IO.STREAM, nest: INT, ltgn: PT.LongTGN ] ~ {
IO.PutF[on, " long "];
ShowTGN[on, nest+2, ltgn.underlyingType];
};
Module
ShowModuleTGN: PROC [ on: IO.STREAM, nest: INT, mtgn: PT.ModuleTGN ] ~ {
on.PutF["MODULE\n"];
on.PutF["%gFields: ", Indentation[nest+2]];
ShowFrozenFieldList[on, nest+4, mtgn.ffl];
};
Monitorlock
ShowMonitorlockTGN: PROC [ on: IO.STREAM, nest: INT, mtgn: PT.MonitorlockTGN ] ~ {
IO.PutF[on, "MONITORLOCK"];
};
Named
ShowNamedTGN: PROC [ on: IO.STREAM, nest: INT, ntgn: PT.NamedTGN, shown: BOOLEAN ] ~ {
IO.PutF[on, "Named Type \"%g\"\n", IO.rope[RopeForId[ntgn.name]]];
IF shown THEN RETURN;
on.PutF["%gType Access: ", Indentation[nest+2]];
ShowAVN[on, nest, ntgn.access];
on.PutF["\n%gDefault: ", Indentation[nest+2]];
ShowDEN[on, nest, ntgn.default];
IO.PutF[on, "\n%g", Indentation[nest+2]];
IF NOT shown THEN {
on.PutF["Type: "];
ShowTGN[on, nest+2, ntgn.type];
};
};
Opaque
ShowOpaqueTGN: PROC[on: IO.STREAM, nest: INT, otgn: PT.OpaqueTGN] = BEGIN
IO.PutF[on, " Opaque"];
ShowPaint[on, nest, otgn.paint];
IO.PutF[on, " %g", IO.rope[TextForExpPTree[otgn.optSize]]];
END;
Pointer
ShowPointerTGN: PROC [ on: IO.STREAM, nest: INT, ptgn: PT.PointerTGN ] ~ {
IO.PutF[on, "%g Pointer %g %g\n",
IO.rope[IF ptgn.ordered THEN "(ordered)" ELSE ""],
IO.rope[IF ptgn.base THEN "(base)" ELSE ""],
IO.rope[IF ptgn.readOnly THEN "(readOnly)" ELSE ""]];
ShowNested[on, nest+1];
ShowBVN[on, nest+1, ptgn.bounds];
IO.PutF[on, "\n"]; ShowNested[on, nest+1]; IO.PutF[on, "target type = "];
ShowTGN[on, nest+2, ptgn.target];
};
Real
ShowRealTGN: PROC [ on: IO.STREAM, nest: INT, rtgn: PT.RealTGN ] ~ {
IO.PutF[on, "REAL"];
};
Record
ShowRecordTGN: PROC [ on: IO.STREAM, nest: INT, rn: PT.RecordTGN ] ~ {
IO.PutF[on, "RECORD"];
ShowPaint[on, nest, rn.paint];
on.PutF["\n%gMachine Dependent: %g\n", Indentation[nest+2], IO.bool[rn.machineDependent]];
on.PutF["%gMonitored: %g\n", Indentation[nest+2], IO.bool[rn.monitoredRecord]];
on.PutF["%gFields: ", Indentation[nest+2]];
ShowFrozenFieldList[on, nest+4, rn.fields];
};
Ref
ShowRefTGN: PROC [ on: IO.STREAM, nest: INT, rtgn: PT.RefTGN ] ~ {
IO.PutF[on, "Ref %g\n", IO.rope[IF rtgn.machineDependent THEN "(machine dependent)" ELSE ""]];
ShowTGNAsNamedSubstructure[on, nest+2, "target type = ", rtgn.target];
};
Referent
ShowReferentTGN: PROC [ on: IO.STREAM, nest: INT, refenttgn: PT.ReferentTGN ] ~ {
IO.PutF[on, "REFERENT\n"];
ShowTGNAsNamedSubstructure[on, nest+2, "contents type = ", refenttgn.contents];
};
Relative
ShowRelativeTGN: PROC [ on: IO.STREAM, nest: INT, rtgn: PT.RelativeTGN ] ~ {
IO.PutF[on, "relative\n"];
ShowTGNAsNamedSubstructure[on, nest+2, "base type = ", rtgn.base];
ShowTGNAsNamedSubstructure[on, nest+2, "pointer type = ", rtgn.pointer];
};
Sequence
ShowSequenceTGN: PROC [ on: IO.STREAM, nest: INT, stgn: PT.SequenceTGN ] ~ {
IO.PutF[on, "%gsequence\n", IO.rope[IF stgn.packed THEN "packed " ELSE ""]]; ShowNested[on, nest+2];
IO.PutF[on, "%g", IO.rope[RopeForId[stgn.indexId]]];
ShowPVN[on, nest, stgn.indexPosition];
ShowAVN[on, nest, stgn.indexAccess];
ShowTGNAsNamedSubstructure[on, nest+2, "tagType", stgn.tagType];
ShowTGNAsNamedSubstructure[on, nest+2, "type", stgn.type];
IO.PutF[on, "\n"]; ShowNested[on, nest+2]; IO.PutF[on, "tagType "];
};
String
ShowStringTGN: PROC [ on: IO.STREAM, nest: INT, stgn: PT.StringTGN ] ~ {
IO.PutF[on, "STRING"];
};
Top and Bottom
ShowTopTGN: PROC [ on: IO.STREAM, nest: INT, ttgn: PT.TopTGN ] ~ {
IO.PutF[on, "TOP"];
};
ShowBottomTGN: PROC [ on: IO.STREAM, nest: INT, btgn: PT.BottomTGN ] ~ {
IO.PutF[on, "BOTTOM"];
};
Transfer
ShowTransferTGN: PROC [ on: IO.STREAM, nest: INT, ttgn: PT.TransferTGN ] ~ {
modeName: Rope.ROPE ← SELECT ttgn.mode FROM
proc => "proc",
port => "port",
signal => "signal",
error => "error",
process => "process",
program => "program",
ENDCASE => ERROR;
IO.PutF[on, "%g transfer\n", IO.rope[modeName]];
on.PutF["%gArguments: ", Indentation[nest+2]];
ShowFrozenFieldList[on, nest+4, ttgn.arguments];
on.PutF["%gResults: ", Indentation[nest+2]];
ShowFrozenFieldList[on, nest+4, ttgn.results];
};
Unspecified
Var
ShowVarTGN: PROC [ on: IO.STREAM, nest: INT, vtgn: PT.VarTGN ] ~ {
IO.PutF[on, "var\n"];
ShowTGNAsNamedSubstructure[on, nest+2, "target type = ", vtgn.target];
};
Variant Part and Union List
ShowVariantPartTGN: PROC [ on: IO.STREAM, nest: INT, vptgn: PT.VariantPartTGN ] ~ {
IO.PutF[on, "variant\n"]; ShowNested[on, nest+2];
ShowVariantFlavor[on, nest+2, vptgn.flavor];
IO.PutF[on, "tagType\n"]; ShowNested[on, nest+2];
ShowTGN[on, nest+2, vptgn.tagType];
IO.PutF[on, "\n"];
ShowNested[on, nest+2]; IO.PutF[on, "variations\n"]; ShowNested[on, nest+2];
ShowFrozenUnionList[on, nest+2, vptgn.types];
};
ShowFrozenUnionList: PROC [ on: IO.STREAM, nest: INT, ful: PT.FrozenUnionList ] ~ {
first: BOOLEAN ← FALSE;
FOR I: CARDINAL IN [0..ful.nTypes) DO
IF NOT first THEN { IO.PutF[on, "\n"]; ShowNested[on, nest] };
IO.PutF[on, "%g => ", IO.rope[RopeForId[ful[I].id]]];
ShowFrozenFieldList[on, nest+2, ful[I].fields];
ENDLOOP;
};
Zone TGN
ShowZoneTGN: PROC [ on: IO.STREAM, nest: INT, ztgn: PT.ZoneTGN ] ~ {
IO.PutF[on, "% zone ", IO.rope[IF ztgn.uncounted THEN "uncounted" ELSE "counted"]];
};
Field lists and frozen field lists
ValueNode: TYPE = REF ValueNodeBody;
ValueNodeBody: PUBLIC TYPE = PT.ValueNodeBody;
ShowFrozenFieldList: PROC [ on: IO.STREAM, nest: INT, ffl: PT.FrozenFieldListNode ] ~ {
IO.PutF[on, "Frozen Field List (%g) %g", IO.int[LOOPHOLE[ffl, INT]], IO.rope[IF ffl.cells.any THEN "ANY" ELSE ""]];
ffl.shown ← FALSE;
IF NOT ffl.shown THEN {
ffl.shown ← TRUE;
FOR cell: PT.FieldListCell ← ffl.cells.first, cell.next WHILE (cell # NIL) DO
IO.PutRope[on, "\n"]; ShowNested[on, nest];
IO.PutF[on, "%g: ", IO.rope[IF cell.node.name = NIL THEN "<unnamed>" ELSE RopeForId[cell.node.name]]];
ShowPVN[on, nest, cell.node.position];
WITH cell.node SELECT FROM
c: REF typeDecl PT.FieldNodeBody => {
ShowAVN[on, nest, c.access];
IO.PutF[on, " TYPE"];
IO.PutF[on, "\n%gType == ", Indentation[nest+2]];
ShowTGN[on, nest+2, c.type];
};
c: REF module PT.FieldNodeBody => {
};
c: REF constant PT.FieldNodeBody => {
ShowAVN[on, nest, c.access];
IO.PutF[on, " CONSTANT"];
IO.PutF[on, "\n%gType == ", Indentation[nest+2]];
ShowTGN[on, nest+2, c.type];
IO.PutF[on, "\n%gValue == ", Indentation[nest+2]];
SaffronContext.ShowValue[on, nest+2, c.value];
};
c: REF variable PT.FieldNodeBody => {
ShowAVN[on, nest, c.access];
IO.PutF[on, " VARIABLE"];
IO.PutF[on, "\n%gType == ", Indentation[nest+2]];
ShowTGN[on, nest+2, c.type];
IO.PutF[on, "\n%gInitial Value == ", Indentation[nest+2]];
SaffronContext.ShowValue[on, nest+2, c.initialValue];
};
c: REF recordField PT.FieldNodeBody => {
ShowAVN[on, nest, c.access];
IO.PutF[on, " FIELD"];
IO.PutF[on, "\n%gType == ", Indentation[nest+2]];
ShowTGN[on, nest+2, c.type];
IO.PutF[on, "\n%gDefault == ", Indentation[nest+2]];
ShowDEN[on, nest+2, c.initialization];
};
ENDCASE => ERROR;
ENDLOOP;
};
on.PutF["\n"];
};
ShowFieldList: PROC [on: IO.STREAM, nest: INT, fl: FieldListNode] = BEGIN
IO.PutF[on, "Field List (%g) %g", IO.int[LOOPHOLE[fl, INT]], IO.rope[IF fl.any THEN "ANY" ELSE ""]];
ShowFrozenFieldList: PROC [ on: IO.STREAM, nest: INT, ffl: FrozenFieldListNode ] ~ {
IO.PutF[on, "ffl (%g) %g", IO.int[LOOPHOLE[ffl, INT]], IO.rope[IF ffl.any THEN "ANY" ELSE ""]];
IF NOT ffl.shown THEN {
ffl.shown ← TRUE;
FOR x: CARDINAL IN [0..ffl.nSlots) DO
IO.PutRope[on, "\n"]; ShowNested[on, nest];
SELECT ffl.fields[x].case FROM
field => {
IF ffl.fields[x].name = NIL
THEN { -- assume unnamed field
IO.PutF[on, "<>: "]
}
ELSE { -- assume named field
IO.PutF[on, "%g: ", IO.rope[RopeForId[ffl.fields[x].name]]];
ShowPVN[on, nest, ffl.fields[x].pvn];
ShowAVN[on, nest, ffl.fields[x].avn];
};
ShowTGN[on, nest+2, ffl.fields[x].tgn];
ShowDEN[on, nest+2, ffl.fields[x].default]
};
ffl => ShowFrozenFieldList[on, nest+2, ffl.fields[x].ffl];
ENDCASE => ERROR;
ENDLOOP;
};
};
Variant Flavors
ShowVariantFlavor: PROC [ on: IO.STREAM, nest: INT, vf: PT.VariantFlavorNode ] ~ {
WITH vf SELECT FROM
o: REF PT.VariantFlavorNodeBody.overlaid =>
IO.PutF[on, "Overlaid"];
c: REF PT.VariantFlavorNodeBody.computed =>
IO.PutF[on, "Computed"];
v: REF PT.VariantFlavorNodeBody.vanilla => {
IO.PutF[on, "Vanilla %g", IO.rope[RopeForId[v.id]]];
ShowPVN[on, nest, v.position];
ShowAVN[on, nest, v.access];
};
ENDCASE => ERROR;
};
Specianated TGN
ShowSpecianatedTGN: PROC [ on: IO.STREAM, nest: INT, stgn: PT.SpecianatedTGN ] ~ {
IO.PutF[on, "%g specianated ", IF ( stgn.expParam # NIL )
THEN IO.rope["foobar"]
THEN IO.rope[TextForExpPTree[stgn.expParam]]
ELSE IO.rope[RopeForId[stgn.idParam]]
];
ShowTGN[on, nest+2, stgn.underlyingType];
};
Paint nodes
ShowPaint: PROC [ on: IO.STREAM, nest: INT, paint: PT.PaintNode ] ~ {
IO.PutF[on, " (paint = %g) ", IO.int[paint.index]];
};
Locally Visible Names
General purpose show routines
ShowNested: PROC [ on: IO.STREAM, nest: INT ] ~ {
FOR i: INT IN [0..nest) DO
IO.PutRope[on, " "];
ENDLOOP
};
Indentation: PROC [nest: INT] RETURNS [IO.Value] ~ {
r: Rope.ROPE ← "";
FOR i: INT IN [0..nest) DO
r ← Rope.Concat[r, " "];
ENDLOOP;
RETURN[IO.rope[r]];
};
RopeForId: PROC [ id: GEN.IdNode ] RETURNS [ Rope.ROPE ] ~ {
RETURN[IF ( id # NIL ) THEN id.text ELSE ""];
};
IORopeForId: PROC [ id: GEN.IdNode ] RETURNS [IO.Value] ~ {
RETURN[IO.rope[IF ( id # NIL ) THEN id.text ELSE ""]];
};
Context Ribs
RealShowRib: PROC [on: IO.STREAM, nest: INT, rib: PT.ContextRibNode, cs: BD.CompilerStateNode] ~ {
IO.PutF[on, "Context Rib %g:", IO.int[LOOPHOLE[rib, INT]]];
IO.PutRope[on, "\n"]; ShowNested[on, nest+2];
RealShowLocalContext[on, nest+2, rib.lc, cs];
};
Context Trees
RealShowTree: PROC [on: IO.STREAM, nest: INT, ct: ContextTreeNode, cs: BD.CompilerStateNode] ~ {
on.PutF["Context Tree %g:\n", IO.int[LOOPHOLE[ct, INT]]];
ShowNested[on, nest+2];
RealShowRib[on, nest+2, ct.rib, cs];
IO.PutRope[on, "\n\n"]; ShowNested[on, nest+4];
FOR cell: PT.CTCell ← ct.firstSubTree, cell.next WHILE ( cell # NIL ) DO
RealShowTree[on, nest+4, cell.ctn, cs];
IF cell = ct.lastSubTree THEN EXIT;
ENDLOOP;
};
Default Exp Nodes
ShowDEN: PROC [ on: IO.STREAM, nest: INT, den: PT.DefaultExpNode ] ~ {
t1: Rope.ROPE ← IF den = NIL THEN "" ELSE SELECT den.case FROM
c1 => "",
c2 => "← ",
c3 => "𡤎 ",
c4 => "←TRASH ",
c5 => "𡤎|TRASH ",
ENDCASE => ERROR;
t2: Rope.ROPE ← IF den = NIL THEN "" ELSE ""; -- TextForExpPTree[den.exp];
IO.PutF[on, "<%g%g>", IO.rope[t1], IO.rope[t2]];
};
position val nodes
ShowPVN: PROC [ on: IO.STREAM, nest: INT, pvn: PT.PositionValNode ] ~ {
IF ( pvn # NIL ) THEN {
IO.PutF[on, "( %g ", IO.rope["foobar"]];
IO.PutF[on, "( %g ", IO.rope[TextForExpPTree[pvn.index]]];
ShowBVN[on, nest, pvn.bounds];
IO.PutF[on, " )"];
};
};
bounds val nodes
The colon is not needed for some uses, but I have to go back and figure out all of the uses, and see which ones need the colon.
ShowBVN: PROC [ on: IO.STREAM, nest: INT, bvn: PT.BoundsValNode ] ~ {
IF bvn # NIL THEN {
left: Rope.ROPE ← SELECT bvn.left FROM
open => "(",
closed => "[",
ENDCASE => ERROR;
right: Rope.ROPE ← SELECT bvn.right FROM
open => ")",
closed => "]",
ENDCASE => ERROR;
IO.PutF[on, ": %g%g..%g%g ", IO.rope[left], IO.rope["foo"], IO.rope["bar"], IO.rope[right]];
IO.PutF[on, ": %g%g..%g%g ", IO.rope[left], IO.rope[TextForExpPTree[bvn.first]], IO.rope[TextForExpPTree[bvn.last]], IO.rope[right]];
};
};
access val nodes
ShowAVN: PROC [ on: IO.STREAM, nest: INT, avn: PT.AccessValNode ] ~ {
IO.PutF[on, " %g", IORopeFromAVN[avn]]
};
IORopeFromAVN: PROC [avn: PT.AccessValNode] RETURNS [IO.Value] ~ {
RETURN [IO.rope[IF avn = NIL
THEN "!!Error: No AVN!!"
ELSE SELECT avn^ FROM
private => "PRIVATE",
public => "PUBLIC",
NotSureWhatItShouldBe => "!!Error: Undetermined AVN!!",
ENDCASE => ERROR]];
};
ExpPTree
TextForExpPTree: PROC [ exp: ExpPTreeNode ] RETURNS [ Rope.ROPE ] ~ { RETURN[IF (exp # NIL) THEN "exp" ELSE ""] };
ScopePTree
misc stuff
following are exported to SaffronContext
ShowContextRib: PROC [ on: IO.STREAM, nest: INT, rib: PT.ContextRibNode, cs: BD.CompilerStateNode] ~ {
RealShowRib[on, nest, rib, cs];
};
LocalContextNode: TYPE ~ REF LocalContextNodeBody;
LocalContextNodeBody: PUBLIC TYPE ~ PT.LocalContextNodeBody;
ShowLocalContext: PUBLIC PROC [ on: IO.STREAM, nest: INT, lc: LocalContextNode, cs: BD.CompilerStateNode ] ~ {
RealShowLocalContext[on, nest, lc, cs];
};
ContextTreeNode: TYPE ~ REF ContextTreeNodeBody;
ContextTreeNodeBody: PUBLIC TYPE ~ PT.ContextTreeNodeBody;
ShowContextTree: PUBLIC PROC [ on: IO.STREAM, nest: INT, ct: ContextTreeNode, cs: BD.CompilerStateNode ] ~ {
RealShowTree[on, nest, ct, cs];
};
RopeFromValue: PUBLIC PROC [v: BD.ValueNode] RETURNS [Rope.ROPE] = BEGIN
RETURN ["value"];
END;
}.