Skip to content

Instantly share code, notes, and snippets.

@astrada
Created December 23, 2012 15:02
Show Gist options
  • Save astrada/4363846 to your computer and use it in GitHub Desktop.
Save astrada/4363846 to your computer and use it in GitHub Desktop.
Monads and exception handling in OCaml
(* Tested with OCaml 3.12.1/4.00.1 *)
(* A standard state monad with an integer state *)
module IntStateMonad =
struct
type 'a t = int -> 'a * int
(* val return : 'a -> 'a t *)
let return (x : 'a) : 'a t =
(fun s -> (x, s))
(* val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t *)
let (>>=) (m : 'a t) (f : 'a -> 'b t) : 'b t =
(fun s ->
let (x, s') = m s in
let m' = f x in
m' s')
(* val get : int t *)
let get : int t = (fun s -> (s, s))
(* val put : int -> unit t *)
let put new_state : unit t = (fun _ -> ((), new_state))
end
open IntStateMonad
(* A function that never throws exceptions *)
(* val double_and_incr_state : int -> int IntStateMonad.t = <fun> *)
let double_and_incr_state x =
get >>= fun s ->
put (succ s) >>= fun _ ->
return (x + x)
(* Using the safe function *)
(* val sm1 : int IntStateMonad.t = <fun> *)
let sm1 =
put 0 >>= fun () ->
return 1 >>= fun x ->
double_and_incr_state x >>= fun x ->
double_and_incr_state x
let (result1, last_state1) = sm1 0
(* val result1 : int = 4
* val last_state1 : int = 2 *)
(* A function that throws an exception *)
let unsafe_f x =
if x = 1 then raise Not_found
else return 2
(* Directly catching the exception works as expected *)
(* val sm2 : int IntStateMonad.t = <fun> *)
let sm2 =
put 0 >>= fun () ->
return 1 >>= fun x ->
try unsafe_f x with Not_found -> return 10 >>= fun x ->
double_and_incr_state x
let (result2, last_state2) = sm2 0
(* val result2 : int = 20
* val last_state2 : int = 1 *)
(* Embedding the unsafe function in another monadic value *)
(* val use_unsafe_f : int IntStateMonad.t = <fun> *)
let use_unsafe_f =
return 1 >>= fun x ->
unsafe_f x
(* This time, catching the exception does not work *)
let sm3 =
put 0 >>= fun () ->
try use_unsafe_f with Not_found -> return 10 >>= fun x ->
double_and_incr_state x
(* This line throws Exception: Not_found. *)
(* let (result3, last_state3) = sm3 0 *)
(* Wrapping try/with and raise to make them work inside the monad *)
(* val with_try : ('a -> 'b) -> (exn -> 'a -> 'b) -> 'a -> 'b = <fun> *)
let with_try f handle_exception s =
try
f s
with e ->
handle_exception e s
(* val throw : exn -> 'a -> 'b = <fun> *)
let throw e _ =
raise e
(* val unsafe_f' : int -> int IntStateMonad.t = <fun> *)
let unsafe_f' x =
if x = 1 then throw Not_found
else return 2
(* val use_unsafe_f' : int IntStateMonad.t = <fun> *)
let use_unsafe_f' =
return 1 >>= fun x ->
unsafe_f' x
(* This time, catching the exception works *)
(* val sm4 : int IntStateMonad.t = <fun> *)
let sm4 =
put 0 >>= fun () ->
with_try
use_unsafe_f'
(function Not_found -> return 10 | e -> raise e) >>= fun x ->
double_and_incr_state x
let (result4, last_state4) = sm4 0
(* val result4 : int = 20
* val last_state4 : int = 1 *)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment