我正在开发一个库,其中通常混合了几个状态monad。混合的状态不是先验的,但很可能在应用程序级别定义。因此,我的解决方案是开发具有可扩展隐藏状态的一个状态monad。
(** ObjectStateMonad for composable State Monads *)
module ObjectStateMonad =
struct
(* A state monad yields tuple of a state-object and an observable value *)
type ('a, 'b) monad = 'a -> ('a * 'b)
(* usual bind, just more type parameters *)
let bind : (('a, 'b) monad) -> ('b -> ('a, 'c) monad) -> ('a, 'c) monad =
fun m ->
fun f ->
fun s ->
let (st, obs) = m(s) in
( (f obs) st)
(* run, as usual *)
let run m a = m(a)
type ('a, 'b) field = { field_get : 'a -> 'b ; field_set : 'a -> 'b -> 'a }
(* get does not directly expose the state but requires a "getter" *)
let get f =
let m : 'a -> ('a * 'b) = fun s -> (s, f.field_get s)
in m
(* put requires a "setter" function to modify the state *)
let put f =
fun b ->
let m : 'a -> ('a * unit) = fun s ->
let s2 : 'a = (f.field_set s b) in (s2, ())
in m
let yield a = fun s -> (s, a)
let return = yield
let rec repeat m = function
| 0 -> m
| n -> bind m (fun _ -> repeat m (n - 1))
end
我的实现使用row-polymorphism来实现可扩展性:
module FooState = struct
open ObjectStateMonad
type state_t = int
class state_container = object
val _foo : state_t = 0
method get_foo = _foo
method set_foo n = {< _foo = n >}
end
let field = { field_get = (fun a -> (a#get_foo : state_t)) ; field_set = fun a b -> a#set_foo b }
(* just an example operation *)
let increment s = (
perform n <-- get field ;
_ <-- put field (n+1);
return n
) s
end
上面的模块演示了可组合性的工作原理:创建一个继承自所有相关状态容器的类,实例化该类并对它们运行操作。
我的问题是由于OCaml的多态性中的值限制,我不能在该状态monad(这只是一个函数)上使用部分应用程序,因此我总是必须使应用程序显式化(参数s
在increment
)。现在我正在使用pa_monad语法扩展,应该可以在执行时的每次出现时自动添加它,不应该吗?
换句话说:我可以使用pa_monad来对某些函数进行η扩展吗?
对此问题的任何其他解决方案也表示赞赏。
答案 0 :(得分:0)
你对pa_monad是正确的;只要在s
块内使用增量,它就会允许您忽略perform
参数。例如,
open ObjectStateMonad
open FooState
let state, result =
(perform
_ <-- increment;
_ <-- increment;
a <-- increment;
return a) (new state_container)
in
print_int state#get_foo ; print_char ':' ; print_int result
按预期打印出3:2
。
更重要的是,在增量定义中甚至不需要s
参数。 η-reduced版本:
let increment =
perform n <-- get field ;
_ <-- put field (n+1);
return n
同样适用。