Why does OCaml think that this function takes an int parameter when nothing suggests that it should be the case? - ocaml

I was working on chapter 1 of Modern Compiler Implementation in ML by Andrew Appel and I decided to implement it in OCaml instead of SML. I'm new to OCaml and I came across a very frustrating problem. OCaml seems to think that the below function has the signature int * (int * 'a) -> 'a option.
let rec lookupTable = function
| name, (i, v) :: _ when name = i -> Some v
| name, (_, _) :: rest -> lookupTable (name, rest)
| _, [] -> None
But as far as I can tell, there should be nothing that suggests that the first element in the tuple is an int. This is a problem because when the lookupTable function down the line, the compiler complains that I am not passing it an integer. Perhaps I am missing something incredibly obvious, but it has been pretty mind-boggling. Here is the rest of the program
open Base
type id = string
type binop = Plus | Minus | Times | Div
type stm =
| CompoundStm of stm * stm
| AssignStm of id * exp
| PrintStm of exp list
and exp =
| IdExp of id
| NumExp of int
| OpExp of exp * binop * exp
| EseqExp of stm * exp
(* Returns the maximum number of arguments of any print
statement within any subexpression of a given statement *)
let rec maxargs s =
match s with
| CompoundStm (stm1, stm2) -> Int.max (maxargs stm1) (maxargs stm2)
| AssignStm (_, exp) -> maxargs_exp exp
(* Might be more nested expressions *)
| PrintStm exps -> Int.max (List.length exps) (maxargs_explist exps)
and maxargs_exp e = match e with EseqExp (stm, _) -> maxargs stm | _ -> 0
and maxargs_explist exps =
match exps with
| exp :: rest -> Int.max (maxargs_exp exp) (maxargs_explist rest)
| [] -> 0
type table = (id * int) list
let updateTable name value t : table = (name, value) :: t
let rec lookupTable = function
| name, (i, v) :: _ when name = i -> Some v
| name, (_, _) :: rest -> lookupTable (name, rest)
| _, [] -> None
exception UndefinedVariable of string
let rec interp s =
let t = [] in
interpStm s t
and interpStm s t =
match s with
| CompoundStm (stm1, stm2) -> interpStm stm2 (interpStm stm1 t)
| AssignStm (id, exp) ->
let v, t' = interpExp exp t in
updateTable id v t'
(* Might be more nested expressions *)
| PrintStm exps ->
let interpretAndPrint t e =
let v, t' = interpExp e t in
Stdio.print_endline (Int.to_string v);
t'
in
List.fold_left exps ~init:t ~f:interpretAndPrint
and interpExp e t =
match e with
| IdExp i -> (
match lookupTable (i, t) with
| Some v -> (v, t)
| None -> raise (UndefinedVariable i))
| NumExp i -> (i, t)
| OpExp (exp1, binop, exp2) ->
let exp1_val, t' = interpExp exp1 t in
let exp2_val, _ = interpExp exp2 t' in
let res =
match binop with
| Plus -> exp1_val + exp2_val
| Minus -> exp1_val - exp2_val
| Times -> exp1_val * exp2_val
| Div -> exp1_val / exp2_val
in
(res, t')
| EseqExp (s, e) -> interpExp e (interpStm s t)

Base defines = as int -> int -> bool, so when you have the expression name = i the compiler will infer them as ints.
You can access the polymorphic functions and operators through the Poly module, or use a type-specific operator by locally opening the relevant module, e.g. String.(name = i).
The reason Base does not expose polymorphic operators by default is briefly explained in the documentation's introduction:
The comparison operators exposed by the OCaml standard library are polymorphic:
What they implement is structural comparison of the runtime representation of values. Since these are often error-prone, i.e., they don't correspond to what the user expects, they are not exposed directly by Base.
There's also a performance-argument to be made, because the polymorphic/structural operators need to also inspect what kind of value it is at runtime in order to compare them correctly.

Related

How to define "apply" in OCaml

I am trying to define a function that is similar to Lisp's apply. Here is my attempt:
type t =
| Str of string
| Int of int
let rec apply f args =
match args with
| (Str s)::xs -> apply (f s) xs
| (Int i)::xs -> apply (f i) xs
| [] -> f
(* Example 1 *)
let total = apply (fun x y z -> x + y + z)
[Int 1; Int 2; Int 3]
(* Example 2 *)
let () = apply (fun name age ->
Printf.printf "Name: %s\n" name;
Printf.printf "Age: %i\n" age)
[Str "Bob"; Int 99]
However, this fails to compile. The compiler gives this error message:
File "./myprog.ml", line 7, characters 25-30:
7 | | (Str s)::xs -> apply (f s) xs
^^^^^
Error: This expression has type 'a but an expression was expected of type
string -> 'a
The type variable 'a occurs inside string -> 'a
What is the meaning of this error message? How can I fix the problem and implement apply?
You cannot mix an untyped DSL for data:
type t =
| Int of int
| Float of float
and a shallow embedding (using OCaml functions as functions inside the DSL) for functions in apply
let rec apply f args =
match args with
| (Str s)::xs -> apply (f s) xs (* f is int -> 'a *)
| (Int i)::xs -> apply (f i) xs (* f is string -> 'a *)
| [] -> f (* f is 'a *)
The typechecker is complaining that if f has type 'a, f s cannot also have for type 'a since it would mean that f has simultaneously type string -> 'a and 'a (without using the recursive types flag).
And more generally, your function apply doesn't use f with a coherent type: sometimes it has type 'a, sometimes it has type int -> 'a, other times it would rather have type string -> 'a. In other words, it is not possible to write a type for apply
val apply: ??? (* (int|string) -> ... *) -> t list -> ???
You have to choose your poison.
Either go with a fully untyped DSL which contains functions, that can be applied:
type t =
| Int of int
| Float of float
| Fun of (t -> t)
exception Type_error
let rec apply f l = match f, l with
| x, [] -> f
| Fun f, a :: q -> apply (f a) q
| (Int _|Float _), _ :: _ -> raise Type_error
or use OCaml type system and define a well-typed list of arguments with a GADT:
type ('a,'b) t =
| Nil: ('a,'a) t
| Cons: 'a * ('b,'r) t -> ('a -> 'b,'r) t
let rec apply: type f r. f -> (f,r) t -> r = fun f l ->
match l with
| Nil -> f
| Cons (x,l) -> apply (f x) l
EDIT:
Using the GADT solution is quite direct since we are using usual OCaml type without much wrapping:
let three = apply (+) (Cons(1, Cons(2,Nil)))
(and we could use a heterogeneous list syntactic sugar to make this form even lighter syntactically)
The untyped DSL requires to build first a function in the DSL:
let plus = Fun(function
| Float _ | Fun _ -> raise Type_error
| Int x -> Fun(function
| Float _ | Fun _ -> raise Type_error
| Int y -> Int (x+y)
)
)
but once we have built the function, it is relatively straightforward:
let three = apply_dsl plus [Int 2; Int 1]
type t =
| Str of string
| Int of int
| Unit
let rec apply f args =
match args with
| x::xs -> apply (f x) xs
| [] -> f Unit
Let's go step by step:
line 1: apply : 'a -> 'b -> 'c (we don't know the types of f, args and apply's return type
line 2 and beginning of line 3: args : t list so apply : 'a -> t list -> 'c
rest of line 3: Since f s (s : string), f : string -> 'a but f t : f because apply (f s). This means that f contains f in its type, this is a buggy behaviour
It's actually buggy to call f on s and i because this means that f can take a string or an int, the compiler will not allow it.
And lastly, if args is empty, you return f so the return type of f is the type of f itself, another buggy part of this code.
Looking at your examples, a simple solution would be:
type t = Str of string | Int of int
let rec apply f acc args =
match args with x :: xs -> apply f (f acc x) xs | [] -> acc
(* Example 1 *)
let total =
apply
(fun acc x ->
match x with Int d -> d + acc | Str _ -> failwith "Type error")
0 [ Int 1; Int 2; Int 3 ]
(* Example 2 *)
let () =
apply
(fun () -> function
| Str name -> Printf.printf "Name: %s\n" name
| Int age -> Printf.printf "Age: %i\n" age)
() [ Str "Bob"; Int 99 ]
Since you know the type you want to work on, you don't need GADT shenanigans, just let f handle the pattern matching and work with an accumulator

expanding type equation generator in OCaml

type exp =
| CONST of int
| VAR of var
| ADD of exp * exp
| SUB of exp * exp
| ISZERO of exp
| IF of exp * exp * exp
| LET of var * exp * exp
| PROC of var * exp
| CALL of exp * exp
and var = string
type typ = TyInt | TyBool | TyFun of typ * typ | TyVar of tyvar
and tyvar = string
type typ_eqn = (typ * typ) list
module TEnv = struct
type t = var -> typ
let empty = fun _ -> raise (Failure "Type Env is empty")
let extend (x,t) tenv = fun y -> if x = y then t else (tenv y)
let find tenv x = tenv x
end
let rec gen_equations : TEnv.t -> exp -> typ -> typ_eqn
=fun tenv e ty -> match e with
| CONST n -> [(ty, TyInt)]
| VAR x -> [(ty, TEnv.find tenv x)]
| ADD (e1,e2) -> [(ty, TyInt)]#
[gen_equations (tenv, e1, TyInt)]#
[gen_equations (tenv, e2, TyInt)]
Implementing type equation generator in OCaml
I'm expanding type checker based on above code
What I want to do is add "EQUAL" expression, which take two input and return TyBool as output
Problem is how to make equation of input, as input is not a fixed type.
EQUAL can take both TyInt and TyBool as input
ex)
EQUAL (FALSE, FALSE) have output TRUE (because false == false)
EQUAL (5, 3) have output FALSE (because 5 != 3)
How can I make equation?
Your EQUAL expression has a polymorphic type, i.e., it is typable for integers and variables. It is your choice, as a language designer, which flavor of polymorphism you will implement. You can start with the classical parametric polymorphism. In that case, you will type EQUAL as 'a -> 'a -> bool, or, in the parlance of your representation,
TyFun (TyVar a, TyFun (TyVar a, TyBool))
Then, during the unification process, the type variable a will be unified either with TyBool or with TyVar (well, it could also unify with functional types, which you can turn into a type error if you wish).
Alternatively, you can implement EQUAL using ad-hoc polymorphism. This will require you to change your type system though, i.e., to add new constructors to your type typ. You can take the type classes approach and have TyCls of string * typ and give EQUAL the following type,
TyFun (TyCls ("comparable",t), TyFun (TyCls ("comparable",t), TyBool))
But inference with type classes is hard and is not always decidable.

how to implement lambda-calculus in OCaml?

In OCaml, it seems that "fun" is the binding operator to me. Does OCaml have built-in substitution? If does, how it is implemented? is it implemented using de Bruijn index?
Just want to know how the untyped lambda-calculus can be implemented in OCaml but did not find such implementation.
As Bromind, I also don't exactly understand what you mean by saying "Does OCaml have built-in substitution?"
About lambda-calculus once again I'm not really understand but, if you talking about writing some sort of lambda-calculus interpreter then you need first define your "syntax":
(* Bruijn index *)
type index = int
type term =
| Var of index
| Lam of term
| App of term * term
So (λx.x) y will be (λ 0) 1 and in our syntax App(Lam (Var 0), Var 1).
And now you need to implement your reduction, substitution and so on. For example you may have something like this:
(* identity substitution: 0 1 2 3 ... *)
let id i = Var i
(* particular case of lift substitution: 1 2 3 4 ... *)
let lift_one i = Var (i + 1)
(* cons substitution: t σ(0) σ(1) σ(2) ... *)
let cons (sigma: index -> term) t = function
| 0 -> t
| x -> sigma (x - 1)
(* by definition of substitution:
1) x[σ] = σ(x)
2) (λ t)[σ] = λ(t[cons(0, (σ; lift_one))])
where (σ1; σ2)(x) = (σ1(x))[σ2]
3) (t1 t2)[σ] = t1[σ] t2[σ]
*)
let rec apply_subs (sigma: index -> term) = function
| Var i -> sigma i
| Lam t -> Lam (apply_subs (function
| 0 -> Var 0
| i -> apply_subs lift_one (sigma (i - 1))
) t)
| App (t1, t2) -> App (apply_subs sigma t1, apply_subs sigma t2)
As you can see OCaml code is just direct rewriting of definition.
And now small-step reduction:
let is_value = function
| Lam _ | Var _ -> true
| _ -> false
let rec small_step = function
| App (Lam t, v) when is_value v ->
apply_subs (cons id v) t
| App (t, u) when is_value t ->
App (t, small_step u)
| App (t, u) ->
App (small_step t, u)
| t when is_value t ->
t
| _ -> failwith "You will never see me"
let rec eval = function
| t when is_value t -> t
| t -> let t' = small_step t in
if t' = t then t
else eval t'
For example you can evaluate (λx.x) y:
eval (App(Lam (Var 0), Var 1))
- : term = Var 1
OCaml does not perform normal-order reduction and uses call-by-value semantics. Some terms of lambda calculus have a normal form than cannot be reached with this evaluation strategy.
See The Substitution Model of Evaluation, as well as How would you implement a beta-reduction function in F#?.
I don't exactly understand what you mean by saying "Does OCaml have built-in substitution? ...", but concerning how the lambda-calculus can be implemented in OCaml, you can indeed use fun : just replace all the lambdas by fun, e.g.:
for the church numerals: you know that zero = \f -> (\x -> x), one = \f -> (\x -> f x), so in Ocaml, you'd have
let zero = fun f -> (fun x -> x)
let succ = fun n -> (fun f -> (fun x -> f (n f x)))
and succ zero gives you one as you expect it, i.e. fun f -> (fun x -> f x) (to highlight it, you can for instance try (succ zero) (fun s -> "s" ^ s) ("0") or (succ zero) (fun s -> s + 1) (0)).
As far as I remember, you can play with let and fun to change the evaluation strategy, but to be confirmed...
N.B.: I put all parenthesis just to make it clear, maybe some can be removed.

