ソースを参照

Added location attribute to all node definitions & matches

Taddeus Kroes 12 年 前
コミット
50cc633821
6 ファイル変更203 行追加157 行削除
  1. 33 29
      ast.ml
  2. 42 39
      parser.cpp.mly
  3. 22 20
      phases/desug.ml
  4. 29 29
      stringify.ml
  5. 71 40
      util.ml
  6. 6 0
      util.mli

+ 33 - 29
ast.ml

@@ -1,4 +1,5 @@
 type loc = string * int * int * int * int
 type loc = string * int * int * int * int
+let noloc = ("", 0, 0, 0, 0)
 
 
 type monop = Neg | Not
 type monop = Neg | Not
 type binop = Add | Sub | Mul | Div | Mod
 type binop = Add | Sub | Mul | Div | Mod
@@ -10,38 +11,38 @@ type ctype = Void | Bool | Int | Float
 and node =
 and node =
     (* global *)
     (* global *)
     | Program of node list * loc
     | Program of node list * loc
-    | Param of ctype * string
-    | FunDec of ctype * string * node list
-    | FunDef of bool * ctype * string * node list * node list
-    | GlobalDec of ctype * string
-    | GlobalDef of bool * ctype * string * node option
+    | Param of ctype * string * loc
+    | FunDec of ctype * string * node list * loc
+    | FunDef of bool * ctype * string * node list * node list * loc
+    | GlobalDec of ctype * string * loc
+    | GlobalDef of bool * ctype * string * node option * loc
 
 
     (* statements *)
     (* statements *)
-    | VarDec of ctype * string * node option
-    | Assign of string * node
-    | Return of node
-    | If of node * node list
-    | IfElse of node * node list * node list
-    | While of node * node list
-    | DoWhile of node * node list
-    | For of string * node * node * node * node list
-    | Allocate of string * node list
+    | VarDec of ctype * string * node option * loc
+    | Assign of string * node * loc
+    | Return of node * loc
+    | If of node * node list * loc
+    | IfElse of node * node list * node list * loc
+    | While of node * node list * loc
+    | DoWhile of node * node list * loc
+    | For of string * node * node * node * node list * loc
+    | Allocate of string * node list * loc
     | Expr of node
     | Expr of node
-    | Statements of node list
+    | Statements of node list * loc
 
 
     (* expressions *)
     (* expressions *)
-    | BoolConst of bool
-    | IntConst of int
-    | FloatConst of float
-    | ArrayConst of node list
-    | ArrayScalar of node
-    | Var of string
-    | Deref of string * node list
-    | Monop of monop * node
-    | Binop of binop * node * node
-    | Cond of node * node * node
-    | TypeCast of ctype * node
-    | FunCall of string * node list
+    | BoolConst of bool * loc
+    | IntConst of int * loc
+    | FloatConst of float * loc
+    | ArrayConst of node list * loc
+    | ArrayScalar of node * loc
+    | Var of string * loc
+    | Deref of string * node list * loc
+    | Monop of monop * node * loc
+    | Binop of binop * node * node * loc
+    | Cond of node * node * node * loc
+    | TypeCast of ctype * node * loc
+    | FunCall of string * node list * loc
 
 
 (* intermediate representations between phases *)
 (* intermediate representations between phases *)
 type repr =
 type repr =
@@ -75,19 +76,22 @@ exception CompileError of string
  *     | While (cond, body, loc) ->
  *     | While (cond, body, loc) ->
  *     | DoWhile (cond, body, loc) ->
  *     | DoWhile (cond, body, loc) ->
  *     | For (counter, start, stop, step, body, loc) ->
  *     | For (counter, start, stop, step, body, loc) ->
- *     | Expr (value, loc) ->
+ *     | Expr (value) ->
  *
  *
  *     | BoolConst (value, loc) ->
  *     | BoolConst (value, loc) ->
  *     | IntConst (value, loc) ->
  *     | IntConst (value, loc) ->
  *     | FloatConst (value, loc) ->
  *     | FloatConst (value, loc) ->
+ *     | ArrayConst (dims, loc) ->
+ *     | ArrayScalar (value, loc) ->
  *     | Var (name, loc) ->
  *     | Var (name, loc) ->
+ *     | Deref (name, dims, loc) ->
  *     | Monop (op, value, loc) ->
  *     | Monop (op, value, loc) ->
  *     | Binop (op, left, right, loc) ->
  *     | Binop (op, left, right, loc) ->
  *     | Cond (cond, true_expr, false_expr, loc) ->
  *     | Cond (cond, true_expr, false_expr, loc) ->
  *     | TypeCast (ctype, value, loc) ->
  *     | TypeCast (ctype, value, loc) ->
  *     | FunCall (name, args, loc) ->
  *     | FunCall (name, args, loc) ->
  *
  *
