fork download
copy 
  1.  
  2. (** how to sharing the code is still a problem
  3.     how to encode the relationship 
  4.     Monad => MonadState
  5.  *)
  6. module type MONAD = sig
  7.   type ('a,'param) t
  8.   val return:  'a -> ('a,'param) t
  9.   val (>>=): ('a,'param) t -> ('a -> ('b,'param) t) -> ('b,'param) t
  10. end 
  11. module type Monad =sig
  12.   type a
  13.   type param 
  14.   module Repr (M:MONAD):sig
  15.     val extract: (a,param) M.t
  16.   end
  17. end
  18.  
  19. module type MONADSTATE =sig
  20.   include MONAD
  21.   val gets: ('s->'a) -> ('a,'s)t 
  22. end
  23.  
  24. module type MonadState = sig
  25.   type a
  26.   type param
  27.   module Repr(M:MONADSTATE) : sig
  28.     val extract:(a,param) M.t
  29.   end 
  30. end 
  31. (*
  32.   reify a type constructor ['a t] as a module
  33.  *)
  34. type ('a,'param) monad =
  35.     (module Monad with type a = 'a and type param='param)
  36. type ('a,'param) monad_state =
  37.     (module MonadState with type a = 'a and type param = 'param)
  38.  
  39.  
  40. (* result can not esscape M *)
  41. (* let get (type s) (mx :s monad) (module M: MONAD) =
  42.  *   let module MX = (val mx) in
  43.  *   let module NX = MX.Repr(M) in
  44.  *   NX.extract *)
  45.  
  46. module Make(M:MONAD) = struct
  47.   include M
  48.   (* let unwrap (x:) *)
  49.   let run (type s) (type param) (mx : (s,param) monad) : (s,param) t =
  50.     let module MX = (val mx) in
  51.     let module NX = MX.Repr(M) in NX.extract 
  52. end
  53.  
  54. (* let unwrap (type s) (type p) (x: : (s,p) monad=
  55.  *   (module struct
  56.  *     type a = s
  57.  *     type param = p
  58.  *     module Repr (M : MONAD) = struct
  59.  *       let extract  = x
  60.  *     end
  61.  *   end ) *)
  62.  
  63. (** how to reuse [return] for monad_state
  64.     if not reusable,
  65.     reuse liftM
  66.  *)
  67. let return (type s) (type p) x : (s,p) monad=
  68.   (module struct
  69.     type a = s
  70.     type param = p
  71.     module Repr (M : MONAD) = struct
  72.       let extract  = M.return x
  73.     end
  74.   end )
  75.  
  76. let (>>=) (type s) (type t) (type p)
  77.   (mx:(s,p) monad)
  78.   (f:s -> (t,p) monad)
  79.   : (t,p) monad =
  80.   (module struct
  81.     type a = t
  82.     type param = p 
  83.     module Repr (M:MONAD) = struct
  84.       let extract =
  85.         let module MX = (val mx) in
  86.         let module RX = MX.Repr(M) in
  87.         M.(RX.extract >>= fun x ->
  88.            let my = f x in
  89.            let module MY = (val my) in
  90.            let module RY = MY.Repr(M)     in
  91.            RY.extract)
  92.     end 
  93.   end);;
  94.  
  95.  
  96. let liftM f mx = mx >>= fun x -> return (f x)
  97. let (>>) mx my = mx >>= fun _ -> my
  98. (* let guard p = if p then return () else fail *)
  99.  
  100.  
  101.  
  102.  
  103.  
  104. module OptionM = Make(struct
  105.   type ('a,'param) t = 'a option
  106.   let return x = Some x
  107.   let (>>=) mx f = match mx with None -> None | Some x -> f x
  108. end)
  109.  
  110. module ListM = Make(struct
  111.   type ('a,'param) t = 'a list
  112.   let return x = [x]
  113.   let (>>=) mx f = List.(concat (map f mx))
  114. end)
  115. ;;
  116. (* module StateM = Make(struct
  117.  *   type 'a t = (s -> ('a*s))
  118.  * end) *)
  119. let v : (int,unit) monad  =
  120.         liftM succ (return 3) >>= fun x -> return (succ x);;
  121.  
  122. match OptionM.run v with Some v -> print_int v
  123. | None -> print_string "None";;
  124.  
  125. List.iter print_int (ListM.run v );;
  126. module StateM = struct
  127.   include Make(struct
  128.   type ('a,'param) t =  ('param -> ('a*'param))
  129.   let return x = (fun s -> (x,s))
  130.   let (>>=) mx f = fun s ->
  131.     let a,s = mx s in
  132.     f a s
  133.   let gets f = fun s -> return (f s)
  134.  end)
  135. end
  136.  
  137. (*
  138.   gets :: (s->a) -> a monad
  139.  *)    
  140.  
  141.  
  142.  
  143.  
Compilation error #stdin compilation error #stdout 0s 0KB
comments (?)
stdin
copy 
Standard input is empty
compilation info 
File "prog.ml", line 35, characters 5-11:
Syntax error
stdout
copy 
Standard output is empty
https://ideone.com/HgG4M
language:
OCaml (ocamlopt 4.05.0)
created:
12 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!