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
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: INTLAST[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: TVNIL;
msg: ROPENIL;
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: ROPENIL;
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: TVNIL;
quitFlag: BOOLFALSE;
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: ROPENIL;
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: ROPENIL;
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: BOOLFALSE] = {
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: ROPENIL;
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: BOOLFALSE] = TRUSTED {
deep: BOOLTRUE;
msg1, msg2: ROPENIL;
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: ROPENIL] = {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: BOOLFALSE] = {
Bp[to, united, 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.
Spreitzer, May 12, 1985 11:58:11 am PDT
Changed formatting of LIST from (e, e, ...e) to LIST[e, e, ...e]
changes to: PutList