- *     | Statements (stats, loc) ->
+ *     | Statements (stats) ->
  *
  *
  *     | node -> transform visit node
  *     | node -> transform visit node
  *
  *

+ 42 - 39
parser.cpp.mly

@@ -48,84 +48,87 @@ program : decl*; EOF
           { Program ($1, LOC) }
           { Program ($1, LOC) }
 
 
 decl : EXTERN; fun_header; SEMICOL
 decl : EXTERN; fun_header; SEMICOL
-       { let (t, n, p) = $2 in FunDec(t, n, p) }
+       { let (t, n, p) = $2 in FunDec(t, n, p, LOC) }
      | boption(EXPORT); fun_header; LBRACE; fun_body; RBRACE
      | boption(EXPORT); fun_header; LBRACE; fun_body; RBRACE
-       { let (t, n, p) = $2 in FunDef ($1, t, n, p, $4) }
+       { let (t, n, p) = $2 in FunDef ($1, t, n, p, $4, LOC) }
 
 
      | EXTERN; basic_type; ID; SEMICOL
      | EXTERN; basic_type; ID; SEMICOL
-       { GlobalDec ($2, $3) }
+       { GlobalDec ($2, $3, LOC) }
      | EXTERN; t=basic_type; LBRACK; d=separated_list(COMMA, ID); RBRACK; n=ID; SEMICOL
      | EXTERN; t=basic_type; LBRACK; d=separated_list(COMMA, ID); RBRACK; n=ID; SEMICOL
-       { GlobalDec (ArrayDec (t, d), n) }
+       { GlobalDec (ArrayDec (t, d), n, LOC) }
 
 
      | boption(EXPORT); basic_type; ID; SEMICOL
      | boption(EXPORT); basic_type; ID; SEMICOL
-       { GlobalDef ($1, $2, $3, None) }
+       { GlobalDef ($1, $2, $3, None, LOC) }
      | boption(EXPORT); basic_type; ID; ASSIGN; expr; SEMICOL
      | boption(EXPORT); basic_type; ID; ASSIGN; expr; SEMICOL
-       { GlobalDef ($1, $2, $3, Some $5) }
+       { GlobalDef ($1, $2, $3, Some $5, LOC) }
 
 
-     | e=boption(EXPORT); t=basic_type; LBRACK; d=separated_list(COMMA, expr); RBRACK; n=ID; SEMICOL
-       { GlobalDef (e, ArrayDef (t, d), n, None) }
-     | e=boption(EXPORT); t=basic_type; LBRACK; d=separated_list(COMMA, expr); RBRACK; n=ID; ASSIGN; v=expr; SEMICOL
-       { GlobalDef (e, ArrayDef (t, d), n, Some v) }
+     | e=boption(EXPORT); t=basic_type; LBRACK; d=separated_list(COMMA, expr);
+            RBRACK; n=ID; SEMICOL
+       { GlobalDef (e, ArrayDef (t, d), n, None, LOC) }
+     | e=boption(EXPORT); t=basic_type; LBRACK; d=separated_list(COMMA, expr);
+            RBRACK; n=ID; ASSIGN; v=expr; SEMICOL
+       { GlobalDef (e, ArrayDef (t, d), n, Some v, LOC) }
 
 
 fun_header : ret=basic_type; name=ID; LPAREN; params=separated_list(COMMA, param); RPAREN
 fun_header : ret=basic_type; name=ID; LPAREN; params=separated_list(COMMA, param); RPAREN
              { (ret, name, params) }
              { (ret, name, params) }
            | VOID; name=ID; LPAREN; params=separated_list(COMMA, param); RPAREN
            | VOID; name=ID; LPAREN; params=separated_list(COMMA, param); RPAREN
              { (Void, name, params) }
              { (Void, name, params) }
 
 
-param : basic_type; ID  { Param ($1, $2) }
+param : basic_type; ID  { Param ($1, $2, LOC) }
 
 
 fun_body : var_dec* local_fun_dec* statement* loption(return_statement)
 fun_body : var_dec* local_fun_dec* statement* loption(return_statement)
            { $1 @ $2 @ $3 }
            { $1 @ $2 @ $3 }
 
 
 local_fun_dec : fun_header; LBRACE; fun_body; RBRACE
 local_fun_dec : fun_header; LBRACE; fun_body; RBRACE
