tiger book読書記録 chapter 4

Sep 29, 2018
Chapter 4を読む.abstract syntaxとabstract syntax treeの説明.それに応じてTiger languageでの例を説明がある.chapter 2, 3に比べると短くて優しい.演習問題でlexも自前で作れってか.chapter 3ではまだlexerは作っていなかったので,ここで作る必要があるな.ML-lexとML-yaccのmanualを眺める必要があるかな.

4.2内の例variable a, function f, function gとこのabstract syntax treeの例が間違っている気がする.gがprocedureであるかastのgに対応するresultがnilナノが間違い.簡単なのはg(i: int) = f()としてgをprocedureにしてしまうこと.どっちを直すのかはよくわからん.誤植多すぎる.

Sep 29, 2018
演習はtiger languageのASTを作成するところまで実装しろとのことだが,lexerを作っていないので少し時間がかかりそうだ.なのでexerciseを先に片付けることにする.
exercise 4.1

type pos = int;

datatype symbol = Regsym of string | Epsilon | Period;
datatype regexp = Symbol of symbol * pos
                | Concatination of symbol list * pos
                | Alternation of symbol list * pos
                | Repeat of symbol * int * pos;

こんな感じでいいのかね.4.2をやろうとしてML-lex, ML-yaccを合わせた使い方を知らないことに気づいたのでML-yaccのmanualを読んでCalc sampleを動かしてみる.manualからcopyしただけではsmlのversion違いで動作しなかった.

--- a/ml-yacc-samle/sample.grm
+++ b/ml-yacc-sample/sample.grm
@@ -39,9 +39,9 @@ fun lookup "bogus" = 10000
 
 (* the parser returns the value associated with the expression *)
 
-START : PRINT EXP (print EXP;
+START : PRINT EXP (print (Int.toString EXP);
                    print "\n";
-                   flush_out std_out; SOME EXP)
+                   TextIO.flushOut TextIO.stdOut; SOME EXP)
       | EXP (SOME EXP)
       | (NONE)
 
--- a/ml-yacc-samle/sample.lex
+++ b/ml-yacc-sample/sample.lex
@@ -8,7 +8,7 @@ type lexresult = (svalue, pos) token
 val pos = ref 0
 val eof = fn () => Tokens.EOF(!pos,!pos)
 val error = fn (e,l : int,_) =>
-              output(std_out,"line " ^ (makestring l) ^
+              TextIO.output(TextIO.stdOut,"line " ^ (Int.toString l) ^
                                ": " ^ e ^ "\n")
 %%
 
@@ -22,9 +22,9 @@ ws = [\ \t];
 \n       => (pos := (!pos) + 1; lex());
 {ws}+    => (lex());
 {digit}+ => (Tokens.NUM
-                (revfold (fn (a,r) => ord(a)-ord("0")+10*r)
-                         (explode yytext) 0,
-                  !pos,!pos));
+                 (foldl (fn (a,r) => ord(a)-ord(#"0")+10*r)
+                        0 (explode yytext) ,
+                  !pos, !pos));
 "+"      => (Tokens.PLUS(!pos,!pos));
 "*"      => (Tokens.TIMES(!pos,!pos));

char literalの表記法とfold関数がrenameされている..sml内に定義されているmethodの呼び出しをするにはsignatureに定義されていないと駄目なのね.

Sep 30, 2018
exercise 4.2
.lexと.grmと実行のためのコードを載せる.
e4-2.lex

;structure Tokens = Tokens

(* for ML-yacc *)
type pos = int;
type svalue = Tokens.svalue;
type ('a,'b) token = ('a,'b) Tokens.token;
type lexresult = (svalue, pos) token;

val lineNum = ref 0;
val pos = ref 0;
val eof = fn () => Tokens.EOF(!pos, !lineNum);
val error = fn (e, l : int,_) =>
              TextIO.output(TextIO.stdOut,"line " ^ (Int.toString l) ^
                             ": " ^ e ^ "\n");

%%

%header (functor E4_2LexFun(structure Tokens: E4_2_TOKENS));
alpha   = [a-zA-Z];
alnum   = [a-zA-Z0-9];
digit   = [0-9];
ws      = [\ \t];

%%

{ws}+   => (continue());
\n      => (lineNum := !lineNum + 1; continue());
{digit}+ => (Tokens.INT(valOf (Int.fromString yytext),
                        !lineNum, yypos));
"print" => (Tokens.PRINT(!lineNum, yypos));
"eof" => (Tokens.EOF(!lineNum, yypos));
{alpha}{alnum}* => (Tokens.ID(yytext, !lineNum, yypos));
"+"     => (Tokens.PLUS(!lineNum, yypos));
"-"     => (Tokens.MINUS(!lineNum, yypos));
"*"     => (Tokens.TIMES(!lineNum, yypos));
"/"     => (Tokens.DIV(!lineNum, yypos));
":="    => (Tokens.ASSIGN(!lineNum, yypos));
"("     => (Tokens.LPAREN(!lineNum, yypos));
")"     => (Tokens.RPAREN(!lineNum, yypos));
","     => (Tokens.COMMA(!lineNum, yypos));
";"     => (Tokens.SEMICOLON(!lineNum, yypos));

e4-2.grm

(* val debug_print_enable = false; *)
val debug_print_enable = true;
val debug_prefix = "DEBUG: "
fun debug_print debug_string =
    if debug_print_enable then
        print (debug_prefix ^ debug_string ^ "\n")
    else
        ()

type table = string -> int;

fun update (t : table, id, num) =
        (debug_print ("update ID : " ^ id ^ " = " ^ (Int.toString num));
         fn j =>
            if j = id
            then
                num
            else
                t j)

val emptytable = fn j => raise Fail ("uninitialized var" ^ j);

%%

%term INT of int
    | ID of string
    | PLUS | MINUS | TIMES | DIV
    | ASSIGN | PRINT
    | LPAREN | RPAREN | COMMA | SEMICOLON
    | EOF

%nonterm exp of table -> (table * int)
       | stm of table -> table
       | exps of table -> table
       | prog of table

%right SEMICOLON
%left COMMA
%left PLUS MINUS
%left TIMES DIV

%start prog
%eop EOF
%pos int
%verbose

%name E4_2

%%

prog : stm      (stm(emptytable))

stm : stm SEMICOLON stm         (debug_print "stm; stm"; fn t => stm2(stm1(t)))
    | ID ASSIGN exp             (debug_print ("ID \"" ^ ID ^ "\" ASSIGN exp");
                                 fn t =>
                                    let
                                        val (ttmp, intval) = exp t;
                                    in
                                        update(ttmp, ID, intval)
                                    end
                                )
    | PRINT LPAREN exps RPAREN  (debug_print "print ( exps )"; exps)

exps : exp              (debug_print "exp";
                         fn t =>
                            let
                                val (tret, intval) = exp t;
                                val _ = print((Int.toString intval) ^ "\n");
                            in
                                tret
                            end
                        )
     | exps COMMA exp   (debug_print "exps, exp";
                         fn t =>
                            let
                                val t0 = exps t;
                                val (tret, intval) = exp t0;
                                val _ = print ((Int.toString intval) ^ "\n");
                            in
                                tret
                            end
                        )
     (* | exp COMMA exps   (debug_print "exp, exps"; *)
     (*                     fn t => *)
     (*                        let *)
     (*                            val (t0, intval) = exp t; *)
     (*                            val _ = print((Int.toString intval) ^ "\n"); *)
     (*                        in *)
     (*                            exps t0 *)
     (*                        end *)
     (*                    ) *)

exp : INT               (debug_print ("INT = " ^ (Int.toString INT) ^ "");
                         fn t => (t, INT))
    | ID                (debug_print ("ID = " ^ ID);
                         fn t => (t, t(ID)))
    | exp PLUS exp      (debug_print "exp + exp";
                         fn t =>
                            let
                                val (t1, intval1) = exp1 t;
                                val (t2, intval2) = exp2 t1;
                                val _ = debug_print ("exp + exp = "
                                                     ^ (Int.toString intval1)
                                                     ^ ", "
                                                     ^ (Int.toString intval2))
                            in
                                (t2, intval1 + intval2)
                            end
                        )
    | exp MINUS exp     (debug_print "exp - exp";
                         fn t =>
                            let
                                val (t1, intval1) = exp1 t;
                                val (t2, intval2) = exp2 t1;
                                val _ = debug_print ("exp - exp = "
                                                     ^ (Int.toString intval1)
                                                     ^ ", "
                                                     ^ (Int.toString intval2))
                            in
                                (t2, intval1 - intval2)
                            end
                        )
    | exp TIMES exp     (debug_print "exp * exp";
                         fn t =>
                            let
                                val (t1, intval1) = exp1 t;
                                val (t2, intval2) = exp2 t1;
                                val _ = debug_print ("exp * exp = "
                                                     ^ (Int.toString intval1)
                                                     ^ ", "
                                                     ^ (Int.toString intval2))
                            in
                                (t2, intval1 * intval2)
                            end
                        )
    | exp DIV exp       (debug_print "exp / exp";
                         fn t =>
                            let
                                val (t1, intval1) = exp1 t;
                                val (t2, intval2) = exp2 t1;
                                val _ = debug_print ("exp div exp = "
                                                     ^ (Int.toString intval1)
                                                     ^ ", "
                                                     ^ (Int.toString intval2))
                            in
                                (t2, intval1 div intval2)
                            end
                        )
    | stm COMMA exp     (debug_print "stm, exp";
                         fn t => exp (stm t)
                        )
    | LPAREN exp RPAREN (debug_print "(exp)";
                         exp)

e4-2.sml

structure E4_2_Prog : sig
                         val parse : unit -> unit
                       end =
struct

  structure E4_2LrVals =
    E4_2LrValsFun(structure Token = LrParser.Token)

  structure E4_2Lex =
    E4_2LexFun(structure Tokens = E4_2LrVals.Tokens)

  structure E4_2Parser =
    Join(structure LrParser = LrParser
         structure ParserData = E4_2LrVals.ParserData
         structure Lex = E4_2Lex)

  fun invoke lexstream =
      let
          fun print_error (s, i:int, _) =
              TextIO.output(TextIO.stdOut,
                            "Error, line " ^ (Int.toString i) ^ ", " ^ s ^ "\n")
      in
          E4_2Parser.parse(0, lexstream, print_error, ())
      end

  fun parse () =
      let
          val lexer = E4_2Parser.makeLexer (fn _ =>
                                               (case TextIO.inputLine TextIO.stdIn
                                                of SOME s => s
                                                 | _ => ""))
          val dummyEOF = E4_2LrVals.Tokens.EOF(0, 0)
          fun loop lexer =
              let
                  val (result, lexer) = invoke lexer
                  val (nextToken, lexer) = E4_2Parser.Stream.get lexer
              in
                  if E4_2Parser.sameToken(nextToken, dummyEOF) then
                      ()
                  else
                      loop lexer
              end
      in
          loop lexer
      end

end

こんなものか.exercise 4.6を見るとprogram4.4はexpsに右再帰, program4.5は左再帰であると書いてある.しかし本文中はprogram 4.4, 4.5共に左再帰だ.どっちかが間違っているんだろうな.また,program 4.4ではshift/reduce conflictがあるのでCOMMAに演算子優先度を追加した.

exercise 4.3, 4.4
exercise 4.3をやった上で4.4をやるのはダルいので4.4をいきなりやった.4.4の結果は4.3のsuper setなので良しとする..lexと.smlはprefixをE4_2 -> E4_3に置換したのみで同一なので省略 .grmのみ載せる.

(* val debug_print_enable = false; *)
val debug_print_enable = true;
val debug_prefix = "DEBUG: "
fun debug_print debug_string =
    if debug_print_enable then
        print (debug_prefix ^ debug_string ^ "\n")
    else
        ()

type table = string -> int;

fun update (t : table, id, num) =
        (debug_print ("update ID : " ^ id ^ " = " ^ (Int.toString num));
         fn j =>
            if j = id
            then
                num
            else
                t j)

val emptytable = fn j => raise Fail ("uninitialized var" ^ j);

%%

%term INT of int
    | ID of string
    | PLUS | MINUS | TIMES | DIV
    | ASSIGN | PRINT
    | LPAREN | RPAREN | COMMA | SEMICOLON
    | EOF

%nonterm prog of int list
       | stm of table -> (table * int list)
       | exps of (table * int list) -> (table * int list)
       | exp of (table * int list) -> (table * int list * int)

%right SEMICOLON
%left COMMA
%left PLUS MINUS
%left TIMES DIV

%start prog
%eop EOF
%pos int
%verbose

%name E4_3

%%

prog : stm      (
                    let
                        val (t, ilist) = stm emptytable;
                        val _ = debug_print (foldr (op ^) "" (map Int.toString ilist));
                    in
                        ilist
                    end
                )

stm : stm SEMICOLON stm         (debug_print "stm; stm";
                                 fn t =>
                                    let
                                        val (t0, ilist0) = stm1 t;
                                        val (t1, ilist1) = stm2 t0;
                                    in
                                        (t1, ilist0 @ ilist1)
                                    end
                                )
    | ID ASSIGN exp             (debug_print ("ID \"" ^ ID ^ "\" ASSIGN exp");
                                 fn t =>
                                    let
                                        val (t0, ilist, intval) = exp (t, []);
                                    in
                                        (update(t0, ID, intval), ilist)
                                    end
                                )
    | PRINT LPAREN exps RPAREN  (debug_print "print ( exps )";
                                 fn t => exps (t, []))

exps : exp              (debug_print "exp";
                         fn (t, ilist) =>
                            let
                                val (t0, ilist0, intval) = exp (t, ilist);
                                val _ = print((Int.toString intval) ^ "\n");
                                val ilist1 = ilist0 @ [intval]
                            in
                                (t0, ilist1)
                            end
                        )
     | exps COMMA exp   (debug_print "exps, exp";
                         fn (t, ilist) =>
                            let
                                val (t0, ilist0) = exps (t, ilist);
                                val (t1, ilist1, intval) = exp (t0, ilist0);
                                val _ = print ((Int.toString intval) ^ "\n");
                                val ilist2 = ilist1 @ [intval]
                            in
                                (t1, ilist2)
                            end
                        )
     (* | exp COMMA exps   (debug_print "exp, exps"; *)
     (*                     fn (t, ilist) => *)
     (*                        let *)
     (*                            val (t0, ilist0, intval) = exp (t, ilist); *)
     (*                            val _ = print((Int.toString intval) ^ "\n"); *)
     (*                        in *)
     (*                            exps (t0, ilist0 @ [intval]) *)
     (*                        end *)
     (*                    ) *)

exp : INT               (debug_print ("INT = " ^ (Int.toString INT) ^ "");
                         fn (t, ilist) => (t, ilist, INT))
    | ID                (debug_print ("ID = " ^ ID);
                         fn (t, ilist) => (t, ilist, t(ID)))
    | exp PLUS exp      (debug_print "exp + exp";
                         fn (t, ilist) =>
                            let
                                val (t1, ilist1, intval1) = exp1 (t, ilist);
                                val (t2, ilist2, intval2) = exp2 (t1, ilist1);
                                val _ = debug_print ("exp + exp = "
                                                     ^ (Int.toString intval1)
                                                     ^ ", "
                                                     ^ (Int.toString intval2))
                            in
                                (t2, ilist2, intval1 + intval2)
                            end
                        )
    | exp MINUS exp     (debug_print "exp - exp";
                         fn (t, ilist) =>
                            let
                                val (t1, ilist1, intval1) = exp1 (t, ilist);
                                val (t2, ilist2, intval2) = exp2 (t1, ilist1);
                                val _ = debug_print ("exp - exp = "
                                                     ^ (Int.toString intval1)
                                                     ^ ", "
                                                     ^ (Int.toString intval2))
                            in
                                (t2, ilist2, intval1 - intval2)
                            end
                        )
    | exp TIMES exp     (debug_print "exp * exp";
                         fn (t, ilist) =>
                            let
                                val (t1, ilist1, intval1) = exp1 (t, ilist);
                                val (t2, ilist2, intval2) = exp2 (t1, ilist1);
                                val _ = debug_print ("exp * exp = "
                                                     ^ (Int.toString intval1)
                                                     ^ ", "
                                                     ^ (Int.toString intval2))
                            in
                                (t2, ilist2, intval1 * intval2)
                            end
                        )
    | exp DIV exp       (debug_print "exp / exp";
                         fn (t, ilist) =>
                            let
                                val (t1, ilist1, intval1) = exp1 (t, ilist);
                                val (t2, ilist2, intval2) = exp2 (t1, ilist1);
                                val _ = debug_print ("exp div exp = "
                                                     ^ (Int.toString intval1)
                                                     ^ ", "
                                                     ^ (Int.toString intval2))
                            in
                                (t2, ilist2, intval1 div intval2)
                            end
                        )
    | stm COMMA exp     (debug_print "stm, exp";
                         fn (t, ilist) =>
                            let
                                val (t0, ilist0) = stm t
                            in
                                exp (t0, ilist @ ilist0)
                            end
                        )
    | LPAREN exp RPAREN (debug_print "(exp)";
                         exp)

exercie 4.5は省略する.再帰下降型で書き直すのはちょっとだるい.先に進みたい.exercise 4.6も省略. syntax treeのtraverse順を書き換えるだけだしな.
明日からは本文中の演習.tiger languageのlexerを真面目に書いてAST作成だ.

Oct 2, 2018
chapter 2, chapter 3の結果のtiger.lexとtiger.grmをコピーしてきて.lexと.grmを合わせて動作させる為の調整を行った.sources.cmも直す.

diff --git a/sources.cm b/sources.cm
index e91dfd4..4b7bc96 100644
--- a/sources.cm
+++ b/sources.cm
@@ -8,6 +8,7 @@ symbol.sml
 parse.sml
 tiger.lex
 tiger.grm
-smlnj-lib.cm
-ml-yacc-lib.cm
+$/basis.cm
+$/smlnj-lib.cm
+$/ml-yacc-lib.cm

tiger.grmのterminal, non-terminalの型をabsyn.smlに合わせて調整する.未だ途中だが今日やった所迄載せる.tiger.grmの宣言部分.

structure A = Absyn

%%

(* yacc declarations *)
%term
    EOF
  | ID of string | INT of int | STRING of string
  | COMMA | COLON | SEMICOLON
  | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
  | DOT
  | PLUS | MINUS | TIMES | DIVIDE | UMINUS
  | EQ | NEQ | LT | LE | GT | GE
  | AND | OR
  | ASSIGN
  | ARRAY | IF | THEN | ELSE | WHILE | FOR | TO | DO | LET | IN | END | OF
  | BREAK
  | NIL
  | FUNCTION | VAR | TYPE
  | LVALUE

%nonterm program of A.exp
       | exp of A.exp
       | decs of A.dec list
       | dec of A.dec
       | fundec of A.FunctionDec
       | vardec of A.VarDec
       | tydec of A.TypeDec
       | ty of A.ty
       | tyfields of A.RecordTy
       | tyfield of A.field
       | lvalue of A.var
       | eseq of A.SeqExp
       | eseqlist of A.SeqExp
       | funcall of A.CallExp
       | args of A.exp list
       | arithmetic of A.OpExp
       | comparison of A.OpExp
       | boolean_exp of A.OpExp
       | record_creation of A.RecordExp
       | record_fields of (A.symbol * A.exp * A.pos) list
       | record_field of (A.symbol * A.exp * A.pos)
       | array_creation of A.ArrayExp
       | assign_stmt of A.AssignExp
       | if_then_else_stmt of A.IfExp
       | if_then_stmt of A.IfExp
       | while_stmt of A.WhileExp
       | for_stmt of A.ForExp
       | let_stmt of A.LetExp

tiger language referance manualの記述とabsynのdata typeの定義とでズレがある.宣言文では宣言文は宣言のリストであるが,一方absynではFunctionDecがfundec listになっている.decのlistでは無い.うーむ,これはsemantic valueを組み立てる時に頑張るのか?それとも文法をいじるべきか. tiger.grm内で%term, %nontermが出来たのでtiger.grm.sml内でtokenの定義が得られる様になった.明日以降はtiger.lexにをupdateしよう.

Oct 3, 2018
tiger.lexとtiger.grmを更新する.,ml-lex, ml-yaccはdocumentはあるけれど,細かいところはcodeを読まないと使えない.smlの理解不足とあわせて辛い.単なるtype mismatchを取り除くだけでも時間がかかる.取り敢えずtiger.lexはそれらしくなったので,途中ではあるが載せる.

(* for ML-yacc *)
type pos = int;
type svalue = Tokens.svalue;
type ('a,'b) token = ('a,'b) Tokens.token;
type lexresult = (svalue, pos) token;

val lineNum = ErrorMsg.lineNum;
val linePos = ErrorMsg.linePos;
val commentNest = ref 0;

fun eof () =
    let
        val pos = hd(!linePos)
    in
        Tokens.EOF (pos, pos)
    end;

%%

%header (functor TigerLexFun(structure Tokens: Tiger_TOKENS));

%s INITIAL COMMENT;
alpha   = [a-zA-Z];
alnum   = [a-zA-Z0-9];
alnumunder = [a-zA-Z0-9_];
digit   = [0-9];
ws      = [\ \t];

%%

\n      => (lineNum := !lineNum + 1;
            linePos := yypos :: !linePos;
            continue ());

{ws}+   => (continue ());

<INITIAL>"while"        => (Tokens.WHILE (yypos, yypos + String.size yytext));
<INITIAL>"for"          => (Tokens.FOR (yypos, yypos + String.size yytext));
<INITIAL>"to"           => (Tokens.TO (yypos, yypos + String.size yytext));
<INITIAL>"break"        => (Tokens.BREAK (yypos, yypos + String.size yytext));
<INITIAL>"let"          => (Tokens.LET (yypos, yypos + String.size yytext));
<INITIAL>"in"           => (Tokens.IN (yypos, yypos + String.size yytext));
<INITIAL>"end"          => (Tokens.END (yypos, yypos + String.size yytext));
<INITIAL>"function"     => (Tokens.FUNCTION (yypos, yypos + String.size yytext));
<INITIAL>"var"          => (Tokens.VAR (yypos, yypos + String.size yytext));
<INITIAL>"type"         => (Tokens.TYPE (yypos, yypos + String.size yytext));
<INITIAL>"array"        => (Tokens.ARRAY (yypos, yypos + String.size yytext));
<INITIAL>"if"           => (Tokens.IF (yypos, yypos + String.size yytext));
<INITIAL>"then"         => (Tokens.THEN (yypos, yypos + String.size yytext));
<INITIAL>"else"         => (Tokens.ELSE (yypos, yypos + String.size yytext));
<INITIAL>"do"           => (Tokens.DO (yypos, yypos + String.size yytext));
<INITIAL>"of"           => (Tokens.OF (yypos, yypos + String.size yytext));
<INITIAL>"nil"          => (Tokens.NIL (yypos, yypos + String.size yytext));

<INITIAL>","    => (Tokens.COMMA (yypos, yypos + String.size yytext));
<INITIAL>":"    => (Tokens.COLON (yypos, yypos + String.size yytext));
<INITIAL>";"    => (Tokens.SEMICOLON (yypos, yypos + String.size yytext));
<INITIAL>"("    => (Tokens.LPAREN (yypos, yypos + String.size yytext));
<INITIAL>")"    => (Tokens.RPAREN (yypos, yypos + String.size yytext));
<INITIAL>"["    => (Tokens.LBRACK (yypos, yypos + String.size yytext));
<INITIAL>"]"    => (Tokens.RBRACK (yypos, yypos + String.size yytext));
<INITIAL>"{"    => (Tokens.LBRACE (yypos, yypos + String.size yytext));
<INITIAL>"}"    => (Tokens.RBRACE (yypos, yypos + String.size yytext));
<INITIAL>"."    => (Tokens.DOT (yypos, yypos + String.size yytext));
<INITIAL>"+"    => (Tokens.PLUS (yypos, yypos + String.size yytext));
<INITIAL>"-"    => (Tokens.MINUS (yypos, yypos + String.size yytext));
<INITIAL>"*"    => (Tokens.TIMES (yypos, yypos + String.size yytext));
<INITIAL>"/"    => (Tokens.DIVIDE (yypos, yypos + String.size yytext));
<INITIAL>"="    => (Tokens.EQ (yypos, yypos + String.size yytext));
<INITIAL>"<>"   => (Tokens.NEQ (yypos, yypos + String.size yytext));
<INITIAL>"<"    => (Tokens.LT (yypos, yypos + String.size yytext));
<INITIAL>"<="   => (Tokens.LE (yypos, yypos + String.size yytext));
<INITIAL>">"    => (Tokens.GT (yypos, yypos + String.size yytext));
<INITIAL>">="   => (Tokens.GE (yypos, yypos + String.size yytext));
<INITIAL>"&"    => (Tokens.AND (yypos, yypos + String.size yytext));
<INITIAL>"|"    => (Tokens.OR (yypos, yypos + String.size yytext));
<INITIAL>":="   => (Tokens.ASSIGN (yypos, yypos + String.size yytext));

<INITIAL>{alpha}{alnumunder}*   => (Tokens.ID  (yytext, yypos, yypos + String.size yytext));
<INITIAL>{digit}+               => (Tokens.INT (valOf (Int.fromString yytext),
                                                yypos, yypos + String.size yytext));
<INITIAL>\".+\"                 => (Tokens.STRING (yytext, yypos, yypos + String.size yytext));

<INITIAL>"/*"   => (commentNest := !commentNest + 1;
                    if !commentNest = 1 then (YYBEGIN COMMENT) else ();
                    continue ());
<COMMENT>"*/"   => (commentNest := !commentNest - 1;
                    if !commentNest = 0 then (YYBEGIN INITIAL) else ();
                    continue ());
<COMMENT>.      => (continue ());

.       => (ErrorMsg.error yypos ("illegal character " ^ yytext); continue ());

Oct 4, 2018
tiger.grmをupdateした.明らかなbuild errorは取り除いたが未だshift/reduce conflictが残っている.途中のものを載せる.明日以降debugを続ける.Absyn.decの定義が納得いかん.FunctionDecとTypeDecはlistなのにVarDecはlistじゃない.

structure A = Absyn;

%%

(* yacc declarations *)
%term
    EOF
  | ID of string | INT of int | STRING of string
  | COMMA | COLON | SEMICOLON
  | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
  | DOT
  | PLUS | MINUS | TIMES | DIVIDE | UMINUS
  | EQ | NEQ | LT | LE | GT | GE
  | AND | OR
  | ASSIGN
  | ARRAY | IF | THEN | ELSE | WHILE | FOR | TO | DO | LET | IN | END | OF
  | BREAK
  | NIL
  | FUNCTION | VAR | TYPE
  | LVALUE

%nonterm program of A.exp
       | exp of A.exp
       | decs of A.dec list
       | dec of A.dec
       | fundec of A.fundec
       | vardec of A.dec
       | tydec of {name: A.symbol, ty: A.ty, pos: A.pos}
       | ty of A.ty
       | tyfields of A.field list
       | tyfield of A.field
       | lvalue of A.var
       | eseq of A.exp
       | eseqlist of (A.exp * A.pos) list
       | funcall of A.exp
       | args of A.exp list
       | arithmetic of A.exp
       | comparison of A.exp
       | boolean_exp of A.exp
       | record_creation of A.exp
       | record_fields of (A.symbol * A.exp * A.pos) list
       | record_field of (A.symbol * A.exp * A.pos)
       | array_creation of A.exp
       | assign_stmt of A.exp
       | if_then_else_stmt of A.exp
       | if_then_stmt of A.exp
       | while_stmt of A.exp
       | for_stmt of A.exp
       | let_stmt of A.exp

%nonassoc ASSIGN
%left OR
%left AND
%nonassoc EQ NEQ LT LE GT GE
%left PLUS MINUS
%left TIMES DIVIDE
%left UMINUS
%nonassoc LVALUE
%left LBRACK
%left LPAREN

%pos int
%verbose
%start program
%eop EOF
%noshift EOF

%name Tiger

(* declarations for error recovery *)
%keyword WHILE FOR TO BREAK LET IN END FUNCTION VAR TYPE ARRAY IF THEN ELSE
	DO OF NIL

%prefer THEN ELSE LPAREN

%value ID ("bogus")
%value INT (1)
%value STRING ("")

%%

program	: exp   (exp)

(* declaration *)
decs : decs dec (dec :: decs)
     | dec      (dec :: nil)
dec : tydec     (A.TypeDec (tydec :: nil))
    | vardec    (vardec)
    | fundec    (A.FunctionDec (fundec :: nil))

(* type declaration *)
tydec : TYPE ID EQ ty                   ({name=Symbol.symbol ID,
                                          ty=ty,
                                          pos=EQleft})

ty : ID                         (A.NameTy(Symbol.symbol ID, ID1left))
   | LBRACE tyfields RBRACE     (A.RecordTy tyfields)
   | ARRAY OF ID                (A.ArrayTy (Symbol.symbol ID,
                                            ARRAYleft))
tyfields : tyfields COMMA tyfield    (tyfield :: tyfields)
         |                           (nil : A.field list)
tyfield : ID COLON ID   ({name = Symbol.symbol ID1,
                          escape = ref true,
                          typ = Symbol.symbol ID2,
                          pos = COLONleft})

(* variable declaration *)
vardec : VAR ID ASSIGN exp              (A.VarDec {name= Symbol.symbol ID,
                                                   escape = ref true,
                                                   typ = NONE,
                                                   init = exp,
                                                   pos = ASSIGNleft})
       | VAR ID COLON ID ASSIGN exp     (A.VarDec {name= Symbol.symbol ID1,
                                                   escape = ref true,
                                                   typ = SOME (Symbol.symbol ID2, ID2left),
                                                   init = exp,
                                                   pos = ASSIGNleft})

(* function declaration *)
fundec : FUNCTION ID LPAREN tyfields RPAREN EQ exp              (
             {name = Symbol.symbol ID,
              params = tyfields,
              result = NONE,
              body = exp,
              pos = EQleft})
       | FUNCTION ID LPAREN tyfields RPAREN COLON ID EQ exp     (
             {name = Symbol.symbol ID,
              params = tyfields,
              result = SOME (Symbol.symbol ID2, ID2left),
              body = exp,
              pos = EQleft})

(* lvalue *)
lvalue : ID %prec LVALUE                (A.SimpleVar (Symbol.symbol ID, IDleft))
       | lvalue DOT ID                  (A.FieldVar (lvalue,
                                                     Symbol.symbol ID,
                                                     DOTleft))
       | lvalue LBRACK exp RBRACK       (A.SubscriptVar (lvalue, exp,
                                                         LBRACKleft))

(* expression *)
exp : lvalue            (A.VarExp lvalue)
    | NIL               (A.NilExp)
    | INT               (A.IntExp INT)
    | STRING            (A.StringExp (STRING, STRINGleft))
    | BREAK             (A.BreakExp BREAKleft)
    | if_then_stmt      (if_then_stmt)
    | if_then_else_stmt (if_then_else_stmt)
    | while_stmt        (while_stmt)
    | for_stmt          (for_stmt)
    | let_stmt          (let_stmt)
    | eseq              (eseq)
    | record_creation   (record_creation)
    | array_creation    (array_creation)
    | assign_stmt       (assign_stmt)
    | funcall           (funcall)
    | arithmetic        (arithmetic)
    | comparison        (comparison1)
    | boolean_exp       (boolean_exp)

(* flow control statement *)
if_then_else_stmt : IF exp THEN exp ELSE exp    (A.IfExp {test = exp1,
                                                          then' = exp2,
                                                          else' = SOME exp3,
                                                          pos = THENleft})
if_then_stmt : IF exp THEN exp                  (A.IfExp {test = exp1,
                                                          then' = exp2,
                                                          else' = NONE,
                                                          pos = THENleft})
while_stmt : WHILE exp DO exp                   (A.WhileExp {test = exp1,
                                                             body = exp2,
                                                             pos = DOleft})
for_stmt : FOR ID ASSIGN exp TO exp DO exp      (
          A.ForExp {var = Symbol.symbol ID,
                    escape = ref true,
                    lo = exp1,
                    hi = exp2,
                    body = exp3,
                    pos = ASSIGNleft})
let_stmt : LET decs IN exp END                  (
          A.LetExp {decs = decs,
                    body = exp,
                    pos = INleft})

(* expression sequence and paren *)
eseq : LPAREN eseqlist RPAREN           (A.SeqExp eseqlist)
eseqlist : eseqlist SEMICOLON exp       ((exp, expleft) :: eseqlist)
         |                              (nil : (A.exp * A.pos) list)

(* funcall *)
funcall : ID LPAREN args RPAREN         (A.CallExp {func = Symbol.symbol ID,
                                                    args = args,
                                                    pos = IDleft})
args : args COMMA exp   (exp :: args)
     |                  (nil : A.exp list)

(* arithmetic expression *)
arithmetic : exp PLUS exp               (A.OpExp {left = exp1,
                                                  oper = A.PlusOp,
                                                  right = exp2,
                                                  pos = PLUSleft})
           | exp MINUS exp              (A.OpExp {left = exp1,
                                                  oper = A.MinusOp,
                                                  right = exp2,
                                                  pos = MINUS1left})
           | exp TIMES exp              (A.OpExp {left = exp1,
                                                  oper = A.TimesOp,
                                                  right = exp2,
                                                  pos = TIMESleft})
           | exp DIVIDE exp             (A.OpExp {left = exp1,
                                                  oper = A.DivideOp,
                                                  right = exp2,
                                                  pos = DIVIDEleft})
           | MINUS exp %prec UMINUS     (A.OpExp {left = A.IntExp 0,
                                                  oper = A.MinusOp,
                                                  right = exp1,
                                                  pos = MINUS1left})

(* comparison *)
comparison : exp EQ exp         (A.OpExp {left = exp1,
                                          oper = A.EqOp,
                                          right = exp2,
                                          pos = EQ1left})
           | exp NEQ exp        (A.OpExp {left = exp1,
                                          oper = A.NeqOp,
                                          right = exp2,
                                          pos = NEQleft})
           | exp LT exp         (A.OpExp {left = exp1,
                                          oper = A.LtOp,
                                          right = exp2,
                                          pos = LTleft})
           | exp LE exp         (A.OpExp {left = exp1,
                                          oper = A.LeOp,
                                          right = exp2,
                                          pos = LEleft})
           | exp GT exp         (A.OpExp {left = exp1,
                                          oper = A.GtOp,
                                          right = exp2,
                                          pos = GTleft})
           | exp GE exp         (A.OpExp {left = exp1,
                                          oper = A.GeOp,
                                          right = exp2,
                                          pos = GEleft})

(* boolean expression *)
boolean_exp : exp AND exp       (A.IfExp {test = exp1,
                                          then' = exp2,
                                          else' = SOME (A.IntExp 0),
                                          pos = ANDleft})
            | exp OR exp        (A.IfExp {test = exp1,
                                          then' = A.IntExp 1,
                                          else' = SOME exp2,
                                          pos = ORleft})

(* record creation *)
record_creation : ID LBRACE record_fields RBRACE        (
                  A.RecordExp {fields = record_fields,
                               typ = Symbol.symbol ID,
                               pos = IDleft})
record_fields : record_fields COMMA record_field        (record_field :: record_fields)
            |   (nil : (A.symbol * A.exp * A.pos) list)
record_field : ID EQ exp        ((Symbol.symbol ID, exp, EQleft))

(* array creation *)
array_creation : ID LBRACK exp RBRACK OF exp (
                    A.ArrayExp {typ = Symbol.symbol ID,
                                size = exp1,
                                init = exp2,
                                pos = OFleft})

(* asssignement *)
assign_stmt : lvalue ASSIGN exp (A.AssignExp {var = lvalue,
                                              exp = exp,
                                              pos = ASSIGNleft})

Oct 5, 2018
string literalの処理が無かった.escape sequenceに対応していない.これはlexでやったほうが楽なのでtiger.lexに処理を追加した.vardecとfuncdecがlistである理由がわかった.recursive declarationの為である.smlだとandで区切る必要があるのだが,tiger languageは単に宣言を連続して並べるだけなのね.うーん,shift/reduce conflictになるじゃないか.(だからsmlはandを区切りとして並べるようになっているのに.文法を簡単にする為か.)

(* for ML-yacc *)
type pos = int;
type svalue = Tokens.svalue;
type ('a,'b) token = ('a,'b) Tokens.token;
type lexresult = (svalue, pos) token;

val lineNum = ErrorMsg.lineNum;
val linePos = ErrorMsg.linePos;
val commentNest = ref 0;

val string_buf = ref "";
fun string_add c = string_buf := (! string_buf) ^ c;
fun string_get () = ! string_buf;
fun string_reset () = string_buf := "";

val string_pos = ref 0;
fun string_pos_get () = (! string_pos);
fun string_pos_set pos = string_pos := pos;

fun eof () =
    let
        val pos = hd(!linePos)
    in
        Tokens.EOF (pos, pos)
    end;

%%

%header (functor TigerLexFun(structure Tokens: Tiger_TOKENS));

%s INITIAL COMMENT STRING STRINGF;
alpha   = [a-zA-Z];
alnum   = [a-zA-Z0-9];
alnumunder = [a-zA-Z0-9_];
digit   = [0-9];
ws      = [\ \t];

%%

\n      => (lineNum := !lineNum + 1;
            linePos := yypos :: !linePos;
            continue ());

{ws}+   => (continue ());

<INITIAL>"while"        => (Tokens.WHILE (yypos, yypos + String.size yytext));
<INITIAL>"for"          => (Tokens.FOR (yypos, yypos + String.size yytext));
<INITIAL>"to"           => (Tokens.TO (yypos, yypos + String.size yytext));
<INITIAL>"break"        => (Tokens.BREAK (yypos, yypos + String.size yytext));
<INITIAL>"let"          => (Tokens.LET (yypos, yypos + String.size yytext));
<INITIAL>"in"           => (Tokens.IN (yypos, yypos + String.size yytext));
<INITIAL>"end"          => (Tokens.END (yypos, yypos + String.size yytext));
<INITIAL>"function"     => (Tokens.FUNCTION (yypos, yypos + String.size yytext));
<INITIAL>"var"          => (Tokens.VAR (yypos, yypos + String.size yytext));
<INITIAL>"type"         => (Tokens.TYPE (yypos, yypos + String.size yytext));
<INITIAL>"array"        => (Tokens.ARRAY (yypos, yypos + String.size yytext));
<INITIAL>"if"           => (Tokens.IF (yypos, yypos + String.size yytext));
<INITIAL>"then"         => (Tokens.THEN (yypos, yypos + String.size yytext));
<INITIAL>"else"         => (Tokens.ELSE (yypos, yypos + String.size yytext));
<INITIAL>"do"           => (Tokens.DO (yypos, yypos + String.size yytext));
<INITIAL>"of"           => (Tokens.OF (yypos, yypos + String.size yytext));
<INITIAL>"nil"          => (Tokens.NIL (yypos, yypos + String.size yytext));

<INITIAL>","    => (Tokens.COMMA (yypos, yypos + String.size yytext));
<INITIAL>":"    => (Tokens.COLON (yypos, yypos + String.size yytext));
<INITIAL>";"    => (Tokens.SEMICOLON (yypos, yypos + String.size yytext));
<INITIAL>"("    => (Tokens.LPAREN (yypos, yypos + String.size yytext));
<INITIAL>")"    => (Tokens.RPAREN (yypos, yypos + String.size yytext));
<INITIAL>"["    => (Tokens.LBRACK (yypos, yypos + String.size yytext));
<INITIAL>"]"    => (Tokens.RBRACK (yypos, yypos + String.size yytext));
<INITIAL>"{"    => (Tokens.LBRACE (yypos, yypos + String.size yytext));
<INITIAL>"}"    => (Tokens.RBRACE (yypos, yypos + String.size yytext));
<INITIAL>"."    => (Tokens.DOT (yypos, yypos + String.size yytext));
<INITIAL>"+"    => (Tokens.PLUS (yypos, yypos + String.size yytext));
<INITIAL>"-"    => (Tokens.MINUS (yypos, yypos + String.size yytext));
<INITIAL>"*"    => (Tokens.TIMES (yypos, yypos + String.size yytext));
<INITIAL>"/"    => (Tokens.DIVIDE (yypos, yypos + String.size yytext));
<INITIAL>"="    => (Tokens.EQ (yypos, yypos + String.size yytext));
<INITIAL>"<>"   => (Tokens.NEQ (yypos, yypos + String.size yytext));
<INITIAL>"<"    => (Tokens.LT (yypos, yypos + String.size yytext));
<INITIAL>"<="   => (Tokens.LE (yypos, yypos + String.size yytext));
<INITIAL>">"    => (Tokens.GT (yypos, yypos + String.size yytext));
<INITIAL>">="   => (Tokens.GE (yypos, yypos + String.size yytext));
<INITIAL>"&"    => (Tokens.AND (yypos, yypos + String.size yytext));
<INITIAL>"|"    => (Tokens.OR (yypos, yypos + String.size yytext));
<INITIAL>":="   => (Tokens.ASSIGN (yypos, yypos + String.size yytext));

<INITIAL>{alpha}{alnumunder}*   => (Tokens.ID  (yytext, yypos, yypos + String.size yytext));
<INITIAL>{digit}+               => (Tokens.INT (valOf (Int.fromString yytext),
                                                yypos, yypos + String.size yytext));

<INITIAL>\"     => (YYBEGIN STRING;
                    string_reset ();
                    string_pos_set (yypos + 1);
                    continue ());
<STRING>\"      => (YYBEGIN INITIAL;
                    Tokens.STRING (string_get (), string_pos_get (), yypos));
