PrintTypeImpl.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
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] = {
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
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;
output the SELECT stuff
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
which describes the bound variant type (so be careful where you start)
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];
be prepared: rttypes bug when NValues[...] > LAST[CARDINAL]
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};
now fetch and print the element (if possible)
{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