我试图用F#表达自由monad的教会编码。 Free
专门针对特定的函子,Effect
.
我能够毫无问题地写return_ : 'T -> Free<'T>
和bind: ('T -> Free<'U>) -> Free<'T> -> Free<'U>
。
下面给出了我的实现草图。
type Effect<'T>
= GetStr of (string -> 'T)
| PutStr of string * 'T
module Effect =
let map (f: 'a -> 'b) : Effect<'a> -> Effect<'b> = function
| GetStr k ->
GetStr(f << k)
| PutStr (s,t) ->
PutStr(s, f t)
type Free<'T> =
abstract Apply : ('T -> 'R) -> (Effect<'R> -> 'R) -> 'R
module Free =
let inline runFree (f:Free<'T>) (kp: 'T -> 'R) (kf: Effect<'R> -> 'R) : 'R =
f.Apply kp kf
let return_ (x: 'a) : Free<'a> =
{ new Free<'a>
with
member __.Apply kp _ =
kp x
}
let bind (f: 'a -> Free<'b>) (m: Free<'a>) : Free<'b> =
{ new Free<'b>
with
member __.Apply kp kf =
runFree m
(fun a ->
runFree (f a) kp kf
)
kf
}
当我尝试为这种编码编写解释器时,我遇到了一个问题。
给定以下代码:
module Interpret =
let interpretEffect = function
| GetStr k ->
let s = System.Console.ReadLine()
(k s , String.length s)
| PutStr(s,t) ->
do System.Console.WriteLine s
(t , 0)
let rec interpret (f: Free<string * int>) =
Free.runFree
f
(fun (str,len) -> (str,len))
(fun (a: Effect<Free<string*int>>) ->
let (b,n) = interpretEffect a
let (c,n') = interpret b
(c, n + n')
)
我在第三个参数中收到一个类型错误,要在interpret
函数中Free.runFree
:
...
(fun (a: Effect<Free<string*int>>) ->
^^^^^^^^^^^^^^^^^^ ------ Expecting a Effect<string * int> but given a Effect<Free<string*int>>
我理解为什么会发生这种情况(第一个函数的结果类型决定了'R === string*int
),并怀疑可以使用 rank-2 函数(可以用 F# 编码,例如 http://eiriktsarpalis.github.io/typeshape/#/33)来解决,但我不确定如何应用它。
任何指示将不胜感激。
迈克尔
你不需要在那里做任何事情,编译器建议的类型实际上是正确的(并且符合runFree
的类型)。
似乎你想的是斯科特编码(从这个Haskell问题中撕下来):
runFree :: Functor f => (a -> r) -> (f (F f a) -> r) -> F f a -> r
其中F f a
将是你的Effect
专业Free<'a>
,而f (F f a)
将是Effect<Free<'a>>
,这就是你尝试使用的。
而教会编码将是:
runFree :: Functor f => (a -> r) -> (f r -> r) -> F f a -> r
其中f r
Effect<'a>
- 从而使在 F# 中表达更容易(这就是为什么我假设您首先使用它。
这是我对interpret
的
let rec interpret (f: Free<string * int>) =
Free.runFree
f
(fun (str,len) -> (str,len))
(fun (a: Effect<_>) ->
let (b,n) = interpretEffect a
let (c,n') = interpret (Free.pureF b)
(c, n + n')
)
pureF
在哪里
let pureF (x: 'a) : Free<'a> =
{ new Free<'a> with member __.Apply kp _ = kp x }
即您的return_
功能。
我认为定义相应的freeF
函数会清除一些事情(例如为什么Effect<'a>
函子 - 您没有在粘贴的代码中的任何地方利用这一事实)。