Top > TigerBook > PROGRAM4
Counter: 2489, today: 2, yesterday: 0

Chapter 4 の PROGRAM

ここで chapter 2, 3 でやった program の間違いがボロボロ発覚する。

PROGRAM

tiger.lex 修正後

type svalue = Tokens.svalue (* append *)
type pos = int
type ('a, 'b) token = ('a, 'b) Tokens.token (* append *)
type lexresult = (svalue, pos) Tokens.token  (* modified *)

val lineNum = ErrorMsg.lineNum
val linePos = ErrorMsg.linePos
fun err(p1,p2) = ErrorMsg.error p1
val strTerm = ref ""
val currState = ref 0
val commentLv = ref 0
fun eof() = let val pos = hd(!linePos)
     in if !currState > 0
        then ErrorMsg.error pos ("String or Comment not concluded.")
        else (); Tokens.EOF(pos,pos)
     end
%%
%header (functor TigerLexFun(structure Tokens: Tiger_TOKENS));
%s COMMENT STRINGS IGNORES;
%%
<INITIAL>type     => (Tokens.TYPE(yypos,yypos+4));
<INITIAL>var      => (Tokens.VAR(yypos,yypos+3));
<INITIAL>function => (Tokens.FUNCTION(yypos,yypos+8));
<INITIAL>break    => (Tokens.BREAK(yypos,yypos+5));
<INITIAL>of       => (Tokens.OF(yypos,yypos+2));
<INITIAL>end      => (Tokens.END(yypos,yypos+3));
<INITIAL>in       => (Tokens.IN(yypos,yypos+2));
<INITIAL>nil      => (Tokens.NIL(yypos,yypos+3));
<INITIAL>let      => (Tokens.LET(yypos,yypos+3));
<INITIAL>do       => (Tokens.DO(yypos,yypos+2));
<INITIAL>to       => (Tokens.TO(yypos,yypos+2));
<INITIAL>for      => (Tokens.FOR(yypos,yypos+3));
<INITIAL>while    => (Tokens.WHILE(yypos,yypos+5));
<INITIAL>if       => (Tokens.IF(yypos,yypos+2));
<INITIAL>then     => (Tokens.THEN(yypos,yypos+4));
<INITIAL>else     => (Tokens.ELSE(yypos,yypos+4));
<INITIAL>array    => (Tokens.ARRAY(yypos,yypos+5));

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

<INITIAL>"/*"     => (commentLv := 1;currState := 1; YYBEGIN COMMENT; continue());
<INITIAL>\"       => (currState := 2; strTerm := ""; YYBEGIN STRINGS; continue());
<INITIAL>[0-9]+   => (Tokens.INT(valOf(Int.fromString yytext),yypos,yypos+size yytext));
<INITIAL>[A-Za-z][A-Za-z0-9_]*   => (Tokens.ID(yytext,yypos,yypos+size yytext));
<INITIAL>[" "\t]  => (continue());
<INITIAL>\n       => (lineNum := !lineNum+1; linePos := yypos :: !linePos; continue());
<INITIAL>.       => (ErrorMsg.error yypos ("illegal character " ^ yytext); continue());

<COMMENT>"/*"    => (commentLv := !commentLv + 1; continue());
<COMMENT>"*/"    => (currState := 0; commentLv := !commentLv - 1;
                    (if !commentLv = 0 then YYBEGIN INITIAL else ()); continue() );
<COMMENT>\n      => (lineNum := !lineNum+1; linePos := yypos :: !linePos; continue());
<COMMENT>.       => (continue());

<STRINGS>\"      => (currState := 0; YYBEGIN INITIAL; Tokens.STRING(!strTerm,0,0));
<STRINGS>\\\"    => (strTerm := !strTerm ^ "\"" ; continue());
<STRINGS>\\n     => (strTerm := !strTerm ^ "\n" ; continue());
<STRINGS>\\t     => (strTerm := !strTerm ^ "\t" ; continue());
<STRINGS>\\\^[@A-Z\[\\\]^_]
                => (strTerm := !strTerm ^ (str(chr(ord (String.sub (yytext,2)) - 64)));
                    continue()) ;
<STRINGS>\\\^[a-z]
                => (strTerm := !strTerm ^ (str(chr(ord (String.sub (yytext,2)) - 96)));
                    continue()) ;
<STRINGS>\\[0-9][0-9][0-9]
                => (strTerm := !strTerm ^ (str(chr(valOf(Int.fromString(substring (yytext,1,3))))));
                                 continue());
<STRINGS>"\\"    => (strTerm := !strTerm ^ "\\" ; continue());
<STRINGS>\\      => (YYBEGIN IGNORES; continue());
<STRINGS>\\.     => (ErrorMsg.error yypos ("illegal character " ^ yytext); continue());
<STRINGS>\n      => (lineNum := !lineNum+1; linePos := yypos :: !linePos;
                     strTerm := !strTerm ^ yytext; continue());
