Add injectivity annotations (#9500)
parent
5a9c5dd5b0
commit
603506aa34
10
Changes
10
Changes
|
@ -3,6 +3,16 @@ Working version
|
||||||
|
|
||||||
### Language features:
|
### Language features:
|
||||||
|
|
||||||
|
* #9500: Injectivity annotations
|
||||||
|
One can now mark type parameters as injective, which is useful for
|
||||||
|
abstract types:
|
||||||
|
module Vec : sig type !'a t end = struct type 'a t = 'a array end
|
||||||
|
On non-abstract types, this can be used to check the injectivity of
|
||||||
|
parameters. Since all parameters of record and sum types are by definition
|
||||||
|
injective, this only makes sense for type abbreviations:
|
||||||
|
type !'a t = 'a list
|
||||||
|
(Jacques Garrigue, review by Jeremy Yallop and Leo White)
|
||||||
|
|
||||||
### Runtime system:
|
### Runtime system:
|
||||||
|
|
||||||
- #1795, #9543: modernize signal handling on Linux i386, PowerPC, and s390x,
|
- #1795, #9543: modernize signal handling on Linux i386, PowerPC, and s390x,
|
||||||
|
|
File diff suppressed because one or more lines are too long
|
@ -36,12 +36,18 @@ type-params:
|
||||||
| '(' type-param { "," type-param } ')'
|
| '(' type-param { "," type-param } ')'
|
||||||
;
|
;
|
||||||
type-param:
|
type-param:
|
||||||
[variance] "'" ident
|
[ext-variance] "'" ident
|
||||||
|
;
|
||||||
|
ext-variance:
|
||||||
|
variance [injectivity]
|
||||||
|
| injectivity [variance]
|
||||||
;
|
;
|
||||||
variance:
|
variance:
|
||||||
'+'
|
'+'
|
||||||
| '-'
|
| '-'
|
||||||
;
|
;
|
||||||
|
injectivity: '!'
|
||||||
|
;
|
||||||
record-decl:
|
record-decl:
|
||||||
'{' field-decl { ';' field-decl } [';'] '}'
|
'{' field-decl { ';' field-decl } [';'] '}'
|
||||||
;
|
;
|
||||||
|
@ -88,7 +94,9 @@ for type constructors with one parameter, or a list of type variables
|
||||||
@"('"ident_1,\ldots,"'"ident_n")"@, for type constructors with several
|
@"('"ident_1,\ldots,"'"ident_n")"@, for type constructors with several
|
||||||
parameters. Each type parameter may be prefixed by a variance
|
parameters. Each type parameter may be prefixed by a variance
|
||||||
constraint @"+"@ (resp. @"-"@) indicating that the parameter is
|
constraint @"+"@ (resp. @"-"@) indicating that the parameter is
|
||||||
covariant (resp. contravariant). These type parameters can appear in
|
covariant (resp. contravariant), and an injectivity annotation @"!"@
|
||||||
|
indicating that the parameter can be deduced from the whole type.
|
||||||
|
These type parameters can appear in
|
||||||
the type expressions of the right-hand side of the definition,
|
the type expressions of the right-hand side of the definition,
|
||||||
optionally restricted by a variance constraint ; {\em i.e.\/} a
|
optionally restricted by a variance constraint ; {\em i.e.\/} a
|
||||||
covariant parameter may only appear on the right side of a functional
|
covariant parameter may only appear on the right side of a functional
|
||||||
|
@ -200,6 +208,18 @@ constraints, the variance properties of the type constructor
|
||||||
are inferred from its definition, and the variance annotations are
|
are inferred from its definition, and the variance annotations are
|
||||||
only checked for conformance with the definition.
|
only checked for conformance with the definition.
|
||||||
|
|
||||||
|
Injectivity annotations are only necessary for abstract types and
|
||||||
|
private row types, since they can otherwise be deduced from the type
|
||||||
|
declaration: all parameters are injective for record and variant type
|
||||||
|
declarations (including extensible types); for type abbreviations a
|
||||||
|
parameter is injective if it has an injective occurrence in its
|
||||||
|
defining equation (be it private or not). For constrained type
|
||||||
|
parameters in type abbreviations, they are injective if either they
|
||||||
|
appear at an injective position in the body, or if all their type
|
||||||
|
variables are injective; in particular, if a constrained type
|
||||||
|
parameter contains a variable that doesn't appear in the body, it
|
||||||
|
cannot be injective.
|
||||||
|
|
||||||
\ikwd{constraint\@\texttt{constraint}}
|
\ikwd{constraint\@\texttt{constraint}}
|
||||||
The construct @ 'constraint' "'" ident '=' typexpr @ allows the
|
The construct @ 'constraint' "'" ident '=' typexpr @ allows the
|
||||||
specification of
|
specification of
|
||||||
|
|
|
@ -204,7 +204,7 @@ module Val:
|
||||||
module Type:
|
module Type:
|
||||||
sig
|
sig
|
||||||
val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
|
val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
|
||||||
?params:(core_type * variance) list ->
|
?params:(core_type * (variance * injectivity)) list ->
|
||||||
?cstrs:(core_type * core_type * loc) list ->
|
?cstrs:(core_type * core_type * loc) list ->
|
||||||
?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str ->
|
?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str ->
|
||||||
type_declaration
|
type_declaration
|
||||||
|
@ -220,8 +220,8 @@ module Type:
|
||||||
module Te:
|
module Te:
|
||||||
sig
|
sig
|
||||||
val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs ->
|
val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs ->
|
||||||
?params:(core_type * variance) list -> ?priv:private_flag ->
|
?params:(core_type * (variance * injectivity)) list ->
|
||||||
lid -> extension_constructor list -> type_extension
|
?priv:private_flag -> lid -> extension_constructor list -> type_extension
|
||||||
|
|
||||||
val mk_exception: ?loc:loc -> ?attrs:attrs -> ?docs:docs ->
|
val mk_exception: ?loc:loc -> ?attrs:attrs -> ?docs:docs ->
|
||||||
extension_constructor -> type_exception
|
extension_constructor -> type_exception
|
||||||
|
@ -454,7 +454,8 @@ module Cf:
|
||||||
module Ci:
|
module Ci:
|
||||||
sig
|
sig
|
||||||
val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
|
val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
|
||||||
?virt:virtual_flag -> ?params:(core_type * variance) list ->
|
?virt:virtual_flag ->
|
||||||
|
?params:(core_type * (variance * injectivity)) list ->
|
||||||
str -> 'a -> 'a class_infos
|
str -> 'a -> 'a class_infos
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
@ -60,4 +60,8 @@ type 'a loc = 'a Location.loc = {
|
||||||
type variance =
|
type variance =
|
||||||
| Covariant
|
| Covariant
|
||||||
| Contravariant
|
| Contravariant
|
||||||
| Invariant
|
| NoVariance
|
||||||
|
|
||||||
|
type injectivity =
|
||||||
|
| Injective
|
||||||
|
| NoInjectivity
|
||||||
|
|
|
@ -2942,9 +2942,20 @@ type_variable:
|
||||||
;
|
;
|
||||||
|
|
||||||
type_variance:
|
type_variance:
|
||||||
/* empty */ { Invariant }
|
/* empty */ { NoVariance, NoInjectivity }
|
||||||
| PLUS { Covariant }
|
| PLUS { Covariant, NoInjectivity }
|
||||||
| MINUS { Contravariant }
|
| MINUS { Contravariant, NoInjectivity }
|
||||||
|
| BANG { NoVariance, Injective }
|
||||||
|
| PLUS BANG | BANG PLUS { Covariant, Injective }
|
||||||
|
| MINUS BANG | BANG MINUS { Contravariant, Injective }
|
||||||
|
| INFIXOP2
|
||||||
|
{ if $1 = "+!" then Covariant, Injective else
|
||||||
|
if $1 = "-!" then Contravariant, Injective else
|
||||||
|
expecting $loc($1) "type_variance" }
|
||||||
|
| PREFIXOP
|
||||||
|
{ if $1 = "!+" then Covariant, Injective else
|
||||||
|
if $1 = "!-" then Contravariant, Injective else
|
||||||
|
expecting $loc($1) "type_variance" }
|
||||||
;
|
;
|
||||||
|
|
||||||
(* A sequence of constructor declarations is either a single BAR, which
|
(* A sequence of constructor declarations is either a single BAR, which
|
||||||
|
|
|
@ -429,7 +429,7 @@ and value_description =
|
||||||
and type_declaration =
|
and type_declaration =
|
||||||
{
|
{
|
||||||
ptype_name: string loc;
|
ptype_name: string loc;
|
||||||
ptype_params: (core_type * variance) list;
|
ptype_params: (core_type * (variance * injectivity)) list;
|
||||||
(* ('a1,...'an) t; None represents _*)
|
(* ('a1,...'an) t; None represents _*)
|
||||||
ptype_cstrs: (core_type * core_type * Location.t) list;
|
ptype_cstrs: (core_type * core_type * Location.t) list;
|
||||||
(* ... constraint T1=T1' ... constraint Tn=Tn' *)
|
(* ... constraint T1=T1' ... constraint Tn=Tn' *)
|
||||||
|
@ -497,7 +497,7 @@ and constructor_arguments =
|
||||||
and type_extension =
|
and type_extension =
|
||||||
{
|
{
|
||||||
ptyext_path: Longident.t loc;
|
ptyext_path: Longident.t loc;
|
||||||
ptyext_params: (core_type * variance) list;
|
ptyext_params: (core_type * (variance * injectivity)) list;
|
||||||
ptyext_constructors: extension_constructor list;
|
ptyext_constructors: extension_constructor list;
|
||||||
ptyext_private: private_flag;
|
ptyext_private: private_flag;
|
||||||
ptyext_loc: Location.t;
|
ptyext_loc: Location.t;
|
||||||
|
@ -598,7 +598,7 @@ and class_type_field_desc =
|
||||||
and 'a class_infos =
|
and 'a class_infos =
|
||||||
{
|
{
|
||||||
pci_virt: virtual_flag;
|
pci_virt: virtual_flag;
|
||||||
pci_params: (core_type * variance) list;
|
pci_params: (core_type * (variance * injectivity)) list;
|
||||||
pci_name: string loc;
|
pci_name: string loc;
|
||||||
pci_expr: 'a;
|
pci_expr: 'a;
|
||||||
pci_loc: Location.t;
|
pci_loc: Location.t;
|
||||||
|
|
|
@ -118,10 +118,14 @@ let override = function
|
||||||
|
|
||||||
(* variance encoding: need to sync up with the [parser.mly] *)
|
(* variance encoding: need to sync up with the [parser.mly] *)
|
||||||
let type_variance = function
|
let type_variance = function
|
||||||
| Invariant -> ""
|
| NoVariance -> ""
|
||||||
| Covariant -> "+"
|
| Covariant -> "+"
|
||||||
| Contravariant -> "-"
|
| Contravariant -> "-"
|
||||||
|
|
||||||
|
let type_injectivity = function
|
||||||
|
| NoInjectivity -> ""
|
||||||
|
| Injective -> "!"
|
||||||
|
|
||||||
type construct =
|
type construct =
|
||||||
[ `cons of expression list
|
[ `cons of expression list
|
||||||
| `list of expression list
|
| `list of expression list
|
||||||
|
@ -1434,8 +1438,8 @@ and structure_item ctxt f x =
|
||||||
item_extension ctxt f e;
|
item_extension ctxt f e;
|
||||||
item_attributes ctxt f a
|
item_attributes ctxt f a
|
||||||
|
|
||||||
and type_param ctxt f (ct, a) =
|
and type_param ctxt f (ct, (a,b)) =
|
||||||
pp f "%s%a" (type_variance a) (core_type ctxt) ct
|
pp f "%s%s%a" (type_variance a) (type_injectivity b) (core_type ctxt) ct
|
||||||
|
|
||||||
and type_params ctxt f = function
|
and type_params ctxt f = function
|
||||||
| [] -> ()
|
| [] -> ()
|
||||||
|
|
|
@ -6,14 +6,14 @@ type 'a x = private [> `x] as 'a;;
|
||||||
[%%expect {|
|
[%%expect {|
|
||||||
Line 1:
|
Line 1:
|
||||||
Error: Type declarations do not match:
|
Error: Type declarations do not match:
|
||||||
type 'a x = private [> `x ] constraint 'a = 'a x
|
type !'a x = private [> `x ] constraint 'a = 'a x
|
||||||
is not included in
|
is not included in
|
||||||
type 'a x
|
type 'a x
|
||||||
Their constraints differ.
|
Their constraints differ.
|
||||||
|}, Principal{|
|
|}, Principal{|
|
||||||
Line 1:
|
Line 1:
|
||||||
Error: Type declarations do not match:
|
Error: Type declarations do not match:
|
||||||
type 'a x = private 'a constraint 'a = [> `x ]
|
type !'a x = private 'a constraint 'a = [> `x ]
|
||||||
is not included in
|
is not included in
|
||||||
type 'a x
|
type 'a x
|
||||||
Their constraints differ.
|
Their constraints differ.
|
||||||
|
|
|
@ -0,0 +1,375 @@
|
||||||
|
(* TEST
|
||||||
|
* expect
|
||||||
|
*)
|
||||||
|
|
||||||
|
(* Syntax *)
|
||||||
|
|
||||||
|
type ! 'a t = private 'a ref
|
||||||
|
type +! 'a t = private 'a
|
||||||
|
type -!'a t = private 'a -> unit
|
||||||
|
type + !'a t = private 'a
|
||||||
|
type - ! 'a t = private 'a -> unit
|
||||||
|
type !+ 'a t = private 'a
|
||||||
|
type !-'a t = private 'a -> unit
|
||||||
|
type ! +'a t = private 'a
|
||||||
|
type ! -'a t = private 'a -> unit
|
||||||
|
[%%expect{|
|
||||||
|
type 'a t = private 'a ref
|
||||||
|
type +'a t = private 'a
|
||||||
|
type -'a t = private 'a -> unit
|
||||||
|
type +'a t = private 'a
|
||||||
|
type -'a t = private 'a -> unit
|
||||||
|
type +'a t = private 'a
|
||||||
|
type -'a t = private 'a -> unit
|
||||||
|
type +'a t = private 'a
|
||||||
|
type -'a t = private 'a -> unit
|
||||||
|
|}]
|
||||||
|
(* Expect doesn't support syntax errors
|
||||||
|
type -+ 'a t
|
||||||
|
[%%expect]
|
||||||
|
type -!! 'a t
|
||||||
|
[%%expect]
|
||||||
|
*)
|
||||||
|
|
||||||
|
(* Define an injective abstract type, and use it in a GADT
|
||||||
|
and a constrained type *)
|
||||||
|
module M : sig type +!'a t end = struct type 'a t = 'a list end
|
||||||
|
[%%expect{|
|
||||||
|
module M : sig type +!'a t end
|
||||||
|
|}]
|
||||||
|
type _ t = M : 'a -> 'a M.t t (* OK *)
|
||||||
|
type 'a u = 'b constraint 'a = 'b M.t
|
||||||
|
[%%expect{|
|
||||||
|
type _ t = M : 'a -> 'a M.t t
|
||||||
|
type 'a u = 'b constraint 'a = 'b M.t
|
||||||
|
|}]
|
||||||
|
|
||||||
|
(* Without the injectivity annotation, the cannot be defined *)
|
||||||
|
module N : sig type +'a t end = struct type 'a t = 'a list end
|
||||||
|
[%%expect{|
|
||||||
|
module N : sig type +'a t end
|
||||||
|
|}]
|
||||||
|
type _ t = N : 'a -> 'a N.t t (* KO *)
|
||||||
|
[%%expect{|
|
||||||
|
Line 1, characters 0-29:
|
||||||
|
1 | type _ t = N : 'a -> 'a N.t t (* KO *)
|
||||||
|
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
|
||||||
|
Error: In this definition, a type variable cannot be deduced
|
||||||
|
from the type parameters.
|
||||||
|
|}]
|
||||||
|
type 'a u = 'b constraint 'a = 'b N.t
|
||||||
|
[%%expect{|
|
||||||
|
Line 1, characters 0-37:
|
||||||
|
1 | type 'a u = 'b constraint 'a = 'b N.t
|
||||||
|
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
|
||||||
|
Error: In this definition, a type variable cannot be deduced
|
||||||
|
from the type parameters.
|
||||||
|
|}]
|
||||||
|
|
||||||
|
(* Of course, the internal type should be injective in this parameter *)
|
||||||
|
module M : sig type +!'a t end = struct type 'a t = int end (* KO *)
|
||||||
|
[%%expect{|
|
||||||
|
Line 1, characters 33-59:
|
||||||
|
1 | module M : sig type +!'a t end = struct type 'a t = int end (* KO *)
|
||||||
|
^^^^^^^^^^^^^^^^^^^^^^^^^^
|
||||||
|
Error: Signature mismatch:
|
||||||
|
Modules do not match:
|
||||||
|
sig type 'a t = int end
|
||||||
|
is not included in
|
||||||
|
sig type +!'a t end
|
||||||
|
Type declarations do not match:
|
||||||
|
type 'a t = int
|
||||||
|
is not included in
|
||||||
|
type +!'a t
|
||||||
|
Their variances do not agree.
|
||||||
|
|}]
|
||||||
|
|
||||||
|
(* Annotations in type abbreviations allow to check injectivity *)
|
||||||
|
type !'a t = 'a list
|
||||||
|
type !'a u = int
|
||||||
|
[%%expect{|
|
||||||
|
type 'a t = 'a list
|
||||||
|
Line 2, characters 0-16:
|
||||||
|
2 | type !'a u = int
|
||||||
|
^^^^^^^^^^^^^^^^
|
||||||
|
Error: In this definition, expected parameter variances are not satisfied.
|
||||||
|
The 1st type parameter was expected to be injective invariant,
|
||||||
|
but it is unrestricted.
|
||||||
|
|}]
|
||||||
|
type !'a t = private 'a list
|
||||||
|
type !'a t = private int
|
||||||
|
[%%expect{|
|
||||||
|
type 'a t = private 'a list
|
||||||
|
Line 2, characters 0-24:
|
||||||
|
2 | type !'a t = private int
|
||||||
|
^^^^^^^^^^^^^^^^^^^^^^^^
|
||||||
|
Error: In this definition, expected parameter variances are not satisfied.
|
||||||
|
The 1st type parameter was expected to be injective invariant,
|
||||||
|
but it is unrestricted.
|
||||||
|
|}]
|
||||||
|
|
||||||
|
(* Can also use to add injectivity in private row types *)
|
||||||
|
module M : sig type !'a t = private < m : int ; .. > end =
|
||||||
|
struct type 'a t = < m : int ; n : 'a > end
|
||||||
|
type 'a u = M : 'a -> 'a M.t u
|
||||||
|
[%%expect{|
|
||||||
|
module M : sig type !'a t = private < m : int; .. > end
|
||||||
|
type 'a u = M : 'a -> 'a M.t u
|
||||||
|
|}]
|
||||||
|
module M : sig type 'a t = private < m : int ; .. > end =
|
||||||
|
struct type 'a t = < m : int ; n : 'a > end
|
||||||
|
type 'a u = M : 'a -> 'a M.t u
|
||||||
|
[%%expect{|
|
||||||
|
module M : sig type 'a t = private < m : int; .. > end
|
||||||
|
Line 3, characters 0-30:
|
||||||
|
3 | type 'a u = M : 'a -> 'a M.t u
|
||||||
|
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
|
||||||
|
Error: In this definition, a type variable cannot be deduced
|
||||||
|
from the type parameters.
|
||||||
|
|}]
|
||||||
|
module M : sig type !'a t = private < m : int ; .. > end =
|
||||||
|
struct type 'a t = < m : int > end
|
||||||
|
[%%expect{|
|
||||||
|
Line 2, characters 2-36:
|
||||||
|
2 | struct type 'a t = < m : int > end
|
||||||
|
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
|
||||||
|
Error: Signature mismatch:
|
||||||
|
Modules do not match:
|
||||||
|
sig type 'a t = < m : int > end
|
||||||
|
is not included in
|
||||||
|
sig type !'a t = private < m : int; .. > end
|
||||||
|
Type declarations do not match:
|
||||||
|
type 'a t = < m : int >
|
||||||
|
is not included in
|
||||||
|
type !'a t
|
||||||
|
Their variances do not agree.
|
||||||
|
|}]
|
||||||
|
|
||||||
|
(* Injectivity annotations are inferred correctly for constrained parameters *)
|
||||||
|
type 'a t = 'b constraint 'a = <b:'b>
|
||||||
|
type !'b u = <b:'b> t
|
||||||
|
[%%expect{|
|
||||||
|
type 'a t = 'b constraint 'a = < b : 'b >
|
||||||
|
type 'b u = < b : 'b > t
|
||||||
|
|}]
|
||||||
|
|
||||||
|
(* Ignore injectivity for nominal types *)
|
||||||
|
type !_ t = X
|
||||||
|
[%%expect{|
|
||||||
|
type _ t = X
|
||||||
|
|}]
|
||||||
|
|
||||||
|
(* Beware of constrained parameters *)
|
||||||
|
type (_,_) eq = Refl : ('a,'a) eq
|
||||||
|
type !'a t = private 'b constraint 'a = < b : 'b > (* OK *)
|
||||||
|
[%%expect{|
|
||||||
|
type (_, _) eq = Refl : ('a, 'a) eq
|
||||||
|
type 'a t = private 'b constraint 'a = < b : 'b >
|
||||||
|
|}]
|
||||||
|
|
||||||
|
type !'a t = private 'b constraint 'a = < b : 'b; c : 'c > (* KO *)
|
||||||
|
module M : sig type !'a t constraint 'a = < b : 'b; c : 'c > end =
|
||||||
|
struct type nonrec 'a t = 'a t end
|
||||||
|
let inj_t : type a b. (<b:_; c:a> M.t, <b:_; c:b> M.t) eq -> (a, b) eq =
|
||||||
|
fun Refl -> Refl
|
||||||
|
[%%expect{|
|
||||||
|
Line 1, characters 0-58:
|
||||||
|
1 | type !'a t = private 'b constraint 'a = < b : 'b; c : 'c > (* KO *)
|
||||||
|
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
|
||||||
|
Error: In this definition, expected parameter variances are not satisfied.
|
||||||
|
The 1st type parameter was expected to be injective invariant,
|
||||||
|
but it is unrestricted.
|
||||||
|
|}]
|
||||||
|
|
||||||
|
(* One cannot assume that abstract types are not injective *)
|
||||||
|
module F(X : sig type 'a t end) = struct
|
||||||
|
type 'a u = unit constraint 'a = 'b X.t
|
||||||
|
type _ x = G : 'a -> 'a u x
|
||||||
|
end
|
||||||
|
module M = F(struct type 'a t = 'a end)
|
||||||
|
let M.G (x : bool) = M.G 3
|
||||||
|
[%%expect{|
|
||||||
|
Line 3, characters 2-29:
|
||||||
|
3 | type _ x = G : 'a -> 'a u x
|
||||||
|
^^^^^^^^^^^^^^^^^^^^^^^^^^^
|
||||||
|
Error: In this definition, a type variable cannot be deduced
|
||||||
|
from the type parameters.
|
||||||
|
|}]
|
||||||
|
|
||||||
|
(* Try to be clever *)
|
||||||
|
type 'a t = unit
|
||||||
|
type !'a u = int constraint 'a = 'b t
|
||||||
|
[%%expect{|
|
||||||
|
type 'a t = unit
|
||||||
|
type 'a u = int constraint 'a = 'b t
|
||||||
|
|}]
|
||||||
|
module F(X : sig type 'a t end) = struct
|
||||||
|
type !'a u = 'b constraint 'a = <b : 'b> constraint 'b = _ X.t
|
||||||
|
end
|
||||||
|
[%%expect{|
|
||||||
|
module F :
|
||||||
|
functor (X : sig type 'a t end) ->
|
||||||
|
sig type 'a u = 'b X.t constraint 'a = < b : 'b X.t > end
|
||||||
|
|}]
|
||||||
|
(* But not too clever *)
|
||||||
|
module F(X : sig type 'a t end) = struct
|
||||||
|
type !'a u = 'b X.t constraint 'a = <b : 'b X.t>
|
||||||
|
end
|
||||||
|
[%%expect{|
|
||||||
|
Line 2, characters 2-50:
|
||||||
|
2 | type !'a u = 'b X.t constraint 'a = <b : 'b X.t>
|
||||||
|
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
|
||||||
|
Error: In this definition, expected parameter variances are not satisfied.
|
||||||
|
The 1st type parameter was expected to be injective invariant,
|
||||||
|
but it is unrestricted.
|
||||||
|
|}]
|
||||||
|
module F(X : sig type 'a t end) = struct
|
||||||
|
type !'a u = 'b constraint 'a = <b : _ X.t as 'b>
|
||||||
|
end
|
||||||
|
[%%expect{|
|
||||||
|
module F :
|
||||||
|
functor (X : sig type 'a t end) ->
|
||||||
|
sig type 'a u = 'b X.t constraint 'a = < b : 'b X.t > end
|
||||||
|
|}, Principal{|
|
||||||
|
Line 2, characters 2-51:
|
||||||
|
2 | type !'a u = 'b constraint 'a = <b : _ X.t as 'b>
|
||||||
|
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
|
||||||
|
Error: In this definition, expected parameter variances are not satisfied.
|
||||||
|
The 1st type parameter was expected to be injective invariant,
|
||||||
|
but it is unrestricted.
|
||||||
|
|}]
|
||||||
|
|
||||||
|
(* Motivating examples with GADTs *)
|
||||||
|
|
||||||
|
type (_,_) eq = Refl : ('a,'a) eq
|
||||||
|
|
||||||
|
module Vec : sig
|
||||||
|
type +!'a t
|
||||||
|
val make : int -> (int -> 'a) -> 'a t
|
||||||
|
val get : 'a t -> int -> 'a
|
||||||
|
end = struct
|
||||||
|
type 'a t = Vec of Obj.t array
|
||||||
|
let make n f = Vec (Obj.magic Array.init n f)
|
||||||
|
let get (Vec v) n = Obj.obj (Array.get v n)
|
||||||
|
end
|
||||||
|
|
||||||
|
type _ ty =
|
||||||
|
| Int : int ty
|
||||||
|
| Fun : 'a ty * 'b ty -> ('a -> 'b) ty
|
||||||
|
| Vec : 'a ty -> 'a Vec.t ty
|
||||||
|
|
||||||
|
type dyn = Dyn : 'a ty * 'a -> dyn
|
||||||
|
|
||||||
|
let rec eq_ty : type a b. a ty -> b ty -> (a,b) eq option =
|
||||||
|
fun t1 t2 -> match t1, t2 with
|
||||||
|
| Int, Int -> Some Refl
|
||||||
|
| Fun (t11, t12), Fun (t21, t22) ->
|
||||||
|
begin match eq_ty t11 t21, eq_ty t12 t22 with
|
||||||
|
| Some Refl, Some Refl -> Some Refl
|
||||||
|
| _ -> None
|
||||||
|
end
|
||||||
|
| Vec t1, Vec t2 ->
|
||||||
|
begin match eq_ty t1 t2 with
|
||||||
|
| Some Refl -> Some Refl
|
||||||
|
| None -> None
|
||||||
|
end
|
||||||
|
| _ -> None
|
||||||
|
|
||||||
|
let undyn : type a. a ty -> dyn -> a option =
|
||||||
|
fun t1 (Dyn (t2, v)) ->
|
||||||
|
match eq_ty t1 t2 with
|
||||||
|
| Some Refl -> Some v
|
||||||
|
| None -> None
|
||||||
|
|
||||||
|
let v = Vec.make 3 (fun n -> Vec.make n (fun m -> (m*n)))
|
||||||
|
|
||||||
|
let int_vec_vec = Vec (Vec Int)
|
||||||
|
|
||||||
|
let d = Dyn (int_vec_vec, v)
|
||||||
|
|
||||||
|
let Some v' = undyn int_vec_vec d
|
||||||
|
[%%expect{|
|
||||||
|
type (_, _) eq = Refl : ('a, 'a) eq
|
||||||
|
module Vec :
|
||||||
|
sig
|
||||||
|
type +!'a t
|
||||||
|
val make : int -> (int -> 'a) -> 'a t
|
||||||
|
val get : 'a t -> int -> 'a
|
||||||
|
end
|
||||||
|
type _ ty =
|
||||||
|
Int : int ty
|
||||||
|
| Fun : 'a ty * 'b ty -> ('a -> 'b) ty
|
||||||
|
| Vec : 'a ty -> 'a Vec.t ty
|
||||||
|
type dyn = Dyn : 'a ty * 'a -> dyn
|
||||||
|
val eq_ty : 'a ty -> 'b ty -> ('a, 'b) eq option = <fun>
|
||||||
|
val undyn : 'a ty -> dyn -> 'a option = <fun>
|
||||||
|
val v : int Vec.t Vec.t = <abstr>
|
||||||
|
val int_vec_vec : int Vec.t Vec.t ty = Vec (Vec Int)
|
||||||
|
val d : dyn = Dyn (Vec (Vec Int), <poly>)
|
||||||
|
Line 47, characters 4-11:
|
||||||
|
47 | let Some v' = undyn int_vec_vec d
|
||||||
|
^^^^^^^
|
||||||
|
Warning 8: this pattern-matching is not exhaustive.
|
||||||
|
Here is an example of a case that is not matched:
|
||||||
|
None
|
||||||
|
val v' : int Vec.t Vec.t = <abstr>
|
||||||
|
|}]
|
||||||
|
|
||||||
|
(* Break it (using magic) *)
|
||||||
|
module Vec : sig
|
||||||
|
type +!'a t
|
||||||
|
val eqt : ('a t, 'b t) eq
|
||||||
|
end = struct
|
||||||
|
type 'a t = 'a
|
||||||
|
let eqt = Obj.magic Refl (* Never do that! *)
|
||||||
|
end
|
||||||
|
|
||||||
|
type _ ty =
|
||||||
|
| Int : int ty
|
||||||
|
| Vec : 'a ty -> 'a Vec.t ty
|
||||||
|
|
||||||
|
let coe : type a b. (a,b) eq -> a ty -> b ty =
|
||||||
|
fun Refl x -> x
|
||||||
|
let eq_int_any : type a. (int, a) eq =
|
||||||
|
let vec_ty : a Vec.t ty = coe Vec.eqt (Vec Int) in
|
||||||
|
let Vec Int = vec_ty in Refl
|
||||||
|
[%%expect{|
|
||||||
|
module Vec : sig type +!'a t val eqt : ('a t, 'b t) eq end
|
||||||
|
type _ ty = Int : int ty | Vec : 'a ty -> 'a Vec.t ty
|
||||||
|
val coe : ('a, 'b) eq -> 'a ty -> 'b ty = <fun>
|
||||||
|
Line 17, characters 2-30:
|
||||||
|
17 | let Vec Int = vec_ty in Refl
|
||||||
|
^^^^^^^^^^^^^^^^^^^^^^^^^^^^
|
||||||
|
Warning 8: this pattern-matching is not exhaustive.
|
||||||
|
Here is an example of a case that is not matched:
|
||||||
|
Vec (Vec Int)
|
||||||
|
val eq_int_any : (int, 'a) eq = Refl
|
||||||
|
|}]
|
||||||
|
|
||||||
|
(* Not directly related: injectivity and constraints *)
|
||||||
|
type 'a t = 'b constraint 'a = <b : 'b>
|
||||||
|
class type ['a] ct = object method m : 'b constraint 'a = < b : 'b > end
|
||||||
|
[%%expect{|
|
||||||
|
type 'a t = 'b constraint 'a = < b : 'b >
|
||||||
|
class type ['a] ct = object constraint 'a = < b : 'b > method m : 'b end
|
||||||
|
|}]
|
||||||
|
|
||||||
|
type _ u = M : 'a -> 'a t u (* OK *)
|
||||||
|
[%%expect{|
|
||||||
|
type _ u = M : < b : 'a > -> < b : 'a > t u
|
||||||
|
|}]
|
||||||
|
type _ v = M : 'a -> 'a ct v (* OK *)
|
||||||
|
[%%expect{|
|
||||||
|
type _ v = M : < b : 'a > -> < b : 'a > ct v
|
||||||
|
|}]
|
||||||
|
|
||||||
|
type 'a t = 'b constraint 'a = <b : 'b; c : 'c>
|
||||||
|
type _ u = M : 'a -> 'a t u (* KO *)
|
||||||
|
[%%expect{|
|
||||||
|
type 'a t = 'b constraint 'a = < b : 'b; c : 'c >
|
||||||
|
Line 2, characters 0-27:
|
||||||
|
2 | type _ u = M : 'a -> 'a t u (* KO *)
|
||||||
|
^^^^^^^^^^^^^^^^^^^^^^^^^^^
|
||||||
|
Error: In this definition, a type variable cannot be deduced
|
||||||
|
from the type parameters.
|
||||||
|
|}]
|
|
@ -114,7 +114,7 @@ type t = private < x : int >
|
||||||
type t = private < x : int >
|
type t = private < x : int >
|
||||||
Line 1:
|
Line 1:
|
||||||
Error: Type declarations do not match:
|
Error: Type declarations do not match:
|
||||||
type 'a t = private 'a constraint 'a = < x : int; .. >
|
type !'a t = private 'a constraint 'a = < x : int; .. >
|
||||||
is not included in
|
is not included in
|
||||||
type 'a t
|
type 'a t
|
||||||
Their constraints differ.
|
Their constraints differ.
|
||||||
|
|
|
@ -114,7 +114,7 @@ type t = private < x : int >
|
||||||
type t = private < x : int >
|
type t = private < x : int >
|
||||||
Line 1:
|
Line 1:
|
||||||
Error: Type declarations do not match:
|
Error: Type declarations do not match:
|
||||||
type 'a t = private < x : int; .. > constraint 'a = 'a t
|
type !'a t = private < x : int; .. > constraint 'a = 'a t
|
||||||
is not included in
|
is not included in
|
||||||
type 'a t
|
type 'a t
|
||||||
Their constraints differ.
|
Their constraints differ.
|
||||||
|
|
|
@ -400,9 +400,11 @@ let out_type = ref print_out_type
|
||||||
let print_type_parameter ppf s =
|
let print_type_parameter ppf s =
|
||||||
if s = "_" then fprintf ppf "_" else pr_var ppf s
|
if s = "_" then fprintf ppf "_" else pr_var ppf s
|
||||||
|
|
||||||
let type_parameter ppf (ty, (co, cn)) =
|
let type_parameter ppf (ty, (var, inj)) =
|
||||||
fprintf ppf "%s%a"
|
let open Asttypes in
|
||||||
(if not cn then "+" else if not co then "-" else "")
|
fprintf ppf "%s%s%a"
|
||||||
|
(match var with Covariant -> "+" | Contravariant -> "-" | NoVariance -> "")
|
||||||
|
(match inj with Injective -> "!" | NoInjectivity -> "")
|
||||||
print_type_parameter ty
|
print_type_parameter ty
|
||||||
|
|
||||||
let print_out_class_params ppf =
|
let print_out_class_params ppf =
|
||||||
|
|
|
@ -56,6 +56,8 @@ type out_value =
|
||||||
| Oval_tuple of out_value list
|
| Oval_tuple of out_value list
|
||||||
| Oval_variant of string * out_value option
|
| Oval_variant of string * out_value option
|
||||||
|
|
||||||
|
type out_type_param = string * (Asttypes.variance * Asttypes.injectivity)
|
||||||
|
|
||||||
type out_type =
|
type out_type =
|
||||||
| Otyp_abstract
|
| Otyp_abstract
|
||||||
| Otyp_open
|
| Otyp_open
|
||||||
|
@ -97,10 +99,10 @@ type out_module_type =
|
||||||
| Omty_alias of out_ident
|
| Omty_alias of out_ident
|
||||||
and out_sig_item =
|
and out_sig_item =
|
||||||
| Osig_class of
|
| Osig_class of
|
||||||
bool * string * (string * (bool * bool)) list * out_class_type *
|
bool * string * out_type_param list * out_class_type *
|
||||||
out_rec_status
|
out_rec_status
|
||||||
| Osig_class_type of
|
| Osig_class_type of
|
||||||
bool * string * (string * (bool * bool)) list * out_class_type *
|
bool * string * out_type_param list * out_class_type *
|
||||||
out_rec_status
|
out_rec_status
|
||||||
| Osig_typext of out_extension_constructor * out_ext_status
|
| Osig_typext of out_extension_constructor * out_ext_status
|
||||||
| Osig_modtype of string * out_module_type
|
| Osig_modtype of string * out_module_type
|
||||||
|
@ -110,7 +112,7 @@ and out_sig_item =
|
||||||
| Osig_ellipsis
|
| Osig_ellipsis
|
||||||
and out_type_decl =
|
and out_type_decl =
|
||||||
{ otype_name: string;
|
{ otype_name: string;
|
||||||
otype_params: (string * (bool * bool)) list;
|
otype_params: out_type_param list;
|
||||||
otype_type: out_type;
|
otype_type: out_type;
|
||||||
otype_private: Asttypes.private_flag;
|
otype_private: Asttypes.private_flag;
|
||||||
otype_immediate: Type_immediacy.t;
|
otype_immediate: Type_immediacy.t;
|
||||||
|
|
|
@ -1229,8 +1229,20 @@ let rec tree_of_type_decl id decl =
|
||||||
let vari =
|
let vari =
|
||||||
List.map2
|
List.map2
|
||||||
(fun ty v ->
|
(fun ty v ->
|
||||||
if abstr || not (is_Tvar (repr ty)) then Variance.get_upper v
|
let is_var = is_Tvar (repr ty) in
|
||||||
else (true,true))
|
if abstr || not is_var then
|
||||||
|
let inj =
|
||||||
|
decl.type_kind = Type_abstract && Variance.mem Inj v &&
|
||||||
|
match decl.type_manifest with
|
||||||
|
| None -> true
|
||||||
|
| Some ty -> (* only abstract or private row types *)
|
||||||
|
decl.type_private = Private &&
|
||||||
|
Btype.is_constr_row ~allow_ident:true (Btype.row_of_type ty)
|
||||||
|
and (co, cn) = Variance.get_upper v in
|
||||||
|
(if not cn then Covariant else
|
||||||
|
if not co then Contravariant else NoVariance),
|
||||||
|
(if inj then Injective else NoInjectivity)
|
||||||
|
else (NoVariance, NoInjectivity))
|
||||||
decl.type_params decl.type_variance
|
decl.type_params decl.type_variance
|
||||||
in
|
in
|
||||||
(Ident.name id,
|
(Ident.name id,
|
||||||
|
@ -1503,10 +1515,15 @@ let tree_of_class_param param variance =
|
||||||
(match tree_of_typexp true param with
|
(match tree_of_typexp true param with
|
||||||
Otyp_var (_, s) -> s
|
Otyp_var (_, s) -> s
|
||||||
| _ -> "?"),
|
| _ -> "?"),
|
||||||
if is_Tvar (repr param) then (true, true) else variance
|
if is_Tvar (repr param) then Asttypes.(NoVariance, NoInjectivity)
|
||||||
|
else variance
|
||||||
|
|
||||||
let class_variance =
|
let class_variance =
|
||||||
List.map Variance.(fun v -> mem May_pos v, mem May_neg v)
|
let open Variance in let open Asttypes in
|
||||||
|
List.map (fun v ->
|
||||||
|
(if not (mem May_pos v) then Contravariant else
|
||||||
|
if not (mem May_neg v) then Covariant else NoVariance),
|
||||||
|
NoInjectivity)
|
||||||
|
|
||||||
let tree_of_class_declaration id cl rs =
|
let tree_of_class_declaration id cl rs =
|
||||||
let params = filter_params cl.cty_params in
|
let params = filter_params cl.cty_params in
|
||||||
|
|
|
@ -131,10 +131,16 @@ let make p n i =
|
||||||
let open Variance in
|
let open Variance in
|
||||||
set May_pos p (set May_neg n (set May_weak n (set Inj i null)))
|
set May_pos p (set May_neg n (set May_weak n (set Inj i null)))
|
||||||
|
|
||||||
|
let injective = Variance.(set Inj true null)
|
||||||
|
|
||||||
let compute_variance_type env ~check (required, loc) decl tyl =
|
let compute_variance_type env ~check (required, loc) decl tyl =
|
||||||
(* Requirements *)
|
(* Requirements *)
|
||||||
|
let check_injectivity = decl.type_kind = Type_abstract in
|
||||||
let required =
|
let required =
|
||||||
List.map (fun (c,n,i) -> if c || n then (c,n,i) else (true,true,i))
|
List.map
|
||||||
|
(fun (c,n,i) ->
|
||||||
|
let i = if check_injectivity then i else false in
|
||||||
|
if c || n then (c,n,i) else (true,true,i))
|
||||||
required
|
required
|
||||||
in
|
in
|
||||||
(* Prepare *)
|
(* Prepare *)
|
||||||
|
@ -146,6 +152,32 @@ let compute_variance_type env ~check (required, loc) decl tyl =
|
||||||
(fun (cn,ty) ->
|
(fun (cn,ty) ->
|
||||||
compute_variance env tvl (if cn then full else covariant) ty)
|
compute_variance env tvl (if cn then full else covariant) ty)
|
||||||
tyl;
|
tyl;
|
||||||
|
(* Infer injectivity of constrained parameters *)
|
||||||
|
if check_injectivity then
|
||||||
|
List.iter
|
||||||
|
(fun ty ->
|
||||||
|
if Btype.is_Tvar ty || mem Inj (get_variance ty tvl) then () else
|
||||||
|
let visited = ref TypeSet.empty in
|
||||||
|
let rec check ty =
|
||||||
|
let ty = Ctype.repr ty in
|
||||||
|
if TypeSet.mem ty !visited then () else begin
|
||||||
|
visited := TypeSet.add ty !visited;
|
||||||
|
if mem Inj (get_variance ty tvl) then () else
|
||||||
|
match ty.desc with
|
||||||
|
| Tvar _ -> raise Exit
|
||||||
|
| Tconstr _ ->
|
||||||
|
begin try
|
||||||
|
Btype.iter_type_expr check ty
|
||||||
|
with Exit ->
|
||||||
|
let ty' = Ctype.expand_head_opt env ty in
|
||||||
|
if ty == ty' then raise Exit else check ty'
|
||||||
|
end
|
||||||
|
| _ -> Btype.iter_type_expr check ty
|
||||||
|
end
|
||||||
|
in
|
||||||
|
try check ty; compute_variance env tvl injective ty
|
||||||
|
with Exit -> ())
|
||||||
|
params;
|
||||||
if check then begin
|
if check then begin
|
||||||
(* Check variance of parameters *)
|
(* Check variance of parameters *)
|
||||||
let pos = ref 0 in
|
let pos = ref 0 in
|
||||||
|
@ -154,7 +186,7 @@ let compute_variance_type env ~check (required, loc) decl tyl =
|
||||||
incr pos;
|
incr pos;
|
||||||
let var = get_variance ty tvl in
|
let var = get_variance ty tvl in
|
||||||
let (co,cn) = get_upper var and ij = mem Inj var in
|
let (co,cn) = get_upper var and ij = mem Inj var in
|
||||||
if Btype.is_Tvar ty && (co && not c || cn && not n || not ij && i)
|
if Btype.is_Tvar ty && (co && not c || cn && not n) || not ij && i
|
||||||
then raise (Error(loc, Bad_variance
|
then raise (Error(loc, Bad_variance
|
||||||
(Variance_not_satisfied !pos,
|
(Variance_not_satisfied !pos,
|
||||||
(co,cn,ij),
|
(co,cn,ij),
|
||||||
|
@ -350,10 +382,14 @@ let property : (prop, req) Typedecl_properties.property =
|
||||||
check;
|
check;
|
||||||
}
|
}
|
||||||
|
|
||||||
let transl_variance : Asttypes.variance -> _ = function
|
let transl_variance (v, i) =
|
||||||
| Covariant -> (true, false, false)
|
let co, cn =
|
||||||
| Contravariant -> (false, true, false)
|
match v with
|
||||||
| Invariant -> (false, false, false)
|
| Covariant -> (true, false)
|
||||||
|
| Contravariant -> (false, true)
|
||||||
|
| NoVariance -> (false, false)
|
||||||
|
in
|
||||||
|
(co, cn, match i with Injective -> true | NoInjectivity -> false)
|
||||||
|
|
||||||
let variance_of_params ptype_params =
|
let variance_of_params ptype_params =
|
||||||
List.map transl_variance (List.map snd ptype_params)
|
List.map transl_variance (List.map snd ptype_params)
|
||||||
|
|
|
@ -20,7 +20,8 @@ open Typedecl_properties
|
||||||
type surface_variance = bool * bool * bool
|
type surface_variance = bool * bool * bool
|
||||||
|
|
||||||
val variance_of_params :
|
val variance_of_params :
|
||||||
(Parsetree.core_type * Asttypes.variance) list -> surface_variance list
|
(Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list ->
|
||||||
|
surface_variance list
|
||||||
val variance_of_sdecl :
|
val variance_of_sdecl :
|
||||||
Parsetree.type_declaration -> surface_variance list
|
Parsetree.type_declaration -> surface_variance list
|
||||||
|
|
||||||
|
|
|
@ -483,7 +483,7 @@ and value_description =
|
||||||
and type_declaration =
|
and type_declaration =
|
||||||
{ typ_id: Ident.t;
|
{ typ_id: Ident.t;
|
||||||
typ_name: string loc;
|
typ_name: string loc;
|
||||||
typ_params: (core_type * variance) list;
|
typ_params: (core_type * (variance * injectivity)) list;
|
||||||
typ_type: Types.type_declaration;
|
typ_type: Types.type_declaration;
|
||||||
typ_cstrs: (core_type * core_type * Location.t) list;
|
typ_cstrs: (core_type * core_type * Location.t) list;
|
||||||
typ_kind: type_kind;
|
typ_kind: type_kind;
|
||||||
|
@ -527,7 +527,7 @@ and type_extension =
|
||||||
{
|
{
|
||||||
tyext_path: Path.t;
|
tyext_path: Path.t;
|
||||||
tyext_txt: Longident.t loc;
|
tyext_txt: Longident.t loc;
|
||||||
tyext_params: (core_type * variance) list;
|
tyext_params: (core_type * (variance * injectivity)) list;
|
||||||
tyext_constructors: extension_constructor list;
|
tyext_constructors: extension_constructor list;
|
||||||
tyext_private: private_flag;
|
tyext_private: private_flag;
|
||||||
tyext_loc: Location.t;
|
tyext_loc: Location.t;
|
||||||
|
@ -600,7 +600,7 @@ and class_type_declaration =
|
||||||
|
|
||||||
and 'a class_infos =
|
and 'a class_infos =
|
||||||
{ ci_virt: virtual_flag;
|
{ ci_virt: virtual_flag;
|
||||||
ci_params: (core_type * variance) list;
|
ci_params: (core_type * (variance * injectivity)) list;
|
||||||
ci_id_name: string loc;
|
ci_id_name: string loc;
|
||||||
ci_id_class: Ident.t;
|
ci_id_class: Ident.t;
|
||||||
ci_id_class_type: Ident.t;
|
ci_id_class_type: Ident.t;
|
||||||
|
|
|
@ -622,7 +622,7 @@ and type_declaration =
|
||||||
{
|
{
|
||||||
typ_id: Ident.t;
|
typ_id: Ident.t;
|
||||||
typ_name: string loc;
|
typ_name: string loc;
|
||||||
typ_params: (core_type * variance) list;
|
typ_params: (core_type * (variance * injectivity)) list;
|
||||||
typ_type: Types.type_declaration;
|
typ_type: Types.type_declaration;
|
||||||
typ_cstrs: (core_type * core_type * Location.t) list;
|
typ_cstrs: (core_type * core_type * Location.t) list;
|
||||||
typ_kind: type_kind;
|
typ_kind: type_kind;
|
||||||
|
@ -666,7 +666,7 @@ and type_extension =
|
||||||
{
|
{
|
||||||
tyext_path: Path.t;
|
tyext_path: Path.t;
|
||||||
tyext_txt: Longident.t loc;
|
tyext_txt: Longident.t loc;
|
||||||
tyext_params: (core_type * variance) list;
|
tyext_params: (core_type * (variance * injectivity)) list;
|
||||||
tyext_constructors: extension_constructor list;
|
tyext_constructors: extension_constructor list;
|
||||||
tyext_private: private_flag;
|
tyext_private: private_flag;
|
||||||
tyext_loc: Location.t;
|
tyext_loc: Location.t;
|
||||||
|
@ -739,7 +739,7 @@ and class_type_declaration =
|
||||||
|
|
||||||
and 'a class_infos =
|
and 'a class_infos =
|
||||||
{ ci_virt: virtual_flag;
|
{ ci_virt: virtual_flag;
|
||||||
ci_params: (core_type * variance) list;
|
ci_params: (core_type * (variance * injectivity)) list;
|
||||||
ci_id_name : string loc;
|
ci_id_name : string loc;
|
||||||
ci_id_class: Ident.t;
|
ci_id_class: Ident.t;
|
||||||
ci_id_class_type : Ident.t;
|
ci_id_class_type : Ident.t;
|
||||||
|
|
|
@ -477,14 +477,14 @@ let merge_constraint initial_env remove_aliases loc sg constr =
|
||||||
type_manifest = None;
|
type_manifest = None;
|
||||||
type_variance =
|
type_variance =
|
||||||
List.map
|
List.map
|
||||||
(fun (_, v) ->
|
(fun (_, (v, i)) ->
|
||||||
let (c, n) =
|
let (c, n) =
|
||||||
match v with
|
match v with
|
||||||
| Covariant -> true, false
|
| Covariant -> true, false
|
||||||
| Contravariant -> false, true
|
| Contravariant -> false, true
|
||||||
| Invariant -> false, false
|
| NoVariance -> false, false
|
||||||
in
|
in
|
||||||
make_variance (not n) (not c) false
|
make_variance (not n) (not c) (i = Injective)
|
||||||
)
|
)
|
||||||
sdecl.ptype_params;
|
sdecl.ptype_params;
|
||||||
type_separability =
|
type_separability =
|
||||||
|
|
Loading…
Reference in New Issue