|
@@ -55,13 +55,13 @@ let is_const_id id =
|
|
|
&& id.[String.length id - 1] = '_'
|
|
&& id.[String.length id - 1] = '_'
|
|
|
|
|
|
|
|
let loc_from_lexpos pstart pend =
|
|
let loc_from_lexpos pstart pend =
|
|
|
- let (fname, ystart, yend, xstart, xend) = begin
|
|
|
|
|
|
|
+ let fname, ystart, yend, xstart, xend =
|
|
|
pstart.pos_fname,
|
|
pstart.pos_fname,
|
|
|
pstart.pos_lnum,
|
|
pstart.pos_lnum,
|
|
|
pend.pos_lnum,
|
|
pend.pos_lnum,
|
|
|
- (pstart.pos_cnum - pstart.pos_bol + 1),
|
|
|
|
|
- (pend.pos_cnum - pend.pos_bol)
|
|
|
|
|
- end in
|
|
|
|
|
|
|
+ pstart.pos_cnum - pstart.pos_bol + 1,
|
|
|
|
|
+ pend.pos_cnum - pend.pos_bol
|
|
|
|
|
+ in
|
|
|
if ystart = yend && xend < xstart then
|
|
if ystart = yend && xend < xstart then
|
|
|
(fname, ystart, yend, xstart, xstart)
|
|
(fname, ystart, yend, xstart, xstart)
|
|
|
else
|
|
else
|
|
@@ -100,120 +100,120 @@ let rec flatten_blocks lst =
|
|
|
* (node -> node) -> node -> node *)
|
|
* (node -> node) -> node -> node *)
|
|
|
let rec traverse u ( *: ) trav node =
|
|
let rec traverse u ( *: ) trav node =
|
|
|
let trav_all nodes =
|
|
let trav_all nodes =
|
|
|
- let (nodes, res) = List.split (List.map trav nodes) in
|
|
|
|
|
|
|
+ let nodes, res = List.split (List.map trav nodes) in
|
|
|
(nodes, List.fold_left ( *: ) u res)
|
|
(nodes, List.fold_left ( *: ) u res)
|
|
|
in
|
|
in
|
|
|
match node with
|
|
match node with
|
|
|
| Program (decls, ann) ->
|
|
| Program (decls, ann) ->
|
|
|
- let (decls, res_decls) = trav_all decls in
|
|
|
|
|
|
|
+ let decls, res_decls = trav_all decls in
|
|
|
(Program (flatten_blocks decls, ann), res_decls)
|
|
(Program (flatten_blocks decls, ann), res_decls)
|
|
|
| FunDec (ret_type, name, params, ann) ->
|
|
| FunDec (ret_type, name, params, ann) ->
|
|
|
- let (params, res_params) = trav_all params in
|
|
|
|
|
|
|
+ let params, res_params = trav_all params in
|
|
|
(FunDec (ret_type, name, params, ann), res_params)
|
|
(FunDec (ret_type, name, params, ann), res_params)
|
|
|
| FunDef (export, ret_type, name, params, body, ann) ->
|
|
| FunDef (export, ret_type, name, params, body, ann) ->
|
|
|
- let (params, resp) = trav_all params in
|
|
|
|
|
- let (body, resb) = trav body in
|
|
|
|
|
|
|
+ let params, resp = trav_all params in
|
|
|
|
|
+ let body, resb = trav body in
|
|
|
(FunDef (export, ret_type, name, params, body, ann), resp *: resb)
|
|
(FunDef (export, ret_type, name, params, body, ann), resp *: resb)
|
|
|
| GlobalDec (ctype, name, ann) ->
|
|
| GlobalDec (ctype, name, ann) ->
|
|
|
(GlobalDec (ctype, name, ann), u)
|
|
(GlobalDec (ctype, name, ann), u)
|
|
|
| GlobalDef (export, ctype, name, Some init, ann) ->
|
|
| GlobalDef (export, ctype, name, Some init, ann) ->
|
|
|
- let (init, res_init) = trav init in
|
|
|
|
|
|
|
+ let init, res_init = trav init in
|
|
|
(GlobalDef (export, ctype, name, Some init, ann), res_init)
|
|
(GlobalDef (export, ctype, name, Some init, ann), res_init)
|
|
|
|
|
|
|
|
| VarDecs decs ->
|
|
| VarDecs decs ->
|
|
|
- let (decs, res_decs) = trav_all decs in
|
|
|
|
|
|
|
+ let decs, res_decs = trav_all decs in
|
|
|
(VarDecs decs, res_decs)
|
|
(VarDecs decs, res_decs)
|
|
|
| LocalFuns funs ->
|
|
| LocalFuns funs ->
|
|
|
- let (funs, res_funs) = trav_all funs in
|
|
|
|
|
|
|
+ let funs, res_funs = trav_all funs in
|
|
|
(LocalFuns funs, res_funs)
|
|
(LocalFuns funs, res_funs)
|
|
|
|
|
|
|
|
| VarDec (ctype, name, Some init, ann) ->
|
|
| VarDec (ctype, name, Some init, ann) ->
|
|
|
- let (init, res_init) = trav init in
|
|
|
|
|
|
|
+ let init, res_init = trav init in
|
|
|
(VarDec (ctype, name, Some init, ann), res_init)
|
|
(VarDec (ctype, name, Some init, ann), res_init)
|
|
|
| Assign (name, None, value, ann) ->
|
|
| Assign (name, None, value, ann) ->
|
|
|
- let (value, res_value) = trav value in
|
|
|
|
|
|
|
+ let value, res_value = trav value in
|
|
|
(Assign (name, None, value, ann), res_value)
|
|
(Assign (name, None, value, ann), res_value)
|
|
|
| Assign (name, Some dims, value, ann) ->
|
|
| Assign (name, Some dims, value, ann) ->
|
|
|
- let (dims, res_dims) = trav_all dims in
|
|
|
|
|
- let (value, res_value) = trav value in
|
|
|
|
|
|
|
+ let dims, res_dims = trav_all dims in
|
|
|
|
|
+ let value, res_value = trav value in
|
|
|
(Assign (name, Some dims, value, ann), res_dims *: res_value)
|
|
(Assign (name, Some dims, value, ann), res_dims *: res_value)
|
|
|
| VarLet (dec, None, value, ann) ->
|
|
| VarLet (dec, None, value, ann) ->
|
|
|
- let (value, res_value) = trav value in
|
|
|
|
|
|
|
+ let value, res_value = trav value in
|
|
|
(VarLet (dec, None, value, ann), res_value)
|
|
(VarLet (dec, None, value, ann), res_value)
|
|
|
| VarLet (dec, Some dims, value, ann) ->
|
|
| VarLet (dec, Some dims, value, ann) ->
|
|
|
- let (dims, res_dims) = trav_all dims in
|
|
|
|
|
- let (value, res_value) = trav value in
|
|
|
|
|
|
|
+ let dims, res_dims = trav_all dims in
|
|
|
|
|
+ let value, res_value = trav value in
|
|
|
(VarLet (dec, Some dims, value, ann), res_dims *: res_value)
|
|
(VarLet (dec, Some dims, value, ann), res_dims *: res_value)
|
|
|
| Return (value, ann) ->
|
|
| Return (value, ann) ->
|
|
|
- let (value, res_value) = trav value in
|
|
|
|
|
|
|
+ let value, res_value = trav value in
|
|
|
(Return (value, ann), res_value)
|
|
(Return (value, ann), res_value)
|
|
|
| If (cond, body, ann) ->
|
|
| If (cond, body, ann) ->
|
|
|
- let (cond, res_cond) = trav cond in
|
|
|
|
|
- let (body, res_body) = trav body in
|
|
|
|
|
|
|
+ let cond, res_cond = trav cond in
|
|
|
|
|
+ let body, res_body = trav body in
|
|
|
(If (cond, body, ann), res_cond *: res_body)
|
|
(If (cond, body, ann), res_cond *: res_body)
|
|
|
| IfElse (cond, tbody, fbody, ann) ->
|
|
| IfElse (cond, tbody, fbody, ann) ->
|
|
|
- let (cond, resa) = trav cond in
|
|
|
|
|
- let (tbody, resb) = trav tbody in
|
|
|
|
|
- let (fbody, resc) = trav fbody in
|
|
|
|
|
|
|
+ let cond, resa = trav cond in
|
|
|
|
|
+ let tbody, resb = trav tbody in
|
|
|
|
|
+ let fbody, resc = trav fbody in
|
|
|
(IfElse (cond, tbody, fbody, ann), resa *: resb *: resc)
|
|
(IfElse (cond, tbody, fbody, ann), resa *: resb *: resc)
|
|
|
| While (cond, body, ann) ->
|
|
| While (cond, body, ann) ->
|
|
|
- let (cond, resc) = trav cond in
|
|
|
|
|
- let (body, resb) = trav body in
|
|
|
|
|
|
|
+ let cond, resc = trav cond in
|
|
|
|
|
+ let body, resb = trav body in
|
|
|
(While (cond, body, ann), resc *: resb)
|
|
(While (cond, body, ann), resc *: resb)
|
|
|
| DoWhile (cond, body, ann) ->
|
|
| DoWhile (cond, body, ann) ->
|
|
|
- let (cond, resc) = trav cond in
|
|
|
|
|
- let (body, resb) = trav body in
|
|
|
|
|
|
|
+ let cond, resc = trav cond in
|
|
|
|
|
+ let body, resb = trav body in
|
|
|
(DoWhile (cond, body, ann), resc *: resb)
|
|
(DoWhile (cond, body, ann), resc *: resb)
|
|
|
| For (counter, start, stop, step, body, ann) ->
|
|
| For (counter, start, stop, step, body, ann) ->
|
|
|
- let (start, resa) = trav start in
|
|
|
|
|
- let (stop, resb) = trav stop in
|
|
|
|
|
- let (step, resc) = trav step in
|
|
|
|
|
- let (body, resd) = trav body in
|
|
|
|
|
|
|
+ let start, resa = trav start in
|
|
|
|
|
+ let stop, resb = trav stop in
|
|
|
|
|
+ let step, resc = trav step in
|
|
|
|
|
+ let body, resd = trav body in
|
|
|
let res = resa *: resb *: resc *: resd in
|
|
let res = resa *: resb *: resc *: resd in
|
|
|
(For (counter, start, stop, step, body, ann), res)
|
|
(For (counter, start, stop, step, body, ann), res)
|
|
|
| Allocate (dec, dims, ann) ->
|
|
| Allocate (dec, dims, ann) ->
|
|
|
- let (dims, res_dims) = trav_all dims in
|
|
|
|
|
|
|
+ let dims, res_dims = trav_all dims in
|
|
|
(Allocate (dec, dims, ann), res_dims)
|
|
(Allocate (dec, dims, ann), res_dims)
|
|
|
| Expr value ->
|
|
| Expr value ->
|
|
|
- let (value, res_value) = trav value in
|
|
|
|
|
|
|
+ let value, res_value = trav value in
|
|
|
(Expr value, res_value)
|
|
(Expr value, res_value)
|
|
|
| Block (body) ->
|
|
| Block (body) ->
|
|
|
- let (body, res_body) = trav_all body in
|
|
|
|
|
|
|
+ let body, res_body = trav_all body in
|
|
|
(Block body, res_body)
|
|
(Block body, res_body)
|
|
|
|
|
|
|
|
| Monop (op, value, ann) ->
|
|
| Monop (op, value, ann) ->
|
|
|
- let (value, res_value) = trav value in
|
|
|
|
|
|
|
+ let value, res_value = trav value in
|
|
|
(Monop (op, value, ann), res_value)
|
|
(Monop (op, value, ann), res_value)
|
|
|
| Binop (op, left, right, ann) ->
|
|
| Binop (op, left, right, ann) ->
|
|
|
- let (left, res_left) = trav left in
|
|
|
|
|
- let (right, res_right) = trav right in
|
|
|
|
|
|
|
+ let left, res_left = trav left in
|
|
|
|
|
+ let right, res_right = trav right in
|
|
|
(Binop (op, left, right, ann), res_left *: res_right)
|
|
(Binop (op, left, right, ann), res_left *: res_right)
|
|
|
| Cond (cond, texpr, fexpr, ann) ->
|
|
| Cond (cond, texpr, fexpr, ann) ->
|
|
|
- let (cond, resa) = trav cond in
|
|
|
|
|
- let (texpr, resb) = trav texpr in
|
|
|
|
|
- let (fexpr, resc) = trav fexpr in
|
|
|
|
|
|
|
+ let cond, resa = trav cond in
|
|
|
|
|
+ let texpr, resb = trav texpr in
|
|
|
|
|
+ let fexpr, resc = trav fexpr in
|
|
|
(Cond (cond, texpr, fexpr, ann), resa *: resb *: resc)
|
|
(Cond (cond, texpr, fexpr, ann), resa *: resb *: resc)
|
|
|
| TypeCast (ctype, value, ann) ->
|
|
| TypeCast (ctype, value, ann) ->
|
|
|
- let (value, res_value) = trav value in
|
|
|
|
|
|
|
+ let value, res_value = trav value in
|
|
|
(TypeCast (ctype, value, ann), res_value)
|
|
(TypeCast (ctype, value, ann), res_value)
|
|
|
| FunCall (name, args, ann) ->
|
|
| FunCall (name, args, ann) ->
|
|
|
- let (args, res_args) = trav_all args in
|
|
|
|
|
|
|
+ let args, res_args = trav_all args in
|
|
|
(FunCall (name, args, ann), res_args)
|
|
(FunCall (name, args, ann), res_args)
|
|
|
| Arg value ->
|
|
| Arg value ->
|
|
|
- let (value, res_value) = trav value in
|
|
|
|
|
|
|
+ let value, res_value = trav value in
|
|
|
(Arg value, res_value)
|
|
(Arg value, res_value)
|
|
|
|
|
|
|
|
| ArrayInit (value, dims) ->
|
|
| ArrayInit (value, dims) ->
|
|
|
- let (value, res_value) = trav value in
|
|
|
|
|
|
|
+ let value, res_value = trav value in
|
|
|
(ArrayInit (value, dims), res_value)
|
|
(ArrayInit (value, dims), res_value)
|
|
|
| Var (dec, Some dims, ann) ->
|
|
| Var (dec, Some dims, ann) ->
|
|
|
- let (dims, res_dims) = trav_all dims in
|
|
|
|
|
|
|
+ let dims, res_dims = trav_all dims in
|
|
|
(Var (dec, Some dims, ann), res_dims)
|
|
(Var (dec, Some dims, ann), res_dims)
|
|
|
| VarUse (dec, Some dims, ann) ->
|
|
| VarUse (dec, Some dims, ann) ->
|
|
|
- let (dims, res_dims) = trav_all dims in
|
|
|
|
|
|
|
+ let dims, res_dims = trav_all dims in
|
|
|
(VarUse (dec, Some dims, ann), res_dims)
|
|
(VarUse (dec, Some dims, ann), res_dims)
|
|
|
| FunUse (dec, params, ann) ->
|
|
| FunUse (dec, params, ann) ->
|
|
|
- let (params, res_params) = trav_all params in
|
|
|
|
|
|
|
+ let params, res_params = trav_all params in
|
|
|
(FunUse (dec, params, ann), res_params)
|
|
(FunUse (dec, params, ann), res_params)
|
|
|
|
|
|
|
|
| _ -> (node, u)
|
|
| _ -> (node, u)
|
|
@@ -444,7 +444,7 @@ let prerr_loc (fname, ystart, yend, xstart, xend) =
|
|
|
|
|
|
|
|
let prerr_loc_msg loc msg =
|
|
let prerr_loc_msg loc msg =
|
|
|
if Globals.args.verbose >= 1 then begin
|
|
if Globals.args.verbose >= 1 then begin
|
|
|
- let (fname, ystart, yend, xstart, xend) = loc in
|
|
|
|
|
|
|
+ let fname, ystart, yend, xstart, xend = loc in
|
|
|
if loc != noloc then begin
|
|
if loc != noloc then begin
|
|
|
let line_s = if yend != ystart
|
|
let line_s = if yend != ystart
|
|
|
then sprintf "lines %d-%d" ystart yend
|
|
then sprintf "lines %d-%d" ystart yend
|