Use RescriptError class for exceptions

rescript-lang · Aug 26, 2024 · 574b53b · 574b53b
1 parent db27059
commit 574b53b
Show file tree

Hide file tree

Showing 4 changed files with 36 additions and 45 deletions.
diff --git a/jscomp/core/js_dump.ml b/jscomp/core/js_dump.ml
@@ -97,10 +97,7 @@ type cxt = Ext_pp_scope.t
 let semi f = P.string f L.semi
 let comma f = P.string f L.comma
 
-let new_error name cause =
-  E.new_ (E.js_global Js_dump_lit.error) [ name; cause ]
-
-let exn_block_as_obj ~(stack : bool) (el : J.expression list) (ext : J.tag_info)
+let exn_block_as_obj ~(is_exception : bool) (el : J.expression list) (ext : J.tag_info)
     : J.expression =
   let field_name =
     match ext with
@@ -111,29 +108,18 @@ let exn_block_as_obj ~(stack : bool) (el : J.expression list) (ext : J.tag_info)
         fun i -> match i with 0 -> Literals.exception_id | i -> ss.(i - 1))
     | _ -> assert false
   in
-    let cause =
+    let extension =
     {
       J.expression_desc =
         Object (List.mapi (fun i e -> (Js_op.Lit (field_name i), e)) el);
       comment = None;
     }
   in
-   if stack then
-      new_error (List.hd el)
-        {
-          J.expression_desc = Object [ (Lit Js_dump_lit.cause, cause) ];
-          comment = None;
-        }
-    else cause
-
-let exn_ref_as_obj e : J.expression =
-  let cause = { J.expression_desc = e; comment = 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;
-    }
+  if is_exception then
+    match el with 
+    | [extension_id] -> E.runtime_call Js_runtime_modules.caml_js_exceptions "internalMakeExn" [extension_id]
+    | _ -> E.runtime_call Js_runtime_modules.caml_js_exceptions "internalFromExtension" [extension]   
+  else extension
 
 let rec iter_lst cxt (f : P.t) ls element inter =
   match ls with
@@ -774,8 +760,8 @@ and expression_desc cxt ~(level : int) f x : cxt =
                  (Lit Literals.polyvar_value, value);
                ])
       | _ -> assert false)
-  | Caml_block (el, _, _, ((Blk_extension _ | Blk_record_ext _) as ext)) ->
-      expression cxt ~level f (exn_block_as_obj ~stack:false el ext)
+  | Caml_block (el, _, _, ((Blk_extension { is_exception } | Blk_record_ext { is_exception}) as ext)) ->
+      expression cxt ~level f (exn_block_as_obj ~is_exception el ext)
   | Caml_block (el, _, tag, Blk_record_inlined p) ->
       let untagged = Ast_untagged_variants.process_untagged p.attrs in
       let objs =
@@ -1234,12 +1220,6 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt =
                   P.newline f;
                   statements false cxt f def))
   | Throw e ->
-      let e =
-        match e.expression_desc with
-        | Caml_block (el, _, _, ((Blk_extension _ | Blk_record_ext _) as ext)) ->
-            { e with expression_desc = (exn_block_as_obj ~stack:true el ext).expression_desc }
-        | exp -> { e with expression_desc = (exn_ref_as_obj exp).expression_desc }
-      in
       P.string f L.throw;
       P.space f;
       P.group f 0 (fun _ ->

diff --git a/jscomp/core/lam_compile_primitive.ml b/jscomp/core/lam_compile_primitive.ml
@@ -79,7 +79,7 @@ let translate output_prefix loc (cxt : Lam_compile_context.t)
   | Pcreate_extension s -> E.make_exception s
   | Pwrap_exn ->
       E.runtime_call Js_runtime_modules.caml_js_exceptions
-        "internalToOCamlException" args
+        "internalAnyToExn" args
   | Praw_js_code { code; code_info } -> E.raw_js_code code_info code
   (* FIXME: save one allocation
      trim can not be done before syntax checking

diff --git a/jscomp/runtime/caml_exceptions.res b/jscomp/runtime/caml_exceptions.res
@@ -89,12 +89,8 @@ let create = (str: string): string => {
 
    This is not a problem in `try .. with` since the logic above is not expressible, see more design in [destruct_exn.md]
 */
-let is_extension = (type a, e: a): bool =>
-  if Js.testAny(e) {
-    false
-  } else {
-    Js.typeof((Obj.magic(e): t).id) == "string"
-  }
+let is_extension = (any: 'a): bool =>
+  Obj.magic(any) && Js.typeof((Obj.magic(any): t).id) === "string"
 
 /** FIXME: remove the trailing `/` */
 let exn_slot_name = (x: t): string => x.id
diff --git a/jscomp/runtime/caml_js_exceptions.res b/jscomp/runtime/caml_js_exceptions.res
@@ -23,17 +23,32 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
 
 exception Error = JsError
-type js_error = {cause: exn}
-/**   
-   This function has to be in this module Since 
-   [Error] is defined here 
-*/
-let internalToOCamlException = (e: unknown) =>
-  if Caml_exceptions.is_extension((Obj.magic(e): js_error).cause) {
-    (Obj.magic(e): js_error).cause
+
+let internalAnyToExn = (any: 'a): exn =>
+  if Obj.magic(any) && Js.typeof(Obj.magic(any)["RE_EXN_ID"]) === "string" {
+    any->Obj.magic
   } else {
-    JsError(e)
+    {
+      "RE_EXN_ID": "JsError",
+      "_1": any,
+    }->Obj.magic
+  }
+
+%%raw(`class RescriptError extends Error {
+  constructor(message) {
+    super(message);
+    this.RE_EXN_ID = message;
   }
+}`)
+
+@new
+external internalMakeExn: string => exn = "RescriptError"
+// Reassign it here from external to let, since RescriptError is not exported
+let internalMakeExn = internalMakeExn
+
+let internalFromExtension = (_ext: 'a): exn => {
+  %raw(`Object.assign(new RescriptError(_ext.RE_EXN_ID), _ext)`)
+}
 
 let as_js_exn = exn =>
   switch exn {