i'm trying to write an interpreter in Ocaml but I do not know resolve the error in this program:
SYNTAX
type ide = string
type exp =
| Eint of int
| Ebool of bool
| Den of ide
| Sum of exp * exp
| Diff of exp * exp
| Prod of exp * exp
| Eq of exp * exp
| Minus of exp
| Iszero of exp
| Or of exp * exp
| And of exp * exp
| Not of exp
| Ifthenelse of exp * exp * exp
| Let of ide * exp * exp
| Fun of ide * exp
| Apply of exp * exp
| Letrec of ide * ide * exp * exp
| Etup of tuple (*Tupla come espressione*)
| Pipe of tuple (*Concatenazione di funzioni*)
| ManyTimes of int * exp (*Esecuzione iterata di una funzione*)
and tuple =
| Nil (*Tupla vuota*)
| Seq of exp * tuple (*Tupla di espressioni*)
;;
SEMANTIC
type eval=
| Int of int
| Bool of bool
| Unbound
| RecFunVal of ide * ide * exp * eval env
| Funval of efun
| ValTup of etuple
and efun = ide * exp * eval env
and etuple =
| Nil
| Seq of eval * etuple
;;
RUN-TIME SUPPORT
| Fun(i,a) -> Funval(i,a,r)
| Letrec(f, i, fBody, letBody) ->
let benv = bind(r, f, (RecFunVal(f, i, fBody, r)))
in sem(letBody, benv)
| Etup(tup) -> (match tup with
| Seq(ex1, tupla) ->
let evex1 = sem(ex1, r) in
let ValTup(etupla) = sem(Etup(tupla), r) in
ValTup(Seq(evex1, etupla))
| Nil -> ValTup(Nil))
| Apply(Den f, arg1) ->
(let fclosure= sem(Den f, r) in
match fclosure with
| Funval(arg, fbody, fDecEnv) ->
sem(fbody, bind(fDecEnv, arg, sem(arg1, r)))
| RecFunVal(f, arg, fbody, fDecEnv) ->
let aVal= sem(arg1, r) in
let rEnv= bind(fDecEnv, f, fclosure) in
let aEnv= bind(rEnv, arg, aVal) in
sem(fbody, aEnv)
| _ -> failwith("non functional value"))
| Apply(Pipe tup, arg) -> applyPipe tup arg r
| Apply(_,_) -> failwith("not function")
and applyPipe tup argo r = match tup with
| Seq(Den f, tupla) ->
applyPipe tupla (Apply(Den f,argo)) r
| Seq(Pipe(tuplaP),tupla) ->
let appf = applyPipe tuplaP argo r in
applyPipe tupla appf r (**)
| Nil -> sem(argo,r)
| _ -> failwith("Not a valid Pipe")
;;
The error is on the line (***) : "the variant type tuple has no constructor Pipe"
How can I solve it?
The compiler expects the first argument of applyPipe to have type tuple. On the line (***) the applyPipe is applied to the value Pipe(tupla) which has type exp.
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 write an interpreter with Ocaml but when i try :
sem(Let("Somma",Fun("x",Sum(Den "x",Eint(5))),Let("pipa",Pipe(Seq(Den "Somma",Nil)),Apply(Den "pipa",Eint(42)))),(emptyenv Unbound));;
the resault is an error : "Exception: Match_failure ("",1,41)
I think that error is in applyPipe but I don't understand where and why there is
Where did i wrong?
this is my code :
type exp =
.
.
.
| Fun of ide * exp
| Apply of exp * exp
| Letrec of ide * ide * exp * exp
| Etup of tuple (*Tupla come espressione*)
| Pipe of tuple (*Concatenazione di funzioni*)
| ManyTimes of int * exp (*Esecuzione iterata di una funzione*)
and tuple =
| Nil (*Tupla vuota*)
| Seq of exp * tuple (*Tupla di espressioni*)
;;
type eval=
| Int of int
| Bool of bool
| Unbound
| RecFunVal of ide * ide * exp * eval env
| Funval of efun
| ValTup of etuple
and efun = ide * exp * eval env
and etuple =
| Nil
| Seq of eval * etuple
;;
let rec sem ((ex: exp), (r: eval env)) = match ex with
.
.
.
| Let(i, e1, e2) -> sem(e2, bind (r, i, sem(e1, r)))
| Fun(i,a) -> Funval(i,a,r)
| Letrec(f, i, fBody, letBody) ->
let benv = bind(r, f, (RecFunVal(f, i, fBody, r)))
in sem(letBody, benv)
| Etup(tup) -> (match tup with
| Seq(ex1, tupla) ->
let evex1 = sem(ex1, r) in
let ValTup(etupl) = sem(Etup(tupla), r) in
ValTup(Seq(evex1, etupl))
| Nil -> ValTup(Nil))
| Apply(Den f, arg1) ->
(let fclosure= sem(Den f, r) in
match fclosure with
| Funval(arg, fbody, fDecEnv) ->
sem(fbody, bind(fDecEnv, arg, sem(arg1, r)))
| RecFunVal(f, arg, fbody, fDecEnv) ->
let aVal= sem(arg1, r) in
let rEnv= bind(fDecEnv, f, fclosure) in
let aEnv= bind(rEnv, arg, aVal) in
sem(fbody, aEnv)
| _ -> failwith("non functional value"))
| Apply(Pipe tup, arg) -> applyPipe tup arg r
| Apply(_,_) -> failwith("not function")
| _ -> failwith("non implementato")
and applyPipe tup argo r = (match tup with
| Seq(Den f, tupla) ->
let appf = Apply(Den f,argo) in
applyPipe tupla appf r
| Nil -> sem(argo,r)
| _ -> failwith("Not a valid Pipe"))
;;
The complete code is there : http://pastebin.com/VgpanX51
Please help me thaks
When you compile (or evaluate in a toplevel) an OCaml program, a typechecker will emit warnings about all pattern matches that are irrefutable, i.e., such patterns that may raise a Match_failure exception.
What you should do, is to go through all warnings and fix them.
There are quite a few irrefutable matches in your code, e.g., the sem function final match Apply(_,_) -> failwith("not function") will only catch Apply terms, but will not catch all others, adding something like _ -> failwith "unimplemented" will fix it.
QA
the error is in the try-code or in my interpreter?
It is in the interpreter, you didn't include all possible cases in your pattern-matching code.
.I do extend the typechecker
You don't need to. The typechecker verifies whether you anticipated all possible cases, for example, let's take the simple example:
type abc = A | B | C
let string_of_abc abc = match abc with
| A -> "A"
| B -> "B"
When you will try to compile (or interpret) the above code the typechecker will tell you:
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
C
type abc = A | B | C
So, it gives you a hint, that you forgot to match with the C constructor, so the expression string_of_abc C will terminate with a Match_failure exception.
You can follow the hints and add the cases one-by-one. Given your example, the pattern matching in the sema function is incomplete, and the type checker hits you with the following:
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
(Pipe _|ManyTimes (_, _))
And indeed, you missed the case with Pipe, so when the interpreter sees
Pipe(...)
It can't find a match, as according to your code you're expecting the Pipe constructor only as a first argument to Apply, when in your example, you're actually passing it as a second argument to Let.
i'm trying to write an interpreter in Ocaml, i have defined the syntax already and the semantic for the most of the operations.
I'm trying to implement two more operations:
Ntimes: this has two argouments, an Integer and a function. Ntimes has to apply the function n times.
Pipe: this is the same has the pipe in the linux bash.
example of Ntimes:
Ntimes(Int(4),f);;
example of Pipe:
Pipe(f1,(f2,(f3,(f4,(f5,Nil)))));;
The interpeter that i have is this:
SYNTAX
type ide = string;;
type operator = Plus | Minus | Mul | Div | And | Or | Eq;;
type exp = Int of int
| Bool of bool
| Den of string
| Op of exp * operator * exp
| Let of ide * exp * exp
| Fun of ide * exp
| Apply of exp * exp
| Ifz of exp * exp * exp
| Etup of tuple
| Pipe of tuple
| ManyTimes of int * exp
and tuple = Nil | Seq of exp * tuple;;
type dexp = Dint of int | Dbool of bool | Dstring of string | Unbound | Dtuple of dexp list | Funval of efun and efun = ide * exp * dexp env ;;
RUN-TIME SUPPORT
let rec eval ((e: exp), (r:dexp env)) = match e with
Int i -> Dint i
| Bool i -> Dbool i
.
.
.
.
| Etup e1 -> let v = (evalList e1 r) in Dtuple v
| Apply(e1, e2) -> (match eval(e1, r) with
| Funval(i, a, r1) -> eval(a, bind(r1, i, eval(e2, r)))
| _ -> failwith("no funct in apply"))
| NTimes(i,e) -> *I have no idea*
| Pipe(e) -> * I have no idea*
;;
Thanks for the any help that you will give me!
HI I have the following define type and try to eval the function as example:
let evn =[("z1",Int 0);("x",Int 1);("y",Int 2);("z",Int 3);("z1",Int 4)];;
val evn : (string * Nano.value) list = [("z1", Int 0); ("x", Int 1); ("y", Int 2); ("z", Int 3); ("z1", Int 4)]
# let e1 =Bin(Bin(Var "x",Plus,Var "y"), Minus, Bin(Var "z",Plus,Var "z1"));;
val e1 : Nano.expr = Bin (Bin (Var "x", Plus, Var "y"), Minus, Bin (Var "z", Plus, Var "z1"))
# eval (evn,e1);;
- : Nano.value = Int 0
# eval (evn,Var "p");;
Exception: Nano.MLFailure "Variable not bound: p".
somehow i got a erros in the second bin match in the eval function saying :
This pattern matches values of type expr
but a pattern was expected which matches values of type
int option * int option
type binop = Plus | Minus | Mul | Div
type expr = Const of int
| Var of string
| Bin of expr * binop * expr
type value = Int of int
type env = (string * value) list
here is the programs:
exception MLFailure of string
type binop =
Plus
| Minus
| Mul
| Div
| Eq
| Ne
| Lt
| Le
| And
| Or
| Cons
type expr =
Const of int
| True
| False
| NilExpr
| Var of string
| Bin of expr * binop * expr
| If of expr * expr * expr
| Let of string * expr * expr
| App of expr * expr
| Fun of string * expr
| Letrec of string * expr * expr
type value =
Int of int
| Bool of bool
| Closure of env * string option * string * expr
| Nil
| Pair of value * value
and env = (string * value) list
let binopToString op =
match op with
Plus -> "+"
| Minus -> "-"
| Mul -> "*"
| Div -> "/"
| Eq -> "="
| Ne -> "!="
| Lt -> "<"
| Le -> "<="
| And -> "&&"
| Or -> "||"
| Cons -> "::"
let rec valueToString v =
match v with
Int i ->
Printf.sprintf "%d" i
| Bool b ->
Printf.sprintf "%b" b
| Closure (evn,fo,x,e) ->
let fs = match fo with None -> "Anon" | Some fs -> fs in
Printf.sprintf "{%s,%s,%s,%s}" (envToString evn) fs x (exprToString e)
| Pair (v1,v2) ->
Printf.sprintf "(%s::%s)" (valueToString v1) (valueToString v2)
| Nil ->
"[]"
and envToString evn =
let xs = List.map (fun (x,v) -> Printf.sprintf "%s:%s" x (valueToString v)) evn in
"["^(String.concat ";" xs)^"]"
and exprToString e =
match e with
Const i ->
Printf.sprintf "%d" i
| True ->
"true"
| False ->
"false"
| Var x ->
x
| Bin (e1,op,e2) ->
Printf.sprintf "%s %s %s"
(exprToString e1) (binopToString op) (exprToString e2)
| If (e1,e2,e3) ->
Printf.sprintf "if %s then %s else %s"
(exprToString e1) (exprToString e2) (exprToString e3)
| Let (x,e1,e2) ->
Printf.sprintf "let %s = %s in \n %s"
x (exprToString e1) (exprToString e2)
| App (e1,e2) ->
Printf.sprintf "(%s %s)" (exprToString e1) (exprToString e2)
| Fun (x,e) ->
Printf.sprintf "fun %s -> %s" x (exprToString e)
| Letrec (x,e1,e2) ->
Printf.sprintf "let rec %s = %s in \n %s"
x (exprToString e1) (exprToString e2)
let rec fold f base args =
match args with [] -> base
| h::t -> fold f (f(base,h)) t
let listAssoc (k,l) =
fold (fun (r,(t,v)) -> if r = None && k=t then Some v else r) None l
let lookup (x,evn) =
let n = listAssoc (x,evn) in
match n with
| None -> raise (MLFailure x)
| Some x -> x
let rec eval (evn,e) = match e with
| Const i -> Some i
| Var v -> lookup (v,evn)
| Bin(e1, Plus, e2) -> match (eval (evn,e1), eval (evn,e2)) with
| (Some a, Some b) -> Some (a + b)
| (Some c, None) -> raise (MLFailure c)
| (None, Some a) -> raise (MLFailure a)
(here is the where the erro causing *)
| Bin(e1, Div, e2) -> match (eval (evn,e1), eval (evn,e2)) with
| (Some a, Some b) -> Some (a / b)
| (Some c, None) -> raise (MLFailure c)
| (None, Some a) -> raise (MLFailure a)
| Bin(e1, Minus, e2) -> match (eval (evn,e1), eval (evn,e2)) with
| (Some a, Some b) -> Some (a - b)
| (Some c, None) -> raise (MLFailure c)
| (None, Some a) -> raise (MLFailure a)
| Bin(e1, Mul, e2) -> match (eval (evn,e1), eval (evn,e2)) with
| (Some a, Some b) -> Some (a * b)
| (Some c, None) -> raise (MLFailure c)
| (None, Some a) -> raise (MLFailure a)
Be careful, with nested match-with do not forget to add begin-end statements. That's why you have this error.
let rec eval (evn,e) = match e with
| Const i -> Some i
| Var v -> lookup (v,evn)
| Bin(e1, Plus, e2) ->
begin match (eval (evn,e1), eval (evn,e2)) with
| (Some a, Some b) -> Some (a + b)
| (Some c, None) -> raise (MLFailure c)
| (None, Some a) -> raise (MLFailure a)
end
| Bin(e1, Div, e2) ->
begin match (eval (evn,e1), eval (evn,e2)) with
| (Some a, Some b) -> Some (a / b)
| (Some c, None) -> raise (MLFailure c)
| (None, Some a) -> raise (MLFailure a)
end
| Bin(e1, Minus, e2) ->
begin match (eval (evn,e1), eval (evn,e2)) with
| (Some a, Some b) -> Some (a - b)
| (Some c, None) -> raise (MLFailure c)
| (None, Some a) -> raise (MLFailure a)
end
| Bin(e1, Mul, e2) ->
begin match (eval (evn,e1), eval (evn,e2)) with
| (Some a, Some b) -> Some (a * b)
| (Some c, None) -> raise (MLFailure c)
| (None, Some a) -> raise (MLFailure a)
end
If you don't do this, it's like you wrote as follow:
let rec eval (evn,e) = match e with
| Const i -> Some i
| Var v -> lookup (v,evn)
| Bin(e1, Plus, e2) -> match (eval (evn,e1), eval (evn,e2)) with
| (Some a, Some b) -> Some (a + b)
| (Some c, None) -> raise (MLFailure c)
| (None, Some a) -> raise (MLFailure a)
| Bin(e1, Div, e2) -> match (eval (evn,e1), eval (evn,e2)) with
| (Some a, Some b) -> Some (a / b)
| (Some c, None) -> raise (MLFailure c)
| (None, Some a) -> raise (MLFailure a)
| Bin(e1, Minus, e2) -> (* ... *)