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
Related
I don't have much experience with ocmal and the compiler error message isn't very helpful. I don't see any obvious problem with the code. I have the full code and the error message below. Thank you.
Full compiler error message:
File "compile.ml",
| Id(x) ->
^^
Error: This variant pattern is expected to have type prim1
The constructor Id does not belong to type prim1
type reg =
| EAX
| ESP
type arg =
| Const of int
| Reg of reg
| RegOffset of int * reg
type instruction =
| IMov of arg * arg
| IAdd of arg * arg
| IRet
type prim1 =
| Add1
| Sub1
type expr =
| Number of int
| Prim1 of prim1 * expr
| Let of (string * expr) list * expr
| Id of string
let rec find (ls : (string * int) list) (x : string) =
match ls with
| [] -> None
| (y,v)::rest ->
if y = x then Some(v) else find rest x
let rec compile_env (p : expr) (stack_index : int) (env : (string * int) list) : instruction list =
match p with
| Number(n) -> [ IMov(Reg(EAX), Const(n)) ]
| Prim1(op, e) ->
match op with
| Add1 -> (compile_env e stack_index env) # [ IAdd(Reg(EAX), Const(1)) ]
| Sub1 -> (compile_env e stack_index env) # [ IAdd(Reg(EAX), Const(-1)) ]
| Id(x) ->
match find env x with
| None -> failwith "%s not in scope" x
| Some value -> [IMov(Reg(EAX), RegOffset(value, Reg(ESP)))]
| Let(binds, body) ->
match binds with
| [] -> [] # (compile_env body stack_index env)
| (str, exp)::rest ->
let new_env = env # [(str, -4*stack_index)] in
let eval_expr = (compile_env exp stack_index env) in
let eval_tail = (compile_env Let(rest, body) stack_index+1 new_env) in
eval_expr # [IMov(RegOffset(-4*stack_index, Reg(ESP)), Reg(EAX))] # eval_tail
It looks like your problem is that you have nested match expressions. The difficulty is that the compiler is thinking that the next case of the outer match is in fact the next case of the inner match.
The solution is to parenthesize all of the the inner match expressions.
It should look something like this:
match p with
| Number(n) -> [ IMov(Reg(EAX), Const(n)) ]
| Prim1(op, e) ->
(match op with
| Add1 -> (compile_env e stack_index env) # [ IAdd(Reg(EAX), Const(1)) ]
| Sub1 -> (compile_env e stack_index env) # [ IAdd(Reg(EAX), Const(-1)) ]
)
. . .
You need to do this for all of the nested match expressions (I see 3 of them).
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))))"
I am writing a small interpreter in OCaml and am using GADTs to type my expressions:
type _ value =
| Bool : bool -> bool value
| Int : int -> int value
| Symbol : string -> string value
| Nil : unit value
| Pair : 'a value * 'b value -> ('a * 'b) value
and _ exp =
| Literal : 'a value -> 'a exp
| Var : name -> 'a exp
| If : bool exp * 'a exp * 'a exp -> 'a exp
and name = string
exception NotFound of string
type 'a env = (name * 'a) list
let bind (n, v, e) = (n, v)::e
let rec lookup = function
| (n, []) -> raise (NotFound n)
| (n, (n', v)::e') -> if n=n' then v else lookup (n, e')
let rec eval : type a. a exp -> a value env -> a value = fun e rho ->
match e with
| Literal v -> v
| Var n -> lookup (n, rho)
| If (b, l, r) ->
let Bool b' = eval b rho in
if b' then eval l rho else eval r rho
But I cannot get my code to compile. I get the following error:
File "gadt2.ml", line 33, characters 33-36:
Error: This expression has type a value env = (name * a value) list
but an expression was expected of type
bool value env = (name * bool value) list
Type a is not compatible with type bool
My understanding is that for some reason rho is being coerced into a bool value env, but I don't know why. I also tried the following:
let rec eval : 'a. 'a exp -> 'a value env -> 'a value = fun e rho ->
match e with
| Literal v -> v
| Var n -> lookup (n, rho)
| If (b, l, r) ->
let Bool b = eval b rho in
if b then eval l rho else eval r rho
But I am not sure how exactly that is different, and it also gives me an error -- albeit a different one:
File "gadt2.ml", line 38, characters 56-247:
Error: This definition has type bool exp -> bool value env -> bool value
which is less general than 'a. 'a exp -> 'a value env -> 'a value
Guidance on GADTs, differences between the two evals, and this particular problem are all appreciated. Cheers.
The type 'a env is intended to represent a list of name/value bindings, but the values in a list must all be the same type. Two different value types (such as bool value and int value) are not the same type. If eval b rho returns Bool b, rho must be a list of string * bool value. So eval l rho and eval r rho will return bool value. But your annotation says the function returns a value.
There are a few possible approaches to typed binding with GADTs. Here's a design that associates type info with both variables and environment entries.
Environment lookup involves attempting to construct a correspondence between the types of the variable and the environment entry (which is a bit slow, but does recover the type in a safe way). This is what allows the lookup to return an unwrapped value of arbitrary type.
type var = string
type _ ty =
| TyInt : int ty
| TyArrow : 'a ty * 'b ty -> ('a -> 'b) ty
type _ term =
| Int : int -> int term
| Var : 'a ty * var -> 'a term
| Lam : 'a ty * var * 'b term -> ('a -> 'b) term
| App : ('a -> 'b) term * 'a term -> 'b term
type ('a, 'b) eq = Refl : ('a, 'a) eq
let rec types_equal : type a b . a ty -> b ty -> (a, b) eq option =
fun a b ->
match a, b with
| TyInt, TyInt -> Some Refl
| TyArrow (x1, y1), TyArrow (x2, y2) ->
begin match types_equal x1 x2, types_equal y1 y2 with
| Some Refl, Some Refl -> Some Refl
| _, _ -> None
end
| _, _ -> None
type env = Nil | Cons : var * 'a ty * 'a * env -> env
let rec lookup : type a . a ty -> var -> env -> a =
fun ty var -> function
| Nil -> raise Not_found
| Cons (xname, xty, x, rest) ->
if var = xname then
match types_equal ty xty with
| Some Refl -> x
| None -> assert false
else
lookup ty var rest
let rec eval : type a . env -> a term -> a =
fun env -> function
| Int n -> n
| Var (ty, var) -> lookup ty var env
| App (f, x) -> (eval env f) (eval env x)
| Lam (arg_ty, arg_name, body) ->
fun arg_value ->
eval (Cons (arg_name, arg_ty, arg_value, env)) body
It is possible to have a typed interpreter that avoids the type reconstruction (and the string comparison!) by enforcing the correspondence between variable indices and environments at the type level, but that gets complicated.
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
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.