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 --