Skip to content

Commit bf82c06

Browse files
DZakhDZakh
committed
Pass is_exception to Blk_extension
1 parent ea8a5f2 commit bf82c06

16 files changed

+40
-29
lines changed

‎jscomp/core/js_dump.ml

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -104,7 +104,7 @@ let exn_block_as_obj ~(stack : bool) (el : J.expression list) (ext : J.tag_info)
104104
: J.expression =
105105
let field_name =
106106
match ext with
107-
| Blk_extension -> (
107+
| Blk_extension _ -> (
108108
fun i ->
109109
match i with 0 -> Literals.exception_id | i -> "_" ^ string_of_int i)
110110
| Blk_record_ext { fields = ss } -> (
@@ -170,7 +170,7 @@ let exp_need_paren (e : J.expression) =
170170
( _,
171171
_,
172172
_,
173-
( Blk_record _ | Blk_module _ | Blk_poly_var _ | Blk_extension
173+
( Blk_record _ | Blk_module _ | Blk_poly_var _ | Blk_extension _
174174
| Blk_record_ext _ | Blk_record_inlined _ | Blk_constructor _ ) )
175175
| Object _ ->
176176
true
@@ -774,7 +774,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
774774
(Lit Literals.polyvar_value, value);
775775
])
776776
| _ -> assert false)
777-
| Caml_block (el, _, _, ((Blk_extension | Blk_record_ext _) as ext)) ->
777+
| Caml_block (el, _, _, ((Blk_extension _ | Blk_record_ext _) as ext)) ->
778778
expression cxt ~level f (exn_block_as_obj ~stack:false el ext)
779779
| Caml_block (el, _, tag, Blk_record_inlined p) ->
780780
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 =
12361236
| Throw e ->
12371237
let e =
12381238
match e.expression_desc with
1239-
| Caml_block (el, _, _, ((Blk_extension | Blk_record_ext _) as ext)) ->
1239+
| Caml_block (el, _, _, ((Blk_extension _ | Blk_record_ext _) as ext)) ->
12401240
{ e with expression_desc = (exn_block_as_obj ~stack:true el ext).expression_desc }
12411241
| exp -> { e with expression_desc = (exn_ref_as_obj exp).expression_desc }
12421242
in

‎jscomp/core/js_exp_make.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -250,7 +250,7 @@ let dummy_obj ?comment (info : Lam_tag_info.t) : t =
250250
*)
251251
match info with
252252
| Blk_record _ | Blk_module _ | Blk_constructor _ | Blk_record_inlined _
253-
| Blk_poly_var _ | Blk_extension | Blk_record_ext _ ->
253+
| Blk_poly_var _ | Blk_extension _ | Blk_record_ext _ ->
254254
{ comment; expression_desc = Object [] }
255255
| Blk_tuple | Blk_module_export _ ->
256256
{ comment; expression_desc = Array ([], Mutable) }

