2

例が長くてすみません:

module type MONAD = sig
  type ('r, 'a) t
  val return : 'a -> ('r, 'a) t
  val bind : ('r, 'a) t -> ('a -> ('r, 'b) t) -> ('r, 'b) t
end

module MonadOps (Monad : MONAD) = struct
  include Monad
  type ('r, 'a) monad = ('r, 'a) t
  let run x = x
  let return = Monad.return
  let bind = Monad.bind
  let (>>=) a b = bind a b
  let rec foldM f a = function
    | [] -> return a
    | x::xs -> f a x >>= fun a' -> foldM f a' xs
  let whenM p s = if p then s else return ()
  let lift f m = perform x <-- m; return (f x)
  let join m = perform x <-- m; x
  let (>=>) f g = fun x -> f x >>= g
end

module Monad = (MonadOps : functor (M : MONAD) -> sig
  type ('a, 'b) monad
  val run : ('a, 'b) monad -> ('a, 'b) M.t
  val return : 'a -> ('b, 'a) monad
  val bind : ('a, 'b) monad -> ('b -> ('a, 'c) monad) -> ('a, 'c) monad
  val ( >>= ) :
    ('a, 'b) monad -> ('b -> ('a, 'c) monad) -> ('a, 'c) monad
  val foldM :
    ('a -> 'b -> ('c, 'a) monad) -> 'a -> 'b list -> ('c, 'a) monad
  val whenM : bool -> ('a, unit) monad -> ('a, unit) monad
  val lift : ('a -> 'b) -> ('c, 'a) monad -> ('c, 'b) monad
  val join : ('a, ('a, 'b) monad) monad -> ('a, 'b) monad
  val ( >=> ) :
    ('a -> ('b, 'c) monad) ->
    ('c -> ('b, 'd) monad) -> 'a -> ('b, 'd) monad
end)

module type MONAD_PLUS = sig
  include MONAD
  val mzero : ('r, 'a) t
  val mplus : ('r, 'a) t -> ('r, 'a) t -> ('r, 'a) t
end

module MonadPlusOps (MonadPlus : MONAD_PLUS) = struct
  include MonadOps (MonadPlus)
  let mzero = MonadPlus.mzero
  let mplus = MonadPlus.mplus
  let fail = mzero
  let (++) a b = mplus a b
  let guard p = if p then return () else fail
end

署名コードを過度に重複させずにMonadPlus類似させる方法はありますか? Monad（間違った解決策）の行に沿って：

module MonadPlus = (MonadPlusOps : functor (M : MONAD_PLUS) -> sig
  include module type of MonadPlusOps (M)
    with type ('a, 'b) t := ('a, 'b) MonadPlusOps (M).monad
end)

または (型チェックを行いません):

module MonadPlus = (MonadPlusOps : functor (M : MONAD_PLUS) -> sig
  include module type of Monad(M)
  val mzero : ('a, 'b) monad
  (* ... *)
end)

編集：更新-より良い最終的な解決策

module type MONAD = sig
  type ('s, 'a) t
  val return : 'a -> ('s, 'a) t
  val bind : ('s, 'a) t -> ('a -> ('s, 'b) t) -> ('s, 'b) t
end

module type MONAD_OPS = sig
  type ('s, 'a) monad
  include MONAD with type ('s, 'a) t := ('s, 'a) monad
  val ( >>= ) :
    ('s, 'a) monad -> ('a -> ('s, 'b) monad) -> ('s, 'b) monad
  val foldM :
    ('a -> 'b -> ('s, 'a) monad) -> 'a -> 'b list -> ('s, 'a) monad
  val whenM : bool -> ('s, unit) monad -> ('s, unit) monad
  val lift : ('a -> 'b) -> ('s, 'a) monad -> ('s, 'b) monad
  val join : ('s, ('s, 'a) monad) monad -> ('s, 'a) monad
  val ( >=> ) :
    ('a -> ('s, 'b) monad) ->
    ('b -> ('s, 'c) monad) -> 'a -> ('s, 'c) monad
end

module MonadOps (M : MONAD) = struct
  open M
  type ('s, 'a) monad = ('s, 'a) t
  let run x = x
  let (>>=) a b = bind a b
  let rec foldM f a = function
    | [] -> return a
    | x::xs -> f a x >>= fun a' -> foldM f a' xs
  let whenM p s = if p then s else return ()
  let lift f m = perform x <-- m; return (f x)
  let join m = perform x <-- m; x
  let (>=>) f g = fun x -> f x >>= g
end

module Monad (M : MONAD) =
sig
  include MONAD_OPS
  val run : ('s, 'a) monad -> ('s, 'a) M.t
end = struct
  include M
  include MonadOps(M)
end

module type MONAD_PLUS = sig
  include MONAD
  val mzero : ('s, 'a) t
  val mplus : ('s, 'a) t -> ('s, 'a) t -> ('s, 'a) t
end

module type MONAD_PLUS_OPS = sig
  include MONAD_OPS
  val mzero : ('s, 'a) monad
  val mplus : ('s, 'a) monad -> ('s, 'a) monad -> ('s, 'a) monad
  val fail : ('s, 'a) monad
  val (++) : ('s, 'a) monad -> ('s, 'a) monad -> ('s, 'a) monad
  val guard : bool -> ('s, unit) monad
end

module MonadPlus (M : MONAD_PLUS) :
sig
  include MONAD_PLUS_OPS
  val run : ('s, 'a) monad -> ('s, 'a) M.t
end = struct
  include M
  include MonadOps(M)
  let fail = mzero
  let (++) a b = mplus a b
  let guard p = if p then return () else fail
end
4

2 に答える 2

2

あなたが達成しようとしていることは完全にはわかりませんが、おそらく次のように因数分解しようとします：

module type MONAD =
sig
  type ('r, 'a) t
  val return : 'a -> ('r, 'a) t
  val bind : ('r, 'a) t -> ('a -> ('r, 'b) t) -> ('r, 'b) t
end

module type MONAD_OPS =
sig
  type ('a, 'b) monad
  val run : ('a, 'b) monad -> ('a, 'b) monad
  val (>>=) : ('a, 'b) monad -> ('b -> ('a, 'c) monad) -> ('a, 'c) monad
  (* ... *)
end

module MonadOps (Monad : MONAD) : 
sig
  include MONAD with type ('a ,'b) t := ('a, 'b) Monad.t
  include MONAD_OPS with type ('a ,'b) monad = ('a, 'b) Monad.t
end =
struct
  include Monad
  type ('r, 'a) monad = ('r, 'a) t
  let run x = x
  let (>>=) = bind
  let rec foldM f a = function
    | [] -> return a
    | x::xs -> f a x >>= fun a' -> foldM f a' xs
  (* ... *)
end

module type MONAD_PLUS = sig
  include MONAD
  val mzero : ('r, 'a) t
  val mplus : ('r, 'a) t -> ('r, 'a) t -> ('r, 'a) t
end

module type MONAD_PLUS_OPS =
sig
  include MONAD_OPS
  val fail : ('r, 'a) monad
  val (++) : ('r, 'a) monad -> ('r, 'a) monad -> ('r, 'a) monad
  (* ... *)
end

module MonadPlusOps (MonadPlus : MONAD_PLUS) :
sig
  include MONAD_PLUS with type ('a ,'b) t := ('a, 'b) Monad.t
  include MONAD_PLUS_OPS with type ('a ,'b) monad = ('a, 'b) Monad.t
end =
struct
  include MonadPlus
  include MonadOps (MonadPlus)
  let fail = mzero
  let (++) = mplus
  (* ... *)
end
于 2012-12-12T23:16:14.193 に答える
2

Andreas の回答を補足するものとして、ファンクタを使用してシグネチャを生成できることを示したいと思いました。どのレベルの型を抽象化する必要があるかについての議論には正確に従っていないので、このコードを Andreas のバージョンと比較してください。

module MonadSig = struct
  module type S = sig
    type ('r, 'a) t
    val return : 'a -> ('r, 'a) t
    val bind : ('r, 'a) t -> ('a -> ('r, 'b) t) -> ('r, 'b) t
  end
end

module MonadOpsSig (M : MonadSig.S) = struct
  module type S = sig
    type ('a, 'b) monad = ('a, 'b) M.t
    val run : ('a, 'b) monad -> ('a, 'b) monad
    val (>>=) : ('a, 'b) monad -> ('b -> ('a, 'c) monad) -> ('a, 'c) monad
    (* ... *)
  end
end

module MonadOps (M : MonadSig.S) : MonadOpsSig(M).S = struct
  open M
  type ('r, 'a) monad = ('r, 'a) t
  let run x = x
  let (>>=) = bind
  let rec foldM f a = function
    | [] -> return a
    | x::xs -> f a x >>= fun a' -> foldM f a' xs
  (* ... *)
end

module MonadPlusSig = struct
  module type S = sig
    include MonadSig.S
    val mzero : ('r, 'a) t
    val mplus : ('r, 'a) t -> ('r, 'a) t -> ('r, 'a) t
  end
end

module MonadPlusOpsSig (Monad : MonadPlusSig.S) = struct
  module type S = sig
    include MonadOpsSig(Monad).S
    val fail : ('r, 'a) monad
    val (++) : ('r, 'a) monad -> ('r, 'a) monad -> ('r, 'a) monad
    (* ... *)
  end
end

module MonadPlusOps (M : MonadPlusSig.S) : MonadPlusOpsSig(M).S = struct
  include MonadOps(M)
  open M
  let fail = mzero
  let (++) = mplus
  (* ... *)
end

アイデアは、何かにパラメーター化された署名を提供するために、この署名をパラメーター化されたファンクターに埋め込むか (これを「ファンクター スタイル」と呼びます)、パラメーターを抽象として定義することができます (ただし、実際にはパラメーターではなく入力です)。出力) を使用し、実際のパラメーターと同等にします (これを「ミックスイン スタイル」と呼びます)。上記のコードが Andreas のコードよりも優れていると言っているわけではありません。実際、おそらく彼のバージョンを使用したいと思いますが、それらを比較するのは興味深いことです。

于 2012-12-13T10:22:06.017 に答える