DIRECTORY
Basics: TYPE USING [HighHalf, LowHalf],
ConvertUnsafe: TYPE USING [SubString],
Symbols: TYPE USING [
codeANY, codeCHAR, codeINT, CSEIndex, CTXIndex, 
ISEIndex, ISENull, MDIndex, MDNull, Name, nullName, nullType,
OwnMdi, Type, StandardContext, typeTYPE],
SymbolTable: TYPE USING [Base],
TypeStrings: TYPE USING [Code, TypeString];

TypeStringsImpl: PROGRAM 
IMPORTS Basics
EXPORTS TypeStrings = {
OPEN Symbols, TypeStrings;



stb: SymbolTable.Base _ NIL;
zone: UNCOUNTED ZONE _ NIL;
ts: TypeString;

Create: PUBLIC PROC[base: SymbolTable.Base, sei: Type, z: UNCOUNTED ZONE]
RETURNS[TypeString] = {
IF base=NIL THEN RETURN[NIL];
stb _ base;
zone _ z;
stackIndex _ defsIndex _ 0;
ts _ zone.NEW[StringBody[50]];
stack _ zone.NEW[StackVector];
defs _ zone.NEW[DefsVector];
lastName _ '\000;
stateLength _ 0;  
AppendTypeString[sei];
IF InsertDefinitions[] THEN Canonicalize[sei];
zone.FREE[@defs];  zone.FREE[@stack];
IF ts.length # ts.maxlength THEN ts _ Adjust[ts,ts.length];
RETURN[ts]};

Adjust: PROC[s: TypeString, n: CARDINAL] RETURNS[new: TypeString] = {
new _ zone.NEW[StringBody[n]];
FOR i: CARDINAL IN [0..MIN[n, s.length]) DO
AppendChar[new, s[i]] ENDLOOP;
zone.FREE[@s];
RETURN[new]};

Append: PROC[c: CHAR] = {  
WHILE ts.length >= ts.maxlength DO
ts _ Adjust[ts,ts.length+20] ENDLOOP;
AppendChar[ts, c]};

AppendChar: PROC [s: LONG STRING, c: CHARACTER] = {
IF s = NIL OR s.length >= s.maxlength THEN ERROR;
s[s.length] _ c;
s.length _ s.length + 1;
};

AppendCode: PROC[code: Code] = LOOPHOLE[Append];

AppendCardinal: PROC[c: CARDINAL] = INLINE {
Append[LOOPHOLE[c/256]];  Append[LOOPHOLE[c MOD 256]]};

AppendLongCardinal: PROC [lc: LONG CARDINAL] = {
AppendCardinal[Basics.HighHalf[lc]];
AppendCardinal[Basics.LowHalf[lc]]};

AppendString: PROC [s:TypeString] = INLINE {
FOR i: CARDINAL IN [0..s.length) DO Append[s[i]] ENDLOOP};

Paint: TYPE = MACHINE DEPENDENT RECORD [
version (0): ARRAY [0..3) OF CARDINAL,
index (3): CARDINAL];

GetPaint: PROC[type: Type] RETURNS[paint: Paint] = {
SELECT stb.TypeForm[type] FROM
$enumerated, $definition, $record, $union => {
ctx: CTXIndex _ TypeContext[type];
mdi: MDIndex;
WITH c~~stb.ctxb[ctx] SELECT FROM
simple => mdi _ OwnMdi;
included => {mdi _ c.module; ctx _ c.map};
ENDCASE => ERROR;
paint.index _ LOOPHOLE[ctx];
paint.version _
(IF ctx IN StandardContext THEN ALL[0] ELSE LOOPHOLE[stb.mdb[mdi].stamp])};
$opaque =>
paint _ [LOOPHOLE[stb.mdb[OwnMdi].stamp], LOOPHOLE[type]];
ENDCASE => ERROR};

AppendPaint: PROC[paint:Paint] = {
AppendCardinal[paint.version[0]];
AppendCardinal[paint.version[1]];
AppendCardinal[paint.version[2]];
AppendCardinal[paint.index]};

AppendName: PROC[name: Name] = {
length, offset: CARDINAL;
IF name = nullName THEN length _ offset _ 0
ELSE length _ stb.ht[name].ssIndex - (offset _ stb.ht[name-1].ssIndex);
IF length>200b THEN ERROR; -- avoid code for leftParen and rightParen
Append[LOOPHOLE[length]];
FOR i: CARDINAL IN [offset..offset+length) DO Append[stb.ssb[i]] ENDLOOP};

AppendField: PROC[iSei: ISEIndex] = INLINE {
AppendName[stb.NameForSe[iSei]];
AppendTypeString[stb.seb[iSei].idType]};

AppendTypeString: PROC[type: Type] = {
class: Code;
e: StackElement;
type _ UnderStar[type];
IF stb.TypeForm[type]=$opaque THEN
type _ OpaqueValue[LOOPHOLE[type,CSEIndex],stb];
FOR i: CARDINAL IN [0..stateLength) DO
IF state[i].type = type THEN {type _ state[i].current; EXIT};
ENDLOOP;
IF (e _ Find[type]) # NIL THEN {
IF e.name='\000 THEN e.name_NewName[]; 
AppendCode[name]; Append[e.name]; RETURN};
Push[type];
SELECT (class _ TypeClass[type]) FROM
$definition => ERROR;
$enumerated => {
SELECT LOOPHOLE[TypeContext[type],CARDINAL] FROM
4 => AppendCode[boolean];
ENDCASE => {AppendCode[paint]; AppendPaint[GetPaint[type]]}};
$record => {
SELECT LOOPHOLE[TypeContext[type],CARDINAL] FROM
6 => AppendCode[text];
8 => AppendCode[stringBody];
ENDCASE => {AppendCode[paint]; AppendPaint[GetPaint[type]]}};
$structure => {
ctx: CTXIndex = TypeContext[type];
WITH c~~stb.ctxb[ctx] SELECT FROM
included => IF ~c.complete THEN ERROR;
ENDCASE;
AppendCode[leftParen];
FOR iSei: ISEIndex _ stb.FirstCtxSe[ctx], stb.NextSe[iSei] WHILE iSei#ISENull DO
AppendField[iSei] ENDLOOP;
AppendCode[rightParen]};
$union => {AppendCode[union]; AppendPaint[GetPaint[type]]};
$array => {
IF Packed[type] THEN AppendCode[packed];
AppendCode[array];  
AppendTypeString[Domain[type]]; 
AppendTypeString[Range[type]]};
$sequence => {
IF Packed[type] THEN AppendCode[packed];
AppendCode[sequence];  
AppendField[Tag[type]]; 
AppendTypeString[Range[type]]};
$subrange => { -- 10 bytes
AppendCode[subrange];
AppendTypeString[Ground[type]];
AppendLongCardinal[First[type]];
AppendLongCardinal[Last[type]]};
$opaque =>  {
csei: CSEIndex = LOOPHOLE[type];
WITH t~~stb.seb[csei] SELECT FROM
opaque =>
IF stb.seb[t.id].idCtx IN StandardContext THEN AppendCode[atomRec]
ELSE {AppendCode[opaque]; AppendPaint[GetPaint[type]]};
ENDCASE => ERROR};
$countedZone, $uncountedZone => {
IF Mds[type] THEN AppendCode[mds];
AppendCode[class]};
$list => { -- list = REF RECORD[cdr]
IF Ordered[type] THEN AppendCode[ordered];
IF ReadOnly[type] THEN AppendCode[readOnly];
AppendCode[list];
AppendTypeString[Cdr[type]]};
$relativeRef => {
AppendCode[relativeRef];
AppendTypeString[Base[type]];
AppendTypeString[Range[type]]};
$ref => {
IF ReadOnly[type] THEN AppendCode[readOnly];
IF TypeClass[Range[type]] = $any THEN AppendCode[refAny]
ELSE {AppendCode[ref]; AppendTypeString[Range[type]]}};
$var => {
IF ReadOnly[type] THEN AppendCode[readOnly];
AppendCode[var]; AppendTypeString[Range[type]]};
$pointer, $longPointer => { 
IF Ordered[type] THEN AppendCode[ordered];
IF ReadOnly[type] THEN AppendCode[readOnly];
AppendCode[class]; AppendTypeString[Range[type]]}; 
$descriptor, $longDescriptor => {
IF ReadOnly[type] THEN AppendCode[readOnly];
AppendCode[class]; AppendTypeString[Range[type]]};
$procedure, $safeProc => {
AppendCode[class];
AppendTypeString[Domain[type]];
AppendTypeString[Range[type]]};
$port, $program, $signal, $error => {
IF Safe[type] THEN AppendCode[safe];
AppendCode[class];
AppendTypeString[Domain[type]];
AppendTypeString[Range[type]]};
$process => {
IF Safe[type] THEN AppendCode[safe];
AppendCode[process]; AppendTypeString[Range[type]]};
$nil => {AppendCode[leftParen]; AppendCode[rightParen]};
$cardinal, $integer, $character, $longInteger, $longCardinal, $real,
$type, $any, $unspecified, $longUnspecified =>
AppendCode[class];
$globalFrame, $localFrame => ERROR;
ENDCASE => ERROR;
Pop[]};

