I'm new in OCaml. I wrote this code to reduce algebraic expressions:
type expr =
| Int of int
| Float of float
| Add of expr*expr
| Sub of expr*expr
| Mult of expr*expr
| Div of expr*expr
| Minus of expr
let rec eval expression = match expression with
| Add (e1, e2) -> (eval e1) +. (eval e2)
| Sub (e1,e2) -> (eval e1) -. (eval e2)
| Mult (e1,e2) -> (eval e1) *. (eval e2)
| Div (e1, e2) -> (eval e1) /. (eval e2)
| Minus (e1) -> -.(eval e1)
| Int i -> (float) i
| Float f -> f
let rec simplify_expr e = match e with
| Add (e1,e2) -> if (eval e1) == 0.0 then simplify_expr e2
else if (eval e2) == 0.0 then simplify_expr e1
else Add (simplify_expr e1, simplify_expr e2)
| Mult(e1,e2) -> if (eval e1) == 1.0 then simplify_expr e2
else if (eval e2) == 1.0 then simplify_expr e1
else Mult (simplify_expr e1, simplify_expr e2)
| Sub (e1, e2) -> if (eval e1) == 0.0 then simplify_expr e2
else if (eval e2) == 0.0 then simplify_expr e1
else Sub (simplify_expr e1, simplify_expr e2)
| Div (e1, e2) -> if (eval e1) == 1.0 then simplify_expr e2
else if (eval e2) == 1.0 then simplify_expr e1
else Div (simplify_expr e1, simplify_expr e2)
| Int i -> e
| Minus e1 -> simplify_expr(e1)
| Float f -> e
I call simplify_expr in this way:
Expr.simplify_expr Expr.Mult (Expr.Int 4, Expr.Add (Expr.Int 1, Expr.Int 0));;
And I've got wrong answer:
- : Expr.expr = Expr.Mult (Expr.Int 4, Expr.Add (Expr.Int 1, Expr.Int 0))
Below I paste call's stack.
Expr.simplify_expr <--
Expr.Mult (Expr.Int 4, Expr.Add (Expr.Int 1, Expr.Int 0))
Expr.eval <-- Expr.Int 4
Expr.eval --> 4.
Expr.eval <-- Expr.Add (Expr.Int 1, Expr.Int 0)
Expr.eval <-- Expr.Int 0
Expr.eval --> 0.
Expr.eval <-- Expr.Int 1
Expr.eval --> 1.
Expr.eval --> 1.
Expr.simplify_expr <-- Expr.Add (Expr.Int 1, Expr.Int 0)
Expr.eval <-- Expr.Int 1
Expr.eval --> 1.
Expr.eval <-- Expr.Int 0
Expr.eval --> 0.
Expr.simplify_expr <-- Expr.Int 0
Expr.simplify_expr --> Expr.Int 0
Expr.simplify_expr <-- Expr.Int 1
Expr.simplify_expr --> Expr.Int 1
Expr.simplify_expr --> Expr.Add (Expr.Int 1, Expr.Int 0)
Expr.simplify_expr <-- Expr.Int 4
Expr.simplify_expr --> Expr.Int 4
Expr.simplify_expr -->
Expr.Mult (Expr.Int 4, Expr.Add (Expr.Int 1, Expr.Int 0))
- : Expr.expr = Expr.Mult (Expr.Int 4, Expr.Add (Expr.Int 1, Expr.Int 0))
I have no idea, why after return of eval with 1 (9th line) simplify_expr was called with Add. Anybody can help ?
Replace == with =. See for instance Does != have meaning in OCaml? .
Not the question, but also check the Sub, Div and Minus cases of simplify_expr: 0 - e2 is not e2 and 1 / e2 is not e2...
Related
I am writing a language interpeter with OCaml.
With ApplyOver I have to map a function on every value of the type dictionary, which is made of (ide * exp) -> ("key", value).
If the function is "fun x-> x+1" on a dictionary ("key1", Eint 2), ("key2", Eint 3), then ApplyOver will add +1 to 2 and +1 to 3.
I have this error on the last line, This function has type exp -> evT env -> evT
It is applied to too many arguments; maybe you forgot a `;'.
Code (without standard evaluations):
type exp = ... | Dict of (ide * exp) list | ApplyOver of exp * exp;;
type evT = ... | DictVal of (ide * exp) list
let rec eval (e : exp) (r : evT env) : evT = match e with
Dict(pairs) ->
if invariant pairs then DictVal(evalDictList pairs r)
else failwith("The Dictionary has multiple copy of the same key")|
ApplyOver(ex, dict) ->
(match (eval dict r) with
DictVal(pairs) -> DictVal(applyover ex pairs)|
_-> failwith ("not a dictionary"))|
Estring s -> String s |
Eint n -> Int n |
Ebool b -> Bool b |
IsZero a -> iszero (eval a r) |
Den i -> applyenv r i |
Eq(a, b) -> eq (eval a r) (eval b r) |
Prod(a, b) -> prod (eval a r) (eval b r) |
Sum(a, b) -> sum (eval a r) (eval b r) |
Diff(a, b) -> diff (eval a r) (eval b r) |
Minus a -> minus (eval a r) |
And(a, b) -> et (eval a r) (eval b r) |
Or(a, b) -> vel (eval a r) (eval b r) |
Not a -> non (eval a r) |
Ifthenelse(a, b, c) ->
let g = (eval a r) in
if (typecheck "bool" g)
then (if g = Bool(true) then (eval b r) else (eval c r))
else failwith ("nonboolean guard") |
Let(i, e1, e2) -> eval e2 (bind r i (eval e1 r)) |
Fun(i, a) -> FunVal(i, a, r) |
FunCall(f, eArg) ->
let fClosure = (eval f r) in
(match fClosure with
FunVal(arg, fBody, fDecEnv) ->
eval fBody (bind fDecEnv arg (eval eArg r)) |
RecFunVal(g, (arg, fBody, fDecEnv)) ->
let aVal = (eval eArg r) in
let rEnv = (bind fDecEnv g fClosure) in
let aEnv = (bind rEnv arg aVal) in
eval fBody aEnv |
_ -> failwith("non functional value")) |
Letrec(f, funDef, letBody) ->
(match funDef with
Fun(i, fBody) -> let r1 = (bind r f (RecFunVal(f, (i, fBody, r)))) in
eval letBody r1 |
_ -> failwith("non functional def"))
and evalDictList (pairs : (ide * exp) list) (r : evT env) : (ide * evT) list = match pairs with
[ ] -> [ ] |
(key,value) :: other -> (key, eval value r) :: evalDictList other r
and applyover (ex : exp) (listtoscan : (ide * evT) list) : (ide * evT) list = match listtoscan with
[ ] -> [ ] |
(key,value) :: other -> (key, eval FunCall(ex, value) r) :: applyover ex other;;
Function application has the second highest precedence after method calls (and similar user-defined operators). Thus the compiler reads eval FunCall(ex, value) r as
(eval FunCall) (ex, value) r
while you intended to write
eval (Funcall(ex,value)) r
I'm having trouble tracing through this code (which is correct):
let rec prepend (l: int list list) (x: int) : int list list =
begin match l with
| [] -> []
| hd :: tl -> (x :: hd) :: (prepend tl x)
end
prepend [[]; [2]; [2;3]] 1 = [[1]; [1;2]; [1;2;3]]
My tracing is incorrect, but I'm not sure what's wrong:
prepend ([]::2::[]::2::3::[]::[]) 1 =
1::[]::prepend (2::[]::2::3::[]::[]) 1 =
1::[]::1::2::prepend([]::2::3::[]::[]) 1 =
1::[]::1::2::1::[]::prepend(2::3::[]::[]) 1 -->
This is incorrect because then it comes out as [1] ; [1;2;1]
when it should be [1]; [1;2] ; [1;2;3]
The :: operator isn't associative, i.e., (a :: b) :: c is not the same as a :: (b :: c). So you should be using parentheses to keep track of your sublists.
prepend ([] :: (2 :: []) :: (2 :: 3 :: []) :: []) 1 =>
(1 :: []) :: prepend ((2 :: []) :: (2 :: 3 :: []) :: []) 1 =>
(1 :: []) :: (1 :: 2 :: []) :: prepend ((2 :: 3 :: []) :: []) 1 => ...
Maybe you can take it from there....
I'm learning OCaml from the MOOC offered by Université Paris Diderot. At the moment i have not encounter major struggle with functional thinking, but i do find this piece of code, a little bit ugly. How can i refactor it, so i can write general evaluation of e1, and e2 that serves for two latest branches of the match statement included in the simplify function. The idea of this function is to transform e * 0 or 0 * e into 0; e * 1 or 1 * e into e; and e + 0 or 0 + e into e.
type exp =
| EInt of int
| EAdd of exp * exp
| EMul of exp * exp;;
let eval expression =
let rec aux = function
| EInt x -> x
| EAdd (e1, e2) -> (aux e1) + (aux e2)
| EMul (e1, e2) -> (aux e1) * (aux e2)
in aux expression;;
let simplify expression =
match expression with
| EInt _ -> expression
| EAdd (e1, e2) ->
let v1 = eval e1 in
let v2 = eval e2 in
if v1 = 0 then e2
else if v2 = 0 then e1
else expression
| EMul (e1, e2) ->
let v1 = eval e1 in
let v2 = eval e2 in
if v1 = 0 || v2 = 0 then EInt 0
else if v1 = 1 then e2
else if v2 = 1 then e1
else expression;;
I appreciate you help!
Thanks!
I guess you can have a function like this:
let simplifyop identity zero exp e1 e2 =
let v1 = eval e1 in
let v2 = eval e2 in
if v1 = identity then e2
else if v2 = identity then e1
else
match zero with
| None -> exp
| Some z ->
if v1 = z || v2 = z then EInt z
else exp
Then your cases look like this:
| EAdd (e1, e2) -> simplifyop 0 None expression e1 e2
| EMul (e1, e2) -> simplifyop 1 (Some 0) expression e1 e2
I have an SML program which represents a language with Expressions that are comprised of Values:
datatype Value = IntVal of int
| ListVal of Value list
datatype Exp = Const of Value
| Plus of Exp * Exp
| Minus of Exp * Exp
| Times of Exp * Exp
I'm also writing an eval function that converts an expression into a value. If the expression is a Plus expression (e.g. Plus (Const (IntVal 1), Const (IntVal 1)) which represents 1+1), I just want to take out the integer stored in the IntVal and just add them together and return that.
But as far as I can tell, I have to have a seemingly redundant case statement with only one case just to get at the integer inside the IntVal data type:
(*Evaluates an Exp and returns a Value*)
fun eval e =
(*Evaluate different types of Exp*)
case e of
(*If it's a constant, then just return the Value*)
Const v => v
(*If it's a Plus, we want to add together the two Values*)
| Plus (x,y) =>
(*Case statement with only one case that seems redundant*)
case (eval x, eval y) of
(IntVal xVal, IntVal yVal) => IntVal (xVal + yVal)
Is there no easy way to do simplify this? I'd like to do something like this, which of course isn't valid SML:
fun eval e =
case e of
Const v => v
| Plus (x,y) => IntVal (eval x + eval x)
If you want your eval function to return an int and you haven't figured out how to get an int from a Value which uses the ListVal constructor -- it is enough to just supply patterns which correspond to the cases that your intended definition covers.
fun eval (Const (IntVal v)) = v
| eval (Plus (e1,e2)) = eval(e1) + eval(e2)
| eval (Minus (e1,e2)) = eval(e1) - eval(e2)
| eval (Times (e1,e2)) = eval(e1) * eval(e2);
SML/NJ gives Warning: match nonexhaustive - but if it matches your intention then you can ignore the warning.
The above code returns an int. If you want to return values which look like e.g. IntVal 3 then you could define 3 functions which take pairs of IntVals and return IntVals corresponding to their sums, differences, and products and use these functions on the right hand sides of the above definition.
Yes, there are at least two ways to simplify this: Exceptions, or monads.
The problem you have is that eval (Const (ListVal [...])) does not have a meaningful integer value. To ensure that this remains a total function (one for which all input values result in an output value, as opposed to a partial function), its type could instead be expressed as:
val eval : Exp -> int option
You could implement this most easily by using exceptions:
local
fun eval' (Const (IntVal v)) = v
| eval' (Const (ListVal _)) = raise Domain
| eval' (Plus (e1, e2)) = eval' e1 + eval' e2
| eval' (Minus (e1, e2)) = eval' e1 - eval' e2
| eval' (Times (e1, e2)) = eval' e1 * eval' e2
in
fun eval e = SOME (eval' e) handle Domain => NONE
end
Or you could implement this by complicating your recursive function:
fun eval (Const (IntVal v)) = SOME v
| eval (Const (ListVal _)) = NONE
| eval (Plus (e1, e2)) =
(case (eval e1, eval e2) of
(SOME v1, SOME v2) => SOME (v1+v2)
| _ => NONE)
| eval (Minus (e1, e2)) =
(case (eval e1, eval e2) of
(SOME v1, SOME v2) => SOME (v1-v2)
| _ => NONE)
| eval (Times (e1, e2)) =
(case (eval e1, eval e2) of
(SOME v1, SOME v2) => SOME (v1*v2)
| _ => NONE)
Clearly that is not easy or pretty.
One way to improve this code is to abstract a common, repetitive pattern into a function:
fun evalBinop (f, e1, e2) =
case (eval e1, eval e2) of
(SOME v1, SOME v2) => SOME (f (v1, v2))
| _ => NONE
and eval (Const (IntVal v)) = SOME v
| eval (Const (ListVal _)) = NONE
| eval (Plus (e1, e2)) = evalBinop (op+, e1, e2)
| eval (Minus (e1, e2)) = evalBinop (op-, e1, e2)
| eval (Times (e1, e2)) = evalBinop (op*, e1, e2)
Here evalBinop depends on calling back on eval, so I made them mutually recursive. I also rely on interpreting binary operators as functions that take tuples as arguments.
An improvement comes in making more generic helper functions that handles the 'a option type:
infix 3 >>=
fun NONE >>= _ = NONE
| (SOME a) >>= f = f a
fun liftM2 f (opt1, opt2) =
opt1 >>= (fn x1 => opt2 >>= (fn x2 => SOME (f (x1, x2))))
fun eval (Const (IntVal v)) = SOME v
| eval (Const (ListVal _)) = NONE
| eval (Plus (e1, e2)) = liftM2 (op+) (eval e1, eval e2)
| eval (Minus (e1, e2)) = liftM2 (op-) (eval e1, eval e2)
| eval (Times (e1, e2)) = liftM2 (op* ) (eval e1, eval e2)
At this point, >>= and liftM2 are useful functions that don't depend on the notion of evaluating an expression or applying integer operators. They're not present in Standard ML's library, but they should be. At this point I incidentally re-invented monads.
A last improvement comes by adding a little syntax sugar, which is most likely overkill:
infix 7 **
infix 6 ++
infix 6 --
val op** = liftM2 op*
val op++ = liftM2 op+
val op-- = liftM2 op-
fun eval (Const (IntVal v)) = SOME v
| eval (Const (ListVal _)) = NONE
| eval (Plus (e1, e2)) = eval e1 ++ eval e2
| eval (Minus (e1, e2)) = eval e1 -- eval e2
| eval (Times (e1, e2)) = eval e1 ** eval e2
(A few examples demonstrating exactly what it is >>= and liftM2 do...)
(* 'x >>= f' means:
* if x is 'NONE', just return NONE
* if x is 'SOME a', apply f to a, and expect f to return either 'SOME b' or 'NONE' *)
(* For example, this should give 'SOME 4': *)
val example_1 = SOME 3 >>= (fn x => SOME (x+1))
(* And these should both give 'NONE': *)
val example_2 = NONE >>= (fn x => SOME (x+1))
val example_3 = SOME 3 >>= (fn x => NONE)
(* If 'f : t1 * t2 -> t3', then 'liftM2 f : t1 option * t2 option -> t3 option' *)
val _ = op+ : int * int -> int
val _ = liftM2 op+ : int option * int option -> int option
(* For example *)
val example_4 = liftM2 op+ (SOME 3, SOME 4) (* gives SOME 7 *)
val example_5 = liftM2 op- (SOME 10, NONE) (* gives NONE *)
val example_6 = liftM2 op* (NONE, SOME 5) (* gives NONE *)
I am trying to use List.map in recursive definition, mapping over a list using currently defined recursive function as an argument. Is it possible at all? I can define my own recursive fixpoint definition instead of using map but I am interested in using map here.
Require Import Coq.Lists.List.
Import ListNotations.
Inductive D: nat -> Type := | D0 (x:nat): D x.
Inductive T: nat -> nat -> Type :=
| T0 {i o} (foo:nat): T i o
| T1 {i o} (foo bar:nat) : T i o -> T i o.
Fixpoint E {i o: nat} (t:T i o) (x:nat) (d:D i): option (D o)
:=
(match t in #T i o
return D i -> option (D o)
with
| T0 _ _ foo => fun d0 => None
| T1 _ _ foo bar t' =>
fun d0 =>
let l := List.map (fun n => E t' x d0) [ 1 ; 2 ; 3 ] in
let default := Some (D0 o) in
List.hd default l
end) d.
The example above is artificial, but demonstrates the problem. The error message:
The term "l" has type "list (option (D n0))"
while it is expected to have type "list (option (D o))".
You just need to bind the names on the T1 pattern:
Require Import Coq.Lists.List.
Import ListNotations.
Inductive D: nat -> Type := | D0 (x:nat): D x.
Inductive T: nat -> nat -> Type :=
| T0 {i o} (foo:nat): T i o
| T1 {i o} (foo bar:nat) : T i o -> T i o.
Fixpoint E {i o: nat} (t:T i o) (x:nat) (d:D i): option (D o)
:=
(match t in #T i o
return D i -> option (D o)
with
| T0 _ _ foo => fun d0 => None
(* \/ change here *)
| T1 i o foo bar t' =>
fun d0 =>
let l := List.map (fun n => E t' x d0) [ 1 ; 2 ; 3 ] in
let default := Some (D0 o) in
List.hd default l
end) d.
The problem is that omitting the binders means that the o used on the T1 branch refers to the "outer" variable of the same name, whereas you want it to refer to the one given by T1.