<STRING>\\n     => (string_add "\n"; continue ());
<STRING>\\t     => (string_add "\t"; continue ());
<STRING>\\\^[abtnvfr]   => (
    let
        val char_val = String.sub (yytext, 2);
        fun control_char_add c =
            case c of
                #"a" => string_add "\a"
              | #"b" => string_add "\b"
              | #"t" => string_add "\t"
              | #"n" => string_add "\n"
              | #"v" => string_add "\v"
              | #"f" => string_add "\f"
              | #"r" => string_add "\r"
              | _ => (ErrorMsg.error
                          yypos ("illegal control character " ^ yytext);
                      ())
        val _ = control_char_add char_val;
    in
        continue()
    end);
<STRING>\\{digit}{3}    => (
    let
        val three_digit = substring (yytext, 1, 3);
        val ascii_code = valOf (Int.fromString three_digit);
        val char_val = chr ascii_code;
        val str_val = Char.toString char_val;
        val _ = string_add str_val;
    in
        continue()
    end);
<STRING>\\\"    => (string_add "\""; continue ());
<STRING>\\\\    => (string_add "\\"; continue ());
<STRING>\\f     => (YYBEGIN STRINGF; continue ());
<STRING>.       => (string_add yytext; continue ());
<STRINGF>f\\    => (YYBEGIN STRING; continue ());
<STRINGF>.      => (continue ());

