
<<file:  PasStd.mesa>>
<<modified by Ramshaw, December 20, 1982 8:30 pm>>
<<written by McCreight, November 13, 1980  2:34 PM>>
<<Last change by Pavel on September 20, 1984 2:51:11 pm PDT>>

DIRECTORY
IO,
PasPrivate,
PasPrivateVars,
Rope;

PasStd: CEDAR PROGRAM IMPORTS PasPrivate, Pas: PasPrivateVars, IO, Rope EXPORTS PasPrivate =

BEGIN

OPEN PasPrivate, Pas;

NumericType: TYPE = {integer, real};
Direction: TYPE = {input, output};

TranslateStandardProcedure: PUBLIC PROCEDURE [key: Standards] =
BEGIN
SELECT key FROM
Get, Put, Reset, Rewrite, Break, Page => TranslateGetPut[key];
Read => TranslateReadWrite[input, FALSE];
ReadLn => TranslateReadWrite[input, TRUE];
Write => TranslateReadWrite[output, FALSE];
WriteLn => TranslateReadWrite[output, TRUE];
New => TranslateNewDispose[s: "NEW", isNew: TRUE];
Dispose => TranslateNewDispose[s: "FREE", isNew: FALSE];
Assign, Concat =>
TranslateStringOp[s: PascalStandardProcedureNames[key], var2: TRUE];
PutChar => DefaultProcedure[key: key, var2: TRUE];
GetFileName => DefaultProcedure[key];
Pack, Unpack => TranslatePack[key];
Date, Time => DefaultProcedure[key: key, var1: TRUE];
ENDCASE =>
DefaultCall[s: PascalStandardProcedureNames[key], isQuestionable: TRUE];
END; -- of TranslateStandardProcedure


DefaultProcedure: PROCEDURE [
key: StandardProcedures, var1, var2, var3, var4: BOOLEAN _ FALSE] = {
DefaultCall[
s: PascalStandardProcedureNames[key], var1: var1, var2: var2, var3: var3,
var4: var4]};


DefaultCall: PROCEDURE [
s: ROPE, isQuestionable, var1, var2, var3, var4: BOOLEAN _ FALSE] =
BEGIN