OpaqueValue: PROC[type: CSEIndex, base: SymbolTable.Base] RETURNS[val: Type] = {
OPEN b1~~stb;
val _ type;
WITH t1~~b1.seb[type] SELECT FROM
opaque => {
mdi1:MDIndex = (WITH c1~~b1.ctxb[b1.seb[t1.id].idCtx] SELECT FROM
included => c1.module,
imported => b1.ctxb[c1.includeLink].module,
ENDCASE => OwnMdi);
mdi2: MDIndex = base.FindMdi[b1.mdb[mdi1].stamp];
IF mdi2 # MDNull AND base.mdb[mdi2].exported THEN {
sei2: ISEIndex;
ss: ConvertUnsafe.SubString = b1.SubStringForName[b1.seb[t1.id].hash];
sei2 _ base.SearchContext[base.FindString[ss], base.mainCtx];
IF sei2#ISENull AND base.seb[sei2].idType=typeTYPE 
AND base.seb[sei2].public THEN val _ base.UnderType[sei2]}};
ENDCASE};

lastName: CHAR;

NewName: PROC RETURNS[CHAR] = {RETURN[lastName _ lastName+1]};



Canonicalize: PROC [type:Type] = {
stateLength _ 0;
state _ zone.NEW[StateTable];
AddState[type]; -- gets them all recursively
UNTIL ~Split[] DO NULL ENDLOOP;
ts.length _ 0;
AppendTypeString[type];  -- will make use of the equivalences
[] _ InsertDefinitions[];
zone.FREE[@state]};

