some more primitive source mapping

jscomp/core/js_dump.ml

@@ -541,8 +541,8 @@ and vident cxt (v : J.vident) =
 
 (* The higher the level, the more likely that inner has to add parens *)
 and expression ~level cxt (exp : J.expression) : cxt =
-  write_sourcemap cxt exp.loc;
   pp_comment_option cxt exp.comment;
+  write_sourcemap cxt exp.loc;
   expression_desc cxt ~level exp.expression_desc
 
 and expression_desc cxt ~(level : int) x : cxt =
@@ -956,8 +956,10 @@ and pp_comment_option cxt comment =
   match comment with None -> () | Some x -> pp_comment cxt x
 
 (* and pp_loc_option f loc =  *)
-and statement top cxt ({ statement_desc = s; comment; _ } : J.statement) : cxt =
+and statement top cxt ({ statement_desc = s; comment; loc } : J.statement) : cxt
+    =
   pp_comment_option cxt comment;
+  write_sourcemap cxt loc;
   statement_desc top cxt s
 
 and statement_desc top cxt (s : J.statement_desc) : cxt =

jscomp/core/js_exp_make.ml

@@ -112,8 +112,8 @@ let runtime_call module_name fn_name args =
     (runtime_var_dot module_name fn_name)
     args
 
-let pure_runtime_call module_name fn_name args =
-  call ~comment:Literals.pure ~info:Js_call_info.builtin_runtime_call
+let pure_runtime_call ?loc module_name fn_name args =
+  call ?loc ~comment:Literals.pure ~info:Js_call_info.builtin_runtime_call
     (runtime_var_dot module_name fn_name)
     args
 
@@ -1201,5 +1201,5 @@ let resolve_and_apply (s : string) (args : t list) : t =
     (runtime_call Js_runtime_modules.external_polyfill "resolve" [ str s ])
     args
 
-let make_exception (s : string) =
-  pure_runtime_call Js_runtime_modules.exceptions Literals.create [ str s ]
+let make_exception ~loc (s : string) =
+  pure_runtime_call ~loc Js_runtime_modules.exceptions Literals.create [ str s ]

jscomp/core/js_exp_make.mli

@@ -76,10 +76,14 @@ val runtime_call :
                                 t
 
 val pure_runtime_call :
-  string -> (* module_name *)
-            string -> (* fn_name *)
-                      t list -> (* args *)
-                                t
+  ?loc:Location.t ->
+  string ->
+  (* module_name *)
+  string ->
+  (* fn_name *)
+  t list ->
+  (* args *)
+  t
 
 val runtime_ref : string -> string -> t
 val public_method_call : string -> t -> t -> Int32.t -> t list -> t
@@ -317,4 +321,4 @@ val is_undef : ?loc:Location.t -> ?comment:string -> t -> t
 val for_sure_js_null_undefined : J.expression -> bool
 val is_null_undefined : ?loc:Location.t -> ?comment:string -> t -> t
 val resolve_and_apply : string -> t list -> t
-val make_exception : string -> t
+val make_exception : loc:Location.t -> string -> t

jscomp/core/js_of_lam_block.ml

@@ -1,5 +1,5 @@
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * 
+ *
  * This program is free software: you can redistribute it and/or modify
  * it under the terms of the GNU Lesser General Public License as published by
  * the Free Software Foundation, either version 3 of the License, or
@@ -17,7 +17,7 @@
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU Lesser General Public License for more details.
- * 
+ *
  * You should have received a copy of the GNU Lesser General Public License
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
@@ -27,10 +27,10 @@ module E = Js_exp_make
 (* TODO: it would be even better, if the [tag_info] contains more information
    about immutablility
 *)
-let make_block mutable_flag (tag_info : Lam_tag_info.t) tag args =
+let make_block ?loc mutable_flag (tag_info : Lam_tag_info.t) tag args =
   match tag_info with
   | Blk_array -> Js_of_lam_array.make_array mutable_flag args
