code/_tree_monadize.ml

   1 (*
   2  * tree_monadize.ml
   3  *
   4  * If you've got some block of code that uses `unit`s and `bind`s, and you
   5  * want to interpret it alternately using this monad, that monad, or another
   6  * monad, you can use OCaml's module system. You'd write your code like this:
   7  *)
   8
   9 module Reader_monad = struct
  10     (* change this to suit your needs *)
  11     type env = int -> int;;
  12
  13     type 'a m = env -> 'a;;
  14     let unit a : 'a m = fun e -> a;;
  15     let bind (u : 'a m) (f : 'a -> 'b m) : 'b m =
  16       fun e -> f (u e) e;;
  17 end
  18
  19 module State_monad = struct
  20     (* change this to suit your needs *)
  21     type store = int;;
  22
  23     type 'a m = store -> 'a * store;;
  24     let unit a : 'a m  = fun s -> (a, s);;
  25     let bind (u : 'a m) (f : 'a -> 'b m) : 'b m =
  26       fun s -> (let (a, s') = u s in (f a) s');;
  27 end
  28
  29 module List_monad = struct
  30     type 'a m = 'a list;;
  31     let unit a : 'a m = [a];;
  32     let bind (u: 'a m) (f : 'a -> 'b m) : 'b m =
  33       List.concat(List.map f u);;
  34 end
  35
  36 (*
  37  * Then you can replace code that looks like this:
  38  *     ... reader_bind ...
  39  * with code that looks like this:
  40  *     ... Reader_monad.bind ...
  41  * and the latter can be reformulated like this:
  42  *     let open Reader_monad in ... bind ...
  43  * or equivalently, like this:
  44  *     Reader_monad.(... bind ...)
  45  * Then you can use literally the same `... bind ...` code when writing instead:
  46  *     State_monad.(... bind ...)
  47  *)
  48
  49 (* That's great, however it still requires us to repeat the
  50  * `... bind ...` code every time we want to change which monad we're working
  51  * with. Shouldn't there be a way to _parameterize_ the `... bind ...` code
  52  * on a monad, so that we only have to write the `... bind ...` code once,
  53  * but can invoke it alternately with the Reader_monad supplied as an
  54  * argument, or the State_monad, or another?
  55  *
  56  * There is a way to do this, but it requires putting the `... bind ...` code in
  57  * its own module, and making that module parameterized on some M_monad
  58  * module. Also we have to explicitly declare what commonality we're expecting
  59  * from M_monad modules we're going to use as parameters. We'll explain how to
  60  * do this in a moment.
  61  *
  62  * As preparation, a general observation:
  63  * 'a and so on are type variables in OCaml; they stand for arbitrary types.
  64  * What if you want a variable for a type constructor? For example, you want to
  65  * generalize this pattern:
  66  *      type ('a) t1 = 'a -> ('a) list
  67  *      type ('a) t2 = 'a -> ('a) option
  68  *      type ('a) t3 = 'a -> ('a) reader
  69  * and so on? OCaml won't let you do this:
  70  *      type ('a, 'b) t = 'a -> ('a) 'b
  71  * To generalize on the 'b position, we instead have to use OCaml's modules,
  72  * and in particular its ability to make modules parameterized on other modules
  73  * (OCaml calls these parameterized modules Functors, but that name is also
  74  * used in other ways in this literature, so I won't give in to it.)
  75  *
  76  * Here's how you'd have to define the t type from above:
  77  *      module T_maker(
  78  *      (* A sig...end block specifies the type of a module
  79  *       * What we're doing here is specifying the type of the
  80  *       * module parameter that will choose
  81  *       * whether b = list or b = option or b = reader...
  82  *       * This module parameter may supply values as well as types *)
  83  *      M : sig
  84  *          type ('a) b
  85  *      end
  86  *      ) =
  87  *      (* A struct...end block gives a module value
  88  *       * What we're doing here is building a new module that makes
  89  *       * use of the module that was supplied as M *)
  90  *      struct
  91  *          type ('a) t = 'a -> ('a) M.b
  92  *      end
  93  * And here's how you'd use it:
  94  *      module T_list = T_maker(struct type 'a b = 'a list end);;
  95  *      type 'a t1 = 'a T_list.t;;
  96  *      module T_option = T_maker(struct type 'a b = 'a option end);;
  97  *      type 'a t2 = 'a T_option.t;;
  98  *      (* and so on *)
  99  *
 100  * I know, it seems unnecessarily complicated. Nonetheless, that's how it
 101  * works. And that is also the technique we'll use to make our
 102  * `... bind ...` code parametric on some M_monad module.
 103  *)
 104
 105 type 'a tree = Leaf of 'a | Node of ('a tree) * ('a tree);;
 106
 107 let t1 = Node
 108            (Node
 109              (Leaf 2, Leaf 3),
 110             Node
 111              (Leaf 5,
 112               Node
 113                 (Leaf 7, Leaf 11)));;
 114
 115
 116 module Tree_monadizer(M : sig
 117   (* the module we're using as a parameter has to supply function values
 118    * for unit and bind, as well as a monadic type constructor *)
 119   type 'a m
 120   val unit : 'a -> 'a m
 121   val bind : 'a m -> ('a -> 'b m) -> 'b m
 122 end) = struct
 123   let rec monadize (f: 'a -> 'b M.m) (t: 'a tree) : 'b tree M.m =
 124     match t with
 125     | Leaf a -> M.bind (f a) (fun b -> M.unit (Leaf b))
 126     | Node(l, r) ->
 127         M.bind (monadize f l) (fun l' ->
 128           M.bind (monadize f r) (fun r' ->
 129             M.unit (Node (l', r'))))
 130 end;;
 131
 132
 133 (* Now we supply Reader_monad as a parameter to Tree_monadizer.
 134  * We'll get back a module TreeReader that contains a single value,
 135  * the monadize function specialized to the Reader monad *)
 136 module TreeReader = Tree_monadizer(Reader_monad);;
 137
 138
 139 (* Make a TreeState module containing monadize specialized to the State monad *)
 140 module TreeState =  Tree_monadizer(State_monad);;
 141
 142
 143 (* Make a TreeList module containing monadize specialized to the List monad *)
 144 module TreeList =  Tree_monadizer(List_monad);;
 145
 146
 147 (* The Continuation monad is a bit more complicated *)
 148 module Continuation_monad = struct
 149     type ('r,'a) m = ('a -> 'r) -> 'r;;
 150     let unit a : ('r,'a) m = fun k -> k a;;
 151     let bind (u: ('r,'a) m) (f: 'a -> ('r,'b) m) : ('r,'b) m =
 152       fun k -> u (fun a -> f a k);;
 153 end
 154
 155 (* Since the Continuation monad is parameterized on two types---it's
 156  * ('r,'a) cont not ('a) cont---we can't match the type ('a) monad that
 157  * Tree_monadizer expects in its parameter. So we have to make a different
 158  * Tree_monadizer2 that takes a ('r,'a) monad type constructor in its
 159  * parameter instead *)
 160 module Tree_monadizer2(M : sig
 161   type ('r,'a) m
 162   val unit : 'a -> ('r,'a) m
 163   val bind : ('r,'a) m -> ('a -> ('r,'b) m) -> ('r,'b) m
 164 end) = struct
 165   (* the body of the monadize function is the same; the only difference is in
 166    * the types *)
 167   let rec monadize (f: 'a -> ('r,'b) M.m) (t: 'a tree) : ('r,'b tree) M.m =
 168     match t with
 169     | Leaf a -> M.bind (f a) (fun b -> M.unit (Leaf b))
 170     | Node(l, r) ->
 171         M.bind (monadize f l) (fun l' ->
 172           M.bind (monadize f r) (fun r' ->
 173             M.unit (Node (l', r'))))
 174 end;;
 175
 176 (* Make a TreeCont module containing monadize specialized to the Cont monad *)
 177 module TreeCont =  Tree_monadizer2(Continuation_monad);;
 178
 179
 180
 181 (*
 182  * Here are all the examples from
 183  * http://lambda.jimpryor.net/manipulating_trees_with_monads/
 184  *)
 185
 186
 187 let asker : int -> int Reader_monad.m =
 188   fun (a : int) -> fun (env : int -> int) -> env a;;
 189
 190 (* asker takes an int and returns a Reader monad that
 191  * "looks up" that int in the environment (i.e. modifies it)
 192  * this is structurally parallel to the function `lookup` we used
 193  * before to "look up" variables in the environment *)
 194
 195 (* double each leaf *)
 196 let env = fun i -> i + i in
 197 TreeReader.monadize asker t1 env;;
 198
 199 (* You can also avoid declaring a separate toplevel TreeReader module
 200  * (or even a separate Reader_monad module) by using one of these forms:
 201  *     ...
 202  *     let module T = Tree_monadizer(Reader_monad) in
 203  *     T.monadize asker t1 env;;
 204  * or:
 205  *     ...
 206  *     let env = fun i -> i + i in
 207  *     let module Monad = struct
 208  *       type env = int -> int;;
 209  *       type 'a m = env -> 'a;;
 210  *       let unit a : 'a m = fun e -> a;;
 211  *       let bind (u : 'a m) (f : 'a -> 'b m) : 'b m =
 212  *         fun e -> f (u e) e;;
 213  *     end in
 214  *     let module T = Tree_monadizer(Monad) in
 215  *     T.monadize asker t1 env;;
 216  * or:
 217  *     ...
 218  *     let module T = Tree_monadizer(struct
 219  *       type env = int -> int;;
 220  *       type 'a m = env -> 'a;;
 221  *       let unit a : 'a m = fun e -> a;;
 222  *       let bind (u : 'a m) (f : 'a -> 'b m) : 'b m =
 223  *         fun e -> f (u e) e;;
 224  *     end) in
 225  *     T.monadize asker t1 env;;
 226  *)
 227
 228
 229 (* square each leaf *)
 230 let env = fun i -> i * i in
 231 TreeReader.monadize asker t1 env;;
 232
 233
 234
 235 (* count leaves *)
 236
 237 let incrementer : int -> int State_monad.m =
 238   fun (a : int) -> fun s -> (a, s+1);;
 239 (* incrementer takes an 'a and returns it wrapped in a
 240  * State monad that increments the store *)
 241
 242 let initial_store = 0 in
 243 TreeState.monadize incrementer t1 initial_store;;
 244
 245 (* annotate leaves as they're visited *)
 246
 247 let annotater : int -> (int * int) State_monad.m =
 248   fun (a : int) -> fun s -> ((a,s+1), s+1);;
 249
 250 let initial_store = 0 in
 251 TreeState.monadize annotater t1 initial_store;;
 252
 253
 254 (* copy tree with different choices for leaves *)
 255
 256 let chooser i = if i = 2 then [20; 21] else [i];;
 257
 258 TreeList.monadize chooser t1;;
 259
 260
 261
 262 (* do nothing *)
 263 let initial_continuation = fun t -> t in
 264 TreeCont.monadize Continuation_monad.unit t1 initial_continuation;;
 265
 266 (* convert tree to list of leaves *)
 267 let initial_continuation = fun t -> [] in
 268 TreeCont.monadize (fun a k -> a :: k a) t1 initial_continuation;;
 269
 270 (* square each leaf using continuation *)
 271 let initial_continuation = fun t -> t in
 272 TreeCont.monadize (fun a k -> k (a*a)) t1 initial_continuation;;
 273
 274 (* count leaves, using continuation *)
 275 let initial_continuation = fun t -> 0 in
 276 TreeCont.monadize (fun a k -> 1 + k a) t1 initial_continuation;;
 277
 278