tiger/src/lib/tiger/tiger_parser.mly

   1 %{
   2   module Ast = Tiger_absyn
   3   module Sym = Tiger_symbol
   4
   5   let pos () =
   6     Tiger_position.of_lexing_positions
   7       ~pos_start:(Parsing.symbol_start_pos ())
   8       ~pos_end:(Parsing.symbol_end_pos ())
   9 %}
  10
  11 /* Declarations */
  12 %token AND
  13 %token ARRAY
  14 %token ASSIGN
  15 %token BREAK
  16 %token COLON
  17 %token COMMA
  18 %token DIVIDE
  19 %token DO
  20 %token DOT
  21 %token ELSE
  22 %token END
  23 %token EOF
  24 %token EQ
  25 %token FOR
  26 %token FUNCTION
  27 %token GE
  28 %token GT
  29 %token <string> ID
  30 %token IF
  31 %token IN
  32 %token <int> INT
  33 %token LBRACE
  34 %token LBRACK
  35 %token LE
  36 %token LET
  37 %token LPAREN
  38 %token LT
  39 %token MINUS
  40 %token NEQ
  41 %token NIL
  42 %token OF
  43 %token OR
  44 %token PLUS
  45 %token RBRACE
  46 %token RBRACK
  47 %token RPAREN
  48 %token SEMICOLON
  49 %token <string> STRING
  50 %token THEN
  51 %token TIMES
  52 %token TO
  53 %token TYPE
  54 %token VAR
  55 %token WHILE
  56
  57 /* from lowest precedence */
  58 %nonassoc LOWEST
  59 %nonassoc THEN
  60 %nonassoc ELSE
  61 %nonassoc ASSIGN
  62 %nonassoc OF DO
  63 %left OR
  64 %left AND
  65 %nonassoc EQ NEQ GT LT GE LE
  66 %left PLUS MINUS
  67 %left TIMES DIVIDE
  68 %nonassoc HIGHEST
  69 /* to highest precedence */
  70
  71 %type <Tiger_absyn.t> program
  72
  73 %start program
  74
  75 %%
  76
  77 program: exp EOF { $1 };
  78
  79 exp:
  80   | NIL
  81     { Ast.NilExp }
  82   | INT
  83     { Ast.IntExp $1 }
  84   | MINUS exp %prec HIGHEST
  85     {
  86       Ast.OpExp
  87         { left  = Ast.IntExp 0
  88         ; oper  = Ast.MinusOp
  89         ; right = $2
  90         ; pos   = pos ()
  91         }
  92     }
  93   | lvalue LBRACK exp RBRACK OF exp
  94     {
  95       match $1 with
  96       | Ast.SimpleVar {symbol=typ; _} ->
  97           Ast.ArrayExp
  98             { typ
  99             ; size = $3
 100             ; init = $6
 101             ; pos  = pos ()
 102             }
 103       | Ast.SubscriptVar _ | Ast.FieldVar _ ->
 104           raise Parse_error
 105     }
 106   | ID LBRACE rec_fields_bind RBRACE
 107     {
 108       let type_id = $1 in
 109       let fields  = $3 in
 110       let typ     = Sym.of_string type_id in
 111       let pos     = pos () in
 112       Ast.RecordExp {fields; typ; pos}
 113     }
 114   | lvalue
 115     { Ast.VarExp $1 }
 116   | lvalue ASSIGN exp
 117     {
 118       let var = $1 in
 119       let exp = $3 in
 120       let pos = pos () in
 121       Ast.AssignExp {var; exp; pos}
 122     }
 123   | STRING
 124     { Ast.StringExp {string = $1; pos = pos ()} }
 125   | ID LPAREN fun_args RPAREN
 126     {
 127       Ast.CallExp
 128         { func = Sym.of_string $1
 129         ; args = $3
 130         ; pos  = pos ()
 131         }
 132     }
 133   | exp PLUS exp
 134     {
 135       Ast.OpExp
 136         { left  = $1
 137         ; oper  = Ast.PlusOp
 138         ; right = $3
 139         ; pos   = pos ()
 140         }
 141     }
 142   | exp MINUS exp
 143     {
 144       Ast.OpExp
 145         { left  = $1
 146         ; oper  = Ast.MinusOp
 147         ; right = $3
 148         ; pos   = pos ()
 149         }
 150     }
 151   | exp TIMES exp
 152     {
 153       Ast.OpExp
 154         { left  = $1
 155         ; oper  = Ast.TimesOp
 156         ; right = $3
 157         ; pos   = pos ()
 158         }
 159     }
 160   | exp DIVIDE exp
 161     {
 162       Ast.OpExp
 163         { left  = $1
 164         ; oper  = Ast.DivideOp
 165         ; right = $3
 166         ; pos   = pos ()
 167         }
 168     }
 169   | exp EQ exp
 170     {
 171       Ast.OpExp
 172         { left  = $1
 173         ; oper  = Ast.EqOp
 174         ; right = $3
 175         ; pos   = pos ()
 176         }
 177     }
 178   | exp NEQ exp
 179     {
 180       Ast.OpExp
 181         { left  = $1
 182         ; oper  = Ast.NeqOp
 183         ; right = $3
 184         ; pos   = pos ()
 185         }
 186     }
 187   | exp GT exp
 188     {
 189       Ast.OpExp
 190         { left  = $1
 191         ; oper  = Ast.GtOp
 192         ; right = $3
 193         ; pos   = pos ()
 194         }
 195     }
 196   | exp LT exp
 197     {
 198       Ast.OpExp
 199         { left  = $1
 200         ; oper  = Ast.LtOp
 201         ; right = $3
 202         ; pos   = pos ()
 203         }
 204     }
 205   | exp GE exp
 206     {
 207       Ast.OpExp
 208         { left  = $1
 209         ; oper  = Ast.GeOp
 210         ; right = $3
 211         ; pos   = pos ()
 212         }
 213     }
 214   | exp LE exp
 215     {
 216       Ast.OpExp
 217         { left  = $1
 218         ; oper  = Ast.LeOp
 219         ; right = $3
 220         ; pos   = pos ()
 221         }
 222     }
 223   | exp AND exp
 224     {
 225       let e1 = $1 in
 226       let e2 = $3 in
 227       Ast.IfExp
 228         { test  = e1
 229         ; then' = e2
 230         ; else' = Some (Ast.IntExp 0)
 231         ; pos   = pos ()
 232         }
 233     }
 234   | exp OR exp
 235     {
 236       let e1 = $1 in
 237       let e2 = $3 in
 238       Ast.IfExp
 239         { test  = e1
 240         ; then' = Ast.IntExp 1
 241         ; else' = Some e2
 242         ; pos   = pos ()
 243         }
 244     }
 245   | IF exp THEN exp ELSE exp
 246     {
 247       let e1 = $2 in
 248       let e2 = $4 in
 249       let e3 = $6 in
 250       Ast.IfExp
 251         { test  = e1
 252         ; then' = e2
 253         ; else' = Some e3
 254         ; pos   = pos ()
 255         }
 256     }
 257   | IF exp THEN exp
 258     {
 259       let e1 = $2 in
 260       let e2 = $4 in
 261       Ast.IfExp
 262         { test  = e1
 263         ; then' = e2
 264         ; else' = None
 265         ; pos   = pos ()
 266         }
 267     }
 268   | WHILE exp DO exp
 269     {
 270       let e1 = $2 in
 271       let e2 = $4 in
 272       Ast.WhileExp
 273         { test = e1
 274         ; body = e2
 275         ; pos  = pos ()
 276         }
 277     }
 278   | FOR ID ASSIGN exp TO exp DO exp
 279     {
 280       let var = $2 in
 281       let e1  = $4 in
 282       let e2  = $6 in
 283       let e3  = $8 in
 284       Ast.ForExp
 285         { var    = Sym.of_string var
 286         ; escape = ref true
 287         ; lo     = e1
 288         ; hi     = e2
 289         ; body   = e3
 290         ; pos    = pos ()
 291         }
 292     }
 293   | BREAK
 294     { Ast.BreakExp (pos ()) }
 295   | LPAREN exps RPAREN
 296     { Ast.SeqExp $2 }
 297   | LET decs IN exps END
 298     {
 299       let decs = $2 in
 300       let exps = $4 in
 301       Ast.LetExp {decs; body = Ast.SeqExp exps; pos = pos ()}
 302     }
 303   ;
 304
 305 exps:
 306   |                    {                 [] }
 307   | exp                { ($1, pos ()) :: [] }
 308   | exp SEMICOLON exps { ($1, pos ()) :: $3 }
 309   ;
 310
 311 rec_fields_bind:
 312   | ID EQ exp                       { (Sym.of_string $1, $3, pos ()) :: [] }
 313   | ID EQ exp COMMA rec_fields_bind { (Sym.of_string $1, $3, pos ()) :: $5 }
 314   ;
 315
 316 decs:
 317   | dec      { $1 :: [] }
 318   | dec decs { $1 :: $2 }
 319   ;
 320
 321 dec:
 322   | var_dec                { $1 }
 323   | typ_decs  %prec LOWEST { Ast.TypeDecs $1 }
 324   | fun_decs  %prec LOWEST { Ast.FunDecs $1 }
 325   ;
 326
 327 typ_decs:
 328   | typ_dec                        { $1 :: [] }
 329   | typ_dec typ_decs %prec LOWEST  { $1 :: $2 }
 330   ;
 331
 332 typ_dec:
 333   | TYPE ID EQ ID
 334     {
 335       let type_id_left = $2 in
 336       let type_id_right = $4 in
 337       let pos = pos () in  (* FIXME: rhs id should have its own pos, no? *)
 338       Ast.TypeDec
 339         { name = Sym.of_string type_id_left
 340         ; ty   = Ast.NameTy {symbol = Sym.of_string type_id_right; pos}
 341         ; pos
 342         }
 343     }
 344   | TYPE ID EQ LBRACE type_fields RBRACE
 345     {
 346       let type_id = $2 in
 347       let type_fields = $5 in
 348       Ast.TypeDec
 349         { name = Sym.of_string type_id
 350         ; ty   = Ast.RecordTy type_fields
 351         ; pos  = pos ()
 352         }
 353     }
 354   | TYPE ID EQ ARRAY OF ID
 355     {
 356       let type_id         = Sym.of_string $2 in
 357       let element_type_id = Sym.of_string $6 in
 358       let pos = pos () in
 359       Ast.TypeDec
 360         { name = type_id
 361         ; ty   = Ast.ArrayTy {symbol = element_type_id; pos}
 362         ; pos
 363         }
 364     }
 365   ;
 366
 367 var_dec:
 368   | VAR ID maybe_type_sig ASSIGN exp
 369     {
 370       let var_id = Sym.of_string $2 in
 371       let maybe_type_sig = $3 in
 372       let exp = $5 in
 373       let pos = pos () in
 374       Ast.VarDec
 375         { name   = var_id
 376         ; escape = ref true
 377         ; typ    = maybe_type_sig
 378         ; init   = exp
 379         ; pos
 380         }
 381     }
 382   ;
 383
 384 fun_decs:
 385   | fun_dec                       { $1 :: [] }
 386   | fun_dec fun_decs %prec LOWEST { $1 :: $2 }
 387   ;
 388
 389 fun_dec:
 390   | FUNCTION ID LPAREN type_fields RPAREN maybe_type_sig EQ exp
 391     {
 392       let name   = Sym.of_string $2 in
 393       let params = $4 in
 394       let result = $6 in
 395       let body   = $8 in
 396       let pos    = pos () in
 397       Ast.FunDec {name; params; result; body; pos}
 398     }
 399   ;
 400
 401 maybe_type_sig:
 402   |          { None }
 403   | COLON ID { Some (Sym.of_string $2, pos ()) }
 404   ;
 405
 406 type_fields:
 407   |
 408     { [] }
 409   | ID COLON ID
 410     {
 411       let field =
 412         Ast.Field
 413           { name   = Sym.of_string $1
 414           ; escape = ref true
 415           ; typ    = Sym.of_string $3
 416           ; pos    = pos ()
 417           }
 418       in
 419       field :: []
 420     }
 421   | ID COLON ID COMMA type_fields
 422     {
 423       let field =
 424         Ast.Field
 425           { name   = Sym.of_string $1
 426           ; escape = ref true
 427           ; typ    = Sym.of_string $3
 428           ; pos    = pos ()
 429           }
 430       in
 431       field :: $5
 432     }
 433   ;
 434
 435 fun_args:
 436   |                    {       [] }
 437   | exp                { $1 :: [] }
 438   | exp COMMA fun_args { $1 :: $3 }
 439   ;
 440
 441 lvalue:
 442   | ID
 443     {
 444       Ast.SimpleVar
 445         { symbol = Sym.of_string $1
 446         ; pos    = pos ()
 447         }
 448     }
 449   | lvalue LBRACK exp RBRACK
 450     {
 451       Ast.SubscriptVar
 452         { var = $1
 453         ; exp = $3
 454         ; pos = pos ()
 455         }
 456     }
 457   | lvalue DOT ID
 458     {
 459       Ast.FieldVar
 460         { var    = $1
 461         ; symbol = Sym.of_string $3
 462         ; pos    = pos ()
 463         }
 464     }
 465   ;
 466
 467 %%