Move source code location resolution from code output to code generation

Author: vouillon

compiler/bin-wasm_of_ocaml/compile.ml

@@ -161,7 +161,7 @@ let generate_prelude ~out_file =
       ~debug
       program
   in
-  Wa_generate.output ch ~context ~debug;
+  Wa_generate.output ch ~context;
   uinfo.provides
 
 let build_prelude z =
@@ -324,7 +324,7 @@ let run
         program
     in
     if standalone then Wa_generate.add_start_function ~context toplevel_name;
-    Wa_generate.output ch ~context ~debug;
+    Wa_generate.output ch ~context;
     if times () then Format.eprintf "compilation: %a@." Timer.print t;
     generated_js
   in

compiler/lib/wasm/wa_ast.ml

@@ -191,7 +191,7 @@ and instruction =
   | StructSet of var * int * expression * expression
   | Return_call of var * expression list
   | Return_call_ref of var * expression * expression list
-  | Location of Code.loc * instruction
+  | Location of Parse_info.t option * instruction
       (** Instruction with attached location information *)
 
 type import_desc =

compiler/lib/wasm/wa_code_generation.ml

@@ -290,11 +290,11 @@ let with_location loc instrs st =
   ( ()
   , { st with
       instrs =
-        (match st.instrs with
-        | [] -> []
-        | Location _ :: _ when Poly.equal loc No -> st.instrs
-        | Location (_, i) :: rem -> Location (loc, i) :: rem
-        | i :: rem -> Location (loc, i) :: rem)
+        (match loc, st.instrs with
+        | _, [] -> []
+        | None, Location _ :: _ -> st.instrs
+        | Some loc, Location (_, i) :: rem -> Location (loc, i) :: rem
+        | _, i :: rem -> Location (Option.value ~default:None loc, i) :: rem)
     } )
 
 let cast ?(nullable = false) typ e =

compiler/lib/wasm/wa_code_generation.mli

@@ -138,7 +138,7 @@ val is_small_constant : Wa_ast.expression -> bool t
 
 val get_i31_value : Wa_ast.var -> Wa_ast.var option t
 
-val with_location : Code.loc -> unit t -> unit t
+val with_location : Parse_info.t option option -> unit t -> unit t
 
 type type_def =
   { supertype : Wa_ast.var option

compiler/lib/wasm/wa_generate.ml

@@ -676,7 +676,9 @@ module Generate (Target : Wa_target_sig.S) = struct
 
   and translate_instr ctx context (i, loc) =
     with_location
-      loc
+      (match loc with
+      | No -> None
+      | _ -> Some (Parse_bytecode.Debug.find_loc ctx.debug loc))
       (match i with
       | Assign (x, y) -> assign x (load y)
       | Let (x, e) ->
@@ -912,7 +914,9 @@ module Generate (Target : Wa_target_sig.S) = struct
           let* () = translate_instrs ctx context block.body in
           let branch, loc = block.branch in
           with_location
-            loc
+            (match loc with
+            | No -> None
+            | _ -> Some (Parse_bytecode.Debug.find_loc ctx.debug loc))
             (match branch with
             | Branch cont -> translate_branch result_typ fall_through pc cont context
             | Return x -> (
@@ -1223,10 +1227,10 @@ let add_init_function =
   let module G = Generate (Wa_gc_target) in
   G.add_init_function
 
-let output ch ~context ~debug =
+let output ch ~context =
   let module G = Generate (Wa_gc_target) in
   let fields = G.output ~context in
-  Wa_wat_output.f ~debug ch fields
+  Wa_wat_output.f ch fields
 
 let wasm_output ch ~context =
   let module G = Generate (Wa_gc_target) in

compiler/lib/wasm/wa_generate.mli

@@ -34,10 +34,6 @@ val add_start_function : context:Wa_code_generation.context -> Wa_ast.var -> uni
 
 val add_init_function : context:Wa_code_generation.context -> to_link:string list -> unit
 
-val output :
-     out_channel
-  -> context:Wa_code_generation.context
-  -> debug:Parse_bytecode.Debug.t
-  -> unit
+val output : out_channel -> context:Wa_code_generation.context -> unit
 
 val wasm_output : out_channel -> context:Wa_code_generation.context -> unit

compiler/lib/wasm/wa_wat_output.ml

@@ -280,10 +280,7 @@ let select i32 i64 f32 f64 op =
   | F32 x -> f32 "32" x
   | F64 x -> f64 "64" x
 
-type ctx =
-  { mutable function_refs : Code.Var.Set.t
-  ; debug : Parse_bytecode.Debug.t
-  }
+type ctx = { mutable function_refs : Code.Var.Set.t }
 
 let reference_function ctx f = ctx.function_refs <- Code.Var.Set.add f ctx.function_refs
 
@@ -523,11 +520,10 @@ let expression_or_instructions ctx st in_function =
             :: List.concat (List.map ~f:expression (l @ [ e ])))
         ]
     | Location (loc, i) -> (
-        let loc = Generate.source_location ctx.debug loc in
         match loc with
-        | Javascript.N | U | Pi Parse_info.{ src = None; _ } ->
+        | None | Some Parse_info.{ src = None | Some ""; _ } ->
             Comment "@" :: instruction i
-        | Pi Parse_info.{ src = Some src; col; line; _ } ->
+        | Some Parse_info.{ src = Some src; col; line; _ } ->
             let loc = Format.sprintf "%s:%d:%d" src line col in
             Comment ("@ " ^ loc) :: instruction i)
   and instructions l = List.concat (List.map ~f:instruction l) in
@@ -630,9 +626,9 @@ let field ctx st f =
   | Type [ t ] -> [ type_field st t ]
   | Type l -> [ List (Atom "rec" :: List.map ~f:(type_field st) l) ]
 
-let f ~debug ch fields =
+let f ch fields =
   let st = build_name_tables fields in
-  let ctx = { function_refs = Code.Var.Set.empty; debug } in
+  let ctx = { function_refs = Code.Var.Set.empty } in
   let other_fields = List.concat (List.map ~f:(fun f -> field ctx st f) fields) in
   let funct_decl =
     let functions = Code.Var.Set.elements ctx.function_refs in

compiler/lib/wasm/wa_wat_output.mli

@@ -16,4 +16,4 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
-val f : debug:Parse_bytecode.Debug.t -> out_channel -> Wa_ast.module_field list -> unit
+val f : out_channel -> Wa_ast.module_field list -> unit