Pass is_exception to Blk_extension

Author: DZakh

jscomp/core/js_dump.ml

@@ -104,7 +104,7 @@ let exn_block_as_obj ~(stack : bool) (el : J.expression list) (ext : J.tag_info)
  : J.expression =
  let field_name =
  match ext with
- | Blk_extension -> (
+ | Blk_extension _ -> (
  fun i ->
  match i with 0 -> Literals.exception_id | i -> "_" ^ string_of_int i)
  | Blk_record_ext { fields = ss } -> (
@@ -170,7 +170,7 @@ let exp_need_paren (e : J.expression) =
  ( _,
  _,
  _,
- ( Blk_record _ | Blk_module _ | Blk_poly_var _ | Blk_extension
+ ( Blk_record _ | Blk_module _ | Blk_poly_var _ | Blk_extension _
  | Blk_record_ext _ | Blk_record_inlined _ | Blk_constructor _ ) )
  | Object _ ->
  true
@@ -774,7 +774,7 @@ 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)) ->
+ | 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, _, tag, Blk_record_inlined p) ->
  let untagged = Ast_untagged_variants.process_untagged p.attrs in
@@ -1236,7 +1236,7 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt =
  | Throw e ->
  let e =
  match e.expression_desc with
- | Caml_block (el, _, _, ((Blk_extension | Blk_record_ext _) as ext)) ->
+ | 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

jscomp/core/js_exp_make.ml

@@ -250,7 +250,7 @@ let dummy_obj ?comment (info : Lam_tag_info.t) : t =
  *)
  match info with
  | Blk_record _ | Blk_module _ | Blk_constructor _ | Blk_record_inlined _
- | Blk_poly_var _ | Blk_extension | Blk_record_ext _ ->
+ | Blk_poly_var _ | Blk_extension _ | Blk_record_ext _ ->
  { comment; expression_desc = Object [] }
  | Blk_tuple | Blk_module_export _ ->
  { comment; expression_desc = Array ([], Mutable) }

jscomp/core/lam_constant_convert.ml

@@ -69,7 +69,7 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t =
  Const_some (convert_constant (Ext_list.singleton_exn xs))
  | Blk_some -> Const_some (convert_constant (Ext_list.singleton_exn xs))
  | Blk_constructor _ | Blk_tuple | Blk_record _ | Blk_module _