-                { let (t, n, p) = $1 in FunDef (false, t, n, p, $3) }
+                { let (t, n, p) = $1 in FunDef (false, t, n, p, $3, LOC) }
 
 
 var_dec : basic_type; ID; SEMICOL
 var_dec : basic_type; ID; SEMICOL
-          { VarDec ($1, $2, None) }
+          { VarDec ($1, $2, None, LOC) }
         | basic_type; ID; ASSIGN; expr; SEMICOL
         | basic_type; ID; ASSIGN; expr; SEMICOL
-          { VarDec ($1, $2, Some $4) }
+          { VarDec ($1, $2, Some $4, LOC) }
         | t=basic_type; LBRACK; d=separated_list(COMMA, expr); RBRACK; n=ID; SEMICOL
         | t=basic_type; LBRACK; d=separated_list(COMMA, expr); RBRACK; n=ID; SEMICOL
-          { VarDec (ArrayDef (t, d), n, None) }
+          { VarDec (ArrayDef (t, d), n, None, LOC) }
         | t=basic_type; LBRACK; d=separated_list(COMMA, expr); RBRACK; n=ID; ASSIGN; v=expr; SEMICOL
         | t=basic_type; LBRACK; d=separated_list(COMMA, expr); RBRACK; n=ID; ASSIGN; v=expr; SEMICOL
-          { VarDec (ArrayDef (t, d), n, Some v) }
+          { VarDec (ArrayDef (t, d), n, Some v, LOC) }
 
 
 statement : ID; ASSIGN; expr; SEMICOL
 statement : ID; ASSIGN; expr; SEMICOL
-            { Assign ($1, $3) }
+            { Assign ($1, $3, LOC) }
           | name=ID; LPAREN; params=separated_list(COMMA, expr); RPAREN; SEMICOL
           | name=ID; LPAREN; params=separated_list(COMMA, expr); RPAREN; SEMICOL
-            { Expr (FunCall (name, params)) }
+            { Expr (FunCall (name, params, LOC)) }
           | IF; LPAREN; expr; RPAREN; block
           | IF; LPAREN; expr; RPAREN; block
-            { If ($3, $5) }                                 %prec IF
+            { If ($3, $5, LOC) }                                 %prec IF
           | IF; LPAREN; expr; RPAREN; block; ELSE; block
           | IF; LPAREN; expr; RPAREN; block; ELSE; block
-            { IfElse ($3, $5, $7) }                         %prec ELSE
+            { IfElse ($3, $5, $7, LOC) }                         %prec ELSE
           | WHILE; LPAREN; expr; RPAREN; block
           | WHILE; LPAREN; expr; RPAREN; block
-            { While ($3, $5) }
+            { While ($3, $5, LOC) }
           | DO; block; WHILE; LPAREN; expr; RPAREN; SEMICOL
           | DO; block; WHILE; LPAREN; expr; RPAREN; SEMICOL
-            { DoWhile ($5, $2) }
+            { DoWhile ($5, $2, LOC) }
           | FOR; LPAREN; INT; id=ID; ASSIGN; start=expr; COMMA; stop=expr; RPAREN; body=block
           | FOR; LPAREN; INT; id=ID; ASSIGN; start=expr; COMMA; stop=expr; RPAREN; body=block
-            { For (id, start, stop, IntConst 1, body) }
-          | FOR; LPAREN; INT; id=ID; ASSIGN; start=expr; COMMA; stop=expr; COMMA; step=expr; RPAREN; body=block
-            { For (id, start, stop, step, body) }
+            { For (id, start, stop, IntConst (1, noloc), body, LOC) }
+          | FOR; LPAREN; INT; id=ID; ASSIGN; start=expr; COMMA; stop=expr;
+                COMMA; step=expr; RPAREN; body=block
+            { For (id, start, stop, step, body, LOC) }
 
 
-return_statement : RETURN; expr; SEMICOL  { [Return ($2)] }
+return_statement : RETURN; expr; SEMICOL  { [Return ($2, LOC)] }
 
 
 block : LBRACE; statement*; RBRACE  { $2 }
 block : LBRACE; statement*; RBRACE  { $2 }
       | statement                   { [$1] }
       | statement                   { [$1] }
 
 
 expr : LPAREN; expr; RPAREN                 { $2 }
 expr : LPAREN; expr; RPAREN                 { $2 }
      | name=ID; LPAREN; params=separated_list(COMMA, expr); RPAREN
      | name=ID; LPAREN; params=separated_list(COMMA, expr); RPAREN