Split: PROC RETURNS [split: BOOL_FALSE]= {
FOR i: CARDINAL IN [0..stateLength) DO
found: BOOL _ FALSE;
FOR j: CARDINAL IN [0..i) DO 
IF state[i].current=state[j].current THEN found _ TRUE;
ENDLOOP;
IF found THEN LOOP;
list _ zone.NEW[ListVector];
list[0] _ state[i].type; listLength _ 1;
state[i].next _ state[i].type;
FOR j: CARDINAL IN (i..stateLength) DO
IF state[j].current#state[i].current THEN LOOP;  -- not in the class
found _ FALSE;
FOR k: CARDINAL IN [0..listLength) DO
IF kEQ[state[j].type,list[k]] THEN {
state[j].next _ list[k]; found _ TRUE; EXIT};
ENDLOOP;
IF found THEN LOOP;  
state[j].next _ state[j].type;
IF listLength >= maxStateLength THEN ERROR;
list[listLength]_state[j].type;
listLength _ listLength + 1;
split _ TRUE;
ENDLOOP;
zone.FREE[@list];
ENDLOOP;
FOR i: CARDINAL IN [0..stateLength) DO
state[i].current _ state[i].next;
ENDLOOP};

AddState: PROC[type:Type] = {
class: Code;
type _ UnderStar[type];
FOR i: CARDINAL IN [0..stateLength) DO
IF state[i].type = type THEN RETURN;
ENDLOOP;
IF stateLength >= maxStateLength THEN ERROR;
state[stateLength] _ [type,nullType,nullType];
stateLength _ stateLength + 1;
class _ TypeClass[type];
SELECT class FROM
$definition => ERROR;
$record, $enumerated => NULL;
$structure => 
FOR iSei: ISEIndex _ stb.FirstCtxSe[TypeContext[type]], stb.NextSe[iSei]
WHILE iSei#ISENull DO
AddState[stb.seb[iSei].idType];
ENDLOOP;
$union => NULL;
$array => {AddState[Domain[type]]; AddState[Range[type]]};
$sequence => {AddState[stb.seb[Tag[type]].idType]; AddState[Range[type]]};
$subrange => AddState[Ground[type]];
$opaque => NULL;
$countedZone, $uncountedZone => NULL;
$list => AddState[Cdr[type]];
$relativeRef => {AddState[Base[type]]; AddState[Range[type]]};
$ref => AddState[Range[type]];
$var => AddState[Range[type]];
$pointer, $longPointer, $descriptor, $longDescriptor => AddState[Range[type]];
$procedure, $safeProc, $port, $program, $signal, $error => {
AddState[Domain[type]]; AddState[Range[type]]};
$process => AddState[Range[type]];
$nil => NULL;
$globalFrame, $localFrame => ERROR;
$cardinal, $integer, $character, $longInteger, $longCardinal, $real,
$type, $any, $unspecified, $longUnspecified => NULL;
ENDCASE => ERROR};

kEQ: PROC[t1, t2: Type] RETURNS[BOOL] = {
class1: Code = TypeClass[t1];
class2: Code = TypeClass[t2];
IF class1#class2 THEN RETURN[FALSE];
SELECT class1 FROM
$definition => ERROR;
$record, enumerated, union => RETURN[t1=t2];
$structure => {
iSei1: ISEIndex _ stb.FirstCtxSe[TypeContext[t1]];
iSei2: ISEIndex _ stb.FirstCtxSe[TypeContext[t2]];
DO
IF iSei1=ISENull OR iSei2=ISENull THEN RETURN[iSei1=iSei2];
IF stb.NameForSe[iSei1] # stb.NameForSe[iSei2] THEN RETURN[FALSE];
IF Current[stb.seb[iSei1].idType]#Current[stb.seb[iSei2].idType] THEN RETURN[FALSE]; 
iSei1 _ stb.NextSe[iSei1];
iSei2 _ stb.NextSe[iSei2];
ENDLOOP};
$array =>
RETURN[Current[Domain[t1]]=Current[Domain[t2]]
AND Current[Range[t1]]=Current[Range[t2]]];
$sequence => {
iSei1: ISEIndex = Tag[t1];
iSei2: ISEIndex = Tag[t2];
RETURN[stb.NameForSe[iSei1] = stb.NameForSe[iSei2]
AND Current[stb.seb[iSei1].idType]=Current[stb.seb[iSei2].idType]
AND Current[Range[t1]]=Current[Range[t2]]]};
$subrange => RETURN[Current[Ground[t1]]=Current[Ground[t2]] AND First[t1] = First[t2] AND Last[t1] = Last[t2]];
$opaque => RETURN[t1=t2];
$countedZone, uncountedZone => RETURN[t1=t2];
$list => RETURN[Current[Cdr[t1]]=Current[Cdr[t2]]];
$relativeRef =>
RETURN[Current[Base[t1]]=Current[Base[t2]]
AND Current[Range[t1]]=Current[Range[t2]]];
$ref => RETURN[Current[Range[t1]]=Current[Range[t2]]];
$var => RETURN[Current[Range[t1]]=Current[Range[t2]]];
$pointer, $longPointer, $descriptor, $longDescriptor => 
RETURN[Current[Range[t1]]=Current[Range[t2]]];
$procedure, $safeProc, $port, $program, $signal, $error => {
RETURN[Current[Domain[t1]]=Current[Domain[t2]] 
AND Current[Range[t1]]=Current[Range[t2]]]};
$process => RETURN[Current[Range[t1]]=Current[Range[t2]]];
$nil => RETURN[t1=t2];
$globalFrame, $localFrame => ERROR;
$cardinal, $integer, $character, $longInteger, $longCardinal, $real,
$type, $any, $unspecified, $longUnspecified =>
RETURN[t1=t2];
ENDCASE => ERROR};

