COMPILER SimpleMod2 (* Simplified Modula-2 without PROCEDURE / FUNCTION - program module only, no DEFINITION / IMPLEMENTATION split - no local modules, no EXPORT, no PRIORITY - no ProcedureDeclaration, FormalParameters, ProcedureType, ProcedureCall, ActualParameters, FORWARD, RETURN - statements: assignment, IF, CASE, WHILE, REPEAT, LOOP/EXIT, FOR, WITH - symbol table (SymTab) with static type checking: 200 = duplicate identifier, 201 = undeclared identifier, 202 = MODULE / END name mismatch, 210 = incompatible assignment (incl. assignment to a constant), 211 = arithmetic operand must be numeric, 212 = boolean operand required, 213 = incompatible comparison / CASE label mismatch, 214 = BOOLEAN condition required, 215 = not a RECORD type, 216 = unknown field, 217 = not an ARRAY type, 218 = array index must be integer, 219 = not a POINTER type, 220 = FOR needs integer variable and bounds, 221 = not a type name, 222 = set operand mismatch, 223 = cyclical type definition, 224 = ordinal type required - type rules (single pass, declare-before-use): . INTEGER, CARDINAL and subranges form one integer family; no mixed INTEGER/REAL arithmetic; INTEGER assigns to REAL . each TYPE name gets an alias descriptor, so self-references (POINTER TO Person) resolve; A = A is caught as cyclical . record fields live in the type descriptor; WITH pushes them as an inner scope, so unqualified field access works there . string literal of length 1 is CHAR, longer ones are string type (assignable to ARRAY types only) . unknown types (InvalidType) suppress follow-on errors - backend (CodeGen): pretty-prints a complete, ready-to-compile Modula-2 program module to gen/.mod (directory gen/ must exist). Comments are dropped; layout is regenerated. *) IMPORT SymTab, CodeGen; CHARACTERS eol = CHR(13) . letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" . digit = "0123456789" . hexDigit = digit + "ABCDEF" . noQuote1 = ANY - "'" - eol . noQuote2 = ANY - '"' - eol . IGNORE CHR(9) .. CHR(13) COMMENTS FROM "(*" TO "*)" NESTED TOKENS ident = letter { letter | digit } . integer = digit { digit } | digit { digit } CONTEXT("..") | digit { hexDigit } "H" . real = digit { digit } "." { digit } [ "E" [ "+" | "-" ] digit { digit } ] . string = "'" { noQuote1 } "'" | '"' { noQuote2 } '"' . PRODUCTIONS SimpleMod2 (. VAR m1, m2: SymTab.Name; .) = "MODULE" (. CodeGen.Emit("MODULE ") .) GetIdent (. SymTab.Init; CodeGen.OpenModule(m1); CodeGen.Emit("MODULE "); CodeGen.Emit(m1); IF ~SymTab.Enter(m1, SymTab.KindModule) THEN SemError(200) END .) ";" (. CodeGen.Emit(";"); CodeGen.Brk; .) { Import } Block GetIdent (. IF ~SymTab.Equal(m1, m2) THEN SemError(202) END .) "." (. CodeGen.Emit("."); CodeGen.Close; SymTab.PrintTable; .) . Import (. VAR n: SymTab.Name; .) = "FROM" (. CodeGen.Emit("FROM ") .) GetIdent (. IF ~SymTab.Enter(n, SymTab.KindImport) THEN SemError(200) END .) "IMPORT" (. CodeGen.Emit(" IMPORT ") .) ImportList ";" (. CodeGen.Emit(";"); CodeGen.Brk; .) | "IMPORT" (. CodeGen.Emit("IMPORT ") .) ImportList ";" (. CodeGen.Emit(";"); CodeGen.Brk; .) . ImportList (. VAR n: SymTab.Name; .) = GetIdent (. IF ~SymTab.Enter(n, SymTab.KindImport) THEN SemError(200) END .) { "," (. CodeGen.Emit(", ") .) GetIdent (. IF ~SymTab.Enter(n, SymTab.KindImport) THEN SemError(200) END .) } . Block = { Declaration } [ "BEGIN" (. CodeGen.Emit("BEGIN"); CodeGen.Ind; CodeGen.Brk; .) StatSeq ] "END" (. CodeGen.Ded; CodeGen.Brk; CodeGen.Emit("END ") .) . Declaration = "CONST" (. CodeGen.Emit("CONST"); CodeGen.Ind; .) { (. CodeGen.Brk; .) ConstDecl ";" (. CodeGen.Emit(";") .) } (. CodeGen.Ded; CodeGen.Brk; .) | "TYPE" (. CodeGen.Emit("TYPE"); CodeGen.Ind; .) { (. CodeGen.Brk; .) TypeDecl ";" (. CodeGen.Emit(";") .) } (. CodeGen.Ded; CodeGen.Brk; .) | "VAR" (. CodeGen.Emit("VAR"); CodeGen.Ind; .) { (. CodeGen.Brk; .) VarDecl ";" (. CodeGen.Emit(";") .) } (. CodeGen.Ded; CodeGen.Brk; .) . ConstDecl (. VAR n: SymTab.Name; t: SymTab.TypeIndex; .) = GetIdent (. IF ~SymTab.Enter(n, SymTab.KindConst) THEN SemError(200) END .) "=" (. CodeGen.Emit(" = ") .) ConstExpr (. SymTab.SetSymType(n, t); .) . ConstExpr = Expr . TypeDecl (. VAR n: SymTab.Name; t0, t1: SymTab.TypeIndex; .) = GetIdent (. IF ~SymTab.Enter(n, SymTab.KindType) THEN SemError(200) END; t0 := SymTab.NewAlias(); SymTab.SetSymType(n, t0); .) "=" (. CodeGen.Emit(" = ") .) Type (. IF t1 = t0 THEN SemError(223); SymTab.SetTarget(t0, SymTab.InvalidType) ELSE SymTab.SetTarget(t0, t1) END; .) . VarDecl (. VAR t: SymTab.TypeIndex; .) = VarIdents ":" (. CodeGen.Emit(" : ") .) Type (. SymTab.FixPending(t); .) . VarIdents (. VAR n: SymTab.Name; .) = GetIdent (. IF ~SymTab.EnterPending(n, SymTab.KindVar) THEN SemError(200) END .) { "," (. CodeGen.Emit(", ") .) GetIdent (. IF ~SymTab.EnterPending(n, SymTab.KindVar) THEN SemError(200) END .) } . QualIdent (. VAR n, m: SymTab.Name; .) = GetIdent (. IF ~SymTab.Lookup(n) THEN SemError(201); t := SymTab.InvalidType ELSIF (SymTab.SymKind(n) # SymTab.KindType) & (SymTab.SymKind(n) # SymTab.KindPredef) & (SymTab.SymKind(n) # SymTab.KindImport) THEN SemError(221); t := SymTab.InvalidType ELSE t := SymTab.SymType(n) END; .) { "." (. CodeGen.Emit("."); t := SymTab.InvalidType; .) GetIdent } . (* Types: ProcedureType removed; subrange factored for LL(1) *) Type = SimpleType | ArrayType | RecordType | SetType | PointerType . SimpleType (. VAR t1, t2: SymTab.TypeIndex; .) = QualIdent [ "[" (. CodeGen.Emit("[") .) ConstExpr (. IF (t1 # SymTab.InvalidType) & (SymTab.ClassOf(t1) # SymTab.ClInt) & (SymTab.ClassOf(t1) # SymTab.ClChar) & (SymTab.ClassOf(t1) # SymTab.ClEnum) THEN SemError(224) END; .) ".." (. CodeGen.Emit("..") .) ConstExpr (. IF (t2 # SymTab.InvalidType) & (SymTab.ClassOf(t2) # SymTab.ClInt) & (SymTab.ClassOf(t2) # SymTab.ClChar) & (SymTab.ClassOf(t2) # SymTab.ClEnum) THEN SemError(224) END; .) "]" (. CodeGen.Emit("]") .) (. t := SymTab.NewSub(t1); .) ] | "[" (. CodeGen.Emit("[") .) ConstExpr (. IF (t1 # SymTab.InvalidType) & (SymTab.ClassOf(t1) # SymTab.ClInt) & (SymTab.ClassOf(t1) # SymTab.ClChar) & (SymTab.ClassOf(t1) # SymTab.ClEnum) THEN SemError(224) END; .) ".." (. CodeGen.Emit("..") .) ConstExpr (. IF (t2 # SymTab.InvalidType) & (SymTab.ClassOf(t2) # SymTab.ClInt) & (SymTab.ClassOf(t2) # SymTab.ClChar) & (SymTab.ClassOf(t2) # SymTab.ClEnum) THEN SemError(224) END; .) "]" (. CodeGen.Emit("]") .) (. t := SymTab.NewSub(t1); .) | Enum . Enum (. VAR n: SymTab.Name; .) = "(" (. CodeGen.Emit("("); t := SymTab.NewEnum(); .) GetIdent (. IF ~SymTab.Enter(n, SymTab.KindConst) THEN SemError(200) END; SymTab.SetSymType(n, t); .) { "," (. CodeGen.Emit(", ") .) GetIdent (. IF ~SymTab.Enter(n, SymTab.KindConst) THEN SemError(200) END; SymTab.SetSymType(n, t); .) } ")" (. CodeGen.Emit(")") .) . ArrayType (. VAR s, s2, e: SymTab.TypeIndex; .) = "ARRAY" (. CodeGen.Emit("ARRAY ") .) SimpleType (. IF (s # SymTab.InvalidType) & (SymTab.ClassOf(s) # SymTab.ClInt) & (SymTab.ClassOf(s) # SymTab.ClChar) & (SymTab.ClassOf(s) # SymTab.ClEnum) THEN SemError(224) END; .) { "," (. CodeGen.Emit(", ") .) SimpleType (. IF (s2 # SymTab.InvalidType) & (SymTab.ClassOf(s2) # SymTab.ClInt) & (SymTab.ClassOf(s2) # SymTab.ClChar) & (SymTab.ClassOf(s2) # SymTab.ClEnum) THEN SemError(224) END; .) } "OF" (. CodeGen.Emit(" OF ") .) Type (. t := SymTab.NewArray(e); .) . RecordType = "RECORD" (. CodeGen.Emit("RECORD"); CodeGen.Ind; CodeGen.Brk; t := SymTab.NewRecord(); .) FieldSeq "END" (. CodeGen.Ded; CodeGen.Brk; CodeGen.Emit("END") .) . FieldSeq = Field { ";" (. CodeGen.Emit(";"); CodeGen.Brk; .) Field } . Field (. VAR et: SymTab.TypeIndex; .) = [ FieldIdents ":" (. CodeGen.Emit(" : ") .) Type (. SymTab.FixPendingF(rt, et); .) ] . FieldIdents (. VAR n: SymTab.Name; .) = GetIdent (. IF ~SymTab.FieldPending(rt, n) THEN SemError(200) END .) { "," (. CodeGen.Emit(", ") .) GetIdent (. IF ~SymTab.FieldPending(rt, n) THEN SemError(200) END .) } . SetType (. VAR s: SymTab.TypeIndex; .) = "SET" (. CodeGen.Emit("SET ") .) "OF" (. CodeGen.Emit("OF ") .) SimpleType (. IF (s # SymTab.InvalidType) & (SymTab.ClassOf(s) # SymTab.ClInt) & (SymTab.ClassOf(s) # SymTab.ClChar) & (SymTab.ClassOf(s) # SymTab.ClEnum) THEN SemError(224) END; t := SymTab.NewSet(s); .) . PointerType (. VAR b: SymTab.TypeIndex; .) = "POINTER" (. CodeGen.Emit("POINTER ") .) "TO" (. CodeGen.Emit("TO ") .) Type (. t := SymTab.NewPtr(b); .) . (* Statements: ProcedureCall and RETURN removed *) StatSeq = Stat { ";" (. CodeGen.Emit(";") .) (. CodeGen.Brk; .) Stat } . Stat = [ Assign | IfStat | CaseStat | WhileStat | RepeatStat | LoopStat | ForStat | WithStat | "EXIT" (. CodeGen.Emit("EXIT") .) ] . Assign (. VAR dt, et: SymTab.TypeIndex; dk: INTEGER; .) = Design ":=" (. CodeGen.Emit(" := ") .) Expr (. IF (dt # SymTab.InvalidType) & (dk # SymTab.KindVar) & (dk # SymTab.KindField) & (dk # SymTab.KindImport) THEN SemError(210) ELSIF ~SymTab.Assignable(et, dt) THEN SemError(210) END; .) . IfStat (. VAR t: SymTab.TypeIndex; .) = "IF" (. CodeGen.Emit("IF ") .) Expr (. IF ~SymTab.BoolCheck(t) THEN SemError(214) END; .) "THEN" (. CodeGen.Emit(" THEN"); CodeGen.Brk; CodeGen.Ind; .) StatSeq { "ELSIF" (. CodeGen.Ded; CodeGen.Brk; CodeGen.Emit("ELSIF ") .) Expr (. IF ~SymTab.BoolCheck(t) THEN SemError(214) END; .) "THEN" (. CodeGen.Emit(" THEN"); CodeGen.Brk; CodeGen.Ind; .) StatSeq } [ "ELSE" (. CodeGen.Ded; CodeGen.Brk; CodeGen.Emit("ELSE"); CodeGen.Ind; CodeGen.Brk; .) StatSeq ] "END" (. CodeGen.Ded; CodeGen.Brk; CodeGen.Emit("END") .) . CaseStat (. VAR st: SymTab.TypeIndex; .) = "CASE" (. CodeGen.Emit("CASE ") .) Expr "OF" (. CodeGen.Emit(" OF"); CodeGen.Brk; CodeGen.Ind; .) Case { "|" (. CodeGen.Brk; CodeGen.Emit("| ") .) Case } [ "ELSE" (. CodeGen.Ded; CodeGen.Brk; CodeGen.Emit("ELSE "); CodeGen.Ind; CodeGen.Brk; .) StatSeq ] "END" (. CodeGen.Ded; CodeGen.Brk; CodeGen.Emit("END") .) . Case = [ LabelList ":" (. CodeGen.Emit(" : ") .) StatSeq ] . LabelList = Labels { "," (. CodeGen.Emit(", ") .) Labels } . Labels (. VAR t, t2: SymTab.TypeIndex; .) = ConstExpr (. IF ~SymTab.EqCheck(t, sel) THEN SemError(213) END; .) [ ".." (. CodeGen.Emit("..") .) ConstExpr (. IF ~SymTab.EqCheck(t2, sel) THEN SemError(213) END; .) ] . WhileStat (. VAR t: SymTab.TypeIndex; .) = "WHILE" (. CodeGen.Emit("WHILE ") .) Expr (. IF ~SymTab.BoolCheck(t) THEN SemError(214) END; .) "DO" (. CodeGen.Emit(" DO"); CodeGen.Brk; CodeGen.Ind; .) StatSeq "END" (. CodeGen.Ded; CodeGen.Brk; CodeGen.Emit("END") .) . RepeatStat (. VAR t: SymTab.TypeIndex; .) = "REPEAT" (. CodeGen.Emit("REPEAT"); CodeGen.Brk; CodeGen.Ind; .) StatSeq "UNTIL" (. CodeGen.Ded; CodeGen.Brk; CodeGen.Emit("UNTIL ") .) Expr (. IF ~SymTab.BoolCheck(t) THEN SemError(214) END; .) . LoopStat = "LOOP" (. CodeGen.Emit("LOOP"); CodeGen.Brk; CodeGen.Ind; .) StatSeq "END" (. CodeGen.Ded; CodeGen.Brk; CodeGen.Emit("END") .) . ForStat (. VAR n: SymTab.Name; lo, hi, by: SymTab.TypeIndex; .) = "FOR" (. CodeGen.Emit("FOR ") .) GetIdent (. IF ~SymTab.Lookup(n) THEN SemError(201) ELSIF (SymTab.SymKind(n) # SymTab.KindVar) & (SymTab.SymKind(n) # SymTab.KindField) THEN SemError(220) ELSIF (SymTab.SymType(n) # SymTab.InvalidType) & ~SymTab.IsIntFamily( SymTab.SymType(n)) THEN SemError(220) END; .) ":=" (. CodeGen.Emit(" := ") .) Expr (. IF (lo # SymTab.InvalidType) & ~SymTab.IsIntFamily(lo) THEN SemError(220) END; .) "TO" (. CodeGen.Emit(" TO ") .) Expr (. IF (hi # SymTab.InvalidType) & ~SymTab.IsIntFamily(hi) THEN SemError(220) END; .) [ "BY" (. CodeGen.Emit(" BY ") .) ConstExpr (. IF (by # SymTab.InvalidType) & ~SymTab.IsIntFamily(by) THEN SemError(220) END; .) ] "DO" (. CodeGen.Emit(" DO"); CodeGen.Brk; CodeGen.Ind; .) StatSeq "END" (. CodeGen.Ded; CodeGen.Brk; CodeGen.Emit("END") .) . WithStat (. VAR dt: SymTab.TypeIndex; dk: INTEGER; pushed: BOOLEAN; .) = "WITH" (. CodeGen.Emit("WITH ") .) Design (. pushed := FALSE; IF dt # SymTab.InvalidType THEN pushed := SymTab.PushRecord(dt); IF ~pushed THEN SemError(215) END END; .) "DO" (. CodeGen.Emit(" DO"); CodeGen.Brk; CodeGen.Ind; .) StatSeq "END" (. IF pushed THEN SymTab.PopScope END; CodeGen.Ded; CodeGen.Brk; CodeGen.Emit("END") .) . (* Expressions: Designator without ActualParameters. Only record fields resolve qualified access; WITH pushes an inner scope so field names also work unqualified in its body. *) Design (. VAR n, m: SymTab.Name; it: SymTab.TypeIndex; .) = GetIdent (. IF ~SymTab.Lookup(n) THEN SemError(201); t := SymTab.InvalidType; k := -1 ELSE t := SymTab.SymType(n); k := SymTab.SymKind(n) END; .) { "." (. CodeGen.Emit(".") .) GetIdent (. IF t = SymTab.InvalidType THEN ELSIF SymTab.ClassOf(t) # SymTab.ClRecord THEN SemError(215); t := SymTab.InvalidType ELSIF ~SymTab.FieldExists(t, m) THEN SemError(216); t := SymTab.InvalidType ELSE t := SymTab.FieldType(t, m) END; .) | "[" (. CodeGen.Emit("[") .) Expr (. IF t = SymTab.InvalidType THEN ELSIF SymTab.ClassOf(t) # SymTab.ClArray THEN SemError(217); t := SymTab.InvalidType ELSIF (it # SymTab.InvalidType) & ~SymTab.IsIntFamily(it) THEN SemError(218); t := SymTab.InvalidType ELSE t := SymTab.ArrayElem(t) END; .) { "," (. CodeGen.Emit(", ") .) Expr (. IF (it # SymTab.InvalidType) & ~SymTab.IsIntFamily(it) THEN SemError(218) END; .) } "]" (. CodeGen.Emit("]") .) | "^" (. CodeGen.Emit("^") .) (. IF t = SymTab.InvalidType THEN ELSIF SymTab.ClassOf(t) # SymTab.ClPtr THEN SemError(219); t := SymTab.InvalidType ELSE t := SymTab.PtrBase(t) END; .) } . Expr (. VAR t2: SymTab.TypeIndex; op: INTEGER; .) = SimExpr [ Rel SimExpr (. IF op = SymTab.OpIn THEN IF SymTab.InCheck(t, t2) THEN t := SymTab.BoolType() ELSE SemError(222); t := SymTab.InvalidType END ELSE IF SymTab.RelCheck(t, t2, op) THEN t := SymTab.BoolType() ELSE SemError(213); t := SymTab.InvalidType END END; .) ] . Rel = "=" (. CodeGen.Emit(" = "); op := SymTab.OpEq; .) | "#" (. CodeGen.Emit(" # "); op := SymTab.OpNeq1; .) | "<>" (. CodeGen.Emit(" <> "); op := SymTab.OpNeq2; .) | "<" (. CodeGen.Emit(" < "); op := SymTab.OpLt; .) | "<=" (. CodeGen.Emit(" <= "); op := SymTab.OpLe; .) | ">" (. CodeGen.Emit(" > "); op := SymTab.OpGt; .) | ">=" (. CodeGen.Emit(" >= "); op := SymTab.OpGe; .) | "IN" (. CodeGen.Emit(" IN "); op := SymTab.OpIn; .) . SimExpr (. VAR t2, res2: SymTab.TypeIndex; op: INTEGER; .) = [ "+" (. CodeGen.Emit("+") .) | "-" (. CodeGen.Emit("-") .) ] Term { AddOp Term (. IF op = SymTab.OpOr THEN IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN t := SymTab.BoolType() ELSE SemError(212); t := SymTab.InvalidType END ELSE IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN t := res2 ELSE SemError(211); t := SymTab.InvalidType END END; .) } . AddOp = "+" (. CodeGen.Emit(" + "); op := SymTab.OpAdd; .) | "-" (. CodeGen.Emit(" - "); op := SymTab.OpSub; .) | "OR" (. CodeGen.Emit(" OR "); op := SymTab.OpOr; .) . Term (. VAR t2, res2: SymTab.TypeIndex; op: INTEGER; .) = Fact { MulOp Fact (. IF op = SymTab.OpAnd THEN IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN t := SymTab.BoolType() ELSE SemError(212); t := SymTab.InvalidType END ELSE IF SymTab.ArithCheck(t, t2, (op = SymTab.OpDiv) OR (op = SymTab.OpMod), res2) THEN t := res2 ELSE SemError(211); t := SymTab.InvalidType END END; .) } . MulOp = "*" (. CodeGen.Emit(" * "); op := SymTab.OpTimes; .) | "/" (. CodeGen.Emit(" / "); op := SymTab.OpSlash; .) | "DIV" (. CodeGen.Emit(" DIV "); op := SymTab.OpDiv; .) | "MOD" (. CodeGen.Emit(" MOD "); op := SymTab.OpMod; .) | "AND" (. CodeGen.Emit(" AND "); op := SymTab.OpAnd; .) | "&" (. CodeGen.Emit(" & "); op := SymTab.OpAnd; .) . Fact (. VAR s: ARRAY [0 .. 255] OF CHAR; t2, et, dt, st: SymTab.TypeIndex; dk: INTEGER; .) = integer (. LexString(s); CodeGen.Emit(s); t := SymTab.IntType(); .) | real (. LexString(s); CodeGen.Emit(s); t := SymTab.RealType(); .) | string (. LexString(s); CodeGen.Emit(s); IF SymTab.StrLen(s) <= 3 THEN t := SymTab.CharType() ELSE t := SymTab.NewStr() END; .) | Design (. t := dt; .) | "(" (. CodeGen.Emit("(") .) Expr ")" (. CodeGen.Emit(")"); t := et; .) | ( "NOT" (. CodeGen.Emit("NOT ") .) | "~" (. CodeGen.Emit("~") .) ) Fact (. IF SymTab.BoolCheck(t2) THEN t := SymTab.BoolType() ELSE SemError(212); t := SymTab.InvalidType END; .) | SetLit (. t := st; .) . SetLit (. VAR first, et: SymTab.TypeIndex; .) = "{" (. CodeGen.Emit("{"); t := SymTab.SetFor(SymTab.IntType()); .) [ Elem (. first := et; t := SymTab.SetFor(et); .) { "," (. CodeGen.Emit(", ") .) Elem (. IF ~SymTab.SetElemCheck(first, et) THEN SemError(222) END; .) } ] "}" (. CodeGen.Emit("}") .) . Elem (. VAR t2: SymTab.TypeIndex; .) = Expr [ ".." (. CodeGen.Emit("..") .) Expr (. IF ~SymTab.SetElemCheck(t, t2) THEN SemError(222) END; .) ] . GetIdent = ident (. LexName(n); CodeGen.Emit(n); .) . END SimpleMod2.