Revert #6611

CHANGELOG.md

@@ -12,6 +12,10 @@
 
 # 12.0.0-alpha.3 (Unreleased)
 
+#### :bug: Bug fix
+
+- Revert Throws an instance of JavaScript's `new Error()` and adds the extension payload for `cause` option introduced in https://github.com/rescript-lang/rescript-compiler/pull/6611. https://github.com/rescript-lang/rescript-compiler/pull/7016
+
 # 12.0.0-alpha.2
 
 #### :rocket: New Feature
@@ -2623,4 +2627,4 @@ Features:
 
 # 1.0.0
 
-Initial release
+Initial release

jscomp/core/js_dump.ml

@@ -97,11 +97,8 @@ 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)
-    : J.expression =
+    : J.expression_desc =
   let field_name =
     match ext with
     | Blk_extension -> (
@@ -111,29 +108,12 @@ 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 =
-    {
-      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;
-    }
+  Object
+    (if stack then
+     Ext_list.mapi_append el
+       (fun i e -> (Js_op.Lit (field_name i), e))
+       [ (Js_op.Lit "Error", E.new_ (E.js_global "Error") []) ]
+    else Ext_list.mapi el (fun i e -> (Js_op.Lit (field_name i), e)))
 
 let rec iter_lst cxt (f : P.t) ls element inter =
   match ls with
@@ -777,7 +757,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
                ])
       | _ -> assert false)
   | Caml_block (el, _, _, ((Blk_extension | Blk_record_ext _) as ext)) ->
-      expression cxt ~level f (exn_block_as_obj ~stack:false el ext)
+      expression_desc cxt ~level f (exn_block_as_obj ~stack:false el ext)
   | Caml_block (el, _, tag, Blk_record_inlined p) ->
       let untagged = Ast_untagged_variants.process_untagged p.attrs in
       let objs =
@@ -1239,8 +1219,8 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt =
       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 }
+            { e with expression_desc = exn_block_as_obj ~stack:true el ext }
+        | _ -> e
       in
       P.string f L.throw;
       P.space f;

jscomp/core/js_dump_lit.ml

@@ -168,9 +168,3 @@ let block_variant = "variant"
 let block_simple_variant = "simpleVariant"
 
 let case = "case"
-
-let cause = "cause"
-
-let error = "Error"
-
-let exception_id = "RE_EXN_ID"

jscomp/core/js_exp_make.ml

@@ -416,7 +416,7 @@ let poly_var_value_access (e : t) =
         comment = None;
       }
 
-let extension_access (e : t) ?name (pos : int32) : t =
+let extension_access (e : t) name (pos : int32) : t =
   match e.expression_desc with
   | Array (l, _) (* Float i -- should not appear here *)
   | Caml_block (l, _, _, _)

jscomp/core/js_exp_make.mli

@@ -170,7 +170,7 @@ val variant_access : t -> int32 -> t
 
 val cons_access : t -> int32 -> t
 
-val extension_access : t -> ?name:string -> Int32.t -> t
+val extension_access : t -> string option -> Int32.t -> t
 
 val record_assign : t -> int32 -> string -> t -> t
 

jscomp/core/js_of_lam_block.ml

@@ -38,8 +38,8 @@ let field (field_info : Lam_compat.field_dbg_info) e (i : int32) =
         e i
   | Fld_poly_var_content -> E.poly_var_value_access e
   | Fld_poly_var_tag -> E.poly_var_tag_access e
-  | Fld_record_extension { name } -> E.extension_access e ~name i
-  | Fld_extension -> E.extension_access e i
+  | Fld_record_extension { name } -> E.extension_access e (Some name) i
+  | Fld_extension -> E.extension_access e None i
   | Fld_variant -> E.variant_access e i
   | Fld_cons -> E.cons_access e i
   | Fld_record_inline { name } -> E.inline_record_access e name i

jscomp/core/lam_convert.ml

@@ -22,17 +22,14 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
+let caml_id_field_info : Lambda.field_dbg_info =
+  Fld_record { name = Literals.exception_id; mutable_flag = Immutable }
+
+let lam_caml_id : Lam_primitive.t = Pfield (0, caml_id_field_info)
 let prim = Lam.prim
 
-let lam_extension_id =
-  let lam_caml_id : Lam_primitive.t =
-    let caml_id_field_info : Lambda.field_dbg_info =
-      Fld_record { name = Js_dump_lit.exception_id; mutable_flag = Immutable }
-    in
-    Pfield (0, caml_id_field_info)
-  in
-  fun loc (head : Lam.t) ->
-    prim ~primitive:lam_caml_id ~args:[ head ] loc
+let lam_extension_id loc (head : Lam.t) =
+  prim ~primitive:lam_caml_id ~args:[ head ] loc
 
 let lazy_block_info : Lam_tag_info.t =
   Blk_record

jscomp/runtime/caml_format.res

@@ -709,7 +709,7 @@ let float_of_string: (string, exn) => float = %raw(`function(s,exn){
         return Infinity;
     if (/^-inf(inity)?$/i.test(s))
         return -Infinity;
-    throw new Error(exn.RE_EXN_ID, { cause: exn });;
+    throw exn;
 }
 `)
 

jscomp/runtime/caml_js_exceptions.res

@@ -29,8 +29,8 @@ type js_error = {cause: exn}
    [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
+  if Caml_exceptions.is_extension(e) {
+    (Obj.magic(e): exn)
   } else {
     JsError(e)
   }

jscomp/runtime/caml_lexer.res

@@ -160,7 +160,7 @@ let caml_lex_engine_aux: (
         if (state < 0) {
             lexbuf.lex_curr_pos = lexbuf.lex_last_pos;
             if (lexbuf.lex_last_action == -1)
-                throw new Error(exn.RE_EXN_ID, { cause: exn })
+                throw exn
             else
                 return lexbuf.lex_last_action;
         }
@@ -308,7 +308,7 @@ let caml_new_lex_engine_aux: (
         if (state < 0) {
             lexbuf.lex_curr_pos = lexbuf.lex_last_pos;
             if (lexbuf.lex_last_action == -1)
-                throw new Error(exn.RE_EXN_ID, { cause: exn });
+                throw exn;
             else
                 return lexbuf.lex_last_action;
         }