Monads

An aside - OCaml type restriction

# let x = [];;
val x : 'a list = []
# let y = ref [];;
val y : '_a list ref = {contents = []}
# let y' = !y;;
val y' : '_a list = []
# x;;
- : 'a list = []
# y';;
- : '_a list = []
#

in the above definitions, x is of type 'a list and y is of type '_a list this subtle distinction essentially means that once an element has been added to y its type hardens meaning it no longer behaves as a generic 'a but as the type of whatever was inserted.

# y';;
- : '_a list = []
# 1 :: y';;
- : int list = [1]
# y';;
- : int list = []
# 'a' :: y';;

Characters 7-9:
  'a' :: y';;
         ^^
Error: This expression has type int list
       but an expression was expected of type char list
       Type int is not compatible with type char

whereas with x of type 'a list

# x;;
- : 'a list = []
# 1 :: x;;
- : int list = [1]
# 'a' :: x;;
- : char list = ['a']

To avoid this issue you can simple stipulate all variables being when defining functions. This process is called an eta-expansion or η\eta-expansion

given :

# let f x = x;;
val f : 'a -> 'a = <fun>

This creates the difference between:

# let g = f f;;
val g : '_a -> '_a = <fun>

and

# let g x = f f x;;
val g : 'a -> 'a = <fun>

Monads

# 1/0;;
Exception: Division_by_zero
# let ( / ) x y = if y = 0 then None else Some (x/y)
- : val ( / ) : int -> int -> int option = <fun>
# 1/0;;
- : int option = None
# 4/2;;
- : int option = Some 2
# 4/2 + 2;;
Characters 0-3:
  4/2 + 2;;
  ^^^
Error: This expression has type int option
       but an expression was expected of type int
 let ( + ) = lift ( + )
 let ( * ) = lift ( * )
 let ( - ) = lift ( - )
 let ( < ) = lift ( < )
 ...

What are monads?

module type F = sig
  type _ t

  val map : ('a -> 'b) -> ('a t -> 'b t)
end

Monads are just functors with 2 extra operations

The monad extension adds a further 2

module type M = sig
  include F

  val unit : 'a -> 'a t       

  val mult : ('a t) t -> 'a t
end

To produce

module type M =
  sig
    type _ t
    val map : ('a -> 'b) -> 'a t -> 'b t
    val unit : 'a -> 'a t
    val mult : 'a t t -> 'a t
  end

Once compiled.

Our two new operations

Unit

Mult

Option Monad

module Option_m : (M with type 'a t = 'a option) = struct
  type 'a t = 'a option

  let map (f : 'a -> 'b) = function
    | None   -> None
    | Some a -> Some (f a)

  let unit a = Some a

  let mult = function
    | None   -> None
    | Some x -> x
end

This is the condensed form using the predefined Monad (and by proxy, functor) signatures, simply stipulating the instrumented type as 'a option

The full, explicit signature is given by:

module Option_m :
  sig
    type 'a t = 'a option
    val map : ('a -> 'b) -> 'a t -> 'b t
    val unit : 'a -> 'a t
    val mult : 'a t t -> 'a t
  end

With the same resulting implementation, simply taking the above to be its explicit signature.

With the above machinary we could lift all our functions uniformly. However, the monadic extension, as mentioned earlier, adds a futher 2 functions useful when lifting many functions.

Our two new operations : Monad_extension

module Monad_e (Monad : M) = struct
  include Monad

  (* bind *)
  let ( >>= ) at f = at |> (map f) |> mult

  (* lift *)
  let lift f at bt =
    at >>= fun a ->
    bt >>= fun b ->
    unit (f a b)
end

module Monad_e :
  functor (Monad : M) ->
    sig
      type 'a t = 'a Monad.t
      val map : ('a -> 'b) -> 'a t -> 'b t
      val unit : 'a -> 'a t
      val mult : 'a t t -> 'a t
      val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
      val lift : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
    end

Bind


Other common Monads


Identity

module Id_m : M = struct 
  type 'a t = 'a 
  let map f = f 
  let unit a = a 
  let mult a = a 
end

Writer Monad

module Writer_m : (M with type 'a t = 'a * string) = struct
  type 'a t = 'a * string
  let map f (a, s) = (f a, s)
  let unit a = (a, "")
  let mult ((a, s), s') = (a, s' ^ s)
end
module Writer_m :
  sig
    type 'a t = 'a * string
    val map : ('a -> 'b) -> 'a t -> 'b t
    val unit : 'a -> 'a t
    val mult : 'a t t -> 'a t
  end

module Logger = struct  
  module M = Monad_e (Writer_m)      
  open M

  let (<) (x, s) (y, s') =
    (x < y,
     (if x < y
      then ((string_of_int x) ^ "<"  ^ (string_of_int y) ^ "\n")
      else ((string_of_int x) ^ ">=" ^ (string_of_int y) ^ "\n"))
    ^ s ^ s')
end
module Logger :
  sig
    module M :
      sig
        type 'a t = 'a Writer_m.t
        val map : ('a -> 'b) -> 'a t -> 'b t
        val unit : 'a -> 'a t
        val mult : 'a t t -> 'a t
        val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
        val lift : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
        val lift2 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t
      end
    val ( < ) : int * string -> int * string -> bool * string
  end

State Monad

module type STATE =
sig
  type s
  val emp : s
end

module type MONAD =
  sig
    type 'a m
    val map  : ('a -> 'b) -> ('a m -> 'b m)
    val mult : 'a m m -> 'a m
    val unit : 'a -> 'a m
  end
  
module type STATE_MONAD = 
  functor(State : STATE) ->
  sig
    include MONAD
    (* Special operations *)
    val run  : 'a m -> 'a 
    val set  : State.s -> unit m
    val get  : State.s m
    val ( >>= ) : 'a m -> ('a -> 'b m) -> 'b m
  end

module StateMonad : (STATE_MONAD) =
   functor (State : STATE) ->
     struct
       type 'a m = State.s -> ('a * State.s)
                               
       let (map : ('a -> 'b) -> ('a m -> 'b m)) =
         fun f a s -> let (a', s') = a s in (f a', s')
                                                
       let (mult : 'a m m -> 'a m) =
         fun att s0 -> let (at, s1) = att s0 in at s1
           
       let (unit : 'a -> 'a m) =
         fun a s -> (a, s)
                        
       let (run : 'a m -> 'a ) =
         fun m -> m State.emp |> fst

       let (set : State.s -> unit m) =
         fun s _ -> ((), s)

       let (get : State.s m) =
         fun s -> (s, s)

       (* Bind *)
       let (>>=) at f = at |> (map f) |> mult
     end

An example usage:

module IntState : (STATE with type s = int) = struct
  type s = int
  let emp = 0
end

module Stateful = struct
  module SM = StateMonad(IntState)
  open SM

  let inc s =
    get         >>= fun n  ->
    set (n + 1) >>= fun () ->
    get
end