‎jscomp/core/lam_constant_convert.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,7 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t =
6969
Const_some (convert_constant (Ext_list.singleton_exn xs))
7070
| Blk_some -> Const_some (convert_constant (Ext_list.singleton_exn xs))
7171
| Blk_constructor _ | Blk_tuple | Blk_record _ | Blk_module _
72-
| Blk_module_export _ | Blk_extension | Blk_record_inlined _
72+
| Blk_module_export _ | Blk_extension _ | Blk_record_inlined _
7373
| Blk_record_ext _ ->
7474
Const_block (tag, t, Ext_list.map xs convert_constant)
7575
| Blk_poly_var s -> (

‎jscomp/core/lam_convert.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -179,7 +179,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
179179
| Blk_some_not_nested -> prim ~primitive:Psome_not_nest ~args loc
180180
| Blk_some -> prim ~primitive:Psome ~args loc
181181
| Blk_constructor _ | Blk_tuple | Blk_record _ | Blk_record_inlined _
182-
| Blk_module _ | Blk_module_export _ | Blk_extension | Blk_record_ext _ ->
182+
| Blk_module _ | Blk_module_export _ | Blk_extension _ | Blk_record_ext _ ->
183183
prim ~primitive:(Pmakeblock (tag, info, mutable_flag)) ~args loc
184184
| Blk_poly_var s -> (
185185
match args with

‎jscomp/ml/datarepr.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -201,7 +201,7 @@ let extension_descr path_ext ext =
201201
cstr_existentials = existentials;
202202
cstr_args;
203203
cstr_arity = List.length cstr_args;
204-
cstr_tag = Cstr_extension(path_ext);
204+
cstr_tag = Cstr_extension(path_ext, ext.ext_is_exception);
205205
cstr_consts = -1;
206206
cstr_nonconsts = -1;
207207
cstr_private = ext.ext_private;

‎jscomp/ml/env.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -549,7 +549,7 @@ let is_ident = function
549549
| Pdot _ | Papply _ -> false
550550

551551
let is_local_ext = function
552-
| {cstr_tag = Cstr_extension(p)} -> is_ident p
552+
| {cstr_tag = Cstr_extension(p, _)} -> is_ident p
553553
| _ -> false
554554

555555
let diff env1 env2 =

‎jscomp/ml/lambda.ml

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -47,11 +47,15 @@ type tag_info =
4747
| Blk_record of {fields : string array; mutable_flag : Asttypes.mutable_flag; record_repr : record_repr}
4848
| Blk_module of string list
4949
| Blk_module_export of Ident.t list
50-
51-
| Blk_extension
50+
| Blk_extension of {
51+
is_exception: bool;
52+
}
5253
| Blk_some
5354
| Blk_some_not_nested (* ['a option] where ['a] can not inhabit a non-like value *)
54-
| Blk_record_ext of { fields : string array; mutable_flag : Asttypes.mutable_flag}
55+
| Blk_record_ext of {
56+
fields: string array;
57+
mutable_flag: Asttypes.mutable_flag;
58+
}
5559
| Blk_lazy_general
5660

5761
let tag_of_tag_info (tag : tag_info ) =
@@ -63,7 +67,7 @@ let tag_of_tag_info (tag : tag_info ) =
6367
| Blk_record _
6468
| Blk_module _
6569
| Blk_module_export _
66-
| Blk_extension
70+
| Blk_extension _
6771
| Blk_some (* tag not make sense *)
6872
| Blk_some_not_nested (* tag not make sense *)
6973
| Blk_lazy_general (* tag not make sense 248 *)
@@ -81,7 +85,7 @@ let mutable_flag_of_tag_info (tag : tag_info) =
8185
| Blk_poly_var _
8286
| Blk_module _
8387
| Blk_module_export _
84-
| Blk_extension
88+
| Blk_extension _
8589
| Blk_some_not_nested
8690
| Blk_some
8791
-> Immutable

‎jscomp/ml/lambda.mli

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,9 @@ type tag_info =
4646
| Blk_record of {fields : string array; mutable_flag : mutable_flag; record_repr : record_repr }
4747
| Blk_module of string list
4848
| Blk_module_export of Ident.t list
49-
| Blk_extension
49+
| Blk_extension of {
50+
is_exception: bool;
51+
}
5052
(* underlying is the same as tuple, immutable block
5153
{[
5254
exception A of int * int
@@ -60,7 +62,10 @@ type tag_info =
6062

6163
| Blk_some
6264
| Blk_some_not_nested (* ['a option] where ['a] can not inhabit a non-like value *)
63-
| Blk_record_ext of {fields : string array; mutable_flag : mutable_flag}
65+
| Blk_record_ext of {
66+
fields: string array;
67+
mutable_flag: mutable_flag;
68+
}
6469
| Blk_lazy_general
6570

6671
val find_name :

‎jscomp/ml/matching.ml

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2279,7 +2279,7 @@ let get_extension_cases tag_lambda_list =
22792279
| (cstr, act) :: rem ->
22802280
let nonconsts = split_rec rem in
22812281
match cstr with
2282-
| Cstr_extension(path) -> ((path, act) :: nonconsts)
2282+
| Cstr_extension(path, _) -> ((path, act) :: nonconsts)
22832283
| _ -> assert false in
22842284
split_rec tag_lambda_list
22852285

@@ -2918,7 +2918,9 @@ let partial_function loc () =
29182918
let fname =
29192919
Filename.basename fname
29202920
in
2921-
Lprim(Praise Raise_regular, [Lprim(Pmakeblock(Blk_extension),
2921+
Lprim(Praise Raise_regular, [Lprim(Pmakeblock(Blk_extension {
2922+
is_exception = true;
2923+
}),
29222924
[transl_normal_path Predef.path_match_failure;
29232925
Lconst(Const_block(Blk_tuple,
29242926
[Const_base(Const_string (fname, None));

‎jscomp/ml/printlambda.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -106,7 +106,7 @@ let str_of_field_info (fld_info : Lambda.field_dbg_info)=
106106
| Fld_cons -> "cons"
107107
| Fld_array -> "[||]"
108108
let print_taginfo ppf = function
109-
| Blk_extension -> fprintf ppf "ext"
109+
| Blk_extension _ -> fprintf ppf "ext"
110110
| Blk_record_ext {fields = ss} -> fprintf ppf "[%s]" (String.concat ";" (Array.to_list ss) )
111111
| Blk_tuple -> fprintf ppf "tuple"
112112
| Blk_constructor {name ;num_nonconst} -> fprintf ppf "%s/%i" name num_nonconst

‎jscomp/ml/rec_check.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -240,7 +240,7 @@ let rec expression : Env.env -> Typedtree.expression -> Use.t =
240240
| Texp_construct (_, desc, exprs) ->
241241
let access_constructor =
242242
match desc.cstr_tag with
243-
| Cstr_extension (pth) -> Use.inspect (path env pth)
243+
| Cstr_extension (pth, _) -> Use.inspect (path env pth)
244244
| _ -> Use.empty
245245
in
246246
let use =

‎jscomp/ml/translcore.ml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -685,7 +685,7 @@ let assert_failed exp =
685685
( Praise Raise_regular,
686686
[
687687
Lprim
688-
( Pmakeblock Blk_extension,
688+
( Pmakeblock (Blk_extension {is_exception = true}),
689689
[
690690
transl_normal_path Predef.path_assert_failure;
691691
Lconst
@@ -905,9 +905,9 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
905905
in
906906
try Lconst (Const_block (tag_info, List.map extract_constant ll))
907907
with Not_constant -> Lprim (Pmakeblock tag_info, ll, e.exp_loc))
908-
| Cstr_extension (path) ->
908+
| Cstr_extension (path, is_exception) ->
909909
Lprim
910-
( Pmakeblock Blk_extension,
910+
( Pmakeblock (Blk_extension {is_exception}),
911911
transl_extension_path e.exp_env path :: ll,
912912
e.exp_loc ))
913913
| Texp_extension_constructor (_, path) -> transl_extension_path e.exp_env path

‎jscomp/ml/typecore.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2839,7 +2839,7 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg=Rejected) env sexp ty
28392839
} ] ->
28402840
let path =
28412841
match (Typetexp.find_constructor env lid.loc lid.txt).cstr_tag with
2842-
| Cstr_extension (path) -> path
2842+
| Cstr_extension (path, _) -> path
28432843
| _ -> raise (Error (lid.loc, env, Not_an_extension_constructor))
28442844
in
28452845
rue {

‎jscomp/ml/typedecl.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1531,7 +1531,7 @@ let transl_extension_constructor env type_path type_params
15311531
end;
15321532
let path =
15331533
match cdescr.cstr_tag with
1534-
Cstr_extension(path) -> path
1534+
Cstr_extension (path, _) -> path
15351535
| _ -> assert false
15361536
in
15371537
let args =

‎jscomp/ml/types.ml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -282,15 +282,15 @@ and constructor_tag =
282282
Cstr_constant of int (* Constant constructor (an int) *)
283283
| Cstr_block of int (* Regular constructor (a block) *)
284284
| Cstr_unboxed (* Constructor of an unboxed type *)
285-
| Cstr_extension of Path.t (* Extension constructor *)
285+
| Cstr_extension of Path.t * bool (* Extension constructor. true if is_exception *)
286286

287287
let equal_tag t1 t2 =
288288
match (t1, t2) with
289289
| Cstr_constant i1, Cstr_constant i2 -> i2 = i1
290290
| Cstr_block i1, Cstr_block i2 -> i2 = i1
291291
| Cstr_unboxed, Cstr_unboxed -> true
292-
| Cstr_extension (path1), Cstr_extension (path2) ->
293-
Path.same path1 path2
292+
| Cstr_extension (path1, is_exception1), Cstr_extension (path2, is_exception2) ->
293+
Path.same path1 path2 && is_exception1 = is_exception2
294294
| (Cstr_constant _|Cstr_block _|Cstr_unboxed|Cstr_extension _), _ -> false
295295

296296
let may_equal_constr c1 c2 = match c1.cstr_tag,c2.cstr_tag with

‎jscomp/ml/types.mli

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -434,7 +434,7 @@ and constructor_tag =
434434
Cstr_constant of int (* Constant constructor (an int) *)
435435
| Cstr_block of int (* Regular constructor (a block) *)
436436
| Cstr_unboxed (* Constructor of an unboxed type *)
437-
| Cstr_extension of Path.t (* Extension constructor *)
437+
| Cstr_extension of Path.t * bool (* Extension constructor. true if is_exception *)
438438

439439
(* Constructors are the same *)
440440
val equal_tag : constructor_tag -> constructor_tag -> bool

0 commit comments

Comments
 (0)