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; CR: CHAR = '\n; STREAM: TYPE = IO.STREAM; Pair: TYPE = MACHINE DEPENDENT RECORD [lo, hi: CARDINAL]; indent: INTEGER _ 3; 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 { index _ AMTypes.Copy[index]; TRUSTED {AMBridge.SetTVFromLI[index, 0]}; }; IF class = sequence THEN max _ AMTypes.Length[tv] ELSE TRUSTED { low: INT _ AMBridge.TVToLI[index]; high: INT _ AMBridge.TVToLI[AMTypes.Last[indexType]]; max _ high-low+1; }; stream.PutRope["("]; stream.Put[IO.int[max]]; stream.PutRope[")["]; IF depth <= 1 THEN stream.PutRope["..."] 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] = { IF TypeClass[underType] = structure AND NComponents[underType] = 2 THEN { ENABLE AMTypes.Error => GO TO nope; IF EquivalentTypes[ Range[IndexToType[underType, 2]], underType] THEN RETURN [TRUE]; EXITS nope => {}; }; RETURN [FALSE]; }; PutList: PROC [put: STREAM, node: TV, depth, width: INT] = { 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] }; 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.  PrettyPrinters.mesa Copyright c 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 miscellaneous types and constants procedures Absolutely miserable kludge to get around indexing by INTEGER For sequences, the length is easy to find For arrays, we have to do this the hard way (sigh) First show the number of elements Next test to see if we have anything to print Now try to output the remainder of the elements copied from ListImpl (in order to avoid dependency on List so Russ can use PrintTVImpl stand alone. 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. 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. miscellaneous utility routines 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  Κ – "cedar" style˜šΟc™Icodešœ Οmœ1™JšŸœŸœŸœ˜%JšœŸœŸœ˜JšœŸœŸœ˜š’œŸœ˜J˜&J˜—JšŸœŸœ˜#JšŸœ ŸœŸœ˜0Jšœ!˜!J˜Jšœ˜JšŸœ˜ —J˜šŸ˜J˜B—KšŸœ˜—K˜š ’ œŸœŸœŸœ ŸœŸœ˜LK˜ KšœŸœŸœ˜K˜ šœ Ÿœ˜Kšœ˜K˜—KšŸœ ŸœŸœ˜3K˜ KšŸœŸœŸœ'Ÿœ˜AK˜šŸœ ŸœŸœ˜!KšœŸœŸœ˜Kšœ ŸœŸœ˜šœŸœ˜K˜—šœ Ÿœ˜K˜K˜ K˜K˜-šŸœ ŸœŸœ˜&Kšœ Ÿœ˜KšŸœŸœŸœ˜AKšŸœŸœŸœ˜AK˜K˜%K˜0KšŸœ˜ —K˜$K˜—š’ œŸœ˜KšœŸœŸœ˜Kšœ$˜$KšŸœŸœŸœ+Ÿœ˜DK˜KšŸœŸœŸœ-Ÿœ˜FK˜—š’ œŸœ˜KšœŸœŸœ˜KšœŸœ˜"KšœŸœ˜ šŸœŸœ˜Kšœ˜K˜K˜—KšŸœ˜K˜—KšŸœ Ÿœ˜$KšŸœ ŸœŸœ˜-K˜KšŸœ˜ —K˜K˜—K˜š ’œŸœŸœ ŸœŸœ˜BKšœd™dšŸœ"ŸœŸœ˜IKšŸœŸœŸœ˜#Kšœι™ιšŸœ˜Kšœ!˜!Kšœ ˜ KšŸœŸœŸœ˜—KšŸœ ˜K˜—KšŸœŸœ˜K˜—K˜š ’œŸœŸœŸœŸœ˜