<STRINGS>.       => (strTerm := !strTerm ^ yytext; continue());

<IGNORES>\\      => (YYBEGIN STRINGS; continue() );
<IGNORES>\n      => (lineNum := !lineNum+1; linePos := yypos :: !linePos; continue());
<IGNORES>.       => ( continue() );

tiger.grm

structure A = Absyn
%%
%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 | 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
  | UNARYMINUS
%nonterm  exp of A.exp
        | program of A.exp
        | lvalue of A.var
        | novalue of A.exp
        | sequensing of A.exp
        | expsemilist of (A.exp * A.pos) list
        | functionCall of A.exp
        | explistopt of A.exp list
        | explist of A.exp list
        | opExpr of A.exp
        | recordCreate of A.exp
        | typeid of A.symbol
        | idExpList of (A.symbol * A.exp * A.pos) list
        | recField of (A.symbol * A.exp * A.pos)
        | arrayCreate of A.exp
        | assignment of A.exp
        | ifThenElse of A.exp
        | ifThen of A.exp
        | whileClause  of A.exp
        | forClause of A.exp
        | letexp of A.exp
        | expseq of (A.exp * A.pos) list
        | parentheses of A.exp
        | decs of A.dec list
        | dec of A.dec
        | tydec of A.dec
        | ty of A.ty
        | tyfields of A.field list
        | tyfieldlist of A.field list
        | tyfield of A.field
        | vardec of A.dec
        | fundec of A.fundec
        | fundeclist of A.fundec list
(*	| valuelessExp | stringCmp | precedenceOp | associativityOp
       | arrRecAssign | extent *)
%pos int
%verbose
%start program
%eop EOF
%noshift EOF
%name Tiger
%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 ("")
%nonassoc ASSIGN
%left DO THEN OF
%left ELSE
%left OR
%left AND
%nonassoc EQ NEQ LT LE GT GE
%left PLUS MINUS
%left TIMES DIVIDE
%left UNARYMINUS

%%

program : exp        (exp)
(***** Expressions *****)
exp: lvalue          (A.VarExp lvalue)
   | ID              (A.VarExp (A.SimpleVar (Symbol.symbol ID, IDleft)))
   | novalue         (novalue)
   | NIL             (A.NilExp)
   | sequensing      (sequensing)
   | INT             (A.IntExp INT)
   | STRING          (A.StringExp (STRING, STRINGleft))
   | functionCall    (functionCall)
   | opExpr          (opExpr)
   | recordCreate    (recordCreate)
   | arrayCreate     (arrayCreate)
   | assignment      (assignment)
   | ifThenElse      (ifThenElse)
   | ifThen          (ifThen)
   | whileClause     (whileClause)
   | forClause       (forClause)
   | BREAK           (A.BreakExp BREAKleft)
   | letexp          (letexp)
   | parentheses     (parentheses)

lvalue :  ID DOT ID          (A.FieldVar  (A.SimpleVar(Symbol.symbol ID1, ID1left), Symbol.symbol ID2, ID2left))
       | ID LBRACK exp RBRACK (A.SubscriptVar (A.SimpleVar(Symbol.symbol ID, IDleft), exp, IDleft))
       | lvalue DOT ID            (A.FieldVar  (lvalue, Symbol.symbol ID, IDleft)) (*fix*)
       | lvalue LBRACK exp RBRACK (A.SubscriptVar (lvalue, exp, lvalueleft))

novalue : LPAREN RPAREN (A.SeqExp [])

sequensing     : LPAREN expsemilist RPAREN (A.SeqExp expsemilist)

expsemilist : expsemilist SEMICOLON exp (expsemilist @ [(exp, expleft)])
            | exp SEMICOLON exp   ((exp1,exp1left) :: [(exp2, exp2left)])  (* Excl. Parentheses *)

functionCall : ID LPAREN explistopt RPAREN (A.CallExp {func=Symbol.symbol ID, args=explistopt, pos=IDleft})
explistopt : explist (explist)
           |         ([])  (* empty *)
explist    : explist COMMA exp (explist @ [exp])
           | exp               ([exp])

