diff options
Diffstat (limited to 'src/bytecode_util.ml')
| -rw-r--r-- | src/bytecode_util.ml | 48 |
1 files changed, 23 insertions, 25 deletions
diff --git a/src/bytecode_util.ml b/src/bytecode_util.ml index 139763b1..b11b70d0 100644 --- a/src/bytecode_util.ml +++ b/src/bytecode_util.ml @@ -73,18 +73,15 @@ let iinit ?loc:(l=Parse_ast.Unknown) ctyp id cval = let iif ?loc:(l=Parse_ast.Unknown) cval then_instrs else_instrs ctyp = I_aux (I_if (cval, then_instrs, else_instrs, ctyp), (instr_number (), l)) -let ifuncall ?loc:(l=Parse_ast.Unknown) clexp id cvals ctyp = - I_aux (I_funcall (clexp, false, id, cvals, ctyp), (instr_number (), l)) +let ifuncall ?loc:(l=Parse_ast.Unknown) clexp id cvals = + I_aux (I_funcall (clexp, false, id, cvals), (instr_number (), l)) -let iextern ?loc:(l=Parse_ast.Unknown) clexp id cvals ctyp = - I_aux (I_funcall (clexp, true, id, cvals, ctyp), (instr_number (), l)) +let iextern ?loc:(l=Parse_ast.Unknown) clexp id cvals = + I_aux (I_funcall (clexp, true, id, cvals), (instr_number (), l)) let icopy ?loc:(l=Parse_ast.Unknown) clexp cval = I_aux (I_copy (clexp, cval), (instr_number (), l)) -let iconvert ?loc:(l=Parse_ast.Unknown) clexp ctyp1 id ctyp2 = - I_aux (I_convert (clexp, ctyp1, id, ctyp2), (instr_number (), l)) - let iclear ?loc:(l=Parse_ast.Unknown) ctyp id = I_aux (I_clear (ctyp, id), (instr_number (), l)) @@ -107,6 +104,9 @@ let ilabel ?loc:(l=Parse_ast.Unknown) label = let igoto ?loc:(l=Parse_ast.Unknown) label = I_aux (I_goto label, (instr_number (), l)) +let iundefined ?loc:(l=Parse_ast.Unknown) ctyp = + I_aux (I_undefined ctyp, (instr_number (), l)) + let imatch_failure ?loc:(l=Parse_ast.Unknown) () = I_aux (I_match_failure, (instr_number (), l)) @@ -203,11 +203,11 @@ let pp_cval (frag, ctyp) = string (string_of_fragment ~zencode:false frag) ^^ string " : " ^^ pp_ctyp ctyp let rec pp_clexp = function - | CL_id id -> pp_id id - | CL_field (id, field) -> pp_id id ^^ string "." ^^ string field - | CL_addr id -> string "*" ^^ pp_id id - | CL_addr_field (id, field) -> pp_id id ^^ string "->" ^^ string field - | CL_current_exception -> string "current_exception" + | CL_id (id, ctyp) -> pp_id id ^^ string " : " ^^ pp_ctyp ctyp + | CL_field (id, field, ctyp) -> pp_id id ^^ string "." ^^ string field ^^ string " : " ^^ pp_ctyp ctyp + | CL_addr (id, ctyp) -> string "*" ^^ pp_id id ^^ string " : " ^^ pp_ctyp ctyp + | CL_addr_field (id, field, ctyp) -> pp_id id ^^ string "->" ^^ string field ^^ string " : " ^^ pp_ctyp ctyp + | CL_current_exception _ -> string "current_exception" | CL_have_exception -> string "have_exception" let rec pp_instr ?short:(short=false) (I_aux (instr, aux)) = @@ -238,13 +238,9 @@ let rec pp_instr ?short:(short=false) (I_aux (instr, aux)) = pp_keyword "create" ^^ pp_id id ^^ string " : " ^^ pp_ctyp ctyp ^^ string " = " ^^ pp_cval cval | I_reinit (ctyp, id, cval) -> pp_keyword "recreate" ^^ pp_id id ^^ string " : " ^^ pp_ctyp ctyp ^^ string " = " ^^ pp_cval cval - | I_funcall (x, _, f, args, ctyp2) -> + | I_funcall (x, _, f, args) -> separate space [ pp_clexp x; string "="; - string (string_of_id f |> Util.green |> Util.clear) ^^ parens (separate_map (string ", ") pp_cval args); - string ":"; pp_ctyp ctyp2 ] - | I_convert (x, ctyp1, y, ctyp2) -> - separate space [ pp_clexp x; colon; pp_ctyp ctyp1; string "="; - pp_keyword "convert" ^^ pp_id y; colon; pp_ctyp ctyp2 ] + string (string_of_id f |> Util.green |> Util.clear) ^^ parens (separate_map (string ", ") pp_cval args) ] | I_copy (clexp, cval) -> separate space [pp_clexp clexp; string "="; pp_cval cval] | I_clear (ctyp, id) -> @@ -261,6 +257,8 @@ let rec pp_instr ?short:(short=false) (I_aux (instr, aux)) = pp_keyword "goto" ^^ string (str |> Util.blue |> Util.clear) | I_match_failure -> pp_keyword "match_failure" + | I_undefined ctyp -> + pp_keyword "undefined" ^^ pp_ctyp ctyp | I_raw str -> pp_keyword "C" ^^ string (str |> Util.cyan |> Util.clear) @@ -355,12 +353,12 @@ let rec fragment_deps = function let cval_deps = function (frag, _) -> fragment_deps frag let rec clexp_deps = function - | CL_id id -> NS.singleton (G_id id) - | CL_field (id, _) -> NS.singleton (G_id id) - | CL_addr id -> NS.singleton (G_id id) - | CL_addr_field (id, _) -> NS.singleton (G_id id) + | CL_id (id, _) -> NS.singleton (G_id id) + | CL_field (id, _, _) -> NS.singleton (G_id id) + | CL_addr (id, _) -> NS.singleton (G_id id) + | CL_addr_field (id, _, _) -> NS.singleton (G_id id) | CL_have_exception -> NS.empty - | CL_current_exception -> NS.empty + | CL_current_exception _ -> NS.empty (** Return the direct, non program-order dependencies of a single instruction **) @@ -370,8 +368,7 @@ let instr_deps = function | I_init (ctyp, id, cval) | I_reinit (ctyp, id, cval) -> cval_deps cval, NS.singleton (G_id id) | I_if (cval, _, _, _) -> cval_deps cval, NS.empty | I_jump (cval, label) -> cval_deps cval, NS.singleton (G_label label) - | I_funcall (clexp, _, _, cvals, _) -> List.fold_left NS.union NS.empty (List.map cval_deps cvals), clexp_deps clexp - | I_convert (clexp, _, id, _) -> NS.singleton (G_id id), clexp_deps clexp + | I_funcall (clexp, _, _, cvals) -> List.fold_left NS.union NS.empty (List.map cval_deps cvals), clexp_deps clexp | I_copy (clexp, cval) -> cval_deps cval, clexp_deps clexp | I_clear (_, id) -> NS.singleton (G_id id), NS.singleton (G_id id) | I_throw cval | I_return cval -> cval_deps cval, NS.empty @@ -379,6 +376,7 @@ let instr_deps = function | I_comment _ | I_raw _ -> NS.empty, NS.empty | I_label label -> NS.singleton (G_label label), NS.empty | I_goto label -> NS.empty, NS.singleton (G_label label) + | I_undefined _ -> NS.empty, NS.empty | I_match_failure -> NS.empty, NS.empty let add_link from_node to_node graph = |