问题
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.
回答1:
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.
回答2:
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.
来源：https://stackoverflow.com/questions/41797085/writing-an-interpreter-with-ocaml-gadts