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
Related
It seems that only a * b can fit in to _ and only (a,b) can fit in to (a,_).
I can imagine that a*b is a proper type for the internal product with components a and b whereas (a,b) is a external product of type a and type b (just a guess)
But are there examples distinguishing the two ?
type zero = Z : zero
type 'a succ = S : 'a succ
type _ ptree1 =
| Leaf : 'a -> ('a * zero) ptree1
| Node : (('a * 'n) ptree1 * ('a * 'n) ptree1) -> ('a * 'n succ) ptree1
type (_, _) ptree =
| Leaf : 'a -> ('a, zero) ptree
| Node : (('a, 'n) ptree * ('a, 'n) ptree) -> ('a, 'n succ) ptree
(* bad
type ('a * _) ptree =
| Leaf : 'a -> ('a, zero) ptree
| Node : (('a, 'n) ptree * ('a, 'n) ptree) -> ('a, 'n succ) ptree
*)
let rec last1 : type n a. (a * n) ptree1 -> a = function
| Leaf x -> x
| Node (_, t) -> last1 t
let rec last : type n a. (a, n) ptree -> a = function
| Leaf x -> x
| Node (_, t) -> last t
Type constructors have an arity in OCaml.
For instance, in
type ('a,'b) either =
| Left of 'a
| Right of 'b
the type constructor either has an arity of two. And ('a,'b) either denotes the type constructor either applied to two argument 'a and 'b. The form ('a,'b) does not exist by itself in the language.
However, it is possible to encode type constructor with an arity of n as a type constructor of arity 1 constrained on only having a n-tuple type as an argument.
Typically, this means rewriting either to
type 'p either2 =
| Left2 of 'a
| Right2 of 'b
constraint 'p = 'a * 'b
let translation: type a b. (a*b) either2 -> (a,b) either = function
| Left2 x -> Left x
| Right2 x -> Right x
Here, either2 is a type constructor of arity one, but which arguments must be a 2-tuple type.
This is the equivalent of translating a function of type 'a -> 'b -> 'c to a function of type 'a * 'b -> 'c at the type-level.
And another point of view is that type-level applications were written like function applications ('a,'b) either would be written either 'a 'b and ('a * 'b) either2 would become either2 ('a * 'b).
Without GADTs, this kind of encoding requires the use of an explicit constraint and they are thus not that frequent.
With GADTs, since the definition of the GADTs is free to construct its own type indices, this choice is simply more apparent. For instance, one can define an eccentric version of either as
type (_,_,_) either3 =
| Left3: 'a -> ('a list -> _, 'a * unit, _) either3
| Right3: 'a -> ( _ -> 'a array, _, unit * 'a) either3
let translate: type a b. (a list -> b array, a * unit, unit * b) either3 -> (a,b) either =
function
| Left3 x -> Left x
| Right3 x -> Right x
Here, either3 is a type constructor of arity 3, which stores the left and right types all over the place among its 3 argument.
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
I have such type:
type lT = LV of name
| LC of name
| LA of lT * lT
| LAb of name * lT
I want to implement a function called let's say s in a way that, it is gonna behave in the following way:
let println x = printf "%s\n" (s x)
s (`App(`App(`App(`Bs, `K), `K), `K)) ==> "B* K K K”
For this reason, I have implemented the following module:
module type L2C =
sig
val c1 : lT -> ([> `T | `L | `J
| `A of 'b * 'b | `V of name | `C of name] as 'b)
val c2 : lT -> ([> `T | `L | `J | `C | `D
| `A of 'b * 'b | `V of name | `C of name] as 'b)
val c3 : lT -> ([> `T | `L | `J | `C | `D | `Sp | `Bp | `Bs | `Cp
| `A of 'b * 'b | `V of name | `C of name] as 'b)
val e : ([< `T | `L | `J | `C | `D | `Sp | `Bp | `Bs | `Cp
| `A of 'b * 'b | `V of name | `C of name] as 'b) ->
([ `T | `L | `J | `C | `D | `Sp | `Bp | `Bs | `Cp
| `A of 'b * 'b | `V of name | `C of name] as 'b)
end
But since I am new in ocaml, I couldn't manage to create an "s" function to have the output I wanted.
What might be a possible way to do that?
I don't really understand the details of what you're trying to do, but I hope this can help:
let s expr =
let rec loop acc = function
| `Bs -> "B* "^acc
| `K -> "K "^acc
| `App(a,b) -> (loop acc a)^(loop acc b)
in
loop "" expr
The above works pretty well for the example you gave:
s (`App(`App(`App(`Bs, `K), `K), `K));;
- : string = "B* K K K "
You'll need to add extra cases to the pattern-match, and maybe a few type annotations if you want helpful type inference instead of the ugly polymorphic variant types.
In case you do not have to stick to :
s (`App(`App(`App(`Bs, `K), `K), `K)) ==> "B* K K K”
You could use ppx_deriving to automatically produce a function that transform your type into string (example in utop below) :
#require "ppx_deriving.std";;
type t = [`App of (t * t) | `B | `K] [##deriving show];; (* assuming your type is like this *)
> type t = [ `App of t * t | `B | `K ]
> val pp : Format.formatter -> t -> unit = <fun>
> val show : t -> string = <fun> ...
show (`App (`B , `App (`K , `K)));;
- : string = "`App ((`B, `App ((`K, `K))))"
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.
I have a parameterized type that recursively uses itself but with a type parameter specialized and when I implement a generic operator, the type of that operator is bound too tightly because of the case that handles the specialized sub-tree. The first code sample shows the problem, and the second shows a workaround that I'd rather not use because the real code has quite a few more cases so duplicating code this way is a maintenance hazard.
Here's a minimal test case that shows the problem:
module Op1 = struct
type 'a t = A | B (* 'a is unused but it and the _ below satisfy a sig *)
let map _ x = match x with
| A -> A
| B -> B
end
module type SIG = sig
type ('a, 'b) t =
| Leaf of 'a * 'b
(* Here a generic ('a, 'b) t contains a specialized ('a, 'a Op1.t) t. *)
| Inner of 'a * ('a, 'a Op1.t) t * ('a, 'b) t
val map : ('a -> 'b) -> ('a_t -> 'b_t) -> ('a, 'a_t) t -> ('b, 'b_t) t
end
module Impl : SIG = struct
type ('a, 'b) t =
| Leaf of 'a * 'b
| Inner of 'a * ('a, 'a Op1.t) t * ('a, 'b) t
(* Fails signature check:
Values do not match:
val map :
('a -> 'b) ->
('a Op1.t -> 'b Op1.t) -> ('a, 'a Op1.t) t -> ('b, 'b Op1.t) t
is not included in
val map :
('a -> 'b) -> ('a_t -> 'b_t) -> ('a, 'a_t) t -> ('b, 'b_t) t
*)
let rec map f g n = match n with
| Leaf (a, b) -> Leaf (f a, g b)
(* possibly because rec call is applied to specialized sub-tree *)
| Inner (a, x, y) -> Inner (f a, map f (Op1.map f) x, map f g y)
end
This modified version of Impl.map fixed the problem but introduces a maintenance hazard.
let rec map f g n = match n with
| Leaf (a, b) -> Leaf (f a, g b)
| Inner (a, x, y) -> Inner (f a, map_spec f x, map f g y)
and map_spec f n = match n with
| Leaf (a, b) -> Leaf (f a, Op1.map f b)
| Inner (a, x, y) -> Inner (f a, map_spec f x, map_spec f y)
Is there any way to get this to work without duplicating the body of let rec map?
Applying gasche's solution yields the following working code:
let rec map
: 'a 'b 'c 'd . ('a -> 'b) -> ('c -> 'd) -> ('a, 'c) t -> ('b, 'd) t
= fun f g n -> match n with
| Leaf (a, b) -> Leaf (f a, g b)
| Inner (a, x, y) -> Inner (f a, map f (Op1.map f) x, map f g y)
This style of recursion in datatype definitions is called "non-regular": the recursive type 'a t is reused at an instance foo t where foo is different from the single variable 'a used in the definition. Another well-known example is the type of full binary trees (with exactly 2^n leaves):
type 'a full_tree =
| Leaf of 'a
| Node of ('a * 'a) full_tree
Recursive functions that operate these datatypes typically suffer from the monomorphic recursion restriction of languages with type inference. When you do type inference you have to make a guess at what the type of a recursive function may be, before type-checking its body (as it may be use inside). ML languages refine this guess by unification/inference, but only monomorphic types may be inferred. If your function makes polymorphic uses of itself (it calls itself recursively on a different type that what it took as input), this cannot be inferred (it is undecidable in the general case).
let rec depth = function
| Leaf _ -> 1
| Node t -> 1 + depth t
^
Error: This expression has type ('a * 'a) full_tree
but an expression was expected of type 'a full_tree
Since 3.12, OCaml allows to use an explicit polymorphic annotation of
the form 'a 'b . foo, meaning forall 'a 'b. foo:
let rec depth : 'a . 'a full_tree -> int = function
| Leaf _ -> 1
| Node t -> 1 + depth t
You could do the same in your example. However, I wasn't able to
compile the type after using the annotation you have in your module
signature, as it appear to be wrong (the 'a_t are just weird). Here
is what I used to make it work:
let rec map : 'a 'b . ('a -> 'b) -> ('a Op1.t -> 'b Op1.t) ->
('a, 'a Op1.t) t -> ('b, 'b Op1.t) t
= fun f g n -> match n with
| Leaf (a, b) -> Leaf (f a, g b)
| Inner (a, x, y) -> Inner (f a, map f (Op1.map f) x, map f g y)