学步园

假设我们已经有啤酒与威士忌两个模块:
module Beer = struct
      type t = BEER 
      let pour () =  
          let () = Printf.printf "... a nice head ... "
in BEER

      let consume t =Printf.printf
"Ha! Nothing like a good beer to quench the thirst\n"
end

module Whisky = struct
      type t = WHISKY 
      let pour () =  
          let () = Printf.printf
"... 2 fingers of this ...." in WHISKY

      let consume _ = Printf.printf
"... Ha! Piss of the Gods!\n"
end

如果现在想实现一个酒鬼模块, 这个酒鬼有时喜欢啤酒,有时又喜欢威士忌. 注意:
啤酒与威士忌模块实现了一样的函数(pour/consume). 所以我们可以定义一个如下的"模块类型":

module type Beverage =
sig
      type t 
      val pour :unit -> t 
      val consume : t ->unit
end

然后,使用 functor建一个酒鬼模块:

module Alkie =functor (B:Beverage)
-> struct
      let rec another =
function
      | 0 -> () 
      | i -> let b = B.pour ()
in
          let () = B.consume b
in
          another (i-1) 
end

使用:

let menu = Hashtbl.create
3 
let () = Hashtbl.add menu "Beer" (module Beer : Beverage)
let () = Hashtbl.add menu "Whisky" (module Whisky : Beverage)

let () = let favourite =ref "Whisky"
in
    let () = Arg.parse
        [("--beverage", Arg.Set_string favourite,Printf.sprintf "which beverage to use (%s)" !favourite)]
      (fun s -> raise (Arg.Bad s))
      ("usage:")
    in
      let
module B = (val (Hashtbl.find menu !favourite) : Beverage)in
      let module  AlkieB = Alkie(B) in
      let () = AlkieB.another 3
in ();;

将上面代码存入文件a.ml,然后:

>ocamlc a.ml

>./a.out
... 2 fingers of this ....... Ha! Piss of the Gods!
... 2 fingers of this ....... Ha! Piss of the Gods!
... 2 fingers of this ....... Ha! Piss of the Gods!

>./a.out --beverage Beer
... a nice head ... Ha! Nothing like a good beer to quench the thirst
... a nice head ... Ha! Nothing like a good beer to quench the thirst
... a nice head ... Ha! Nothing like a good beer to quench the thirst

当然你也可以用类来实现,
只需将啤酒与威士忌对象注入酒鬼就可以了.
附代码:

classtype
beverage = object
    method consume :
unit -> unit
end

class beer = object (self :#beverage)
    method consume () =
Printf.printf "...drank beer\n"
end

let make_beer () =
    let () = Printf.printf "pouring beer\n" in
        let b = new beer in
            (b :> beverage)  (*b是beverage的子对象,函数返回的类型是beverage
*)

class whisky = object(self :#beverage)
    method consume () =
Printf.printf "...drank whisky\n"
end

let make_whisky () =
    let ()  = Printf.printf "pouring whisky\n" in
        let b = new whisky in
            (b :> beverage)

class alkie p = object (self)
    method another n =
       if n = 0  
       then ()  
       else
            let b = p ()
in
                let () = b#consume ()in
                    self#another (n-1)
end

let
menu = Hashtbl.create 3
let () = Hashtbl.add menu "Beer" make_beer
let () = Hashtbl.add menu "Whisky" make_whisky

let () =
    let favourite =
ref "Whisky" in
    let () = Arg.parse
        [("--beverage", Arg.Set_string favourite,Printf.sprintf "which beverage to use (%s)" !favourite)]
        (fun s ->
raise (Arg.Bad s))
        ("usage:") 
    in
        let p = Hashtbl.find menu !favouritein
        let a = new alkie pin   (* 注入对象 *)
            a#another 3 ;;
引用网址：http://blog.csdn.net/sw2wolf/article/details/7006930