F#重写计算表达式
F# rewrite computation expression
我正在研究延续,因为我想对协程进行一些有趣的使用...无论如何,我想更好地理解我找到的一个实现。
为此,我想在不使用计算表达式(continuation Monad)的情况下重写实现,但我不太能做到。
我有这个:
type K<'T,'r> = (('T -> 'r) -> 'r)
let returnK x = (fun k -> k x)
let bindK m f = (fun k -> m (fun a -> f a k))
let runK (c:K<_,_>) cont = c cont
let callcK (f: ('T -> K<'b,'r>) -> K<'T,'r>) : K<'T,'r> =
fun cont -> runK (f (fun a -> (fun _ -> cont a))) cont
type ContinuationBuilder() =
member __.Return(x) = returnK x
member __.ReturnFrom(x) = x
member __.Bind(m,f) = bindK m f
member this.Zero () = this.Return ()
let K = new ContinuationBuilder()
/// The coroutine type from http://fssnip.net/7M
type Coroutine() =
let tasks = new System.Collections.Generic.Queue<K<unit,unit>>()
member this.Put(task) =
let withYield = K {
do! callcK (fun exit ->
task (fun () ->
callcK (fun c ->
tasks.Enqueue(c())
exit ())))
if tasks.Count <> 0 then
do! tasks.Dequeue() }
tasks.Enqueue(withYield)
member this.Run() =
runK (tasks.Dequeue()) ignore
// from FSharpx tests
let ``When running a coroutine it should yield elements in turn``() =
// This test comes from the sample on http://fssnip.net/7M
let actual = System.Text.StringBuilder()
let coroutine = Coroutine()
coroutine.Put(fun yield' -> K {
actual.Append("A") |> ignore
do! yield' ()
actual.Append("B") |> ignore
do! yield' ()
actual.Append("C") |> ignore
do! yield' ()
})
coroutine.Put(fun yield' -> K {
actual.Append("1") |> ignore
do! yield' ()
actual.Append("2") |> ignore
do! yield' ()
})
coroutine.Run()
actual.ToString() = "A1B2C"
``When running a coroutine it should yield elements in turn``()
所以,我想在不使用计算表达式 K
.
的情况下重写协程 class 的 Put
成员
我当然读过 this and this and several other articles about catamorphisms 但是重写这个延续 monand 并不容易,因为它是重写 Write Monad 的例子...
我尝试了几种方法,这是其中之一:
member this.Put(task) =
let withYield =
bindK
(callcK (fun exit ->
task (fun () ->
callcK (fun c ->
tasks.Enqueue(c())
exit ()))))
(fun () ->
if tasks.Count <> 0
then tasks.Dequeue()
else returnK ())
tasks.Enqueue(withYield)
当然不行:(
(顺便说一句:有一些关于编译器用于重写纯 F# 计算的所有规则的大量文档?)
您的 Put
版本几乎是正确的。不过有两个问题:
bindK
函数正在反向使用,需要调换参数。
task
应该传递 Cont<_,_> -> Cont<_,_>
,而不是 unit -> Cont<_,_> -> Cont<_,_>
。
解决这些问题可能如下所示:
member this.Put(task) =
let withYield =
bindK
(fun () ->
if tasks.Count <> 0
then tasks.Dequeue()
else returnK ())
(callcK (fun exit ->
task (
callcK (fun c ->
tasks.Enqueue(c())
exit ()))))
tasks.Enqueue(withYield)
当然不能太优雅。
使用 bind
时最好声明一个运算符 >>=
:
let (>>=) c f = bindK f c
那样
do!
转换为在 之后放置 >>= fun () ->
let! a =
转换为在 之后放置 >>= fun a ->
然后你的代码看起来会好一点:
member this.Put2(task) =
let withYield =
callcK( fun exit ->
task( callcK (fun c ->
tasks.Enqueue(c())
exit())
)
) >>= fun () ->
if tasks.Count <> 0 then
tasks.Dequeue()
else returnK ()
tasks.Enqueue withYield
我正在研究延续,因为我想对协程进行一些有趣的使用...无论如何,我想更好地理解我找到的一个实现。
为此,我想在不使用计算表达式(continuation Monad)的情况下重写实现,但我不太能做到。
我有这个:
type K<'T,'r> = (('T -> 'r) -> 'r)
let returnK x = (fun k -> k x)
let bindK m f = (fun k -> m (fun a -> f a k))
let runK (c:K<_,_>) cont = c cont
let callcK (f: ('T -> K<'b,'r>) -> K<'T,'r>) : K<'T,'r> =
fun cont -> runK (f (fun a -> (fun _ -> cont a))) cont
type ContinuationBuilder() =
member __.Return(x) = returnK x
member __.ReturnFrom(x) = x
member __.Bind(m,f) = bindK m f
member this.Zero () = this.Return ()
let K = new ContinuationBuilder()
/// The coroutine type from http://fssnip.net/7M
type Coroutine() =
let tasks = new System.Collections.Generic.Queue<K<unit,unit>>()
member this.Put(task) =
let withYield = K {
do! callcK (fun exit ->
task (fun () ->
callcK (fun c ->
tasks.Enqueue(c())
exit ())))
if tasks.Count <> 0 then
do! tasks.Dequeue() }
tasks.Enqueue(withYield)
member this.Run() =
runK (tasks.Dequeue()) ignore
// from FSharpx tests
let ``When running a coroutine it should yield elements in turn``() =
// This test comes from the sample on http://fssnip.net/7M
let actual = System.Text.StringBuilder()
let coroutine = Coroutine()
coroutine.Put(fun yield' -> K {
actual.Append("A") |> ignore
do! yield' ()
actual.Append("B") |> ignore
do! yield' ()
actual.Append("C") |> ignore
do! yield' ()
})
coroutine.Put(fun yield' -> K {
actual.Append("1") |> ignore
do! yield' ()
actual.Append("2") |> ignore
do! yield' ()
})
coroutine.Run()
actual.ToString() = "A1B2C"
``When running a coroutine it should yield elements in turn``()
所以,我想在不使用计算表达式 K
.
Put
成员
我当然读过 this and this and several other articles about catamorphisms 但是重写这个延续 monand 并不容易,因为它是重写 Write Monad 的例子...
我尝试了几种方法,这是其中之一:
member this.Put(task) =
let withYield =
bindK
(callcK (fun exit ->
task (fun () ->
callcK (fun c ->
tasks.Enqueue(c())
exit ()))))
(fun () ->
if tasks.Count <> 0
then tasks.Dequeue()
else returnK ())
tasks.Enqueue(withYield)
当然不行:(
(顺便说一句:有一些关于编译器用于重写纯 F# 计算的所有规则的大量文档?)
您的 Put
版本几乎是正确的。不过有两个问题:
bindK
函数正在反向使用,需要调换参数。task
应该传递Cont<_,_> -> Cont<_,_>
,而不是unit -> Cont<_,_> -> Cont<_,_>
。
解决这些问题可能如下所示:
member this.Put(task) =
let withYield =
bindK
(fun () ->
if tasks.Count <> 0
then tasks.Dequeue()
else returnK ())
(callcK (fun exit ->
task (
callcK (fun c ->
tasks.Enqueue(c())
exit ()))))
tasks.Enqueue(withYield)
当然不能太优雅。
使用 bind
时最好声明一个运算符 >>=
:
let (>>=) c f = bindK f c
那样
do!
转换为在 之后放置 let! a =
转换为在 之后放置
>>= fun () ->
>>= fun a ->
然后你的代码看起来会好一点:
member this.Put2(task) =
let withYield =
callcK( fun exit ->
task( callcK (fun c ->
tasks.Enqueue(c())
exit())
)
) >>= fun () ->
if tasks.Count <> 0 then
tasks.Dequeue()
else returnK ()
tasks.Enqueue withYield