The typical Pause monad implementation that I see looks like this (based on Chapter 5 from Friendly F# by Giulia Costantini and Giuseppe Maggiore).
open System
type Process<'a> = unit -> 'a Step
and Step<'a> =
| Continue of 'a
| Paused of 'a Process
type PauseMonad () =
member this.Return x = fun () -> Continue x
member this.ReturnFrom x = x
member this.Bind (result, rest) =
fun () ->
match result () with
| Continue x -> rest x ()
| Paused p -> Paused (this.Bind (p, rest))
let yield_ () =
fun () ->
Paused (fun () ->
Continue ())
let get_process_step process_ step = do printfn "Process %d, step %d." process_ step
let get_last_process_step process_ = do printfn "Process %d finished." process_
let rec get_process process_ step_count =
PauseMonad () {
do! yield_ ()
if step_count = 0 then
do get_last_process_step process_
return ()
else
do get_process_step process_ step_count
return! get_process process_ <| step_count - 1
}
let rec race p1 p2 =
match p1 (), p2 () with
| Continue _, _ -> do printfn "Process 1 finished first."
| _, Continue _ -> do printfn "Process 2 finished first."
| Paused p1_, Paused p2_ -> race (p1_) (p2_)
[<EntryPoint>]
let main _ =
let process_1 = get_process 1 5
let process_2 = get_process 2 7
do race process_1 process_2
0
Here is a similar implementation in Haskell.
However, it seems simpler to get rid of the mutually recursive types Process and Step, and just use a single recursive type, Process, as follows.
open System
type Process<'a> =
| Continue of 'a
| Paused of (unit -> 'a Process)
type PauseMonad () =
member this.Return x = Continue x
member this.ReturnFrom x = x
member this.Bind (result, rest) =
match result with
| Continue x -> Paused (fun () -> rest x)
| Paused p -> Paused (fun () -> this.Bind (p (), rest))
let yield_ () =
Paused (fun () ->
Continue ())
let get_process_step process_ step = do printfn "Process %d, step %d." process_ step
let get_last_process_step process_ = do printfn "Process %d finished." process_
let rec get_process process_ step_count =
PauseMonad () {
do! yield_ ()
if step_count = 0 then
do get_last_process_step process_
return ()
else
do get_process_step process_ step_count
return! get_process process_ <| step_count - 1
}
let rec race p1 p2 =
match p1, p2 with
| Continue _, _ -> do printfn "Process 1 finished first."
| _, Continue _ -> do printfn "Process 2 finished first."
| Paused p1_, Paused p2_ -> race (p1_ ()) (p2_ ())
[<EntryPoint>]
let main _ =
let process_1 = get_process 1 5
let process_2 = get_process 2 7
do race process_1 process_2
0
Either of these implementations gives me the same output:
Process 1, step 5.
Process 2, step 7.
Process 1, step 4.
Process 2, step 6.
Process 1, step 3.
Process 2, step 5.
Process 1, step 2.
Process 2, step 4.
Process 1, step 1.
Process 2, step 3.
Process 1 finished.
Process 2, step 2.
Process 1 finished first.
I've made the two implementations as similar as possible to facilitate differencing. As far as I can tell, the only differences are these:
In the first version, yield_, PauseMonad.Return, and PauseMonad.Bind add delays to the return values. In the second version, PauseMonad.Return adds the delay inside the Paused wrapper.
In the first version, PauseMonad.Bind runs one step of the result process to see whether the return value matches Continue or Paused. In the second version, PauseMonad.Bind runs one step of the result process only after determining that it matches Paused.
In the first version, race runs one step of each process, checks that both results match Paused, and recurses with the remaining processes. In the second version, race checks that both processes match Paused, then runs one step of each process, and recurses with the return values of these steps.
Is there a reason the first version is better?