Question

我有这个名为Desync的单子 -

[<AutoOpen>]
module DesyncModule =

    /// The Desync monad. Allows the user to define in a sequential style an operation that spans
    /// across a bounded number of events. Span is bounded because I've yet to figure out how to
    /// make Desync implementation tail-recursive (see note about unbounded recursion in bind). And
    /// frankly, I'm not sure if there is a tail-recursive implementation of it...
    type [<NoComparison; NoEquality>] Desync<'e, 's, 'a> =
        Desync of ('s -> 's * Either<'e -> Desync<'e, 's, 'a>, 'a>)

    /// Monadic return for the Desync monad.
    let internal returnM (a : 'a) : Desync<'e, 's, 'a> =
        Desync (fun s -> (s, Right a))

    /// Monadic bind for the Desync monad.
    let rec internal bind (m : Desync<'e, 's, 'a>) (cont : 'a -> Desync<'e, 's, 'b>) : Desync<'e, 's, 'b> =
        Desync (fun s ->
            match (match m with Desync f -> f s) with
            //                              ^--- NOTE: unbounded recursion here
            | (s', Left m') -> (s', Left (fun e -> bind (m' e) cont))
            | (s', Right v) -> match cont v with Desync f -> f s')

    /// Builds the Desync monad.
    type DesyncBuilder () =
        member this.Return op = returnM op
        member this.Bind (m, cont) = bind m cont

    /// The Desync builder.
    let desync = DesyncBuilder ()

它允许实现跨多个游戏标记执行的游戏逻辑，使用计算表达式以看似顺序的方式编写。

不幸的是，当用于持续无限数量游戏滴答的任务时，它会因StackOverflowException而崩溃。即使它没有崩溃，它最终也会出现像这样笨重的堆栈痕迹 -

InfinityRpg.exe!InfinityRpg.GameplayDispatcherModule.desync@525-20.Invoke(Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen> _arg10) Line 530   F#
Prime.exe!Prime.DesyncModule.bind@20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>>.Invoke(Nu.SimulationModule.World s) Line 24    F#
Prime.exe!Prime.DesyncModule.bind@20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21    F#
Prime.exe!Prime.DesyncModule.bind@20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21    F#
Prime.exe!Prime.DesyncModule.bind@20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21    F#
Prime.exe!Prime.DesyncModule.bind@20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21    F#
Prime.exe!Prime.DesyncModule.bind@20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21    F#
Prime.exe!Prime.DesyncModule.bind@20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21    F#
Prime.exe!Prime.DesyncModule.bind@20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21    F#
Prime.exe!Prime.Desync.step<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit>(Prime.DesyncModule.Desync<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit> m, Nu.SimulationModule.World s) Line 71 F#
Prime.exe!Prime.Desync.advanceDesync<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit>(Microsoft.FSharp.Core.FSharpFunc<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Prime.DesyncModule.Desync<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit>> m, Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen> e, Nu.SimulationModule.World s) Line 75 F#
Nu.exe!Nu.Desync.advance@98<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>.Invoke(Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen> event, Nu.SimulationModule.World world) Line 100 F#
Nu.exe!Nu.Desync.subscription@104-16<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>.Invoke(Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen> event, Nu.SimulationModule.World world) Line 105    F#
Nu.exe!Nu.World.boxableSubscription@165<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>.Invoke(object event, Nu.SimulationModule.World world) Line 166 F#

我希望通过使绑定函数的Left case尾递归来解决问题。但是，我不确定两件事 -

1）如果可以完成，并且 2）如何实际完成。

如果在这里不可能使绑定尾递归，有没有办法重构我的monad以使其成为尾递归？

编辑3（包含以前的编辑）：这是实现我将用于演示堆栈溢出的异步组合器的附加代码 -

module Desync =

    /// Get the state.
    let get : Desync<'e, 's, 's> =
        Desync (fun s -> (s, Right s))

    /// Set the state.
    let set s : Desync<'e, 's, unit> =
        Desync (fun _ -> (s, Right ()))

    /// Loop in a desynchronous context while 'pred' evaluate to true.
    let rec loop (i : 'i) (next : 'i -> 'i) (pred : 'i -> 's -> bool) (m : 'i -> Desync<'e, 's, unit>) =
        desync {
            let! s = get
            do! if pred i s then
                    desync {
                        do! m i
                        let i = next i
                        do! loop i next pred m }
                else returnM () }

    /// Loop in a desynchronous context while 'pred' evaluates to true.
    let during (pred : 's -> bool) (m : Desync<'e, 's, unit>) =
        loop () id (fun _ -> pred) (fun _ -> m)

    /// Step once into a desync.
    let step (m : Desync<'e, 's, 'a>) (s : 's) : 's * Either<'e -> Desync<'e, 's, 'a>, 'a> =
    match m with Desync f -> f s

    /// Run a desync to its end, providing e for all its steps.
    let rec runDesync (m : Desync<'e, 's, 'a>) (e : 'e) (s : 's) : ('s * 'a) =
        match step m s with
        | (s', Left m') -> runDesync (m' e) e s'
        | (s', Right v) -> (s', v)

这是Either的实现 -

[<AutoOpen>]
module EitherModule =

    /// Haskell-style Either type.
    type Either<'l, 'r> =
        | Right of 'r
        | Left of 'l

最后，这里有一行代码可以产生堆栈溢出 -

open Desync
ignore <| runDesync (desync { do! during (fun _ -> true) (returnM ()) }) () ()

Answer 1

在我看来，你的monad是一个有错误处理的州。

它基本上是 ErrorT< State<'s,Either<'e,'a>>> ，但错误分支再次绑定，这对我来说不是很清楚。

无论如何，我能够使用基本的状态monad重现你的Stack Overflow：

type State<'S,'A> = State of ('S->('A * 'S))

module State =
    let run (State x) = x :'s->_
    let get() = State (fun s -> (s , s))  :State<'s,_>
    let put x = State (fun _ -> ((), x))  :State<'s,_>
    let result a = State(fun s -> (a, s))
    let bind (State m) k = State(fun s -> 
                                    let (a, s') = m s
                                    let (State u) = (k a) 
                                    u s')     :State<'s,'b>

    type StateBuilder() =
        member this.Return op = result op
        member this.Bind (m, cont) = bind m cont

    let state = StateBuilder()

    let rec loop (i: 'i) (next: 'i -> 'i) (pred: 'i -> 's -> bool) (m: 'i -> State<'s, unit>) =
        state {
            let! s = get()
            do! if pred i s then
                    state {
                        do! m i
                        let i = next i
                        do! loop i next pred m }
                else result () }

    let during (pred : 's -> bool) (m : State<'s, unit>) =
        loop () id (fun _ -> pred) (fun _ -> m)

// test
open State
ignore <| run (state { do! during (fun c -> true) (result ()) })  () // boom

正如评论中所述，解决此问题的一种方法是使用StateT<'s,Cont<'r,'a>>。

以下是solution的示例。最后有一个使用zipIndex函数的测试，当使用普通的状态monad定义时，它也会打击堆栈。

请注意，您不需要使用FsControl中的Monad变形金刚，我使用它们因为它对我来说更容易，因为我写的代码更少，但您可以随时手动创建变换后的monad。

（怎么样）我可以使这个monadic绑定尾递归？

1 个答案: