-- TypeGraphImpl.mesa: November 29, 1985 1:53:49 pm PST
-- Sturgis, January 3, 1986 2:02:47 pm PST

DIRECTORY
KipperMain1Def USING[idNode, idNodeBody],
Rope USING[Cat, Equal, Fetch, Length, ROPE],
TypeGraphDef USING[BuiltInTypeCase, RecordCase, TypeNodeCase];

TypeGraphImpl: CEDAR PROGRAM IMPORTS Rope EXPORTS TypeGraphDef, KipperMain1Def =
BEGIN OPEN KipperMain1Def;

-- Name and NameSeq mechanism

NameNode: TYPE = REF NameNodeBody;
NameNodeBody: PUBLIC TYPE = RECORD[
id: idNode,
key: INT];

NameSeqNode: TYPE = REF NameSeqNodeBody;
NameSeqNodeBody: PUBLIC TYPE= RECORD[
count: CARDINAL,
first, last: NameSeqCell];

NameSeqCell: TYPE = REF NameSeqCellBody;
NameSeqCellBody: TYPE = RECORD[
name: NameNode,
next: NameSeqCell];

BuildName: PUBLIC PROC[id: idNode] RETURNS[NameNode] =
{RETURN[NEW[NameNodeBody_[id, HashKey[id.text]]]]};

BuildImplModName: PUBLIC PROC[id: idNode] RETURNS[NameNode] =
BEGIN
newText: Rope.ROPE _ Rope.Cat[id.text, "Impl"];
newId: idNode _ NEW[idNodeBody_[newText, id.position, id.length]];
RETURN[NEW[NameNodeBody_[newId, HashKey[newId.text]]]];
END;

BuildRopeName: PUBLIC PROC[text: Rope.ROPE] RETURNS[NameNode] =
{RETURN[NEW[NameNodeBody_[NEW[idNodeBody_[text, 0, LAST[INT]]], HashKey[text]]]]};

BuildNullName: PUBLIC PROC RETURNS[NameNode] = {RETURN[NIL]};

<<declared as not damaging arg, nor sharing arg>>
FakeCopyName: PUBLIC PROC[name: NameNode] RETURNS[NameNode] = {RETURN[name]};

GetNameNodeInfo: PUBLIC PROC[name: NameNode] RETURNS[text: Rope.ROPE, position: INT] =
{RETURN[name.id.text, name.id.position]};

EqualNames: PUBLIC PROC[name1, name2: NameNode] RETURNS[BOOLEAN] =
BEGIN
IF (name1 = NIL) OR (name2 = NIL) THEN RETURN[(name1 = NIL) AND (name2 = NIL)];
RETURN[name1.key = name2.key AND Rope.Equal[name1.id.text, name2.id.text]];
END;

BuildEmptyNameSeq: PUBLIC PROC RETURNS[NameSeqNode] = {RETURN[NIL]};

<<damages NameSeqNode argument>>
AppendToNameSeq: PUBLIC PROC[nameSeq: NameSeqNode, name: NameNode] RETURNS[NameSeqNode] =
BEGIN
newCell: NameSeqCell _ NEW[NameSeqCellBody_[name, NIL]];
IF nameSeq = NIL THEN RETURN[NEW[NameSeqNodeBody_[1, newCell, newCell]]];
nameSeq.count _ nameSeq.count + 1;
IF nameSeq.last = NIL THEN nameSeq.first _ newCell ELSE nameSeq.last.next _ newCell;
nameSeq.last _ newCell;
RETURN[nameSeq];
END;

<<damages NameSeqNode argument>>
PrefixToNameSeq: PUBLIC PROC[name: NameNode, nameSeq: NameSeqNode] RETURNS[NameSeqNode] =
BEGIN
newCell: NameSeqCell _ NEW[NameSeqCellBody_[name, NIL]];
IF nameSeq = NIL THEN RETURN[NEW[NameSeqNodeBody_[1, newCell, newCell]]];
nameSeq.count _ nameSeq.count + 1;
newCell.next _ nameSeq.first;
nameSeq.first _ newCell;
IF nameSeq.last = NIL THEN nameSeq.last _ newCell;
RETURN[nameSeq];
END;

CopyNameSeq: PROC[nameSeq: NameSeqNode] RETURNS[NameSeqNode] =
BEGIN
newSeq: NameSeqNode _ BuildEmptyNameSeq[];
SeeOneName: PROC[name: NameNode] =
{newSeq _ AppendToNameSeq[newSeq, name]};
GenNameSeq[nameSeq, SeeOneName];
RETURN[newSeq];
END;