<INITIAL>"/*"   => (commentNest := !commentNest + 1;
                    if !commentNest = 1 then (YYBEGIN COMMENT) else ();
                    continue ());
<COMMENT>"*/"   => (commentNest := !commentNest - 1;
                    if !commentNest = 0 then (YYBEGIN INITIAL) else ();
                    continue ());
<COMMENT>.      => (continue ());

.       => (ErrorMsg.error yypos ("illegal character " ^ yytext); continue ());

Oct 8, 2018
tiger.grmの更新を続ける.array subscriptとarray creationのconflictが取れない.lvalue [ exp ]とID [ exp ] of expでshift優先だとarray creationを選択してしまいarr[0]などがsyntax errorになってしまう.左括り出しを行って修正する必要があるのかな.一応parse出来るようになったが,まだerrorになるべきtest<n>.tigがerrorにならない.途中経過を載せる.

(* for ML-yacc *)
type pos = int;
type svalue = Tokens.svalue;
type ('a,'b) token = ('a,'b) Tokens.token;
type lexresult = (svalue, pos) token;

val lineNum = ErrorMsg.lineNum;
val linePos = ErrorMsg.linePos;
val commentNest = ref 0;

val string_buf = ref "";
fun string_add c = string_buf := (! string_buf) ^ c;
fun string_get () = ! string_buf;
fun string_reset () = string_buf := "";