-       { FunCall (name, params) }
-     | ID                                   { Var $1 }
-     | l=expr; op=binop; r=expr             { Binop (op, l, r) }
-     | SUB; expr                            { Monop (Neg, $2) }    %prec NEG
-     | NOT; expr                            { Monop (Not, $2) }
-     | LPAREN; basic_type; RPAREN; expr     { TypeCast ($2, $4) }  %prec CAST
-     | FLOAT_CONST                          { FloatConst $1 }
-     | INT_CONST                            { IntConst $1 }
-     | BOOL_CONST                           { BoolConst $1 }
-     | ID; array_const                      { Deref ($1, $2) }
-     | array_const                          { ArrayConst $1 }
-
-array_const : LBRACK; values=separated_list(COMMA, expr); RBRACK { values }
+       { FunCall (name, params, LOC) }
+     | ID                                   { Var ($1, LOC) }
+     | l=expr; op=binop; r=expr             { Binop (op, l, r, LOC) }
+     | SUB; expr                            { Monop (Neg, $2, LOC) }    %prec NEG
+     | NOT; expr                            { Monop (Not, $2, LOC) }
+     | LPAREN; basic_type; RPAREN; expr     { TypeCast ($2, $4, LOC) }  %prec CAST
+     | FLOAT_CONST                          { FloatConst ($1, LOC) }
+     | INT_CONST                            { IntConst ($1, LOC) }
+     | BOOL_CONST                           { BoolConst ($1, LOC) }
+     | ID; array_const                      { Deref ($1, $2, LOC) }
+     | array_const                          { ArrayConst ($1, LOC) }
+
+array_const : LBRACK; values=separated_list(COMMA, expr); RBRACK  { values }
 
 
 %inline binop : ADD { Add }
 %inline binop : ADD { Add }
               | SUB { Sub }
               | SUB { Sub }

+ 22 - 20
phases/desug.ml

@@ -3,63 +3,65 @@ open Util
 
 
 let rec flatten = function
 let rec flatten = function
     | [] -> []
     | [] -> []
-    | Statements nodes :: t -> (flatten nodes) @ (flatten t)
+    | Statements (nodes, _) :: t -> (flatten nodes) @ (flatten t)
     | h :: t -> h :: (flatten t)
     | h :: t -> h :: (flatten t)
 
 
 let rec var_init = function
 let rec var_init = function
     (* Split local variable initialisations in declaration and assignment *)
     (* Split local variable initialisations in declaration and assignment *)
-    | FunDef (export, ret_type, name, params, body) ->
+    | FunDef (export, ret_type, name, params, body, loc) ->
         let move_inits body =
         let move_inits body =
-            let rec trav inits = function
+            let rec trav inits node = match node with
                 (* translate scalar array initialisation to ArrayScalar node,
                 (* translate scalar array initialisation to ArrayScalar node,
                  * for easy replacement later on *)
                  * for easy replacement later on *)
-                | VarDec (ArrayDef (_, _) as vtype, name, Some (BoolConst _ as v)) :: t
-                | VarDec (ArrayDef (_, _) as vtype, name, Some (FloatConst _ as v)) :: t
-                | VarDec (ArrayDef (_, _) as vtype, name, Some (IntConst _ as v)) :: t ->
-                    trav inits (VarDec (vtype, name, Some (ArrayScalar v)) :: t)
+                | VarDec (ArrayDef (_, _) as vtype, name, Some ((BoolConst (_, l)) as v), loc) :: t
+                | VarDec (ArrayDef (_, _) as vtype, name, Some ((FloatConst (_, l)) as v), loc) :: t
+                | VarDec (ArrayDef (_, _) as vtype, name, Some ((IntConst (_, l)) as v), loc) :: t ->
+                    trav inits (VarDec (vtype, name, Some (ArrayScalar (v, l)), loc) :: t)
 
 
-                | VarDec (ctype, name, init) :: t ->
+                | VarDec (ctype, name, init, loc) :: t ->
                     (* array definition: create __allocate statement *)
                     (* array definition: create __allocate statement *)
                     let alloc = match ctype with
                     let alloc = match ctype with
-                        | ArrayDef (_, dims) -> [Allocate (name, dims)]
+                        | ArrayDef (_, dims) -> [Allocate (name, dims, noloc)]
                         | _ -> []
                         | _ -> []
                     in
                     in
                     (* variable initialisation: create assign statement *)
                     (* variable initialisation: create assign statement *)
                     let stats = match init with
                     let stats = match init with
