DIRECTORY
IO USING [int, PutF, rope, STREAM, Value],
RefTab USING [Ref, Create, Fetch, GetSize, Store],
Rope USING [Concat, ROPE],
SaffronBaseDef USING [],
SaffronContext USING [ShowValue],
SaffronProgramGraphPrivateTypes;
SaffronShowProgramGraphImpl:
CEDAR
PROGRAM
IMPORTS IO, RefTab, Rope, SaffronContext
EXPORTS SaffronBaseDef, SaffronContext
= BEGIN
OPEN
PG: SaffronProgramGraphPrivateTypes;
ProgramGraphNode: TYPE = REF ProgramGraphNodeBody;
ProgramGraphNodeBody: PUBLIC TYPE = PG.ProgramGraphNodeBody;
ProcedureGraphNode: TYPE = REF ProcedureGraphNodeBody;
ProcedureGraphNodeBody: PUBLIC TYPE = PG.ProcedureGraphNodeBody;
ProgramFragmentNode: TYPE = REF ProgramFragmentNodeBody;
ProgramFragmentNodeBody: PUBLIC TYPE = PG.ProgramFragmentNodeBody;
ShowProgramGraph:
PUBLIC
PROC [on:
IO.
STREAM, nest:
INT, pg: ProgramGraphNode] =
BEGIN
on.PutF["Program Graph {\n"];
on.PutF["%gMain ", Indentation[nest+2]];
ShowProcedureGraph[on, nest+2, pg.main];
FOR cell:
PG.ProcedureGraphCell ← pg.firstSubroutine, cell.next
WHILE (cell #
NIL)
DO
on.PutF["%g", Indentation[nest+2]];
ShowProcedureGraph[on, nest+2, cell.procedureGraph];
ENDLOOP;
on.PutF["%g}", Indentation[nest]];
END;
ShowProcedureGraph:
PROC [on:
IO.
STREAM, nest:
INT, pg: ProcedureGraphNode] =
BEGIN
table: RefTab.Ref ← RefTab.Create[];
on.PutF["Procedure Graph (%g) {\n", IO.int[LOOPHOLE[pg.code]]];
ShowOperationNodes[on, nest+2, pg.firstOperation, table];
on.PutF["%g}\n", Indentation[nest]];
END;
TableEntry: TYPE = REF TableEntryBody;
TableEntryBody:
TYPE =
RECORD [index:
INT, shown:
BOOLEAN];
ShowOperationNodes:
PROC [on:
IO.
STREAM, nest:
INT, operation:
PG.OperationNode, table: RefTab.Ref] =
BEGIN
found: BOOLEAN;
entry: TableEntry;
IF operation = NIL THEN RETURN;
found ← table.Fetch[operation].found;
entry ← NARROW[table.Fetch[operation].val];
SELECT
TRUE
FROM
found AND entry.shown => RETURN;
found AND (NOT entry.shown) => NULL;
ENDCASE => {
entry ← NEW[TableEntryBody ← [table.GetSize[], FALSE]];
[] ← table.Store[operation, entry];
};
entry.shown ← TRUE;
on.PutF["%g%g: ", Indentation[nest], IO.int[entry.index]];
WITH operation.effects
SELECT
FROM
e: PG.OpPushConstant => ShowPushConstant[on, nest, e, table];
e: PG.OpUnaryFunction => ShowUnaryFunction[on, nest, e, table];
e: PG.OpBinaryFunction => ShowBinaryFunction[on, nest, e, table];
e: PG.OpLoadLocal => ShowLoadLocal[on, nest, e, table];
e: PG.OpLoadIndirect => ShowLoadIndirect[on, nest, e, table];
e: PG.OpStoreLocal => ShowStoreLocal[on, nest, e, table];
e: PG.OpStoreIndirect => ShowStoreIndirect[on, nest, e, table];
e: PG.OpTest => ShowTest[on, nest, e, table];
e: PG.OpReturn => ShowReturn[on, nest, e, table];
ENDCASE => ERROR;
FOR cell:
PG.OutgoingActionsCell ← operation.outgoingActionEdges, cell.next
WHILE (cell #
NIL)
DO
found: BOOLEAN;
entry: TableEntry;
found ← table.Fetch[cell.to].found;
entry ← NARROW[table.Fetch[cell.to].val];
IF
NOT found
THEN {
entry ← NEW[TableEntryBody ← [table.GetSize[], FALSE]];
[] ← table.Store[cell.to, entry];
};
on.PutF[", %g: %g",
IO.rope[SELECT cell.label FROM next => "next", ifTrue => "ifTrue", ifFalse => "ifFalse", ENDCASE => ERROR],
IO.int[entry.index]
];
ENDLOOP;
on.PutF["\n"];
FOR cell:
PG.OutgoingActionsCell ← operation.outgoingActionEdges, cell.next
WHILE (cell #
NIL)
DO
ShowOperationNodes[on, nest, cell.to, table];
ENDLOOP;
END;
ShowPushConstant:
PROC [on:
IO.
STREAM, nest:
INT, e:
PG.OpPushConstant, table: RefTab.Ref] =
BEGIN
on.PutF["PushConstant("];
SaffronContext.ShowValue[on, nest, e.constant];
on.PutF[")"];
END;
ShowUnaryFunction:
PROC [on:
IO.
STREAM, nest:
INT, e:
PG.OpUnaryFunction, table: RefTab.Ref] =
BEGIN
on.PutF["UnaryFunction "];
on.PutF[
SELECT e.function
FROM
negate => "NEGATE",
not => "NOT",
ENDCASE => ERROR
];
END;
ShowBinaryFunction:
PROC [on:
IO.
STREAM, nest:
INT, e:
PG.OpBinaryFunction, table: RefTab.Ref] =
BEGIN
on.PutF["BinaryFunction "];
on.PutF[
SELECT e.function
FROM
add => "ADD",
subtract => "SUBTRACT",
multiply => "MULTIPLY",
divide => "DIVIDE",
mod => "MOD",
and => "AND",
or => "OR",
equal => "EQUAL",
notEqual => "NOTEQUAL"
ENDCASE => ERROR
];
END;
ShowLoadLocal:
PROC [on:
IO.
STREAM, nest:
INT, e:
PG.OpLoadLocal, table: RefTab.Ref] =
BEGIN
on.PutF["LoadLocal "];
ShowPFD[on, nest, e.pfd];
END;
ShowLoadIndirect:
PROC [on:
IO.
STREAM, nest:
INT, e:
PG.OpLoadIndirect, table: RefTab.Ref] =
BEGIN
on.PutF["LoadIndirect "];
ShowPFD[on, nest, e.pfd];
END;
ShowStoreLocal:
PROC [on:
IO.
STREAM, nest:
INT, e:
PG.OpStoreLocal, table: RefTab.Ref] =
BEGIN
on.PutF["StoreLocal "];
ShowPFD[on, nest, e.pfd];
END;
ShowStoreIndirect:
PROC [on:
IO.
STREAM, nest:
INT, e:
PG.OpStoreIndirect, table: RefTab.Ref] =
BEGIN
on.PutF["StoreIndirect "];
ShowPFD[on, nest, e.pfd];
END;
ShowTest:
PROC [on:
IO.
STREAM, nest:
INT, e:
PG.OpTest, table: RefTab.Ref] =
BEGIN
on.PutF["Test"];
END;
ShowReturn:
PROC [on:
IO.
STREAM, nest:
INT, e:
PG.OpReturn, table: RefTab.Ref] =
BEGIN
on.PutF["Return"];
END;
ShowPFD:
PROC [on:
IO.
STREAM, nest:
INT, pfd: PG.ParameterizedFieldDescriptorNode] =
BEGIN
FOR cell: PG.ParameterizedFieldDescriptorCell ← pfd.firstCell, cell.next
WHILE (cell #
NIL)
DO
WITH cell
SELECT
FROM
c:
REF index
PG.ParameterizedFieldDescriptorCellBody => {
on.PutF["[&]"];
};
c:
REF nested
PG.ParameterizedFieldDescriptorCellBody => {
on.PutF["nested"];
};
c:
REF staticLink
PG.ParameterizedFieldDescriptorCellBody => {
on.PutF["staticLink"];
};
c:
REF vars
PG.ParameterizedFieldDescriptorCellBody => {
on.PutF["vars.%g", IO.rope[c.name]];
};
c:
REF fieldName
PG.ParameterizedFieldDescriptorCellBody =>
on.PutF["%g", IO.rope[c.name]];
ENDCASE => ERROR;
IF cell.next # NIL THEN on.PutF["."];
ENDLOOP;
END;
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]];
};
END.