GenNameSeq: PROC[nameSeq: NameSeqNode, for: PROC[NameNode]] =
BEGIN
IF nameSeq = NIL THEN RETURN;
FOR cell: NameSeqCell _ nameSeq.first, cell.next WHILE cell # NIL DO
for[cell.name];
IF cell = nameSeq.last THEN EXIT;
ENDLOOP;
END;

CountNames: PROC[nameSeq: NameSeqNode] RETURNS[CARDINAL] =
{RETURN[IF nameSeq = NIL THEN 0 ELSE nameSeq.count]};

-- Element sequences
-- at the moment, elements are just names

ElementSeqNode: TYPE = REF ElementSeqNodeBody;
ElementSeqNodeBody: PUBLIC TYPE = NameSeqNode;

BuildEmptyElementSeq: PUBLIC PROC RETURNS[ElementSeqNode] = 
{RETURN[NEW[ElementSeqNodeBody_NIL]]};

<<damages first argument>>
AppendNameToElementSeq: PUBLIC PROC[elementSeq: ElementSeqNode, name: NameNode] RETURNS[ElementSeqNode] =
BEGIN
elementSeq^ _ AppendToNameSeq[elementSeq^, name];
RETURN[elementSeq];
END;

CountElements: PROC[elementSeq: ElementSeqNode] RETURNS[CARDINAL] =
{RETURN[CountNames[elementSeq^]]};

GenElements: PROC[elementSeq: ElementSeqNode, for: PROC[name: NameNode]] =
{GenNameSeq[elementSeq^, for]};


-- annonymous type nodes

TypeNode: TYPE = REF TypeNodeBody;
TypeNodeBody: PUBLIC TYPE = RECORD[
info: REF ANY,
name: NameNode _ NIL, -- nil if not named
defFile: NameNode _ NIL, -- nil if not named, or if a cedar predefined type
fcnDefFile: NameNode _ NIL,
fcnImplFile: NameNode _ NIL, -- nil if no marshall code is to be generated
allNames: NameSeqNode _ NIL, -- nil if not named
-- following fields are used when processing a type graph
visitNumber: INT _ 0,
onStackRefDepth: CARDINAL _ 0
];

GetTypeNodeCase: PUBLIC PROC[node: TypeNode] RETURNS[TypeGraphDef.TypeNodeCase] =
BEGIN
RETURN[WITH node.info SELECT FROM
named: NamedType => naming,
enum: EnumeratedType => enumerated,
record: RecordType => record,
ref: RefType => ref,
list: ListType => list,
seq: SeqType => seq,
builtIn: BuiltInType => builtIn,
ENDCASE => ERROR];
END;

GetTypeNodeName: PUBLIC PROC[node: TypeNode] RETURNS[NameNode] =
{RETURN[node.name]};

GetTypeNodeTypeDefFile: PUBLIC PROC[node: TypeNode] RETURNS[NameNode] =
{RETURN[node.defFile]};

GetTypeNodeFcnDefFile: PUBLIC PROC[node: TypeNode] RETURNS[NameNode] =
{RETURN[node.fcnDefFile]};

GetTypeNodeFcnImplFile: PUBLIC PROC[node: TypeNode] RETURNS[NameNode] =
{RETURN[node.fcnImplFile]};

GenAllNamesForType: PUBLIC PROC[node: TypeNode, for: PROC[NameNode]] =
{GenNameSeq[node.allNames, for]};



-- field sequences
-- used in building up record types, etc., but do not actually occur in the record types.

FieldSeqNode: TYPE = REF FieldSeqNodeBody;
FieldSeqNodeBody: PUBLIC TYPE = RECORD[
count: CARDINAL,
variety: FieldSeqVariety,
first, last: FieldCell];

FieldSeqVariety: TYPE = {nameTypePairs, typesOnly, empty};

FieldCell: TYPE = REF FieldCellBody;
FieldCellBody: TYPE = RECORD[
name: NameNode,
type: TypeNode,
next: FieldCell];



BuildEmptyFieldSeq: PUBLIC PROC RETURNS[FieldSeqNode] = {RETURN[NIL]};


BuildOnePairFieldSeq: PUBLIC PROC[nameSeq: NameSeqNode, type: TypeNode] RETURNS[FieldSeqNode] =
BEGIN
seq: FieldSeqNode _ NIL;
BuildOneCell: PROC[name: NameNode] =
BEGIN
cell: FieldCell _ NEW[FieldCellBody_[name, type, NIL]];
IF seq = NIL THEN seq _ NEW[FieldSeqNodeBody_[1, nameTypePairs, cell, cell]]
 ELSE {seq.last.next _ cell; seq.last _ cell; seq.count _ seq.count+1};
