feat: throw a dedicated instance of MelangeError instead of Error

jscomp/core/js_block_runtime.ml

@@ -24,11 +24,18 @@
 
 open Import
 
-let option_id = Ident.create_persistent Js_runtime_modules.option
-let curry_id = Ident.create_persistent Js_runtime_modules.curry
+let check_additional_id =
+  let option_id = Some (Ident.create_persistent Js_runtime_modules.option)
+  and curry_id = Some (Ident.create_persistent Js_runtime_modules.curry) in
+  fun (x : J.expression) : Ident.t option ->
+    match x.expression_desc with
+    | Optional_block (_, false) -> option_id
+    | Call (_, _, { arity = NA; _ }) -> curry_id
+    | _ -> None
 
-let check_additional_id (x : J.expression) : Ident.t option =
-  match x.expression_desc with
-  | Optional_block (_, false) -> Some option_id
-  | Call (_, _, { arity = NA; _ }) -> Some curry_id
-  | _ -> None
+let check_additional_statement_id =
+  let js_exceptions_id =
+    Some (Ident.create_persistent Js_runtime_modules.caml_js_exceptions)
+  in
+  fun (x : J.statement) : Ident.t option ->
+    match x.statement_desc with Throw _ -> js_exceptions_id | _ -> None

jscomp/core/js_block_runtime.mli

@@ -1,5 +1,5 @@
 (* Copyright (C) 2019- Authors of ReScript
- * 
+ *
  * 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,9 +17,10 @@
  * 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. *)
 
 val check_additional_id : J.expression -> Ident.t option
+val check_additional_statement_id : J.statement -> Ident.t option

jscomp/core/js_dump.ml

@@ -131,7 +131,10 @@ let semi cxt = string cxt L.semi
 let comma cxt = string cxt L.comma
 
 let new_error name cause =
-  E.new_ (E.js_global Js_dump_lit.error) [ name; cause ]
+  E.new_
+    (E.runtime_var_dot Js_runtime_modules.caml_js_exceptions
+       Js_dump_lit.melange_error)
+    [ name; cause ]
 
 let exn_block_as_obj ~(stack : bool) (el : J.expression list) (ext : J.tag_info)
     : J.expression =
@@ -151,24 +154,10 @@ let exn_block_as_obj ~(stack : bool) (el : J.expression list) (ext : J.tag_info)
       loc = None;
     }
   in
-  if stack then
-    new_error (List.hd el)
-      {
-        J.expression_desc = Object [ (Lit Js_dump_lit.cause, cause) ];
-        comment = None;
-        loc = None;
-      }
-  else cause
-
-let exn_ref_as_obj e : J.expression =
-  let cause = { J.expression_desc = e; comment = None; loc = None } in
-  new_error
-    (E.record_access cause Js_dump_lit.exception_id 0l)
-    {
-      J.expression_desc = Object [ (Lit Js_dump_lit.cause, cause) ];
-      comment = None;
-      loc = None;
-    }
+  if stack then new_error (List.hd el) cause else cause
+
+let exn_ref_as_obj cause : J.expression =
+  new_error (E.record_access cause Js_dump_lit.exception_id 0l) cause
 
 let rec iter_lst cxt ls element inter =
   match ls with
@@ -1245,8 +1234,7 @@ and statement_desc top cxt (s : J.statement_desc) : cxt =
               expression_desc =
                 (exn_block_as_obj ~stack:true el ext).expression_desc;
             }
-        | exp ->
-            { e with expression_desc = (exn_ref_as_obj exp).expression_desc }
+        | _ -> { e with expression_desc = (exn_ref_as_obj e).expression_desc }
       in
       string cxt L.throw;
       space cxt;

jscomp/core/js_dump_lit.ml

@@ -80,8 +80,7 @@ let minus_minus = "--"
 (** debug symbols *)
 
 let case = "case"
-let cause = "cause"
-let error = "Error"
+let melange_error = "MelangeError"
 let exception_id = "MEL_EXN_ID"
 let polyvar_hash = "NAME"
 let polyvar_value = "VAL"

jscomp/core/js_fold_basic.ml

@@ -38,6 +38,14 @@ let count_hard_dependencies hard_dependencies =
               (Lam_module_ident.of_runtime id)
         | _ -> ());
         super.expression self x);
+    statement =
+      (fun self x ->
+        (match Js_block_runtime.check_additional_statement_id x with
+        | Some id ->
+            add_lam_module_ident hard_dependencies
+              (Lam_module_ident.of_runtime id)
+        | _ -> ());
+        super.statement self x);
   }
 
 let calculate_hard_dependencies block =

jscomp/runtime/caml_js_exceptions.ml

@@ -17,3 +17,32 @@ let internalToOCamlException (e : Obj.t) =
   else Error (Any e)
 
 let caml_as_js_exn exn = match exn with Error t -> Some t | _ -> None
+
+let[@mel.as MelangeError] melangeError =
+  [%mel.raw
+    {|
+function MelangeError(message, cause) {
+  var _this = Error.call(this, message, { cause: cause });
+
+  if (_this.cause == null) {
+    Object.defineProperty(_this, 'cause', {
+      configurable : true,
+      enumerable : false,
+      writable : true,
+      value : cause
+    });
+  }
+  Object.defineProperty(_this, 'name', {
+    configurable : true,
+    enumerable : false,
+    writable : true,
+    value : 'MelangeError'
+  })
+
+  return _this;
+}
+|}]
+
+[%%mel.raw {|
+MelangeError.prototype = Error.prototype;
+|}]