val string_pos = ref 0;
fun string_pos_get () = (! string_pos);
fun string_pos_set pos = string_pos := pos;

fun eof () =
    let
        val pos = hd(!linePos)
    in
        Tokens.EOF (pos, pos)
    end;

val debug_print_enable = false;
(* val debug_print_enable = true; *)
val debug_prefix = "LEX: "
fun debug_print debug_string =
    if debug_print_enable then
        print (debug_prefix ^ debug_string ^ "\n")
    else
        ()

%%

%header (functor TigerLexFun(structure Tokens: Tiger_TOKENS));

%s INITIAL COMMENT STRING STRINGF;
alpha   = [a-zA-Z];
alnum   = [a-zA-Z0-9];
alnumunder = [a-zA-Z0-9_];
digit   = [0-9];
ws      = [\ \t];

%%

\n	=> (lineNum := !lineNum + 1;
            linePos := yypos :: !linePos;
            continue ());

{ws}+	=> (continue ());

<INITIAL>"while"	=> (debug_print "while";
                            Tokens.WHILE (yypos, yypos + String.size yytext));
<INITIAL>"for"		=> (debug_print "for";
                            Tokens.FOR (yypos, yypos + String.size yytext));
<INITIAL>"to"		=> (debug_print "to";
                            Tokens.TO (yypos, yypos + String.size yytext));
<INITIAL>"break"	=> (debug_print "break";
                            Tokens.BREAK (yypos, yypos + String.size yytext));
<INITIAL>"let"		=> (debug_print "let";
                            Tokens.LET (yypos, yypos + String.size yytext));
<INITIAL>"in"		=> (debug_print "in";
                            Tokens.IN (yypos, yypos + String.size yytext));
<INITIAL>"end"		=> (debug_print "end";
                            Tokens.END (yypos, yypos + String.size yytext));
<INITIAL>"function"	=> (debug_print "function";
                            Tokens.FUNCTION (yypos, yypos + String.size yytext));
<INITIAL>"var"		=> (debug_print "var";
                            Tokens.VAR (yypos, yypos + String.size yytext));
<INITIAL>"type"		=> (debug_print "type";
                            Tokens.TYPE (yypos, yypos + String.size yytext));
<INITIAL>"array"	=> (debug_print "array";
                            Tokens.ARRAY (yypos, yypos + String.size yytext));
<INITIAL>"if"		=> (debug_print "if";
                            Tokens.IF (yypos, yypos + String.size yytext));
<INITIAL>"then"		=> (debug_print "then";
                            Tokens.THEN (yypos, yypos + String.size yytext));
<INITIAL>"else"		=> (debug_print "else";
                            Tokens.ELSE (yypos, yypos + String.size yytext));
<INITIAL>"do"		=> (debug_print "do";
                            Tokens.DO (yypos, yypos + String.size yytext));
<INITIAL>"of"		=> (debug_print "of";
                            Tokens.OF (yypos, yypos + String.size yytext));
<INITIAL>"nil"		=> (debug_print "nil";
                            Tokens.NIL (yypos, yypos + String.size yytext));

<INITIAL>","	=> (debug_print ",";
                    Tokens.COMMA (yypos, yypos + String.size yytext));
<INITIAL>":"	=> (debug_print ":";
                    Tokens.COLON (yypos, yypos + String.size yytext));
<INITIAL>";"	=> (debug_print ";";
                    Tokens.SEMICOLON (yypos, yypos + String.size yytext));
<INITIAL>"("	=> (debug_print "(";
                    Tokens.LPAREN (yypos, yypos + String.size yytext));
<INITIAL>")"	=> (debug_print ")";
                    Tokens.RPAREN (yypos, yypos + String.size yytext));
<INITIAL>"["	=> (debug_print "[";
                    Tokens.LBRACK (yypos, yypos + String.size yytext));
<INITIAL>"]"	=> (debug_print "]";
                    Tokens.RBRACK (yypos, yypos + String.size yytext));
<INITIAL>"{"	=> (debug_print "{";
                    Tokens.LBRACE (yypos, yypos + String.size yytext));
<INITIAL>"}"	=> (debug_print "}";
                    Tokens.RBRACE (yypos, yypos + String.size yytext));
<INITIAL>"."	=> (debug_print ".";
                    Tokens.DOT (yypos, yypos + String.size yytext));
<INITIAL>"+"	=> (debug_print "+";
                    Tokens.PLUS (yypos, yypos + String.size yytext));
<INITIAL>"-"	=> (debug_print "-";
                    Tokens.MINUS (yypos, yypos + String.size yytext));
<INITIAL>"*"	=> (debug_print "*";
                    Tokens.TIMES (yypos, yypos + String.size yytext));
<INITIAL>"/"	=> (debug_print "/";
                    Tokens.DIVIDE (yypos, yypos + String.size yytext));
<INITIAL>"="	=> (debug_print "=";
                    Tokens.EQ (yypos, yypos + String.size yytext));
<INITIAL>"<>"	=> (debug_print "<>";
                    Tokens.NEQ (yypos, yypos + String.size yytext));
<INITIAL>"<"	=> (debug_print "<";
                    Tokens.LT (yypos, yypos + String.size yytext));
<INITIAL>"<="	=> (debug_print "<=";
                    Tokens.LE (yypos, yypos + String.size yytext));
<INITIAL>">"	=> (debug_print ">";
                    Tokens.GT (yypos, yypos + String.size yytext));
<INITIAL>">="	=> (debug_print ">=";
                    Tokens.GE (yypos, yypos + String.size yytext));
<INITIAL>"&"	=> (debug_print "&";
                    Tokens.AND (yypos, yypos + String.size yytext));
<INITIAL>"|"	=> (debug_print "|";
                    Tokens.OR (yypos, yypos + String.size yytext));
<INITIAL>":="	=> (debug_print ":=";
                    Tokens.ASSIGN (yypos, yypos + String.size yytext));

<INITIAL>{alpha}{alnumunder}*   => (debug_print ("ID = " ^ yytext);
                                    Tokens.ID  (yytext, yypos, yypos + String.size yytext));
<INITIAL>{digit}+               => (debug_print ("INT = " ^ yytext);
                                    Tokens.INT (valOf (Int.fromString yytext),
                                                yypos, yypos + String.size yytext));

<INITIAL>\"     => (YYBEGIN STRING;
                    string_reset ();
                    string_pos_set (yypos + 1);
                    continue ());
<STRING>\"      => (YYBEGIN INITIAL;
                    debug_print ("STRING " ^ string_get());
                    Tokens.STRING (string_get (), string_pos_get (), yypos));
<STRING>\\n     => (string_add "\n"; continue ());
<STRING>\\t     => (string_add "\t"; continue ());
<STRING>\\\^[abtnvfr]   => (
    let
        val char_val = String.sub (yytext, 2);
        fun control_char_add c =
            case c of
                #"a" => string_add "\a"
              | #"b" => string_add "\b"
              | #"t" => string_add "\t"
              | #"n" => string_add "\n"
              | #"v" => string_add "\v"
              | #"f" => string_add "\f"
              | #"r" => string_add "\r"
              | _ => (ErrorMsg.error
                          yypos ("illegal control character " ^ yytext);
                      ())
        val _ = control_char_add char_val;
    in
        continue()
    end);
<STRING>\\{digit}{3}    => (
    let
        val three_digit = substring (yytext, 1, 3);
        val ascii_code = valOf (Int.fromString three_digit);
        val char_val = chr ascii_code;
        val str_val = Char.toString char_val;
        val _ = string_add str_val;
    in
        continue()
    end);
<STRING>\\\"    => (string_add "\""; continue ());
<STRING>\\\\    => (string_add "\\"; continue ());
<STRING>\\f     => (YYBEGIN STRINGF; continue ());
<STRING>.	=> (string_add yytext; continue ());
<STRINGF>f\\    => (YYBEGIN STRING; continue ());
<STRINGF>.      => (continue ());