END;
GenNameSeq[nameSeq, BuildOneCell];
RETURN[seq];
END;

<<Damages fieldSeq1 argument, shares fieldSeq2 argument with result>>
ConcatFieldSeq: PUBLIC PROC[fieldSeq1, fieldSeq2: FieldSeqNode] RETURNS[FieldSeqNode] =
BEGIN
IF fieldSeq1 # NIL AND fieldSeq2 # NIL AND fieldSeq1.variety # fieldSeq2.variety
THEN ERROR;
IF fieldSeq1 = NIL OR fieldSeq1.first = NIL THEN RETURN[fieldSeq2];
IF fieldSeq2 = NIL OR fieldSeq2.first = NIL THEN RETURN[fieldSeq1];
fieldSeq1.count _ fieldSeq1.count + fieldSeq2.count;
fieldSeq1.last.next _ fieldSeq2.first;
fieldSeq1.last _ fieldSeq2.last;
RETURN[fieldSeq1];
END;

<<damages fieldSeq argument>>
PrefixTypeToFieldSeq: PUBLIC PROC[type: TypeNode, fieldSeq: FieldSeqNode] RETURNS[FieldSeqNode] =
BEGIN
cell: FieldCell _ NEW[FieldCellBody_[NIL, type, NIL]];
IF fieldSeq = NIL THEN RETURN[NEW[FieldSeqNodeBody_[1, typesOnly, cell, cell]]];
IF fieldSeq.variety # typesOnly THEN ERROR;
fieldSeq.count _ fieldSeq.count + 1;
cell.next _ fieldSeq.first;
IF fieldSeq.last = NIL THEN fieldSeq.last _ cell;
fieldSeq.first _ cell;
RETURN[fieldSeq];
END;

GenFieldCells: PROC[fieldSeq: FieldSeqNode, for: PROC[FieldCell]] =
BEGIN
IF fieldSeq = NIL THEN RETURN;
FOR cell: FieldCell _ fieldSeq.first, cell.next WHILE cell # NIL DO
for[cell];
IF cell = fieldSeq.last THEN EXIT;
ENDLOOP;
END;

CountFields: PROC[fieldSeq: FieldSeqNode] RETURNS[CARDINAL] =
{RETURN[IF fieldSeq = NIL THEN 0 ELSE fieldSeq.count]};

