Skip to content

Instantly share code, notes, and snippets.

@swuecho
Created May 4, 2014 21:02
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save swuecho/11523797 to your computer and use it in GitHub Desktop.
Save swuecho/11523797 to your computer and use it in GitHub Desktop.
(* 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);;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment