pattern aliases do not ignore type constraints (#1655)
parent
5940632496
commit
4edc4b9928
3
Changes
3
Changes
|
@ -3,6 +3,9 @@ Working version
|
||||||
|
|
||||||
### Language features:
|
### Language features:
|
||||||
|
|
||||||
|
- #1655: pattern aliases do not ignore type constraints
|
||||||
|
(Thomas Refis, review by Jacques Garrigue and Gabriel Scherer)
|
||||||
|
|
||||||
* #9500, #9727: Injectivity annotations
|
* #9500, #9727: Injectivity annotations
|
||||||
One can now mark type parameters as injective, which is useful for
|
One can now mark type parameters as injective, which is useful for
|
||||||
abstract types:
|
abstract types:
|
||||||
|
|
|
@ -233,11 +233,7 @@ let simple_merged_annotated_return_annotated (type a) (t : a t) (a : a) =
|
||||||
;;
|
;;
|
||||||
|
|
||||||
[%%expect{|
|
[%%expect{|
|
||||||
Lines 3-4, characters 4-30:
|
val simple_merged_annotated_return_annotated : 'a t -> 'a -> unit = <fun>
|
||||||
3 | ....IntLit, ((3 : a) as x)
|
|
||||||
4 | | BoolLit, ((true : a) as x)............
|
|
||||||
Error: The variable x on the left-hand side of this or-pattern has type
|
|
||||||
a but on the right-hand side it has type bool
|
|
||||||
|}]
|
|}]
|
||||||
|
|
||||||
(* test more scenarios: when the or-pattern itself is not at toplevel but under
|
(* test more scenarios: when the or-pattern itself is not at toplevel but under
|
||||||
|
@ -579,12 +575,7 @@ let lambiguity (type a) (t2 : a t2) =
|
||||||
;;
|
;;
|
||||||
|
|
||||||
[%%expect{|
|
[%%expect{|
|
||||||
Line 3, characters 8-22:
|
val lambiguity : 'a t2 -> 'a = <fun>
|
||||||
3 | | Int ((_ : a) as x)
|
|
||||||
^^^^^^^^^^^^^^
|
|
||||||
Error: This pattern matches values of type a
|
|
||||||
This instance of a is ambiguous:
|
|
||||||
it would escape the scope of its equation
|
|
||||||
|}]
|
|}]
|
||||||
|
|
||||||
let rambiguity (type a) (t2 : a t2) =
|
let rambiguity (type a) (t2 : a t2) =
|
||||||
|
@ -594,12 +585,11 @@ let rambiguity (type a) (t2 : a t2) =
|
||||||
;;
|
;;
|
||||||
|
|
||||||
[%%expect{|
|
[%%expect{|
|
||||||
Line 4, characters 9-23:
|
Lines 3-4, characters 4-23:
|
||||||
4 | | Bool ((_ : a) as x) -> x
|
3 | ....Int (_ as x)
|
||||||
^^^^^^^^^^^^^^
|
4 | | Bool ((_ : a) as x).....
|
||||||
Error: This pattern matches values of type a
|
Error: The variable x on the left-hand side of this or-pattern has type
|
||||||
This instance of a is ambiguous:
|
int but on the right-hand side it has type a
|
||||||
it would escape the scope of its equation
|
|
||||||
|}]
|
|}]
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -362,7 +362,7 @@ val foo : int foo -> int = <fun>
|
||||||
Line 3, characters 26-31:
|
Line 3, characters 26-31:
|
||||||
3 | | { x = (x : int); eq = Refl3 } -> x
|
3 | | { x = (x : int); eq = Refl3 } -> x
|
||||||
^^^^^
|
^^^^^
|
||||||
Warning 18: typing this pattern requires considering M.t and N.t as equal.
|
Warning 18: typing this pattern requires considering M.t and int as equal.
|
||||||
But the knowledge of these types is not principal.
|
But the knowledge of these types is not principal.
|
||||||
val foo : int foo -> int = <fun>
|
val foo : int foo -> int = <fun>
|
||||||
|}]
|
|}]
|
||||||
|
|
|
@ -0,0 +1,155 @@
|
||||||
|
(* TEST
|
||||||
|
* expect
|
||||||
|
*)
|
||||||
|
|
||||||
|
let f = function
|
||||||
|
| ([] : int list) as x -> x
|
||||||
|
| _ :: _ -> assert false;;
|
||||||
|
[%%expect{|
|
||||||
|
val f : int list -> int list = <fun>
|
||||||
|
|}]
|
||||||
|
|
||||||
|
let f =
|
||||||
|
let f' = function
|
||||||
|
| ([] : 'a list) as x -> x
|
||||||
|
| _ :: _ -> assert false
|
||||||
|
in
|
||||||
|
f', f';;
|
||||||
|
[%%expect{|
|
||||||
|
val f : ('a list -> 'a list) * ('a list -> 'a list) = (<fun>, <fun>)
|
||||||
|
|}]
|
||||||
|
|
||||||
|
let f =
|
||||||
|
let f' = function
|
||||||
|
| ([] : _ list) as x -> x
|
||||||
|
| _ :: _ -> assert false
|
||||||
|
in
|
||||||
|
f', f';;
|
||||||
|
[%%expect{|
|
||||||
|
val f : ('a list -> 'b list) * ('c list -> 'd list) = (<fun>, <fun>)
|
||||||
|
|}]
|
||||||
|
|
||||||
|
let f =
|
||||||
|
let f' (type a) = function
|
||||||
|
| ([] : a list) as x -> x
|
||||||
|
| _ :: _ -> assert false
|
||||||
|
in
|
||||||
|
f', f';;
|
||||||
|
[%%expect{|
|
||||||
|
val f : ('a list -> 'a list) * ('b list -> 'b list) = (<fun>, <fun>)
|
||||||
|
|}]
|
||||||
|
|
||||||
|
type t = [ `A | `B ];;
|
||||||
|
[%%expect{|
|
||||||
|
type t = [ `A | `B ]
|
||||||
|
|}]
|
||||||
|
|
||||||
|
let f = function `A as x -> x | `B -> `A;;
|
||||||
|
[%%expect{|
|
||||||
|
val f : [< `A | `B ] -> [> `A ] = <fun>
|
||||||
|
|}]
|
||||||
|
|
||||||
|
let f = function (`A : t) as x -> x | `B -> `A;;
|
||||||
|
[%%expect{|
|
||||||
|
val f : t -> t = <fun>
|
||||||
|
|}]
|
||||||
|
|
||||||
|
let f : t -> _ = function `A as x -> x | `B -> `A;;
|
||||||
|
[%%expect{|
|
||||||
|
val f : t -> [> `A ] = <fun>
|
||||||
|
|}]
|
||||||
|
|
||||||
|
let f = function
|
||||||
|
| (`A : t) as x ->
|
||||||
|
(* This should be flagged as non-exhaustive: because of the constraint [x]
|
||||||
|
is of type [t]. *)
|
||||||
|
begin match x with
|
||||||
|
| `A -> ()
|
||||||
|
end
|
||||||
|
| `B -> ();;
|
||||||
|
[%%expect{|
|
||||||
|
Lines 5-7, characters 4-7:
|
||||||
|
5 | ....begin match x with
|
||||||
|
6 | | `A -> ()
|
||||||
|
7 | end
|
||||||
|
Warning 8: this pattern-matching is not exhaustive.
|
||||||
|
Here is an example of a case that is not matched:
|
||||||
|
`B
|
||||||
|
val f : t -> unit = <fun>
|
||||||
|
|}]
|
||||||
|
|
||||||
|
|
||||||
|
let f = function
|
||||||
|
| (`A : t) as x ->
|
||||||
|
begin match x with
|
||||||
|
| `A -> ()
|
||||||
|
| `B -> ()
|
||||||
|
end
|
||||||
|
| `B -> ();;
|
||||||
|
[%%expect{|
|
||||||
|
val f : t -> unit = <fun>
|
||||||
|
|}]
|
||||||
|
|
||||||
|
|
||||||
|
let f = function
|
||||||
|
| (`A : t) as x ->
|
||||||
|
begin match x with
|
||||||
|
| `A -> ()
|
||||||
|
| `B -> ()
|
||||||
|
| `C -> ()
|
||||||
|
end
|
||||||
|
| `B -> ();;
|
||||||
|
[%%expect{|
|
||||||
|
Line 6, characters 6-8:
|
||||||
|
6 | | `C -> ()
|
||||||
|
^^
|
||||||
|
Error: This pattern matches values of type [? `C ]
|
||||||
|
but a pattern was expected which matches values of type t
|
||||||
|
The second variant type does not allow tag(s) `C
|
||||||
|
|}]
|
||||||
|
|
||||||
|
let f = function (`A, _ : _ * int) as x -> x;;
|
||||||
|
[%%expect{|
|
||||||
|
val f : [< `A ] * int -> [> `A ] * int = <fun>
|
||||||
|
|}]
|
||||||
|
|
||||||
|
(* Make sure *all* the constraints are respected: *)
|
||||||
|
|
||||||
|
let f = function
|
||||||
|
| ((`A : _) : t) as x ->
|
||||||
|
(* This should be flagged as non-exhaustive: because of the constraint [x]
|
||||||
|
is of type [t]. *)
|
||||||
|
begin match x with
|
||||||
|
| `A -> ()
|
||||||
|
end
|
||||||
|
| `B -> ();;
|
||||||
|
[%%expect{|
|
||||||
|
Lines 5-7, characters 4-7:
|
||||||
|
5 | ....begin match x with
|
||||||
|
6 | | `A -> ()
|
||||||
|
7 | end
|
||||||
|
Warning 8: this pattern-matching is not exhaustive.
|
||||||
|
Here is an example of a case that is not matched:
|
||||||
|
`B
|
||||||
|
val f : t -> unit = <fun>
|
||||||
|
|}]
|
||||||
|
|
||||||
|
let f = function
|
||||||
|
| ((`A : t) : _) as x ->
|
||||||
|
(* This should be flagged as non-exhaustive: because of the constraint [x]
|
||||||
|
is of type [t]. *)
|
||||||
|
begin match x with
|
||||||
|
| `A -> ()
|
||||||
|
end
|
||||||
|
| `B -> ();;
|
||||||
|
|
||||||
|
[%%expect{|
|
||||||
|
Lines 5-7, characters 4-7:
|
||||||
|
5 | ....begin match x with
|
||||||
|
6 | | `A -> ()
|
||||||
|
7 | end
|
||||||
|
Warning 8: this pattern-matching is not exhaustive.
|
||||||
|
Here is an example of a case that is not matched:
|
||||||
|
`B
|
||||||
|
val f : t -> unit = <fun>
|
||||||
|
|}]
|
|
@ -304,12 +304,6 @@ let u = function
|
||||||
;;
|
;;
|
||||||
[%%expect{|
|
[%%expect{|
|
||||||
val u : M.r ref -> int = <fun>
|
val u : M.r ref -> int = <fun>
|
||||||
|}, Principal{|
|
|
||||||
Line 3, characters 7-10:
|
|
||||||
3 | !x.lbl
|
|
||||||
^^^
|
|
||||||
Warning 18: this type-based field disambiguation is not principal.
|
|
||||||
val u : M.r ref -> int = <fun>
|
|
||||||
|}]
|
|}]
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -466,6 +466,22 @@ let enter_orpat_variables loc env p1_vs p2_vs =
|
||||||
unify_vars p1_vs p2_vs
|
unify_vars p1_vs p2_vs
|
||||||
|
|
||||||
let rec build_as_type env p =
|
let rec build_as_type env p =
|
||||||
|
let as_ty = build_as_type_aux env p in
|
||||||
|
(* Cf. #1655 *)
|
||||||
|
List.fold_left (fun as_ty (extra, _loc, _attrs) ->
|
||||||
|
match extra with
|
||||||
|
| Tpat_type _ | Tpat_open _ | Tpat_unpack -> as_ty
|
||||||
|
| Tpat_constraint cty ->
|
||||||
|
begin_def ();
|
||||||
|
let ty = instance cty.ctyp_type in
|
||||||
|
end_def ();
|
||||||
|
generalize_structure ty;
|
||||||
|
(* This call to unify can't fail since the pattern is well typed. *)
|
||||||
|
unify !env (instance as_ty) (instance ty);
|
||||||
|
ty
|
||||||
|
) as_ty p.pat_extra
|
||||||
|
|
||||||
|
and build_as_type_aux env p =
|
||||||
match p.pat_desc with
|
match p.pat_desc with
|
||||||
Tpat_alias(p1,_, _) -> build_as_type env p1
|
Tpat_alias(p1,_, _) -> build_as_type env p1
|
||||||
| Tpat_tuple pl ->
|
| Tpat_tuple pl ->
|
||||||
|
@ -1420,8 +1436,7 @@ and type_pat_aux
|
||||||
({ptyp_desc=Ptyp_poly _} as sty)) ->
|
({ptyp_desc=Ptyp_poly _} as sty)) ->
|
||||||
(* explicitly polymorphic type *)
|
(* explicitly polymorphic type *)
|
||||||
assert construction_not_used_in_counterexamples;
|
assert construction_not_used_in_counterexamples;
|
||||||
let cty, force = Typetexp.transl_simple_type_delayed !env sty in
|
let cty, ty, force = Typetexp.transl_simple_type_delayed !env sty in
|
||||||
let ty = cty.ctyp_type in
|
|
||||||
unify_pat_types ~refine lloc env ty (instance expected_ty);
|
unify_pat_types ~refine lloc env ty (instance expected_ty);
|
||||||
pattern_force := force :: !pattern_force;
|
pattern_force := force :: !pattern_force;
|
||||||
begin match ty.desc with
|
begin match ty.desc with
|
||||||
|
@ -1810,8 +1825,7 @@ and type_pat_aux
|
||||||
| Ppat_constraint(sp, sty) ->
|
| Ppat_constraint(sp, sty) ->
|
||||||
(* Pretend separate = true *)
|
(* Pretend separate = true *)
|
||||||
begin_def();
|
begin_def();
|
||||||
let cty, force = Typetexp.transl_simple_type_delayed !env sty in
|
let cty, ty, force = Typetexp.transl_simple_type_delayed !env sty in
|
||||||
let ty = cty.ctyp_type in
|
|
||||||
end_def();
|
end_def();
|
||||||
generalize_structure ty;
|
generalize_structure ty;
|
||||||
let ty, expected_ty' = instance ty, ty in
|
let ty, expected_ty' = instance ty, ty in
|
||||||
|
@ -3124,10 +3138,9 @@ and type_expect_
|
||||||
let (arg, ty',cty,cty') =
|
let (arg, ty',cty,cty') =
|
||||||
match sty with
|
match sty with
|
||||||
| None ->
|
| None ->
|
||||||
let (cty', force) =
|
let (cty', ty', force) =
|
||||||
Typetexp.transl_simple_type_delayed env sty'
|
Typetexp.transl_simple_type_delayed env sty'
|
||||||
in
|
in
|
||||||
let ty' = cty'.ctyp_type in
|
|
||||||
begin_def ();
|
begin_def ();
|
||||||
let arg = type_exp env sarg in
|
let arg = type_exp env sarg in
|
||||||
end_def ();
|
end_def ();
|
||||||
|
@ -3171,13 +3184,11 @@ and type_expect_
|
||||||
(arg, ty', None, cty')
|
(arg, ty', None, cty')
|
||||||
| Some sty ->
|
| Some sty ->
|
||||||
begin_def ();
|
begin_def ();
|
||||||
let (cty, force) =
|
let (cty, ty, force) =
|
||||||
Typetexp.transl_simple_type_delayed env sty
|
Typetexp.transl_simple_type_delayed env sty
|
||||||
and (cty', force') =
|
and (cty', ty', force') =
|
||||||
Typetexp.transl_simple_type_delayed env sty'
|
Typetexp.transl_simple_type_delayed env sty'
|
||||||
in
|
in
|
||||||
let ty = cty.ctyp_type in
|
|
||||||
let ty' = cty'.ctyp_type in
|
|
||||||
begin try
|
begin try
|
||||||
let force'' = subtype env ty ty' in
|
let force'' = subtype env ty ty' in
|
||||||
force (); force' (); force'' ()
|
force (); force' (); force'' ()
|
||||||
|
|
|
@ -687,9 +687,17 @@ let transl_simple_type_univars env styp =
|
||||||
|
|
||||||
let transl_simple_type_delayed env styp =
|
let transl_simple_type_delayed env styp =
|
||||||
univars := []; used_variables := TyVarMap.empty;
|
univars := []; used_variables := TyVarMap.empty;
|
||||||
|
begin_def ();
|
||||||
let typ = transl_type env Extensible styp in
|
let typ = transl_type env Extensible styp in
|
||||||
|
end_def ();
|
||||||
make_fixed_univars typ.ctyp_type;
|
make_fixed_univars typ.ctyp_type;
|
||||||
(typ, globalize_used_variables env false)
|
(* This brings the used variables to the global level, but doesn't link them
|
||||||
|
to their other occurences just yet. This will be done when [force] is
|
||||||
|
called. *)
|
||||||
|
let force = globalize_used_variables env false in
|
||||||
|
(* Generalizes everything except the variables that were just globalized. *)
|
||||||
|
generalize typ.ctyp_type;
|
||||||
|
(typ, instance typ.ctyp_type, force)
|
||||||
|
|
||||||
let transl_type_scheme env styp =
|
let transl_type_scheme env styp =
|
||||||
reset_type_variables();
|
reset_type_variables();
|
||||||
|
|
|
@ -23,10 +23,13 @@ val transl_simple_type:
|
||||||
Env.t -> bool -> Parsetree.core_type -> Typedtree.core_type
|
Env.t -> bool -> Parsetree.core_type -> Typedtree.core_type
|
||||||
val transl_simple_type_univars:
|
val transl_simple_type_univars:
|
||||||
Env.t -> Parsetree.core_type -> Typedtree.core_type
|
Env.t -> Parsetree.core_type -> Typedtree.core_type
|
||||||
val transl_simple_type_delayed:
|
val transl_simple_type_delayed
|
||||||
Env.t -> Parsetree.core_type -> Typedtree.core_type * (unit -> unit)
|
: Env.t
|
||||||
|
-> Parsetree.core_type
|
||||||
|
-> Typedtree.core_type * type_expr * (unit -> unit)
|
||||||
(* Translate a type, but leave type variables unbound. Returns
|
(* Translate a type, but leave type variables unbound. Returns
|
||||||
the type and a function that binds the type variable. *)
|
the type, an instance of the corresponding type_expr, and a
|
||||||
|
function that binds the type variable. *)
|
||||||
val transl_type_scheme:
|
val transl_type_scheme:
|
||||||
Env.t -> Parsetree.core_type -> Typedtree.core_type
|
Env.t -> Parsetree.core_type -> Typedtree.core_type
|
||||||
val reset_type_variables: unit -> unit
|
val reset_type_variables: unit -> unit
|
||||||
|
|
Loading…
Reference in New Issue