Remove location from instructions

Author: vouillon

compiler/bin-js_of_ocaml/compile.ml

@@ -242,11 +242,9 @@ let run
         let var_k = Code.Var.fresh () in
         let var_v = Code.Var.fresh () in
         Code.
-          [ Let (var_k, Prim (Extern "caml_jsstring_of_string", [ Pc (String k) ])), noloc
-          ; Let (var_v, Prim (Extern "caml_jsstring_of_string", [ Pc (String v) ])), noloc
-          ; ( Let
-                (Var.fresh (), Prim (Extern "caml_set_static_env", [ Pv var_k; Pv var_v ]))
-            , noloc )
+          [ Let (var_k, Prim (Extern "caml_jsstring_of_string", [ Pc (String k) ]))
+          ; Let (var_v, Prim (Extern "caml_jsstring_of_string", [ Pc (String v) ]))
+          ; Let (Var.fresh (), Prim (Extern "caml_set_static_env", [ Pv var_k; Pv var_v ]))
           ])
   in
   let output

compiler/lib/code.ml

@@ -441,8 +441,8 @@ type last =
 
 type block =
   { params : Var.t list
-  ; body : (instr * loc) list
-  ; branch : last * loc
+  ; body : instr list
+  ; branch : last
   }
 
 type program =
@@ -575,7 +575,7 @@ module Print = struct
     | Prim (p, l) -> prim f p l
     | Special s -> special f s
 
-  let instr f (i, _loc) =
+  let instr f i =
     match i with
     | Let (x, e) -> Format.fprintf f "%a = %a" Var.print x expr e
     | Assign (x, y) -> Format.fprintf f "(assign) %a = %a" Var.print x Var.print y
@@ -588,7 +588,7 @@ module Print = struct
         Format.fprintf f "%a[%a] = %a" Var.print x Var.print y Var.print z
     | Event loc -> Format.fprintf f "event %s" (Parse_info.to_string loc)
 
