<> <> <> <> <> <> 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, <> SaffronGenericDef USING [ IdNode ]; <<>> SaffronContextShowImpl: CEDAR PROGRAM IMPORTS BigCardinals, SaffronContext, IO, Rope EXPORTS SaffronBaseDef, SaffronContext ~ { OPEN BC: BigCardinals, BD: SaffronBaseDef, <> PT: SaffronContextPrivateTypes, GEN: SaffronGenericDef; TypeGraphNodeNode: TYPE ~ REF TypeGraphNodeNodeBody; TypeGraphNodeNodeBody: PUBLIC TYPE ~ PT.TypeGraphNodeNodeBody; <> 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; <> <> <> <> <> <> <> <> <> <> <> <> <<>> <> <> <> <> <> <> <> <> <> <> <> <> 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; <> <> <> <<>> 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"]; }; <> <> <> <> <> <> <> <> <> <> <> <> <<};>> <> <> <> <> <> <> <> <> <<};>> <> <> <> <> <> <> <> <> <<};>> <> <> <<};>> <<>> <> <> <> <> 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]; < 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]; < 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]; }; <> <> 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]; }; <> ShowAtomTGN: PROC [on: IO.STREAM, nest: INT, atgn: PT.AtomTGN] ~ { IO.PutF[on, "ATOM"]; }; <> 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]; }; <> ShowConditionTGN: PROC [on: IO.STREAM, nest: INT, ctgn: PT.ConditionTGN] ~ { IO.PutF[on, "CONDITION"]; }; <> 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]; }; <> 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; }; <> <> <> <> <> <> <> <> <<};>> <<>> <> <> <> <> <> <<};>> <> ShowIdentifierTGN: PROC [ on: IO.STREAM, nest: INT, itgn: PT.IdentifierTGN ] = BEGIN on.PutF["Identifier \"%g\"", IO.rope[itgn.id.text]]; <> <> END; <> 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; <> 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; <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> 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; <> <> <> <> <> <> <> <> <> <> 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]; }; <> ShowLongTGN: PROC [ on: IO.STREAM, nest: INT, ltgn: PT.LongTGN ] ~ { IO.PutF[on, " long "]; ShowTGN[on, nest+2, ltgn.underlyingType]; }; <> 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]; }; <> ShowMonitorlockTGN: PROC [ on: IO.STREAM, nest: INT, mtgn: PT.MonitorlockTGN ] ~ { IO.PutF[on, "MONITORLOCK"]; }; <> 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]; }; }; <> ShowOpaqueTGN: PROC[on: IO.STREAM, nest: INT, otgn: PT.OpaqueTGN] = BEGIN IO.PutF[on, " Opaque"]; ShowPaint[on, nest, otgn.paint]; <> END; <> 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]; }; <> ShowRealTGN: PROC [ on: IO.STREAM, nest: INT, rtgn: PT.RealTGN ] ~ { IO.PutF[on, "REAL"]; }; <> 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]; }; <> 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]; }; <> ShowReferentTGN: PROC [ on: IO.STREAM, nest: INT, refenttgn: PT.ReferentTGN ] ~ { IO.PutF[on, "REFERENT\n"]; ShowTGNAsNamedSubstructure[on, nest+2, "contents type = ", refenttgn.contents]; }; <> 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]; }; <> 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 "]; }; <> ShowStringTGN: PROC [ on: IO.STREAM, nest: INT, stgn: PT.StringTGN ] ~ { IO.PutF[on, "STRING"]; }; <> 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"]; }; <> 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]; }; <> <> ShowVarTGN: PROC [ on: IO.STREAM, nest: INT, vtgn: PT.VarTGN ] ~ { IO.PutF[on, "var\n"]; ShowTGNAsNamedSubstructure[on, nest+2, "target type = ", vtgn.target]; }; <> 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; }; <> ShowZoneTGN: PROC [ on: IO.STREAM, nest: INT, ztgn: PT.ZoneTGN ] ~ { IO.PutF[on, "% zone ", IO.rope[IF ztgn.uncounted THEN "uncounted" ELSE "counted"]]; }; <> 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 "" 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]; <> <> }; 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"]; }; <> <> <> <> <> <> <> <> <