-                        | Some value -> alloc @ [Assign (name, value)]
+                        | Some value -> alloc @ [Assign (name, value, loc)]
                         | None -> alloc
                         | None -> alloc
                     in
                     in
-                    VarDec (ctype, name, None) :: (trav (inits @ stats) t)
+                    VarDec (ctype, name, None, loc) :: (trav (inits @ stats) t)
 
 
                 (* initialisations need to be placed after local functions *)
                 (* initialisations need to be placed after local functions *)
-                | (FunDef (_, _, _, _, _) as h) :: t ->
+                | (FunDef (_, _, _, _, _, _) as h) :: t ->
                     (var_init h) :: (trav inits t)
                     (var_init h) :: (trav inits t)
 
 
                 (* rest of function body: recurse *)
                 (* rest of function body: recurse *)
                 | rest -> inits @ (List.map var_init rest)
                 | rest -> inits @ (List.map var_init rest)
             in trav [] body
             in trav [] body
         in
         in
-        FunDef (export, ret_type, name, params, move_inits body)
+        FunDef (export, ret_type, name, params, move_inits body, loc)
 
 
     (* Move global variable initialisations to exported __init function *)
     (* Move global variable initialisations to exported __init function *)
-    | GlobalDef (export, ctype, name, Some init) ->
-        Statements [GlobalDef (export, ctype, name, None); Assign (name, init)]
+    | GlobalDef (export, ctype, name, Some init, loc) ->
+        Statements ([GlobalDef (export, ctype, name, None, loc);
+                     Assign (name, init, locof init)], loc)
 
 
-    | Program (decls, l) ->
+    (* Move global initialisations to __init function *)
+    | Program (decls, loc) ->
         let decls = flatten (List.map var_init decls) in
         let decls = flatten (List.map var_init decls) in
         let rec trav assigns = function
         let rec trav assigns = function
             | [] -> (assigns, [])
             | [] -> (assigns, [])
-            | (Assign (_, _) as h) :: t -> trav (assigns @ [h]) t
+            | (Assign (_, _, _) as h) :: t -> trav (assigns @ [h]) t
             | h :: t ->
             | h :: t ->
                 let (assigns, decls) = trav assigns t in
                 let (assigns, decls) = trav assigns t in
                 (assigns, (h :: decls))
                 (assigns, (h :: decls))
         in
         in
         let (assigns, decls) = trav [] decls in
         let (assigns, decls) = trav [] decls in
         (match assigns with
         (match assigns with
-            | [] -> Program (decls, l)
+            | [] -> Program (decls, loc)
             | assigns ->
             | assigns ->
-                let init_func = FunDef (true, Void, "__init", [], assigns) in
-                Program (init_func :: decls, l)
+                let init_func = FunDef (true, Void, "__init", [], assigns, noloc) in
+                Program (init_func :: decls, loc)
             )
             )
 
 
     | node -> transform var_init node
     | node -> transform var_init node

+ 29 - 29
stringify.ml

@@ -43,10 +43,10 @@ and node2lines node =
     let all_lines = List.map node2lines in
     let all_lines = List.map node2lines in
     match node with
     match node with
     (* Decls *)
     (* Decls *)
-    | FunDec (ret_type, name, params) ->
+    | FunDec (ret_type, name, params, _) ->
         let params = String.concat ", " (all_str params) in
         let params = String.concat ", " (all_str params) in
         ["extern " ^ type2str ret_type ^ " " ^ name ^ "(" ^ params ^ ");"]
         ["extern " ^ type2str ret_type ^ " " ^ name ^ "(" ^ params ^ ");"]
-    | FunDef (export, ret_type, name, params, body) ->
+    | FunDef (export, ret_type, name, params, body, _) ->
         let export = if export then "export " else "" in
         let export = if export then "export " else "" in
         let params = String.concat ", " (all_str params) in
         let params = String.concat ", " (all_str params) in
         let header = type2str ret_type ^ " " ^ name ^ "(" ^ params ^ ")" in
         let header = type2str ret_type ^ " " ^ name ^ "(" ^ params ^ ")" in
@@ -54,9 +54,9 @@ and node2lines node =
         [export ^ header ^ " {"] @
         [export ^ header ^ " {"] @
             body @
             body @
         ["}"]
         ["}"]
-    | GlobalDec (var_type, name) ->
+    | GlobalDec (var_type, name, _) ->
         ["extern " ^ type2str var_type ^ " " ^ name ^ ";"]
         ["extern " ^ type2str var_type ^ " " ^ name ^ ";"]
