TranslateConstantDeclaration:
PUBLIC
PROCEDURE [position: Position]
RETURNS [saySemiColon: BOOL ← TRUE] =
BEGIN
id: IdentifierPtr;
v: ValuePtr;
defsId: IdentifierPtr;
defsTail: REF defsModule IdentifierTail;
IF position = outer
THEN
BEGIN
mentionedId: IdentifierPtr ← IdentLookup[pset: configTail.mentionedIdents, couldFail: TRUE];
mentionedTail: REF outerItem IdentifierTail;
IF mentionedId #
NIL
THEN
{mentionedTail ←
NARROW[mentionedId.class];
defsId ← mentionedTail.dest.defsModule}
ELSE
defsId ← defaultDest[const].defsModule;
defsTail ← NARROW[defsId.class];
END;
IF sy # identSy THEN Error[MalformedStatement];
SayIdent[ident];
id ← NewIdent[];
InSymbol[];
IF op # eqOp THEN Error[MalformedStatement];
MustBe[relOpSy, , MalformedStatement];
v ← ParseConstantExpression[];
WITH v.value
SELECT
FROM
vs: REF stringConstant ValueTail => ExpressStringConstant[v, v.type];
ENDCASE => NULL;
id.type ← v.type;
Say[": "];
SayType[id.type];
Say[" ="];
SayTranslation[v];
IF position = outer
THEN
{q: OutputQueuePtr;
SayLine[";"];
q ← CopyAndPopOut[];
MergeQueue[to: defsTail.q, from: q];
PushOut[];
saySemiColon ← FALSE};
IF GetConcreteTypeOfValue[v] = real
THEN id.class ←
Z.NEW[IdentifierTail← [realConstant[]]]
ELSE
WITH v.value
SELECT
FROM
vsc:
REF scalarConstant ValueTail =>
id.class ←
Z.
NEW[IdentifierTail ←
[constant[scalarLink: NIL, value: vsc.v.value]]];
vsc:
REF otherConstant ValueTail =>
id.class ← Z.NEW[IdentifierTail ← [charArrayConstant[]]];
ENDCASE => {
Error[CantComputeConstant];
id.class ←
Z.
NEW[IdentifierTail ←
[constant[scalarLink: NIL, value: 0]]]};
END; -- of TranslateConstDeclaration
TranslateTypeDeclaration:
PUBLIC
PROCEDURE [position: Position]
RETURNS [saySemiColon: BOOL ← TRUE] =
BEGIN
id: IdentifierPtr;
defsId: IdentifierPtr;
defsTail: REF defsModule IdentifierTail;
IF position = outer
THEN
BEGIN
mentionedId: IdentifierPtr ← IdentLookup[pset: configTail.mentionedIdents, couldFail: TRUE];
mentionedTail: REF outerItem IdentifierTail;
IF mentionedId #
NIL
THEN
{mentionedTail ←
NARROW[mentionedId.class];
defsId ← mentionedTail.dest.defsModule}
ELSE
defsId ← defaultDest[type].defsModule;
defsTail ← NARROW[defsId.class];
END;
IF sy # identSy THEN Error[MalformedStatement];
SayIdent[ident];
InSymbol[];
id ← IdentLookup[couldFail: TRUE, pset: display[lexLevel].locals];
just the current locals
IF id =
NIL
THEN
BEGIN
id ← NewIdent[];
id.type ← nilGeneralTypePtr;
id.class ← Z.NEW[IdentifierTail←[type[]]];
END
ELSE
IF id.type # nilGeneralTypePtr
OR id.class.idClass # type
THEN
Error[MultipleTypeDefinition];
IF op # eqOp THEN Error[MalformedStatement];
MustBe[relOpSy, ": TYPE =", MalformedStatement];
id.type ← TranslateType[id: id, fwdOK: TRUE];
IF position = outer
THEN
{q: OutputQueuePtr;
SayLine[";"];
q ← CopyAndPopOut[];
MergeQueue[to: defsTail.q, from: q];
PushOut[];
saySemiColon ← FALSE};
END; -- of TranslateTypeDeclaration
TranslateVariableDeclaration:
PUBLIC
PROCEDURE [position: Position]
RETURNS [saySemiColon: BOOL ← TRUE] =
BEGIN -- sy=identSy
ParseVariableName:
PROCEDURE =
BEGIN
id: IdentifierPtr;
adm: ArrayDifferentlyMethod ← notAtAll;
IF sy # identSy THEN Error[MalformedIdList];
WITH display[lexLevel]
SELECT
FROM
cde:
REF call DisplayEntry =>
IF cde.programSegment #
NIL
THEN
BEGIN
psip: SegmentIdentifierTailPtr ← NARROW[cde.programSegment.class];
cid: IdentifierPtr ← IdentLookup[
pset: psip.mentionedVariables, couldFail: TRUE];
IF cid #
NIL
THEN
WITH cid.class
SELECT
FROM
cdit:
REF compileDifferently IdentifierTail =>
adm ← cdit.arrayHow;
ENDCASE;
END;
ENDCASE;
id ← NewIdent[pset: varSet[adm]];
IF firstVar[adm] = NIL THEN firstVar[adm] ← id;
InSymbol[];
END;
SayNameAndType:
PROCEDURE [id: IdentifierPtr] =
{SayLine[];
SayIdent[id.name];
Say[": "];
CopyQueue[from: q]};
ComputeQueuesForOuterItem:
PROCEDURE [id: IdentifierPtr]
RETURNS [defsTail:
REF defsModule IdentifierTail,
implTail: REF implModule IdentifierTail] =
{dest: DestinationPtr ← defaultDest[var];
menId: IdentifierPtr ←
IdentLookup[name: id.name, pset: configTail.mentionedIdents, couldFail: TRUE];
IF menId #
NIL
THEN
{menTail:
REF outerItem IdentifierTail ←
NARROW[menId.class];
dest ← menTail.dest};
defsTail ← NARROW[dest.defsModule.class];
implTail ← NARROW[dest.implModule.class]};
MarkAsNormalVariable:
PROCEDURE [id: IdentifierPtr] =
BEGIN
IF sayComma THEN Say[", "] ELSE sayComma ← TRUE;
SayIdent[id.name];
id.type ← IF id = firstNormalVar THEN t ELSE firstNormalVar;
id.class ← Z.NEW[IdentifierTail←[variable[kind: normal]]];
END;
MarkAsOuterNormalVariable:
PROCEDURE [id: IdentifierPtr] =
BEGIN
defsTail: REF defsModule IdentifierTail;
implTail: REF implModule IdentifierTail;
[defsTail, implTail] ← ComputeQueuesForOuterItem[id];
MergeQueue[to: implTail.q, from: CopyAndPopOut[]]; -- pick up the comments
PushOut[defsTail.q];
SayNameAndType[id];
SayLine[";"];
defsTail.q ← CopyAndPopOut[];
PushOut[implTail.q];
SayNameAndType[id];
SayLine[";"];
implTail.q ← CopyAndPopOut[];
PushOut[]; -- prepare for more of the same
id.type ← IF id = firstNormalVar THEN t ELSE firstNormalVar;
id.class ← Z.NEW[IdentifierTail←[variable[kind: normal]]];
END;
MarkAsDynamicVariable:
PROCEDURE [id: IdentifierPtr] =
BEGIN
ct: TypePtr;
IF sayComma THEN Say["; "] ELSE sayComma ← TRUE;
SayIdent[id.name];
Say[": "];
Say[pointerName];
CopyQueue[from: q];
Say[" ← Pascal"];
IF lexLevel<=2 THEN Say["Static"];
IF targetLanguage = longMesa THEN Say["Long"];
Say["Zone.NEW["];
SayType[t];
Say["]"];
ct ← GetConcreteType[t];
WITH ct
SELECT
FROM
cta: ArrayTypePtr =>
BEGIN
dynamicT: ArrayTypePtr←Z.NEW[array Type];
dynamicT^ ← cta^;
dynamicT.aIsDynamic ← TRUE;
id.type ← dynamicT;
END;
ENDCASE => Error[IncompatibleTypes];
id.class ← Z.NEW[IdentifierTail←[variable[kind: normal]]];
END;
MarkAsOuterDynamicVariable:
PROCEDURE [id: IdentifierPtr] =
BEGIN
ct: TypePtr;
defsTail: REF defsModule IdentifierTail;
implTail: REF implModule IdentifierTail;
[defsTail, implTail] ← ComputeQueuesForOuterItem[id];
MergeQueue[to: implTail.q, from: CopyAndPopOut[]]; -- pick up the comments
PushOut[defsTail.q];
SayIdent[id.name];
Say[": "];
Say[pointerName];
CopyQueue[from: q];
SayLine[";"];
defsTail.q ← CopyAndPopOut[];
PushOut[implTail.q];
SayIdent[id.name];
Say[": "];
Say[pointerName];
SayType[t];
Say[" ← Pascal"];
IF lexLevel<=2 THEN Say["Static"];
IF targetLanguage = longMesa THEN Say["Long"];
Say["Zone.NEW["];
SayType[t];
SayLine["];"];
implTail.q ← CopyAndPopOut[];
PushOut[]; -- prepare for more of the same
ct ← GetConcreteType[t];
WITH ct
SELECT
FROM
cta: ArrayTypePtr =>
BEGIN
dynamicT: ArrayTypePtr←Z.NEW[array Type];
dynamicT^ ← cta^;
dynamicT.aIsDynamic ← TRUE;
id.type ← dynamicT;
END;
ENDCASE => Error[IncompatibleTypes];
id.class ← Z.NEW[IdentifierTail←[variable[kind: normal]]];
END;
MarkAsProcArrayVariable:
PROCEDURE [id: IdentifierPtr] =
BEGIN -- procArray's are always outer
defsTail: REF defsModule IdentifierTail;
implTail: REF implModule IdentifierTail;
inlineFlag: BOOLEAN ← FALSE;
[defsTail, implTail] ← ComputeQueuesForOuterItem[id];
WITH display[lexLevel]
SELECT
FROM
cde:
REF call DisplayEntry =>
IF cde.programSegment #
NIL
THEN
BEGIN
psip: SegmentIdentifierTailPtr ← NARROW[cde.programSegment.class];
cid: IdentifierPtr ← IdentLookup[name: id.name,
pset: psip.mentionedVariables, couldFail: TRUE];
IF cid #
NIL
THEN
WITH cid.class
SELECT
FROM
cdit:
REF compileDifferently IdentifierTail =>
IF cdit.procHow = inlineProc THEN inlineFlag ← TRUE;
ENDCASE;
END;
ENDCASE;
IF inlineFlag
THEN
{MergeQueue[to: defsTail.q, from: CopyAndPopOut[]];
-- pick up the comments
PushOut[defsTail.q];
SayNameAndType[id];
SayLine[" = INLINE ??;"];
defsTail.q ← CopyAndPopOut[];
PushOut[]} -- prepare for more of the same
ELSE
{MergeQueue[to: implTail.q, from: CopyAndPopOut[]]; -- pick up the comments
PushOut[defsTail.q];
SayNameAndType[id];
SayLine[";"];
defsTail.q ← CopyAndPopOut[];
PushOut[implTail.q];
SayNameAndType[id];
SayLine[" = ??;"];
implTail.q ← CopyAndPopOut[];
PushOut[]}; -- prepare for more of the same
id.type ← t;
id.class ← Z.NEW[IdentifierTail←[variable[kind: normal]]];
END;
MarkAsComputedSeqArrayVariable:
PROCEDURE [id: IdentifierPtr] =
BEGIN -- computedSeqArrays are always outer
defsTail: REF defsModule IdentifierTail;
implTail: REF implModule IdentifierTail;
[defsTail, implTail] ← ComputeQueuesForOuterItem[id];
MergeQueue[to: implTail.q, from: CopyAndPopOut[]]; -- pick up the comments
PushOut[defsTail.q];
SayIdent[id.name];
Say["PaintedType: TYPE="];
CopyQueue[from: q];
SayLine[";"];
SayIdent[id.name];
Say[": "];
Say[pointerName];
SayIdent[id.name];
Say["PaintedType"];
SayLine[";"];
defsTail.q ← CopyAndPopOut[];
PushOut[implTail.q];
SayIdent[id.name];
Say[": "];
Say[pointerName];
SayIdent[id.name];
Say["PaintedType"];
SayLine[";"]; -- we don't do anything about allocating it!
implTail.q ← CopyAndPopOut[];
PushOut[]; -- prepare for more of the same
id.type ← t;
id.class ← Z.NEW[IdentifierTail←[variable[kind: normal]]];
END;
MarkAsFileVariable:
PROCEDURE [id: IdentifierPtr] =
BEGIN
IF sayComma THEN Say["; "] ELSE sayComma ← TRUE;
SayIdent[id.name];
Say[": "];
CopyQueue[from: q];
IF useVarNamesForFileNames
THEN
{Say[" ← [baseFile: PascalInventFileName["""];
SayIdent[id.name];
Say["""]]"]};
id.type ← IF id = firstNormalVar THEN t ELSE firstNormalVar;
id.class ← Z.NEW[IdentifierTail←[variable[kind: normal]]];
END;
MarkAsOuterFileVariable:
PROCEDURE [id: IdentifierPtr] =
BEGIN
defsTail: REF defsModule IdentifierTail;
implTail: REF implModule IdentifierTail;
[defsTail, implTail] ← ComputeQueuesForOuterItem[id];
MergeQueue[to: implTail.q, from: CopyAndPopOut[]]; -- pick up the comments
PushOut[defsTail.q];
SayNameAndType[id];
SayLine[";"];
defsTail.q ← CopyAndPopOut[];
PushOut[implTail.q];
SayNameAndType[id];
IF useVarNamesForFileNames
THEN
{Say[" ← [baseFile: PascalInventFileName["""];
SayIdent[id.name];
SayLine["""]];"]} ELSE SayLine[";"];
implTail.q ← CopyAndPopOut[];
PushOut[]; -- prepare for more of the same
id.type ← IF id = firstNormalVar THEN t ELSE firstNormalVar;
id.class ← Z.NEW[IdentifierTail←[variable[kind: normal]]];
END;
firstNormalVar: IdentifierPtr ← NIL;
varSet: ARRAY ArrayDifferentlyMethod OF IdentifierSetPtr;
firstVar: ARRAY ArrayDifferentlyMethod OF IdentifierPtr ← ALL[NIL];
t: GeneralTypePtr;
ct: TypePtr;
q: OutputQueuePtr;
sayComma: BOOLEAN ← FALSE;
FOR adm: ArrayDifferentlyMethod
IN ArrayDifferentlyMethod
DO varSet[adm]𡤌reateIdentifierSet[] ENDLOOP;
SequenceOf[ParseVariableName, commaSy, ""];
PushOut[];
MustBe[colonSy, "", MalformedIdList];
IF
NOT EmptyIdentifierSet[varSet[procArray]]
THEN
BEGIN
FOR adm: ArrayDifferentlyMethod
IN ArrayDifferentlyMethod
DO
IF adm # procArray
AND
NOT EmptyIdentifierSet[varSet[adm]]
THEN
Error[MalformedProcArrayDeclaration] ENDLOOP;
IF position # outer THEN Error[MalformedProcArrayDeclaration];
t ← TranslateType[outerArrayIsFunny: procArray];
ct ← GetConcreteType[t];
q ← CopyAndPopOut[];
IF ct.form # procArray THEN Error[MalformedProcArrayDeclaration];
EnumerateIdentifierSet[varSet[procArray], MarkAsProcArrayVariable];
END
ELSE
IF
NOT EmptyIdentifierSet[varSet[computedSeqArray]]
THEN
BEGIN
FOR adm: ArrayDifferentlyMethod
IN ArrayDifferentlyMethod
DO
IF adm#computedSeqArray
AND
NOT EmptyIdentifierSet[varSet[adm]]
THEN
Error[MalformedComputedSeqArrayDeclaration] ENDLOOP;
IF position # outer THEN Error[MalformedComputedSeqArrayDeclaration];
t ← TranslateType[outerArrayIsFunny: computedSeqArray];
ct ← GetConcreteType[t];
q ← CopyAndPopOut[];
IF ct.form # computedSeqArray THEN Error[MalformedComputedSeqArrayDeclaration];
EnumerateIdentifierSet[varSet[computedSeqArray], MarkAsComputedSeqArrayVariable];
END
ELSE
BEGIN
t ← TranslateType[];
ct ← GetConcreteType[t];
q ← CopyAndPopOut[];
firstNormalVar ← firstVar[notAtAll]; -- the more common case
SELECT TRUE FROM
ct.form = file =>
EnumerateIdentifierSet[varSet[notAtAll],
IF position = outer THEN MarkAsOuterFileVariable ELSE MarkAsFileVariable];
ct.form = array
AND targetLanguage = cedar =>
-- default is allocated from the heap
BEGIN
firstNormalVar ← firstVar[specialArray];
IF firstNormalVar #
NIL
THEN
SELECT position
FROM
inner =>
BEGIN
EnumerateIdentifierSet[varSet[specialArray], MarkAsNormalVariable];
Say[":"];
CopyQueue[from: q];
END;
outer => EnumerateIdentifierSet[varSet[specialArray], MarkAsOuterNormalVariable];
ENDCASE => ERROR;
EnumerateIdentifierSet[varSet[notAtAll],
IF position = outer THEN MarkAsOuterDynamicVariable ELSE MarkAsDynamicVariable];
END;
ct.form = array
AND targetLanguage # cedar =>
-- default is in the frame
BEGIN
IF firstNormalVar #
NIL
THEN
SELECT position
FROM
inner =>
BEGIN
EnumerateIdentifierSet[varSet[notAtAll], MarkAsNormalVariable];
Say[":"];
CopyQueue[from: q];
END;
outer => EnumerateIdentifierSet[varSet[notAtAll], MarkAsOuterNormalVariable];
ENDCASE => ERROR;
EnumerateIdentifierSet[varSet[specialArray],
IF position = outer THEN MarkAsOuterDynamicVariable ELSE MarkAsDynamicVariable];
END;
ENDCASE =>
SELECT position
FROM
inner =>
BEGIN
EnumerateIdentifierSet[varSet[notAtAll], MarkAsNormalVariable];
Say[":"];
CopyQueue[from: q];
END;
outer => EnumerateIdentifierSet[varSet[notAtAll], MarkAsOuterNormalVariable];
ENDCASE => ERROR;
END;
IF position = outer THEN saySemiColon ← FALSE;
FOR adm: ArrayDifferentlyMethod
IN ArrayDifferentlyMethod
DO MergeIdentifierSets[from: varSet[adm]] ENDLOOP;
END; -- TranslateVariableDeclaration
TranslateProcedureDeclaration:
PUBLIC
PROCEDURE [
position: Position, isFunction: BOOLEAN ← FALSE] =
BEGIN
In the queue on top of the stack may be some comments
that we should incorporate in this module. We should flush
that queue out after our last CR.
id: IdentifierPtr;
headerQ: OutputQueuePtr; -- the translation of the header line
implModuleQ: OutputQueuePtr; -- where the impl should go if position=outer
defsModuleQ: OutputQueuePtr; -- where the def should go if position=outer
inlineFlag: BOOLEAN ← FALSE;
InSymbol[];
IF sy # identSy THEN Error[MalformedStatement];
id ← IdentLookup[couldFail: TRUE, pset: display[lexLevel].locals];
IF id =
NIL
THEN
BEGIN -- header declaration with argument types
t: ProcedureTypePtr;
WITH display[lexLevel]
SELECT
FROM
cde:
REF call DisplayEntry =>
IF cde.programSegment #
NIL
THEN
BEGIN
psip: SegmentIdentifierTailPtr ← NARROW[cde.programSegment.class];
cid: IdentifierPtr ← IdentLookup[
pset: psip.mentionedVariables, couldFail: TRUE];
IF cid #
NIL
THEN
WITH cid.class
SELECT
FROM
cdit:
REF compileDifferently IdentifierTail =>
IF cdit.procHow = inlineProc THEN inlineFlag ← TRUE;
ENDCASE;
END;
ENDCASE;
id ← NewIdent[];
SayIdent[id.name];
Say[": "];
InSymbol[];
t ← TranslateFormalParameterList[procName: id.name];
id.type ← t;
IF (isFunction # (t.result # nilGeneralTypePtr))
OR sy # semiColonSy
THEN
Error[MalformedStatement];
InSymbol[stopAtCR: TRUE];
headerQ ← CopyAndPopOut[];
id.class ←
Z.
NEW[IdentifierTail←[procedure[
source: declared[defining: FALSE, inline: inlineFlag, headerQ: headerQ]]]];
PushOut[];
IF sy = CRSy THEN InSymbol[];
END -- header declaration with argument types
ELSE
BEGIN -- previous FORWARD declaration
InSymbol[];
MustBe[semiColonSy, "", MalformedStatement];
retrieve the headerQ that we built when we scanned the header
WITH id.class
SELECT
FROM
dpidt:
REF declared procedure IdentifierTail =>
{headerQ ← dpidt.headerQ; inlineFlag ← dpidt.inline};
ENDCASE => ERROR;
END; -- previous FORWARD declaration
IF position = outer
THEN
BEGIN -- which module does this procedure go in?
defsModuleTail: REF defsModule IdentifierTail;
implModuleTail: REF implModule IdentifierTail;
procId: IdentifierPtr ← IdentLookup[
name: id.name, pset: configTail.mentionedIdents,
couldFail: TRUE];
IF procId #
NIL
THEN
WITH procId.class
SELECT
FROM
ps:
REF outerItem IdentifierTail =>
{defsModuleTail ←
NARROW[ps.dest.defsModule.class];
implModuleTail ← NARROW[ps.dest.implModule.class]};
ENDCASE => ERROR
ELSE {defsModuleTail ←
NARROW[defaultDest[proc].defsModule.class];
implModuleTail ← NARROW[defaultDest[proc].implModule.class]};
implModuleQ ← implModuleTail.q;
defsModuleQ ← defsModuleTail.q;
END; -- which module does this procedure go in?
SELECT
TRUE
FROM
CouldBe[forwardSy, ""] => MustBe[semiColonSy, "", MalformedStatement];
CouldBe[externSy, ""] =>
{MustBe[semiColonSy, "", MalformedStatement];
IF position # outer THEN Error[MalformedExternalProc];
IF inlineFlag
THEN
{
-- all we can do is put a hint into the defs module
PushOut[defsModuleQ];
SayLine[""];
CopyQueue[from: headerQ];
SayLine["= INLINE ??;"];
defsModuleQ ← CopyAndPopOut[]}
ELSE
{PushOut[defsModuleQ];
SayLine[""];
CopyQueue[from: headerQ];
SayLine[";"];
defsModuleQ ← CopyAndPopOut[];
next, put a copy of the header in the impl file as a hint to the implementer
PushOut[implModuleQ];
SayLine[""];
CopyQueue[from: headerQ];
SayLine[" = ??;"];
implModuleQ ← CopyAndPopOut[]}};
ENDCASE =>
BEGIN -- the procedure body is declared here
WITH id.class
SELECT
FROM
dpidt:
REF declared procedure IdentifierTail =>
BEGIN
CopyQueue[from: headerQ];
NewLocalsFromFormals[id];
IF inlineFlag THEN SayLine[" = INLINE "] ELSE SayLine[" = "];
Say["BEGIN"];
TranslateBlock[inner];
DisposeLocals[id];
Say[" END;"];
IF sy # semiColonSy THEN Error[MalformedStatement];
InSymbol[stopAtCR: TRUE];
IF position = outer
THEN
BEGIN
q: OutputQueuePtr ← CopyAndPopOut[];
IF inlineFlag
THEN
MergeQueue[to: defsModuleQ, from: q]
ELSE {MergeQueue[to: implModuleQ, from: q];
PushOut[defsModuleQ];
SayLine[""];
CopyQueue[from: headerQ];
SayLine[";"];
defsModuleQ ← CopyAndPopOut[]};
PushOut[];
END;
END;
ENDCASE => Error[MalformedStatement];
END;
END; -- of TranslateProcedureDeclaration
TranslateFormalParameterList:
PROCEDURE [
procName: Name, location: {external, internal} ← external]
RETURNS [ProcedureTypePtr] =
BEGIN
NextParameterString:
PROCEDURE
RETURNS [
ROPE] =
BEGIN
parameterNumber ← parameterNumber + 1;
RETURN[Rope.Concat["P",Convert.RopeFromInt[from: parameterNumber]]];
END; -- of NextParameterToString
TranslateParameterNames:
PROCEDURE [pset: IdentifierSetPtr] =
BEGIN
IF location = external
OR paramsHaveNames
THEN
TranslateIdList[pset: pset]
ELSE
BEGIN
s:ROPE←NextParameterString[];
Say[s];
[] ← NewIdent[name: s, pset: pset];
END;
END;
TranslateFormalParameter:
PROCEDURE =
BEGIN
set: IdentifierSetPtr;
t: ProcedureTypePtr;
typedId: IdentifierPtr ← NIL;
MakeParameterProcedure:
PROCEDURE [id: IdentifierPtr] =
BEGIN
id.type ← IF typedId = NIL THEN t ELSE typedId;
typedId ← id;
id.class ← Z.NEW[IdentifierTail←[procedure[source: parameter[]]]];
END;
set𡤌reateIdentifierSet[];
SELECT sy
FROM
procedureSy =>
BEGIN
InSymbol[];
TranslateParameterNames[set];
Say[": "];
t ← TranslateFormalParameterList["", internal];
IF t.result # nilGeneralTypePtr THEN Error[MalformedParameterList];
EnumerateIdentifierSet[set, MakeParameterProcedure];
END;
functionSy =>
BEGIN
InSymbol[];
TranslateParameterNames[set];
Say[": "];
t ← TranslateFormalParameterList["", internal];
IF t.result = nilGeneralTypePtr THEN Error[MalformedParameterList];
EnumerateIdentifierSet[set, MakeParameterProcedure];
END;
varSy =>
BEGIN
q: OutputQueuePtr;
vt: GeneralTypePtr;
MakeVarVariable:
PROCEDURE [id: IdentifierPtr] = {
id.class ← Z.NEW[IdentifierTail←[variable[kind: var]]]};
InSymbol[];
TranslateParameterNames[set];
[] ← CouldBe[colonSy, ""];
Say[": "];
PushOut[];
vt ← TranslateType[];
q ← CopyAndPopOut[];
Say[varPointerName];
-- !! McCreight had file variables be special, never LONG !!
This may mean that some runtime doesn't support LONG POINTER TO args
for the file operations.
MergeQueue[from: q];
AssignTypeToIdSet[pset: set, type: vt];
EnumerateIdentifierSet[set, MakeVarVariable];
END;
ENDCASE =>
BEGIN
MakeNormalVariable:
PROCEDURE [id: IdentifierPtr] = {
id.class ← Z.NEW[IdentifierTail←[variable[kind: normal]]]};
TranslateParameterNames[set];
[] ← CouldBe[colonSy, ""];
Say[": "];
AssignTypeToIdSet[pset: set, type: TranslateType[]];
EnumerateIdentifierSet[set, MakeNormalVariable];
END;
MergeIdentifierSets[into: pt.formals, from: set];
END; -- of TranslateFormalParameter
parameterNumber: PascalInteger ← 0;
pt: ProcedureTypePtr ←
Z.
NEW[procedure Type←
[procedure[formals: NIL, result: nilGeneralTypePtr]]];
pt.formals𡤌reateIdentifierSet[];
Say["PROCEDURE"];
IF CouldBe[lParentSy, "["]
THEN
BEGIN
SequenceOf[TranslateFormalParameter, semiColonSy, ","];
MustBe[rParentSy, "]", MalformedParameterList];
END;
IF CouldBe[colonSy, " RETURNS["]
THEN
BEGIN
IF location = external THEN {SayIdent[procName]; Say["Result: "]};
pt.result ← TranslateType[];
SayCh[']];
END;
RETURN[pt];
END; -- of TranslateFormalParameterList
TranslateProcedureCall:
PUBLIC
PROCEDURE [id: IdentifierPtr]
RETURNS [ValuePtr] =
BEGIN
firstParameter: BOOLEAN ← TRUE;
resultType: GeneralTypePtr;
TranslateUntypedExpression: PROCEDURE = {[] ← TranslateExpression[]};
MesaLoopholeTypes:
PROCEDURE [t1, t2: GeneralTypePtr]
RETURNS [
BOOLEAN] =
BEGIN
RETURN[
SELECT
TRUE
FROM
NOT IsCountableType[t1] => FALSE,
NOT IsCountableType[t2] => FALSE,
GetCountableType[t1] = GetCountableType[t2] => FALSE,
they conform without LOOPHOLE
GetCountableHostType[t1] # GetCountableHostType[t2] => FALSE,
different host types
GetCountableType[t1] = integer => GetFiniteType[t2].lower = 0,
GetCountableType[t2] = integer => GetFiniteType[t1].lower = 0,
ENDCASE => GetFiniteType[t1].lower = GetFiniteType[t2].lower]
END; -- of MesaLoopholeTypes
TranslateActualParameter:
PROCEDURE [id: IdentifierPtr] =
BEGIN
IF firstParameter THEN firstParameter ← FALSE
ELSE MustBe[commaSy, ",", MalformedParameterList]; -- between parameters
WITH id.class
SELECT
FROM
vid: VariableIdentifierTailPtr =>
IF vid.kind = var
THEN
BEGIN
v: ValuePtr;
q: OutputQueuePtr;
SayCh['@];
PushOut[];
v ← TranslateVariable[isLHS: TRUE];
IF MesaLoopholeTypes[id.type, v.type]
THEN
BEGIN
q ← CopyAndPopOut[];
Say["LOOPHOLE["];
MergeQueue[from: q];
Say[", "];
SayType[id.type];
SayCh[']];
END
ELSE BEGIN q ← CopyAndPopOut[]; MergeQueue[from: q]; END;
END
ELSE [] ← TranslateExpression[id.type];
pid: ProcedureIdentifierTailPtr =>
BEGIN SayIdent[ident]; MustBe[identSy, "", MalformedParameterList]; END;
ENDCASE => Error[MalformedParameterList];
END; -- of TranslateActualParameter
WITH id.class
SELECT
FROM
pid: ProcedureIdentifierTailPtr =>
WITH pid
SELECT
FROM
spid:
REF standard procedure IdentifierTail =>
IF spid.key
IN StandardProcedures
THEN
BEGIN
TranslateStandardProcedure[spid.key];
RETURN[Z.NEW[Value←[value: Z.NEW[ValueTail←[unknown[]]]]]];
END
ELSE RETURN[TranslateStandardFunction[spid.key]];
ENDCASE =>
-- either parameter or declared procedure IdentifierTail
BEGIN
t: TypePtr ← GetConcreteType[id.type];
pformals: IdentifierSetPtr;
WITH t SELECT FROM pt: ProcedureTypePtr => pformals ← pt.formals; ENDCASE;
SayIdent[id.name];
InSymbol[];
IF CouldBe[lParentSy, "["]
THEN
BEGIN
EnumerateIdentifierSet[pformals, TranslateActualParameter];
IF
NOT CouldBe[rParentSy, "]"]
THEN
BEGIN -- only God and the programmer know the
number and types of these parameters
SequenceOf[TranslateUntypedExpression, semiColonSy, ","];
hope for the best!
MustBe[rParentSy, "]", MalformedProcedureCall];
END;
END
ELSE Say["[]"];
END;
ENDCASE => Error[MalformedProcedureCall];
resultType ← ExtractResultType[id];
RETURN[
IF resultType = nilGeneralTypePtr
THEN
Z.NEW[Value←[value: Z.NEW[ValueTail←[unknown[]]]]]
ELSE Z.NEW[Value←[type: resultType, value: Z.NEW[ValueTail←[nonConstant[]]]]]];
END; -- of TranslateProcedureCall