CheckVar: PROCEDURE =
BEGIN
IF
(SELECT paramNo FROM
1 => var1,
2 => var2,
3 => var3,
4 => var4,
ENDCASE => FALSE) THEN SayCh['@];
END;

paramNo: CARDINAL _ 1;
Say["Pascal"];
Say[s];
IF isQuestionable THEN Respond["--?--"] ELSE InSymbol[];
IF CouldBe[lParentSy, "["] AND NOT CouldBe[rParentSy, "]"] THEN
BEGIN
CheckVar[];
[] _ TranslateExpression[nilGeneralTypePtr];
WHILE CouldBe[commaSy, ","] DO
paramNo _ paramNo + 1;
CheckVar[];
[] _ TranslateExpression[nilGeneralTypePtr];
ENDLOOP;
MustBe[rParentSy, "]", MalformedStandard];
END;
END; -- of DefaultCall

TranslateIOProcedure: PROCEDURE [
dir: Direction,
CallPerItem: PROCEDURE [
isText: BOOLEAN, fName: OutputQueuePtr, fEltType: GeneralTypePtr, item: ValuePtr],
CallAfterward: PROCEDURE [
isText: BOOLEAN, fName: OutputQueuePtr, fEltType: GeneralTypePtr]] =
BEGIN
isText: BOOLEAN;
fName: OutputQueuePtr;
fEltType: GeneralTypePtr;
InSymbol[]; -- the procedure name
IF CouldBe[lParentSy, ""] AND NOT CouldBe[rParentSy, ""] THEN
BEGIN
v: ValuePtr _ ParseExpressionAndSuggestString[];
ct: TypePtr _ GetConcreteTypeOfValue[v];
isText _ IsTextFile[v.type];
WITH ct SELECT FROM
fct: FileTypePtr =>
BEGIN fEltType _ fct.fileType; fName _ ExtractTranslation[v]; END;
ENDCASE => -- implicit Input or Output file
BEGIN
fEltType _ char;
PushOut[];
Say[IF dir = output THEN "Output" ELSE "Input"];
fName _ CopyAndPopOut[];
isText _ TRUE;
CallPerItem[isText, fName, fEltType, v];
<<to handle the value we just parsed>>

END;
WHILE CouldBe[commaSy, ""] DO
CallPerItem[isText, fName, fEltType, ParseExpressionAndSuggestString[]];
ENDLOOP;
MustBe[rParentSy, "", MalformedStandard];
END
ELSE
BEGIN
fEltType _ char;
PushOut[];
Say[IF dir = output THEN "Output" ELSE "Input"];
isText _ TRUE;
fName _ CopyAndPopOut[];
END;
CallAfterward[isText, fName, fEltType];
END; -- of TranslateIOProcedure


ParseExpressionAndSuggestString: PROCEDURE[] RETURNS [ValuePtr] =
BEGIN
v: ValuePtr _ ParseExpression[];
IF v.value.binding = stringConstant THEN
ExpressStringConstant[v, string];
RETURN[v];
END; -- of ParseExpressionAndSuggestString

TranslateGetPut: PROCEDURE [key: Standards] =
BEGIN

IgnoreExtraArg: PROCEDURE [
isText: BOOLEAN, fName: OutputQueuePtr, fEltType: GeneralTypePtr,
item: ValuePtr] = {Say[" -- ??  -- "]};

TranslateMainIOCall: PROCEDURE [
isText: BOOLEAN, fName: OutputQueuePtr, fEltType: GeneralTypePtr] =
BEGIN
Say["Pascal"];
IF isText THEN Say["Text"];
Say[PascalStandardProcedureNames[key]];
Say["[file: @"];
CopyQueue[from: fName];
IF NOT isText THEN
BEGIN
Say[".baseFile, length: SIZE["];
SayType[fEltType];
Say[", 2], element: @"];
CopyQueue[from: fName];
Say[".element"];
END;
SayCh[']];
END; -- of TranslateMainIOCall

TranslateIOProcedure[
dir: (SELECT key FROM Get, Reset => input, ENDCASE => output),
CallPerItem: IgnoreExtraArg, CallAfterward: TranslateMainIOCall];

END; -- of TranslateGetPut

TranslateReadWrite: PROCEDURE [dir: Direction, ln: BOOLEAN] =
BEGIN
statementCount: CARDINAL _ 0;

IsSimpleVariable: PROCEDURE [item: ValuePtr] RETURNS [BOOLEAN] =
BEGIN
WITH item.value SELECT FROM
var: REF variable ValueTail => {
name: ROPE _ var.translation.contents;
RETURN[ Rope.Equal[name, IO.GetID[IO.RIS[name]]] ];
};
ENDCASE => RETURN[FALSE];
END; -- of SayPostamble

SayPostamble: PROCEDURE =
BEGIN
IF statementCount > 0 THEN Say["; "];
statementCount _ statementCount + 1;
END; -- of SayPostamble

SayPreamble: PROCEDURE[] =
BEGIN Say["Pascal"]; Say[IF dir = output THEN "Write" ELSE "Read"]; END;
<<of SayPreamble>>

TranslateRWField: PROCEDURE [
isText: BOOLEAN, fName: OutputQueuePtr, fEltType: GeneralTypePtr,
item: ValuePtr] =
BEGIN
IOKinds: TYPE = {
unknown, general, integer, real, char, boolean, string, arrayOfChar};
kind: IOKinds;
routine: ARRAY IOKinds OF ROPE =
["Unknown", "", "Integer", "Real", "Char", "Boolean", "String",
"ArrayOfChar"];
isFunctional: PACKED ARRAY IOKinds OF BOOLEAN =
[FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE];
arrayLength: PascalInteger;
mustUseExprHack : BOOLEAN _ FALSE;

SELECT TRUE FROM
NOT isText =>
kind _ general;
IsScalarType[item.type] =>
kind _
(SELECT GetScalarType[item.type] FROM
Pas.integer => integer,
Pas.real => real,
Pas.char => char,
Pas.boolean => boolean,
Pas.string => string,
ENDCASE => unknown);
ENDCASE =>
BEGIN -- this had better be a packed array of chars, indexed by [1..n]
isCharArray: BOOLEAN _ FALSE;
[isCharArray, arrayLength] _ CheckForPascalString[item.type];
IF NOT isCharArray THEN Error[MalformedStandard];
kind _ arrayOfChar;
END;

SayPostamble[];
IF dir = input AND isFunctional[kind] THEN {
SayTranslation[item];
SayCh['_];
};
IF dir = output AND kind = general AND NOT IsSimpleVariable[item] THEN {
Say["{grossExprHack:"];
SayType[fEltType];
Say[" _ "];
SayTranslation[item];
Say["; "];
mustUseExprHack _ TRUE;
};
SayPreamble[];
IF (targetLanguage = longMesa OR targetLanguage = cedar)
AND NOT isFunctional[kind] THEN Say["Long"];
Say[routine[kind]];
Say["[file: @"];
CopyQueue[from: fName];
IF NOT isText THEN
BEGIN
Say[".baseFile, length: SIZE["];
SayType[fEltType];
Say[", 2], element: @"];
CopyQueue[from: fName];
Say[".element"];
END;
IF dir # input OR NOT isFunctional[kind] THEN
BEGIN
Say[", item: "];
IF dir = input OR kind = general OR kind = arrayOfChar THEN SayCh['@];
IF mustUseExprHack THEN
Say["grossExprHack"]
ELSE
SayTranslation[item];
END;
IF kind = arrayOfChar THEN {
Say[", arrayBound: "]; SayPascalInteger[arrayLength]};
IF CouldBe[colonSy, ""] THEN {
Say[", fieldMinLength: "]; [] _ TranslateExpression[]};
IF CouldBe[colonSy, ""] THEN {
Say[", fracLength: "]; [] _ TranslateExpression[]};
SayCh[']];
IF mustUseExprHack THEN
SayCh['}];
END; -- of TranslateRWField

SayLnIfNeeded: PROCEDURE [
isText: BOOLEAN, fName: OutputQueuePtr, fEltType: GeneralTypePtr] =
BEGIN
IF ln THEN
BEGIN
IF NOT isText THEN Error[MalformedStandard];
SayPostamble[];
SayPreamble[];
Say["Ln[file: @"];
CopyQueue[from: fName];
SayCh[']]
END;
END;

IOQ: OutputQueuePtr;

PushOut[]; -- see if we need a preliminary curly bracket

TranslateIOProcedure[
dir: dir, CallPerItem: TranslateRWField, CallAfterward: SayLnIfNeeded];

IOQ _ CopyAndPopOut[];
IF statementCount > 1 THEN SayCh['{];
MergeQueue[from: IOQ];
IF statementCount > 1 THEN SayCh['}];
END; -- of TranslateReadWrite


TranslateStringOp: PROCEDURE [s: ROPE, var1, var2, var3: BOOLEAN _ FALSE] =
BEGIN
argPos: CARDINAL _ 0;
v: ValuePtr;
q: OutputQueuePtr;

TranslateStringOpExpression: PROCEDURE =
BEGIN
isCharArray: BOOLEAN;
arrayLength: PascalInteger;
argPos _ argPos + 1;
IF (SELECT argPos FROM 1 => var1, 2 => var2, 3 => var3, ENDCASE => FALSE)
THEN SayCh['@];


IF argPos = 1 THEN -- the string argument
BEGIN
v _ ParseExpressionAndSuggestString[];
[isCharArray, arrayLength] _ CheckForPascalString[v.type];
IF isCharArray AND GetConcreteTypeOfValue[v] # string THEN SayCh['@];
SayTranslation[v];
IF isCharArray AND GetConcreteTypeOfValue[v] # string THEN {
Say[", "]; SayPascalInteger[arrayLength]};
END
ELSE [] _ TranslateExpression[];
END; -- of TranslateStringOpExpression

PushOut[];
InSymbol[];
MustBe[lParentSy, "[", MalformedStandard];
SequenceOf[TranslateStringOpExpression, commaSy, ","];
MustBe[rParentSy, "]", MalformedStandard];
q _ CopyAndPopOut[];
Say["Pascal"];
IF GetConcreteTypeOfValue[v] = string THEN Say["String"];
Say[s];
MergeQueue[from: q];
END; -- of TranslateStringOp

TranslateNewDispose: PROCEDURE [s: ROPE, isNew: BOOLEAN] =
BEGIN
vq: OutputQueuePtr;
v: ValuePtr;
ct: TypePtr;
et: GeneralTypePtr;
f: FieldListPtr;
varStk: ARRAY (0..10] OF RECORD [
q: OutputQueuePtr,
val: PascalInteger, -- value of tag field
f: FieldListPtr -- field list of which this is a tag value
];
varStkDepth, i, nRepresentedTags: [0..10] _ 0;

InSymbol[];
MustBe[lParentSy, "", MalformedNewDispose];
v _ ParseVariable[];
vq _ ExtractTranslation[v];
ct _ GetConcreteTypeOfValue[v];
WITH ct SELECT FROM
dct: PointerTypePtr => et _ dct.elType;
ENDCASE => Error[MalformedNewDispose];

ct _ GetConcreteType[et];
WITH ct SELECT FROM dct: RecordTypePtr => f _ dct.fieldList; ENDCASE => f _ NIL;

WHILE sy = commaSy DO
variant: VariantPtr;
tagVal: PascalInteger;
constVal: ScalarConstantValuePtr;
constValTail: ScalarConstantValueTailPtr;
InSymbol[];
constVal _ ParseCountableConstant[];
constValTail _ NARROW[constVal.value];
tagVal _ constValTail.v.value;
varStkDepth _ varStkDepth + 1;
IF f = NIL THEN Error[MalformedNewDispose];
IF f.tagStatus = identified THEN nRepresentedTags _ nRepresentedTags + 1;
varStk[varStkDepth] _ [q: ExtractTranslation[constVal], val: tagVal, f: f];
FOR variant _ f.firstVariant, variant.nextVariant WHILE variant # NIL AND
tagVal # variant.tagValue DO ENDLOOP;
IF f = NIL THEN Error[MalformedNewDispose];
f _ variant.fieldList;
ENDLOOP;

IF isNew THEN 
BEGIN
CopyQueue[from: vq];
Say[" _ "];
END;
Say["Pascal"];
IF targetLanguage = longMesa THEN Say["Long"];
Say["Zone."];
Say[s];
SayCh['[];
IF isNew THEN
BEGIN
FOR i DECREASING IN (0..varStkDepth] DO
CopyQueue[from: varStk[i].q]; SayCh[' ]; ENDLOOP;
SayType[et];
END
ELSE
BEGIN
SayCh['@];
CopyQueue[from: vq];
END;
MustBe[rParentSy, "]", MalformedNewDispose];

FOR i IN (0..varStkDepth] DO ClearQueue[varStk[i].q] ENDLOOP;
ClearQueue[vq];
END; -- of TranslateNewDispose

TranslatePack: PROCEDURE [key: Standards] =
BEGIN -- I'm going to assume that "z" and "a" are indexed by
<<subranges of INTEGER. If not, the this translator will>>
<<still work, but Mesa will not be willing to do the arithmetic>>
<<on the "a" index.>>

vz, va, vi: ValuePtr;
tz: TypePtr;
ixType: GeneralTypePtr;

SayZ: PROCEDURE = {SayTranslation[vz]; Say["[j]"]};

SayA: PROCEDURE =
BEGIN
SayTranslation[va];
Say["[j-FIRST["];
SayType[ixType];
Say["]+"];
SayTranslation[vi];
SayCh[']];
END;

InSymbol[];
MustBe[lParentSy, "", MalformedPack];
IF key = Pack THEN
BEGIN -- Pack
va _ ParseVariable[];
MustBe[commaSy, "", MalformedPack];
vi _ ParseExpression[];
MustBe[commaSy, "", MalformedPack];
vz _ ParseVariable[];
END
ELSE
BEGIN -- Unpack
vz _ ParseVariable[];
MustBe[commaSy, "", MalformedPack];
va _ ParseVariable[];
MustBe[commaSy, "", MalformedPack];
vi _ ParseExpression[];
END;
MustBe[rParentSy, "", MalformedPack];

tz _ GetConcreteTypeOfValue[vz];
WITH tz SELECT FROM
dtz: ArrayTypePtr => ixType _ dtz.aIxType;
ENDCASE => Error[MalformedPack];

Say["{ j: "];
SayType[ixType];
Say["; FOR j IN "];
SayType[ixType];
Say[" DO "];
IF key = Pack THEN {SayZ[]; Say[" _ "]; SayA[]}
ELSE {SayA[]; Say[" _ "]; SayZ[]};
Say[" ENDLOOP}"]
END; -- of TranslatePack


TranslateStandardFunction: PUBLIC PROCEDURE [key: Standards] RETURNS [ValuePtr] =
BEGIN
SELECT key FROM
Clock => {
Respond["PascalReadClock[]"]; RETURN[ConcreteValue[Pas.real]]};
Sqr => RETURN[TranslateNAryNumeric[key: key]];
Abs =>
RETURN[TranslateNAryNumeric[key: key, isGeneric: TRUE, useMesaOp: TRUE]];
Round, Trunc =>
BEGIN
[] _ TranslateNAryNumeric[key: key, anyReals: TRUE, isGeneric: TRUE];
RETURN[LikeValue[integerId]];
END;
Sin, Cos, Exp, Ln, Sqrt, Arctan =>
RETURN[TranslateNAryNumeric[key: key, anyReals: TRUE, isGeneric: TRUE]];
Min, Max =>
RETURN[
TranslateNAryNumeric[
key: key, arity: -1, isGeneric: TRUE, useMesaOp: TRUE]];
Odd => {[] _ TranslateUnary[key]; RETURN[ConcreteValue[Pas.boolean]]};
Chr => {[] _ TranslateUnary[key]; RETURN[ConcreteValue[Pas.char]]};
Ord => {[] _ TranslateUnary[key]; RETURN[ConcreteValue[Pas.integer]]};
First, Last => RETURN[MesaTypeFunction[key]];
Pred, Succ => RETURN[MesaScalarFunction[key]];
Card => {TranslateCard[]; RETURN[LikeValue[integerId]]};
EOF, EOLn, EOPage => {TranslateFileEnd[key]; RETURN[LikeValue[booleanId]]};
Length => RETURN[DefaultFunction[key]];
GetChar =>
BEGIN
DefaultCall[PascalStandardFunctionNames[key]];
RETURN[LikeValue[charId]];
END;
ENDCASE =>
BEGIN
DefaultCall[PascalStandardFunctionNames[key], TRUE];
RETURN[LikeValue[integerId]];
END;
END; -- of TranslateStandardFunction


DefaultFunction: PROCEDURE [
key: StandardFunctions, var1, var2, var3, var4: BOOLEAN _ FALSE]
RETURNS [ValuePtr] =
BEGIN
DefaultCall[
s: PascalStandardFunctionNames[key], var1: var1, var2: var2, var3: var3,
var4: var4];
RETURN[LikeValue[integerId]]
END;


MesaScalarFunction: PROCEDURE [key: Standards] RETURNS [ValuePtr] =
BEGIN
v: ValuePtr;
Respond[PascalStandardFunctionNames[key]];
MustBe[lParentSy, "[", MalformedStandard];
v _ TranslateExpression[nilGeneralTypePtr];
MustBe[rParentSy, "]", MalformedStandard];
RETURN[Z.NEW[Value_
[type: v.type, value: Z.NEW[ValueTail_[nonConstant[translation: NIL]]]]]];
END; -- of MesaScalarFunction


MesaTypeFunction: PROCEDURE [key: Standards] RETURNS [ValuePtr] =
BEGIN
v: ValuePtr;
Respond[PascalStandardFunctionNames[key]];
MustBe[lParentSy, "[", MalformedStandard];
v _ ParseExpression[nilGeneralTypePtr];
PushOut[];
SayTranslation[v];
PopOut[]; -- throw away translation
SayType[v.type]; -- and say its type instead
MustBe[rParentSy, "]", MalformedStandard];
RETURN[Z.NEW[Value_
[type: v.type, value: Z.NEW[ValueTail_[nonConstant[translation: NIL]]]]]];
END; -- of MesaTypeFunction


TranslateFileEnd: PROCEDURE [key: Standards] =
BEGIN

IgnoreExtraArg: PROCEDURE [
isText: BOOLEAN, fName: OutputQueuePtr, fEltType: GeneralTypePtr,
item: ValuePtr] = {Say[" -- ??  -- "]};

TranslateMainIOCall: PROCEDURE [
isText: BOOLEAN, fName: OutputQueuePtr, fEltType: GeneralTypePtr] =
BEGIN
Say["Pascal"];
IF isText THEN Say["Text"];
Say[PascalStandardFunctionNames[key]];
Say["[file: @"];
CopyQueue[from: fName];
IF NOT isText THEN Say[".baseFile"];
SayCh[']];
END; -- of TranslateMainIOCall

TranslateIOProcedure[
dir: input, CallPerItem: IgnoreExtraArg,
CallAfterward: TranslateMainIOCall];

END; -- of TranslateFileEnd


TranslateUnary: PROCEDURE [key: Standards] RETURNS [ValuePtr] =
BEGIN
v: ValuePtr;

Say["Pascal"];
Respond[PascalStandardFunctionNames[key]];
MustBe[lParentSy, "[", MalformedStandard];
v _ TranslateExpression[];
MustBe[rParentSy, "]", MalformedStandard];
RETURN[v];
END; -- of TranslateUnary


TranslateCard: PROCEDURE[] =
BEGIN
v: ValuePtr;
InSymbol[];
MustBe[lParentSy, "", MalformedStandard];
v _ ParseExpression[];
MustBe[rParentSy, "", MalformedStandard];
SaySetType[GetConcreteTypeOfValue[v]];
Say["CARD["];
SayTranslation[v];
SayCh[']];
END; -- of TranslateCARD


TranslateNAryNumeric: PROCEDURE [
key: Standards, arity: INTEGER _ 1, anyReals: BOOLEAN _ FALSE,
isGeneric: BOOLEAN _ FALSE, useMesaOp: BOOLEAN _ FALSE] RETURNS [ValuePtr] =
BEGIN
i, j: INTEGER;
args: ARRAY [1..10] OF ValuePtr;

InSymbol[];
i _ 0;
IF CouldBe[lParentSy, ""] THEN
WHILE NOT CouldBe[rParentSy, ""] DO
IF i > 0 THEN MustBe[commaSy, "", MalformedStandard];
i _ i + 1;
args[i] _ ParseExpression[];
IF GetConcreteTypeOfValue[args[i]] = real THEN anyReals _ TRUE;
ENDLOOP;


IF arity >= 0 AND i # arity THEN Error[BadArgumentCount];


IF NOT useMesaOp THEN Say["Pascal"];
IF NOT isGeneric THEN Say[IF anyReals THEN "Real" ELSE "Integer"];
Say[PascalStandardFunctionNames[key]];
SayCh['[];
FOR j IN [1..i] DO
IF j > 1 THEN SayCh[',];
IF anyReals AND GetConcreteTypeOfValue[args[j]] # real THEN
CoerceToReal[args[j]];
SayTranslation[args[j]];
ENDLOOP;
SayCh[']];
RETURN[ConcreteValue[IF anyReals THEN Pas.real ELSE Pas.integer]];
END; -- of ParseNAryNumeric


GetNumericType: PROCEDURE [t: GeneralTypePtr] RETURNS [NumericType] =
BEGIN
ct: TypePtr _ GetScalarType[t];
SELECT ct FROM
Pas.integer => RETURN[integer];
Pas.real => RETURN[real];
ENDCASE => Error[ImproperType];
RETURN[integer]; -- never gets here

END; -- of GetNumericType


END.  -- of PasStd --