PrettyPrinters.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Russ Atkinson, June 22, 1983 6:53 pm
Warren Teitelman, February 5, 1983 3:50 pm
Paul Rovner, November 3, 1983 12:56 pm
Last Edited by: Spreitzer, September 20, 1985 10:23:17 am PDT
Mike Spreitzer July 30, 1986 7:53:27 pm PDT
DIRECTORY
AMBridge USING [SetTVFromLI, TVToLI],
AMTypes
USING
[Apply, Class, Copy, Domain, Error, First, Index, IndexToName, IndexToTV, IndexToType, IsComputed, IsOverlaid, Last, Length, NComponents, Next, Range, Referent, Tag, TVToName, TVType, TypeClass, UnderClass, UnderType, Variant, TV],
BackStop USING [Call],
IO USING [STREAM, Put, PutRope, PutChar, int],
PrintTV USING [TVPrintProc, Print, RegisterClassPrintProc],
Rope USING [ROPE, Size, Cat, Length],
SafeStorage USING [Type, EquivalentTypes],
StructuredStreams USING [Begin, End, Bp]
PrettyPrinters:
CEDAR
PROGRAM
IMPORTS
AMBridge, AMTypes, BackStop, IO, PrintTV, Rope, SafeStorage, StructuredStreams
= BEGIN OPEN PrintTV, Rope, AMBridge, AMTypes, SafeStorage, StructuredStreams;
miscellaneous types and constants
CR: CHAR = '\n;
STREAM: TYPE = IO.STREAM;
Pair: TYPE = MACHINE DEPENDENT RECORD [lo, hi: CARDINAL];
indent: INTEGER ← 3;
procedures
PrintRecord: TVPrintProc = {PutRecord[stream, tv, 1, depth, width]};
PrintStructure: TVPrintProc = {
IF IsAList[UnderType[TVType[tv]]]
THEN PutList[stream, tv, depth, width]
ELSE PutRecord[stream, tv, 1, depth, width];
};
PrintList: TVPrintProc = {PutList[stream, Referent[tv], depth, width]};
PrintArraySeq: TVPrintProc =
BEGIN
type: Type ← TVType[tv];
under: Type;
class: Class;
indexType: Type;
index: TV;
max: INT ← LAST[INT];
[under, class] ← UnderTypeAndClass[type];
indexType ← AMTypes.Domain[under];
index ← AMTypes.First[indexType];
IF AMTypes.UnderClass[indexType] = integer
THEN {
Absolutely miserable kludge to get around indexing by INTEGER
index ← AMTypes.Copy[index];
TRUSTED {AMBridge.SetTVFromLI[index, 0]};
};
IF class = sequence
THEN
For sequences, the length is easy to find
max ← AMTypes.Length[tv]
ELSE
TRUSTED {
For arrays, we have to do this the hard way (sigh)
low: INT ← AMBridge.TVToLI[index];
high: INT ← AMBridge.TVToLI[AMTypes.Last[indexType]];
max ← high-low+1;
};
First show the number of elements
stream.PutRope["("];
stream.Put[IO.int[max]];
stream.PutRope[")["];
Next test to see if we have anything to print
IF depth <= 1 THEN stream.PutRope["..."]
Now try to output the remainder of the elements
ELSE
FOR i:
INT
IN [0..width]
WHILE index #
NIL
AND i < max
DO
ENABLE {AMTypes.Error => GO TO urp};
elem: TV ← NIL;
msg: ROPE ← NIL;
WriteElt:
PROC = {
PutTV[stream, elem, depth - 1, width];
};
IF i > 0 THEN stream.PutRope[", "];
IF i = width THEN {stream.PutRope["..."]; EXIT};
elem ← AMTypes.Apply[tv, index];
MakePiece[stream, WriteElt];
index ← AMTypes.Next[index];
ENDLOOP;
stream.PutChar[']];
EXITS
urp => {PutErr[stream, "Can't fetch element"]; stream.PutChar[']]}
END;
PutRecord:
PROC [put:
STREAM, tv:
TV, start:
NAT ← 0, depth, width:
INT] = {
size: Index;
sep: ROPE ← NIL;
type: Type;
innerSize:
PROC = {
type ← TVType[tv];
size ← NComponents[type]};
IF depth <= 1 THEN {put.PutRope["[...]"]; RETURN};
sep ← BackStop.Call[innerSize];
IF sep # NIL THEN {PutErr[put, "can't examine, ", sep]; RETURN};
put.PutChar['[];
FOR i: Index
IN [start..size]
DO
inner: TV ← NIL;
quitFlag: BOOL ← FALSE;
innerIndexToTV:
PROC = {
inner ← IndexToTV[tv, i]};
innerPut:
PROC = {
itype: Type ← TVType[inner];
iunder: Type;
iclass: Class;
[iunder, iclass] ← UnderTypeAndClass[itype];
IF i = size
AND iclass = union
THEN {
variantTV: TV;
IF IsOverlaid[iunder] THEN {put.PutRope["--Overlaid--"]; RETURN};
IF IsComputed[iunder] THEN {put.PutRope["--Computed--"]; RETURN};
variantTV ← Variant[inner];
QPutName[put, TVToName[Tag[inner]]];
PutRecord[put, variantTV, i, depth - 1, width];
RETURN};
PutTV[put, inner, depth - 1, width];
};
WriteValue:
PROC = {
msg: ROPE ← NIL;
msg ← BackStop.Call[innerIndexToTV];
IF msg # NIL THEN {PutErr[put, "Can't get element: ", msg]; RETURN};
msg ← BackStop.Call[innerPut];
IF msg # NIL THEN {PutErr[put, "Can't print element: ", msg]; RETURN};
};
WriteField:
PROC = {
msg: ROPE ← NIL;
name: ROPE = IndexToName[type, i];
named: BOOL = name.Length[] > 0;
IF named
THEN {
put.PutRope[name.Cat[": "]];
MakePiece[put, WriteValue];
}
ELSE WriteValue[];
};
IF i > start THEN put.PutRope[", "];
IF i > width THEN {put.PutRope["..."]; EXIT};
MakePiece[put, WriteField];
ENDLOOP;
put.PutChar[']];
};
IsAList:
PROC [underType: Type]
RETURNS [result:
BOOL ←
FALSE] = {
copied from ListImpl (in order to avoid dependency on List so Russ can use PrintTVImpl stand alone.
IF TypeClass[underType] = structure
AND NComponents[underType] = 2
THEN {
ENABLE AMTypes.Error => GO TO nope;
checks whether the rest field points to an object whose type is the same as the referrent of ref. Note that it is nnecessary to check to see whether TypeClass[IndexToType[underType, 2]] = list since this is a stronger test, i.e. that it is equivalent to the type of the first list node. The catch phrase is to handle REF ANY, for which Range causes a typefault.
IF EquivalentTypes[
Range[IndexToType[underType, 2]],
underType]
THEN RETURN [TRUE];
EXITS nope => {};
};
RETURN [FALSE];
};
PutList:
PROC [put:
STREAM, node:
TV, depth, width:
INT] = {
separate procedure because can be called from both ref, list, and structure case case. start with node, rather than element, because in case of structure, already at the node.
sep: ROPE ← NIL;
count: INT ← 0;
put.PutRope["LIST["]; -- used to be LIST[
WHILE node #
NIL
DO
WriteElt:
PROC = {
PutTV[put, IndexToTV[node, 1], depth, width];
};
put.PutRope[sep];
sep ← ", ";
IF (count ← count + 1) > width THEN {put.PutRope["..."]; EXIT};
MakePiece[put, WriteElt];
node ← Referent[IndexToTV[node, 2]];
ENDLOOP;
put.PutChar[']];
};
PutTV:
PROC [put:
STREAM, tv:
TV, depth, width:
INT, verbose:
BOOL ←
FALSE] =
TRUSTED {
deep: BOOL ← TRUE;
msg1, msg2: ROPE ← NIL;
IF tv = NIL THEN {put.PutRope["NIL"]; RETURN};
IF depth <= 0 THEN {put.PutRope["&"]; RETURN};
Print[tv, put, depth, width, verbose];
};
PutErr: PROC [put: STREAM, r1,r2: ROPE ← NIL] = {put.PutRope[Rope.Cat["--{", r1, r2, "}--"]]};
QPutName:
PROC [put:
STREAM, name:
ROPE] = {
IF name.Size[] = 0 THEN put.PutRope["??"] ELSE put.PutRope[name]
};
miscellaneous utility routines
UnderTypeAndClass:
PROC [type: Type]
RETURNS [under: Type, class: Class] = {
under ← type;
WHILE (class ← TypeClass[under]) = definition
DO
under ← UnderType[under];
ENDLOOP;
};
MakePiece:
PROC [to:
IO.
STREAM, write:
PROC, united:
BOOL ←
FALSE] = {
Bp[to, IF united THEN united ELSE lookLeft, indent];
Begin[to];
write[ !UNWIND => End[to] ];
End[to];
};
Setup:
PROC =
BEGIN
RegisterClassPrintProc[class: record, proc: PrintRecord];
RegisterClassPrintProc[class: structure, proc: PrintStructure];
RegisterClassPrintProc[class: array, proc: PrintArraySeq];
RegisterClassPrintProc[class: sequence, proc: PrintArraySeq];
RegisterClassPrintProc[class: list, proc: PrintList];
END;
Setdown:
PROC =
BEGIN
RegisterClassPrintProc[class: record, proc: NIL];
RegisterClassPrintProc[class: structure, proc: NIL];
RegisterClassPrintProc[class: array, proc: NIL];
RegisterClassPrintProc[class: sequence, proc: NIL];
RegisterClassPrintProc[class: list, proc: NIL];
END;
Setup[];
END.