Writing an interpreter with OCaml GADTs

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.

Filtering OCaml list to one variant

So I have a list of stmt (algebraic type) that contain a number of VarDecl within the list.
I'd like to reduce the list from stmt list to VarDecl list.
When I use List.filter I can eliminate all other types but I'm still left with a stmt list.
I found that I was able to do the filtering as well as the type change by folding, but I can't figure out how to generalize it (I need this pattern many places in the project).
let decls = List.fold_left
(fun lst st -> match st with
| VarDecl(vd) -> vd :: lst
| _ -> lst
) [] stmts in
Is there a better way to perform a filter and cast to a variant of the list type?
Assuming you have a type like
type stmt = VarDecl of int | Foo of int | Bar | Fie of string
and a stmt list, Batteries lets you do
let vardecl_ints l =
List.filter_map (function Vardecl i -> Some i | _ -> None) l
let foo_ints l =
List.filter_map (function Foo i -> Some i | _ -> None) l
which I think is about as concise as you're going to get. I don't
think you can make general "list-getters" for ADT's, because e.g.
let bars l =
List.filter_map (function Bar -> Some Bar | _ -> None) l
https://github.com/ocaml-batteries-team/batteries-included/blob/d471e24/src/batList.mlv#L544
has the Batteries implementation of filter_map, if you don't want the
dependency. A functional version with [] instead of dst would be quite similar, only doing
(x::dst) and a |>List.rev at the end.
You could use GADTs or polymorphic variants, but both tend to drive up complexity.
Here's a rough sketch of how you might approach this problem with polymorphic variants:
type constant = [ `Int of int | `String of string ]
type var = [ `Var of string ]
type term = [ constant | var | `Add of term * term ]
let rec select_vars (list : term list) : var list =
match list with
| [] -> []
| (#var as v)::list -> v::select_vars list
| _::list -> select_vars list
let rec select_constants (list : term list) : constant list =
match list with
| [] -> []
| (#constant as k)::list -> k::select_constants list
| _::list -> select_constants list
Another possibility is to pull the bits of a var out into an explicit type of which you can have a list:
type var = {
...
}
type term =
| Int of int
| Var of var
This has some overhead over having the bits just be constructor args, and a var is not a term, so you will likely need to do some wrapping and unwrapping.
It's hard to answer without seeing your type definition (or a simplified version of it).
Note, though, that if you have this definition:
type xyz = X | Y | Z
The values X, Y, and Z aren't types. They're values. Possibly Vardecl is a value also. So you can't have a list of that type (in OCaml).
Update
One thing I have done for cases like this is to use the type projected from the one variant you want:
type xyz = X | Y of int * int | Z
let extract_proj v l =
match v with
| X | Z -> l
| Y (a, b) -> (a, b) :: l
let filter_to_y l =
List.fold_right extract_proj l []
Here's a toplevel session:
type xyz = X | Y of int * int | Z
val extract_proj : xyz -> (int * int) list -> (int * int) list = <fun>
val filter_to_y : xyz list -> (int * int) list = <fun>
# filter_to_y [X; Z; Y(3,4); Z; Y(4,5)];;
- : (int * int) list = [(3, 4); (4, 5)]