-    | GlobalDef (export, ret_type, name, init) ->
+    | GlobalDef (export, ret_type, name, init, _) ->
         let export = if export then "export " else "" in
         let export = if export then "export " else "" in
         let init = match init with
         let init = match init with
             | Some value -> " = " ^ node2str value
             | Some value -> " = " ^ node2str value
@@ -65,22 +65,22 @@ and node2lines node =
         [export ^ (type2str ret_type) ^ " " ^ name ^ init ^ ";"]
         [export ^ (type2str ret_type) ^ " " ^ name ^ init ^ ";"]
 
 
     (* Statements *)
     (* Statements *)
-    | VarDec (var_type, name, None) ->
+    | VarDec (var_type, name, None, _) ->
         [(type2str var_type) ^ " " ^ name ^ ";"]
         [(type2str var_type) ^ " " ^ name ^ ";"]
-    | VarDec (var_type, name, Some init) ->
+    | VarDec (var_type, name, Some init, _) ->
         [(type2str var_type) ^ " " ^ name ^ " = " ^ (node2str init) ^ ";"]
         [(type2str var_type) ^ " " ^ name ^ " = " ^ (node2str init) ^ ";"]
-    | Assign (name, value) ->
+    | Assign (name, value, _) ->
         [name ^ " = " ^ (node2str value) ^ ";"]
         [name ^ " = " ^ (node2str value) ^ ";"]
     | Expr expr ->
     | Expr expr ->
         [node2str expr ^ ";"]
         [node2str expr ^ ";"]
-    | Return value ->
+    | Return (value, _) ->
         ["return " ^ (node2str value) ^ ";"]
         ["return " ^ (node2str value) ^ ";"]
-    | If (cond, body) ->
+    | If (cond, body, _) ->
         let body = indent (List.concat (all_lines body)) in
         let body = indent (List.concat (all_lines body)) in
         ["if (" ^ node2str cond ^ ") {"] @
         ["if (" ^ node2str cond ^ ") {"] @
             body @
             body @
         ["}"]
         ["}"]
-    | IfElse (cond, true_body, false_body) ->
+    | IfElse (cond, true_body, false_body, _) ->
         let true_body = indent (List.concat (all_lines true_body)) in
         let true_body = indent (List.concat (all_lines true_body)) in
         let false_body = indent (List.concat (all_lines false_body)) in
         let false_body = indent (List.concat (all_lines false_body)) in
         ["if (" ^ node2str cond ^ ") {"] @
         ["if (" ^ node2str cond ^ ") {"] @
@@ -88,19 +88,19 @@ and node2lines node =
         ["} else {"] @
         ["} else {"] @
             false_body @
             false_body @
         ["}"]
         ["}"]
-    | While (cond, body) ->
+    | While (cond, body, _) ->
         let body = indent (List.concat (all_lines body)) in
         let body = indent (List.concat (all_lines body)) in
         ["while (" ^ node2str cond ^ ") {"] @
         ["while (" ^ node2str cond ^ ") {"] @
             body @
             body @
         ["}"]
         ["}"]
-    | DoWhile (cond, body) ->
+    | DoWhile (cond, body, _) ->
         let body = indent (List.concat (all_lines body)) in
         let body = indent (List.concat (all_lines body)) in
         ["do {"] @
         ["do {"] @
             body @
             body @
         ["} while (" ^ node2str cond ^ ");"]
         ["} while (" ^ node2str cond ^ ");"]
-    | For (counter, start, stop, step, body) ->
+    | For (counter, start, stop, step, body, _) ->
         let step = match step with
         let step = match step with
-            | IntConst 1 -> ""
+            | IntConst (1, _) -> ""
             | value -> ", " ^ node2str value
             | value -> ", " ^ node2str value
         in
         in
         let range = node2str start ^ ", " ^ node2str stop ^ step in
         let range = node2str start ^ ", " ^ node2str stop ^ step in
@@ -108,10 +108,10 @@ and node2lines node =
         ["for (int " ^ counter ^ " = " ^ range ^ ") {"] @
         ["for (int " ^ counter ^ " = " ^ range ^ ") {"] @
             body @
             body @
         ["}"]
         ["}"]
-    | Allocate (name, dims) ->
+    | Allocate (name, dims, _) ->
         [name ^ " = __allocate(" ^ String.concat ", " (List.map node2str dims) ^ ");"]
         [name ^ " = __allocate(" ^ String.concat ", " (List.map node2str dims) ^ ");"]
 
 
