parent
d0ddf25f3d
commit
f794d799ad
7
Changes
7
Changes
|
@ -652,6 +652,13 @@ OCaml 4.12.0
|
|||
- #9999: fix -dsource printing of the pattern (`A as x | (`B as x)).
|
||||
(Gabriel Scherer, report by Anton Bachin, review by Florian Angeletti)
|
||||
|
||||
- #9970, #10010: fix the declaration scope of extensible-datatype constructors.
|
||||
A regression that dates back to 4.08 makes extensible-datatype constructors
|
||||
with inline records very fragile, for example:
|
||||
type 'a t += X of {x : 'a}
|
||||
(Gabriel Scherer, review by Thomas Refis and Leo White,
|
||||
report by Nicolás Ojeda Bär)
|
||||
|
||||
OCaml 4.11.1
|
||||
------------
|
||||
|
||||
|
|
|
@ -187,6 +187,30 @@ let get_num : type a. a foo -> a -> a option = fun f i1 ->
|
|||
val get_num : 'a foo -> 'a -> 'a option = <fun>
|
||||
|}]
|
||||
|
||||
(* Extensions can have inline records (regression test for #9970) *)
|
||||
type _ inline = ..
|
||||
type 'a inline += X of {x : 'a}
|
||||
;;
|
||||
[%%expect {|
|
||||
type _ inline = ..
|
||||
type 'a inline += X of { x : 'a; }
|
||||
|}]
|
||||
|
||||
let _ = X {x = 1};;
|
||||
[%%expect {|
|
||||
- : int inline = X {x = 1}
|
||||
|}]
|
||||
|
||||
let must_be_polymorphic = fun x -> X {x};;
|
||||
[%%expect {|
|
||||
val must_be_polymorphic : 'a -> 'a inline = <fun>
|
||||
|}]
|
||||
|
||||
let must_be_polymorphic : 'a . 'a -> 'a inline = fun x -> X {x};;
|
||||
[%%expect {|
|
||||
val must_be_polymorphic : 'a -> 'a inline = <fun>
|
||||
|}]
|
||||
|
||||
(* Extensions must obey constraints *)
|
||||
|
||||
type 'a foo = .. constraint 'a = [> `Var ]
|
||||
|
|
|
@ -945,9 +945,8 @@ let transl_type_decl env rec_flag sdecl_list =
|
|||
|
||||
(* Translating type extensions *)
|
||||
|
||||
let transl_extension_constructor env type_path type_params
|
||||
let transl_extension_constructor ~scope env type_path type_params
|
||||
typext_params priv sext =
|
||||
let scope = Ctype.create_scope () in
|
||||
let id = Ident.create_scoped ~scope sext.pext_name.txt in
|
||||
let args, ret_type, kind =
|
||||
match sext.pext_kind with
|
||||
|
@ -1060,10 +1059,10 @@ let transl_extension_constructor env type_path type_params
|
|||
Typedtree.ext_loc = sext.pext_loc;
|
||||
Typedtree.ext_attributes = sext.pext_attributes; }
|
||||
|
||||
let transl_extension_constructor env type_path type_params
|
||||
let transl_extension_constructor ~scope env type_path type_params
|
||||
typext_params priv sext =
|
||||
Builtin_attributes.warning_scope sext.pext_attributes
|
||||
(fun () -> transl_extension_constructor env type_path type_params
|
||||
(fun () -> transl_extension_constructor ~scope env type_path type_params
|
||||
typext_params priv sext)
|
||||
|
||||
let is_rebind ext =
|
||||
|
@ -1072,6 +1071,9 @@ let is_rebind ext =
|
|||
| Text_decl _ -> false
|
||||
|
||||
let transl_type_extension extend env loc styext =
|
||||
(* Note: it would be incorrect to call [create_scope] *after*
|
||||
[reset_type_variables] or after [begin_def] (see #10010). *)
|
||||
let scope = Ctype.create_scope () in
|
||||
reset_type_variables();
|
||||
Ctype.begin_def();
|
||||
let type_path, type_decl =
|
||||
|
@ -1124,7 +1126,7 @@ let transl_type_extension extend env loc styext =
|
|||
(Ctype.instance_list type_decl.type_params)
|
||||
type_params;
|
||||
let constructors =
|
||||
List.map (transl_extension_constructor env type_path
|
||||
List.map (transl_extension_constructor ~scope env type_path
|
||||
type_decl.type_params type_params styext.ptyext_private)
|
||||
styext.ptyext_constructors
|
||||
in
|
||||
|
@ -1180,10 +1182,11 @@ let transl_type_extension extend env loc styext =
|
|||
(fun () -> transl_type_extension extend env loc styext)
|
||||
|
||||
let transl_exception env sext =
|
||||
let scope = Ctype.create_scope () in
|
||||
reset_type_variables();
|
||||
Ctype.begin_def();
|
||||
let ext =
|
||||
transl_extension_constructor env
|
||||
transl_extension_constructor ~scope env
|
||||
Predef.path_exn [] [] Asttypes.Public sext
|
||||
in
|
||||
Ctype.end_def();
|
||||
|
|
Loading…
Reference in New Issue