diff options
Diffstat (limited to 'src/bytecode_util.ml')
| -rw-r--r-- | src/bytecode_util.ml | 34 |
1 files changed, 32 insertions, 2 deletions
diff --git a/src/bytecode_util.ml b/src/bytecode_util.ml index aeb1daf1..c7fdc62d 100644 --- a/src/bytecode_util.ml +++ b/src/bytecode_util.ml @@ -82,6 +82,9 @@ let iextern ?loc:(l=Parse_ast.Unknown) clexp id cvals = let icopy l clexp cval = I_aux (I_copy (clexp, cval), (instr_number (), l)) +let ialias l clexp cval = + I_aux (I_alias (clexp, cval), (instr_number (), l)) + let iclear ?loc:(l=Parse_ast.Unknown) ctyp id = I_aux (I_clear (ctyp, id), (instr_number (), l)) @@ -167,6 +170,7 @@ let rec instr_rename from_id to_id (I_aux (instr, aux)) = I_funcall (clexp_rename from_id to_id clexp, extern, id, List.map (cval_rename from_id to_id) args) | I_copy (clexp, cval) -> I_copy (clexp_rename from_id to_id clexp, cval_rename from_id to_id cval) + | I_alias (clexp, cval) -> I_alias (clexp_rename from_id to_id clexp, cval_rename from_id to_id cval) | I_clear (ctyp, id) when Id.compare id from_id = 0 -> I_clear (ctyp, to_id) | I_clear (ctyp, id) -> I_clear (ctyp, id) @@ -447,6 +451,8 @@ let rec pp_instr ?short:(short=false) (I_aux (instr, aux)) = 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_alias (clexp, cval) -> + pp_keyword "alias" ^^ separate space [pp_clexp clexp; string "="; pp_cval cval] | I_clear (ctyp, id) -> pp_keyword "kill" ^^ pp_id id ^^ string " : " ^^ pp_ctyp ctyp | I_return cval -> @@ -574,6 +580,7 @@ let instr_deps = function | 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_copy (clexp, cval) -> cval_deps cval, clexp_deps clexp + | I_alias (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 | I_block _ | I_try_block _ -> NS.empty, NS.empty @@ -698,6 +705,7 @@ let rec map_instr_ctyp f (I_aux (instr, aux)) = | I_funcall (clexp, extern, id, cvals) -> I_funcall (map_clexp_ctyp f clexp, extern, id, List.map (fun (frag, ctyp) -> frag, f ctyp) cvals) | I_copy (clexp, (frag, ctyp)) -> I_copy (map_clexp_ctyp f clexp, (frag, f ctyp)) + | I_alias (clexp, (frag, ctyp)) -> I_alias (map_clexp_ctyp f clexp, (frag, f ctyp)) | I_clear (ctyp, id) -> I_clear (f ctyp, id) | I_return (frag, ctyp) -> I_return (frag, f ctyp) | I_block instrs -> I_block (List.map (map_instr_ctyp f) instrs) @@ -714,7 +722,7 @@ let rec map_instr_ctyp f (I_aux (instr, aux)) = let rec map_instr f (I_aux (instr, aux)) = let instr = match instr with | I_decl _ | I_init _ | I_reset _ | I_reinit _ - | I_funcall _ | I_copy _ | I_clear _ | I_jump _ | I_throw _ | I_return _ + | I_funcall _ | I_copy _ | I_alias _ | I_clear _ | I_jump _ | I_throw _ | I_return _ | I_comment _ | I_label _ | I_goto _ | I_raw _ | I_match_failure | I_undefined _ -> instr | I_if (cval, instrs1, instrs2, ctyp) -> I_if (cval, List.map (map_instr f) instrs1, List.map (map_instr f) instrs2, ctyp) @@ -756,7 +764,7 @@ let rec map_instrs f (I_aux (instr, aux)) = | I_decl _ | I_init _ | I_reset _ | I_reinit _ -> instr | I_if (cval, instrs1, instrs2, ctyp) -> I_if (cval, f (List.map (map_instrs f) instrs1), f (List.map (map_instrs f) instrs2), ctyp) - | I_funcall _ | I_copy _ | I_clear _ | I_jump _ | I_throw _ | I_return _ -> instr + | I_funcall _ | I_copy _ | I_alias _ | I_clear _ | I_jump _ | I_throw _ | I_return _ -> instr | I_block instrs -> I_block (f (List.map (map_instrs f) instrs)) | I_try_block instrs -> I_try_block (f (List.map (map_instrs f) instrs)) | I_comment _ | I_label _ | I_goto _ | I_raw _ | I_match_failure | I_undefined _ -> instr @@ -774,6 +782,28 @@ let rec instr_ids (I_aux (instr, _)) = |> Util.option_these |> IdSet.of_list +let rec instr_reads (I_aux (instr, _)) = + let reads, _ = instr_deps instr in + let get_id = function + | G_id id -> Some id + | _ -> None + in + NS.elements reads + |> List.map get_id + |> Util.option_these + |> IdSet.of_list + +let rec instr_writes (I_aux (instr, _)) = + let _, writes = instr_deps instr in + let get_id = function + | G_id id -> Some id + | _ -> None + in + NS.elements writes + |> List.map get_id + |> Util.option_these + |> IdSet.of_list + let rec filter_instrs f instrs = let filter_instrs' = function | I_aux (I_block instrs, aux) -> I_aux (I_block (filter_instrs f instrs), aux) |