-    | Statements stats -> List.concat (List.map node2lines stats)
+    | Statements (stats, _) -> List.concat (List.map node2lines stats)
 
 
     (* Catch-all, whould never happen *)
     (* Catch-all, whould never happen *)
     | _ -> failwith "invalid node"
     | _ -> failwith "invalid node"
@@ -124,24 +124,24 @@ and node2str node =
     | Program (decls, _) ->
     | Program (decls, _) ->
         let decl2str decl = String.concat "\n" (node2lines decl) in
         let decl2str decl = String.concat "\n" (node2lines decl) in
         String.concat "\n\n" (List.map decl2str decls)
         String.concat "\n\n" (List.map decl2str decls)
-    | Param (param_type, name) -> (type2str param_type) ^ " " ^ name
+    | Param (param_type, name, _) -> (type2str param_type) ^ " " ^ name
 
 
     (* Expressions *)
     (* Expressions *)
-    | BoolConst b -> string_of_bool b
-    | IntConst i -> string_of_int i
-    | FloatConst f -> string_of_float f
-    | ArrayConst dims -> "[" ^ concat ", " dims ^ "]"
-    | ArrayScalar value -> node2str value
-    | Var v -> v
-    | Deref (name, dims) -> name ^ (node2str (ArrayConst dims))
-    | Monop (op, opnd) -> monop2str op ^ node2str opnd
-    | Binop (op, left, right) ->
+    | BoolConst (b, _) -> string_of_bool b
+    | IntConst (i, _) -> string_of_int i
+    | FloatConst (f, _) -> string_of_float f
+    | ArrayConst (dims, _) -> "[" ^ concat ", " dims ^ "]"
+    | ArrayScalar (value, _) -> node2str value
+    | Var (v, _) -> v
+    | Deref (name, dims, _) -> name ^ (node2str (ArrayConst (dims, noloc)))
+    | Monop (op, opnd, _) -> monop2str op ^ node2str opnd
+    | Binop (op, left, right, _) ->
         "(" ^ node2str left ^ binop2str op ^ node2str right ^ ")"
         "(" ^ node2str left ^ binop2str op ^ node2str right ^ ")"
-    | Cond (cond, t, f) ->
+    | Cond (cond, t, f, _) ->
         (node2str cond) ^ " ? " ^ node2str t ^ " : " ^ node2str f
         (node2str cond) ^ " ? " ^ node2str t ^ " : " ^ node2str f
-    | TypeCast (ctype, value) ->
+    | TypeCast (ctype, value, _) ->
         "(" ^ type2str ctype ^ ")" ^ node2str value
         "(" ^ type2str ctype ^ ")" ^ node2str value
-    | FunCall (name, args) ->
+    | FunCall (name, args, _) ->
         name ^ "(" ^ (concat ", " args) ^ ")"
         name ^ "(" ^ (concat ", " args) ^ ")"
 
 
     | node -> String.concat "\n" (node2lines node)
     | node -> String.concat "\n" (node2lines node)

+ 71 - 40
util.ml

@@ -12,48 +12,79 @@ let rec transform visitor node =
     let trav = visitor in
     let trav = visitor in
     let trav_all nodes = List.map trav nodes in
     let trav_all nodes = List.map trav nodes in
     match node with
     match node with
