+++ /dev/null
-(*
- * tree_monadize.ml
- *
- * If you've got some block of code that uses `unit`s and `bind`s, and you
- * want to interpret it alternately using this monad, that monad, or another
- * monad, you can use OCaml's module system. You'd write your code like this:
- *)
-
-module Reader_monad = struct
- (* change this to suit your needs *)
- type env = int -> int;;
-
- type 'a m = env -> 'a;;
- let unit a : 'a m = fun e -> a;;
- let bind (u : 'a m) (f : 'a -> 'b m) : 'b m =
- fun e -> f (u e) e;;
-end
-
-module State_monad = struct
- (* change this to suit your needs *)
- type store = int;;
-
- type 'a m = store -> 'a * store;;
- let unit a : 'a m = fun s -> (a, s);;
- let bind (u : 'a m) (f : 'a -> 'b m) : 'b m =
- fun s -> (let (a, s') = u s in (f a) s');;
-end
-
-module List_monad = struct
- type 'a m = 'a list;;
- let unit a : 'a m = [a];;
- let bind (u: 'a m) (f : 'a -> 'b m) : 'b m =
- List.concat(List.map f u);;
-end
-
-(*
- * Then you can replace code that looks like this:
- * ... reader_bind ...
- * with code that looks like this:
- * ... Reader_monad.bind ...
- * and the latter can be reformulated like this:
- * let open Reader_monad in ... bind ...
- * or equivalently, like this:
- * Reader_monad.(... bind ...)
- * Then you can use literally the same `... bind ...` code when writing instead:
- * State_monad.(... bind ...)
- *)
-
-(* That's great, however it still requires us to repeat the
- * `... bind ...` code every time we want to change which monad we're working
- * with. Shouldn't there be a way to _parameterize_ the `... bind ...` code
- * on a monad, so that we only have to write the `... bind ...` code once,
- * but can invoke it alternately with the Reader_monad supplied as an
- * argument, or the State_monad, or another?
- *
- * There is a way to do this, but it requires putting the `... bind ...` code in
- * its own module, and making that module parameterized on some M_monad
- * module. Also we have to explicitly declare what commonality we're expecting
- * from M_monad modules we're going to use as parameters. We'll explain how to
- * do this in a moment.
- *
- * As preparation, a general observation:
- * 'a and so on are type variables in OCaml; they stand for arbitrary types.
- * What if you want a variable for a type constructor? For example, you want to
- * generalize this pattern:
- * type ('a) t1 = 'a -> ('a) list
- * type ('a) t2 = 'a -> ('a) option
- * type ('a) t3 = 'a -> ('a) reader
- * and so on? OCaml won't let you do this:
- * type ('a, 'b) t = 'a -> ('a) 'b
- * To generalize on the 'b position, we instead have to use OCaml's modules,
- * and in particular its ability to make modules parameterized on other modules
- * (OCaml calls these parameterized modules Functors, but that name is also
- * used in other ways in this literature, so I won't give in to it.)
- *
- * Here's how you'd have to define the t type from above:
- * module T_maker(
- * (* A sig...end block specifies the type of a module
- * * What we're doing here is specifying the type of the
- * * module parameter that will choose
- * * whether b = list or b = option or b = reader...
- * * This module parameter may supply values as well as types *)
- * M : sig
- * type ('a) b
- * end
- * ) =
- * (* A struct...end block gives a module value
- * * What we're doing here is building a new module that makes
- * * use of the module that was supplied as M *)
- * struct
- * type ('a) t = 'a -> ('a) M.b
- * end
- * And here's how you'd use it:
- * module T_list = T_maker(struct type 'a b = 'a list end);;
- * type 'a t1 = 'a T_list.t;;
- * module T_option = T_maker(struct type 'a b = 'a option end);;
- * type 'a t2 = 'a T_option.t;;
- * (* and so on *)
- *
- * I know, it seems unnecessarily complicated. Nonetheless, that's how it
- * works. And that is also the technique we'll use to make our
- * `... bind ...` code parametric on some M_monad module.
- *)
-
-type 'a tree = Leaf of 'a | Node of ('a tree) * ('a tree);;
-
-let t1 = Node
- (Node
- (Leaf 2, Leaf 3),
- Node
- (Leaf 5,
- Node
- (Leaf 7, Leaf 11)));;
-
-
-module Tree_monadizer(M : sig
- (* the module we're using as a parameter has to supply function values
- * for unit and bind, as well as a monadic type constructor *)
- type 'a m
- val unit : 'a -> 'a m
- val bind : 'a m -> ('a -> 'b m) -> 'b m
-end) = struct
- let rec monadize (f: 'a -> 'b M.m) (t: 'a tree) : 'b tree M.m =
- match t with
- | Leaf a -> M.bind (f a) (fun b -> M.unit (Leaf b))
- | Node(l, r) ->
- M.bind (monadize f l) (fun l' ->
- M.bind (monadize f r) (fun r' ->
- M.unit (Node (l', r'))))
-end;;
-
-
-(* Now we supply Reader_monad as a parameter to Tree_monadizer.
- * We'll get back a module TreeReader that contains a single value,
- * the monadize function specialized to the Reader monad *)
-module TreeReader = Tree_monadizer(Reader_monad);;
-
-
-(* Make a TreeState module containing monadize specialized to the State monad *)
-module TreeState = Tree_monadizer(State_monad);;
-
-
-(* Make a TreeList module containing monadize specialized to the List monad *)
-module TreeList = Tree_monadizer(List_monad);;
-
-
-(* The Continuation monad is a bit more complicated *)
-module Continuation_monad = struct
- type ('r,'a) m = ('a -> 'r) -> 'r;;
- let unit a : ('r,'a) m = fun k -> k a;;
- let bind (u: ('r,'a) m) (f: 'a -> ('r,'b) m) : ('r,'b) m =
- fun k -> u (fun a -> f a k);;
-end
-
-(* Since the Continuation monad is parameterized on two types---it's
- * ('r,'a) cont not ('a) cont---we can't match the type ('a) monad that
- * Tree_monadizer expects in its parameter. So we have to make a different
- * Tree_monadizer2 that takes a ('r,'a) monad type constructor in its
- * parameter instead *)
-module Tree_monadizer2(M : sig
- type ('r,'a) m
- val unit : 'a -> ('r,'a) m
- val bind : ('r,'a) m -> ('a -> ('r,'b) m) -> ('r,'b) m
-end) = struct
- (* the body of the monadize function is the same; the only difference is in
- * the types *)
- let rec monadize (f: 'a -> ('r,'b) M.m) (t: 'a tree) : ('r,'b tree) M.m =
- match t with
- | Leaf a -> M.bind (f a) (fun b -> M.unit (Leaf b))
- | Node(l, r) ->
- M.bind (monadize f l) (fun l' ->
- M.bind (monadize f r) (fun r' ->
- M.unit (Node (l', r'))))
-end;;
-
-(* Make a TreeCont module containing monadize specialized to the Cont monad *)
-module TreeCont = Tree_monadizer2(Continuation_monad);;
-
-
-
-(*
- * Here are all the examples from
- * http://lambda.jimpryor.net/manipulating_trees_with_monads/
- *)
-
-
-let asker : int -> int Reader_monad.m =
- fun (a : int) -> fun (env : int -> int) -> env a;;
-
-(* asker takes an int and returns a Reader monad that
- * "looks up" that int in the environment (i.e. modifies it)
- * this is structurally parallel to the function `lookup` we used
- * before to "look up" variables in the environment *)
-
-(* double each leaf *)
-let env = fun i -> i + i in
-TreeReader.monadize asker t1 env;;
-
-(* You can also avoid declaring a separate toplevel TreeReader module
- * (or even a separate Reader_monad module) by using one of these forms:
- * ...
- * let module T = Tree_monadizer(Reader_monad) in
- * T.monadize asker t1 env;;
- * or:
- * ...
- * let env = fun i -> i + i in
- * let module Monad = struct
- * type env = int -> int;;
- * type 'a m = env -> 'a;;
- * let unit a : 'a m = fun e -> a;;
- * let bind (u : 'a m) (f : 'a -> 'b m) : 'b m =
- * fun e -> f (u e) e;;
- * end in
- * let module T = Tree_monadizer(Monad) in
- * T.monadize asker t1 env;;
- * or:
- * ...
- * let module T = Tree_monadizer(struct
- * type env = int -> int;;
- * type 'a m = env -> 'a;;
- * let unit a : 'a m = fun e -> a;;
- * let bind (u : 'a m) (f : 'a -> 'b m) : 'b m =
- * fun e -> f (u e) e;;
- * end) in
- * T.monadize asker t1 env;;
- *)
-
-
-(* square each leaf *)
-let env = fun i -> i * i in
-TreeReader.monadize asker t1 env;;
-
-
-
-(* count leaves *)
-
-let incrementer : int -> int State_monad.m =
- fun (a : int) -> fun s -> (a, s+1);;
-(* incrementer takes an 'a and returns it wrapped in a
- * State monad that increments the store *)
-
-let initial_store = 0 in
-TreeState.monadize incrementer t1 initial_store;;
-
-(* annotate leaves as they're visited *)
-
-let annotater : int -> (int * int) State_monad.m =
- fun (a : int) -> fun s -> ((a,s+1), s+1);;
-
-let initial_store = 0 in
-TreeState.monadize annotater t1 initial_store;;
-
-
-(* copy tree with different choices for leaves *)
-
-let chooser i = if i = 2 then [20; 21] else [i];;
-
-TreeList.monadize chooser t1;;
-
-
-
-(* do nothing *)
-let initial_continuation = fun t -> t in
-TreeCont.monadize Continuation_monad.unit t1 initial_continuation;;
-
-(* convert tree to list of leaves *)
-let initial_continuation = fun t -> [] in
-TreeCont.monadize (fun a k -> a :: k a) t1 initial_continuation;;
-
-(* square each leaf using continuation *)
-let initial_continuation = fun t -> t in
-TreeCont.monadize (fun a k -> k (a*a)) t1 initial_continuation;;
-
-(* count leaves, using continuation *)
-let initial_continuation = fun t -> 0 in
-TreeCont.monadize (fun a k -> 1 + k a) t1 initial_continuation;;
-
-