I'm getting a match failure for my OCaml code and I have no idea what the issue might be. I attempted having one case only and going from there to figure out where the issue comes up but the error I receive is :
Exception: Match_failure ("hw2.ml", 49, 0).
Code :
let rec compileStack(il : instr list) (st : float list) =
match (il,st) with
[],[_] -> List.hd st
|((Push f)::t),[_] -> compileStack t (f::st)
|(Swap)::t, h2::h1::st -> compileStack t (h2::h1::st)
|(Calculate op)::t, h1::h2::st ->
match op with
Plus -> compileStack t (h2+.h1::st)
| Minus -> compileStack t (h2-.h1::st)
| Times -> compileStack t (h2*.h1::st)
| Divide -> compileStack t (h2/.h1::st) ;;
let execute (li : instr list) : float =
let stack = [] in
compileStack li stack;;
Any suggestion will be highly appreciated, been stuck on this for 2 hours now.
When compiling pay attention to the compiler's output. If it says something like
Warning ...: this pattern-matching is not exhaustive.
then it usually means you skipped some cases. By the way, the compiler provides an example of missed cases.
Considering your problem, I'd separate different jobs into different functions -- that will let you handle those cases easier; also don't forget about stack underflows, which happen when there is not enough data in the stack to perform swaps or binary arithmetic operations. See the example below.
(* just type aliases for convenience *)
type stack = float list
type binop = float -> float -> float
(* helper function to prevent nested pattern matching below *)
let denote_operation (op : oper) : binop =
match op with
| Plus -> ( +. )
| Minus -> ( -. )
| Times -> ( *. )
| Divide -> ( /. )
(* This function executes only 1 instruction and
returns 'stack option', which may signal stack underflow *)
let execute_instruction (i : instr) (st : stack) : stack option =
match i with
| Push f -> Some (f :: st)
| Swap ->
(match st with
| y :: x :: st' -> Some (x :: y :: st')
| _ -> None)
| Calculate op ->
(match st with
| y :: x :: st' -> Some ((denote_operation op x y) :: st')
| _ -> None)
(* this function deals with a bunch of instructions *)
let rec execute_program (il : instr list) (st : stack) : stack option =
match il with
| [] -> Some st
| i :: il' ->
match (execute_instruction i st) with
| None -> None
| Some st' -> execute_program il' st'
Related
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.
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
I am trying to write a function run taking a parameter to parametrize its level of execution. I want this function to return its output after a given level. I used GADTs to have the output of run depends on its input.
Here is the code:
type _ level_output =
| FirstO : int -> int level_output
| SecondO : float -> float level_output
| ThirdO : string -> string level_output
type _ run_level_g =
| First : int run_level_g
| Second : float run_level_g
| Third : string run_level_g
type run_level = Any : 'a run_level_g -> run_level
let first _ =
(*do stuff*)
1
let second _ =
(*do stuff*)
2.5
let third _ =
(*do stuff*)
"third"
let run1 (type a) (level:a run_level_g) data : a level_output =
let out = first data in
match level with
| First -> FirstO out
| Second ->
let out = second out in
SecondO out
| Third ->
let out = second out in
let out = third out in
ThirdO out
let run2 (type a) (level:a run_level_g) data : a level_output =
let out = first data in
if Any level = Any First
then FirstO out
else
let out = second out in
if Any level = Any Second
then SecondO out
else
let out = third out in
ThirdO out
type (_,_) eq = Eq : ('a,'a) eq
let eq_level (type a b) (x:a run_level_g) (y:b run_level_g) : (a, b) eq option =
match x, y with
| First, First -> Some Eq
| Second, Second -> Some Eq
| Third, Third -> Some Eq
| _ -> None
let cast_output (type a b) (Eq:(a, b) eq) (v:a level_output) : b level_output = v
let run3 (type a) (level:a run_level_g) data : a level_output =
let out = first data in
let eq = eq_level First level in
match eq with
| Some eq -> cast_output eq (FirstO out)
| None ->
let out = second out in
let eq = eq_level Second level in
match eq with
| Some eq -> cast_output eq (SecondO out)
| None ->
let out = third out in
let eq = eq_level Third level in
match eq with
| Some eq -> cast_output eq (ThirdO out)
| None -> failwith "this can't happen"
There are three versions of run. The first one works well but there is code duplication, which I would like to remove. I would like my function to look more like run2 but this one does not compile because the type checker can't infer the type from the if-condition. An answer to that problem is run3 but now I have this clunky failwith case that obviously can't happen.
I was wondering if there was a way for me to have the best of both worlds, a function with no code duplication and no failwith case?
I find your function run1 the most readable one, by far.
One possibility to remove some code duplication may be to make run1 recursive.
First, one can define a short helper function to extract data from level_output
let proj (type a) (x:a level_output): a =
match x with
| FirstO x -> x
| SecondO x -> x
| ThirdO x -> x;;
then a recursive variant of run may be written as
let rec run: type a. a run_level_g -> 'b -> a level_output =
fun level data -> match level with
| First -> FirstO(first data)
| Second -> SecondO(second ## proj ## run First data)
| Third -> ThirdO(third ## proj ## run Second data);;
This is the description of warning 27 from the OCaml manual:
27 Innocuous unused variable: unused variable that is not bound with let nor as, and doesn't start with an underscore (_) character.
This warning is turned on by jbuilder --dev, and I'm curious to know in which cases people find it useful. For me, it's an annoyance to get warnings when I write code like this:
$ utop -w +27
utop # fun (x, y) -> x;;
Characters 8-9:
Warning 27: unused variable y.
- : 'a * 'b -> 'a = <fun>
or like that:
utop # let error loc msg = failwith (loc ^ ": " ^ msg);;
val error : string -> string -> 'a = <fun>
utop # let rec eval = function
| `Plus (loc, a, b) -> eval a + eval b
| `Minus (loc, a, b) -> eval a - eval b
| `Star (loc, a, b) -> eval a * eval b
| `Slash (loc, a, b) ->
let denom = eval b in
if denom = 0 then
error loc "division by zero"
else
eval a / denom
| `Int (loc, x) -> x
;;
Characters 33-36:
Warning 27: unused variable loc.
Characters 73-76:
Warning 27: unused variable loc.
Characters 112-115:
Warning 27: unused variable loc.
Characters 287-290:
Warning 27: unused variable loc.
val eval :
([< `Int of 'b * int
| `Minus of 'c * 'a * 'a
| `Plus of 'd * 'a * 'a
| `Slash of 'e * 'a * 'a
| `Star of 'f * 'a * 'a ]
as 'a) ->
int = <fun>
I know that prepending an underscore to the identifiers as in _loc suppresses the warnings, but it's not compatible with my notions that:
variables starting with an underscore are ugly and are meant for use in generated code, hidden from the programmer;
a name given to something should not have to change based on how it's used (including unused).
Using underscores, the code becomes:
(* Here we have _loc or loc depending on whether it's used. *)
let rec eval = function
| `Plus (_loc, a, b) -> eval a + eval b
| `Minus (_loc, a, b) -> eval a - eval b
| `Star (_loc, a, b) -> eval a * eval b
| `Slash (loc, a, b) ->
let denom = eval b in
if denom = 0 then
error loc "division by zero"
else
eval a / denom
| `Int (_loc, x) -> x
or
(* Here it can be hard to know what _ stands for. *)
let rec eval = function
| `Plus (_, a, b) -> eval a + eval b
| `Minus (_, a, b) -> eval a - eval b
| `Star (_, a, b) -> eval a * eval b
| `Slash (loc, a, b) ->
let denom = eval b in
if denom = 0 then
error loc "division by zero"
else
eval a / denom
| `Int (_, x) -> x
It is very useful in the monadic code, where instead of the common syntactic let bindings you're forced to use monadic >>= bind operator. Basically, where
let x = something in
code
translates to
something >>= fun x ->
code
If x is not used in code then only with the 27 warning enabled the latter will be highlighted, while the former will produce a warning by default. Enabling this warning, revealed lots of bugs for us. For example, it showed us that this code is buggy :)
Another source of use cases are higher-order functions, i.e., map, fold, etc. It captures one of the most common bugs:
let bug init =
List.fold ~init ~f:(fun acc xs ->
List.fold ~init ~f:(fun acc x -> x :: acc))
Concerning the ugliness, I totally agree that underscores are ugly, but in most cases, this is the main purpose of them - to highlight the suspicious code. Concerning the example, that you're showing, in the modern OCaml it could be easily addressed with the inline records, e.g.,
type exp =
| Plus of {loc : loc; lhs : exp; rhs: exp}
| ...
so that instead of using the underscores, you can just omit the unused field,
let rec eval = function
| Plus {lhs; rhs} -> eval lhs + eval rhs
You can use the same approach without using inline records by sparing some extra space in your program and defining all those records separately. The real-world example.
For me this warning is useful in order to remind me to explicit more my intention. If we take your example :
fun (x, y) -> x;;
Your intention is to use only the first element. If we rewrite it this way :
fun (x, _ ) -> x;;
You use a pattern matching in the parameter to make your code more concise, but you explain your intention of using only the first element. The added value in this example is small, related to the very simple implementation. But in real life functions, this warning promote a good habit in coding.
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.