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], 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]; 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[")["]; Begin[stream]; 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; IF i > 0 THEN {stream.PutRope[", "]; Bp[stream, FALSE, 0]}; IF i = width THEN {stream.PutRope["..."]; EXIT}; elem _ AMTypes.Apply[tv, index]; PutTV[stream, elem, depth - 1, width]; index _ AMTypes.Next[index]; ENDLOOP; End[stream]; stream.PutChar[']]; EXITS urp => {PutErr[stream, "Can't fetch element"]; End[stream]; 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['[]; Begin[put]; FOR i: Index IN [start..size] DO name: ROPE; 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]; }; msg: ROPE _ NIL; IF i > start THEN {put.PutRope[", "]; Bp[put, FALSE, 0]}; IF i > width THEN {put.PutRope["..."]; EXIT}; name _ IndexToName[type, i]; IF name.Size[] > 0 THEN put.PutRope[Rope.Cat[name, ": "]]; msg _ BackStop.Call[innerIndexToTV]; IF msg # NIL THEN {PutErr[put, "Can't get element: ", msg]; LOOP}; msg _ BackStop.Call[innerPut]; IF msg # NIL THEN {PutErr[put, "Can't print element: ", msg]; LOOP}; ENDLOOP; End[put]; 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["("]; -- used to be LIST[ Begin[put]; WHILE node # NIL DO put.PutRope[sep]; sep _ ", "; Bp[put, FALSE, 0]; IF (count _ count + 1) > width THEN {put.PutRope["..."]; EXIT}; PutTV[put, IndexToTV[node, 1], depth, width]; node _ Referent[IndexToTV[node, 2]]; ENDLOOP; End[put]; put.PutChar[')]; }; -- used to be ] when ( was LIST[ 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; }; 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 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, April 14, 1985 1:15:11 pm PST 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 ΚΖ– "cedar" style˜šΟc™Jš$™$Jš*™*Jš œ™&—J™8Icode˜šΟk ˜ Kšœ žœ˜%šœžœ˜Kšœγžœ˜η—Kšœ žœ˜Kšžœžœžœ˜/Kšœžœ.˜;Kšœžœžœ ˜Kšœ žœ˜*Kšœžœ˜(˜K˜——K˜šΠblœžœž˜K˜šž˜Kšœžœ/˜N—K˜KšœžœžœB˜Nhead™!Kšžœžœ˜KšΠbkœžœžœžœ˜Kš Οnœžœžœž œžœ žœ˜9—L™ KšœD˜DK˜šœ˜šžœ˜!Kšžœ"˜&Kšžœ(˜,—Kšœ˜—K˜KšœG˜GK˜˜Kšž˜K˜K˜ K˜ Jšœ˜Jšœžœ˜ Jšœžœžœžœ˜J˜*Jšœ"˜"Jšœ!˜!šžœ)žœ˜1Jšœ=™=Jšœ˜Jšžœ"˜)J˜—šžœ˜šž˜Jšœ)™)Jšœ˜—šžœžœ˜Jšœ2™2Jšœžœ˜"Jšœžœ,˜5Jšœ˜Jšœ˜——Jšœ!™!Jšœ˜Jšœ˜Jšœ˜J˜Jšœ-™-Jšžœ žœ˜(J™/šžœžœžœžœ žœ žœžœ ž˜>Jšžœžœžœ˜%Jšœžœžœ˜Jšœžœžœ˜Jšžœžœ#žœ˜;Jšžœ žœžœ˜1Jšœ!˜!J˜&Jšœ˜Jšžœ˜ —J˜ šž˜J˜O—Kšžœ˜—K˜š ‘ œžœžœžœ žœžœ˜LK˜ Kšœžœžœ˜K˜ šœ žœ˜Kšœ˜K˜—Kšžœ žœžœ˜3K˜ Kšžœžœžœ'žœ˜AK˜šžœ žœžœ˜!Kšœžœ˜ Kšœžœžœ˜Kšœ žœžœ˜šœžœ˜K˜—šœ žœ˜K˜K˜ K˜K˜-šžœ žœžœ˜&Kšœ žœ˜Kšžœžœžœ˜AKšžœžœžœ˜AK˜K˜%K˜0Kšžœ˜ —K˜$K˜—Kšœžœžœ˜Kšžœ žœžœ˜9Kšžœ žœžœ˜.Kšœ˜Kšžœžœ#˜:Kšœ$˜$Kšžœžœžœ+žœ˜CK˜Kšžœžœžœ-žœ˜EKšžœ˜ —K˜K˜—K˜š ‘œžœžœ žœžœ˜BKšœd™dšžœ"žœžœ˜IKšžœžœžœ˜#Kšœι™ιšžœ˜Kšœ!˜!Kšœ ˜ Kšžœžœžœ˜—Kšžœ ˜K˜—Kšžœžœ˜K˜—K˜š ‘œžœžœžœžœ˜