Current: PROC[type:Type] RETURNS[Type] = {
type _ UnderStar[type];
FOR i: CARDINAL IN [0..stateLength) DO
IF state[i].type=type THEN RETURN[state[i].current];
ENDLOOP;
ERROR};

StateTable: TYPE = ARRAY [0..maxStateLength) OF RECORD[type, current, next: Type];
state: LONG POINTER TO StateTable _ NIL;
stateLength: CARDINAL;
maxStateLength: CARDINAL = 100;

ListVector: TYPE = ARRAY [0..maxStateLength) OF Type;
list: LONG POINTER TO ListVector _ NIL;
listLength: CARDINAL;



StackElementRecord: TYPE = RECORD[name: CHAR, type: Type, index: CARDINAL];
StackElement: TYPE = LONG POINTER TO StackElementRecord;

StackVector: TYPE = ARRAY [0..stackLength) OF StackElementRecord;
stack: LONG POINTER TO StackVector _ NIL;
stackLength: CARDINAL = 100;
stackIndex: CARDINAL _ 0;

DefsVector: TYPE = ARRAY [0..defsLength) OF StackElementRecord;
defs: LONG POINTER TO DefsVector _ NIL;
defsLength: CARDINAL = 30;
defsIndex: CARDINAL _ 0;

Push: PROC[type:Type] = {
IF stackIndex=stackLength THEN ERROR;
stack[stackIndex] _ ['\000,type,ts.length];
stackIndex _ stackIndex + 1};

Pop: PROC = {
IF stackIndex=0 THEN ERROR;
stackIndex _ stackIndex - 1;
IF stack[stackIndex].name='\000 THEN RETURN;
IF defsIndex=defsLength THEN ERROR;
defs[defsIndex] _ stack[stackIndex];
defsIndex _ defsIndex+1};

Find: PROC [type:Type] RETURNS[StackElement_NIL] = {
FOR i:CARDINAL IN [0..stackIndex) DO
IF stack[i].type=type THEN RETURN[@stack[i]];
ENDLOOP};

InsertDefinitions: PROC RETURNS[recursive: BOOL _ FALSE] = {
WHILE TRUE DO
index, j: CARDINAL _ 0;
found: BOOL _ FALSE;
FOR i: CARDINAL IN [0..defsIndex) DO
IF defs[i].name='\000 THEN LOOP;
IF defs[i].index<index THEN LOOP;
index _ defs[i].index; j _ i;
found _ recursive _ TRUE;
ENDLOOP;
IF ~found THEN EXIT;
IF ts.length+2 > ts.maxlength THEN ts _ Adjust[ts,ts.length+4];
ts.length _ ts.length + 2;
FOR i: CARDINAL DECREASING IN [index+2..ts.length) DO ts[i] _ ts[i-2] ENDLOOP;
LOOPHOLE[ts[index],Code] _ $definition;
ts[index+1] _ defs[j].name;
defs[j].name _ '\000;
ENDLOOP;
lastName _ '\000;
defsIndex _ 0};









TypeContext: PROC[type: Type] RETURNS[CTXIndex] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [WITH t~~stb.seb[csei] SELECT FROM
enumerated => t.valueCtx,
record => t.fieldCtx,
definition => t.defCtx,
union => t.caseCtx,
ENDCASE => ERROR]};

Cdr: PROC[type: Type] RETURNS[Type] = {
ctx: CTXIndex = TypeContext[Range[type]];
iSei: ISEIndex _ stb.FirstCtxSe[ctx];
WITH c~~stb.ctxb[ctx] SELECT FROM
included => IF ~c.complete THEN ERROR;
ENDCASE;
RETURN [stb.seb[iSei].idType]};

Base: PROC[type: Type] RETURNS[Type] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [WITH t~~stb.seb[csei] SELECT FROM
relative => t.baseType,
ENDCASE => ERROR]};

Range: PROC[type: Type] RETURNS[Type] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [WITH t~~stb.seb[csei] SELECT FROM
array => t.componentType,
sequence => t.componentType,
transfer => t.typeOut,
ref => t.refType,
relative => t.offsetType,
arraydesc => t.describedType,
long => Range[t.rangeType],
ENDCASE => ERROR]};

Domain: PROC[type: Type] RETURNS[Type] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [WITH t~~stb.seb[csei] SELECT FROM
array => t.indexType,
sequence => stb.seb[t.tagSei].idType,
union => stb.seb[t.tagSei].idType,
transfer => t.typeIn,
ENDCASE => ERROR]};

