DIRECTORY
AMTypes USING 
[Class, Domain, Error, First, Ground, Index, IndexToDefaultInitialValue, IndexToName, IndexToType, Last, NComponents, NValues, Range, ReferentStatus, IsComputed, IsMachineDependent, IsOverlaid, IsPacked, TypeClass, TypeToName, UnderType, UnderClass, Value, TV],
BackStop USING [Call],
IO USING [STREAM, PutRope, PutChar],
PrintTV USING [Print],
Rope USING [Fetch, ROPE, Equal, Length, IsEmpty, Cat, Concat],
SafeStorage USING [nullType, Type, EquivalentTypes] 
;

PrintTypeImpl: CEDAR MONITOR

IMPORTS AMTypes, BackStop, IO, Rope, SafeStorage, PrintTV 

EXPORTS PrintTV

=  BEGIN OPEN Rope, SafeStorage, AMTypes;

UnderBoolean: Type _ LOOPHOLE[CODE[BOOL]]; 

PrintType: PUBLIC PROC
[type: Type, put: IO.STREAM, depth: INT _ 4, width: INT _ 32, verbose: BOOL _ FALSE] = {
PutReadonly: PROC [t: Type] = {
IF ReferentStatus[t] = readOnly THEN put.PutRope["READONLY "];
};
PutInnards: PROC [type: Type, start: INT _ 1] = {
n: INT _ 0;
class: Class _ TypeClass[type];
indexStart: NAT _ start;
sep: ROPE _ NIL;
SELECT class FROM
union => {
NCases: PROC [type: Type] RETURNS [n: INT] = {
SELECT AMTypes.UnderClass[type] FROM
record, structure => {
last: INT _ AMTypes.NComponents[type];
lastType: Type _ nullType;
IF last = 0 THEN GO TO noCases;
lastType _ AMTypes.IndexToType[type, last];
IF AMTypes.UnderClass[lastType] # union THEN GO TO noCases;
type _ lastType;
};
union => {};
ENDCASE => GO TO noCases;
n _ AMTypes.NValues[AMTypes.Domain[type]];
WHILE n > 0 DO
[] _ AMTypes.IndexToType[type, n ! AMTypes.Error =>
IF reason = badIndex THEN {n _ n - 1; LOOP}
];
RETURN;
ENDLOOP;
EXITS
noCases => ERROR AMTypes.Error[typeFault, NIL, type];
};
tagType: Type _ nullType;
sep _ " => ";
indexStart _ 1;
put.PutRope["SELECT "];
tagType _ AMTypes.Domain[type];
n _ NCases[type];
IF IsOverlaid[type]
THEN put.PutRope["OVERLAID "]
ELSE put.PutRope[Rope.Concat[AMTypes.IndexToName[type, 0], ": "]];
PrintType[tagType, put, depth, width];
put.PutRope[" FROM "];
};
record, structure => {sep _ ": "; n _ AMTypes.NComponents[type]};
ENDCASE => {PrintType[type, put, depth, width]; RETURN};
FOR i: INT IN [indexStart..n] DO
subType: Type _ nullType;
subClass: Class _ nil;
subInner: PROC = {
name: ROPE _ IndexToName[type, i];
subType _ IndexToType[type, i];
subClass _ TypeClass[subType];
IF NOT name.IsEmpty[] THEN put.PutRope[Rope.Concat[name, sep]];
IF class = union THEN
{-- the subType must be a record or structure
put.PutRope["["];
PutInnards[subType, start];
put.PutRope["]"];
RETURN};
SELECT subClass FROM
union => PutInnards[subType, i];       
sequence => PrintType[subType, put, depth, width];
ENDCASE => 
{defaultTV: TV _ NIL;
PrintType[subType, put, depth-1, width];
defaultTV _ IndexToDefaultInitialValue[type, i ! ANY => CONTINUE];
IF defaultTV # NIL THEN
{put.PutRope[" _ "];
PrintTV.Print[defaultTV, put, depth, width, verbose];
};
};
};
msg: ROPE _ NIL;
IF i > indexStart THEN put.PutRope[", "];
IF i > width AND i < n THEN {put.PutRope["..."]; EXIT};
msg _ BackStop.Call[subInner];
IF msg # NIL THEN put.PutRope[Rope.Cat["--{", msg, "}--"]];
ENDLOOP;
IF class = union THEN put.PutRope[" ENDCASE"];
}; 
class: Class _ nil;
innerPut: PROC = {
IF depth <= 0 THEN {put.PutRope["..."]; RETURN};
class _ TypeClass[type];
SELECT class FROM

definition =>
{mod: REF ROPE _ NEW[ROPE _ NIL];
name: ROPE _ TypeToName[type, mod];
length: INT = mod^.Length[];
IF length # 0 THEN -- put out module name unless type name is all caps.
FOR i: INT IN [0..Rope.Length[name]) DO
IF Rope.Fetch[name, i] NOT IN ['A..'Z] THEN {put.PutRope[Rope.Cat[mod^, "."]]; EXIT};
REPEAT
FINISHED => IF Rope.Equal[name, "LORA"] THEN { -- sorry Russ. 
PrintType[UnderType[type], put, depth, width, verbose];
RETURN;
};
ENDLOOP;
put.PutRope[name];
IF NOT name.IsEmpty[] AND verbose THEN
FOR l: LIST OF ROPE _ everybodyKnowsThese, l.rest UNTIL l = NIL DO
IF Rope.Equal[l.first, name] THEN EXIT;
REPEAT
FINISHED =>
{put.PutRope[": TYPE = "];
PrintType[UnderType[type], put, depth, width, verbose];
};
ENDLOOP;
};

cardinal => put.PutRope["CARDINAL"];

longCardinal => put.PutRope["LONG CARDINAL"];

integer => put.PutRope["INTEGER"];

longInteger => put.PutRope["INT"];

real => put.PutRope["REAL"];

character => put.PutRope["CHAR"];

atom => put.PutRope["ATOM"];

rope => put.PutRope["ROPE"];

list => 
{put.PutRope["LIST OF "];
PrintType[IndexToType[Range[type], 1], put, depth, width];
};

ref =>  
{range: Type _ Range[type];
put.PutRope["REF "];
PutReadonly[type];
IF range # nullType -- AND TypeClass[range] # any -- THEN
{PrintType[range, put, depth, width]};
IF verbose THEN
SELECT TypeClass[UnderType[range]] FROM
record, structure =>
{put.PutRope["; \n"];
PrintType[range, put, depth, width];
put.PutRope[": TYPE = "];
PrintType[UnderType[range], put, depth, width]};
ENDCASE;
};

pointer, longPointer, basePointer, relativePointer => 
{range: Type _ Range[type];
SELECT class FROM
longPointer => put.PutRope["LONG "];
relativePointer => put.PutRope["RELATIVE "];
basePointer => put.PutRope["LONG BASE "];
ENDCASE;
SELECT TRUE FROM
range = nullType OR TypeClass[range] = unspecified => put.PutRope["POINTER"];
EquivalentTypes[range, CODE[StringBody]] => put.PutRope["STRING"];
ENDCASE =>
{put.PutRope["POINTER TO "];
SELECT class FROM
longPointer, pointer => PutReadonly[type];
ENDCASE;
PrintType[range, put, depth, width]};
};

descriptor, longDescriptor =>
{range: Type _ nullType;
IF class = longPointer THEN put.PutRope["LONG "];
put.PutRope["DESCRIPTOR"];
range _ Range[type];
IF range # nullType AND TypeClass[range] # unspecified THEN
{put.PutRope[" TO "];
PutReadonly[type];
PrintType[range, put, depth, width]};
};

procedure, signal, error, program, port => 
{argsType, rtnsType: Type _ nullType;
prefix: ROPE _
SELECT class FROM
procedure => "PROC", signal => "SIGNAL", error => "ERROR",
program => "PROGRAM" , port => "PORT", ENDCASE => "??";     
put.PutRope[prefix];
argsType _ Domain[type];
IF argsType # nullType THEN
{put.PutChar[' ];
PrintType[argsType, put, depth-1, width]};
SELECT class FROM
procedure, signal =>
{rtnsType _ Range[type];
IF rtnsType # nullType THEN
{put.PutRope[" RETURNS "];
PrintType[rtnsType, put, depth-1, width];
};
};
ENDCASE;
}; 

enumerated => 
{n: INT _ 0;
md: BOOL _ IsMachineDependent[type];
IF type = UnderBoolean THEN {put.PutRope["BOOL"]; RETURN};
IF IsMachineDependent[type] THEN put.PutRope["MACHINE DEPENDENT "];
put.PutRope["{"];
FOR i: INT IN [1..NValues[type]] DO
IF i > 1 THEN {put.PutChar[', ]; put.PutChar[' ]};
IF i > width THEN
{put.PutRope["..."]; EXIT};
{elem: TV _ Value[type, i];
PrintTV.Print[elem, put];
};
ENDLOOP;
put.PutRope["}"];
};

subrange => 
{ENABLE Error => IF reason = rangeFault THEN {put.PutRope["0..0)"]; CONTINUE};  -- empty subrange causes First to raise a RangeFault.
IF verbose AND depth > 1 THEN PrintType[Ground[type], put, depth-1, width];
put.PutChar['[];
PrintTV.Print[First[type], put, depth, width];
put.PutRope[".."];
PrintTV.Print[Last[type], put, depth, width];
put.PutChar[']];
};

union => 
{put.PutRope["UNION??"];
};

sequence => 
{IF IsComputed[type] THEN put.PutRope["COMPUTED "];
IF IsPacked[type] THEN put.PutRope["PACKED "];
put.PutRope["SEQUENCE "];
PrintType[Domain[type], put, depth-1, width];
put.PutRope[" OF "];
PrintType[Range[type], put, depth-1, width];
};

record, structure => 
{IF class = record THEN put.PutRope["RECORD"];
IF depth < 2 THEN {put.PutRope["[...]"]; RETURN};
put.PutChar['[];
PutInnards[type];
put.PutChar[']];
};

array => 
{IF IsPacked[type] THEN put.PutRope["PACKED "];
put.PutRope["ARRAY "];
PrintType[Domain[type], put, depth-1, width];
put.PutRope[" OF "];
PrintType[Range[type], put, depth-1, width];
};

countedZone => put.PutRope["ZONE"];

uncountedZone => put.PutRope["UNCOUNTED ZONE"];

nil => put.PutRope["nullType"];

unspecified => put.PutRope["UNSPECIFIED"];

process => put.PutRope["PROCESS"];

type => put.PutRope["TYPE"];

opaque => put.PutRope["OPAQUE"];

any => put.PutRope["ANY"];

globalFrame => put.PutRope["GF??"];

localFrame => put.PutRope["LF??"];

ENDCASE => put.PutRope["??"];

};
msg: ROPE _ BackStop.Call[innerPut];
IF msg # NIL THEN
put.PutRope[Rope.Cat["--{", msg, "}--"]];
};

everybodyKnowsThese: LIST OF ROPE _ LIST["INT", "REAL", "ROPE", "ATOM", "BOOL", "CHAR"];

END.  
September 1, 1982 10:57 am fixed bug in PrintType so that LONG STRING would print correctly.

September 14, 1982 2:15 pm added 3.4 operations for IsPacked, IsMachineDependent, etc.
December 30, 1982 11:39 am added everybodyKnowsThese check so that things like 3.2? didnt print out is of type REAL: TYPE = REAL
NPrintTypeImpl.mesa
Russ Atkinson, September 23, 1982 1:23 pm
Warren Teitelman, January 6, 1983 7:22 pm
Paul Rovner, July 13, 1983 5:39 pm
this procedure returns the number of cases for a variant record. we need this proc because the number of cases is sometimes less than the number of values for the domain type. ERROR AMTypes.Error[typeFault] is raised when the type is not right
output the SELECT stuff
which describes the bound variant type (so be careful where you start)
be prepared: rttypes bug when NValues[...] > LAST[CARDINAL]
now fetch and print the element (if possible)
Κ	U–
"Mesa" style˜J˜Jš
Οc™Jš
)™)Jš
)™)Jš
"™"J˜š
Οk	˜	šœžœ
˜Jšœžœ˜…—Jšœ	žœ˜Jšžœ
žœžœžœ	˜$Jšœžœ	˜Jšœžœ	žœ'˜>Jšœžœ#˜4J˜
J˜—Jšœžœ
ž˜J˜Jšžœžœ˜:J˜Jšžœ˜J˜šœžœ
žœ˜)J˜—JšΟnœ	žœ
žœ
žœ˜+J˜šŸ	œžœ
ž˜Jš
œžœ
žœ	žœ
žœžœžœ˜XšŸœžœ˜Jšžœžœ˜>J˜—šŸ
œžœžœ	˜1Jšœžœ˜J˜Jšœžœ	˜Jšœžœžœ
˜šžœž˜˜
šŸœžœžœžœ˜.Jš
œσ
™σ
šžœž˜$˜Jšœžœ˜&J˜Jšžœ
žœ
žœ
žœ	˜J˜+Jšžœ&žœ
žœ
žœ	˜;J˜J˜—J˜Jšžœžœ
žœ	˜—J˜*šžœž˜˜3Jšžœžœ
žœ
˜+Jš
œ˜—Jšžœ
˜Jšžœ
˜—š
ž˜Jšœžœžœ˜5—J˜—J˜J˜
J˜Jš
™J˜J˜J˜šžœ˜Jšžœ˜Jšžœ>˜B—J˜&J˜J˜—J˜AJšžœ)žœ˜8—šžœžœ
žœž˜ J˜J˜šœ
žœ˜Jšœžœ˜"J˜J˜Jšžœ
žœžœ%˜?šžœž˜šœ
,˜-Jš
F™FJ˜J˜J˜Jšžœ˜——šžœ
ž˜J˜'J˜2šžœ˜šœžœžœ
˜J˜(Jš
;™;Jšœ1žœžœ˜Bšžœ
žœ
ž˜˜J˜5J˜——J˜———J˜—Jšœžœžœ
˜Jšžœžœ˜)Jšžœžœžœžœ˜7J˜Jšžœžœ
žœ*˜;Jšžœ
˜Jšžœžœ˜.—J˜—J˜šŸœžœ˜Jšžœžœžœ˜0J˜šžœž˜J˜˜
šœžœ
žœžœ
žœžœ˜!Jšœžœ˜#Jšœžœ˜šžœžœ
4˜GJšžœžœ
žœž˜'Jš
žœžœ
žœ
žœ$žœ˜UJš
ž˜šžœžœžœ˜>J˜7Jš
ž˜J˜—Jšžœ
˜—J˜šžœ
žœžœ	ž˜&š
žœžœ
žœ
žœžœžœ
ž˜BJšžœžœ
žœ
˜'Jš
ž˜šžœ˜J˜J˜7J˜—Jšžœ
˜——J˜J˜——J˜$J˜J˜-J˜J˜"J˜J˜"J˜J˜J˜J˜!J˜J˜J˜J˜J˜˜˜J˜:J˜J˜——˜˜J˜J˜šžœ œ
ž˜9J˜&—šžœ	ž˜šžœž˜'˜˜J˜$J˜J˜0——Jšžœ
˜——J˜J˜——˜6˜šžœž˜J˜$J˜,J˜)Jšžœ
˜—šžœ
žœ
ž˜Jšœžœ:˜MJšœžœ'˜Bšžœ˜
˜šžœž˜J˜*Jšžœ
˜—J˜%———J˜J˜——˜˜Jšžœžœ˜1J˜J˜šžœžœ ž˜;˜J˜J˜%——J˜J˜——˜+˜%šœžœ˜šžœž˜J˜:Jšœ'žœ˜<——J˜J˜šžœž˜˜J˜*——šžœž˜˜˜šžœž˜J˜J˜)J˜—J˜——Jšžœ
˜—J˜J˜——˜šœžœ˜Jšœžœ˜$Jšžœžœžœ˜:Jšžœžœ#˜CJ˜šžœžœ
žœž˜#Jšžœžœ%˜2šžœž˜Jšœžœ˜—Jš
-™-šœžœ˜J˜J˜—Jšžœ
˜—J˜J˜J˜——˜š
œ
žœ
žœžœžœ5˜…
Jšžœ	žœžœ.˜KJ˜J˜.J˜J˜-J˜J˜J˜——˜	˜J˜J˜——˜šœ
žœžœ˜3Jšžœžœ˜.J˜J˜-J˜J˜,J˜J˜——˜šœ
žœžœ˜.Jšžœžœžœ˜1J˜J˜J˜J˜J˜——˜	šœ
žœžœ˜/J˜J˜-J˜J˜,J˜J˜——J˜#J˜J˜/J˜J˜J˜J˜*J˜J˜"J˜J˜J˜J˜ J˜J˜J˜J˜#J˜J˜"J˜Jšžœ˜J˜J˜——Jšœžœ˜$šžœžœ
ž˜J˜)—J˜J˜Jš
Ÿœžœ
žœ
žœžœ0˜X—J˜Jšžœ˜Jšœ:žœ
žœ˜\J˜J˜VJš
œ€
˜€
—…—!j-