<INITIAL>"/*"   => (commentNest := !commentNest + 1;
                    if !commentNest = 1 then (YYBEGIN COMMENT) else ();
                    continue ());
<COMMENT>"*/"   => (commentNest := !commentNest - 1;
                    if !commentNest = 0 then (YYBEGIN INITIAL) else ();
                    continue ());
<COMMENT>.	=> (continue ());

.	=> (ErrorMsg.error yypos ("illegal character " ^ yytext); continue ());
structure A = Absyn;

val debug_print_enable = false;
(* val debug_print_enable = true; *)
val debug_prefix = "DEBUG: "
fun debug_print debug_string =
    if debug_print_enable then
        print (debug_prefix ^ debug_string ^ "\n")
    else
        ()

%%

(* yacc declarations *)
%term
    EOF
  | ID of string | INT of int | STRING of string
  | COMMA | COLON | SEMICOLON
  | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
  | DOT
  | PLUS | MINUS | TIMES | DIVIDE | UMINUS
  | EQ | NEQ | LT | LE | GT | GE
  | AND | OR
  | ASSIGN
  | ARRAY | IF | THEN | ELSE | WHILE | FOR | TO | DO | LET | IN | END | OF
  | BREAK
  | NIL
  | FUNCTION | VAR | TYPE
  | LVALUE

%nonterm program of A.exp
       | exp of A.exp
       | decs of A.dec list
       | dec of A.dec
       | tydecs of A.dec
       | tydec of {name: A.symbol, ty: A.ty, pos: A.pos}
       | vardec of A.dec
       | fundecs of A.dec
       | fundec of A.fundec
       | ty of A.ty
       | tyfields of A.field list
       | tyfield of A.field
       | id_bracket of (A.symbol * A.exp * pos)
       | lvalue of A.var
       | eseq of A.exp
       | eseqlist of (A.exp * A.pos) list
       | funcall of A.exp
       | args of A.exp list
       | arithmetic of A.exp
       | comparison of A.exp
       | boolean_exp of A.exp
       | record_creation of A.exp
       | record_fields of (A.symbol * A.exp * A.pos) list
       | record_field of (A.symbol * A.exp * A.pos)
       | array_creation of A.exp
       | assign_stmt of A.exp
       | if_then_else_stmt of A.exp
       | if_then_stmt of A.exp
       | while_stmt of A.exp
       | for_stmt of A.exp
       | let_stmt of A.exp

(* %right OF *)
(* %left ELSE *)
(* %left THEN *)
(* %nonassoc DO *)
%nonassoc ASSIGN
%left OR
%left AND
%nonassoc EQ NEQ LT LE GT GE
%left PLUS MINUS
%left TIMES DIVIDE
%left UMINUS
(* %nonassoc LVALUE *)
(* %left LBRACK *)
(* %left LPAREN *)

%pos int
%verbose
%start program
%eop EOF
%noshift EOF

%name Tiger

(* declarations for error recovery *)
%keyword WHILE FOR TO BREAK LET IN END FUNCTION VAR TYPE ARRAY IF THEN ELSE
	DO OF NIL

%prefer THEN ELSE LPAREN

%value ID ("bogus")
%value INT (1)
%value STRING ("")

%%

program	: exp   (debug_print "program";
                 exp)

(* declaration *)
decs : decs dec (debug_print "dec :: decs";
                 dec :: decs)
     | dec      (debug_print "dec";
                 dec :: nil)
     |          (debug_print "decs : nil";
                nil : A.dec list)
dec : tydecs    (debug_print "tydecs";
                 tydecs)
    | vardec    (debug_print "vardec";
                 vardec)
    | fundecs   (debug_print "fundecs";
                 fundecs)

(* type declaration *)
(* This causes shift/reduce conflict. shift is chosen *)
tydecs : tydecs tydec           (let
                                    val _ = debug_print "tydecs tydec";
                                    val A.TypeDec tydeclist = tydecs;
                                in
                                    A.TypeDec (tydec :: tydeclist)
                                end)
    | tydec                  (debug_print "tydec";
                              A.TypeDec (tydec :: nil))

tydec : TYPE ID EQ ty                   (debug_print "TYPE ID EQ ty";
                                         {name=Symbol.symbol ID,
                                          ty=ty,
                                          pos=EQleft})

ty : ID                         (debug_print "ID";
                                 A.NameTy(Symbol.symbol ID, ID1left))
   | LBRACE tyfields RBRACE     (debug_print "{tyfields}";
                                 A.RecordTy tyfields)
   | ARRAY OF ID                (debug_print "ARRAY OF ID";
                                 A.ArrayTy (Symbol.symbol ID,
                                            ARRAYleft))
tyfields : tyfields COMMA tyfield    (debug_print "tyfields, tyefield";
                                      tyfield :: tyfields)
         | tyfield                   (debug_print "tyfield";
                                      tyfield :: nil)
         |                           (debug_print "tyfields : nil";
                                      nil : A.field list)
tyfield : ID COLON ID   (debug_print "ID COLON ID";
                         {name = Symbol.symbol ID1,
                          escape = ref true,
                          typ = Symbol.symbol ID2,
                          pos = COLONleft})

(* variable declaration *)
vardec : VAR ID ASSIGN exp              (debug_print "VAR ID ASSIGN exp";
                                         A.VarDec {name= Symbol.symbol ID,
                                                   escape = ref true,
                                                   typ = NONE,
                                                   init = exp,
                                                   pos = ASSIGNleft})
      | VAR ID COLON ID ASSIGN exp     (debug_print "VAR ID : ID := exp";
                                         A.VarDec {name= Symbol.symbol ID1,
                                                   escape = ref true,
                                                   typ = SOME (Symbol.symbol ID2, ID2left),
                                                   init = exp,
                                                   pos = ASSIGNleft})

(* function declaration *)
(* this causes shift/reduce conflict. shift is chosen *)
fundecs : fundecs fundec        (let
                                    val _ = debug_print "fundecs fundec";
                                    val A.FunctionDec fundeclist = fundecs
                                in
                                    A.FunctionDec (fundec :: fundeclist)
                                end)
        | fundec                (debug_print "fundec";
                                 A.FunctionDec (fundec :: nil))

fundec : FUNCTION ID LPAREN tyfields RPAREN EQ exp              (
              debug_print "FUNCTION ID LPAREN tyfields RPAREN EQ exp";
             {name = Symbol.symbol ID,
              params = tyfields,
              result = NONE,
              body = exp,
              pos = EQleft})
       | FUNCTION ID LPAREN tyfields RPAREN COLON ID EQ exp     (
             debug_print "FUNCTION ID LPAREN tyfields RPAREN COLON ID EQ exp";
             {name = Symbol.symbol ID,
              params = tyfields,
              result = SOME (Symbol.symbol ID2, ID2left),
              body = exp,
              pos = EQleft})

(* lvalue *)
lvalue : ID (* %prec LVALUE *)          (debug_print "lvalue ID";
                                         A.SimpleVar (Symbol.symbol ID, IDleft))
       | lvalue DOT ID                  (debug_print "lvalue . ID";
                                         A.FieldVar (lvalue,
                                                     Symbol.symbol ID,
                                                     DOTleft))
       | lvalue LBRACK exp RBRACK       (debug_print "lvalue[exp]";
                                         A.SubscriptVar (lvalue, exp,
                                                         LBRACKleft))
       | id_bracket                     (
             let
                 val _ = debug_print "lvalue : id_bracket";
                 val (id, exp, pos) = id_bracket1;
             in
                 A.SubscriptVar (A.SimpleVar (id, id_bracket1left),
                                 exp,
                                 pos)
             end)

(* expression *)
exp : lvalue            (debug_print "lvalue";
                         A.VarExp lvalue)
    | NIL               (debug_print "NIL";
                            A.NilExp)
    | INT               (debug_print "INT";
                         A.IntExp INT)
    | STRING            (debug_print "STRING";
                         A.StringExp (STRING, STRINGleft))
    | BREAK             (debug_print "BREAK";
                         A.BreakExp BREAKleft)
    | if_then_stmt      (debug_print "if_then_stmt";
                         if_then_stmt)
    | if_then_else_stmt (debug_print "if_then_else_stmt";
                         if_then_else_stmt)
    | while_stmt        (debug_print "while_stmt";
                         while_stmt)
    | for_stmt          (debug_print "for_stmt";
                         for_stmt)
    | let_stmt          (debug_print "let_stmt";
                         let_stmt)
    | eseq              (debug_print "eseq";
                         eseq)
    | record_creation   (debug_print "record_creation";
                         record_creation)
    | array_creation    (debug_print "array_creation";
                         array_creation)
    | assign_stmt       (debug_print "assign_stmt";
                         assign_stmt)
    | funcall           (debug_print "funcall";
                         funcall)
    | arithmetic        (debug_print "arithmetic";
                         arithmetic)
    | comparison        (debug_print "comparison";
                         comparison1)
    | boolean_exp       (debug_print "boolean_exp";
                         boolean_exp)

(* flow control statement *)
(* this cuases shift/reduce conflict. shift is chosen *)
if_then_else_stmt : IF exp THEN exp ELSE exp    (debug_print " IF exp THEN exp ELSE exp";
                                                 A.IfExp {test = exp1,
                                                          then' = exp2,
                                                          else' = SOME exp3,
                                                          pos = THENleft})
(* this cause shift/reduce conflice due to dangling else. shift is chosen *)
if_then_stmt : IF exp THEN exp                  (debug_print "IF exp THEN exp";
                                                 A.IfExp {test = exp1,
                                                          then' = exp2,
                                                          else' = NONE,
                                                          pos = THENleft})
while_stmt : WHILE exp DO exp                   (debug_print "WHILE exp DO exp";
                                                 A.WhileExp {test = exp1,
                                                             body = exp2,
                                                             pos = DOleft})
for_stmt : FOR ID ASSIGN exp TO exp DO exp      (
          debug_print "FOR ID ASSIGN exp TO exp DO exp";
          A.ForExp {var = Symbol.symbol ID,
                    escape = ref true,
                    lo = exp1,
                    hi = exp2,
                    body = exp3,
                    pos = ASSIGNleft})
let_stmt : LET decs IN eseqlist END             (
          debug_print "LET decs IN eseqlist END";
          A.LetExp {decs = decs,
                    body = A.SeqExp eseqlist,
                    pos = INleft})

(* expression sequence and paren *)
eseq : LPAREN eseqlist RPAREN           (debug_print "LPAREN eseqlist RPAREN";
                                         A.SeqExp eseqlist)