Tag: PROC[type: Type] RETURNS[ISEIndex] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [WITH t~~stb.seb[csei] SELECT FROM
sequence => t.tagSei,
union => t.tagSei,
ENDCASE => ERROR]};

First: PROC[type: Type] RETURNS[LONG CARDINAL] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [SELECT TypeClass[csei] FROM
$enumerated => 0,
$subrange =>
(WITH t~~stb.seb[csei] SELECT FROM
subrange => t.origin.LONG,
ENDCASE => ERROR),
$cardinal => CARDINAL.FIRST,
$integer => LONG[LOOPHOLE[INTEGER.FIRST, CARDINAL]],
$character => LONG[LOOPHOLE[CHAR.FIRST, CARDINAL]],
$longInteger => LOOPHOLE[FIRST[LONG INTEGER]],
$longCardinal => FIRST[LONG CARDINAL],
ENDCASE => ERROR]};

Last: PROC[type: Type] RETURNS[LONG CARDINAL] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [SELECT TypeClass[csei] FROM
$enumerated =>
(WITH t~~stb.seb[csei] SELECT FROM
enumerated => LOOPHOLE[(t.nValues - 1).LONG],
ENDCASE => ERROR),
$subrange =>
(WITH t~~stb.seb[csei] SELECT FROM
subrange => LOOPHOLE[(t.origin + t.range).LONG],
ENDCASE => ERROR),
$cardinal => CARDINAL.LAST,
$integer => LONG[LOOPHOLE[INTEGER.LAST, CARDINAL]],
$character => LONG[LOOPHOLE[CHAR.LAST, CARDINAL]],
$longInteger => LOOPHOLE[LAST[LONG INTEGER]],
$longCardinal => LAST[LONG CARDINAL],
ENDCASE => ERROR]};

Safe: PROC[type: Type] RETURNS[BOOL] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [WITH t~~stb.seb[csei] SELECT FROM
transfer => t.safe,
ENDCASE => ERROR]};

ReadOnly: PROC[type: Type] RETURNS[BOOL] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [WITH t~~stb.seb[csei] SELECT FROM
long => ReadOnly[t.rangeType],
ref => t.readOnly,
arraydesc => t.readOnly,
ENDCASE => ERROR]};

Ordered: PROC[type: Type] RETURNS[BOOL] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [WITH t~~stb.seb[csei] SELECT FROM
long => Ordered[t.rangeType],
ref => t.ordered,
ENDCASE => ERROR]};

Packed: PROC[type: Type] RETURNS[BOOL] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [WITH t~~stb.seb[csei] SELECT FROM
array => t.packed,
sequence => t.packed,
ENDCASE => ERROR]};

Mds: PROC[type: Type] RETURNS[BOOL] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [WITH t~~stb.seb[csei] SELECT FROM
zone => t.mds,
ENDCASE => ERROR]};

Ground: PROC[type: Type] RETURNS[Type] = {
RETURN [WITH se~~stb.seb[type] SELECT FROM
id => se.idInfo,  -- a definition
cons =>
WITH t~~se SELECT FROM
subrange => t.rangeType,
ENDCASE => ERROR,  -- NOTE relativeRef not yet
ENDCASE => ERROR]};

UnderStar: PROC[type: Type] RETURNS[Type] = {
WHILE TypeClass[type]=$definition DO
type _ stb.UnderType[type];
ENDLOOP;
RETURN[type]};

TypeClass: PROC[sei: Type] RETURNS[ans: Code] = {
csei: CSEIndex;
IF sei=nullType THEN RETURN[$nil];
IF stb.seb[sei].seTag = id THEN RETURN[$definition];
csei _ stb.UnderType[sei];
RETURN [WITH t~~stb.seb[csei] SELECT FROM
basic => SelectBasicClass[t.code],
record => (IF t.painted THEN $record ELSE $structure),
definition => $record,
real => $real,
union => $union,
array => $array,
opaque => $opaque,
sequence => $sequence,
ref => (IF t.counted THEN ERROR ELSE $pointer),
arraydesc => $descriptor,
long => (WITH rt~~stb.seb[stb.UnderType[t.rangeType]] SELECT FROM
ref => (SELECT TRUE FROM
rt.var => $var,
rt.counted => IF rt.list THEN $list ELSE $ref,
ENDCASE => $longPointer),
basic => (SELECT rt.code FROM
codeINT => $longInteger,
codeANY => $longUnspecified
ENDCASE => ERROR),
arraydesc => $longDescriptor,
ENDCASE => IF IsCardinal[t.rangeType] THEN $longCardinal ELSE ERROR),
relative => $relativeRef,
enumerated => $enumerated,
subrange => IF IsCardinal[csei] THEN $cardinal ELSE $subrange,
transfer => (SELECT t.mode FROM
$proc => IF t.safe THEN $safeProc ELSE $procedure,
$port => $port,
$signal => $signal,
$error => $error,
$process => $process,
$program => $program,
ENDCASE => ERROR),
zone => (IF t.counted THEN $countedZone ELSE $uncountedZone),
mode => $type,
any => $any,
ENDCASE => ERROR]};

SelectBasicClass: PROC[code: [0..16)] RETURNS[Code] = INLINE {
RETURN [SELECT code FROM
codeINT => $integer,
codeANY => $unspecified,
codeCHAR => $character,
ENDCASE => ERROR]};

