(Как) я могу сделать эту монадную привязку хвостовой рекурсивной?

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 ()

Это позволяет реализовать игровую логику, которая выполняется на нескольких игровых галочках, и записывать их в кажущемся последовательном стиле с использованием выражений вычислений.

К сожалению, при использовании для задач, которые длятся неограниченное количество игровых тиков, происходит сбой с StackruException. И даже когда он не падает, он заканчивается громоздкими следами стека, как это -

InfinityRpg.exe![e-mail](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#

Я надеюсь решить проблему, сделав левый случай функции привязки хвостовой рекурсивной. Однако я не уверен в двух вещах -

1) если это вообще можно сделать, и 2) как это будет на самом деле.

Если здесь невозможно связать хвостовую рекурсию, есть ли способ реструктурировать мою монаду, чтобы она стала хвостовой рекурсивной?

РЕДАКТИРОВАТЬ 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

Мне кажется, ваша монада - это государство с обработкой ошибок.

Это в основном ErrorT< State<'s,Either<'e,'a>>> но ветка ошибок снова связывается, что мне не очень понятно, почему.

В любом случае мне удалось воспроизвести ваше переполнение стека с помощью простой государственной монады:

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>>,

Вот пример решения. В конце есть тест с функцией zipIndex, который также удаляет стек, когда он определен с помощью обычной монады State.

Обратите внимание, что вам не нужно использовать Monad Transformers от FsControl, я использую их, потому что это проще для меня, так как я пишу меньше кода, но вы всегда можете создать свою преобразованную монаду вручную.