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