- | Blk_module_export _ | Blk_extension | Blk_record_inlined _
+ | Blk_module_export _ | Blk_extension _ | Blk_record_inlined _
  | Blk_record_ext _ ->
  Const_block (tag, t, Ext_list.map xs convert_constant)
  | Blk_poly_var s -> (

jscomp/core/lam_convert.ml

@@ -179,7 +179,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
  | Blk_some_not_nested -> prim ~primitive:Psome_not_nest ~args loc
  | Blk_some -> prim ~primitive:Psome ~args loc
  | Blk_constructor _ | Blk_tuple | Blk_record _ | Blk_record_inlined _
- | Blk_module _ | Blk_module_export _ | Blk_extension | Blk_record_ext _ ->
+ | Blk_module _ | Blk_module_export _ | Blk_extension _ | Blk_record_ext _ ->
  prim ~primitive:(Pmakeblock (tag, info, mutable_flag)) ~args loc
  | Blk_poly_var s -> (
  match args with

jscomp/ml/datarepr.ml

@@ -201,7 +201,7 @@ let extension_descr path_ext ext =
  cstr_existentials = existentials;
  cstr_args;
  cstr_arity = List.length cstr_args;
- cstr_tag = Cstr_extension(path_ext);
+ cstr_tag = Cstr_extension(path_ext, ext.ext_is_exception);
  cstr_consts = -1;
  cstr_nonconsts = -1;
  cstr_private = ext.ext_private;

jscomp/ml/env.ml

@@ -549,7 +549,7 @@ let is_ident = function
  | Pdot _ | Papply _ -> false
 
 let is_local_ext = function
- | {cstr_tag = Cstr_extension(p)} -> is_ident p
+ | {cstr_tag = Cstr_extension(p, _)} -> is_ident p
  | _ -> false
 
 let diff env1 env2 =

jscomp/ml/lambda.ml

@@ -47,11 +47,15 @@ type tag_info =
  | Blk_record of {fields : string array; mutable_flag : Asttypes.mutable_flag; record_repr : record_repr} 
  | Blk_module of string list
  | Blk_module_export of Ident.t list
-
- | Blk_extension 
+ | Blk_extension of {
+ is_exception: bool;
+ }
  | Blk_some
  | Blk_some_not_nested (* ['a option] where ['a] can not inhabit a non-like value *)
- | Blk_record_ext of { fields : string array; mutable_flag : Asttypes.mutable_flag}
+ | Blk_record_ext of {
+ fields: string array;
+ mutable_flag: Asttypes.mutable_flag;
+ }
  | Blk_lazy_general
 
 let tag_of_tag_info (tag : tag_info ) = 
@@ -63,7 +67,7 @@ let tag_of_tag_info (tag : tag_info ) =
  | Blk_record _ 
  | Blk_module _ 
  | Blk_module_export _ 
- | Blk_extension 
+ | Blk_extension _
  | Blk_some (* tag not make sense *)
  | Blk_some_not_nested (* tag not make sense *)
  | Blk_lazy_general (* tag not make sense 248 *)
@@ -81,7 +85,7 @@ let mutable_flag_of_tag_info (tag : tag_info) =
  | Blk_poly_var _ 
  | Blk_module _
  | Blk_module_export _ 
- | Blk_extension
+ | Blk_extension _
  | Blk_some_not_nested
  | Blk_some 
  -> Immutable

jscomp/ml/lambda.mli

@@ -46,7 +46,9 @@ type tag_info =
  | Blk_record of {fields : string array; mutable_flag : mutable_flag; record_repr : record_repr }
  | Blk_module of string list
  | Blk_module_export of Ident.t list 
- | Blk_extension
+ | Blk_extension of {
+ is_exception: bool;
+ }
  (* underlying is the same as tuple, immutable block
  {[
  exception A of int * int 
@@ -60,7 +62,10 @@ type tag_info =
 
  | Blk_some
  | Blk_some_not_nested (* ['a option] where ['a] can not inhabit a non-like value *)
- | Blk_record_ext of {fields : string array; mutable_flag : mutable_flag}
+ | Blk_record_ext of {
+ fields: string array;
+ mutable_flag: mutable_flag;
+ }
  | Blk_lazy_general 
 
 val find_name :

jscomp/ml/matching.ml

@@ -2279,7 +2279,7 @@ let get_extension_cases tag_lambda_list =
  | (cstr, act) :: rem ->
  let nonconsts = split_rec rem in
  match cstr with
- | Cstr_extension(path) -> ((path, act) :: nonconsts)
+ | Cstr_extension(path, _) -> ((path, act) :: nonconsts)
  | _ -> assert false in
  split_rec tag_lambda_list
 
@@ -2918,7 +2918,9 @@ let partial_function loc () =
  let fname = 
  Filename.basename fname
  in 
- Lprim(Praise Raise_regular, [Lprim(Pmakeblock(Blk_extension),
+ Lprim(Praise Raise_regular, [Lprim(Pmakeblock(Blk_extension {
+ is_exception = true;
+ }),
  [transl_normal_path Predef.path_match_failure;
  Lconst(Const_block(Blk_tuple,
  [Const_base(Const_string (fname, None));

jscomp/ml/printlambda.ml

@@ -106,7 +106,7 @@ let str_of_field_info (fld_info : Lambda.field_dbg_info)=
  | Fld_cons -> "cons"
  | Fld_array -> "[||]" 
 let print_taginfo ppf = function
- | Blk_extension -> fprintf ppf "ext" 
+ | Blk_extension _ -> fprintf ppf "ext" 
  | Blk_record_ext {fields = ss} -> fprintf ppf "[%s]" (String.concat ";" (Array.to_list ss) )
  | Blk_tuple -> fprintf ppf "tuple"
  | Blk_constructor {name ;num_nonconst} -> fprintf ppf "%s/%i" name num_nonconst