eseqlist : eseqlist SEMICOLON exp       (debug_print "eseqlist SEMICOLON exp";
                                         (exp, expleft) :: eseqlist)
         | exp                          (debug_print "eseqlist: exp";
                                         (exp, expleft) :: nil)
         |                              (debug_print "eseqlist: nil";
                                         nil : (A.exp * A.pos) list)

(* funcall *)
funcall : ID LPAREN args RPAREN         (debug_print "ID LPAREN args RPAREN";
                                         A.CallExp {func = Symbol.symbol ID,
                                                    args = args,
                                                    pos = IDleft})
args : args COMMA exp   (debug_print "args COMMA exp";
                         exp :: args)
     | exp              (debug_print "args: exp";
                         exp :: nil)
     |                  (debug_print "args: nil";
                         nil : A.exp list)

(* arithmetic expression *)
arithmetic : exp PLUS exp               (debug_print "exp PLUS exp";
                                         A.OpExp {left = exp1,
                                                  oper = A.PlusOp,
                                                  right = exp2,
                                                  pos = PLUSleft})
           | exp MINUS exp              (debug_print "exp MINUS exp";
                                         A.OpExp {left = exp1,
                                                  oper = A.MinusOp,
                                                  right = exp2,
                                                  pos = MINUS1left})
           | exp TIMES exp              (debug_print "exp TIMES exp";
                                         A.OpExp {left = exp1,
                                                  oper = A.TimesOp,
                                                  right = exp2,
                                                  pos = TIMESleft})
           | exp DIVIDE exp             (debug_print "exp DIVIDE exp";
                                         A.OpExp {left = exp1,
                                                  oper = A.DivideOp,
                                                  right = exp2,
                                                  pos = DIVIDEleft})
           | MINUS exp %prec UMINUS     (debug_print "UMINUS exp";
                                         A.OpExp {left = A.IntExp 0,
                                                  oper = A.MinusOp,
                                                  right = exp1,
                                                  pos = MINUS1left})

(* comparison *)
comparison : exp EQ exp         (debug_print "exp EQ exp";
                                 A.OpExp {left = exp1,
                                          oper = A.EqOp,
                                          right = exp2,
                                          pos = EQ1left})
           | exp NEQ exp        (debug_print "exp NEQ exp";
                                 A.OpExp {left = exp1,
                                          oper = A.NeqOp,
                                          right = exp2,
                                          pos = NEQleft})
           | exp LT exp         (debug_print "exp LT exp";
                                 A.OpExp {left = exp1,
                                          oper = A.LtOp,
                                          right = exp2,
                                          pos = LTleft})
           | exp LE exp         (debug_print "exp LE exp";
                                 A.OpExp {left = exp1,
                                          oper = A.LeOp,
                                          right = exp2,
                                          pos = LEleft})
           | exp GT exp         (debug_print "exp GT exp";
                                 A.OpExp {left = exp1,
                                          oper = A.GtOp,
                                          right = exp2,
                                          pos = GTleft})
           | exp GE exp         (debug_print "exp GE exp";
                                 A.OpExp {left = exp1,
                                          oper = A.GeOp,
                                          right = exp2,
                                          pos = GEleft})

(* boolean expression *)
boolean_exp : exp AND exp       (debug_print "exp AND exp";
                                 A.IfExp {test = exp1,
                                          then' = exp2,
                                          else' = SOME (A.IntExp 0),
                                          pos = ANDleft})
            | exp OR exp        (debug_print "exp OR exp";
                                 A.IfExp {test = exp1,
                                          then' = A.IntExp 1,
                                          else' = SOME exp2,
                                          pos = ORleft})

(* record creation *)
record_creation : ID LBRACE record_fields RBRACE        (
                  debug_print "ID LBRACE record_fields RBRACE";
                  A.RecordExp {fields = record_fields,
                               typ = Symbol.symbol ID,
                               pos = IDleft})
record_fields : record_fields COMMA record_field        (
                  debug_print "record_fields COMMA record_field";
                  record_field :: record_fields)
            | record_field      (
                  debug_print "record_fields : record_field";
                  record_field :: nil)
            |                   (
                  debug_print "record_fields : nil";
                  nil : (A.symbol * A.exp * A.pos) list)
record_field : ID EQ exp        (debug_print "record_field : ID EQ exp";
                                 (Symbol.symbol ID, exp, EQleft))

(* there is a conflict with array_creation and lvalue LBRACK exp RBRACK
 * introduce a generation rule for common left part.
 *)
id_bracket : ID LBRACK exp RBRACK       ((Symbol.symbol ID, exp, LBRACKleft))

(* array creation *)
(* this causes shift/reduce conflict. shift is chosen *)
array_creation : id_bracket OF exp (
                 let
                     val _ = debug_print "ID LBRACK exp RBRACK OF exp";
                     val (id0, exp0, pos0) = id_bracket;
                 in
                     A.ArrayExp {typ = id0,
                                 size = exp0,
                                 init = exp1,
                                 pos = OFleft}
                 end)

(* asssignement *)
assign_stmt : lvalue ASSIGN exp (debug_print "lvalue ASSIGN exp";
                                 A.AssignExp {var = lvalue,
                                              exp = exp,
                                              pos = ASSIGNleft})

Oct 9, 2018
id [ exp ]に対応するnon-terminal symbolを導入して文法規則を修正.shift/reduce conflictが残るが%nonassoc ASSIGN OF DO THEN ELSEでshiftを優先させる.優先度なしでもshift優先なので問題ないのだが,chapter 3で優先度修飾子を使用してみよとあるので使ってみた.残ったshift/reduce conflictは全てshiftで良い.tiger.lexは修正なし.tiger.grmのみ載せる.

structure A = Absyn;

val debug_print_enable = false;
(* val debug_print_enable = true; *)
val debug_prefix = "DEBUG: "
fun debug_print debug_string =
    if debug_print_enable then
        print (debug_prefix ^ debug_string ^ "\n")
    else
        ()

%%

(* yacc declarations *)
%term
    EOF
  | ID of string | INT of int | STRING of string
  | COMMA | COLON | SEMICOLON
  | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
  | DOT
  | PLUS | MINUS | TIMES | DIVIDE | UMINUS
  | EQ | NEQ | LT | LE | GT | GE
  | AND | OR
  | ASSIGN
  | ARRAY | IF | THEN | ELSE | WHILE | FOR | TO | DO | LET | IN | END | OF
  | BREAK
  | NIL
  | FUNCTION | VAR | TYPE
  | LVALUE

%nonterm program of A.exp
       | exp of A.exp
       | decs of A.dec list
       | dec of A.dec
       | tydecs of A.dec
       | tydec of {name: A.symbol, ty: A.ty, pos: A.pos}
       | vardec of A.dec
       | fundecs of A.dec
       | fundec of A.fundec
       | ty of A.ty
       | tyfields of A.field list
       | tyfield of A.field
       (* there is a conflict with array_creation and lvalue LBRACK exp RBRACK
        * introduce a intermiddiate generation rule for common left part.
        *)
       | id_bracket of (A.symbol * A.exp * pos)
       | lvalue of A.var
       | eseq of A.exp
       | eseqlist of (A.exp * A.pos) list
       | funcall of A.exp
       | args of A.exp list
       | arithmetic of A.exp
       | comparison of A.exp
       | boolean_exp of A.exp
       | record_creation of A.exp
       | record_fields of (A.symbol * A.exp * A.pos) list
       | record_field of (A.symbol * A.exp * A.pos)
       | array_creation of A.exp
       | assign_stmt of A.exp
       | if_then_else_stmt of A.exp
       | if_then_stmt of A.exp
       | while_stmt of A.exp
       | for_stmt of A.exp
       | let_stmt of A.exp

%right THEN ELSE
%nonassoc ASSIGN OF DO
%left OR
%left AND
%nonassoc EQ NEQ LT LE GT GE
%left PLUS MINUS
%left TIMES DIVIDE
%left UMINUS

%pos int
%verbose
%start program
%eop EOF
%noshift EOF

%name Tiger

(* declarations for error recovery *)
%keyword WHILE FOR TO BREAK LET IN END FUNCTION VAR TYPE ARRAY IF THEN ELSE
	DO OF NIL

%prefer THEN ELSE LPAREN

%value ID ("bogus")
%value INT (1)
%value STRING ("")

%%

program	: exp   (debug_print "program";
                 exp)

(* declaration *)
decs : decs dec (debug_print "dec :: decs";
                 dec :: decs)
     | dec      (debug_print "dec";
                 dec :: nil)
     |          (debug_print "decs : nil";
                nil : A.dec list)
dec : tydecs    (debug_print "tydecs";
                 tydecs)
    | vardec    (debug_print "vardec";
                 vardec)
    | fundecs   (debug_print "fundecs";
                 fundecs)

(* type declaration *)
(* This causes shift/reduce conflict. shift is chosen *)
tydecs : tydecs tydec           (let
                                    val _ = debug_print "tydecs tydec";
                                    val A.TypeDec tydeclist = tydecs;
                                in
                                    A.TypeDec (tydec :: tydeclist)
                                end)
    | tydec                  (debug_print "tydec";
                              A.TypeDec (tydec :: nil))

tydec : TYPE ID EQ ty                   (debug_print "TYPE ID EQ ty";
                                         {name=Symbol.symbol ID,
                                          ty=ty,
                                          pos=EQleft})

ty : ID                         (debug_print "ID";
                                 A.NameTy(Symbol.symbol ID, ID1left))
   | LBRACE tyfields RBRACE     (debug_print "{tyfields}";
                                 A.RecordTy tyfields)
   | ARRAY OF ID                (debug_print "ARRAY OF ID";
                                 A.ArrayTy (Symbol.symbol ID,
                                            ARRAYleft))
tyfields : tyfields COMMA tyfield    (debug_print "tyfields, tyefield";
                                      tyfield :: tyfields)
         | tyfield                   (debug_print "tyfield";
                                      tyfield :: nil)
         |                           (debug_print "tyfields : nil";
                                      nil : A.field list)
tyfield : ID COLON ID   (debug_print "ID COLON ID";
                         {name = Symbol.symbol ID1,
                          escape = ref true,
                          typ = Symbol.symbol ID2,
                          pos = COLONleft})

(* variable declaration *)
vardec : VAR ID ASSIGN exp              (debug_print "VAR ID ASSIGN exp";
                                         A.VarDec {name= Symbol.symbol ID,
                                                   escape = ref true,
                                                   typ = NONE,
                                                   init = exp,
                                                   pos = ASSIGNleft})
      | VAR ID COLON ID ASSIGN exp     (debug_print "VAR ID : ID := exp";
                                         A.VarDec {name= Symbol.symbol ID1,
                                                   escape = ref true,
                                                   typ = SOME (Symbol.symbol ID2, ID2left),
                                                   init = exp,
                                                   pos = ASSIGNleft})

