ocaml eval_monad.ml
eval_monad.ml
(* term type *)
type term = Con of int | Div of term * term ;;
(* test data *)
let answer = Div (Div (Con 1972, Con 2), Con 23);; (* 42 *)
let error = Div(Con 1, Con 0);; (* Exception: Division_by_zero. *)
(* ======================== *)
(* primitive evaluator *)
val eval = term -> int;;
let rec eval = function Con a -> a
| Div (t, u) -> eval(t) / eval(u) ;;
(* monad version: identy *)
type 'a m = 'a;;
let pure (a: 'a ) : 'a m = a;;
let bind (a: 'a m) (k: 'a -> 'b m ) : 'b m = k(a);;
(*
problem with precedence,function application
*)
let rec eval (s: term) : int m =
match s with
| Con a -> pure(a)
| Div(t,u) -> bind (eval t) (fun a ->
bind (eval u) (fun b ->
pure (a / b )));;
(* with exception handling *)
type eval_exception = string;;
type 'a m = Raise of eval_exception | Return of 'a;;
let rec eval x = match x with
| Con a -> Return a
| Div (t, u) -> match eval(t) with
| Raise e -> Raise e
| Return b -> match eval(u) with
| Raise e -> Raise e
| Return c -> if c = 0 then Raise ("divided by my zero")
else Return ( b / c) ;;
type eval_exception = string;;
type 'a m = Raise of eval_exception | Return of 'a;;
let pure (a: 'a ) : 'a m = Return(a);;
let bind (m: 'a m) (k: 'a -> 'b m ) : 'b m =
match m with
| Raise e -> Raise e
| Return a -> k(a);;
let eval_raise (e: eval_exception) : 'a m = Raise e;;
let rec eval (s: term) : int m =
match s with
| Con a -> pure(a)
| Div(t,u) ->
bind (eval t) (fun a ->
(bind (eval u) (fun b ->
(if b = 0 then eval_raise ("divided by my zero")
else pure (a/b) ) ) )) ;;
(* why can not you write bind eval(t) .. *)
(* with state *)
(* without explicitly type declearation *)
let rec eval term x = match (term, x) with
| ((Con a), x) -> (a, x)
| (Div (t, u), x) -> let (b,y) = (eval t x) in
let (c,z) = (eval u y) in
(b / c, z + 1) ;;
type state = int ;;
let rec eval (exp:term) (x:state) : int * state = match (exp, x) with
| ((Con a), x) -> (a, x)
| (Div (t, u), x) -> let (b,y) = (eval t x) in
let (c,z) = (eval u y) in
(b / c, z + 1) ;;
(* which one is correct in above three declearration? *)
type 'a m = 'a * state;;
type 'a m = state -> 'a * state;;
type 'a m = 'a -> 'a * state;;
type ('a, state) m = 'a * state;;
(* only this one is right *)
type m 'a = state -> 'a * state;;
let rec eval term : int m = match term with
| (Con a) -> fun x -> (a, x)
| (Div (t, u)) -> fun x ->
let (b,y) = eval t x in
let (c,z) = eval u y in
(b / c, z + 1);;
type state = int ;;
type 'a m = state -> 'a * state ;;
let pure (a: 'a ) = fun x -> (a, x);;
let bind (m: 'a m) (k: 'a -> 'b m) : 'b m =
fun x -> begin
let (a, y) = m x in
let (b, z) = k a y in
(b,z)
end;;
let tick : unit m = fun x -> ((), x + 1);;
(* todo solve problem like this
Error: This expression has type state m/127727 but an expression was expected of type state m/128041 = state -> state * state
*)
let rec eval (s: term) : int m =
match s with
| Con a -> pure(a)
| Div(t,u) ->
bind (eval t) (fun a ->
bind (eval u) (fun b ->
bind tick (fun () -> pure (a / b))));;
(* output *)
(* helper function for pretty print *)
let rec showterm = function Con a -> "Con " ^ (string_of_int a)
| Div (x, y) -> "Div (" ^ showterm(x) ^ "," ^ showterm(y) ^ " )" ;;
let line t a = (showterm t) ^ " = " ^ (string_of_int a) ^ " => " ;;
let rec eval term = match term with
| (Con a) -> (line (Con a) a, a)
| (Div (t, u)) -> let (x,a) = eval t in
let (y,b) = eval u in
(x ^ y ^ (line (Div (t, u)) (a/b)), a/b);;
(* with type * *)
type output_step = string ;;
type m 'a = output_step * 'a ;;
let rec eval term : int m = match term with
| (Con a) -> (line (Con a) a, a)
| (Div (t, u)) -> let (x,a) = eval t in
let (y,b) = eval u in
(x ^ y ^ (line (Div (t, u)) (a/b)), a/b);;
(* monad version *)
(* helper function for pretty print *)
let rec showterm = function Con a -> "Con " ^ (string_of_int a)
| Div (x, y) -> "Div (" ^ showterm(x) ^ "," ^ showterm(y) ^ " )" ;;
let line t a = (showterm t) ^ " = " ^ (string_of_int a) ^ " => " ;;
type output_step = string ;;
type m 'a = output_step * 'a ;;
let pure (a: 'a) : 'a m = ("", a);;
let bind (m: 'a m) (k: 'a -> 'b m) : 'b m =
let (x, a) = m in
let (y, b) = k a in
(x ^ y , b);;
let eval_output (s: output_step) : unit m = (s,());;
let rec eval (s: term) : int m =
match s with
| Con a -> bind (eval_output (line s a)) (fun () -> pure(a))
| Div(t,u) ->
bind (eval t) (fun a ->
bind (eval u) (fun b ->
bind (eval_output (line s (a/b))) (fun () -> pure(a/b))));
ocaml eval.ml
eval.ml
(* test data *)
let answer = Div (Div (Con 1972, Con 2), Con 23);; (* 42 *)
let error = Div(Con 1, Con 0);; (* Exception: Division_by_zero. *)
(* term type *)
type term = Con of int | Div of term * term ;;
(* primitive evaluator *)
let rec eval = function Con a -> a
| Div (t, u) -> eval(t) / eval(u) ;;
(* with exception handling *)
type eval_exception = string;;
type 'a m = Raise of eval_exception | Return of 'a;;
let rec eval x = match x with
| Con a -> Return a
| Div (t, u) -> match eval(t) with
| Raise e -> Raise e
| Return b -> match eval(u) with
| Raise e -> Raise e
| Return c -> if c = 0 then Raise ("divided by my zero")
else Return ( b / c) ;;
(* with state *)
(* without explicitly type declearation *)
let rec eval term x = match (term, x) with
| ((Con a), x) -> (a, x)
| (Div (t, u), x) -> let (b,y) = (eval t x) in
let (c,z) = (eval u y) in
(b / c, z + 1) ;;
type state = int ;;
let rec eval (exp:term) (x:state) : int * state = match (exp, x) with
| ((Con a), x) -> (a, x)
| (Div (t, u), x) -> let (b,y) = (eval t x) in
let (c,z) = (eval u y) in
(b / c, z + 1) ;;
(* which one is correct in above three declearration? *)
type 'a m = 'a * state;;
type 'a m = state -> 'a * state;;
type 'a m = 'a -> 'a * state;;
type ('a, state) m = 'a * state;;
(* only this one is right *)
type m 'a = state -> 'a * state;;
let rec eval term : int m = match term with
| (Con a) -> fun x -> (a, x)
| (Div (t, u)) -> fun x ->
let (b,y) = eval(t)(x) in
let (c,z) = eval(u)(y) in
(b / c, z + 1);;
(* output *)
( * somethig is wrong with this)
(* helper function for pretty print *)
let rec showterm = function Con a -> "Con " ^ (string_of_int a)
| Div (x, y) -> "Div (" ^ showterm(x) ^ "," ^ showterm(y) ^ " )" ;;
let line t a = (showterm t) ^ " = " ^ (string_of_int a) ^ " => " ;;
let rec eval term = match term with
| (Con a) -> (line (Con a) a, a)
| (Div (t, u)) -> let (x,a) = eval t in
let (y,b) = eval u in
(x ^ y ^ (line (Div (t, u)) (a/b)), a/b);;
(* with type * *)
type output_step = string ;;
type m 'a = output_step * 'a ;;
let rec eval term : int m = match term with
| (Con a) -> (line (Con a) a, a)
| (Div (t, u)) -> let (x,a) = eval t in
let (y,b) = eval u in
(x ^ y ^ (line (Div (t, u)) (a/b)), a/b);;
ocaml eval.ml
eval.ml
(* test data *)
let answer = Div (Div (Con 1972, Con 2), Con 23);; (* 42 *)
let error = Div(Con 1, Con 0);; (* Exception: Division_by_zero. *)
(* term type *)
type term = Con of int | Div of term * term ;;
(* primitive evaluator *)
let rec eval = function Con a -> a
| Div (t, u) -> eval(t) / eval(u) ;;
(* with exception handling *)
type eval_exception = string;;
type 'a m = Raise of eval_exception | Return of 'a;;
let rec eval x = match x with
| Con a -> Return a
| Div (t, u) -> match eval(t) with
| Raise e -> Raise e
| Return b -> match eval(u) with
| Raise e -> Raise e
| Return c -> if c = 0 then Raise ("divided by my zero")
else Return ( b / c) ;;
(* with state *)
(* without explicitly type declearation *)
let rec eval term x = match (term, x) with
| ((Con a), x) -> (a, x)
| (Div (t, u), x) -> let (b,y) = (eval t x) in
let (c,z) = (eval u y) in
(b / c, z + 1) ;;
type state = int ;;
let rec eval (exp:term) (x:state) : int * state = match (exp, x) with
| ((Con a), x) -> (a, x)
| (Div (t, u), x) -> let (b,y) = (eval t x) in
let (c,z) = (eval u y) in
(b / c, z + 1) ;;
(* which one is correct in above three declearration? *)
type 'a m = 'a * state;;
type 'a m = state -> 'a * state;;
type 'a m = 'a -> 'a * state;;
type ('a, state) m = 'a * state;;
(* only this one is right *)
type m 'a = state -> 'a * state;;
let rec eval term : int m = match term with
| (Con a) -> fun x -> (a, x)
| (Div (t, u)) -> fun x ->
let (b,y) = eval(t)(x) in
let (c,z) = eval(u)(y) in
(b / c, z + 1);;
(* output *)
( * somethig is wrong with this)
(* helper function for pretty print *)
let rec showterm = function Con a -> "Con " ^ (string_of_int a)
| Div (x, y) -> "Div (" ^ showterm(x) ^ "," ^ showterm(y) ^ " )" ;;
let line t a = (showterm t) ^ " = " ^ (string_of_int a) ^ " => " ;;
let rec eval term = match term with
| (Con a) -> (line (Con a) a, a)
| (Div (t, u)) -> let (x,a) = eval t in
let (y,b) = eval u in
(x ^ y ^ (line (Div (t, u)) (a/b)), a/b);;
(* with type * *)
type output_step = string ;;
type m 'a = output_step * 'a ;;
let rec eval term : int m = match term with
| (Con a) -> (line (Con a) a, a)
| (Div (t, u)) -> let (x,a) = eval t in
let (y,b) = eval u in
(x ^ y ^ (line (Div (t, u)) (a/b)), a/b);;
ocaml fizzbuzz.ml
fizzbuzz.ml
(* Variations of Fizzbuzz in OCaml, translated from the Rust version in
"FizzBuzz Revisited" by Lindsey Kuper:
http://composition.al/blog/2013/03/02/fizzbuzz-revisited/ *)
(* The FizzBuzz test proposed by Imran Ghory:
http://imranontech.com/2007/01/24/using-fizzbuzz-to-find-developers-who-grok-coding/ *)
(* and made famous by Jeff Atwood:
http://www.codinghorror.com/blog/2007/02/why-cant-programmers-program.html *)
(* Utility functions *)
open List
let (--) i j =
let rec aux n acc =
if n < i then acc else aux (n-1) (n::acc) in
aux j []
(* Version 0: Original *)
let is_three n = n mod 3 = 0
let is_five n = n mod 5 = 0
let is_fifteen n = n mod 15 = 0
let ver0 =
let nums = 1 -- 100 in
let rec aux x =
if is_fifteen x then "Fizzbuzz" else
if is_three x then "Fizz" else
if is_five x then "Buzz" else
string_of_int x in
(map (Printf.sprintf "%s") (map aux nums))
(* Version 1: Transliterate into match *)
let ver1 =
let nums = 1 -- 100 in
let rec aux x =
match x with
| _ when is_fifteen x -> "FizzBuzz"
| _ when is_three x -> "Fizz"
| _ when is_five x -> "Buzz"
| _ -> string_of_int x in
(map (Printf.sprintf "%s") (map aux nums))
(* Version 2: Match against tuples of bools *)
let ver2 =
let nums = 1 -- 100 in
let rec aux x =
match (is_three(x), is_five(x)) with
| (true, true) -> "FizzBuzz"
| (true, false) -> "Fizz"
| (false, true) -> "Buzz"
| _ -> string_of_int x in
(map (Printf.sprintf "%s") (map aux nums))
(* Version 2.1: Explicit (false, false) match *)
let ver2_1 =
let nums = 1 -- 100 in
let rec aux x =
match (is_three(x), is_five(x)) with
| (true, true) -> "FizzBuzz"
| (true, false) -> "Fizz"
| (false, true) -> "Buzz"
| (false, false) -> string_of_int x in
(map (Printf.sprintf "%s") (map aux nums))
(* Version 3: match against tuples of ints *)
let ver3 =
let nums = 1 -- 100 in
let rec aux x =
match (x mod 3, x mod 5) with
| (0, 0) -> "FizzBuzz"
| (0, n) when n != 0 -> "Fizz"
| (m, 0) when m != 0 -> "Buzz"
| (m, n) when m != 0 && n != 0 -> string_of_int x in
(map (Printf.sprintf "%s") (map aux nums))
(* Version 3.1: Get rid of pattern guards *)
let ver3_1 =
let nums = 1 -- 100 in
let rec aux x =
match (x mod 3, x mod 5) with
| (0, 0) -> "FizzBuzz"
| (0, _) -> "Fizz"
| (_, 0) -> "Buzz"
| (_, _) -> string_of_int x in
(map (Printf.sprintf "%s") (map aux nums))
(* Final version: Match against tuples of rems *)
type nonzerorem = One | Two | Three | Four
type rem = Zero | Other of nonzerorem
let int_to_rem n =
match n with
| 0 -> Zero
| 1 -> Other(One)
| 2 -> Other(Two)
| 3 -> Other(Three)
| 4 -> Other(Four)
| _ -> failwith "No such remainder"
let ver_final =
let nums = 1 -- 100 in
let rec aux x =
match (int_to_rem(x mod 3), int_to_rem(x mod 5)) with
| (Zero, Zero) -> "FizzBuzz"
| (Zero, Other(_)) -> "Fizz"
| (Other(_), Zero) -> "Buzz"
| (Other(_), Other(_)) -> string_of_int x in
(map (Printf.sprintf "%s") (map aux nums))