DIRECTORY
PasPrivate,
PasPrivateVars;

PasType: CEDAR PROGRAM IMPORTS PasPrivate, PasPrivateVars EXPORTS PasPrivate =

BEGIN

OPEN PasPrivate, PasPrivateVars;


SayScalar: PUBLIC PROCEDURE [t: GeneralTypePtr, i: PascalInteger] =
BEGIN
ct: TypePtr _ GetConcreteType[t];
SELECT ct FROM
integer => SayPascalInteger[i];
char => {SayCh['']; SayCh[PascalIntegerToCh[i]]};
ENDCASE =>
WITH ct SELECT FROM
sct: ScalarTypePtr =>
BEGIN
id: IdentifierPtr _ sct.firstId;
WHILE id # NIL DO
cidt: REF constant IdentifierTail _ NARROW[id.class];
IF cidt.value = i THEN {SayIdent[id.name]; RETURN};
id_cidt.scalarLink;
ENDLOOP;
Error[MalformedScalar];
END;
ENDCASE => Error[MalformedScalar];
END; -- of SayScalar


SayScalarAsInteger: PUBLIC PROCEDURE [t: GeneralTypePtr, i: PascalInteger] =
BEGIN
SELECT GetConcreteType[t] FROM
integer => SayScalar[t, i];
ENDCASE =>
BEGIN
Say["PascalORD["];
SayType[t];
SayCh['[];
SayScalar[t, i];
Say["]]"];
END;
END; -- of SayScalarAsInteger


SayType: PUBLIC PROCEDURE [gtp: GeneralTypePtr] =
BEGIN
isFirst: BOOLEAN _ TRUE;

SayComma: PROCEDURE = {IF isFirst THEN isFirst _ FALSE ELSE Say[", "]};

SayNameAndType: PROCEDURE [id: IdentifierPtr] =
BEGIN
SayComma[];
SayIdent[id.name];
WITH id.type SELECT FROM
dt: TypePtr => {Say[": "]; SayType[id.type]};
dt: IdentifierPtr => IF dt.class.idClass = type THEN {Say[": "]; SayType[id.type]};

ENDCASE;
END; -- of SayNameAndType

WITH gtp SELECT FROM
dgtp: REF Identifier =>
IF dgtp.class.idClass = type THEN
SELECT dgtp FROM
integerId => Say["PascalInteger"];
realId => Say["PascalReal"];
charId => Say["PascalChar"];
booleanId => Say["PascalBoolean"];
stringId => Say["String"];
ENDCASE => SayIdent[dgtp.name]
ELSE SayType[dgtp.type];
dgtp: REF Type =>
SELECT dgtp FROM
integer => Say["PascalInteger"];
real => Say["PascalReal"];
char => Say["PascalChar"];
boolean => Say["PascalBoolean"];
string => Say["String"];
ENDCASE => -- say its internal structure
WITH dgtp SELECT FROM
ddgtp: ScalarTypePtr =>
BEGIN
id: IdentifierPtr _ ddgtp.firstId;
SayCh['{];
UNTIL id = NIL DO
cidt: REF constant IdentifierTail _ NARROW[id.class];
SayComma[]; SayIdent[id.name]; 
id_cidt.scalarLink;
ENDLOOP;
SayCh['}];
END;
ddgtp: SubRangeTypePtr =>
BEGIN
SayType[ddgtp.hostType];
SayCh['[];
SayScalar[ddgtp.hostType, ddgtp.lower];
Say[".."];
SayScalar[ddgtp.hostType, ddgtp.upper];
SayCh[']];
END;
ddgtp: PointerTypePtr => {Say[pointerName]; SayType[ddgtp.elType]};
ddgtp: PowerTypePtr =>
BEGIN
SaySetType[ddgtp];
Say[" -- OF "];
SayType[ddgtp.baseType];
Say[" -- "];
END;
ddgtp: ArrayTypePtr =>
BEGIN
IF ddgtp.aIsPacked THEN Say["PACKED "];
Say["ARRAY "];
SayType[ddgtp.aIxType];
Say[" OF "];
SayType[ddgtp.aElType];
END;
ddgtp: ProcArrayTypePtr =>
BEGIN
SayProcArrayIndexType: PROCEDURE [id: IdentifierPtr] =
{ SayComma[];  Say[id.name];  Say[": "];  SayType[id.type] };
Say["PROCEDURE ["];
isFirst _ TRUE;
EnumerateIdentifierSet[ddgtp.indices, SayProcArrayIndexType];
Say["] RETURNS ["];
Say[varPointerName];
SayType[ddgtp.aElType];
Say["]"];
END;
ddgtp: ComputedSeqArrayTypePtr =>
BEGIN
Say["RECORD[SEQUENCE COMPUTED CARDINAL OF "];
SayType[ddgtp.aElType];
Say["]"];
END;
ddgtp: RecordTypePtr =>
BEGIN

SayFieldList: PROCEDURE [f: FieldListPtr, depth: PascalInteger _ 1] =
BEGIN

EqualFieldLists: PROCEDURE [f1, f2: FieldListPtr]
RETURNS [BOOLEAN] =
BEGIN -- this snippet does not show Mesa at its best!
WITH f1 SELECT FROM
df1: REF identified FieldList =>
WITH f2 SELECT FROM
df2: REF identified FieldList => RETURN[df1 = df2];
ENDCASE => RETURN[FALSE];
df1: REF unidentified FieldList =>
WITH f2 SELECT FROM
df2: REF unidentified FieldList => RETURN[df1 = df2];
ENDCASE => RETURN[FALSE];
ENDCASE => RETURN[FALSE];
END;

tType: GeneralTypePtr;
v: VariantPtr;
savedIsFirst: BOOLEAN _ isFirst;
isFirst _ TRUE;
EnumerateIdentifierSet[f.fieldSet, SayNameAndType];
IF f.firstVariant # NIL THEN
BEGIN
WITH f SELECT FROM
df: REF identified FieldList =>
BEGIN
SayComma[];
SayIdent[df.tagId.name];
Say[": "];
SayType[df.tagId.type];
tType _ df.tagId.type;
END;
df: REF unidentified FieldList => tType _ df.tagType;
ENDCASE;
SayComma[];
Say["x"];
SayPascalInteger[depth];
Say[": "];
Say["SELECT OVERLAID "];
SayType[tType];
Say[" FROM "];
isFirst _ TRUE;
FOR v _ f.firstVariant, v.nextVariant WHILE v # NIL DO
SayComma[];
SayScalar[tType, v.tagValue];
IF v.nextVariant = NIL OR NOT EqualFieldLists[
v.fieldList, v.nextVariant.fieldList] THEN {
Say[": "]; SayFieldList[v.fieldList, depth + 1]};
ENDLOOP;
END;
isFirst _ savedIsFirst;
END; -- of SayFieldList

Say["RECORD["];
SayFieldList[ddgtp.fieldList];
SayCh[']];
END;
ddgtp: FileTypePtr =>
BEGIN
IF IsTextFile[gtp] THEN Say["PascalTextFile"]
ELSE
BEGIN
Say["RECORD[baseFile: PascalFile, element: "];
SayType[ddgtp.fileType];
Say[" _ NULL]"];
END;
END;
ENDCASE; -- on t

ENDCASE; -- on gtp

END; -- of SayType


GetConcreteType: PUBLIC PROCEDURE [gtp: GeneralTypePtr] RETURNS [TypePtr] =
BEGIN
DO
IF gtp=NIL THEN Error[UndefinedType];
WITH gtp SELECT FROM
dgtp: IdentifierPtr => gtp _ dgtp.type;
dgtp: TypePtr => RETURN[dgtp];
ENDCASE;
ENDLOOP;
END; -- of GetConcreteType


Force: PROCEDURE [
gtp: GeneralTypePtr,
check: PROCEDURE [argT: GeneralTypePtr]
RETURNS [is: BOOLEAN, t: GeneralTypePtr]] RETURNS [t: GeneralTypePtr] =
BEGIN
is: BOOLEAN;
[is: is, t: t] _ check[gtp];
IF NOT is THEN Error[UnexpectedType];
END; -- of Force


Is: PROCEDURE [
gtp: GeneralTypePtr,
check: PROCEDURE [argT: GeneralTypePtr]
RETURNS [is: BOOLEAN, t: GeneralTypePtr]] RETURNS [BOOLEAN] = {
RETURN[check[gtp].is]};


GenScalarType: PUBLIC PROCEDURE [gtp: GeneralTypePtr] RETURNS [GeneralTypePtr] =
{RETURN[Force[gtp, CheckScalarType]]};

IsScalarType: PUBLIC PROCEDURE [gtp: GeneralTypePtr] RETURNS [BOOLEAN] = {
RETURN[Is[gtp, CheckScalarType]]};

CheckScalarType: PROCEDURE [argT: GeneralTypePtr]
RETURNS [is: BOOLEAN, t: GeneralTypePtr] =
BEGIN
ct: TypePtr;
IF argT # nilGeneralTypePtr AND (ct _ GetConcreteType[argT]) # NIL THEN
WITH ct SELECT FROM
dt: SubRangeTypePtr => RETURN[TRUE, dt.hostType];
dt: ScalarTypePtr => RETURN[TRUE, argT];
ENDCASE => NULL;
RETURN[FALSE, nilGeneralTypePtr];
END; -- of CheckScalarType


GenCountableType: PUBLIC PROCEDURE [gtp: GeneralTypePtr]
RETURNS [GeneralTypePtr] = {RETURN[Force[gtp, CheckCountableType]]};

IsCountableType: PUBLIC PROCEDURE [gtp: GeneralTypePtr] RETURNS [BOOLEAN] = {
RETURN[Is[gtp, CheckCountableType]]};

CheckCountableType: PROCEDURE [argT: GeneralTypePtr]
RETURNS [is: BOOLEAN, t: GeneralTypePtr] =
BEGIN
ct: TypePtr;
IF argT # nilGeneralTypePtr AND (ct _ GetConcreteType[argT]) # NIL THEN
WITH ct SELECT FROM
dt: SubRangeTypePtr => RETURN[TRUE, argT];
dt: ScalarTypePtr => IF ct # real AND ct # string THEN RETURN[TRUE, argT];
ENDCASE => NULL;
RETURN[FALSE, nilGeneralTypePtr];
END; -- of CheckCountableType


GenCountableHostType: PUBLIC PROCEDURE [gtp: GeneralTypePtr]
RETURNS [GeneralTypePtr] = {RETURN[Force[gtp, CheckCountableHostType]]};

IsCountableHostType: PUBLIC PROCEDURE [gtp: GeneralTypePtr] RETURNS [BOOLEAN] =
{RETURN[Is[gtp, CheckCountableHostType]]};

CheckCountableHostType: PROCEDURE [argT: GeneralTypePtr]
RETURNS [is: BOOLEAN, t: GeneralTypePtr] =
BEGIN
ct: TypePtr;
[is, t] _ CheckCountableType[argT];
IF NOT is THEN RETURN;
ct _ GetConcreteType[t];
WITH ct SELECT FROM
dt: ScalarTypePtr => RETURN[TRUE, t];
dt: SubRangeTypePtr => RETURN[TRUE, dt.hostType];
ENDCASE;
END; -- of CheckCountableHostType


GenFiniteType: PUBLIC PROCEDURE [gtp: GeneralTypePtr]
RETURNS [t: GeneralTypePtr, lower, upper: PascalInteger] =
BEGIN
tp: TypePtr;
t _ GenCountableType[gtp];
tp _ GetConcreteType[t];
WITH tp SELECT FROM
dt: ScalarTypePtr => IF tp # integer THEN RETURN[t, 0, dt.size - 1];
dt: SubRangeTypePtr => RETURN[GenCountableHostType[t], dt.lower, dt.upper];
ENDCASE => NULL;
Error[NotFiniteType];
END; -- of GenFiniteType

IsFiniteType: PUBLIC PROCEDURE [gtp: GeneralTypePtr] RETURNS [BOOLEAN] = {
RETURN[GetCountableType[gtp] # integer]};



CheckForPascalString: PUBLIC PROCEDURE [t: GeneralTypePtr]
RETURNS [is: BOOLEAN, length: PascalInteger] =
BEGIN
ct: TypePtr _ GetConcreteType[t];
IF ct = string THEN RETURN[is: TRUE, length: -1];
WITH ct SELECT FROM
at: ArrayTypePtr =>
IF at.aIsPacked AND IsFiniteType[at.aIxType] AND IsFiniteType[at.aElType]
THEN
BEGIN
it: TypePtr;
lower, upper: PascalInteger;
[it, lower, upper] _ GetFiniteType[at.aIxType];
IF GetCountableType[at.aElType] = char AND lower <= upper
THEN RETURN[is: TRUE, length: upper-lower+1];
END;
ENDCASE => NULL;
RETURN[is: FALSE, length: 0];
END; -- of CheckForPascalString


PowerSetOf: PUBLIC PROCEDURE [t: GeneralTypePtr] RETURNS [GeneralTypePtr] =
BEGIN
pt: TypePtr _ Z.NEW[Type_[power[baseType: t]]];
RETURN[pt];
END; -- of PowerSetOf


IsTextFile: PUBLIC PROCEDURE [t: GeneralTypePtr] RETURNS [BOOLEAN] =
BEGIN
ct: TypePtr _ GetConcreteType[t];
WITH ct SELECT FROM
ft: FileTypePtr => IF GetConcreteType[ft.fileType] = char THEN RETURN[TRUE];
ENDCASE => NULL;
RETURN[FALSE];
END; -- of IsTextFile


TranslateIdList: PUBLIC PROCEDURE [pset: IdentifierSetPtr _ NIL] =
BEGIN -- sy=identSy

TranslateIdInList: PROCEDURE =
BEGIN
new: IdentifierPtr;
IF sy # identSy THEN Error[MalformedIdList];
new _ NewIdent[pset: pset];
SayIdent[ident];
InSymbol[];
END; -- of TranslateIdInList

InitIdentifierSet[pset];
SequenceOf[TranslateIdInList, commaSy];
END; -- TranslateIdList


TranslateVariableList: PUBLIC PROCEDURE [
pset: IdentifierSetPtr _ NIL, fwdOK: BOOLEAN _ FALSE] =
BEGIN -- sy=identSy

MarkAsNormalIdentifier: PROCEDURE [id: IdentifierPtr] = {
id.class _ Z.NEW[IdentifierTail_[variable[kind: normal]]]};

setPtr: IdentifierSetPtr_CreateIdentifierSet[];

TranslateIdList[pset: setPtr];
MustBe[colonSy, ":", MalformedIdList];
AssignTypeToIdSet[pset: setPtr, type: TranslateType[fwdOK: fwdOK]];
EnumerateIdentifierSet[setPtr, MarkAsNormalIdentifier];
MergeIdentifierSets[into: pset, from: setPtr];
END; -- TranslateVariableList


TranslateSimpleType: PROCEDURE [id: IdentifierPtr _ NIL, fwdOK: BOOLEAN]
RETURNS [GeneralTypePtr] =
BEGIN
SELECT sy FROM
lParentSy =>
BEGIN
set: IdentifierSetPtr _ CreateIdentifierSet[];
isFirst: BOOLEAN _ TRUE;
lastId: ConstantIdentifierTailPtr _ NIL;
nextElementValue: CARDINAL _ 0;
t: ScalarTypePtr;
SpecifyElementValue: PROCEDURE [id: IdentifierPtr] =
BEGIN
cTail: ConstantIdentifierTailPtr_Z.NEW[constant IdentifierTail_
[constant[scalarLink: NIL, value: nextElementValue]]];
id.class _ cTail;
IF isFirst THEN {t.firstId _ id; isFirst _ FALSE}
ELSE lastId.scalarLink _ id;
lastId _ cTail;
nextElementValue _ nextElementValue + 1;
END;

MustBe[lParentSy, "{", MalformedSimpleType];
TranslateIdList[pset: set];
MustBe[rParentSy, "}", MalformedSimpleType];
t_Z.NEW[scalar Type_[scalar[firstId: NIL, size: 0]]];
AssignTypeToIdSet[
pset: set,
type: IF id # NIL THEN id ELSE t];
EnumerateIdentifierSet[set, SpecifyElementValue];
t.size _ nextElementValue;
MergeIdentifierSets[from: set];
RETURN[t];
END;

identSy, addOpSy, intConstSy, stringConstSy =>
BEGIN
c: ScalarConstantValuePtr;
cTail: ScalarConstantValueTailPtr;
t: SubRangeTypePtr;



IF sy = identSy THEN
BEGIN
id: IdentifierPtr _ IdentLookup[couldFail: fwdOK];
IF id # NIL THEN
WITH id.class SELECT FROM
didt: REF type IdentifierTail => SayType[id];
ENDCASE => GOTO TryConstant
ELSE -- hasn't been declared yet, plan on somebody later doing it
BEGIN
id _ NewIdent[];
id.type _ nilGeneralTypePtr;
id.class _ Z.NEW[type IdentifierTail_[type[]]];
SayIdent[ident];
END;
InSymbol[];
RETURN[id]
EXITS TryConstant => NULL;
END;

c _ ParseCountableConstant[]; -- subrange a..b
cTail _ NARROW[c.value];
SayType[c.type];
SayCh['[];
SayTranslation[c];
t _ Z.NEW[subRange Type_[subRange[hostType: c.type, lower: cTail.v.value, upper: NULL]]];
IF sy # colonSy THEN Error[MalformedRangeType];
Say[".."];
InSymbol[];
c _ ParseCountableConstant[];
cTail _ NARROW[c.value];
SayTranslation[c];
SayCh[']];
IF t.hostType # c.type THEN Error[MalformedRangeType];
t.upper _ cTail.v.value;
RETURN[t];
END;
ENDCASE => Error[MalformedSimpleType];
RETURN[nilGeneralTypePtr]; -- never gets here

END; -- of TranslateSimpleType


TranslateType: PUBLIC PROCEDURE [
id: IdentifierPtr _ NIL,
fwdOK: BOOLEAN _ FALSE,
packArrays: BOOLEAN _ FALSE,
outerArrayIsFunny: ArrayDifferentlyMethod _ notAtAll] RETURNS [GeneralTypePtr] =
BEGIN

TranslateArrayTail: PROCEDURE [packIt: BOOL _ FALSE] RETURNS [GeneralTypePtr] =
BEGIN -- sy=lBrackSy or commaSy
aTP: ArrayTypePtr;
IF packIt THEN Say["PACKED "];
Say["ARRAY "];
InSymbol[];
aTP _ Z.NEW[array Type_
[array[aIxType: TranslateSimpleType[fwdOK: fwdOK],
aElType: nilGeneralTypePtr,
aIsPacked: packIt]]];
SELECT sy FROM
commaSy => {Say[" OF "]; aTP.aElType _ TranslateArrayTail[packIt]};
rBrackSy =>
BEGIN
InSymbol[];
MustBe[ofSy, " OF ", MalformedType];
aTP.aElType _ TranslateType[fwdOK: fwdOK];
END;
ENDCASE => Error[MalformedType];
RETURN[aTP];
END; -- of TranslateArrayTail

TranslateFieldList: PROCEDURE [depth: PascalInteger _ 1] RETURNS [FieldListPtr] =
BEGIN -- sy=identSy
last, firstThisType, lastThisType, id: IdentifierPtr _ NIL;
tagId: IdentifierPtr;
gtp: GeneralTypePtr;
lastVariant: VariantPtr _ NIL;
commaAfterLastField: BOOLEAN _ FALSE;
fL: FieldListPtr _ Z.NEW[unidentified FieldList];

TranslateVariant: PROCEDURE =
BEGIN
first, last, v: VariantPtr _ NIL;
tagType: TypePtr _ GetConcreteType[gtp];
vFL: FieldListPtr;

TranslateVariantTag: PROCEDURE =
BEGIN
v: VariantPtr;
c: ScalarConstantValuePtr _ ParseCountableConstant[];
cTail: ScalarConstantValueTailPtr _ NARROW[c.value];
cType: TypePtr _ GetConcreteTypeOfValue[c];
SayTranslation[c];
WITH tagType SELECT FROM
t: ScalarTypePtr => IF cType # tagType THEN Error[MalformedType];
t: SubRangeTypePtr =>
IF cType # GetConcreteType[t.hostType] OR cTail.v.value < t.lower OR
cTail.v.value > t.upper THEN Error[MalformedType];
ENDCASE => Error[MalformedType];
v _ Z.NEW[Variant_[nextVariant: NIL, tagValue: cTail.v.value, fieldList: NIL]];
IF first = NIL THEN first _ v ELSE last.nextVariant _ v;
last _ v;
END; -- of TranslateVariantTag

SequenceOf[TranslateVariantTag, commaSy];
MustBe[colonSy, "=>", MalformedType];
MustBe[lParentSy, "[", MalformedType];
vFL _ TranslateFieldList[depth + 1];
MustBe[rParentSy, "]", MalformedType];
FOR v _ first, v.nextVariant UNTIL v = NIL DO v.fieldList _ vFL; ENDLOOP;

IF fL.firstVariant = NIL THEN fL.firstVariant _ first
ELSE lastVariant.nextVariant _ first;
lastVariant _ last;
END; -- of TranslateVariant

TranslateField: PROCEDURE = {
IF sy # caseSy THEN
TranslateVariableList[pset: fL.fieldSet, fwdOK: fwdOK]
ELSE commaAfterLastField _ TRUE};

fL.fieldSet_CreateIdentifierSet[];
IF sy # identSy AND sy # caseSy THEN RETURN[fL]; -- empty is OK
IF sy = identSy THEN
BEGIN
SequenceOf[TranslateField, semiColonSy, ","];
IF sy = caseSy AND NOT commaAfterLastField THEN SayCh[',];
END;
IF sy # caseSy THEN RETURN[fL];
InSymbol;
IF sy # identSy THEN Error[MalformedType];


InSymbol;
SELECT sy FROM
colonSy =>
BEGIN
newfL: FieldListPtr;
sy _ identSy;
SayIdent[ident];
SayCh[':];
tagId _ NewIdent[pset: fL.fieldSet];
tagId.class _ Z.NEW[IdentifierTail_[variable[kind: normal]]];
newfL _ Z.NEW[FieldList_[fieldSet: fL.fieldSet,
firstVariant: fL.firstVariant,
tagSpecific: identified[tagId: tagId]]];
fL _ newfL;
InSymbol;
IF sy # identSy THEN Error[MalformedType];
gtp _ TranslateSimpleType[fwdOK: fwdOK];
tagId.type _ gtp;
Say[", x"];
SayPascalInteger[depth];
Say[": SELECT OVERLAID "];
SayType[gtp];
Say[" FROM "];
MustBe[ofSy, "", MalformedType];
END;
ofSy =>
BEGIN
sy _ identSy;
Say["x"];
SayPascalInteger[depth];
Say[": SELECT OVERLAID "];
gtp _ TranslateSimpleType[fwdOK: fwdOK];
Say[" FROM "];
NARROW[fL, REF unidentified FieldList].tagType _ gtp;
END;
ENDCASE => Error[MalformedType];
SequenceOf[TranslateVariant, semiColonSy, ","];
Say[", ENDCASE"];
RETURN[fL];
END; -- of TranslateFieldList


SELECT sy FROM

arrowSy =>
BEGIN
tP: PointerTypePtr;
InSymbol[];
Say[pointerName];
tP _ Z.NEW[pointer Type_[pointer[elType: TranslateType[fwdOK: fwdOK]]]];
RETURN[tP];
END;

setSy =>
BEGIN
q: OutputQueuePtr;
t: GeneralTypePtr;
InSymbol[];
MustBe[ofSy, "", MalformedType];
PushOut[];
t _ PowerSetOf[TranslateSimpleType[fwdOK: fwdOK]];
q _ CopyAndPopOut[];
SaySetType[GetConcreteType[t]];
Say[" -- OF "];
MergeQueue[from: q];
Say[" -- "];
RETURN[t];
END;

packedSy =>
BEGIN
q: OutputQueuePtr;
gtp: GeneralTypePtr;
InSymbol[];
PushOut[];
gtp _ TranslateType[fwdOK: fwdOK, packArrays: TRUE,
outerArrayIsFunny: outerArrayIsFunny];
q _ CopyAndPopOut[];
WITH gtp SELECT FROM
dgtp: REF array Type =>
IF NOT dgtp.aIsPacked THEN Error[Confusion];
dgtp: REF procArray Type =>
NULL;
dgtp: REF computedSeqArray Type =>
Error[MalformedType];  -- because
dgtp: REF record Type =>
IF dgtp.recIsPacked THEN Error[MalformedType]
ELSE {Say[" -- PACKED -- "]; dgtp.recIsPacked _ TRUE};
dgtp: REF file Type =>
IF dgtp.fileIsPacked THEN Error[MalformedType]
ELSE dgtp.fileIsPacked _ TRUE;
ENDCASE => Error[MalformedType];
MergeQueue[q];
RETURN[gtp];
END;

arraySy =>
BEGIN
InSymbol;
IF sy # lBrackSy THEN Error[MalformedType];
SELECT outerArrayIsFunny FROM
procArray => 
BEGIN
TranslateProcArrayIndex: PROCEDURE =
BEGIN
id: IdentifierPtr;
curOrdinal _ curOrdinal + 1;
id _ NewIdent[ordinalNames[curOrdinal], aTP.indices];
Say[id.name]; Say[": "];
id.type _ TranslateSimpleType[fwdOK: fwdOK];
END;
Ordinal: TYPE = [1..10];
curOrdinal: INT _ 0;
ordinalNames: ARRAY Ordinal OF ROPE = 
["First", "Second", "Third", "Fourth", "Fifth",
"Sixth", "Seventh", "Eighth", "Ninth", "Tenth"];
aTP: ProcArrayTypePtr;
Say["PROCEDURE ["];
InSymbol[];  -- digest the left bracket
aTP _ Z.NEW[procArray Type_
[procArray[aElType: nilGeneralTypePtr, indices: CreateIdentifierSet[]]]];
SequenceOf[TranslateProcArrayIndex, commaSy, ", "];
MustBe[rBrackSy, "]", MalformedType];
MustBe[ofSy, " RETURNS [Result: ", MalformedType];
Say[varPointerName];
aTP.aElType _ TranslateType[fwdOK: fwdOK];
Say["]"];
RETURN[aTP];
END;
computedSeqArray =>
BEGIN
aTP: ComputedSeqArrayTypePtr _ Z.NEW[computedSeqArray Type_
[computedSeqArray[aElType: nilGeneralTypePtr]]];
InSymbol[];  -- digest the left bracket
PushOut[]; --prepare to throw away the index type
IF NOT IsScalarType[TranslateSimpleType[fwdOK: fwdOK]] THEN
Error[MalformedComputedSeqArrayDeclaration];
PopOut[];  --there it went!
MustBe[rBrackSy, "RECORD[SEQUENCE COMPUTED CARDINAL OF", MalformedComputedSeqArrayDeclaration];
MustBe[ofSy, "", MalformedComputedSeqArrayDeclaration];
aTP.aElType _ TranslateType[fwdOK: fwdOK];
Say["]"];
RETURN[aTP];
END
ENDCASE => RETURN[TranslateArrayTail[packIt: packArrays]];
END;

recordSy =>
BEGIN
tP: RecordTypePtr;
Say["RECORD ["];
InSymbol;
tP _ Z.NEW[record Type _[record[fieldList: TranslateFieldList[]]]];
MustBe[endSy, "]", MalformedType];
RETURN[tP];
END;

fileSy =>
BEGIN
tP: FileTypePtr;
q: OutputQueuePtr;
InSymbol[];
MustBe[ofSy, "", MalformedType];
PushOut[];
tP _ Z.NEW[file Type_[file[fileType: TranslateType[fwdOK: fwdOK]]]];
q _ CopyAndPopOut[];
IF IsTextFile[tP] THEN
BEGIN Say["PascalTextFile"]; ClearQueue[q]; END
ELSE
BEGIN
Say["RECORD[baseFile: PascalFile, element: "];
MergeQueue[from: q];
Say[" _ NULL]"]
END;
RETURN[tP];
END;

ENDCASE => RETURN[TranslateSimpleType[id: id, fwdOK: fwdOK]];
END; -- of TranslateType


SaySetType: PUBLIC PROCEDURE [t: TypePtr] =
BEGIN
WITH t SELECT FROM
dt: PowerTypePtr =>
BEGIN
lower, upper: PascalInteger;
st: TypePtr;
[st, lower, upper] _ GetFiniteType[dt.baseType];
SELECT upper - lower FROM
< 16 => Say["PascalSmallSet"];
< 64 => Say["PascalMediumSet"];
< 256 => Say["PascalLargeSet"];
ENDCASE => Error[SetTooLarge];
END;
ENDCASE => Error[NotASet];
END; -- of SaySetType


SaySetOriginOffset: PUBLIC PROCEDURE [baseType: GeneralTypePtr] =
BEGIN
lower, upper: PascalInteger;
st: GeneralTypePtr;
[st, lower, upper] _ GenFiniteType[baseType];
IF lower = 0 THEN RETURN;
SayCh['-];
SayScalarAsInteger[st, lower];
END; -- of SaySetOriginOffset


DisposeType: PUBLIC PROCEDURE [gtp: GeneralTypePtr] =
BEGIN
NULL;  -- I tried sticking in some FREE[@. . .], but the compiler complained
END; -- of DisposeType


DisposeFieldList: PROCEDURE [fl: FieldListPtr] =
BEGIN
NULL;
END; -- of DisposeFieldList

END.  -- of PasType --



šfile:  PasType.mesa
modified by Ramshaw,  October 27, 1983 3:10 pm
written by McCreight, September 16, 1980  4:54 PM
Last Edited by: Plass, December 15, 1982 11:25 am
Last Edited by: Pavel, September 18, 1984 3:08:48 pm PDT
ELSE somebody else will say the type later on
we have a type identifier or a named constant starting a subrange
There follows a small hack. In either legal case we must recover
the identifier and use it either as a field or as a type, but
we don't yet know which. Fortunately the scanner does not
modify PasVars.ident except when it sees a new identifier,
so we can get the effect of a one-symbol look-ahead
by simply re-loading PasVars.sy with the constant identSy.
uses left-over ident string. colonSy didn't change it.
Now, fL should have been identified, not unidentified!
So, allocate a new one and copy the fields:
computedSeq arrays only make sense if elType takes more than one word
�Êû˜J˜Jš
œ™Jš
œ.™.Jš
œ1™1Jš
œ1™1Jš
œ8™8J˜š
Ïk	˜	J˜J˜J˜—Jš	œ	�œ
�œ
�œ�œ
˜N˜Jš
�˜J˜Jš�œ˜ J˜J˜šÏn	œ�œ
�	œ(˜CJš
�˜J˜!š�œ�˜J˜J˜1š�œ˜
š�œ�œ
�˜˜Jš
�˜J˜ š�œ�œ
�˜Jšœ�œ�œ˜5Jš�œ�œ�œ˜3J˜Jš�œ
˜—J˜Jš�œ
˜—Jš�œ˜"———Jš�œÏc˜J˜J˜—šžœ�œ
�	œ(˜LJš
�˜š�œ�˜J˜š�œ˜
Jš
�˜J˜J˜J˜
J˜J˜
Jš�œ
˜——Jš�œŸ˜J˜J˜—šžœ�œ
�	œ˜1Jš
�˜Jšœ	�œ�œ
˜J˜Jšžœ�	œ�œ	�œ�œ
�œ˜GJ˜šžœ�	œ˜/Jš
�˜J˜J˜š�œ	�œ
�˜J˜-Jšœ�œ�œ˜SJš
œ-™-J˜Jš�œ
˜—Jš�œŸ˜J˜—š�œ�œ
�˜šœ�œ˜š�œ�˜!š�œ�˜J˜"J˜J˜J˜"J˜Jš�œ˜——Jš�œ˜—šœ�œ˜š�œ�˜J˜ J˜J˜J˜ J˜š�œŸ˜(š�œ�œ
�˜˜Jš
�˜J˜"J˜
š�œ�œ
�˜Jšœ�œ�œ˜5J˜J˜Jš�œ
˜—J˜
Jš�œ
˜—˜Jš
�˜J˜J˜
J˜'J˜
J˜'J˜
Jš�œ
˜—J˜C˜Jš
�˜J˜J˜J˜J˜Jš�œ
˜—˜Jš
�˜Jš�œ�œ˜'J˜J˜J˜J˜Jš�œ
˜˜Jš
�˜šžœ�	œ˜6J˜=—J˜Jšœ
�œ
˜J˜=J˜J˜J˜J˜	Jš�œ
˜—š
œ!˜!Jš
�˜J˜-J˜J˜	Jš�œ
˜—˜Jš
�˜J˜šžœ�	œ.˜EJš
�˜J˜šžœ�	œ˜1Jš�œ�œ˜Jš�œ
Ÿ/˜5š�œ�œ
�˜šœ�œ˜ š�œ�œ
�˜Jšœ�œ�œ˜3Jš�œ�œ
�œ˜——šœ�œ˜"š�œ�œ
�˜Jšœ�œ�œ˜5Jš�œ�œ
�œ˜——Jš�œ�œ
�œ˜—Jš�œ
˜J˜—J˜J˜Jšœ�œ˜ Jšœ
�œ
˜J˜3š�œ�œ
�˜Jš
�˜š�œ�œ
�˜šœ�œ˜Jš
�˜J˜J˜J˜
J˜J˜Jš�œ
˜—Jšœ�œ.˜5Jš�œ
˜—J˜J˜	J˜J˜
J˜J˜J˜Jšœ
�œ
˜š�œ#�œ�œ
�˜6J˜J˜š�œ�œ
�œ
�œ˜.Jšœ&�œ˜,J˜1—Jš�œ
˜—Jš�œ
˜—J˜Jš�œŸ˜J˜—J˜J˜J˜
Jš�œ
˜——˜Jš
�˜Jš�œ�œ˜-š
�˜Jš
�˜J˜.J˜J˜Jš�œ
˜—Jš�œ
˜—Jš�œŸ˜J˜————Jš�œŸ	˜J˜—Jš�œŸ
˜J˜J˜—šžœ�œ
�	œ�œ˜KJš
�˜š
�˜Jš�œ�œ
�œ˜%š�œ�œ
�˜J˜'Jšœ�œ˜Jš�œ
˜—Jš�œ
˜—Jš�œŸ˜J˜J˜—šžœ�	œ˜J˜šœ�	œ˜'Jš�œ�œ�œ˜G—Jš
�˜Jšœ�œ
˜J˜Jš�œ
�œ�œ˜%Jš�œŸ˜J˜J˜—šžœ�	œ˜J˜šœ�	œ˜'Jš�œ�œ�œ�œ˜?—Jš�œ˜J˜J˜—šž
œ�œ
�	œ�œ˜PJšœ
�œ˜&J˜—š
žœ�œ
�	œ�œ�œ˜JJš�œ˜"J˜—šžœ�	œ˜1Jš�œ�œ˜*Jš
�˜J˜š�œ�œ �œ
�˜Gš�œ�œ
�˜Jšœ�œ
�œ˜1Jšœ�œ
�œ˜(Jš�œ�œ
˜——Jš�œ
�œ˜!Jš�œŸ˜J˜J˜—šžœ�œ
�	œ˜8Jš�œ�œ"˜DJ˜—š
žœ�œ
�	œ�œ�œ˜MJš�œ˜%J˜—šžœ�	œ˜4Jš�œ�œ˜*Jš
�˜J˜š�œ�œ �œ
�˜Gš�œ�œ
�˜Jšœ�œ
�œ˜*Jšœ�œ�œ
�œ
�œ
�œ˜JJš�œ�œ
˜——Jš�œ
�œ˜!Jš�œŸ˜J˜J˜—šžœ�œ
�	œ˜<Jš�œ�œ&˜HJ˜—š
žœ�œ
�	œ�œ�œ˜OJšœ
�œ#˜*J˜—šžœ�	œ˜8Jš�œ�œ˜*Jš
�˜J˜J˜#Jš�œ
�œ�œ
�œ
˜J˜š�œ�œ
�˜Jšœ�œ
�œ˜%Jšœ�œ
�œ˜1Jš�œ
˜—Jš�œŸ˜!J˜J˜—šž
œ�œ
�	œ˜5Jš�œ3˜:Jš
�˜J˜J˜J˜š�œ�œ
�˜Jšœ�œ�œ
�œ˜DJšœ�œ.˜KJš�œ�œ
˜—J˜Jš�œŸ˜J˜—š
žœ�œ
�	œ�œ�œ˜JJš�œ#˜)J˜J˜J˜—šžœ�œ
�	œ˜:Jš�œ�œ˜.Jš
�˜J˜!Jš�œ
�œ
�œ�œ˜1š�œ�œ
�˜˜š�œ�œ�œ˜IJš
�˜Jš
�˜J˜J˜J˜/š�œ%�œ˜9Jš�œ
�œ�œ˜-—Jš�œ
˜——Jš�œ�œ
˜—Jš�œ�œ
˜Jš�œŸ˜J˜J˜—šž
œ�œ
�	œ�œ˜KJš
�˜Jšœ�
œ
�œ˜/Jš�œ˜Jš�œŸ˜J˜J˜—š
ž
œ�œ
�	œ�œ�œ˜DJš
�˜J˜!š�œ�œ
�˜Jš	œ�œ%�œ
�œ
�œ˜LJš�œ�œ
˜—Jš�œ
�œ˜Jš�œŸ˜J˜J˜—šžœ�œ
�	œ�œ˜BJš�œ
Ÿ
˜J˜šžœ�	œ˜Jš
�˜J˜Jš�œ�œ˜,J˜J˜J˜Jš�œŸ˜J˜—J˜J˜'Jš�œŸ˜J˜J˜—šžœ�œ
�	œ˜)Jšœ�œ	�œ�œ˜7Jš�œ
Ÿ
˜J˜šžœ�	œ˜9Jšœ�
œ
�œ+˜;J˜—J˜/J˜J˜J˜&J˜CJ˜7J˜.Jš�œŸ˜J˜J˜—šžœ�	œ�œ	�œ
˜HJš�œ˜Jš
�˜š�œ�˜˜Jš
�˜J˜.Jšœ	�œ�œ
˜Jšœ$�œ
˜(Jšœ�œ˜J˜šžœ�	œ˜4Jš
�˜šœ!�
œ
�œ˜?Jšœ�œ˜6—J˜š�œ	�œ�œ
˜1Jš�œ˜—J˜J˜(Jš�œ
˜J˜—J˜,J˜J˜,Jšœ�
œ
�œ�œ
˜5˜J˜
Jš	œ�œ�œ
�œ�œ˜"—J˜1J˜J˜Jš�œ˜
Jš�œ
˜J˜—˜.Jš
�˜J˜J˜"J˜J˜J˜J˜š�œ�˜Jš
�˜Jš
œA™AJ˜2š�œ�œ
�˜š�œ
�œ
�˜Jšœ�œ$˜-Jš�œ�œ˜——š�œ
Ÿ<˜AJš
�˜J˜J˜Jšœ�
œ
�œ˜/J˜Jš�œ
˜—J˜Jš�œ˜
Jš�œ�œ
˜Jš�œ
˜J˜—JšœŸ˜.Jšœ�œ
˜J˜J˜
J˜Jšœ�
œ
�œH�œ˜YJš�œ�œ˜/J˜
J˜J˜Jšœ�œ
˜J˜J˜
Jš�œ�œ˜6J˜Jš�œ˜
Jš�œ
˜—Jš�œ˜&—Jš�œŸ˜-J˜Jš�œŸ˜J˜J˜—šž
œ�œ
�	œ˜!Jšœ�œ
˜Jšœ�œ�œ
˜Jšœ�œ�œ
˜Jšœ6�œ˜PJš
�˜J˜š
žœ�	œ
�œ�œ�œ˜OJš�œ
Ÿ˜J˜Jš�œ�œ˜J˜J˜šœ�
œ
�œ˜˜2J˜J˜——š�œ�˜J˜C˜Jš
�˜J˜J˜$J˜*Jš�œ
˜—Jš�œ˜ —Jš�œ˜Jš�œŸ˜J˜—šžœ�	œ�œ˜QJš�œ
Ÿ
˜Jšœ7�œ
˜;J˜J˜Jšœ�œ
˜Jšœ�œ�œ
˜%Jšœ�
œ
�œ˜1J˜šžœ�	œ˜Jš
�˜Jšœ�œ
˜!J˜(J˜J˜šžœ�	œ˜ Jš
�˜J˜J˜5Jšœ$�œ
˜4J˜+J˜š�œ	�œ
�˜Jšœ�œ�œ˜A˜š�œ%�œ�˜DJšœ�œ˜2——Jš�œ˜ —Jš	œ�
œ
�œ�œ&�œ˜OJš�œ	�œ
�œ�œ˜8J˜	Jš�œŸ˜J˜—J˜)J˜%J˜&J˜$J˜&Jš
�œ�œ�œ
�œ�œ
˜IJ˜Jš�œ�œ
�œ˜5Jš�œ!˜%J˜Jš�œŸ˜J˜—šžœ�	œ˜š�œ
�˜J˜6—Jš�œ�œ˜!J˜—J˜"Jš	�œ�œ
�œ
�œŸ˜?š�œ�˜Jš
�˜J˜-Jš�œ
�œ
�œ�œ˜:Jš�œ
˜—Jš�œ
�œ
�œ˜J˜	Jš�œ�œ˜*J˜Jš
œ@™@Jš
œ=™=Jš
œ9™9Jš
œ:™:Jš
œ3™3Jš
œ:™:J˜J˜	š�œ�˜˜
Jš
�˜J˜J˜
J˜J˜
J˜$Jš
œ6™6Jšœ�
œ
�œ*˜=Jš
œ6™6Jš
œ+™+šœ�
œ
�œ"˜/J˜J˜(—J˜J˜	Jš�œ�œ˜*J˜(J˜J˜J˜J˜J˜
J˜J˜ Jš�œ
˜—˜Jš
�˜J˜
J˜	J˜J˜J˜(J˜Jš�œ�œ'˜5Jš�œ
˜—Jš�œ˜ —J˜/J˜Jš�œ˜Jš�œŸ˜J˜J˜—Jš�œ�˜˜˜
Jš
�˜J˜J˜J˜Jšœ�
œ
�œ>˜HJš�œ˜Jš�œ
˜J˜—˜Jš
�˜J˜J˜J˜J˜ J˜
J˜2J˜J˜J˜J˜J˜Jš�œ˜
Jš�œ
˜J˜—˜Jš
�˜J˜J˜J˜J˜
šœ.�œ
˜3J˜&—J˜š�œ�œ
�˜šœ�œ˜Jš�œ
�œ�œ˜,—šœ�œ˜Jš�œ
˜—šœ�œ˜"JšœŸ
˜!Jš
œE™E—šœ�œ˜Jš�œ�œ˜-Jš�œ,�œ˜6—šœ�œ
˜Jš�œ�œ˜.Jš�œ�œ
˜—Jš�œ˜ —J˜Jš�œ˜Jš�œ
˜J˜—˜
Jš
�˜J˜	Jš�œ�œ˜+Jš�œ�˜˜
Jš
�˜šžœ�	œ˜$Jš
�˜J˜J˜J˜5J˜J˜,Jš�œ
˜—Jšœ	�œ˜Jšœ�œ˜šœ�œ	�œ
�œ˜&˜/J˜0——J˜J˜Jšœ
Ÿ˜'šœ�
œ
�œ˜J˜I—J˜3J˜%J˜2J˜J˜*J˜	Jš�œ˜Jš
�˜—š
œ˜Jš
�˜šœ�
œ
�œ˜;Jš
œ0˜0—Jšœ
Ÿ˜'JšœŸ&˜1š�œ
�œ1�˜;J˜,—JšœŸ˜J˜_J˜7J˜*J˜	Jš�œ˜Jš
�˜—Jš�
œ
�œ)˜:Jš�œ
˜J˜—˜Jš
�˜J˜J˜J˜	Jšœ�
œ
�œ9˜CJ˜"Jš�œ˜Jš�œ
˜J˜—˜	Jš
�˜J˜J˜J˜J˜ J˜
Jšœ�
œ
�œ:˜DJ˜š�œ�˜Jš�œ'�˜/—š
�˜Jš
�˜J˜.J˜J˜Jš�œ
˜—Jš�œ˜Jš�œ
˜J˜—Jš�œ�œ,˜=—Jš�œŸ˜J˜J˜—šž
œ�œ
�	œ˜+Jš
�˜š�œ�œ
�˜˜Jš
�˜J˜J˜J˜0š�œ�˜J˜J˜J˜Jš�œ˜—Jš�œ
˜—Jš�œ˜—Jš�œŸ˜J˜J˜—šžœ�œ
�	œ˜AJš
�˜J˜J˜J˜-Jš�œ�œ
�œ
˜J˜
J˜Jš�œŸ˜J˜J˜—šžœ�œ
�	œ˜5Jš
�˜Jš�œŸE˜LJš�œŸ˜J˜J˜—šžœ�	œ˜0Jš
�˜Jš�œ
˜Jš�œŸ˜J˜—Jš�œŸ˜J˜J˜J˜——…—NXjí