-  let last f (l, _loc) =
+  let last f l =
     match l with
     | Return x -> Format.fprintf f "return %a" Var.print x
     | Raise (x, `Normal) -> Format.fprintf f "raise %a" Var.print x
@@ -607,8 +607,8 @@ module Print = struct
     | Poptrap c -> Format.fprintf f "poptrap %a" cont c
 
   type xinstr =
-    | Instr of (instr * loc)
-    | Last of (last * loc)
+    | Instr of instr
+    | Last of last
 
   let block annot pc block =
     Format.eprintf "==== %d (%a) ====@." pc var_list block.params;
@@ -627,7 +627,7 @@ end
 let fold_closures p f accu =
   Addr.Map.fold
     (fun _ block accu ->
-      List.fold_left block.body ~init:accu ~f:(fun accu (i, _loc) ->
+      List.fold_left block.body ~init:accu ~f:(fun accu i ->
           match i with
           | Let (x, Closure (params, cont)) -> f (Some x) params cont accu
           | _ -> accu))
@@ -648,12 +648,12 @@ let prepend ({ start; blocks; free_pc } as p) body =
       | exception Not_found ->
           let new_start = free_pc in
           let blocks =
-            Addr.Map.add new_start { params = []; body; branch = Stop, noloc } blocks
+            Addr.Map.add new_start { params = []; body; branch = Stop } blocks
           in
           let free_pc = free_pc + 1 in
           { start = new_start; blocks; free_pc })
 
-let empty_block = { params = []; body = []; branch = Stop, noloc }
+let empty_block = { params = []; body = []; branch = Stop }
 
 let empty =
   let start = 0 in
@@ -666,10 +666,9 @@ let is_empty p =
   | 1 -> (
       let _, v = Addr.Map.choose p.blocks in
       match v with
-      | { body; branch = Stop, _; params = _ } -> (
+      | { body; branch = Stop; params = _ } -> (
           match body with
-          | ([] | [ (Let (_, Prim (Extern "caml_get_global_data", _)), _) ]) when true ->
-              true
+          | ([] | [ Let (_, Prim (Extern "caml_get_global_data", _)) ]) when true -> true
           | _ -> false)
       | _ -> false)
   | _ -> false
@@ -681,7 +680,7 @@ let poptraps blocks pc =
     else
       let visited = Addr.Set.add pc visited in
       let block = Addr.Map.find pc blocks in
-      match fst block.branch with
+      match block.branch with
       | Return _ | Raise _ | Stop -> acc, visited
       | Branch (pc', _) -> loop blocks pc' visited depth acc
       | Poptrap (pc', _) ->
@@ -709,7 +708,7 @@ let poptraps blocks pc =
 
 let fold_children blocks pc f accu =
   let block = Addr.Map.find pc blocks in
-  match fst block.branch with
+  match block.branch with
   | Return _ | Raise _ | Stop -> accu
   | Branch (pc', _) | Poptrap (pc', _) -> f pc' accu
   | Pushtrap ((pc', _), _, (pc_h, _)) ->
@@ -726,7 +725,7 @@ let fold_children blocks pc f accu =
 
 let fold_children_skip_try_body blocks pc f accu =
   let block = Addr.Map.find pc blocks in
-  match fst block.branch with
+  match block.branch with
   | Return _ | Raise _ | Stop -> accu
   | Branch (pc', _) | Poptrap (pc', _) -> f pc' accu
   | Pushtrap ((pc', _), _, (pc_h, _)) ->
@@ -789,7 +788,7 @@ let fold_closures_innermost_first { start; blocks; _ } f accu =
         let block = Addr.Map.find pc blocks in
         List.fold_left block.body ~init:accu ~f:(fun accu i ->
             match i with
-            | Let (x, Closure (params, cont)), _ ->
+            | Let (x, Closure (params, cont)) ->
                 let accu = visit blocks (fst cont) f accu in
                 f (Some x) params cont accu
             | _ -> accu))
@@ -808,7 +807,7 @@ let fold_closures_outermost_first { start; blocks; _ } f accu =
         let block = Addr.Map.find pc blocks in
         List.fold_left block.body ~init:accu ~f:(fun accu i ->
             match i with
-            | Let (x, Closure (params, cont)), _ ->
+            | Let (x, Closure (params, cont)) ->
                 let accu = f (Some x) params cont accu in
                 visit blocks (fst cont) f accu
             | _ -> accu))
@@ -879,7 +878,7 @@ let invariant { blocks; start; _ } =
       | Prim (_, args) -> List.iter ~f:check_prim_arg args
       | Special _ -> ()
     in
-    let check_instr (i, _loc) =
+    let check_instr i =
       match i with
       | Let (x, e) ->
           define x;
@@ -892,11 +891,11 @@ let invariant { blocks; start; _ } =
     in
     let rec check_events l =
       match l with
-      | (Event _, _) :: (Event _, _) :: _ -> assert false
+      | Event _ :: Event _ :: _ -> assert false
       | _ :: r -> check_events r
       | [] -> ()
     in
-    let check_last (l, _loc) =
+    let check_last l =
       match l with
       | Return _ -> ()
       | Raise _ -> ()

compiler/lib/code.mli

@@ -239,8 +239,8 @@ type last =
 
 type block =
   { params : Var.t list
-  ; body : (instr * loc) list
-  ; branch : last * loc
+  ; body : instr list
+  ; branch : last
   }
 
 type program =
@@ -251,22 +251,22 @@ type program =
 
 module Print : sig
   type xinstr =
-    | Instr of (instr * loc)
-    | Last of (last * loc)
+    | Instr of instr
+    | Last of last
 
   val expr : Format.formatter -> expr -> unit
 
   val constant : Format.formatter -> constant -> unit
 
   val var_list : Format.formatter -> Var.t list -> unit
 
-  val instr : Format.formatter -> instr * loc -> unit
+  val instr : Format.formatter -> instr -> unit
 
   val block : (Addr.Map.key -> xinstr -> string) -> int -> block -> unit
 
   val program : (Addr.Map.key -> xinstr -> string) -> program -> unit
 
-  val last : Format.formatter -> last * loc -> unit
+  val last : Format.formatter -> last -> unit
 
   val cont : Format.formatter -> cont -> unit
 end
@@ -310,7 +310,7 @@ val traverse :
 val preorder_traverse :
   fold_blocs_poly -> (Addr.t -> 'c -> 'c) -> Addr.t -> block Addr.Map.t -> 'c -> 'c
 
-val prepend : program -> (instr * loc) list -> program
+val prepend : program -> instr list -> program
 
 val empty : program
 

compiler/lib/deadcode.ml

@@ -87,7 +87,7 @@ and mark_reachable st pc =
   then (
     st.reachable_blocks <- Addr.Set.add pc st.reachable_blocks;
     let block = Addr.Map.find pc st.blocks in
-    List.iter block.body ~f:(fun (i, _loc) ->
+    List.iter block.body ~f:(fun i ->
         match i with
         | Let (_, e) -> if not (pure_expr st.pure_funs e) then mark_expr st e
         | Event _ | Assign _ -> ()
@@ -104,7 +104,7 @@ and mark_reachable st pc =
             mark_var st y;
             mark_var st z
         | Offset_ref (x, _) -> mark_var st x);
-    match fst block.branch with
+    match block.branch with
     | Return x | Raise (x, _) -> mark_var st x
     | Stop -> ()
     | Branch cont | Poptrap cont -> mark_cont_reachable st cont
@@ -143,20 +143,17 @@ let filter_closure blocks st i =
   | Let (x, Closure (l, cont)) -> Let (x, Closure (l, filter_cont blocks st cont))
   | _ -> i
 
-let filter_live_last blocks st (l, loc) =
-  let l =
-    match l with
-    | Return _ | Raise _ | Stop -> l
-    | Branch cont -> Branch (filter_cont blocks st cont)
-    | Cond (x, cont1, cont2) ->
-        Cond (x, filter_cont blocks st cont1, filter_cont blocks st cont2)
-    | Switch (x, a1) ->
-        Switch (x, Array.map a1 ~f:(fun cont -> filter_cont blocks st cont))
-    | Pushtrap (cont1, x, cont2) ->
-        Pushtrap (filter_cont blocks st cont1, x, filter_cont blocks st cont2)
-    | Poptrap cont -> Poptrap (filter_cont blocks st cont)
-  in
-  l, loc
+let filter_live_last blocks st l =
+  match l with
+  | Return _ | Raise _ | Stop -> l
+  | Branch cont -> Branch (filter_cont blocks st cont)
+  | Cond (x, cont1, cont2) ->
+      Cond (x, filter_cont blocks st cont1, filter_cont blocks st cont2)
+  | Switch (x, a1) -> Switch (x, Array.map a1 ~f:(fun cont -> filter_cont blocks st cont))
+  | Pushtrap (cont1, x, cont2) ->
+      Pushtrap (filter_cont blocks st cont1, x, filter_cont blocks st cont2)
+  | Poptrap cont -> Poptrap (filter_cont blocks st cont)
+
 (****)
 
 let ref_count st i =
@@ -170,7 +167,7 @@ let annot st pc xi =
   else
     match (xi : Code.Print.xinstr) with
     | Last _ -> " "
-    | Instr (i, _) ->
+    | Instr i ->
         let c = ref_count st i in
         if c > 0 then Format.sprintf "%d" c else if live_instr st i then " " else "x"
 
@@ -197,13 +194,13 @@ let f ({ blocks; _ } as p : Code.program) =
   let pure_funs = Pure_fun.f p in
   Addr.Map.iter
     (fun _ block ->
-      List.iter block.body ~f:(fun (i, _loc) ->
+      List.iter block.body ~f:(fun i ->
           match i with
           | Let (x, e) -> add_def defs x (Expr e)
           | Assign (x, y) -> add_def defs x (Var y)
           | Event _ | Set_field (_, _, _, _) | Array_set (_, _, _) | Offset_ref (_, _) ->
               ());
-      match fst block.branch with
+      match block.branch with
       | Return _ | Raise _ | Stop -> ()
       | Branch cont -> add_cont_dep blocks defs cont
       | Cond (_, cont1, cont2) ->
@@ -229,14 +226,14 @@ let f ({ blocks; _ } as p : Code.program) =
             pc
             { params = List.filter block.params ~f:(fun x -> st.live.(Var.idx x) > 0)
             ; body =
-                List.fold_left block.body ~init:[] ~f:(fun acc (i, loc) ->
+                List.fold_left block.body ~init:[] ~f:(fun acc i ->
                     match i, acc with
-                    | Event _, (Event _, _) :: prev ->
+                    | Event _, Event _ :: prev ->
                         (* Avoid consecutive events (keep just the last one) *)
-                        (i, loc) :: prev
+                        i :: prev
                     | _ ->
                         if live_instr st i
-                        then (filter_closure all_blocks st i, loc) :: acc
+                        then filter_closure all_blocks st i :: acc
                         else acc)
                 |> List.rev
             ; branch = filter_live_last all_blocks st block.branch

compiler/lib/duplicate.ml

@@ -46,22 +46,19 @@ let instr s i =
   | Array_set (x, y, z) -> Array_set (s x, s y, s z)
   | Event _ -> i
 
-let instrs s l = List.map l ~f:(fun (i, loc) -> instr s i, loc)
+let instrs s l = List.map l ~f:(fun i -> instr s i)
 
-let last m s (l, loc) =
-  let l =
-    match l with
-    | Stop -> l
-    | Branch cont -> Branch (subst_cont m s cont)
-    | Pushtrap (cont1, x, cont2) ->
-        Pushtrap (subst_cont m s cont1, s x, subst_cont m s cont2)
-    | Return x -> Return (s x)
-    | Raise (x, k) -> Raise (s x, k)
-    | Cond (x, cont1, cont2) -> Cond (s x, subst_cont m s cont1, subst_cont m s cont2)
-    | Switch (x, a1) -> Switch (s x, Array.map a1 ~f:(fun cont -> subst_cont m s cont))
-    | Poptrap cont -> Poptrap (subst_cont m s cont)
-  in
-  l, loc
+let last m s l =
+  match l with
+  | Stop -> l
+  | Branch cont -> Branch (subst_cont m s cont)
+  | Pushtrap (cont1, x, cont2) ->
+      Pushtrap (subst_cont m s cont1, s x, subst_cont m s cont2)
+  | Return x -> Return (s x)
+  | Raise (x, k) -> Raise (s x, k)
+  | Cond (x, cont1, cont2) -> Cond (s x, subst_cont m s cont1, subst_cont m s cont2)
+  | Switch (x, a1) -> Switch (s x, Array.map a1 ~f:(fun cont -> subst_cont m s cont))
+  | Poptrap cont -> Poptrap (subst_cont m s cont)
 
 let block m s block =
   { params = List.map ~f:s block.params