Polymorphic variants and type signatures - ocaml

(This is an extension / distillation of Polymorphic variants and let%bind type error)
Consider the following code:
Version 1:
let x : [> `Error1 ] = (`Error1 : [> `Error1 ])
let y : [> `Error1 | `Error2 ] = x
Version 2:
let x : [> `Error1 ] = (`Error1 : [ `Error1 ])
let y : [> `Error1 | `Error2 ] = x
Version 1 typechecks, but version 2 fails (I'm compiling with 4.09.0):
File "test.ml", line 2, characters 33-34:
2 | let y : [> `Error1 | `Error2 ] = x
^
Error: This expression has type [ `Error1 ]
but an expression was expected of type [> `Error1 | `Error2 ]
The first variant type does not allow tag(s) `Error2
Note that this error occurs in the definition of y, but the signature of x is the same in both cases! How is it that y can see inside the definition of x? Is there more typechecking information about x than its signature?

In brief, explicit type annotations are not type signatures.
In particular, in
let x : [> `Error1 ] = (`Error1 : [ `Error1 ])
the type of x is [ `Error1 ].
The root of the issue is that unification type variables in explicit type annotations can be unified with concrete types.
A simpler instance of your problem is
let f: 'a -> 'a = fun x -> x + 1
Here, the 'a -> 'a annotation is unified with the real type int->int and thus this code typechecks. If you want to make the type variable 'a universal, you need to be more explicit by adding an explicit universal quantification
let f: 'a. 'a -> 'a = fun x -> x + 1
Error: This definition has type int -> int which is less general than
'a. 'a -> 'a
The same phenomenon happens with your code with the implicit row variable:
let x : [> `Error1 ] = (`Error1 : [ `Error1 ])
This annotation does not guarantee that the type of x is [> `Error1] but only that it can be unified with [> `Error1]. And since the type [ `Error1 ] can be unified with [> `Error1 ], there is no reason to raise an error.
As before, if you want to avoid this issue, you need to be explicit about which variables are universally quantified in your annotation:
let x : 'row. ([> `Error1 ] as 'row) = (`Error1 : [ `Error1 ])
Error: This expression has type [ `Error1 ]
but an expression was expected of type [> `Error1 ]
The second variant type is bound to the universal type variable 'a,
it cannot be closed

Related

Can type variables be used when writing a type signature for a polymorphic variant type?

I would like to constrain a type variable to allow only polymorphic variant types, such that I could use the variable to construct other polymorphic variant types in a signature:
type 'a t
val f : 'a t -> [`Tag | 'a] t
Is there a way to accomplish this in OCaml? Perhaps using classes/objects instead? A naive attempt failed to compile:
type 'a t = { dummy: int } constraint 'a = [>]
let f : 'a t -> ['a | `Tag] t = fun _ -> { dummy = 0 }
^^
The type [> ] does not expand to a polymorphic variant type
Reason for the question:
I want to use the type signature to reflect capabilities of a t statically, to enforce that a t without a given capability can never be used inappropriately.
val do_something_cool : [<`Super_power] t -> unit
val do_something_else : [<`Super_power|`Extra_super_power] t -> unit
val enhance : 'a t -> ['a | `Super_power] t
val plain_t : [`Empty] t
let () = plain_t |> do_something_cool (* fails *)
let () = plain_t |> enhance |> do_something_cool (* succeeds *)
let () = plain_t |> enhance |> do_something_else (* succeeds *)
Obviously there are other ways to achieve this compile-time safety. For example, enhance could just return a [`Super_power] t that could be used in place of plain_t where required. However, I'm really curious whether the first way could succeed. I am writing a DSL which would be a lot more concise if all the capabilities of t could be reflected in its type.
The short answer is no: it is only possible to inline type declarations, not type variables. In other words, this is fine:
type on = [`On]
type off = [`Off]
type any = [ on | off ]
let f: [< any ] -> _ = fun _ -> ()
but not this
let merge: 'a -> 'b -> [ 'a | 'b ] = ...
However, if you only have a closed set of independent capabilities, it might work to switch to an object phantom type where each capacity correspond to a field and each field can be either on or off. For instance,
type +'a t constraint 'a = < super: [< any ]; extra: [< any ]>
Then consumer functions that only require a conjunction of capabilities are relatively easy to write:
val do_something_cool : < super:on; ..> t -> unit
val do_something_extra : < extra:on; ..> t -> unit
val do_something_super_but_not_extra: <super:on; extra:off; .. > t -> unit
but switching a capability on or off is more complex and fixes the set of capabilities:
val enhance : < super: _; extra: 'es > t -> < super: on; extra:'es > t
Beyond those limitations, everything works as expected. For instance, if I have a variable x
val x: <super: off; extra:on > t
This works:
let () = do_something_extra x
whereas
let () = do_something_cool x
fails and finally
let () =
let x = enhance x in
do_something_cool x; do_something_extra x
works fine too.
The main issue is thus writing the enable function. One trick that may help is to
write helper type to manipulate more easily a subset of capabilities.
For instance, if I have a complex type:
type 'a s
constraint 'a = < a: [< any]; b:[< any]; c: [< any ]; d: [< any] >
I can use the following type:
type ('a, 'others) a = < a:'a; b:'b; c:'c; d: 'd>
constraint 'others = 'b * 'c * 'd
to select the capability a, and thus write
val enable_a: (_,'rest) a s -> (on, 'rest) a s
without having to explicit the three type variables hidden in 'rest.

difference between dune utop and utop

If I load the following code in utop, after #require "mparser", it is accepted in the top level and give the signature below
open MParser
let infix p op = Infix (p |>> (fun _ a b -> (`Binop (op, a, b))), Assoc_left)
let operators =
[
[
infix (char '*') `Mul;
infix (char '/') `Div;
];
[
infix (char '+') `Add;
infix (char '-') `Sub;
];
]
let decimal = many1_chars digit |>> int_of_string
let term = (decimal |>> fun i -> `Int i)
let expr s = expression operators term s
let rec calc = function
| `Int i -> i
| `Binop (op, a, b) ->
match op with
| `Add -> calc a + calc b
| `Sub -> calc a - calc b
| `Mul -> calc a * calc b
| `Div -> calc a / calc b
accepted by utop as
val infix :
('a, 'b) MParser.t ->
'c -> ([> `Binop of 'c * 'd * 'd ] as 'd, 'b) MParser.operator = <fun>
val operators :
(_[> `Binop of _[> `Add | `Div | `Mul | `Sub ] * 'a * 'a | `Int of int ]
as 'a, unit)
MParser.operator list list =
[[Infix (<fun>, Assoc_left); Infix (<fun>, Assoc_left)];
[Infix (<fun>, Assoc_left); Infix (<fun>, Assoc_left)]]
val decimal : (int, unit) MParser.t = <fun>
val term : ([> `Int of int ], unit) MParser.t = <fun>
val expr :
unit MParser.state ->
(_[> `Binop of _[> `Add | `Div | `Mul | `Sub ] * 'a * 'a | `Int of int ]
as 'a, unit)
MParser.reply = <fun>
val calc :
([< `Binop of [< `Add | `Div | `Mul | `Sub ] * 'a * 'a | `Int of int ] as 'a) ->
int = <fun>
Now, if I try to load with dune utop a library containing this code as a file/module, I received the following error :
~$ dune utop lib
ocamlc lib/.lib.objs/lib__VariantExemple.{cmi,cmo,cmt} (exit 2)
(cd _build/default && /usr/local/bin/ocamlc.opt -w #a-4-29-40-41-42-44-45-48-58-59-60-40 -strict-sequence -strict-formats -short-paths -keep-locs -g -bin-annot -I lib/.lib.objs -I lib/.lib.objs/.private -I /Users/nrolland/.opam/system/lib/bytes -I /Users/nrolland/.opam/system/lib/mparser -I /Users/nrolland/.opam/system/lib/re -I /Users/nrolland/.opam/system/lib/re/perl -I /Users/nrolland/.opam/system/lib/seq -no-alias-deps -opaque -open Lib -o lib/.lib.objs/lib__VariantExemple.cmo -c -impl lib/variantExemple.ml)
File "lib/variantExemple.ml", line 5, characters 4-13:
Error: The type of this expression,
(_[> `Binop of _[> `Add | `Div | `Mul | `Sub ] * 'a * 'a | `Int of int ]
as 'a, '_weak1)
operator list list, contains type variables that cannot be generalized
It looks like there are some type annotation missing.
I am not too familiar with polymorphic variant type and , is there an obvious solution out ?
I was hoping that sticking the signature part given by utop in an interface would work, but it does not seem to be valid in a .mli file
Edit : the simple solution is to add a closed type annotation.
let operators : ([ `Binop of [ `Add | `Div | `Mul | `Sub ] * 'a * 'a | `Int of int ] as 'a, unit) operator list list =
I am not sure if there is a reason for why an interactive session and a dune utop lib one-shot loading should behave differently
You have _ in front of your types, which suggest your type is weakly polymorphic, and the compiler refuse to let such things live in a compiled object.
you can get the same result with the mwe :
let store = ref None
The toplevel is ok with that as it can be resolved to a monomorphic type later if you evaluate something like store:= Some1, which "monomorphise" the type from _a option ref to int option ref

Knot-tying with polymorphic variants

I have a variant defined in a module, and another module that basically extends the variant with a few more cases, so I'm using a polymorphic variant.
To prevent the subexpressions in Extended.exp being those of Core.exp, the knot is tied later.
module Core = struct
type 'a expr_f = [
| `Int of int
| `Plus of 'a expr_f * 'a expr_f
]
type expr = expr expr_f
end
module Ex = struct
type 'a expr_f = [
| 'a Core.expr_f
| `Times of 'a expr_f * 'a expr_f
]
type expr = expr expr_f
end
This seems to work, until we use a recursive function to traverse a value of type Ex.expr.
let rec test : Ex.expr -> Ex.expr = function
| `Int i -> `Int i
| `Plus (a, b) -> `Plus (test a, test b)
| `Times (a, b) -> `Times (test a, test b)
I get a type error with this because the type of Expr.expr_f is:
type 'a expr_f = [
| `Int of int
| `Plus of 'a Core.expr_f * 'a Core.expr_f
| `Times of 'a expr_f * 'a expr_f
]
The subexpressions are using Core.expr_f, which doesn't support the additional Times case.
What should I do to resolve this?
I'm not sure if I should just not declare the variant and have it left open because I do want to benefit from exhaustiveness checking.
If you really want to "tie the knot later", this is the definition you should have:
module Core = struct
type 'a expr_f = [
| `Int of int
| `Plus of 'a * 'a
]
type expr = expr expr_f
end
module Ex = struct
type 'a expr_f = [
| 'a Core.expr_f
| `Times of 'a * 'a
]
type expr = expr expr_f
end

OCaml: type inference with polymorphic variants

Function f argument type is [< 'A | 'B] that's what I want.
# let rec f = function
| `A -> 0
| `B -> let _ = f in 1
;;
val f : [< `A | `B ] -> int = <fun>
However, if I call it recursively with 'A it infers an undesired for me type [< 'A | 'B > 'A] which requires at least 'A:
# let rec f = function
| `A -> 0
| `B -> let _ = f `A in 1
;;
val f : [< `A | `B > `A ] -> int = <fun>
I still need to recursively call f 'A, but how do I keep the type [< 'A | 'B]?
This is yet another instantiation of the let-polymorphism constraints, that hinders the usage of polymorphic recursive function. Since, OCaml 3.12 we have an explicit way to declare that your function is polymorphic.
Your case is a little bit more complex, since you have implicit type variable, that occurs inside the row-polymorphic type. Maybe there is a better way, but my approach is to make this type variable explicit, with the following type definition
type 'a t = 'a constraint 'a = [< `A | `B]
With such handy type, it is easy to write a proper annotation for a function:
let rec f : 'a . 'a t -> int = function
| `A -> 0
| `B -> let _ = f `A in 1
Just in case, if you don't want to expose this 'a t, that's ok, since you're not required, 'a t is equal to [< 'A | 'B] it just makes 'a type variable explicit:
module M : sig
val f : [< `A | `B] -> int
end = struct
let rec f : 'a . 'a t -> int = function
| `A -> 0
| `B -> let _ = f `A in 1
end;;
Without introducing 'a t type, you can make it with a little bit uglier (but this is of course a matter of taste) notation:
let rec f : 'a . ([< `A | `B] as 'a) -> int = function
| `A -> 0
| `B -> let _ = f `A in 1
Of course, this will not scale, for non trivial types.

Type-level arithmetic: "at most" nat or nat interval

Using type-level arithmetic in OCaml, it's easy to define a function which takes a nat higher than a specific value:
let f : 'a succ nat -> string = function _ -> "hej"
f Zero (* <-- Won't compile, argument must be > 0 *)
Is there any way to make the function accept "at most" a value, or an interval, like 0 < n < 10?
Btw, this is the type definitions:
type z = Z
type 'n succ = S of 'n
type ( 'n) nat =
| Zero : ( z) nat
| Succ : ( 'n) nat -> ( 'n succ) nat
One possibility is to use polymorphic variants.
let g : [`A0 of z nat | `A1 of (z succ) nat ] -> string = function
_ -> "hej"
It's definitely not beautiful like your example, though it is fairly flexible if you can stand the syntactic burden.
How about the following?
By using open polymorphic variants we can write a function that can only be applied on 1,3 and 4. It would obviously be quite unwieldy to write constraints for very large numbers.
First, let's define our nat type and the numbers one to five:
# type _ nat =
Zero : [> `Zero] nat
| Succ : 'a nat -> [> `Succ of 'a] nat;;
type _ nat = Zero : [> `Zero ] nat | Succ : 'a nat -> [> `Succ of 'a ] nat
# let one = Succ Zero;;
val one : [> `Succ of [> `Zero ] ] nat = Succ Zero
# let two = Succ one;;
val two : [> `Succ of [> `Succ of [> `Zero ] ] ] nat = Succ (Succ Zero)
# let three = Succ two;;
val three : [> `Succ of [> `Succ of [> `Succ of [> `Zero ] ] ] ] nat =
Succ (Succ (Succ Zero))
# let four = Succ three;;
val four :
[> `Succ of [> `Succ of [> `Succ of [> `Succ of [> `Zero ] ] ] ] ] nat =
Succ (Succ (Succ (Succ Zero)))
# let five = Succ four;;
val five :
[> `Succ of
[> `Succ of [> `Succ of [> `Succ of [> `Succ of [> `Zero ] ] ] ] ] ]
nat = Succ (Succ (Succ (Succ (Succ Zero))))
Now let's define some types for representing our restrictions:
# type 'a no = [`Succ of 'a];;
type 'a no = [ `Succ of 'a ]
# type 'a yes = [ `Succ of 'a | `Zero ];;
type 'a yes = [ `Succ of 'a | `Zero ]
# type last = [ `Zero ];;
type last = [ `Zero ]
Using these types we can express a number that is 1,3 or 4 as (last yes no yes no) nat. Here no means don't allow this number, whilst yes and last mean do allow this number. Note that we are counting from the right-hand side.
Now we can define our function. Note that we only need to include cases for the numbers in our function's domain:
# let f (x : (last yes no yes no) nat) =
match x with
Succ Zero -> "1"
| Succ (Succ (Succ Zero)) -> "3"
| Succ (Succ (Succ (Succ Zero))) -> "4";;
val f : last yes no yes no nat -> string = <fun>
Finally, we can try out our function on the numbers one to five, getting some nice large error messages for incorrect usage:
# f Zero;;
Characters 2-6:
f Zero;;
^^^^
Error: This expression has type ([> `Zero ] as 'a) nat
but an expression was expected of type last yes no yes no nat
Type 'a is not compatible with type
last yes no yes no = [ `Succ of last yes no yes ]
The second variant type does not allow tag(s) `Zero
# f one;;
- : string = "1"
# f two;;
Characters 2-5:
f two;;
^^^
Error: This expression has type
([> `Succ of [> `Succ of [> `Zero ] as 'c ] as 'b ] as 'a) nat
but an expression was expected of type last yes no yes no nat
Type 'a is not compatible with type
last yes no yes no = [ `Succ of last yes no yes ]
Type 'b is not compatible with type
last yes no yes = [ `Succ of last yes no | `Zero ]
Type 'c is not compatible with type
last yes no = [ `Succ of last yes ]
The second variant type does not allow tag(s) `Zero
# f three;;
- : string = "3"
# f four;;
- : string = "4"
# f five;;
Characters 2-6:
f five;;
^^^^
Error: This expression has type
([> `Succ of
[> `Succ of
[> `Succ of
[> `Succ of [> `Succ of [> `Zero ] ] as 'e ] as 'd ]
as 'c ]
as 'b ]
as 'a)
nat
but an expression was expected of type last yes no yes no nat
Type 'a is not compatible with type
last yes no yes no = [ `Succ of last yes no yes ]
Type 'b is not compatible with type
last yes no yes = [ `Succ of last yes no | `Zero ]
Type 'c is not compatible with type
last yes no = [ `Succ of last yes ]
Type 'd is not compatible with type
last yes = [ `Succ of last | `Zero ]
Type 'e is not compatible with type last = [ `Zero ]
The second variant type does not allow tag(s) `Succ