(* function declaration *)
(* this causes shift/reduce conflict. shift is chosen *)
fundecs : fundecs fundec        (let
                                    val _ = debug_print "fundecs fundec";
                                    val A.FunctionDec fundeclist = fundecs
                                in
                                    A.FunctionDec (fundec :: fundeclist)
                                end)
        | fundec                (debug_print "fundec";
                                 A.FunctionDec (fundec :: nil))

fundec : FUNCTION ID LPAREN tyfields RPAREN EQ exp              (
              debug_print "FUNCTION ID LPAREN tyfields RPAREN EQ exp";
             {name = Symbol.symbol ID,
              params = tyfields,
              result = NONE,
              body = exp,
              pos = EQleft})
       | FUNCTION ID LPAREN tyfields RPAREN COLON ID EQ exp     (
             debug_print "FUNCTION ID LPAREN tyfields RPAREN COLON ID EQ exp";
             {name = Symbol.symbol ID,
              params = tyfields,
              result = SOME (Symbol.symbol ID2, ID2left),
              body = exp,
              pos = EQleft})

(* lvalue *)
lvalue : ID (* %prec LVALUE *)          (debug_print "lvalue ID";
                                         A.SimpleVar (Symbol.symbol ID, IDleft))
       | lvalue DOT ID                  (debug_print "lvalue . ID";
                                         A.FieldVar (lvalue,
                                                     Symbol.symbol ID,
                                                     DOTleft))
       | lvalue LBRACK exp RBRACK       (debug_print "lvalue[exp]";
                                         A.SubscriptVar (lvalue, exp,
                                                         LBRACKleft))
       | id_bracket                     (
             let
                 val _ = debug_print "lvalue : id_bracket";
                 val (id, exp, pos) = id_bracket1;
             in
                 A.SubscriptVar (A.SimpleVar (id, id_bracket1left),
                                 exp,
                                 pos)
             end)

(* expression *)
exp : lvalue            (debug_print "lvalue";
                         A.VarExp lvalue)
    | NIL               (debug_print "NIL";
                            A.NilExp)
    | INT               (debug_print "INT";
                         A.IntExp INT)
    | STRING            (debug_print "STRING";
                         A.StringExp (STRING, STRINGleft))
    | BREAK             (debug_print "BREAK";
                         A.BreakExp BREAKleft)
    | if_then_stmt      (debug_print "if_then_stmt";
                         if_then_stmt)
    | if_then_else_stmt (debug_print "if_then_else_stmt";
                         if_then_else_stmt)
    | while_stmt        (debug_print "while_stmt";
                         while_stmt)
    | for_stmt          (debug_print "for_stmt";
                         for_stmt)
    | let_stmt          (debug_print "let_stmt";
                         let_stmt)
    | eseq              (debug_print "eseq";
                         eseq)
    | record_creation   (debug_print "record_creation";
                         record_creation)
    | array_creation    (debug_print "array_creation";
                         array_creation)
    | assign_stmt       (debug_print "assign_stmt";
                         assign_stmt)
    | funcall           (debug_print "funcall";
                         funcall)
    | arithmetic        (debug_print "arithmetic";
                         arithmetic)
    | comparison        (debug_print "comparison";
                         comparison1)
    | boolean_exp       (debug_print "boolean_exp";
                         boolean_exp)

(* flow control statement *)
(* this cuases shift/reduce conflict. shift is chosen *)
if_then_else_stmt : IF exp THEN exp ELSE exp    (debug_print " IF exp THEN exp ELSE exp";
                                                 A.IfExp {test = exp1,
                                                          then' = exp2,
                                                          else' = SOME exp3,
                                                          pos = THENleft})
(* this cause shift/reduce conflice due to dangling else. shift is chosen *)
if_then_stmt : IF exp THEN exp                  (debug_print "IF exp THEN exp";
                                                 A.IfExp {test = exp1,
                                                          then' = exp2,
                                                          else' = NONE,
                                                          pos = THENleft})
while_stmt : WHILE exp DO exp                   (debug_print "WHILE exp DO exp";
                                                 A.WhileExp {test = exp1,
                                                             body = exp2,
                                                             pos = DOleft})
for_stmt : FOR ID ASSIGN exp TO exp DO exp      (
          debug_print "FOR ID ASSIGN exp TO exp DO exp";
          A.ForExp {var = Symbol.symbol ID,
                    escape = ref true,
                    lo = exp1,
                    hi = exp2,
                    body = exp3,
                    pos = ASSIGNleft})
let_stmt : LET decs IN eseqlist END             (
          debug_print "LET decs IN eseqlist END";
          A.LetExp {decs = decs,
                    body = A.SeqExp eseqlist,
                    pos = INleft})

(* expression sequence and paren *)
eseq : LPAREN eseqlist RPAREN           (debug_print "LPAREN eseqlist RPAREN";
                                         A.SeqExp eseqlist)
eseqlist : eseqlist SEMICOLON exp       (debug_print "eseqlist SEMICOLON exp";
                                         (exp, expleft) :: eseqlist)
         | exp                          (debug_print "eseqlist: exp";
                                         (exp, expleft) :: nil)
         |                              (debug_print "eseqlist: nil";
                                         nil : (A.exp * A.pos) list)

(* funcall *)
funcall : ID LPAREN args RPAREN         (debug_print "ID LPAREN args RPAREN";
                                         A.CallExp {func = Symbol.symbol ID,
                                                    args = args,
                                                    pos = IDleft})
args : args COMMA exp   (debug_print "args COMMA exp";
                         exp :: args)
     | exp              (debug_print "args: exp";
                         exp :: nil)
     |                  (debug_print "args: nil";
                         nil : A.exp list)

(* arithmetic expression *)
arithmetic : exp PLUS exp               (debug_print "exp PLUS exp";
                                         A.OpExp {left = exp1,
                                                  oper = A.PlusOp,
                                                  right = exp2,
                                                  pos = PLUSleft})
           | exp MINUS exp              (debug_print "exp MINUS exp";
                                         A.OpExp {left = exp1,
                                                  oper = A.MinusOp,
                                                  right = exp2,
                                                  pos = MINUS1left})
           | exp TIMES exp              (debug_print "exp TIMES exp";
                                         A.OpExp {left = exp1,
                                                  oper = A.TimesOp,
                                                  right = exp2,
                                                  pos = TIMESleft})
           | exp DIVIDE exp             (debug_print "exp DIVIDE exp";
                                         A.OpExp {left = exp1,
                                                  oper = A.DivideOp,
                                                  right = exp2,
                                                  pos = DIVIDEleft})
           | MINUS exp %prec UMINUS     (debug_print "UMINUS exp";
                                         A.OpExp {left = A.IntExp 0,
                                                  oper = A.MinusOp,
                                                  right = exp1,
                                                  pos = MINUS1left})

(* comparison *)
comparison : exp EQ exp         (debug_print "exp EQ exp";
                                 A.OpExp {left = exp1,
                                          oper = A.EqOp,
                                          right = exp2,
                                          pos = EQ1left})
           | exp NEQ exp        (debug_print "exp NEQ exp";
                                 A.OpExp {left = exp1,
                                          oper = A.NeqOp,
                                          right = exp2,
                                          pos = NEQleft})
           | exp LT exp         (debug_print "exp LT exp";
                                 A.OpExp {left = exp1,
                                          oper = A.LtOp,
                                          right = exp2,
                                          pos = LTleft})
           | exp LE exp         (debug_print "exp LE exp";
                                 A.OpExp {left = exp1,
                                          oper = A.LeOp,
                                          right = exp2,
                                          pos = LEleft})
           | exp GT exp         (debug_print "exp GT exp";
                                 A.OpExp {left = exp1,
                                          oper = A.GtOp,
                                          right = exp2,
                                          pos = GTleft})
           | exp GE exp         (debug_print "exp GE exp";
                                 A.OpExp {left = exp1,
                                          oper = A.GeOp,
                                          right = exp2,
                                          pos = GEleft})

(* boolean expression *)
boolean_exp : exp AND exp       (debug_print "exp AND exp";
                                 A.IfExp {test = exp1,
                                          then' = exp2,
                                          else' = SOME (A.IntExp 0),
                                          pos = ANDleft})
            | exp OR exp        (debug_print "exp OR exp";
                                 A.IfExp {test = exp1,
                                          then' = A.IntExp 1,
                                          else' = SOME exp2,
                                          pos = ORleft})

(* record creation *)
record_creation : ID LBRACE record_fields RBRACE        (
                  debug_print "ID LBRACE record_fields RBRACE";
                  A.RecordExp {fields = record_fields,
                               typ = Symbol.symbol ID,
                               pos = IDleft})
record_fields : record_fields COMMA record_field        (
                  debug_print "record_fields COMMA record_field";
                  record_field :: record_fields)
            | record_field      (
                  debug_print "record_fields : record_field";
                  record_field :: nil)
            |                   (
                  debug_print "record_fields : nil";
                  nil : (A.symbol * A.exp * A.pos) list)
record_field : ID EQ exp        (debug_print "record_field : ID EQ exp";
                                 (Symbol.symbol ID, exp, EQleft))

id_bracket : ID LBRACK exp RBRACK       ((Symbol.symbol ID, exp, LBRACKleft))

(* array creation *)
(* this causes shift/reduce conflict. shift is chosen *)
array_creation : id_bracket OF exp (
                 let
                     val _ = debug_print "ID LBRACK exp RBRACK OF exp";
                     val (id0, exp0, pos0) = id_bracket;
                 in
                     A.ArrayExp {typ = id0,
                                 size = exp0,
                                 init = exp1,
                                 pos = OFleft}
                 end)

(* asssignement *)
assign_stmt : lvalue ASSIGN exp (debug_print "lvalue ASSIGN exp";
                                 A.AssignExp {var = lvalue,
                                              exp = exp,
                                              pos = ASSIGNleft})

chapter 3プログラミング演習を適当に済ませていた分,間違いが発覚して修正する羽目になった. SML/NJにdebuggerが無いのね.使いたかったら他の処理系を使うしかない.ML-lex, ML-yaccにも途中の処理のlog吐き出しもない.lexの記述がおかしくてtoken切り出しがが怪しいかもと疑ったのだで,debug printを追加した.ML-lexのoptionか何かでlog出力とかあってもおかしくないのに.minor言語ゆえにしょうがないのか.明日からはchapter 5.

この記事が気に入ったらサポートをしてみませんか?