SMLでApplicativeを書く - ::Eldesh a b = LEFT a

コードはcodeplexに置いてあります。
(sml/njでuse "applicative.use"; するとApplicativeなOptionが使えます))

http://www.haskell.org/ghc/docs/latest/html/libraries/base/Control-Applicative.html を参考にしました。

とりあえず下のレイヤから書いていきます。

signature FUNCTOR_CORE =
sig
  type 'a t
  val fmap : ('a -> 'b) -> 'a t -> 'b t
end
signature APPLICATIVE_CORE =
sig
  include FUNCTOR_CORE
  (* ここにも type 'a t とか書きたいなぁ… *)
  val pure : 'a -> 'a t
  val <*> : ('a -> 'b) t * 'a t -> 'b t
end

プリミティブなものだけを実装しておきます。(便利関数は後付けします。)

で、標準モジュール(structure)のOptionをAPPLICATIVE_CORE(Applicative+Functor)にします。

structure ApplicativeOption : APPLICATIVE_CORE =
struct
  type 'a t = 'a Option.option
  fun fmap f = Option.map f
  fun pure x = SOME x
  fun <*> (SOME f, SOME x) = SOME (f x)
    | <*> (SOME _, NONE  ) = NONE
    | <*> (NONE  ,      _) = NONE
end

fmap は引数がある(=SOMEの)ときのみ、その中身に対して関数fを適用する関数です。
関数 op<*> は型t 上での関数適用を行います。

では本体。

functor MkApplicative(A : APPLICATIVE_CORE) =
struct
local
  fun const x _ = x
  fun id x = x
in
  open A
  (* ---> SML/NJ workaround *)
  infix <*>
  (* SML/NJ workaround <--- *)
  structure Open =
  struct
    infix *> <*
    fun u *> v = pure (const id) <*> u <*> v
    fun u <* v = pure const <*> u <*> v
    val op<*> = op<*>
    fun <$> (f,a) = fmap f a
    fun <$ (a,b) = fmap (const a) b
    fun <**> (a,f) = f <*> a
  end
  open Open

  fun liftA f x = fmap f x
  fun liftA2 (f:'a->'b->'c) (x:'a t) (y:'b t) = (fmap f x) <*> y
  fun liftA3 (f:'a->'b->'c->'d) (x:'a t) (y:'b t) (z:'c t) = (fmap f x) <*> y <*> z
end (* local *)
end (* functor MkApplicative(A : APPLICATIVE_CORE) *)

(* 名前をOptionにすると(Monadとかで)別に拡張した
 * Optionと被るのでメンドクサイ *)
structure ApplicativeOption = MkApplicative(ApplicativeOption)