COMPILER Taste

USES TL, TC;

TYPE
  TName = STRING;

PROCEDURE StringToVal (s: STRING; VAR v: INTEGER);
  VAR
    error: INTEGER;
  BEGIN
    val(s, v, error);
  END;

(*--------------------------------------------------------------------------*)

CHARACTERS
  letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz".
  digit = "0123456789".
  cr = CHR(13).
  lf = CHR(10).
  tab = CHR(9).

TOKENS
  ident  = letter {letter | digit}.
  number = digit {digit}.

IGNORE cr + lf + tab

COMMENTS FROM "(*" TO "*)" NESTED

PRODUCTIONS
  Taste                                  (. VAR
                                              name, progName: TName;
                                              obj: TL.TObject; .)
  = "PROGRAM" Ident<progName> ";"        (. TC.progStart := TC.pc .)
    Body
    Ident<name>                          (. IF name <> progName THEN SemError(119);
                                            TC.Emit(TC.HALTc) .)
    "." .

  Body                                   (. VAR
                                              fix, typ: INTEGER;
                                              name, name1: TName;
                                              obj: TL.TObject; .)
  =                                      (. TL.EnterScope;
                                            fix := TC.pc + 1; TC.Emit2(TC.JMP, 0) .)
    { "VAR"
      { Ident<name> ":"                  (. obj := TL.NewObj(name, TL.vars) .)
        TypeId<obj^.typ> ";"
      }

    | "PROCEDURE" Ident<name> ";"        (. obj := TL.NewObj(name, TL.procs);
                                            obj^.adr := TC.pc .)
      Body
      Ident<name1>                       (. TC.Emit(TC.RET);
                                            IF name <> name1 THEN SemError(119); .)
      ";"
    }
    "BEGIN"                              (. TC.Fixup(fix); TC.Emit2(TC.RES, TL.DataSpace) .)
    StatSeq
    "END"                                (. TL.LeaveScope .).

  TypeId<VAR typ: INTEGER>
  =                                      (. typ := undef .)
  (   "INTEGER"                          (. typ := TL.int .)
    | "BOOLEAN"                          (. typ := TL.bool .)
  ) .

  Ident<VAR name: TName>
  = ident                                (. LexName(name) .).

  StatSeq = Stat {";" Stat}.

  Stat                                   (. VAR
                                              typ: INTEGER;
                                              name: TName;
                                              obj: TL.TObject;
                                              fix, fix2, loopstart: INTEGER; .)
  = [ Ident<name>                        (. obj := TL.Obj(name) .)
      ( ":" "="                          (. IF obj^.kind <> TL.vars THEN SemError(123); .)
        Expression<typ>                  (. IF typ <> obj^.typ THEN SemError(121);
                                            TC.Emit3(TC.STO, TL.curLevel-obj^.level, obj^.adr); .)
      |                                  (. IF obj^.kind <> TL.procs THEN SemError(124);
                                            TC.Emit3(TC.CALL, TL.curLevel-obj^.level, obj^.adr); .)
      )
    | "IF" Expression<typ>               (. IF typ <> TL.bool THEN SemError(122);
                                            fix := TC.pc + 1; TC.Emit2(TC.FJMP, 0) .)
      "THEN" StatSeq
      [ "ELSE"                           (. fix2 := TC.pc + 1; TC.Emit2(TC.JMP, 0);
                                            TC.Fixup(fix); fix := fix2 .)
        StatSeq
      ]
      "END"                              (. TC.Fixup(fix) .)
    | "WHILE"                            (. loopstart := TC.pc .)
      Expression<typ>                    (. IF typ <> TL.bool THEN SemError(122);
                                            fix := TC.pc + 1; TC.Emit2(TC.FJMP, 0) .)
      "DO" StatSeq                       (. TC.Emit2(TC.JMP, loopstart); TC.Fixup(fix) .)
      "END"
    | "READ" Ident<name>                 (. obj := TL.Obj(name);
                                            IF obj^.typ <> TL.int THEN SemError(120);
                                            TC.Emit3(TC.READc, TL.curLevel-obj^.level, obj^.adr) .)
    | "WRITE" Expression<typ>           (. IF typ <> TL.int THEN SemError(120);
                                            TC.Emit(TC.WRITEc) .)
    ].

  Expression<VAR typ: INTEGER>           (. VAR
                                              type1, op: INTEGER; .)
  = SimExpr<typ>
    [ RelOp<op> SimExpr<type1>           (. IF (typ <> type1) THEN SemError(121);
                                            TC.Emit(op); typ := TL.bool .)
      ].

  SimExpr<VAR typ: INTEGER>              (. VAR
                                              type1, op: INTEGER; .)
  = Term<typ>
    { AddOp<op> Term<type1>              (. IF (typ <> TL.int) OR (type1 <> TL.int) THEN SemError(120);
                                            TC.Emit(op) .)
      }.

  Term<VAR typ: INTEGER>                 (. VAR
                                              type1, op: INTEGER; .)
  = Factor<typ>
    { MulOp<op> Factor<type1>            (. IF (typ <> TL.int) OR (type1 <> TL.int) THEN SemError(120);
                                            TC.Emit(op) .)
    }.

  Factor<VAR typ: INTEGER>               (. VAR
                                              val, n: INTEGER;
                                              obj: TL.TObject;
                                              name: TName; .)
  = ( Ident<name>                        (. obj := TL.Obj(name); typ := obj^.typ;
                                            IF obj^.kind = TL.vars THEN
                                              TC.Emit3(TC.LOAD, TL.curLevel-obj^.level, obj^.adr)
                                            ELSE SemError(123); .)
    | "TRUE"                             (. TC.Emit2(TC.LIT, 1); typ := TL.bool .)
    | "FALSE"                            (. TC.Emit2(TC.LIT, 0); typ := TL.bool .)
    | number                             (. LexString(name); StringToVal(name, n);
                                            TC.Emit2(TC.LIT, n); typ := TL.int .)
    | "-" Factor<typ>                    (. IF typ <> TL.int THEN BEGIN SemError(120); typ := TL.int END;
                                            TC.Emit(TC.NEG) .)
    ).

  MulOp<VAR op: INTEGER>
  =                                      (. op := -1 .)
    ( "*"                                (. op := TC.MUL .)
    | "/"                                (. op := TC.DIVI .)
    ).

  AddOp<VAR op: INTEGER>
  =                                      (. op := -1 .)
    ( "+"                                (. op := TC.ADD .)
    | "-"                                (. op := TC.SUB .)
    ).

  RelOp<VAR op: INTEGER>
  =                                      (. op := -1 .)
    ( "="                                (. op := TC.EQUc .)
    | "<"                                (. op := TC.LSSc .)
    | ">"                                (. op := TC.GTRc .)
    ).

END Taste.