-  | _ -> E.make_block tag tag_info args mutable_flag
+  | _ -> E.make_block ?loc tag tag_info args mutable_flag
 (* | _, (  Tuple | Variant _ ) -> (\** TODO: check with inline record *\) *)
 (*     E.arr Immutable *)
 (*       (E.small_int  ?comment:(Lam_compile_util.comment_of_tag_info tag_info) tag   *)

jscomp/core/js_of_lam_block.mli

@@ -1,5 +1,5 @@
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * 
+ *
  * This program is free software: you can redistribute it and/or modify
  * it under the terms of the GNU Lesser General Public License as published by
  * the Free Software Foundation, either version 3 of the License, or
@@ -17,14 +17,15 @@
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU Lesser General Public License for more details.
- * 
+ *
  * You should have received a copy of the GNU Lesser General Public License
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 (** Utilities for creating block of lambda expression in JS IR *)
 
 val make_block :
+  ?loc:Location.t ->
   Js_op.mutable_flag ->
   Lam_tag_info.t ->
   J.expression ->

jscomp/core/lam_compile.ml

@@ -1443,13 +1443,13 @@ and compile_prim (prim_info : Lam.prim_info)
       | Fld_module { name = field } ->
           compile_external_field lambda_cxt id field
       | _ -> assert false)
-  | { primitive = Praise; args = [ e ]; _ } -> (
+  | { primitive = Praise; args = [ e ]; loc } -> (
       match
         compile_lambda { lambda_cxt with continuation = NeedValue Not_tail } e
       with
       | { block; value = Some v } ->
           Js_output.make
-            (Ext_list.append_one block (S.throw_stmt v))
+            (Ext_list.append_one block (S.throw_stmt ~loc v))
             ~value:E.undefined ~output_finished:True
       (* FIXME -- breaks invariant when NeedValue, reason is that js [throw] is statement
          while ocaml it's an expression, we should remove such things in lambda optimizations

jscomp/core/lam_compile_const.ml

@@ -1,5 +1,5 @@
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * 
+ *
  * This program is free software: you can redistribute it and/or modify
  * it under the terms of the GNU Lesser General Public License as published by
  * the Free Software Foundation, either version 3 of the License, or
@@ -17,7 +17,7 @@
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU Lesser General Public License for more details.
- * 
+ *
  * You should have received a copy of the GNU Lesser General Public License
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
@@ -62,8 +62,8 @@ and translate (x : Lam_constant.t) : J.expression =
          Int64.(to_float max_int);;
          - : float = 9.22337203685477581e+18
        ]}
-       Note we should compile it to Int64 as JS's 
-       speical representation -- 
+       Note we should compile it to Int64 as JS's
+       speical representation --
        it is not representatble in JS number
     *)
       (* E.float (Int64.to_string i) *)

jscomp/core/lam_compile_primitive.ml

@@ -39,8 +39,10 @@ let ensure_value_unit (st : Lam_compile_context.continuation) e : E.t =
 let translate loc (cxt : Lam_compile_context.t) (prim : Lam_primitive.t)
     (args : J.expression list) : J.expression =
   match prim with
-  | Pis_not_none -> Js_of_lam_option.is_not_none (Ext_list.singleton_exn args)
-  | Pcreate_extension s -> E.make_exception s
+  | Pis_not_none ->
+      Js_of_lam_option.is_not_none
+        { (Ext_list.singleton_exn args) with loc = Some loc }
+  | Pcreate_extension s -> E.make_exception ~loc s
   | Pwrap_exn ->
       E.runtime_call Js_runtime_modules.caml_js_exceptions
         "internalToOCamlException" args
@@ -106,7 +108,7 @@ let translate loc (cxt : Lam_compile_context.t) (prim : Lam_primitive.t)
   | Psome_not_nest -> E.optional_not_nest_block (Ext_list.singleton_exn args)
   | Pmakeblock (tag, tag_info, mutable_flag) ->
       (* RUNTIME *)
-      Js_of_lam_block.make_block
+      Js_of_lam_block.make_block ~loc
         (Js_op_util.of_lam_mutable_flag mutable_flag)
         tag_info (E.small_int tag) args
   | Pval_from_option ->
@@ -295,7 +297,7 @@ let translate loc (cxt : Lam_compile_context.t) (prim : Lam_primitive.t)
   (* Test if the argument is a block or an immediate integer *)
   | Pjs_object_create _ -> assert false
   | Pjs_call { arg_types; ffi } ->
-      Lam_compile_external_call.translate_ffi cxt arg_types ffi args
+      Lam_compile_external_call.translate_ffi cxt ~loc arg_types ffi args
   (* FIXME, this can be removed later *)
   | Pisint -> E.is_type_number (Ext_list.singleton_exn args)
   | Pis_poly_var_const -> E.is_type_string (Ext_list.singleton_exn args)