opExpr  : exp DIVIDE exp (A.OpExp {left=exp1,oper=A.DivideOp,right=exp2,pos=DIVIDEleft})
        | exp TIMES exp  (A.OpExp {left=exp1,oper=A.TimesOp ,right=exp2,pos=TIMESleft})
        | exp MINUS exp  (A.OpExp {left=exp1,oper=A.MinusOp ,right=exp2,pos=MINUSleft})
        | exp PLUS  exp  (A.OpExp {left=exp1,oper=A.PlusOp  ,right=exp2,pos=PLUSleft})
        | exp EQ  exp (A.OpExp {left=exp1, oper=A.EqOp,  right=exp2, pos=EQleft})
        | exp NEQ exp (A.OpExp {left=exp1, oper=A.NeqOp, right=exp2, pos=NEQleft})
        | exp GE  exp (A.OpExp {left=exp1, oper=A.GeOp,  right=exp2, pos=GEleft})
        | exp GT  exp (A.OpExp {left=exp1, oper=A.GtOp,  right=exp2, pos=GTleft})
        | exp LE  exp (A.OpExp {left=exp1, oper=A.LeOp,  right=exp2, pos=LEleft})
        | exp LT  exp (A.OpExp {left=exp1, oper=A.LtOp,  right=exp2, pos=LTleft})
        | 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})
        | MINUS exp %prec UNARYMINUS (A.OpExp {left=A.IntExp 0, oper=A.MinusOp,  right=exp1, pos=MINUSleft})

recordCreate   : ID LBRACE idExpList RBRACE
                 (A.RecordExp {fields=idExpList, typ=Symbol.symbol ID, pos=IDleft}) (* typeid *)
               | ID LBRACE RBRACE (A.RecordExp {fields=[], typ=Symbol.symbol ID, pos=IDleft}) (* empty record*)
typeid : ID (Symbol.symbol ID)
idExpList : recField ([recField])
          | idExpList COMMA recField ( idExpList @ [recField]) (* Correct! *)
recField : ID EQ exp ((Symbol.symbol ID, exp, IDleft))

arrayCreate    : ID LBRACK exp RBRACK OF exp
                 (A.ArrayExp {typ=Symbol.symbol ID, size=exp1, init=exp2, pos=IDleft})
assignment     : lvalue ASSIGN exp
                (A.AssignExp {var=lvalue, exp=exp, pos=ASSIGNleft})
               | ID ASSIGN exp
               (A.AssignExp {var=(A.SimpleVar(Symbol.symbol ID, IDleft)), exp=exp, pos=ASSIGNleft})
ifThen         : IF exp THEN exp
                (A.IfExp {test=exp1, then'=exp2, pos=IFleft, else'=NONE})
ifThenElse     : IF exp THEN exp ELSE exp
                (A.IfExp {test=exp1, then'=exp2, else'=SOME exp3, pos=IFleft})
whileClause    : WHILE exp DO exp
                (A.WhileExp {test=exp1, body=exp2, pos=WHILEleft})
forClause      : FOR ID ASSIGN exp TO exp DO exp
                (A.ForExp {var=Symbol.symbol ID, lo=exp1,hi=exp2, body=exp3, escape=ref true, pos=FORleft})
letexp         : LET decs IN expseq END
                (A.LetExp {decs=decs, body=A.SeqExp expseq, pos=LETleft})
expseq : expsemilist (expsemilist)
       | exp         ([(exp,expleft)])
       |             ([(A.SeqExp [],defaultPos)])  (* novalue *)
parentheses    : LPAREN exp RPAREN        (exp)

(***** Declaration *****)
decs :               ([]) (* empty *)
     |  decs dec     (decs @ [dec])
dec : tydec  (tydec)
    | vardec (vardec)
    | fundeclist (A.FunctionDec fundeclist)

tydec : TYPE typeid EQ ty (A.TypeDec [{name=typeid, ty=ty, pos=TYPEleft}])
ty : typeid                 (A.NameTy (typeid, typeidleft))
   | LBRACE tyfields RBRACE (A.RecordTy tyfields)
   | ARRAY OF typeid        (A.ArrayTy (typeid, typeidleft))
tyfields : ([])  (* empty *)
         | tyfieldlist                  (tyfieldlist)
tyfieldlist : tyfieldlist COMMA tyfield (tyfieldlist @ [tyfield])
            | tyfield                   ([tyfield])
tyfield : ID COLON typeid
          ({name=Symbol.symbol ID, typ=typeid, escape=ref true, pos=IDleft})

vardec : VAR ID ASSIGN exp
         (A.VarDec {name=Symbol.symbol ID, typ=NONE, init=exp, escape=ref true, pos=VARleft})
       | VAR ID COLON typeid ASSIGN exp
         (A.VarDec {name=Symbol.symbol ID, typ=SOME (typeid,typeidleft), init=exp, escape=ref true, pos=VARleft})

fundeclist : fundec            ([fundec])
           | fundeclist fundec (fundeclist @ [fundec])
fundec : FUNCTION ID LPAREN tyfields RPAREN EQ exp
        ({name=Symbol.symbol ID, params=tyfields, result=NONE, body=exp, pos=FUNCTIONleft})
       | FUNCTION ID LPAREN tyfields RPAREN COLON typeid EQ exp
        ({name=Symbol.symbol ID, params=tyfields, result=SOME (typeid,typeidleft), body=exp, pos=FUNCTIONleft})

Reload   New Lower page making Edit Freeze Diff Upload Copy Rename   Front page List of pages Search Recent changes Backup Referer   Help   RSS of recent changes
Last-modified: (4850d)