fixup! Reference unboxing

Author: vouillon

compiler/lib/ref_unboxing.ml

@@ -37,41 +37,42 @@ let times = Debug.find "times"
 
 let stats = Debug.find "stats"
 
-let rewrite refs block m m' =
-  let m, m', l =
+let rewrite_body unboxed_refs body ref_contents subst =
+  let ref_contents, subst, l =
     List.fold_left
-      ~f:(fun (m, m', acc) i ->
+      ~f:(fun (ref_contents, subst, acc) i ->
         match i with
         | Let (x, Block (0, [| y |], (NotArray | Unknown), Maybe_mutable))
-          when Var.Set.mem x refs -> Var.Map.add x y m, m', acc
-        | Let (y, Field (x, 0, Non_float)) when Var.Map.mem x m ->
-            (* Optimized away by Phisimpl *)
-            m, Var.Map.add y (Var.Map.find x m) m', acc
-        | Offset_ref (x, n) when Var.Map.mem x m ->
-            let y = Var.fresh () in
-            ( Var.Map.add x y m
-            , m'
+          when Var.Set.mem x unboxed_refs -> Var.Map.add x y ref_contents, subst, acc
+        | Let (y, Field (x, 0, Non_float)) when Var.Map.mem x ref_contents ->
+            ref_contents, Var.Map.add y (Var.Map.find x ref_contents) subst, acc
+        | Offset_ref (x, n) when Var.Map.mem x ref_contents ->
+            let y = Var.fork x in
+            ( Var.Map.add x y ref_contents
+            , subst
             , Let
                 ( y
                 , Prim
                     ( Extern "%int_add"
-                    , [ Pv (Var.Map.find x m); Pc (Int (Targetint.of_int_exn n)) ] ) )
+                    , [ Pv (Var.Map.find x ref_contents)
+                      ; Pc (Int (Targetint.of_int_exn n))
+                      ] ) )
               :: acc )
-        | Set_field (x, 0, Non_float, y) when Var.Map.mem x m ->
-            Var.Map.add x y m, m', acc
+        | Set_field (x, 0, Non_float, y) when Var.Map.mem x ref_contents ->
+            Var.Map.add x y ref_contents, subst, acc
         | Event _ -> (
-            ( m
-            , m'
+            ( ref_contents
+            , subst
             , match acc with
               | Event _ :: prev ->
                   (* Avoid consecutive events (keep just the last one) *)
                   i :: prev
               | _ -> i :: acc ))
-        | _ -> m, m', i :: acc)
-      block.body
-      ~init:(m, m', [])
+        | _ -> ref_contents, subst, i :: acc)
+      body
+      ~init:(ref_contents, subst, [])
   in
-  m, m', List.rev l
+  ref_contents, subst, List.rev l
 
 let rewrite_cont relevant_vars vars (pc', args) =
   let refs, _ = Int.Hashtbl.find relevant_vars pc' in
@@ -100,28 +101,29 @@ let rewrite_function p variables pc subst =
   let rec traverse_tree' g pc blocks subst =
     let block = Addr.Map.find pc p.blocks in
     let refs, refs' = Int.Hashtbl.find relevant_vars pc in
-    let vars =
+    let ref_contents =
       Var.Set.fold (fun x m -> Var.Map.add x (Var.fork x) m) refs Var.Map.empty
     in
-    let params = List.map ~f:snd (Var.Map.bindings vars) @ block.params in
-    let vars, subst, body = rewrite refs' block vars subst in
+    let params = List.map ~f:snd (Var.Map.bindings ref_contents) @ block.params in
+    let ref_contents, subst, body = rewrite_body refs' block.body ref_contents subst in
     let branch =
       match block.branch with
       | Return _ | Raise _ | Stop -> block.branch
-      | Branch cont -> Branch (rewrite_cont relevant_vars vars cont)
+      | Branch cont -> Branch (rewrite_cont relevant_vars ref_contents cont)
       | Cond (x, cont, cont') ->
           Cond
             ( x
-            , rewrite_cont relevant_vars vars cont
-            , rewrite_cont relevant_vars vars cont' )
+            , rewrite_cont relevant_vars ref_contents cont
+            , rewrite_cont relevant_vars ref_contents cont' )
       | Switch (x, a) ->
-          Switch (x, Array.map ~f:(fun cont -> rewrite_cont relevant_vars vars cont) a)
+          Switch
+            (x, Array.map ~f:(fun cont -> rewrite_cont relevant_vars ref_contents cont) a)
       | Pushtrap (cont, x, cont') ->
           Pushtrap
-            ( rewrite_cont relevant_vars vars cont
+            ( rewrite_cont relevant_vars ref_contents cont
             , x
-            , rewrite_cont relevant_vars vars cont' )
-      | Poptrap cont -> Poptrap (rewrite_cont relevant_vars vars cont)
+            , rewrite_cont relevant_vars ref_contents cont' )
+      | Poptrap cont -> Poptrap (rewrite_cont relevant_vars ref_contents cont)
     in
     let blocks = Addr.Map.add pc { params; body; branch } blocks in
     Addr.Set.fold

compiler/tests-compiler/loops.ml

@@ -586,11 +586,12 @@ let () = print_endline (trim " ")
      for(;;){
       if(i >= len) break;
       if(! is_space(caml_bytes_unsafe_get(s$0, i))) break;
-      i = i + 1 | 0;
+      var i$0 = i + 1 | 0;
+      i = i$0;
      }
      var j = len - 1 | 0;
      for(;;){
-      if(i <= j && is_space(caml_bytes_unsafe_get(s$0, j))){j = j - 1 | 0; continue;}
+      if(i <= j && is_space(caml_bytes_unsafe_get(s$0, j))){var j$0 = j - 1 | 0; j = j$0; continue;}
       a:
       {
        if(i <= j){