-    | Program (decls, l) ->
-        Program (trav_all decls, l)
-    | FunDec (ret_type, name, params) ->
-        FunDec (ret_type, name, trav_all params)
-    | FunDef (export, ret_type, name, params, body) ->
-        FunDef (export, ret_type, name, trav_all params, trav_all body)
-    | GlobalDec (ctype, name) ->
-        GlobalDec (ctype, name)
-    | GlobalDef (export, ctype, name, Some init) ->
-        GlobalDef (export, ctype, name, Some (trav init))
-
-    | VarDec (ctype, name, Some init) ->
-        VarDec (ctype, name, Some (trav init))
-    | Assign (name, value) ->
-        Assign (name, trav value)
-    | Return (value) ->
-        Return (trav value)
-    | If (cond, body) ->
-        If (trav cond, trav_all body)
-    | IfElse (cond, true_body, false_body) ->
-        IfElse (trav cond, trav_all true_body, trav_all false_body)
-    | While (cond, body) ->
-        While (trav cond, trav_all body)
-    | DoWhile (cond, body) ->
-        DoWhile (trav cond, trav_all body)
-    | For (counter, start, stop, step, body) ->
-        For (counter, trav start, trav stop, trav step, trav_all body)
-    | Expr (value) ->
+    | Program (decls, loc) ->
+        Program (trav_all decls, loc)
+    | FunDec (ret_type, name, params, loc) ->
+        FunDec (ret_type, name, trav_all params, loc)
+    | FunDef (export, ret_type, name, params, body, loc) ->
+        FunDef (export, ret_type, name, trav_all params, trav_all body, loc)
+    | GlobalDec (ctype, name, loc) ->
+        GlobalDec (ctype, name, loc)
+    | GlobalDef (export, ctype, name, Some init, loc) ->
+        GlobalDef (export, ctype, name, Some (trav init), loc)
+
+    | VarDec (ctype, name, Some init, loc) ->
+        VarDec (ctype, name, Some (trav init), loc)
+    | Assign (name, value, loc) ->
+        Assign (name, trav value, loc)
+    | Return (value, loc) ->
+        Return (trav value, loc)
+    | If (cond, body, loc) ->
+        If (trav cond, trav_all body, loc)
+    | IfElse (cond, true_body, false_body, loc) ->
+        IfElse (trav cond, trav_all true_body, trav_all false_body, loc)
+    | While (cond, body, loc) ->
+        While (trav cond, trav_all body, loc)
+    | DoWhile (cond, body, loc) ->
+        DoWhile (trav cond, trav_all body, loc)
+    | For (counter, start, stop, step, body, loc) ->
+        For (counter, trav start, trav stop, trav step, trav_all body, loc)
+    | Expr value ->
         Expr (trav value)
         Expr (trav value)
 
 
-    | Monop (op, value) ->
-        Monop (op, trav value)
-    | Binop (op, left, right) ->
-        Binop (op, trav left, trav right)
-    | Cond (cond, true_expr, false_expr) ->
-        Cond (trav cond, trav true_expr, trav false_expr)
-    | TypeCast (ctype, value) ->
-        TypeCast (ctype, trav value)
-    | FunCall (name, args) ->
-        FunCall (name, trav_all args)
+    | Monop (op, value, loc) ->
+        Monop (op, trav value, loc)
+    | Binop (op, left, right, loc) ->
+        Binop (op, trav left, trav right, loc)
+    | Cond (cond, true_expr, false_expr, loc) ->
+        Cond (trav cond, trav true_expr, trav false_expr, loc)
+    | TypeCast (ctype, value, loc) ->
+        TypeCast (ctype, trav value, loc)
+    | FunCall (name, args, loc) ->
+        FunCall (name, trav_all args, loc)
 
 
-    | Statements (stats) ->
-        Statements (trav_all stats)
+    | Statements (stats, loc) ->
+        Statements (trav_all stats, loc)
 
 
     | _ -> node
     | _ -> node
+
+ let rec locof = function
+    | Program (_, loc)
+    | Param (_, _, loc)
+    | FunDec (_, _, _, loc)
+    | FunDef (_, _, _, _, _, loc)
+    | GlobalDec (_, _, loc)
+    | GlobalDef (_, _, _, _, loc)
+    | VarDec (_, _, _, loc)
+    | Assign (_, _, loc)
+    | Return (_, loc)
+    | If (_, _, loc)
+    | IfElse (_, _, _, loc)
+    | While (_, _, loc)
+    | DoWhile (_, _, loc)
+    | For (_, _, _, _, _, loc)
+    | BoolConst (_, loc)
+    | IntConst (_, loc)
+    | FloatConst (_, loc)
+    | ArrayConst (_, loc)
+    | ArrayScalar (_, loc)
+    | Var (_, loc)
+    | Deref (_, _, loc)
+    | Monop (_, _, loc)
+    | Binop (_, _, _, loc)
+    | Cond (_, _, _, loc)
+    | TypeCast (_, _, loc)
+    | FunCall (_, _, loc)
+    | Statements (_, loc) -> loc
+
+    | Expr value -> locof value

+ 6 - 0
util.mli

@@ -1,2 +1,8 @@
+(* Generate a fresh variable from a given prefix, e.g. "counter" -> "counter$1"  *)
 val fresh_var : string -> string
 val fresh_var : string -> string
+
+(* Default transformation traversal for AST nodes *)
 val transform : (Ast.node -> Ast.node) -> Ast.node -> Ast.node
 val transform : (Ast.node -> Ast.node) -> Ast.node -> Ast.node
+
+(* Extract location from node *)
+val locof : Ast.node -> Ast.loc