KipperCodeGenImpl: CEDAR PROGRAM IMPORTS Convert, FS, IO, Process, Rope, TypeGraphDef EXPORTS KipperCodeGen =
BEGIN OPEN KipperMain1Def, TypeGraphDef;
A Comment is in order:
why do I build a Cedar program to generate code, rather than generate code directly from the syntax, as is done in Casaba?
Answer: For two reasons. First, I may generate type graphs from other sources, rather than the current textual source. e.g., from loaded Cedar programs. Second, I eventually want to do complicated things, for example, generate kipperers that have a different external interface from that of the binary data. This will be useful for data bases which have changing internal format, but we want to reflect a constant external format. Or, for remote procedure interface where one side is changing, but not the other.
We begin with some code just to demonstrate that I understand the interface to type graphs (my own interface).
PrintTypeNodeContext: PUBLIC PROC[context: TypeContextNode, on: IO.STREAM] =
BEGIN
SeeOneName: PROC[name: NameNode] =
BEGIN
nameText: Rope.ROPE ← GetNameNodeInfo[name].text;
type: TypeNode ← GetNamedType[context, name];
from: NameNode ← GetDefFileOfNamedType[context, name];
fromText: Rope.ROPE ← GetNameNodeInfo[from].text;
case: TypeNodeCase ← GetTypeNodeCase[type];
IO.PutF[on, "%g: Type%g = ",
IO.rope[nameText],
IO.rope[IF fromText = NIL THEN "" ELSE Rope.Cat[" From ", fromText]]];
PrintTypeNodeData[type, 3, on];
END;
GenRootTypeNames[context, SeeOneName];
END;
PrintTypeNodeData: PROC[type: TypeNode, indent: CARDINAL, on: IO.STREAM] =
BEGIN
case: TypeNodeCase ← GetTypeNodeCase[type];
SELECT case FROM
naming => IO.PutF[on, "naming \"%g\"\N", IO.rope[FormNameRope[type]]];
enumerated => IO.PutF[on, "enumerated = {%g}\N", IO.rope[FormElementNames[type]]];
record =>
{IO.PutF[on, "record\N"]; PrintRecordFields[type, indent+3, on]};
ref => {IO.PutF[on, "ref "]; PrintTypeNodeData[GetRefTypeTarget[type], indent+3, on]};
any => IO.PutF[on, "any\N"];
list => {IO.PutF[on, "list of "]; PrintTypeNodeData[GetListTypeValue[type], indent+3, on]};
builtIn => IO.PutF[on, "builtIn\N"];
ENDCASE => ERROR;
END;
PrintRecordFields: PROC[type: TypeNode, indent: CARDINAL, on: IO.STREAM] =
BEGIN
PrintOneField: PROC[name: NameNode, type: TypeNode, last: BOOLEAN] =
BEGIN
PrintIndent[indent, on];
IO.PutF[on, "%g: ", IO.rope[GetNameNodeInfo[name].text]];
PrintTypeNodeData[type, indent+3, on];
END;
GenRecordFields[type, PrintOneField];
END;
FormNameRope: PROC[type: TypeNode] RETURNS[Rope.ROPE] =
BEGIN
rope: Rope.ROPE ← GetNameNodeInfo[GetNamingNodePrimaryName[type]].text;
SeeRightName: PROC[name: NameNode] =
{rope ← Rope.Cat[rope, ".", GetNameNodeInfo[name].text]};
SeeLeftName: PROC[name: NameNode] =
{rope ← Rope.Cat[GetNameNodeInfo[name].text, " ", rope]};
GenNamingNodeRightNames[type, SeeRightName];
GenNamingNodeLeftNames[type, SeeLeftName];
RETURN[rope];
END;
FormElementNames: PROC[type: TypeNode] RETURNS[Rope.ROPE] =
BEGIN
rope: Rope.ROPE ← NIL;
SeeOneName: PROC[name: NameNode] =
BEGIN
IF rope # NIL THEN rope ← Rope.Cat[rope, ", "];
rope ← Rope.Cat[rope, GetNameNodeInfo[name].text];
END;
GenEnumeratedElements[type, SeeOneName];
RETURN[rope];
END;
PrintIndent: PROC[indent: CARDINAL, on: IO.STREAM] =
{FOR I: CARDINAL IN [0..indent) DO IO.PutF[on, " "] ENDLOOP};
Remark: December 11, 1985 9:58:46 am PST (Sturgis)
basic marshaling has been working for a day, and I have decided to greatly simplify
before adding the other features (e.g. lists)
In the new mechanism, all code will be embedded in procedures with REF (or LIST) arguments or results. All intermediate expressions will either be the ref itself, or are to be treated as field specifications within the target record. (The ref is a field specification for the whole record.) This should GREATLY simplify the case analysis that occurs.
For the moment, I will construct kipper and unkipper procedures for each named ref and each named record. The procedures constructed for the named records will assume ref argument or result. Later, I will put in a filter so that only one pair of these gets constructed for each record type.
GeneratorContext: TYPE = REF GeneratorContextBody;
GeneratorContextBody: TYPE = RECORD[
defFiles: HashTable,
implFiles: HashTable,
kipperedTypes: HashTable,
functions: HashTable,
workList: WorkCell,
refAnyWorkCell: WorkCell];
KipperedTypeEntry: TYPE = REF KipperedTypeEntryBody;
KipperedTypeEntryBody: TYPE = RECORD[
type: TypeNode,
fnNames: ARRAY KipperContext OF RECORD[
kipperFunctionName: NameNode,
unKipperFunctionName: NameNode]];
FunctionEntry: TYPE = REF FunctionEntryBody;
FunctionEntryBody: TYPE = RECORD[
defFile: NameNode,
implFile: NameNode];
WorkCell: TYPE = REF WorkCellBody;
WorkCellBody: TYPE = RECORD[
type: TypeNode,
mcontext: KipperContext,
next: WorkCell];
KipperContext: TYPE = {self, refTarget, listTarget};
KipperUnKipper: TYPE = {kipper, unKipper};
FieldExpCase: TYPE = {localVal, ref, list, shortField, longField};
This describes an accompanying "exp" and an accompanying "Type"
ref when expression is of type "REF Type"
list when expression is of type "LIST Type"
localVal for any local arg or variable that is "Type"
shortField means its a field expression, for which @(expression) leads to a "SHORT POINTER TO Type"
longField means its a field expression, for which @(expression) leads to a "LONG POINTER TO Type", or sometimes expression is a "LIST OF something".
FormValExp: PROC[exp: Rope.ROPE, case: FieldExpCase] RETURNS[Rope.ROPE] =
BEGIN
RETURN[SELECT case FROM
ref => Rope.Cat["(", exp, "^)"],
list => ERROR,
localVal, shortField, longField => exp,
ENDCASE => ERROR];
this is what happens for "exp.field"
FormSubFieldCase: PROC[case: FieldExpCase] RETURNS[FieldExpCase] =
BEGIN
RETURN[SELECT case FROM
ref, list, longField => longField,
shortField => shortField,
localVal => ERROR,
ENDCASE => ERROR];
END;
BuildFilesFromContext: PUBLIC PROC[context: TypeContextNode, ReportStream: IO.STREAM] =
BEGIN
gContext: GeneratorContext ← NEW[GeneratorContextBody];
PrepareOneImplFile: PROC[fileName: NameNode] =
BEGIN
implFileCode: Code ← BuildEmptyCode[context, fileName, impl];
RecordCedarTypeUse[implFileCode, "RawBytes", "Basics"];
RecordCedarTypeUse[implFileCode, "STREAM", "IO"];
RecordCedarProcUse[implFileCode, "UnsafePutBlock", "IO"];
RecordCedarProcUse[implFileCode, "UnsafeGetBlock", "IO"];
RecordCedarTypeUse[implFileCode, "Kipperer", "KipperSupport"];
RecordCedarTypeUse[implFileCode, "UnKipperer", "KipperSupport"];
MakeEntry[gContext.implFiles, fileName, implFileCode];
END;
PrepareOneDefFile: PROC[fileName: NameNode] =
BEGIN
defFileCode: Code ← BuildEmptyCode[context, fileName, def];
DeclareAType: PROC[type: TypeNode] =
BEGIN
IF EqualNames[GetTypeNodeTypeDefFile[type], fileName] THEN
BEGIN
case: TypeNodeCase ← GetTypeNodeCase[type];
SELECT case FROM
ref, list, enumerated, record, naming =>
InstallNamedTypeDecl[defFileCode, type];
builtIn, any => NULL;
ENDCASE => ERROR;
END;
END;
RecordCedarTypeUse[defFileCode, "Kipperer", "KipperSupport"];
RecordCedarTypeUse[defFileCode, "UnKipperer", "KipperSupport"];
GenNamedTypes[context, DeclareAType];
MakeEntry[gContext.defFiles, fileName, defFileCode];
END;
PutNamedRefOrListTypeOnWorkList: PROC[type: TypeNode] =
BEGIN
case: TypeNodeCase ← GetTypeNodeCase[type];
SELECT case FROM
list, ref => [] ← AddTypeToWorkList[gContext, type, self, kipper];
naming, enumerated, builtIn, record => NULL;
ENDCASE => ERROR;
END;
ConditionalPutRecordTypeOnOnWorkList: PROC[type: TypeNode] =
BEGIN
case: TypeNodeCase ← GetTypeNodeCase[type];
SELECT case FROM
record =>
BEGIN
name: NameNode ← GetTypeNodeName[type];
-- perhaps already covered by a named ref
IF FindEntry[gContext.kipperedTypes, name] = NIL THEN
BEGIN -- no, not already covered
[] ← AddTypeToWorkList[gContext, type, refTarget, kipper];
END;
END;
naming, enumerated, builtIn, list, ref => NULL;
ENDCASE => ERROR;
END;
-- initialize the generator context
gContext.defFiles ← CreateHashTable[5];
gContext.implFiles ← CreateHashTable[5];
gContext.kipperedTypes ← CreateHashTable[5];
gContext.functions ← CreateHashTable[5];
gContext.workList ← NIL;
-- now initialize code for the output files
GenImplFileNames[context, PrepareOneImplFile];
GenDefFileNames[context, PrepareOneDefFile];
-- put named ref and list types on the work list
GenNamedTypes[context, PutNamedRefOrListTypeOnWorkList];
-- now add named record types which are not the target of named ref types
GenNamedTypes[context, ConditionalPutRecordTypeOnOnWorkList];
-- now do the work
WHILE gContext.workList # NIL DO
cell: WorkCell ← gContext.workList;
gContext.workList ← cell.next;
-- watch out for ref any, and do it last
-- so that all ref types will be known
IF GetTypeNodeCase[cell.type] = builtIn AND GetBuiltInTypeCase[cell.type] = Any THEN
BEGIN
IF gContext.refAnyWorkCell # NIL THEN ERROR;
gContext.refAnyWorkCell ← cell;
cell.next ← NIL;
END
ELSE GenCodeForOneProcPair[gContext, cell.type, cell.mcontext]
ENDLOOP;
IF gContext.refAnyWorkCell # NIL THEN
GenCodeForOneProcPair[gContext, gContext.refAnyWorkCell.type, gContext.refAnyWorkCell.mcontext];
-- finally, its time to put out the files
BEGIN
PutOutOneDefFile: PROC[codeRef: REF ANY, name: NameNode] =
BEGIN
code: Code ← NARROW[codeRef];
fullFileNameText: Rope.ROPE ← Rope.Cat[GetNameNodeInfo[name].text, ".mesa"];
fileStream: IO.STREAM ← FS.StreamOpen[fullFileNameText, create];
ShowCode[code, fileStream];
IO.Close[fileStream];
IO.PutF[ReportStream, "\Ndefinitions written on %g\N", IO.rope[fullFileNameText]];
Process.Pause[Process.SecondsToTicks[2]]; -- make sure next not same create date
END;
PutOutOneImplFile: PROC[codeRef: REF ANY, name: NameNode] =
BEGIN
code: Code ← NARROW[codeRef];
fullFileNameText: Rope.ROPE ← Rope.Cat[GetNameNodeInfo[name].text, ".mesa"];
fileStream: IO.STREAM ← FS.StreamOpen[fullFileNameText, create];
ShowCode[code, fileStream];
IO.Close[fileStream];
IO.PutF[ReportStream, "\Nimplementation written on %g\N", IO.rope[fullFileNameText]];
Process.Pause[Process.SecondsToTicks[2]]; -- make sure next not same create date
END;
EnumerateHashTable[gContext.defFiles, PutOutOneDefFile];
EnumerateHashTable[gContext.implFiles, PutOutOneImplFile];
END;
END;
AddTypeToWorkList: PROC[gContext: GeneratorContext, type: TypeNode, mContext: KipperContext, mm: KipperUnKipper] RETURNS[NameNode] =
BEGIN
typeName: NameNode ← GetTypeNodeName[type];
kipperEntry: KipperedTypeEntry ← NARROW[FindEntry[gContext.kipperedTypes, typeName]];
IF kipperEntry = NIL THEN
BEGIN
kipperEntry ← NEW[KipperedTypeEntryBody];
kipperEntry.type ← type;
MakeEntry[gContext.kipperedTypes, typeName, kipperEntry];
END;
IF kipperEntry.fnNames[mContext].kipperFunctionName = NIL THEN
BEGIN -- not currently on the work list
final: Rope.ROPE ← SELECT mContext FROM
self => "",
refTarget => "Ref",
listTarget => "List",
ENDCASE => ERROR;
cell: WorkCell ← NEW[WorkCellBody←[type, mContext, gContext.workList]];
kipperFnName: NameNode ← BuildRopeName[Rope.Cat["Kipper", GetNameNodeInfo[typeName].text, final]];
unKipperFnName: NameNode ← BuildRopeName[Rope.Cat["UnKipper", GetNameNodeInfo[typeName].text, final]];
defFileName: NameNode ← GetTypeNodeFcnDefFile[type];
implFileName: NameNode ← GetTypeNodeFcnImplFile[type];
kipperEntry.fnNames[mContext].kipperFunctionName ← kipperFnName;
kipperEntry.fnNames[mContext].unKipperFunctionName ← unKipperFnName;
gContext.workList ← cell;
AddFunctionInfo[gContext, kipperFnName, defFileName, implFileName];
AddFunctionInfo[gContext, unKipperFnName, defFileName, implFileName];
END;
RETURN[IF mm = kipper THEN kipperEntry.fnNames[mContext].kipperFunctionName ELSE kipperEntry.fnNames[mContext].unKipperFunctionName];
END;
this procedure is used by the code that generates the refany kipper and unkipper procedures
GenKipperedTypes: PROC[gContext: GeneratorContext, marshUnMarsh: KipperUnKipper, for: PROC[TypeNode, KipperContext, NameNode]] =
BEGIN
SeeOneKipperedType: PROC[ref: REF ANY, name: NameNode] =
BEGIN
entry: KipperedTypeEntry ← NARROW[ref];
FOR mc: KipperContext IN KipperContext DO
IF entry.fnNames[mc].kipperFunctionName # NIL THEN
SELECT marshUnMarsh FROM
kipper => for[entry.type, mc, entry.fnNames[mc].kipperFunctionName];
unKipper => for[entry.type, mc, entry.fnNames[mc].unKipperFunctionName];
ENDCASE => ERROR;
ENDLOOP;
END;
EnumerateHashTable[gContext.kipperedTypes, SeeOneKipperedType];
END;
AddFunctionInfo: PROC[gContext: GeneratorContext, fnName: NameNode, defFile: NameNode, implFile: NameNode] =
BEGIN
entry: FunctionEntry ← NEW[FunctionEntryBody←[defFile, implFile]];
MakeEntry[gContext.functions, fnName, entry];
END;
GetFunctionInfo: PROC[gContext: GeneratorContext, fnName: NameNode] RETURNS[defFile: NameNode, implFile: NameNode] =
BEGIN
entry: FunctionEntry ← NARROW[FindEntry[gContext.functions, fnName]];
RETURN[entry.defFile, entry.implFile];
END;
GenCodeForOneProcPair: PROC[gContext: GeneratorContext, type: TypeNode, mContext: KipperContext] =
BEGIN
typeNameText: Rope.ROPE ← GetNameNodeInfo[GetTypeNodeName[type]].text;
varName: Rope.ROPE ← SELECT mContext FROM
self => Rope.Cat[typeNameText, "Val"],
refTarget => Rope.Cat[typeNameText, "Ref"],
listTarget => Rope.Cat[typeNameText, "List"],
ENDCASE => ERROR;
varType: Rope.ROPE ← SELECT mContext FROM
self => typeNameText,
refTarget => Rope.Cat["REF ", typeNameText],
listTarget => Rope.Cat["LIST OF ", typeNameText]
ENDCASE => ERROR;
kipperEntry: KipperedTypeEntry ← NARROW[FindEntry[gContext.kipperedTypes, GetTypeNodeName[type]]];
kipperFnName: NameNode ← kipperEntry.fnNames[mContext].kipperFunctionName;
unKipperFnName: NameNode ← kipperEntry.fnNames[mContext].unKipperFunctionName;
defFileName: NameNode; implFileName: NameNode;
defFileCode: Code; implFileCode: Code;
[defFileName, implFileName] ← GetFunctionInfo[gContext, kipperFnName];
defFileCode ← NARROW[FindEntry[gContext.defFiles, defFileName]];
implFileCode ← NARROW[FindEntry[gContext.implFiles, implFileName]];
-- add the proc declarations to the def file
AppendRopeCodeStatement[defFileCode, Rope.Cat[
Rope.Cat[
GetNameNodeInfo[kipperFnName].text,
": PROC[kipperer: Kipperer, ",
varName],
Rope.Cat[
": ",
varType,
"];"]]];
AppendRopeCodeStatement[defFileCode, Rope.Cat[
Rope.Cat[
GetNameNodeInfo[unKipperFnName].text,
": PROC[unKipperer: UnKipperer] RETURNS[",
varName],
Rope.Cat[
": ",
varType,
"];"]]];
-- now add the implementations to the impl file
AppendOpenRopeCodeStatement[implFileCode, Rope.Cat[
Rope.Cat[
"\N\N",
GetNameNodeInfo[kipperFnName].text,
": PUBLIC PROC[kipperer: Kipperer,
", varName],
Rope.Cat[
": ",
varType,
"] = TRUSTED"]]];
AppendRopeCodeStatement[implFileCode, "BEGIN"];
AppendNeededProcVars[implFileCode];
-- now generate the code body, except that the body of KipperANYRef must be treated special
IF GetTypeNodeCase[type] = builtIn AND GetBuiltInTypeCase[type] = Any THEN
BEGIN -- this is the KipperANYRef case
IF mContext # refTarget THEN ERROR;
KipperABuiltIn[gContext, implFileCode, type, varName, ref];
END
ELSE
BEGIN
SELECT mContext FROM
self => GenKipperCodeForAType[gContext, implFileCode, type, varName, localVal];
refTarget => KipperARef[gContext, implFileCode, type, varName, localVal];
listTarget => KipperAList[gContext, implFileCode, type, varName, localVal];
ENDCASE => ERROR;
END;
AppendClosingRopeCodeStatement[implFileCode, "END;"];
AppendOpenRopeCodeStatement[implFileCode,
Rope.Cat[
Rope.Cat[
"\N\N",
GetNameNodeInfo[unKipperFnName].text,
": PUBLIC PROC[unKipperer: UnKipperer] RETURNS[",
varName],
Rope.Cat[
": ",
varType,
"] = TRUSTED"]]];
AppendRopeCodeStatement[implFileCode, "BEGIN"];
AppendNeededProcVars[implFileCode];
-- now generate the code body, except that the body of UnKipperANYRef must be treated special
IF GetTypeNodeCase[type] = builtIn AND GetBuiltInTypeCase[type] = Any THEN
BEGIN
IF mContext # refTarget THEN ERROR;
UnKipperABuiltIn[gContext, implFileCode, type, varName, ref];
END
ELSE
BEGIN
SELECT mContext FROM
self => GenUnKipperCodeForAType[gContext, implFileCode, type, varName, localVal];
refTarget => UnKipperARef[gContext, implFileCode, type, varName, localVal];
listTarget => UnKipperAList[gContext, implFileCode, type, varName, localVal];
ENDCASE => ERROR;
END;
AppendClosingRopeCodeStatement[implFileCode, "END;"];
-- finally, record info needed to construct file headers
RecordNamedTypeUse[defFileCode, type];
RecordNamedTypeUse[implFileCode, type];
RecordFunctionExport[implFileCode, gContext, kipperFnName];
RecordFunctionExport[implFileCode, gContext, unKipperFnName];
END;
InstallNamedTypeDecl: PROC[code: Code, type: TypeNode] =
BEGIN
someNamesSeen: BOOLEAN ← FALSE;
nameRope: Rope.ROPE ← NIL;
SeeOneName: PROC[name: NameNode] =
BEGIN
IF someNamesSeen THEN nameRope ← Rope.Cat[nameRope, ", "] ELSE someNamesSeen ← TRUE;
nameRope ← Rope.Cat[nameRope, GetNameNodeInfo[name].text];
END;
GenAllNamesForType[type, SeeOneName];
IF NOT someNamesSeen THEN ERROR;
AppendRopeCodeStatement[code, Rope.Cat[nameRope, ": TYPE = "]];
InstallTypeConstDecl[code, type];
ExtendRopeCodeStatement[code, ";"];
END;
InstallTypeConstDecl: PROC[code: Code, type: TypeNode] =
BEGIN
case: TypeNodeCase ← GetTypeNodeCase[type];
SELECT case FROM
naming => -- WARNING has to be fixed up for variant records
BEGIN
targetType: TypeNode ← GetNamingNodeNamedNode[type];
ExtendRopeCodeStatement[code, GetNameNodeInfo[GetTypeNodeName[targetType]].text];
RecordNamedTypeUse[code, targetType];
-- ExtendRopeCodeStatement[code, Rope.Cat[" ",GetNameNodeInfo[GetNamingNodePrimaryName[type]].text]];
END;
enumerated =>
BEGIN
someElementsSeen: BOOLEAN ← FALSE;
SeeOneElement: PROC[elementName: NameNode] =
BEGIN
IF someElementsSeen THEN ExtendRopeCodeStatement[code, ", "]
ELSE someElementsSeen ← TRUE;
ExtendRopeCodeStatement[code, GetNameNodeInfo[elementName].text];
END;
ExtendRopeCodeStatement[code, "{"];
GenEnumeratedElements[type, SeeOneElement];
ExtendRopeCodeStatement[code, "}"];
END;
record =>
BEGIN
someFieldsSeen: BOOLEAN ← FALSE;
SeeOneField: PROC[fieldName: NameNode, fieldType: TypeNode, last: BOOLEAN] =
BEGIN
IF someFieldsSeen THEN ExtendRopeCodeStatement[code, ","]
ELSE someFieldsSeen ← TRUE;
AppendRopeCodeStatement[code,
Rope.Cat[GetNameNodeInfo[fieldName].text, ": "]];
InstallTypeConstDecl[code, fieldType];
END;
ExtendOpenRopeCodeStatement[code, "RECORD["];
GenRecordFields[type, SeeOneField];
ExtendClosingRopeCodeStatement[code, "]"];
END;
ref =>
BEGIN
ExtendRopeCodeStatement[code, "REF "];
InstallTypeConstDecl[code, GetRefTypeTarget[type]];
END;
any => ExtendRopeCodeStatement[code, "ANY"];
list =>
BEGIN
ExtendRopeCodeStatement[code, "LIST OF "];
InstallTypeConstDecl[code, GetListTypeValue[type]];
END;
seq => -- SEQUENCE field in a record constructor
BEGIN
ExtendRopeCodeStatement[code, "SEQUENCE "];
ExtendRopeCodeStatement[code, GetNameNodeInfo[GetSeqTypeCountName[type]].text];
ExtendRopeCodeStatement[code, ": "];
InstallTypeConstDecl[code, GetSeqTypeCountType[type]];
ExtendRopeCodeStatement[code, " OF "];
InstallTypeConstDecl[code, GetSeqTypeFieldType[type]];
END;
builtIn => ERROR;
ENDCASE => ERROR;
END;
InstallNameOrTypeConstructor: PROC[code: Code, type: TypeNode] =
BEGIN
name: NameNode ← GetTypeNodeName[type];
IF name # NIL THEN ExtendRopeCodeStatement[code, GetNameNodeInfo[name].text]
ELSE InstallTypeConstDecl[code, type];
END;
AppendNeededProcVars: PROC[code: Code] =
BEGIN
AppendRopeCodeStatement[code, ""];
AppendRopeCodeStatement[code, "word: CARDINAL ← 0;"];
AppendRopeCodeStatement[code, "doubleWord: LONG CARDINAL ← 0;"];
AppendRopeCodeStatement[code, "refAny: REF ANY ← NIL;"];
AppendRopeCodeStatement[code, "flag: BOOLEAN ← FALSE;"];
AppendRopeCodeStatement[code, ""];
END;
GetUltimateTargetType: PROC[type: TypeNode] RETURNS[TypeNode] =
BEGIN-- only valid for REF and LIST types
case: TypeNodeCase ← GetTypeNodeCase[type];
targetType: TypeNode ← SELECT case FROM
ref => GetRefTypeTarget[type],
list => GetListTypeValue[type],
ENDCASE => ERROR;
WHILE GetTypeNodeCase[targetType] = naming DO
targetType ← GetNamingNodeNamedNode[targetType]
ENDLOOP;
RETURN[targetType];
END;
GetFinalNamedType: PROC[type: TypeNode] RETURNS[TypeNode] =
BEGIN
finalType: TypeNode ← type;
WHILE GetTypeNodeCase[finalType] = naming DO
finalType ← GetNamingNodeNamedNode[finalType]
ENDLOOP;
RETURN[finalType];
END;
This procedure gets called by some generator, for example, to handle a field in a record
When exp is placed in a right side environment it produces a value of type "type"
KipperAType: PROC[gContext: GeneratorContext, code: Code, type: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
case: TypeNodeCase ← GetTypeNodeCase[type];
valExp: Rope.ROPE ← FormValExp[exp, fieldCase];
SELECT case FROM
naming =>
KipperAType[gContext, code, GetNamingNodeNamedNode[type], exp, fieldCase];
enumerated, builtIn, record =>
GenKipperCodeForAType[gContext, code, type, exp, fieldCase];
ref, list =>
BEGIN
-- we would like to call a procedure for these guys if possible
-- it is only possible if they are namable, or the target type is .
IF GetTypeNodeName[type] # NIL THEN -- this one is namable
BEGIN
fnName: NameNode ← AddTypeToWorkList[gContext, type, self, kipper];
fnNameText: Rope.ROPE ← GetNameNodeInfo[fnName].text;
AppendRopeCodeStatement[code, Rope.Cat[fnNameText, "[kipperer, ", valExp, "];"]];
RecordFunctionCall[code, gContext, fnName];
END
ELSE -- can't be named, but perhaps the target type can be named or is ANY
BEGIN
targetType: TypeNode ← GetUltimateTargetType[type];
targetName: NameNode ← GetTypeNodeName[targetType];
IF GetTypeNodeCase[targetType] = builtIn AND GetBuiltInTypeCase[targetType] = Any THEN
BEGIN -- we are handling REF ANY
fnName: NameNode ← AddTypeToWorkList[gContext, targetType, refTarget, kipper];
fnNameText: Rope.ROPE ← GetNameNodeInfo[fnName].text;
AppendRopeCodeStatement[code, Rope.Cat[fnNameText, "[kipperer, ", valExp, "];"]];
END
ELSE IF targetName # NIL THEN
BEGIN -- target can be named
mContext: KipperContext ← SELECT case FROM
ref => refTarget,
list => listTarget,
ENDCASE => ERROR;
fnName: NameNode ← AddTypeToWorkList[gContext, targetType, mContext, kipper];
fnNameText: Rope.ROPE ← GetNameNodeInfo[fnName].text;
AppendRopeCodeStatement[code, Rope.Cat[fnNameText, "[kipperer, ", valExp, "];"]];
RecordFunctionCall[code, gContext, fnName];
END
ELSE
the target type was not namable
so, generate the expanded code
GenKipperCodeForAType[gContext, code, type, exp, fieldCase];
END;
END;
any => ERROR; -- can't happen
ENDCASE => ERROR;
END;
procedure gets called by some generator, for example, to handle a field in a record
When exp is placed in a left side environment it names a field of type "type"
It is assumed that this is a field in a REF context, e.g. within a record known by a REF.
UnKipperAType: PROC[gContext: GeneratorContext, code: Code, type: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
case: TypeNodeCase ← GetTypeNodeCase[type];
valExp: Rope.ROPE ← FormValExp[exp, fieldCase];
SELECT case FROM
naming =>
UnKipperAType[gContext, code, GetNamingNodeNamedNode[type], exp, fieldCase];
enumerated, builtIn, record =>
GenUnKipperCodeForAType[gContext, code, type, exp, fieldCase];
ref, list =>
BEGIN
-- we would like to call a procedure for these guys if possible
-- it is only possible if they are namable, or the target type either namable or ANY.
IF GetTypeNodeName[type] # NIL THEN -- this one is namable
BEGIN
fnName: NameNode ← AddTypeToWorkList[gContext, type, self, unKipper];
fnNameText: Rope.ROPE ← GetNameNodeInfo[fnName].text;
AppendRopeCodeStatement[code,
Rope.Cat[valExp, " ← ", fnNameText, "[unKipperer];"]];
RecordFunctionCall[code, gContext, fnName];
END
ELSE -- can't be named, but perhaps the target type can be named
BEGIN
targetType: TypeNode ← GetUltimateTargetType[type];
targetName: NameNode ← GetTypeNodeName[targetType];
IF GetTypeNodeCase[targetType] = builtIn AND GetBuiltInTypeCase[targetType] = Any THEN
BEGIN -- we are handling REF ANY
fnName: NameNode ← AddTypeToWorkList[gContext, targetType, refTarget, unKipper];
fnNameText: Rope.ROPE ← GetNameNodeInfo[fnName].text;
AppendRopeCodeStatement[code, Rope.Cat[valExp, " ← ", fnNameText, "[unKipperer];"]];
END
ELSE
IF targetName # NIL THEN
BEGIN -- target can be named
mContext: KipperContext ← SELECT case FROM
ref => refTarget,
list => listTarget,
ENDCASE => ERROR;
fnName: NameNode ← AddTypeToWorkList[gContext, targetType, mContext, unKipper];
fnNameText: Rope.ROPE ← GetNameNodeInfo[fnName].text;
AppendRopeCodeStatement[code, Rope.Cat[valExp, " ← ", fnNameText, "[unKipperer];"]];
RecordFunctionCall[code, gContext, fnName];
END
ELSE
the target type was not namable
so, generate the expanded code
GenUnKipperCodeForAType[gContext, code, type, exp, fieldCase];
END;
END;
any => ERROR; -- cant happen
ENDCASE;
END;
same comments apply here as apply to KipperAType
GenKipperCodeForAType: PROC[gContext: GeneratorContext, code: Code, type: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
case: TypeNodeCase ← GetTypeNodeCase[type];
SELECT case FROM
ref => KipperARef[gContext, code, GetRefTypeTarget[type], exp, fieldCase];
list => KipperAList[gContext, code, GetListTypeValue[type], exp, fieldCase];
record => KipperARecord[gContext, code, type, exp, fieldCase];
enumerated => KipperAnEnumType[gContext, code, type, exp, fieldCase];
builtIn => KipperABuiltIn[gContext, code, type, exp, fieldCase];
naming => ERROR; -- can't happen
ENDCASE => ERROR;
END;
same comments apply here as apply to UnKipperAType
GenUnKipperCodeForAType: PROC[gContext: GeneratorContext, code: Code, type: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
case: TypeNodeCase ← GetTypeNodeCase[type];
SELECT case FROM
ref => UnKipperARef[gContext, code, GetRefTypeTarget[type], exp, fieldCase];
list => UnKipperAList[gContext, code, GetListTypeValue[type], exp, fieldCase];
record => UnKipperARecord[gContext, code, type, exp, fieldCase];
enumerated => UnKipperAnEnumType[gContext, code, type, exp, fieldCase];
builtIn => UnKipperABuiltIn[gContext, code, type, exp, fieldCase];
naming => ERROR; -- can't happen
ENDCASE => ERROR;
END;
KipperARecord: PROC[gContext: GeneratorContext, code: Code, type: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
seq: BOOLEAN ← GetRecordCase[type] = seq;
subFieldCase: FieldExpCase ← FormSubFieldCase[fieldCase];
OneField: PROC[fieldName: NameNode, fieldType: TypeNode, last: BOOLEAN] =
BEGIN
fieldTextName: Rope.ROPE ← GetNameNodeInfo[fieldName].text;
IF seq AND last
THEN KipperASeq[gContext, code, fieldType, exp, fieldCase, fieldTextName]
ELSE KipperAType[gContext, code, fieldType, Rope.Cat["(", exp, ".", fieldTextName, ")"], subFieldCase];
END;
GenRecordFields[type, OneField];
END;
UnKipperARecord: PROC[gContext: GeneratorContext, code: Code, type: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
seq: BOOLEAN ← GetRecordCase[type] = seq;
subFieldCase: FieldExpCase ← FormSubFieldCase[fieldCase];
OneField: PROC[fieldName: NameNode, fieldType: TypeNode, last: BOOLEAN] =
BEGIN
fieldTextName: Rope.ROPE ← GetNameNodeInfo[fieldName].text;
IF seq AND last
THEN UnKipperASeq[gContext, code, fieldType, exp, fieldCase, fieldTextName]
ELSE UnKipperAType[gContext, code, fieldType, Rope.Cat["(", exp, ".", fieldTextName, ")"], subFieldCase];
END;
GenRecordFields[type, OneField];
END;
KipperASeq: PROC[gContext: GeneratorContext, code: Code, type: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase, fieldTextName: Rope.ROPE] =
BEGIN -- exp defines the record containing the seq field
subFieldCase: FieldExpCase ← FormSubFieldCase[fieldCase];
fieldExp: Rope.ROPE ← Rope.Cat["(", exp, ".", fieldTextName, "[I])"];
countFieldTextName: Rope.ROPE ← GetNameNodeInfo[GetSeqTypeCountName[type]].text;
countExp: Rope.ROPE ← Rope.Cat["(", exp, ".", countFieldTextName, ")"];
countFieldType: TypeNode ← GetSeqTypeCountType[type];
fieldType: TypeNode ← GetSeqTypeFieldType[type];
AppendRopeCodeStatement[code, "FOR I: "];
InstallNameOrTypeConstructor[code, countFieldType];
ExtendOpenRopeCodeStatement[code, Rope.Cat[" IN[0..", countExp, ") DO"]];
KipperAType[gContext, code, fieldType, fieldExp, subFieldCase];
AppendClosingRopeCodeStatement[code, "ENDLOOP;"];
END;
UnKipperASeq: PROC[gContext: GeneratorContext, code: Code, type: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase, fieldTextName: Rope.ROPE] =
BEGIN
subFieldCase: FieldExpCase ← FormSubFieldCase[fieldCase];
fieldExp: Rope.ROPE ← Rope.Cat["(", exp, ".", fieldTextName, "[I])"];
countFieldTextName: Rope.ROPE ← GetNameNodeInfo[GetSeqTypeCountName[type]].text;
countExp: Rope.ROPE ← Rope.Cat["(", exp, ".", countFieldTextName, ")"];
countFieldType: TypeNode ← GetSeqTypeCountType[type];
fieldType: TypeNode ← GetSeqTypeFieldType[type];
AppendRopeCodeStatement[code, "FOR I: "];
InstallNameOrTypeConstructor[code, countFieldType];
ExtendOpenRopeCodeStatement[code, Rope.Cat[" IN[0..", countExp, ") DO"]];
UnKipperAType[gContext, code, fieldType, fieldExp, subFieldCase];
AppendClosingRopeCodeStatement[code, "ENDLOOP;"];
END;
KipperAnEnumType: PROC[gContext: GeneratorContext, code: Code, type: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
I am currently using ORD and VAL. These are not expected to vary in Mimosa. It may be necessary at some future time to use arrays of values to handle compiler changes in the representation.
valExp: Rope.ROPE ← FormValExp[exp, fieldCase];
AppendRopeCodeStatement[code, Rope.Cat["word ← ORD[", valExp, "];"]];
KipperACardinal[gContext, code, "word", localVal];
END;
UnKipperAnEnumType: PROC[gContext: GeneratorContext, code: Code, type: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
See comments on KipperAnEnumType
valExp: Rope.ROPE ← FormValExp[exp, fieldCase];
UnKipperACardinal[gContext, code, "word", localVal];
AppendRopeCodeStatement[code, Rope.Cat[valExp, " ← VAL[word];"]];
END;
note that this takes the targetType as an argument
KipperARef: PROC[gContext: GeneratorContext, code: Code, targetType: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
first a one word flag, perhaps followed by more data
0 for body follows -- this agrees with Lupine "ref=NIL", when ref is non NIL.
1 for NIL -- this agrees with Lupine "ref=NIL", when ref is NIL.
2 for encoding as INT follows, assumes same ref was seen earlier
valExp: Rope.ROPE ← FormValExp[exp, fieldCase];
-- REF ANY must be treated different from other refs, since ANY is not a kipperable type.
finalTargetType: TypeNode ← GetFinalNamedType[targetType];
IF GetTypeNodeCase[finalTargetType] = builtIn AND GetBuiltInTypeCase[finalTargetType] = Any THEN
BEGIN -- we are handling REF ANY
-- generate a call on the global ref any kipper procedure
fnName: NameNode ← AddTypeToWorkList[gContext, finalTargetType, refTarget, kipper];
fnNameText: Rope.ROPE ← GetNameNodeInfo[fnName].text;
AppendRopeCodeStatement[code, Rope.Cat[fnNameText, "[kipperer, ", valExp, "];"]];
END
ELSE
BEGIN -- normal REF case.
seq: BOOLEAN ← GetTypeNodeCase[finalTargetType] = record AND GetRecordCase[finalTargetType] = seq;
AppendOpenRopeCodeStatement[code, Rope.Cat["IF KipperRef[kipperer, ", valExp, "] THEN "]];
AppendRopeCodeStatement[code, "BEGIN"];
IF seq THEN -- we must kipper the count
BEGIN
seqFieldCountType: TypeNode ← IF seq THEN GetSeqTypeCountType[GetSeqFieldType[finalTargetType]] ELSE NIL;
seqFieldCountName: NameNode ← IF seq THEN GetSeqTypeCountName[GetSeqFieldType[finalTargetType]] ELSE NIL;
SeqFieldCountNameText: Rope.ROPE ← GetNameNodeInfo[seqFieldCountName].text;
AppendRopeCodeStatement[code, "count: "];
InstallNameOrTypeConstructor[code, seqFieldCountType];
ExtendRopeCodeStatement[code, Rope.Cat[" ← ", valExp, ".", SeqFieldCountNameText, ";"]];
KipperAType[gContext, code, seqFieldCountType, "count", localVal];
END;
KipperAType[gContext, code, finalTargetType, valExp, ref];
AppendClosingRopeCodeStatement[code, "END;"];
RecordCedarProcUse[code, "KipperRef", "KipperSupport"];
END;
END;
note that this takes the targetType as an argument
UnKipperARef: PROC[gContext: GeneratorContext, code: Code, targetType: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
first a one word flag, perhaps followed by more data
0 for body follows -- this agrees with Lupine "ref=NIL", when ref is non NIL.
1 for NIL -- this agrees with Lupine "ref=NIL", when ref is NIL.
2 for encoding as INT follows, assumes same ref was seen earlier
the target type had better have a name
valExp: Rope.ROPE ← FormValExp[exp, fieldCase];
-- REF ANY must be treated different from other refs, since ANY is not a kipperable type.
finalTargetType: TypeNode ← GetFinalNamedType[targetType];
IF GetTypeNodeCase[finalTargetType] = builtIn AND GetBuiltInTypeCase[finalTargetType] = Any THEN
BEGIN -- we are handling REF ANY
-- generate a call on the global ref any unkipper procedure
fnName: NameNode ← AddTypeToWorkList[gContext, finalTargetType, refTarget, unKipper];
fnNameText: Rope.ROPE ← GetNameNodeInfo[fnName].text;
AppendRopeCodeStatement[code, Rope.Cat[valExp, " ← ", fnNameText, "[unKipperer];"]];
END
ELSE
BEGIN -- normal REF case.
seq: BOOLEAN ← GetTypeNodeCase[finalTargetType] = record AND GetRecordCase[finalTargetType] = seq;
seqFieldCountType: TypeNode ← IF seq THEN GetSeqTypeCountType[GetSeqFieldType[finalTargetType]] ELSE NIL;
AppendRopeCodeStatement[code, Rope.Cat["[flag, refAny] ← UnKipperRef[unKipperer];"]];
AppendOpenRopeCodeStatement[code, Rope.Cat["IF flag THEN"]];
AppendRopeCodeStatement[code, "BEGIN"];
IF seq THEN
BEGIN -- we must get the count
AppendRopeCodeStatement[code, "count: "];
InstallNameOrTypeConstructor[code, seqFieldCountType];
ExtendRopeCodeStatement[code, ";"];
UnKipperAType[gContext, code, seqFieldCountType, "count", localVal];
END;
AppendRopeCodeStatement[code, Rope.Cat["refAny ← NEW["]];
InstallNameOrTypeConstructor[code, finalTargetType];
IF seq THEN
{ExtendRopeCodeStatement[code, "[count]"]};
ExtendRopeCodeStatement[code, "];"];
AppendRopeCodeStatement[code, Rope.Cat["RecordUnKipperedRef[unKipperer, refAny];"]];
AppendRopeCodeStatement[code, Rope.Cat[valExp, " ← NARROW[refAny];"]];
UnKipperAType[gContext, code, finalTargetType, exp, ref];
AppendClosingRopeCodeStatement[code, "END"];
AppendOpenRopeCodeStatement[code, " ELSE"];
AppendClosingRopeCodeStatement[code, Rope.Cat[valExp, " ← NARROW[refAny];"]];
RecordCedarProcUse[code, "UnKipperRef", "KipperSupport"];
RecordCedarProcUse[code, "RecordUnKipperedRef", "KipperSupport"];
END;
END;
note that this takes the value type as an argument
KipperAList: PROC[gContext: GeneratorContext, code: Code, valueType: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
for each ref to a list cell
first a one word flag, perhaps followed by more data
this flag is designed to agree with Lupine "ref=NIL".
0 for body follows
1 for NIL
valExp: Rope.ROPE ← FormValExp[exp, fieldCase];
AppendOpenRopeCodeStatement[code, "FOR cell: LIST OF "];
InstallNameOrTypeConstructor[code, valueType];
ExtendRopeCodeStatement[code, Rope.Cat[" ← ", valExp, ", cell.rest WHILE cell # NIL DO"]];
AppendRopeCodeStatement[code, "word ← 0;"];
KipperACardinal[gContext, code, "word", localVal];
KipperAType[gContext, code, valueType, Rope.Cat["(cell.first)"], longField];
AppendClosingRopeCodeStatement[code, "ENDLOOP;"];
AppendRopeCodeStatement[code, "word ← 1;"];
KipperACardinal[gContext, code, "word", localVal];
END;
note that this takes the value type as an argument
UnKipperAList: PROC[gContext: GeneratorContext, code: Code, valueType: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
the value type had better have a name
valExp: Rope.ROPE ← FormValExp[exp, fieldCase];
ExtendOpenRopeCodeStatement[code, ""];
AppendRopeCodeStatement[code, "BEGIN"];
AppendRopeCodeStatement[code, "temp: "];
InstallNameOrTypeConstructor[code, valueType];
ExtendRopeCodeStatement[code, ";"];
AppendRopeCodeStatement[code, "first, last, current: LIST OF "];
InstallNameOrTypeConstructor[code, valueType];
ExtendRopeCodeStatement[code, " ← NIL;"];
UnKipperACardinal[gContext, code, "word", localVal];
AppendOpenRopeCodeStatement[code, "WHILE word = 0 DO"];
UnKipperAType[gContext, code, valueType, "temp", localVal];
AppendRopeCodeStatement[code, "current ← LIST[temp];"];
AppendRopeCodeStatement[code, "IF last = NIL THEN first ← current ELSE last.rest ← current;"];
AppendRopeCodeStatement[code, "last ← current;"];
UnKipperACardinal[gContext, code, "word", localVal];
AppendClosingRopeCodeStatement[code, "ENDLOOP;"];
AppendRopeCodeStatement[code, Rope.Cat[valExp, " ← first;"]];
AppendClosingRopeCodeStatement[code, "END;"];
END;
KipperABuiltIn: PROC[gContext: GeneratorContext, code: Code, type: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
case: BuiltInTypeCase ← GetBuiltInTypeCase[type];
SELECT case FROM
Cardinal => KipperACardinal[gContext, code, exp, fieldCase];
Int => KipperAnInt[gContext, code, exp, fieldCase];
Boolean => KipperABoolean[gContext, code, exp, fieldCase];
Rope => KipperARope[gContext, code, exp, fieldCase];
Any => KipperAnAny[gContext, code, type, exp, fieldCase];
Bool => KipperABoolean[gContext, code, exp, fieldCase];
Char => KipperAChar[gContext, code, exp, fieldCase];
Character => KipperAChar[gContext, code, exp, fieldCase];
Integer => KipperAnInteger[gContext, code, exp, fieldCase];
Nat => KipperANat[gContext, code, exp, fieldCase];
Real => KipperAReal[gContext, code, exp, fieldCase];
Word => KipperAWord[gContext, code, exp, fieldCase];
Card => KipperACard[gContext, code, exp, fieldCase];
ENDCASE => ERROR;
END;
UnKipperABuiltIn: PROC[gContext: GeneratorContext, code: Code, type: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
case: BuiltInTypeCase ← GetBuiltInTypeCase[type];
SELECT case FROM
Cardinal => UnKipperACardinal[gContext, code, exp, fieldCase];
Int => UnKipperAnInt[gContext, code, exp, fieldCase];
Boolean => UnKipperABoolean[gContext, code, exp, fieldCase];
Rope => UnKipperARope[gContext, code, exp, fieldCase];
Any => UnKipperAnAny[gContext, code, type, exp, fieldCase];
Bool => UnKipperABoolean[gContext, code, exp, fieldCase];
Char => UnKipperAChar[gContext, code, exp, fieldCase];
Character => UnKipperAChar[gContext, code, exp, fieldCase];
Integer => UnKipperAnInteger[gContext, code, exp, fieldCase];
Nat => UnKipperANat[gContext, code, exp, fieldCase];
Real => UnKipperAReal[gContext, code, exp, fieldCase];
Word => UnKipperAWord[gContext, code, exp, fieldCase];
Card => UnKipperACard[gContext, code, exp, fieldCase];
ENDCASE => ERROR;
END;
assumes that exp is an expression of type CARDINAL
KipperACardinal: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
{KipperOneWord[gContext, code, exp, fieldCase]};
UnKipperACardinal: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
{UnKipperOneWord[gContext, code, exp, fieldCase]};
assumes that exp is an expression of type INT.
KipperAnInt: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
{KipperDoubleWord[gContext, code, exp, fieldCase]};
UnKipperAnInt: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
{UnKipperDoubleWord[gContext, code, exp, fieldCase]};
assumes that exp is an expression of type BOOLEAN.
KipperABoolean: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
valExp: Rope.ROPE ← FormValExp[exp, fieldCase];
AppendRopeCodeStatement[code, Rope.Cat["word ← IF", valExp, "THEN 1 ELSE 0;"]];
KipperOneWord[gContext, code, "word", localVal]
END;
UnKipperABoolean: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
valExp: Rope.ROPE ← FormValExp[exp, fieldCase];
UnKipperOneWord[gContext, code, "word", localVal];
AppendRopeCodeStatement[code, Rope.Cat[valExp, " ← (word=1);"]];
END;
assumes that exp is an expression of type Rope.ROPE.
KipperARope: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
valExp: Rope.ROPE ← FormValExp[exp, fieldCase];
AppendRopeCodeStatement[code, Rope.Cat["KipperRope[kipperer, ", valExp, "];"]];
RecordCedarTypeUse[code, "ROPE", "Rope"];
RecordCedarProcUse[code, "KipperRope", "KipperSupport"];
END;
UnKipperARope: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
valExp: Rope.ROPE ← FormValExp[exp, fieldCase];
AppendRopeCodeStatement[code, Rope.Cat[valExp, "← UnKipperRope[unKipperer];"]];
RecordCedarTypeUse[code, "ROPE", "Rope"];
RecordCedarProcUse[code, "UnKipperRope", "KipperSupport"];
END;
fieldCase had better be ref
Further, the work list mechanism has held REF ANY for last, so that ref types will be known, and can be seen via EnumerateHashTable[gContext.kipperedTypes]
KipperAnAny: PROC[gContext: GeneratorContext, code: Code, type: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
IF fieldCase # ref THEN ERROR;
AppendOpenRopeCodeStatement[code, Rope.Cat["IF ", exp, " = NIL THEN"]];
AppendRopeCodeStatement[code, "BEGIN"];
AppendRopeCodeStatement[code, "word ← 1;"];
KipperACardinal[gContext, code, "word", localVal];
AppendClosingRopeCodeStatement[code, "END"];
AppendOpenRopeCodeStatement[code, Rope.Cat[" ELSE WITH ", exp, " SELECT FROM"]];
BEGIN
index: CARDINAL ← 2;
InstallOneEntry: PROC[varName, varTypeText, fnNameText: Rope.ROPE] =
BEGIN
AppendOpenRopeCodeStatement[code, Rope.Cat[varName, ": ", varTypeText, " => "]];
AppendRopeCodeStatement[code, "BEGIN"];
AppendRopeCodeStatement[code, Rope.Cat["word ← ", Convert.RopeFromCard[index], ";"]];
KipperACardinal[gContext, code, "word", localVal];
AppendRopeCodeStatement[code, Rope.Cat[fnNameText, "[kipperer, ", varName, "];"]];
AppendClosingRopeCodeStatement[code, "END;"];
index ← index + 1;
END;
SeeOneType: PROC[xType: TypeNode, mContext: KipperContext, fnName: NameNode] =
BEGIN
-- we must avoid any types that are equivalent to ANY or REF ANY
-- ANY itself will always be generated, because its presence on the work list is how we come to be in this procedure in the first place
finalXType: TypeNode ← GetFinalNamedType[xType];
IF mContext = self THEN finalXType ← GetUltimateTargetType[finalXType];
IF GetTypeNodeCase[finalXType] # builtIn OR GetBuiltInTypeCase[finalXType] # Any THEN
BEGIN
varName: Rope.ROPE ← Rope.Cat["x", Convert.RopeFromCard[index]];
typeNameText: Rope.ROPE ← GetNameNodeInfo[GetTypeNodeName[xType]].text;
varTypeText: Rope.ROPE ← SELECT mContext FROM
self => typeNameText,
refTarget => Rope.Cat["REF ", typeNameText],
listTarget => Rope.Cat["LIST OF ", typeNameText],
ENDCASE => ERROR;
InstallOneEntry[varName, varTypeText, GetNameNodeInfo[fnName].text];
END;
END;
InstallOneEntry["rope", "Rope.ROPE", "KipperRope"];
InstallOneEntry["text", "REF TEXT", "KipperRefText"];
GenKipperedTypes[gContext, kipper, SeeOneType];
END;
AppendClosingRopeCodeStatement[code, "ENDCASE => ERROR;"];
RecordCedarProcUse[code, "KipperRope", "KipperSupport"];
RecordCedarProcUse[code, "KipperRefText", "KipperSupport"];
END;
fieldCase had better be ref
Further, the work list mechanism has held REF ANY for last, so that ref types will be known, and can be seen via EnumerateHashTable[gContext.kipperedTypes]
UnKipperAnAny: PROC[gContext: GeneratorContext, code: Code, type: TypeNode, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
IF fieldCase # ref THEN ERROR;
UnKipperACardinal[gContext, code, "word", localVal];
AppendRopeCodeStatement[code, "IF word = 1 THEN RETURN[NIL]"];
AppendOpenRopeCodeStatement[code, " ELSE SELECT word FROM"];
BEGIN
index: CARDINAL ← 2;
InstallOneEntry: PROC[fnNameText: Rope.ROPE] =
BEGIN
AppendRopeCodeStatement[code, Rope.Cat[
Rope.Cat[Convert.RopeFromCard[index], " => "],
Rope.Cat[exp, " ← ", fnNameText, "[unKipperer];"]]];
index ← index + 1;
END;
SeeOneType: PROC[xType: TypeNode, mContext: KipperContext, fnName: NameNode] =
BEGIN
-- we must avoid any types that are equivalent to ANY or REF ANY
-- ANY itself will always be generated, because its presence on the work list is how we come to be in this procedure in the first place
finalXType: TypeNode ← GetFinalNamedType[xType];
IF mContext = self THEN finalXType ← GetUltimateTargetType[finalXType];
IF GetTypeNodeCase[finalXType] # builtIn OR GetBuiltInTypeCase[finalXType] # Any THEN InstallOneEntry[GetNameNodeInfo[fnName].text];
END;
InstallOneEntry["UnKipperRope"];
InstallOneEntry["UnKipperRefText"];
GenKipperedTypes[gContext, unKipper, SeeOneType];
END;
AppendClosingRopeCodeStatement[code, "ENDCASE => ERROR;"];
RecordCedarProcUse[code, "UnKipperRope", "KipperSupport"];
RecordCedarProcUse[code, "UnKipperRefText", "KipperSupport"];
END;
assumes that exp is an expression of type CHAR
KipperAChar: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
valExp: Rope.ROPE ← FormValExp[exp, fieldCase];
AppendRopeCodeStatement[code, Rope.Cat["word ← ORD[", valExp, "];"]];
KipperOneWord[gContext, code, "word", localVal]
END;
UnKipperAChar: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
valExp: Rope.ROPE ← FormValExp[exp, fieldCase];
UnKipperOneWord[gContext, code, "word", localVal];
AppendRopeCodeStatement[code, Rope.Cat[valExp, " ← VAL[word];"]];
END;
assumes that exp is an expression of type INTEGER
KipperAnInteger: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
{KipperOneWord[gContext, code, exp, fieldCase]};
UnKipperAnInteger: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
{UnKipperOneWord[gContext, code, exp, fieldCase]};
assumes that exp is an expression of type NAT
KipperANat: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
valExp: Rope.ROPE ← FormValExp[exp, fieldCase];
AppendRopeCodeStatement[code, Rope.Cat["word ← ", valExp, ";"]];
KipperOneWord[gContext, code, "word", localVal]
END;
UnKipperANat: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
valExp: Rope.ROPE ← FormValExp[exp, fieldCase];
UnKipperOneWord[gContext, code, "word", localVal];
AppendRopeCodeStatement[code, Rope.Cat[valExp, " ← word;"]];
END;
assumes that exp is an expression of type REAL
KipperAReal: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
{KipperDoubleWord[gContext, code, exp, fieldCase]};
UnKipperAReal: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
{UnKipperDoubleWord[gContext, code, exp, fieldCase]};
assumes that exp is an expression of type WORD
KipperAWord: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
{KipperOneWord[gContext, code, exp, fieldCase]};
UnKipperAWord: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
{UnKipperOneWord[gContext, code, exp, fieldCase]};
assumes that exp is an expression of type Basics.CARD
KipperACard: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
{KipperDoubleWord[gContext, code, exp, fieldCase]};
UnKipperACard: PROC[gContext: GeneratorContext, code: Code, exp: Rope.ROPE, fieldCase: FieldExpCase] =
{UnKipperDoubleWord[gContext, code, exp, fieldCase]};
Here we have the actual kippering code that is dependent on the Kippering mechanism.
For the moment, makes simple assumptions
KipperOneWord: PROC[gContext: GeneratorContext, code: Code, wordExp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
SELECT fieldCase FROM
localVal, shortField => AppendRopeCodeStatement[code, Rope.Cat["UnsafePutBlock[kipperer.stream, [LOOPHOLE[LONG[@", wordExp, "], LONG POINTER TO RawBytes], 0, 2]];"]];
longField => AppendRopeCodeStatement[code, Rope.Cat["UnsafePutBlock[kipperer.stream, [LOOPHOLE[@", wordExp, ", LONG POINTER TO RawBytes], 0, 2]];"]];
ref => AppendRopeCodeStatement[code, Rope.Cat["UnsafePutBlock[kipperer.stream, [LOOPHOLE[", wordExp, ", LONG POINTER TO RawBytes], 0, 2]];"]];
ENDCASE => ERROR;
END;
UnKipperOneWord: PROC[gContext: GeneratorContext, code: Code, wordExp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
SELECT fieldCase FROM
localVal, shortField => AppendRopeCodeStatement[code,
Rope.Cat["IF UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[LONG[@", wordExp, "], LONG POINTER TO RawBytes], 0, 2]] # 2 THEN ERROR;"]];
longField => AppendRopeCodeStatement[code,
Rope.Cat["IF UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[@", wordExp, ", LONG POINTER TO RawBytes], 0, 2]] # 2 THEN ERROR;"]];
ref => AppendRopeCodeStatement[code,
Rope.Cat["IF UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[", wordExp, ", LONG POINTER TO RawBytes], 0, 2]] # 2 THEN ERROR;"]];
ENDCASE => ERROR;
END;
assumes doubleWordExp is an expression of type INT
KipperDoubleWord: PROC[gContext: GeneratorContext, code: Code, doubleWordExp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
SELECT fieldCase FROM
localVal, shortField => AppendRopeCodeStatement[code, Rope.Cat["UnsafePutBlock[kipperer.stream, [LOOPHOLE[LONG[@", doubleWordExp, "], LONG POINTER TO RawBytes], 0, 4]];"]];
longField => AppendRopeCodeStatement[code, Rope.Cat["UnsafePutBlock[kipperer.stream, [LOOPHOLE[@", doubleWordExp, ", LONG POINTER TO RawBytes], 0, 4]];"]];
ref => AppendRopeCodeStatement[code, Rope.Cat["UnsafePutBlock[kipperer.stream, [LOOPHOLE[", doubleWordExp, ", LONG POINTER TO RawBytes], 0, 4]];"]];
ENDCASE => ERROR;
END;
UnKipperDoubleWord: PROC[gContext: GeneratorContext, code: Code, doubleWordExp: Rope.ROPE, fieldCase: FieldExpCase] =
BEGIN
SELECT fieldCase FROM
localVal, shortField => AppendRopeCodeStatement[code,
Rope.Cat["IF UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[LONG[@", doubleWordExp, "], LONG POINTER TO RawBytes], 0, 4]] # 4 THEN ERROR;"]];
longField => AppendRopeCodeStatement[code,
Rope.Cat["IF UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[@", doubleWordExp, ", LONG POINTER TO RawBytes], 0, 4]] # 4 THEN ERROR;"]];
ref => AppendRopeCodeStatement[code,
Rope.Cat["IF UnsafeGetBlock[unKipperer.stream, [LOOPHOLE[", doubleWordExp, ", LONG POINTER TO RawBytes], 0, 4]] # 4 THEN ERROR;"]];
ENDCASE => ERROR;
END;
assumes arrayExp is of type LONG POINTER TO ARRAY [0..0) OF WORD,
(note the old Mesa convention for an array of unknown size)
and countExp is of type INT
KipperArrayOfWord: PROC[code: Code, arrayExp, countExp: Rope.ROPE] =
BEGIN
ERROR
END;
UnKipperArrayOfWord: PROC[code: Code, arrayExp, countExp: Rope.ROPE] =
BEGIN
ERROR
END;
code manipulation
Code: TYPE = REF CodeBody;
CodeBody: TYPE = RECORD[
text: Rope.ROPE,
currentIndent: CARDINAL,
context: TypeContextNode,
variety: CodeVariety,
codeName: NameNode,
usage: Usage];
CodeVariety: TYPE = {def, impl};
BuildEmptyCode: PROC[context: TypeContextNode, name: NameNode, variety: CodeVariety] RETURNS[Code] =
{RETURN[NEW[CodeBody←[NIL, 0, context, variety, name, BuildEmptyUsage[]]]]};
GetContextOfCode: PROC[code: Code] RETURNS[TypeContextNode] =
{RETURN[code.context]};
Append means start a new line and install the current indent
Extend means do not start a new line, or install the current indent
Open means (after putting in argument rope) increment the current indent
Closing means (after putting in argument rope) decrement the current rope
ClosingOpen means install an indent 2 less than current
AppendOpenRopeCodeStatement: PROC[code: Code, statement: Rope.ROPE] =
BEGIN
s: IO.STREAM ← IO.ROS[];
IO.PutF[s, "\N"];
FOR I: CARDINAL IN [0..code.currentIndent) DO IO.PutF[s, " "] ENDLOOP;
IO.PutF[s, "%g", IO.rope[statement]];
code.currentIndent ← code.currentIndent+3;
code.text ← Rope.Cat[code.text, IO.RopeFromROS[s]];
END;
AppendRopeCodeStatement: PROC[code: Code, statement: Rope.ROPE] =
BEGIN
s: IO.STREAM ← IO.ROS[];
IO.PutF[s, "\N"];
FOR I: CARDINAL IN [0..code.currentIndent) DO IO.PutF[s, " "] ENDLOOP;
IO.PutF[s, "%g", IO.rope[statement]];
code.text ← Rope.Cat[code.text, IO.RopeFromROS[s]];
END;
ExtendOpenRopeCodeStatement: PROC[code: Code, statement: Rope.ROPE] =
BEGIN
s: IO.STREAM ← IO.ROS[];
IO.PutF[s, "%g", IO.rope[statement]];
code.text ← Rope.Cat[code.text, IO.RopeFromROS[s]];
code.currentIndent ← code.currentIndent+3;
END;
ExtendRopeCodeStatement: PROC[code: Code, statement: Rope.ROPE] =
BEGIN
s: IO.STREAM ← IO.ROS[];
IO.PutF[s, "%g", IO.rope[statement]];
code.text ← Rope.Cat[code.text, IO.RopeFromROS[s]];
END;
AppendClosingRopeCodeStatement: PROC[code: Code, statement: Rope.ROPE] =
BEGIN
s: IO.STREAM ← IO.ROS[];
IO.PutF[s, "\N"];
FOR I: CARDINAL IN [0..code.currentIndent) DO IO.PutF[s, " "] ENDLOOP;
IO.PutF[s, "%g", IO.rope[statement]];
code.text ← Rope.Cat[code.text, IO.RopeFromROS[s]];
code.currentIndent ← code.currentIndent-3;
END;
AppendClosingOpenRopeCodeStatement: PROC[code: Code, statement: Rope.ROPE] =
BEGIN
s: IO.STREAM ← IO.ROS[];
IO.PutF[s, "\N"];
FOR I: CARDINAL IN [0..code.currentIndent-2) DO IO.PutF[s, " "] ENDLOOP;
IO.PutF[s, "%g", IO.rope[statement]];
code.text ← Rope.Cat[code.text, IO.RopeFromROS[s]];
END;
ExtendClosingRopeCodeStatement: PROC[code: Code, statement: Rope.ROPE] =
BEGIN
s: IO.STREAM ← IO.ROS[];
IO.PutF[s, "%g", IO.rope[statement]];
code.text ← Rope.Cat[code.text, IO.RopeFromROS[s]];
code.currentIndent ← code.currentIndent - 3;
END;
RecordFunctionCall: PROC[code: Code, gContext: GeneratorContext, fnName: NameNode] =
BEGIN
defFile: NameNode; implFile: NameNode;
[defFile, implFile] ← GetFunctionInfo[gContext, fnName];
IF EqualNames[implFile, code.codeName] THEN RETURN;
RecordNameUse[code.usage, fnName, defFile, import]
END;
RecordFunctionExport: PROC[code: Code, gContext: GeneratorContext, fnName: NameNode] =
{RecordNameUse[code.usage, fnName, GetFunctionInfo[gContext, fnName].defFile, export]};
RecordNamedTypeUse: PROC[code: Code, type: TypeNode] =
BEGIN
defFileName: NameNode ← GetTypeNodeTypeDefFile[type];
IF EqualNames[code.codeName, defFileName] THEN RETURN;
IF defFileName = NIL THEN RETURN;
RecordNameUse[code.usage, GetTypeNodeName[type], defFileName, ref];
END;
RecordCedarTypeUse: PROC[code: Code, type: Rope.ROPE, from: Rope.ROPE] =
BEGIN
typeName: NameNode ← BuildRopeName[type];
defFileName: NameNode ← BuildRopeName[from];
RecordNameUse[code.usage, typeName, defFileName, ref];
END;
RecordCedarProcUse: PROC[code: Code, proc: Rope.ROPE, from: Rope.ROPE] =
BEGIN
procName: NameNode ← BuildRopeName[proc];
defFileName: NameNode ← BuildRopeName[from];
RecordNameUse[code.usage, procName, defFileName, import];
END;
ShowCode: PUBLIC PROC[code: Code, on: IO.STREAM] =
BEGIN
IO.PutF[on, "%g", IO.rope[BuildDirectoryRope[code.usage]]];
IO.PutF[on, "%g: %g%g%g =\N",
IO.rope[GetNameNodeInfo[code.codeName].text],
IO.rope[IF code.variety = def THEN "CEDAR DEFINITIONS" ELSE "CEDAR PROGRAM"],
IO.rope[BuildImportsRope[code.usage]],
IO.rope[BuildExportsRope[code.usage]]];
IO.PutF[on, "BEGIN\N"];
IO.PutF[on, "%g", IO.rope[BuildOpenRope[code.usage]]];
IO.PutF[on, "%g", IO.rope[code.text]];
IO.PutF[on, "\N\NEND.."];
END;
-- usage info
Use: TYPE = {ref, import, export};
Usage: TYPE = REF UsageBody;
UsageBody: TYPE = RECORD[
ht: HashTable];
UseInfo: TYPE = REF UseInfoBody;
UseInfoBody: TYPE = RECORD[
bits: ARRAY Use OF BOOLEAN,
names: HashTable];
NameInfo: TYPE = REF CARDINAL; -- just for non nil fill
BuildEmptyUsage: PROC[] RETURNS[Usage] =
{RETURN[NEW[UsageBody←[CreateHashTable[10]]]]};
RecordNameUse: PROC[usage: Usage, name: NameNode, fromFile: NameNode, use: Use] =
BEGIN
info: UseInfo ← NARROW[FindEntry[usage.ht, fromFile]];
IF info = NIL THEN
BEGIN
info ← NEW[UseInfoBody←[[FALSE, FALSE, FALSE], CreateHashTable[10]]];
MakeEntry[usage.ht, fromFile, info];
END;
info.bits[use] ← TRUE;
SELECT use FROM
export => NULL;
ref, import =>
BEGIN
nameInfo: NameInfo ← NARROW[FindEntry[info.names, name]];
IF nameInfo = NIL THEN MakeEntry[info.names, name, NEW[CARDINAL𡤀]];
END;
ENDCASE => ERROR;
END;
BuildDirectoryRope: PROC[usage: Usage] RETURNS[Rope.ROPE] =
BEGIN
s: IO.STREAM ← IO.ROS[];
empty: BOOLEAN ← TRUE;
SeeOneFileEntry: PROC[useRef: REF ANY, fileName: NameNode] =
BEGIN
useInfo: UseInfo ← NARROW[useRef];
noNames: BOOLEAN ← TRUE;
SeeOneNameEntry: PROC[nameRef: REF ANY, name: NameNode] =
BEGIN
IF noNames THEN noNames ← FALSE ELSE IO.PutF[s, ", "];
IO.PutF[s, "%g", IO.rope[GetNameNodeInfo[name].text]];
END;
IF empty THEN
{empty ← FALSE; IO.PutF[s, "DIRECTORY\N"]}
ELSE IO.PutF[s, ",\N"];
IO.PutF[s, " %g USING[", IO.rope[GetNameNodeInfo[fileName].text]];
EnumerateHashTable[useInfo.names, SeeOneNameEntry];
IO.PutF[s, "]"];
END;
EnumerateHashTable[usage.ht, SeeOneFileEntry];
IF NOT empty THEN IO.PutF[s, ";\N\N"];
RETURN[IO.RopeFromROS[s]];
END;
BuildImportsRope: PROC[usage: Usage] RETURNS[Rope.ROPE] =
BEGIN
s: IO.STREAM ← IO.ROS[];
empty: BOOLEAN ← TRUE;
SeeOneFileEntry: PROC[useRef: REF ANY, fileName: NameNode] =
BEGIN
useInfo: UseInfo ← NARROW[useRef];
IF useInfo.bits[import] THEN
BEGIN
IF empty THEN {empty ← FALSE; IO.PutF[s, " IMPORTS "]}
ELSE IO.PutF[s, ", "];
IO.PutF[s, "%g", IO.rope[GetNameNodeInfo[fileName].text]];
END;
END;
EnumerateHashTable[usage.ht, SeeOneFileEntry];
IF NOT empty THEN IO.PutF[s, " "];
RETURN[IO.RopeFromROS[s]];
END;
BuildExportsRope: PROC[usage: Usage] RETURNS[Rope.ROPE] =
BEGIN
s: IO.STREAM ← IO.ROS[];
empty: BOOLEAN ← TRUE;
SeeOneFileEntry: PROC[useRef: REF ANY, fileName: NameNode] =
BEGIN
useInfo: UseInfo ← NARROW[useRef];
IF useInfo.bits[export] THEN
BEGIN
IF empty THEN {empty ← FALSE; IO.PutF[s, " EXPORTS "]}
ELSE IO.PutF[s, ", "];
IO.PutF[s, "%g", IO.rope[GetNameNodeInfo[fileName].text]];
END;
END;
EnumerateHashTable[usage.ht, SeeOneFileEntry];
IF NOT empty THEN IO.PutF[s, " "];
RETURN[IO.RopeFromROS[s]];
END;
BuildOpenRope: PROC[usage: Usage] RETURNS[Rope.ROPE] =
BEGIN
s: IO.STREAM ← IO.ROS[];
empty: BOOLEAN ← TRUE;
SeeOneFileEntry: PROC[useRef: REF ANY, fileName: NameNode] =
BEGIN
useInfo: UseInfo ← NARROW[useRef];
IF useInfo.bits[ref] OR useInfo.bits[import] THEN
BEGIN
IF empty THEN {empty ← FALSE; IO.PutF[s, "OPEN "]}
ELSE IO.PutF[s, ", "];
IO.PutF[s, "%g", IO.rope[GetNameNodeInfo[fileName].text]];
END;
END;
EnumerateHashTable[usage.ht, SeeOneFileEntry];
IF NOT empty THEN IO.PutF[s, ";\N\N"];
RETURN[IO.RopeFromROS[s]];
END;
END..