-- 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]};

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]};

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;

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]]};

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;

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;

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;

FakeCopyContext: PUBLIC PROC[context: TypeContextNode] RETURNS[TypeContextNode] =
{RETURN[context]};

NoteDefFileName: PUBLIC PROC[context: TypeContextNode, name: NameNode] RETURNS[TypeContextNode] =
{context.defFiles _ AppendToNameSeq[context.defFiles, name]; RETURN[context]};

NoteImplFileName: PUBLIC PROC[context: TypeContextNode, name: NameNode] RETURNS[TypeContextNode] =
{context.implFiles _ AppendToNameSeq[context.implFiles, name]; RETURN[context]};


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;

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;

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..
>declared as not damaging arg, nor sharing arg
damages NameSeqNode argument
damages NameSeqNode argument
damages first argument
Damages fieldSeq1 argument, shares fieldSeq2 argument with result
damages fieldSeq argument
declared as damaging its argument
declared as damaging its argument
declared as damaging its argument
damages its context argument
damages its argument
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
�Ê	ȘJ˜7J˜*J˜˜	Jš
œ)˜)J˜,J˜>—J˜š
œP˜PJš
œ˜J˜J˜J˜J˜"˜#J˜J˜
—J˜J˜(˜%J˜J˜—J˜J˜(˜J˜J˜—J˜˜6J˜3—J˜˜=J˜J˜/J˜BJ˜7J˜—J˜˜?J˜R—J˜J˜=˜J™-—J˜MJ˜˜VJ˜)—J˜˜BJ˜J˜OJ˜KJ˜—J˜J˜D˜J™—˜YJ˜J˜8J˜IJ˜"J˜TJ˜J˜J˜—˜J™—˜YJ˜J˜8J˜IJ˜"J˜J˜J˜2J˜J˜—J˜˜>J˜J˜*˜"J˜)—J˜ J˜J˜—J˜˜=J˜J˜˜DJ˜J˜!J˜—J˜—J˜˜:J˜5—J˜˜J˜)J˜—J˜.J˜.J˜˜<J˜&—˜J™—˜iJ˜J˜1J˜J˜—J˜˜CJ˜"—J˜˜JJ˜—J˜J˜J˜J˜J˜"˜#J˜J˜)J˜KJ˜J˜JJ˜0J˜9J˜J˜J˜—J˜˜QJ˜˜!J˜J˜#J˜J˜J˜J˜J˜ J˜—J˜—J˜˜@J˜—J˜˜GJ˜—J˜˜FJ˜J˜—˜GJ˜—J˜˜FJ˜!—J˜J˜J˜˜J˜Y—J˜˜*J˜'J˜J˜J˜—J˜J˜:J˜J˜$˜J˜J˜J˜—J˜J˜J˜J˜FJ˜J˜˜_J˜J˜˜$J˜J˜7J˜LJ˜GJ˜—J˜"J˜J˜—˜J™A—˜WJ˜˜PJ˜—J˜CJ˜CJ˜4J˜&J˜ J˜J˜—˜J™—˜aJ˜J˜6J˜PJ˜+J˜$J˜J˜1J˜J˜J˜—J˜˜CJ˜J˜˜CJ˜
J˜"J˜—J˜—J˜˜=J˜7—J˜˜HJ˜=—J˜J˜:J˜J˜$˜J˜J˜J˜J˜—˜J˜9—˜SJ˜N—J˜˜AJ˜J˜BJ˜@J˜—J˜˜CJ˜'—J˜˜GJ˜0—J˜˜IJ˜=—J˜˜KJ˜J˜˜J˜-—J˜<J˜J˜—˜JJ˜:J˜—J˜J˜J˜J˜.˜"J˜.—J˜˜NJ˜J˜HJ˜˜%J˜ —J˜%J˜J˜!J˜—J˜˜=J˜3—J˜˜IJ˜J˜)J˜BJ˜—J˜J˜J˜J˜&˜J˜J˜J˜t—J˜˜FJ˜J˜<J˜˜$J˜˜<J˜—J˜J˜J˜—J˜#J˜ J˜,J˜!J˜—J˜˜_J˜˜'J˜BJ˜—J˜—J˜˜MJ˜—J˜˜@J˜J˜J˜)J˜—J˜˜_J˜/—J˜˜MJ˜0—J˜˜@J˜2—J˜J˜J˜J˜ J˜1J˜˜=J˜J˜(J˜!J˜—J˜˜>J˜—J˜˜AJ˜3—J˜J˜J˜˜0J˜J˜ZJ˜=J˜#J˜—J˜˜J˜—J˜"J˜1J˜˜>J˜J˜*J˜!J˜—J˜˜?J˜—J˜˜AJ˜3—J˜J˜J˜DJ˜J˜ ˜J˜J˜J˜—J˜˜lJ˜J˜CJ˜!J˜—J˜˜@J˜—J˜˜@J˜—J˜˜@J˜—J˜˜DJ˜6J˜—˜DJ˜6J˜—˜DJ˜6J˜—J˜J˜J˜J˜(˜J˜J˜$—J˜˜}J˜J˜6J˜FJ˜—J˜˜CJ˜.—J˜˜WJ˜.—J˜J˜J˜J˜0˜*J˜J˜J˜J˜J˜—J˜J˜$˜J˜BJ˜GJ˜EJ˜J˜J˜CJ˜—J˜˜lJ˜J˜~J˜QJ˜GJ˜OJ˜LJ˜GJ˜IJ˜IJ˜SJ˜OJ˜GJ˜IJ˜IJ˜NJ˜J˜—J˜˜±
J˜J˜-J˜OJ˜MJ˜QJ˜&J˜—˜J™!—˜QJ˜—˜J™!—˜aJ˜NJ˜J™!—˜bJ˜PJ˜—˜J™—˜È
J˜J˜˜$J˜˜-J˜J˜qJ˜J˜'J˜&J˜kJ˜J˜—J˜—J˜J˜!J˜#J˜$J˜J˜—J˜˜WJ˜I—J˜˜aJ˜T—J˜˜vJ˜J˜UJ˜EJ˜J˜CJ˜J˜)J˜1J˜8J˜J˜J˜—˜J™—˜RJ˜J˜AJ˜8J˜˜$J˜J˜'˜J˜3J˜˜J˜˜BJ˜—J˜*J˜—J˜9J˜<˜J˜J˜,J˜,J˜—J˜J˜—J˜—J˜˜2J˜-—J˜˜2J˜=—J˜J˜/J˜/J˜J˜J˜—J˜˜NJ˜˜1J˜—J˜.J˜—J˜˜MJ˜$—J˜˜NJ˜%—J˜˜KJ˜˜NJ˜J˜+J˜—J˜—J˜J˜ J˜J˜˜J™DJ™2Jšœ*Ïbœ
�™L—˜4J˜J˜!J˜˜<J˜˜!J˜J˜2J˜J˜—J˜J˜$˜J˜LJ˜˜J˜˜BJ˜&—J˜*J˜—J˜LJ˜O˜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˜3˜!J˜J˜2—J˜J˜.˜"J˜J˜J˜—J˜˜KJ˜J˜J˜%˜OJ˜aJ˜—J˜J˜—J˜˜SJ˜J˜'J˜+J˜—J˜˜IJ˜J˜5J˜J˜J˜J˜—˜QJ˜J˜J˜%J˜˜OJ˜\J˜—J˜CJ˜J˜ J˜8J˜J˜—J˜˜AJ˜J˜2J˜J˜CJ˜J˜—J˜˜&J˜J˜J˜J˜9J˜J˜J˜&J˜/˜J˜"J˜(J˜J˜"J˜J˜—J˜—J˜J˜—J˜˜]J˜˜)˜OJ˜J˜—J˜—J˜—J˜J˜——…—`ølþ