PrintTypeImpl.mesa
Russ Atkinson, September 23, 1982 1:23 pm
Warren Teitelman, January 6, 1983 7:22 pm
DIRECTORY
AMTypes
USING
[Class, Domain, Error, First,
Ground, Index, IndexToDefaultInitialValue, IndexToName, IndexToType,
Last, NComponents, NValues, Range, ReferentStatus,
IsComputed, IsMachineDependent, IsOverlaid, IsOrdered, IsPacked,
TypeClass, TypeToName, UnderType, UnderClass, Value],
PrintTV USING [Mother, Print, PutClosure, PutProc],
Rope USING [Fetch, Map, ROPE, Equal, Length, IsEmpty],
RTBasic USING [nullType, TV, Type],
RTTypesBasic USING [EquivalentTypes]
;
PrintTypeImpl: CEDAR MONITOR
IMPORTS AMTypes, Rope, RTTypesBasic, PrintTV
EXPORTS PrintTV
=
BEGIN
OPEN PrintTV, Rope, RTBasic, AMTypes;
UnderBoolean: Type ← LOOPHOLE[CODE[BOOL]];
PrintType:
PUBLIC
PROC
[type: Type, put: PutClosure, depth: INT ← 4, width: INT ← 32, verbose: BOOL ← FALSE] = {
putproc: PutProc = put.proc;
putdata: REF = put.data;
PutChar:
PROC [c:
CHAR] = {
putproc[putdata, c]
};
PutCharB:
PROC [c:
CHAR]
RETURNS [
BOOL] = {
PutChar[c]; RETURN [FALSE]
};
PutRope:
PROC [r:
ROPE] = {
[] ← Rope.Map[base: r, action: PutCharB]
};
PutMD:
PROC [t: Type] = {
IF IsMachineDependent[t] THEN PutRope["MACHINE DEPENDENT "];
};
PutPacked:
PROC [t: Type] = {
IF IsPacked[t] THEN PutRope["PACKED "];
};
PutReadonly:
PROC [t: Type] = {
IF ReferentStatus[t] = readOnly THEN PutRope["READONLY "];
};
PutComputed:
PROC [t: Type] = {
IF IsComputed[t] THEN PutRope["COMPUTED "];
};
PutOverlaid:
PROC [t: Type] = {
IF IsOverlaid[t] THEN PutRope["OVERLAID "];
};
PutOrdered:
PROC [t: Type] = {
IF IsOrdered[t] THEN PutRope["ORDERED "];
};
PutRopes:
PROC [r1,r2,r3,r4,r5,r6:
ROPE ←
NIL] = {
[] ← Rope.Map[base: r1, action: PutCharB];
[] ← Rope.Map[base: r2, action: PutCharB];
[] ← Rope.Map[base: r3, action: PutCharB];
[] ← Rope.Map[base: r4, action: PutCharB];
[] ← Rope.Map[base: r5, action: PutCharB];
[] ← Rope.Map[base: r6, action: PutCharB];
};
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
PutRope["SELECT "];
tagType ← AMTypes.Domain[type];
n ← NCases[type];
IF IsOverlaid[type]
THEN PutOverlaid[type]
ELSE PutRopes[AMTypes.IndexToName[type, 0], ": "];
PrintType[tagType, put, depth, width];
PutRopes[" 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 PutRopes[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)
PutRope["["];
PutInnards[subType, start];
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
{PutRope[" ← "];
PrintTV.Print[defaultTV, put, depth, width, verbose];
};
};
};
msg: ROPE ← NIL;
IF i > indexStart THEN PutRope[", "];
IF i > width AND i < n THEN {PutRope["..."]; EXIT};
msg ← Mother[subInner];
IF msg # NIL THEN PutRopes["--{", msg, "}--"];
ENDLOOP;
IF class = union THEN PutRope[" ENDCASE"];
};
class: Class ← nil;
innerPut:
PROC = {
IF depth <= 0 THEN {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 {PutRopes[mod^, "."]; EXIT};
REPEAT
FINISHED =>
IF Rope.Equal[name, "LORA"]
THEN {
-- sorry Russ.
PrintType[UnderType[type], put, depth, width, verbose];
RETURN;
};
ENDLOOP;
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 =>
{PutRope[": TYPE = "];
PrintType[UnderType[type], put, depth, width, verbose];
};
ENDLOOP;
};
cardinal => PutRope["CARDINAL"];
longCardinal => PutRope["LONG CARDINAL"];
integer => PutRope["INTEGER"];
longInteger => PutRope["INT"];
real => PutRope["REAL"];
character => PutRope["CHAR"];
atom => PutRope["ATOM"];
rope => PutRope["ROPE"];
list =>
{PutRope["LIST OF "];
PrintType[IndexToType[Range[type], 1], put, depth, width];
};
ref =>
{range: Type ← Range[type];
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 =>
{PutRope["; \n"];
PrintType[range, put, depth, width];
PutRope[": TYPE = "];
PrintType[UnderType[range], put, depth, width]};
ENDCASE;
};
pointer, longPointer, basePointer, relativePointer =>
{range: Type ← Range[type];
SELECT class
FROM
longPointer => PutRope["LONG "];
relativePointer => PutRope["RELATIVE "];
basePointer => PutRope["LONG BASE "];
ENDCASE;
SELECT
TRUE
FROM
range = nullType OR TypeClass[range] = unspecified => PutRope["POINTER"];
RTTypesBasic.EquivalentTypes[range, CODE[StringBody]] => PutRope["STRING"];
ENDCASE =>
{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 PutRope["LONG "];
PutRope["DESCRIPTOR"];
range ← Range[type];
IF range # nullType
AND TypeClass[range] # unspecified
THEN
{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 => "??";
PutRope[prefix];
argsType ← Domain[type];
IF argsType # nullType
THEN
{PutChar[' ];
PrintType[argsType, put, depth-1, width]};
SELECT class
FROM
procedure, signal =>
{rtnsType ← Range[type];
IF rtnsType # nullType
THEN
{PutRope[" RETURNS "];
PrintType[rtnsType, put, depth-1, width];
};
};
ENDCASE;
};
enumerated =>
{n:
INT ← 0;
md: BOOL ← IsMachineDependent[type];
IF type = UnderBoolean THEN {PutRope["BOOL"]; RETURN};
PutMD[type];
PutRope["{"];
FOR i:
INT
IN [1..NValues[type]]
DO
IF i > 1 THEN {PutChar[', ]; PutChar[' ]};
IF i > width
THEN
{PutRope["..."]; EXIT};
now fetch and print the element (if possible)
{elem:
TV ← Value[type, i];
PrintTV.Print[elem, put];
};
ENDLOOP;
PutRope["}"];
};
subrange =>
{
ENABLE Error =>
IF reason = rangeFault
THEN {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];
PutChar['[];
PrintTV.Print[First[type], put, depth, width];
PutRope[".."];
PrintTV.Print[Last[type], put, depth, width];
PutChar[']];
};
sequence =>
{PutComputed[type];
PutPacked[type];
PutRope["SEQUENCE "];
PrintType[Domain[type], put, depth-1, width];
PutRope[" OF "];
PrintType[Range[type], put, depth-1, width];
};
record, structure =>
{
IF class = record
THEN PutRope["RECORD"];
IF depth < 2 THEN {PutRope["[...]"]; RETURN};
PutChar['[];
PutInnards[type];
PutChar[']];
};
array =>
{PutPacked[type];
PutRope["ARRAY "];
PrintType[Domain[type], put, depth-1, width];
PutRope[" OF "];
PrintType[Range[type], put, depth-1, width];
};
countedZone => PutRope["ZONE"];
uncountedZone => PutRope["UNCOUNTED ZONE"];
nil => PutRope["nullType"];
unspecified => PutRope["UNSPECIFIED"];
process => PutRope["PROCESS"];
type => PutRope["TYPE"];
opaque => PutRope["OPAQUE"];
any => PutRope["ANY"];
globalFrame => PutRope["GF??"];
localFrame => PutRope["LF??"];
ENDCASE => PutRope["??"];
};
msg: ROPE ← Mother[innerPut];
IF msg #
NIL
THEN
PutRopes["--{", 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