GetFieldVariety: PROC[fieldSeq: FieldSeqNode] RETURNS[FieldSeqVariety] =
{RETURN[IF fieldSeq # NIL THEN fieldSeq.variety ELSE empty]};

-- Named Types (these are removed during CloseTypeContext)

NamedType: TYPE = REF NamedTypeBody;
NamedTypeBody: TYPE = RECORD[
leftNames: NameSeqNode,
rightNames: NameSeqNode,
rootType: TypeNode,
descType: TypeNode];

-- the rootType and descType get filled in during closure
BuildNamedType: PUBLIC PROC[leftNames, rightNames: NameSeqNode] RETURNS[TypeNode] =
{RETURN[NEW[TypeNodeBody_[NEW[NamedTypeBody_[leftNames, rightNames, NIL]]]]]};

CloseNamedType: PROC[context: TypeContextNode, type: NamedType] =
BEGIN
type.rootType _ GetNamedType[context, type.rightNames.first.name];
type.descType _ type.rootType; -- there are no variant types yet
END;

GetNamedNode: PROC[type: NamedType] RETURNS[root, desc: TypeNode] =
{RETURN[type.rootType, type.descType]};

GetNamingNodeNamedNode: PUBLIC PROC[type: TypeNode] RETURNS[TypeNode] =
{RETURN[NARROW[type.info, NamedType].descType]};

GetNamingNodePrimaryName: PUBLIC PROC[type: TypeNode] RETURNS[NameNode] =
{RETURN[NARROW[type.info, NamedType].rightNames.first.name]};

GenNamingNodeRightNames: PUBLIC PROC[type: TypeNode, for: PROC[NameNode]] =
BEGIN
first: BOOLEAN _ TRUE;
filter: PROC[name: NameNode] =
{IF first THEN first _ FALSE ELSE for[name]};
GenNameSeq[NARROW[type.info, NamedType].rightNames, filter];
END;

GenNamingNodeLeftNames: PUBLIC PROC[type: TypeNode, for: PROC[NameNode]] =
{GenNameSeq[NARROW[type.info, NamedType].leftNames, for]};


-- enumerated types

EnumeratedType: TYPE = REF EnumeratedTypeBody;
EnumeratedTypeBody: TYPE = RECORD[
names: SEQUENCE nNames: CARDINAL OF NameNode];

BuildEnumeratedType: PUBLIC PROC[elements: ElementSeqNode] RETURNS[TypeNode] =
BEGIN
body: EnumeratedType _ NEW[EnumeratedTypeBody[CountElements[elements]]];
x:  CARDINAL _ 0;
SeeOneElement: PROC[name: NameNode] =
{body.names[x] _ name; x _ x+1};
GenElements[elements, SeeOneElement];
IF x # body.nNames THEN ERROR; 
RETURN[NEW[TypeNodeBody_[body]]];
END;

GetEnumeratedSize: PUBLIC PROC[type: TypeNode] RETURNS[INT] =
{RETURN[NARROW[type.info, EnumeratedType].nNames]};

GenEnumeratedElements: PUBLIC PROC[type: TypeNode, for: PROC[NameNode]] =
BEGIN
info: EnumeratedType _ NARROW[type.info];
FOR x: CARDINAL IN [0..info.nNames) DO for[info.names[x]] ENDLOOP;
END;

-- record types

RecordType: TYPE = REF RecordTypeBody;
RecordTypeBody: TYPE = RECORD[
fieldVariety: FieldSeqVariety,
case: TypeGraphDef.RecordCase,
fields: SEQUENCE nFields: CARDINAL OF FieldCell]; -- the next field of FieldCell is consistent with this sequence !!

BuildRecordType: PUBLIC PROC[fields: FieldSeqNode] RETURNS[TypeNode] =
BEGIN
body: RecordType _ NEW[RecordTypeBody[CountFields[fields]]];
x:  CARDINAL _ 0;
SeeOneField: PROC[cell: FieldCell] =
BEGIN
IF x + 1 = body.nFields AND GetTypeNodeCase[cell.type] = seq
THEN body.case _ seq;
body.fields[x] _ cell;
body.fields[x] _ cell; x _ x+1;
END;
GenFieldCells[fields, SeeOneField];
IF x # body.nFields THEN ERROR; 
body.fieldVariety _ GetFieldVariety[fields];
RETURN[NEW[TypeNodeBody_[body]]];
END;

LocalGenRecordFields: PROC[type: RecordType, for: PROC[NameNode, TypeNode, --last-- BOOLEAN]] =
BEGIN
FOR x: CARDINAL IN [0..type.nFields) DO
for[type.fields[x].name, type.fields[x].type, (x+1)=type.nFields];
ENDLOOP;
END;

LocalGetRecordCase: PROC[type: RecordType] RETURNS[TypeGraphDef.RecordCase] =
{RETURN[type.case]};

LocalGetSeqFieldType: PROC[type: RecordType] RETURNS[TypeNode] =
BEGIN
IF type.case # seq THEN ERROR;
RETURN[type.fields[type.nFields-1].type];
END;

GenRecordFields: PUBLIC PROC[type: TypeNode, for: PROC[NameNode, TypeNode, --last-- BOOLEAN]] =
{LocalGenRecordFields[NARROW[type.info], for]};

GetRecordCase: PUBLIC PROC[type: TypeNode] RETURNS[TypeGraphDef.RecordCase] =
{RETURN[LocalGetRecordCase[NARROW[type.info]]]};

GetSeqFieldType: PUBLIC PROC[type: TypeNode] RETURNS[TypeNode] =
{RETURN[LocalGetSeqFieldType[NARROW[type.info]]]};

-- ref types

RefType: TYPE = REF RefTypeBody;
RefTypeBody: TYPE = RECORD[targetType: TypeNode];

BuildRefType: PUBLIC PROC[type: TypeNode] RETURNS[TypeNode] =
BEGIN
body: RefType _ NEW[RefTypeBody_[type]];
RETURN[NEW[TypeNodeBody_[body]]];
END;

LocalGetRefTypeTarget: PROC[type: RefType] RETURNS[TypeNode] =
{RETURN[type.targetType]};

GetRefTypeTarget: PUBLIC PROC[type: TypeNode] RETURNS[TypeNode] =
{RETURN[LocalGetRefTypeTarget[NARROW[type.info]]]};

-- ref any type

BuildRefAnyType: PUBLIC PROC RETURNS[TypeNode] =
BEGIN
anyRightNameSeq: NameSeqNode _ AppendToNameSeq[BuildEmptyNameSeq[], BuildRopeName["ANY"]];
anyTypeNode: TypeNode _ BuildNamedType[NIL, anyRightNameSeq];
RETURN[BuildRefType[anyTypeNode]]; 
END;

-- list type

ListType: TYPE = REF ListTypeBody;
ListTypeBody: TYPE = RECORD[valueType: TypeNode];

BuildListType: PUBLIC PROC[type: TypeNode] RETURNS[TypeNode] =
BEGIN
body: ListType _ NEW[ListTypeBody_[type]];
RETURN[NEW[TypeNodeBody_[body]]];
END;

LocalGetListTypeValue: PROC[type: ListType] RETURNS[TypeNode] =
{RETURN[type.valueType]};

GetListTypeValue: PUBLIC PROC[type: TypeNode] RETURNS[TypeNode] =
{RETURN[LocalGetListTypeValue[NARROW[type.info]]]};


-- sequence types (i.e. the sequence field occurring in record type)

SeqType: TYPE = REF SeqTypeBody;
SeqTypeBody: TYPE = RECORD[
countName: NameNode,
countType: TypeNode,
fieldType: TypeNode];

BuildSeqType: PUBLIC PROC[countName: NameNode, countType: TypeNode, fieldType: TypeNode] RETURNS[TypeNode] =
BEGIN
body: SeqType _ NEW[SeqTypeBody_[countName, countType, fieldType]];
RETURN[NEW[TypeNodeBody_[body]]];
END; 

LocalGetSeqTypeCountName: PROC[seq: SeqType] RETURNS[NameNode] =
{RETURN[seq.countName]};

LocalGetSeqTypeCountType: PROC[seq: SeqType] RETURNS[TypeNode] =
{RETURN[seq.countType]};

LocalGetSeqTypeFieldType: PROC[seq: SeqType] RETURNS[TypeNode] =
{RETURN[seq.fieldType]};

GetSeqTypeCountName: PUBLIC PROC[type: TypeNode] RETURNS[NameNode] =
{RETURN[LocalGetSeqTypeCountName[NARROW[type.info]]]};

GetSeqTypeCountType: PUBLIC PROC[type: TypeNode] RETURNS[TypeNode] =
{RETURN[LocalGetSeqTypeCountType[NARROW[type.info]]]};

GetSeqTypeFieldType: PUBLIC PROC[type: TypeNode] RETURNS[TypeNode] =
{RETURN[LocalGetSeqTypeFieldType[NARROW[type.info]]]};


-- built in type

BuiltInType: TYPE = REF BuiltInTypeBody;
BuiltInTypeBody: TYPE = RECORD[
name: NameNode,
case: TypeGraphDef.BuiltInTypeCase];

BuildBuiltInType: PROC[case: TypeGraphDef.BuiltInTypeCase, name, from, fcnDefFile, fcnImplFile: NameNode] RETURNS[TypeNode] =
BEGIN
body: BuiltInType _ NEW[BuiltInTypeBody_[name, case]];
RETURN[NEW[TypeNodeBody_[body, name, from, fcnDefFile, fcnImplFile]]];
END;

GetBuiltInTypeName: PUBLIC PROC[type: TypeNode] RETURNS[NameNode] =
{RETURN[NARROW[type.info, BuiltInType].name]};

GetBuiltInTypeCase: PUBLIC PROC[type: TypeNode] RETURNS[TypeGraphDef.BuiltInTypeCase] =
{RETURN[NARROW[type.info, BuiltInType].case]};

-- type contexts

TypeContextNode: TYPE = REF TypeContextNodeBody;
TypeContextNodeBody: PUBLIC TYPE = RECORD[
table: HashTable,
firstNamedType: TypeEntry,
lastNamedType: TypeEntry,
defFiles: NameSeqNode,
implFiles: NameSeqNode];

TypeEntry: TYPE = REF TypeEntryBody;
TypeEntryBody: TYPE = RECORD[
typeDefFileName: NameNode, -- if NIL, then a built in Cedar type??
fcnDefFileName: NameNode, -- if NIL, then don't build marshall routines
implFileName: NameNode, -- if NIL, then don't build marshall routines
allNames: NameSeqNode,
type: TypeNode,
next: TypeEntry -- in the namedTypes chain, NIL if not a named type
];

BuildEmptyTypeContext: PUBLIC PROC[defFileName: NameNode, implFileName: NameNode] RETURNS[TypeContextNode] =
BEGIN
context: TypeContextNode _ NEW[TypeContextNodeBody_[CreateHashTable[10], NIL, NIL, BuildEmptyNameSeq[], BuildEmptyNameSeq[]]];
RecordBuiltInType[context, Cardinal, "CARDINAL", NIL, defFileName, implFileName];
RecordBuiltInType[context, Int, "INT", NIL, defFileName, implFileName];
RecordBuiltInType[context, Boolean, "BOOLEAN", NIL, defFileName, implFileName];
RecordBuiltInType[context, Rope, "ROPE", "Rope", defFileName, implFileName];
RecordBuiltInType[context, Any, "ANY", NIL, defFileName, implFileName];
RecordBuiltInType[context, Bool, "BOOL", NIL, defFileName, implFileName];
RecordBuiltInType[context, Char, "CHAR", NIL, defFileName, implFileName];
RecordBuiltInType[context, Character, "CHARACTER", NIL, defFileName, implFileName];
RecordBuiltInType[context, Integer, "INTEGER", NIL, defFileName, implFileName];
RecordBuiltInType[context, Nat, "NAT", NIL, defFileName, implFileName];
RecordBuiltInType[context, Real, "REAL", NIL, defFileName, implFileName];
RecordBuiltInType[context, Word, "WORD", NIL, defFileName, implFileName];
RecordBuiltInType[context, Card, "CARD", "Basics", defFileName, implFileName];
RETURN[context];
END;

RecordBuiltInType: PROC[context: TypeContextNode, case: TypeGraphDef.BuiltInTypeCase, typeNameText: Rope.ROPE, typeDefFile: 
Rope.ROPE, fcnDefFile, fcnImplFile: NameNode _ NIL] =
BEGIN
name: NameNode _ BuildRopeName[typeNameText];
from: NameNode _ IF typeDefFile = NIL THEN NIL ELSE BuildRopeName[typeDefFile];
type: TypeNode _ BuildBuiltInType[case, name, from, fcnDefFile, fcnImplFile];
entry: TypeEntry _ NEW[TypeEntryBody_[from, fcnDefFile, fcnImplFile, NIL, type]];
MakeEntry[context.table, name, entry];
END;

<<declared as damaging its argument>>
FakeCopyContext: PUBLIC PROC[context: TypeContextNode] RETURNS[TypeContextNode] =
{RETURN[context]};

<<declared as damaging its argument>>
NoteDefFileName: PUBLIC PROC[context: TypeContextNode, name: NameNode] RETURNS[TypeContextNode] =
{context.defFiles _ AppendToNameSeq[context.defFiles, name]; RETURN[context]};

<<declared as damaging its argument>>
NoteImplFileName: PUBLIC PROC[context: TypeContextNode, name: NameNode] RETURNS[TypeContextNode] =
{context.implFiles _ AppendToNameSeq[context.implFiles, name]; RETURN[context]};


<<damages its context argument>>
RecordTypeDecl: PUBLIC PROC[context: TypeContextNode, typeDefFileName: NameNode, fcnDefFileName: NameNode, fcnImplFileName: 
NameNode, typeNames: NameSeqNode, type: TypeNode] RETURNS[TypeContextNode] =
BEGIN
entry: TypeEntry _ NIL;
MakeOneEntry: PROC[name: NameNode] =
BEGIN
IF entry = NIL THEN -- WE ONLY MAKE ONE ENTRY
BEGIN
entry _ NEW[TypeEntryBody_[typeDefFileName, fcnDefFileName, fcnImplFileName, CopyNameSeq[typeNames], type, NIL]];
type.name _ name;
type.allNames _ CopyNameSeq[typeNames];
MakeEntry[context.table, name, entry];
IF context.lastNamedType # NIL THEN context.lastNamedType.next _ entry ELSE context.firstNamedType _ entry;
context.lastNamedType _ entry;
END;
END;
type.defFile _ typeDefFileName;
type.fcnDefFile _ fcnDefFileName;
type.fcnImplFile _ fcnImplFileName;
GenNameSeq[typeNames, MakeOneEntry];
RETURN[context]
END;

GetNamedType: PUBLIC PROC[context: TypeContextNode, name: NameNode] RETURNS[TypeNode] =
{RETURN[NARROW[FindExistingEntry[context.table, name], TypeEntry].type]};

GetDefFileOfNamedType: PUBLIC PROC [context: TypeContextNode, name: NameNode] RETURNS[NameNode] =
{RETURN[NARROW[FindExistingEntry[context.table, name], TypeEntry].typeDefFileName]};

LookUpType: PUBLIC PROC[context: TypeContextNode, leftNames: NameSeqNode, rightNames: NameSeqNode] RETURNS[TypeNode] =
BEGIN
-- the only purpose allowed for dots (extended right names) is variant descrimination
-- we don't allow dots to see inside other defintion files, or opens 

rootType: TypeNode _ GetNamedType[context, rightNames.first.name]; 

-- at the  moment, we don't have variants
IF rightNames.last # rightNames.first THEN ERROR;
IF leftNames # NIL AND leftNames.first # NIL THEN ERROR;

RETURN[rootType];
END;

<<damages its argument>>
CloseTypeContext: PUBLIC PROC[context: TypeContextNode] RETURNS[TypeContextNode] =
BEGIN
-- this routine replaces symbolic references with the named nodes
-- and then makes a check for no cyclic type references 

CloseOneNode: PROC[node: TypeNode] =
BEGIN
IF node.onStackRefDepth # 0 THEN ERROR;
WITH node.info SELECT FROM
named: NamedType => CloseNamedType[context, named];
enum: EnumeratedType => RETURN;
record: RecordType =>
BEGIN
SeeOneField: PROC[name: NameNode, type: TypeNode, last: BOOLEAN] =
{CloseOneNode[type]};
LocalGenRecordFields[record, SeeOneField];
END;
ref: RefType => CloseOneNode[LocalGetRefTypeTarget[ref]];
list: ListType => CloseOneNode[LocalGetListTypeValue[list]];
seq: SeqType =>
BEGIN
CloseOneNode[LocalGetSeqTypeCountType[seq]];
CloseOneNode[LocalGetSeqTypeFieldType[seq]];
END;
builtIn: BuiltInType => RETURN;
ENDCASE => ERROR;
END;

SeeOneNodeA: PROC[info: REF ANY, name: NameNode] =
{CloseOneNode[NARROW[info, TypeEntry].type]};

SeeOneNodeB: PROC[info: REF ANY, name: NameNode] =
{CheckOneNodeForIllegalCycles[NARROW[info, TypeEntry].type]};

EnumerateHashTable[context.table, SeeOneNodeA];
EnumerateHashTable[context.table, SeeOneNodeB];

RETURN[context];
END;

GenRootTypeNames: PUBLIC PROC[context: TypeContextNode, for: PROC[NameNode]] =
BEGIN
SeeOneNode: PROC[info: REF ANY, name: NameNode] =
{for[name]};
EnumerateHashTable[context.table, SeeOneNode];
END;

GenDefFileNames: PUBLIC PROC[context: TypeContextNode, for: PROC[NameNode]] =
{GenNameSeq[context.defFiles, for]};

GenImplFileNames: PUBLIC PROC[context: TypeContextNode, for: PROC[NameNode]] =
{GenNameSeq[context.implFiles, for]};

GenNamedTypes: PUBLIC PROC[context: TypeContextNode, for: PROC[TypeNode]] =
BEGIN
FOR entry: TypeEntry _ context.firstNamedType, entry.next WHILE entry # NIL DO
for[entry.type];
IF entry = context.lastNamedType THEN EXIT;
ENDLOOP;
END;

-- general type graph mechanisms

visitNumber: INT _ 0;

<<assumes that visitNumber+1 has not been used and is not in the graph>>
<<also assumes that onStackRefDepth = 0 on all nodes>>
<<runs over the whole accessable graph from each named type, I should fix this>>
CheckOneNodeForIllegalCycles: PROC[node: TypeNode] =
BEGIN
thisVisit: INT _ visitNumber + 1;

VisitOneNode: PROC[m: TypeNode, onStackRefDepth: CARDINAL] =
BEGIN
IF m.visitNumber = thisVisit THEN
BEGIN
IF m.onStackRefDepth = onStackRefDepth THEN ERROR;
RETURN;
END;
m.visitNumber _ thisVisit;
m.onStackRefDepth _ onStackRefDepth;
WITH m.info SELECT FROM
named: NamedType => VisitOneNode[GetNamedNode[named].root, onStackRefDepth];
enum: EnumeratedType => NULL;
record: RecordType =>
BEGIN
SeeOneField: PROC[name: NameNode, type: TypeNode, last: BOOLEAN] =
{VisitOneNode[type, onStackRefDepth]};
LocalGenRecordFields[record, SeeOneField];
END;
ref: RefType => VisitOneNode[LocalGetRefTypeTarget[ref], onStackRefDepth+1];
list: ListType => VisitOneNode[LocalGetListTypeValue[list], onStackRefDepth+1];
seq: SeqType =>
BEGIN
VisitOneNode[LocalGetSeqTypeCountType[seq], onStackRefDepth+1];
VisitOneNode[LocalGetSeqTypeFieldType[seq], onStackRefDepth+1];
END;
builtIn: BuiltInType => NULL;
ENDCASE => ERROR;
m.onStackRefDepth _ 0;
END;

visitNumber _ visitNumber + 1;
VisitOneNode[node, 1];
END;


-- hash table mechanism

HashKey: PROC[text: Rope.ROPE] RETURNS[INT] =
BEGIN
key: INT _ 0;
FOR x: INT IN [0..Rope.Length[text]) DO
key _ key + (x+1)*LOOPHOLE[Rope.Fetch[text, x]]
ENDLOOP;
RETURN[key]
END;

HashTable: TYPE = REF HashTableBody;
HashTableBody: PUBLIC TYPE = REF HashTableContents;
HashTableContents: TYPE = RECORD[
nItems: CARDINAL,
items: SEQUENCE size: CARDINAL OF HashTableEntry];

HashTableEntry: TYPE = REF HashTableEntryBody;
HashTableEntryBody: TYPE = RECORD[
name: NameNode,
info: REF ANY,
next: HashTableEntry];

FindEntry: PUBLIC PROC[table: HashTable, name: NameNode] RETURNS[REF ANY] =
BEGIN
key: INT _ name.key;
index: CARDINAL _ key MOD table.size;
FOR entry: HashTableEntry _ table.items[index], entry.next WHILE entry # NIL DO
IF entry.name.key = key AND Rope.Equal[entry.name.id.text, name.id.text] THEN RETURN[entry.info];
ENDLOOP;
RETURN[NIL];
END;

FindExistingEntry: PUBLIC PROC[table: HashTable, name: NameNode] RETURNS[REF ANY] =
BEGIN
info: REF ANY _ FindEntry[table, name];
IF info = NIL THEN ERROR ELSE RETURN[info];
END;

MakeEntry: PUBLIC PROC[table: HashTable, name: NameNode, info: REF ANY] =
BEGIN
entry: HashTableEntry _ FindOrMakeEntry[table, name];
IF entry.info # NIL THEN ERROR;
entry.info _ info;
END;

FindOrMakeEntry: PROC[table: HashTable, name: NameNode] RETURNS[HashTableEntry] =
BEGIN
key: INT _ name.key;
index: CARDINAL _ key MOD table.size;
newEntry: HashTableEntry;
FOR entry: HashTableEntry _ table.items[index], entry.next WHILE entry # NIL DO
IF entry.name.key = key AND Rope.Equal[entry.name.id.text, name.id.text] THEN RETURN[entry];
ENDLOOP;
newEntry _ NEW[HashTableEntryBody_[name, NIL, table.items[index]]];
table.items[index] _ newEntry;
table.nItems _ table.nItems + 1;
IF table.nItems > 2*table.size THEN RebuildTable[table];
RETURN[newEntry];
END;

CreateHashTable: PUBLIC PROC[size: CARDINAL] RETURNS[HashTable] =
BEGIN
htb: HashTableBody _ NEW[HashTableContents[size]];
htb.nItems _ 0;
FOR index: CARDINAL IN [0..size) DO htb.items[index] _ NIL ENDLOOP;
RETURN[NEW[HashTableBody_htb]];
END;

RebuildTable: PROC[table: HashTable] =
BEGIN
oldSize: CARDINAL _ table.size;
newSize: CARDINAL _ 2*oldSize;
newBody: HashTableBody _ NEW[HashTableContents[newSize]];
newBody.nItems _ table.nItems;
FOR index: CARDINAL IN [0..newSize) DO newBody.items[index] _ NIL ENDLOOP;
FOR index: CARDINAL IN [0..oldSize) DO
nextEntry: HashTableEntry _ table.items[index];
WHILE nextEntry # NIL DO
entry: HashTableEntry _ nextEntry;
index: INT _ entry.name.key MOD newSize;
nextEntry _ entry.next;
entry.next _ newBody.items[index];
newBody.items[index] _ entry;
ENDLOOP;
ENDLOOP;
table^ _ newBody;
END;

EnumerateHashTable: PUBLIC PROC[table: HashTable, for: PROC[info: REF ANY, name: NameNode]] =
BEGIN
FOR index: CARDINAL IN [0..table.size) DO
FOR entry: HashTableEntry _ table.items[index], entry.next WHILE entry # NIL DO
for[entry.info, entry.name];
ENDLOOP;
ENDLOOP;
END;

END..