
<<file:  PasDecl.mesa>>
<<modified by Ramshaw, January 20, 1984 2:17 pm>>
<<written by McCreight, October 10, 1980  1:20 PM>>

DIRECTORY
Convert USING [RopeFromInt],
PasPrivate,
PasPrivateVars,
Rope USING [Concat];

PasDecl: CEDAR PROGRAM
IMPORTS Convert, PasPrivate,
PasPrivateVars, Rope EXPORTS PasPrivate =

BEGIN

OPEN PasPrivate, PasPrivateVars;

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]_CreateIdentifierSet[] 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


NewLocalsFromFormals: PROCEDURE [id: IdentifierPtr] =
BEGIN
sid: IdentifierPtr;
psid: SegmentIdentifierTailPtr;

WITH display[lexLevel] SELECT FROM
cde: REF call DisplayEntry =>
IF cde.programSegment = NIL THEN sid _ NIL
ELSE 
{psitp: SegmentIdentifierTailPtr _ NARROW[cde.programSegment.class];
sid_IdentLookup[
name: id.name, pset: psitp.mentionedProcedures,
couldFail: TRUE]};
ENDCASE;


IF sid =  NIL THEN psid _ NIL ELSE psid _ NARROW[sid.class];

lexLevel _ lexLevel + 1;
WITH id.class SELECT FROM
pidt: ProcedureIdentifierTailPtr =>
WITH pidt SELECT FROM
dpidt: DeclaredProcedureIdentifierTailPtr =>
BEGIN
t: TypePtr _ GetConcreteType[id.type];
WITH t SELECT FROM
pt: ProcedureTypePtr =>
BEGIN
dpidt.defining _ TRUE;
display[lexLevel] _ Z.NEW[DisplayEntry_
[formals: call[programSegment: sid, isp: pt.formals],
locals: CreateIdentifierSet[]]];
END;
ENDCASE;
END;
ENDCASE;
ENDCASE;
END; -- of NewLocalsFromFormals


DisposeLocals: PROCEDURE [id: IdentifierPtr] =
BEGIN

FreeDynamicArray: PROCEDURE [id: IdentifierPtr] =
BEGIN
WITH id.class SELECT FROM
vid: VariableIdentifierTailPtr =>
BEGIN
IF id.type # nilGeneralTypePtr THEN
BEGIN
ct: TypePtr _ GetConcreteType[id.type];
WITH ct SELECT FROM
act: ArrayTypePtr =>
IF act.aIsDynamic THEN
BEGIN
Say["Pascal"];
IF targetLanguage = longMesa THEN Say["Long"];
Say["Zone.FREE[@"];
SayIdent[id.name];
Say["]; "]
END;
ENDCASE => NULL
END;
END;
ENDCASE => NULL;
END;

EnumerateIdentifierSet[display[lexLevel].locals, FreeDynamicArray];
DisposeIdentifierSet[display[lexLevel].locals];
WITH id.class SELECT FROM
pid: ProcedureIdentifierTailPtr => 
WITH pid SELECT FROM 
dpid: DeclaredProcedureIdentifierTailPtr => dpid.defining _ FALSE; ENDCASE;
ENDCASE;
lexLevel _ lexLevel - 1;
END; -- of DisposeLocals


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_CreateIdentifierSet[];
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_CreateIdentifierSet[];

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

ExtractResultType: PUBLIC PROCEDURE [id: IdentifierPtr] RETURNS [GeneralTypePtr] =
BEGIN
ct: TypePtr _ GetConcreteType[id.type];
WITH ct SELECT FROM pct: ProcedureTypePtr => RETURN[pct.result]; ENDCASE;
RETURN[nilGeneralTypePtr];
END; -- of ExtractResultType

END.  -- of PasDecl --