IsCardinal: PROC[type: Type] RETURNS[BOOL] = {
csei: CSEIndex = stb.UnderType[type];
RETURN [WITH t~~stb.seb[csei] SELECT FROM
subrange => (WITH rt~~stb.seb[stb.UnderType[t.rangeType]] SELECT FROM
basic => (rt.code = codeINT AND t.origin = 0 AND t.range = CARDINAL.LAST),
ENDCASE => FALSE),
ENDCASE => FALSE]};

}.








€file [Indigo]<Cedar>BCD>TypeStringsImpl.mesa
Edited by Satterthwaite, May 6, 1983 1:11 pm
Edited by Maxwell, 19-Feb-82 11:33:15 (NOTE: we need better error reporting)
Last Modified On July 6, 1983 1:57 pm By Paul Rovner
Last Edited by: Levin, August 8, 1983 4:09 pm
*******************************************************************
basic algorithm
*******************************************************************
n:Entry;
IF base#stb THEN FlushCache[];
IF (n_cache[sei]).type=sei THEN RETURN[n.string];
n.type _ sei;
n.recursive _ InsertDefinitions[];
n.string _ ts;
strip off definitions
substitute concrete type for opaque type
replace type with its set representative
check to see if type is recursive
general cases
10 => AppendCode[condition];
12 => AppendCode[lock];
*******************************************************************
canonicalization	
*******************************************************************
build an equivalence table for the type
minimize the table
generate a new string
iterate over all k-equivalent classes, 
splitting them into k+1-equivalent classes
check to see if we have done this class already
if not, process the class 
a new class is born
strip off unnecessary definitions
ground: Type _ type;
WHILE TypeClass[ground]=$definition DO
type _ ground; 
ground _ stb.UnderType[type];
ENDLOOP;
type _ ground;
*******************************************************************
stack management
*******************************************************************
*******************************************************************
hash table management
*******************************************************************
Entry:TYPE = LONG POINTER TO EntryRec;
EntryRec:TYPE = RECORD [type:Type,
recursive:BOOL,
string:TypeString];
nullEntry:EntryRec = [nullType, FALSE, NIL];
array: ARRAY [0..arrayLength) OF EntryRec;
arrayLength:CARDINAL = 47;
FlushCache: PROC = {array _ ALL[nullEntry]};
cache: PROC [sei:Type] RETURNS[Entry] ={
p:CARDINAL _ LOOPHOLE[sei,CARDINAL] MOD arrayLength;
FOR i:CARDINAL IN [p..arrayLength) DO
IF array[i].type=nullType THEN RETURN[@array[i]];
IF array[i].type=sei THEN RETURN[@array[i]];
ENDLOOP;
FOR i:CARDINAL IN [0..p) DO
IF array[i].type=nullType THEN RETURN[@array[i]];
IF array[i].type=sei THEN RETURN[@array[i]];
ENDLOOP;
ERROR}; ++ too many types!!!
*******************************************************************
procedures that work with the symbol table
*******************************************************************
IF type = fhType THEN RETURN[localFrame];
IF type = nullType THEN RETURN[nil];
IF type = gfhType THEN RETURN[globalFrame];
IF type = unspecType THEN RETURN[unspecified];
�Ê®˜Jš
œ,™,Jš
œ,™,Jš
œL™LJš
œ4™4Jš
œ-™-J˜š
Ïk	˜	Jšœ�œ
�œ˜'Jšœ�œ
�œ
˜&šœ	�œ
�œ˜J˜0J˜=J˜)—Jšœ
�œ
�œ˜Jšœ
�œ
�œ˜+J˜—šœ�œ
˜Jš�œ˜Jš�œ˜Jš�œ˜J˜J˜Jš
œC™CJš
œ™Jš
œC™C˜Jšœ�œ
˜Jšœ�	œ
�œ�œ
˜J˜J˜š
Ïnœ�œ
�œ'�	œ
�œ
˜IJš�œ˜Jš
œ™Jš
œ™Jš
�œ�œ
�œ
�œ
�œ˜J˜J˜	J˜Jš
œ1™1Jšœ
�œ˜Jšœ
�œ˜Jšœ�œ
˜J˜J˜J˜Jš
œ
™
Jš
œ"™"Jš�œ�œ˜.Jš
œ™Jšœ�œ�œ	˜%Jš�œ�œ˜;Jš�œ˜J˜—šžœ�œ�œ�œ˜EJšœ�œ˜š	�œ�œ
�œ�œ�˜+Jšœ�œ
˜—Jšœ�œ˜Jš�œ˜
J˜—šžœ�œ�œ˜š�œ�˜"Jšœ�œ
˜%—J˜J˜—š
ž
œ�œ�œ
�œ�	œ˜3Jš
�œ�œ
�œ�œ
�œ
˜1J˜J˜J˜J˜—Jšž
œ�œ�œ	˜0J˜šžœ�œ�œ�œ˜,Jšœ�œ�œ�œ˜7J˜—šžœ�œ�œ
�œ˜0J˜$J˜$J˜—šžœ�œ�œ˜,Jš
�œ�œ
�œ�œ�œ˜:J˜—š	œ�œ�œ
�	œ
�œ˜(Jšœ
�œ�œ
�œ
˜&Jšœ�œ˜J˜—šžœ�œ
�œ˜4š�œ�˜˜.J˜"J˜
š�œ�œ
�˜!J˜J˜*Jš�œ�œ
˜—Jšœ�œ˜˜Jš
œ
�œ�œ�œ
�œ�œ
�œ˜K——˜
Jšœ	�œ�œ˜:—Jš�œ�œ˜J˜——šžœ�œ˜"J˜!J˜!J˜!J˜J˜—šž
œ�œ˜ Jšœ�œ
˜Jš�œ�œ˜+Jš�œC˜GJš�œ
�œ
�œÏc*˜EJšœ�œ
˜Jš
�œ�œ
�œ�œ�œ˜JJ˜—šžœ�œ�œ˜,J˜ J˜(J˜—šžœ�œ˜&J˜J˜Jš
œ™J˜Jš
œ(™(š�œ�˜"Jšœ�œ˜0—Jš
œ(™(š�œ�œ
�œ�˜&Jš�œ�œ�œ˜=Jš�œ
˜—Jš
œ!™!š�œ�œ
�œ˜ Jš�œ�œ˜'Jšœ"�œ˜*—Jš
œ
™
J˜š�œ�˜%Jšœ�œ
˜˜š�œ
�œ�œ�˜0J˜Jš�œ6˜=——˜š�œ
�œ�œ�˜0J˜J˜Jš
œ™Jš
œ™Jš�œ6˜=——˜J˜"š�œ�œ
�˜!Jšœ�œ
�œ
�œ
˜&Jš�œ
˜—J˜š�œ8�œ�˜PJšœ�œ
˜—J˜—J˜;˜Jš�œ�œ˜(J˜J˜ J˜—˜Jš�œ�œ˜(J˜J˜J˜—šœŸ˜J˜J˜J˜ J˜ —˜
Jšœ�œ˜ š�œ�œ
�˜!˜	Jš�œ�œ�œ˜BJš�œ3˜7—Jš�œ�œ˜——˜!Jš�œ�œ˜"J˜—šœŸ˜$Jš�œ�œ˜*Jš�œ�œ˜,J˜J˜—˜J˜J˜J˜—˜	Jš�œ�œ˜,Jš�œ�œ˜8Jš�œ3˜7—˜	Jš�œ�œ˜,J˜0—˜Jš�œ�œ˜*Jš�œ�œ˜,J˜3—˜!Jš�œ�œ˜,J˜2—˜J˜J˜J˜—˜%Jš�œ�œ˜$J˜J˜J˜—˜
Jš�œ�œ˜$J˜4—J˜8J˜D˜.J˜—Jšœ�œ
˜#Jš�œ�œ
˜—J˜J˜—šžœ�œ)�œ˜PJš�œ	˜
J˜š�œ�œ
�˜!˜šœ�œ"�œ
�˜AJ˜J˜+Jš�œ˜—J˜1š�œ�œ�œ˜3J˜J˜FJ˜=š�œ�œ ˜3Jš�œ�œ˜<———Jš�œ˜	J˜——Jšœ
�œ
˜J˜Jš
žœ�œ
�œ
�œ�œ˜>J˜J˜—Jš
œC™CJš
œ™Jš
œC™C˜šžœ�œ˜"Jš
œ'™'J˜Jšœ
�œ
˜JšœŸ˜,Jš
œ™Jš�œ
�œ
�œ
�œ
˜Jš
œ™J˜JšœŸ$˜=J˜Jšœ�œ
˜J˜—š
žœ�œ
�œ	�œ
�œ˜*Jš
œ'™'Jš
œ*™*š�œ�œ
�œ�˜&Jš
œ/™/Jšœ�œ�œ
˜š�œ�œ
�œ�œ
˜Jš�œ#�œ	�œ
˜7Jš�œ
˜—Jš�œ�œ
�œ
˜Jš
œ™Jšœ�œ
˜J˜(J˜š�œ�œ
�œ�˜&Jš�œ#�œ
�œŸ˜DJšœ�œ
˜š�œ�œ
�œ�˜%š�œ�œ˜$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šœ�œ
˜˜š�œE˜Hš�œ�˜J˜Jš�œ
˜———Jšœ
�œ
˜J˜:J˜JJ˜$Jšœ�œ
˜Jšœ �œ
˜%J˜J˜>J˜J˜J˜N˜<J˜/—J˜"Jšœ�œ
˜
Jšœ�œ
˜#J˜DJšœ/�œ
˜4Jš�œ�œ˜J˜——šœ�œ�œ
�œ˜)J˜J˜Jš�œ�œ
�œ
�œ˜$š�œ�˜Jšœ�œ
˜Jšœ�œ˜,˜J˜2J˜2š
�˜Jš�œ�œ�œ
�œ˜;Jš�œ-�œ
�œ
�œ˜BJš�œ?�œ
�œ
�œ˜UJ˜J˜Jš�œ˜	——˜	š�œ(˜.Jš�œ(˜+——˜J˜J˜š�œ,˜2Jš�œ>˜AJš�œ)˜,——Jšœ
�œ)�œ�œ˜oJšœ�œ˜Jšœ�œ˜-Jšœ	�œ$˜3˜š�œ$˜*Jš�œ(˜+——Jšœ�œ(˜6Jšœ�œ(˜6˜8Jš�œ(˜.—˜<š�œ)˜/Jš�œ)˜,——Jšœ�œ(˜:Jšœ�œ˜Jšœ�œ
˜#J˜D˜.Jš�œ˜—Jš�œ�œ˜J˜——šžœ�œ�œ
˜*J˜š�œ�œ
�œ�˜&Jš�œ�œ
�œ˜4Jš�œ
˜—Jš�œ˜J˜—Jš	œ�œ�œ�œ
�œ˜RJš	œ�œ
�œ
�œ�œ
˜(Jšœ
�œ
˜Jšœ�œ˜J˜Jšœ�œ�œ�œ˜5Jš	œ�œ
�œ
�œ�œ
˜'Jšœ�œ
˜J˜J˜—Jš
œC™CJš
œ™Jš
œC™C˜Jš	œ�œ�œ�œ�œ˜KJš	œ�œ�œ
�œ
�œ˜8J˜Jšœ
�œ�œ�œ˜AJš	œ�œ
�œ
�œ�œ
˜)Jšœ
�œ˜Jšœ�œ˜J˜Jšœ�œ�œ�œ˜?Jš	œ�œ
�œ
�œ�œ
˜'Jšœ�œ˜Jšœ�œ˜J˜šžœ�œ˜Jš�œ�œ
�œ
˜%J˜+J˜J˜—šžœ�œ˜
Jš�œ�œ
�œ
˜J˜Jš�œ�œ
�œ
˜,Jš�œ�œ
�œ
˜#J˜$J˜J˜—šžœ�œ
�œ�œ˜4š�œ�œ
�œ�˜$Jš�œ�œ
�œ˜-Jš�œ˜	J˜——š
žœ�œ
�œ�œ�œ˜<š�œ
�œ
�˜
Jšœ
�œ˜Jšœ�œ�œ
˜š�œ�œ
�œ�˜$Jš�œ�œ
�œ
˜ Jš�œ�œ
�œ
˜!J˜Jšœ�œ
˜Jš�œ
˜—Jš�œ�œ
�œ
˜Jš�œ�œ˜?J˜Jš�œ�œ
�
œ
�œ�œ�œ
˜NJš�œ˜'J˜J˜Jš�œ
˜—J˜J˜J˜———Jš
œC™CJš
œ™Jš
œC™CJ˜Jš
œ&™&J˜Jš
œ"™"Jš
œ™Jš
œ™J˜Jš
œ,™,J˜Jš
œ*™*Jš
œ™J˜Jš
œ,™,J˜Jš
œ(™(Jš
œ4™4Jš
œ%™%Jš
œ1™1Jš
œ,™,Jš
œ™Jš
œ™Jš
œ1™1Jš
œ,™,Jš
œ™Jš
œ™˜Jš
œC™CJš
œ*™*Jš
œC™C˜šžœ�œ
�œ˜3J˜%š�œ�œ�œ
�˜)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˜——š
žœ�œ
�œ
�œ
�œ˜2J˜%š�œ�œ�˜#J˜˜šœ
�œ�œ
�˜"Jšœ�œ
˜Jš�œ�œ˜——Jšœ
�œ
�œ
˜Jšœ�œ
�œ
�œ
�œ�œ˜4Jšœ�œ
�œ
�œ
�œ�œ˜3Jš	œ�œ
�œ
�œ
�œ˜.Jšœ�œ
�œ
�œ˜&Jš�œ�œ˜J˜——š
žœ�œ
�œ
�œ
�œ˜1J˜%š�œ�œ�˜#˜šœ
�œ�œ
�˜"Jšœ�œ�œ˜-Jš�œ�œ˜——˜šœ
�œ�œ
�˜"Jšœ�œ�œ˜0Jš�œ�œ˜——Jšœ
�œ
�œ
˜Jšœ�œ
�œ
�œ
�œ�œ˜3Jšœ�œ
�œ
�œ
�œ�œ˜2Jš	œ�œ
�œ
�œ
�œ˜-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˜—šž	œ�œ�œ˜1J˜Jš
œ)™)Jš
œ$™$Jš
œ+™+Jš
œ.™.Jš�œ�œ
�œ˜"Jš�œ�œ
�œ˜4J˜š�œ�œ�œ
�˜)J˜"Jšœ�œ�œ	�œ
˜6J˜J˜J˜J˜J˜J˜Jš	œ�œ�œ
�œ
�œ˜/J˜šœ	�œ)�œ
�˜Ašœ�œ
�œ
�˜J˜Jšœ�œ	�œ�œ˜.Jš�œ˜—šœ
�œ	�˜J˜J˜Jš�œ�œ˜—J˜Jš
�œ�œ�œ�œ
�œ˜E—J˜J˜Jšœ�œ�œ�œ˜>šœ
�œ�˜Jšœ	�œ�œ�œ˜2J˜J˜J˜J˜J˜Jš�œ�œ˜—Jšœ	�œ�œ�œ˜=J˜J˜Jš�œ�œ˜J˜——šžœ�œ�œ	�œ˜>š�œ�œ�˜J˜J˜J˜Jš�œ�œ˜J˜——šž
œ�œ
�œ
�œ˜.J˜%š�œ�œ�œ
�˜)šœ
�œ)�œ
�˜EJš	œ�œ�œ�œ
�œ˜JJš�œ�œ˜—Jš�œ�œ˜J˜——J˜J˜J˜J˜J˜J˜J˜J˜———…—Kho–