Merge branch 'c_fixes' into sail2

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 =