У меня есть эта монада, называемая 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 ( -> * 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. И даже когда он не сбой, он заканчивается громоздкими трассировками стека вроде этого -
[email protected]20.Invoke(Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen> _arg10) Line 530 F#
[email protected]<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#
[email protected]<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#
[email protected]<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#
[email protected]<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#
[email protected]<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#
[email protected]<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#
[email protected]<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#
[email protected]<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#
[email protected]<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#
[email protected]<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#
[email protected]<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) как это будет на самом деле.
Если это невозможно сделать хвост-рекурсивный bind здесь, есть ли способ реструктурировать мою монаду, чтобы она стала хвостовой рекурсивной?
EDIT 3 (добавляет предыдущие изменения). Вот дополнительный код, который реализует компиляторы desync, которые я буду использовать для демонстрации -
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 -> -> 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 : -> 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) : * 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) : ( * 'a) =
match step m s with
| (s', Left m') -> runDesync (m' e) e s'
| (s', Right v) -> (s', v)
Вот одна реализация -
[<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 ()) }) () ()