The Eventually workflow

The F# specification gives an example of custom workflow in its section on computation expressions. I have extended it as shown below:

type Eventually<'R> =
    | Completed of 'R
    | Blocked of float32 * (unit -> Eventually<'R>)
    | BlockedNextFrame of (unit -> Eventually<'R>)
    | Running of (unit -> Eventually<'R>)
    | Yield of (unit -> Eventually<'R>)

An Eventually computation can be in one of the following states:

• Completed, in which case the state includes the result of the computation.
• Blocked, when the computation is paused, and the state contains the amount of time remaining before it resumes.
• BlockedNextFrame, when the computation is paused for a short while, until the start of next frame. The meaning of "next frame" is up to the scheduler, which is described in an upcoming article
• Running, which indicates the computation is ready to proceed.
  
• Yield, when the computation is willing to pass control to another computation which is in state Running, if any. Otherwise, the computation is ready to proceed.
  

All states but the first one, Completed contain a function value which when executed produces a new state. It represents the work that the computation can perform "in one block" before returning control to the scheduler. When that happens, the scheduler updates the state of the computation.

Although it is possible to build computations "manually" using this discriminated union, F# makes it possible to do so conveniently using a subset of F# extended with a few keywords, namely yield, yield!, return, return!, let! and do!. The meaning of these keywords is up to the designer of the custom workflow, but they have an expected behaviour which should be respected.

yield and yield! are used to produce values in sequences. The second variant allows to insert sequences from other sequence expressions. Here I use sequence expression as a synonym for "a computation expression used to produce sequences". Below is an interesting example (from the F# Programming wikibook).

let allEvens = 
  let rec loop x = seq { yield x; yield! loop (x + 2) }
  loop 0;;

loop is a function which takes an integer x and returns a sequence expression which when evaluated produces the integer, followed by the result of a recursive call to loop using x+2. In clear, this will produce x, x+2, x+2+2, x+2+2+2..., one value at a time. Note the difference between yield and yield!: the first produces a single value, the second produces the values of another sequence expression.

let! allows to "nest" computation expressions. In other words, a computation expression can "call" another computation expression. I'm being pretty vague here, so let's look at an example using asynchronous computations (also from the wikibook).

let extractLinksAsync html =
    async {
        return System.Text.RegularExpressions.Regex.Matches(html, @"http://\S+")
    }
 
let downloadAndExtractLinks url =
    async {
        let webClient = new System.Net.WebClient()
        let html = webClient.DownloadString(url : string)
        let! links = extractLinksAsync html
        return url, links.Count
    }

return and return! are used for the final results of a computation expression. The example above uses return. My guess is return! should behave as

let! x = ...
return x

I am not quite sure if return is meant to have imperative semantics, i.e. discarding the remainder of a computation when encountered. My attempts to use such C-like semantics have not succeeded yet.

Going back to my library, XNAUtils, I have written a computation builder which is used to turn computation expressions (code between curly brackets) into state machines that can be executed in a controlled manner. The builder takes the form of a class with methods are called at selected places in a computation expression. A builder allows to override the meaning of certain keywords and specify the effect of the special keywords I listed above. The code is in CoopMultiTasking.fs

let rec bind k e =
    match e with
    | Completed r ->
        Running(fun () -> k r)
    | Running f ->
        Running(fun () -> f() |> bind k)
    | Blocked(dt, f) ->
        Blocked(dt, fun () -> f() |> bind k)
    | BlockedNextFrame f ->
        BlockedNextFrame(fun () -> f() |> bind k)
    | Yield f ->
        Yield(fun () -> f() |> bind k)

...

type TaskBuilder() =
    member x.Bind(e, f) = bind f e
    member x.Return(r) = result r
    member x.Combine(e1, e2) = combine e1 e2
    member x.Delay(f) = delay f
    member x.Zero() = result ()
    member x.TryWith(e, handler) = tryWith e handler
    member x.TryFinally(e, compensation) = tryFinally e compensation
    member x.While(cond, body) = whileLoop cond body
    member x.For(xs, body) = forLoop xs body
    member x.Using(e, f) = using e f

let task = TaskBuilder()

The module-level variable task can be used to create instances of Eventually. I have provided a few helpful tasks that can be used to wait a fixed amount of time, wait until next frame, give control to another task:

// Wait a fixed amount of time.
let wait dt =
    Blocked(dt, fun () -> Completed())

// Wait until next frame, i.e. next call to Scheduler.RunFor
let nextFrame () =
    BlockedNextFrame(fun() -> Completed())

// Stop executing, let some other task execute, if any is ready. Otherwise, we get control back.
let nextTask () =
    Yield(fun() -> Completed())

// Wait until a specified condition is true.
// nextTask is always called, then the condition is checked.
// If it's false, we wait until next frame, check the condition,
// call nextTask if it's not true, and so on...
let waitUntil f = task {
    let stop = ref false
    while not !stop do
        do! nextTask()
        if f() then
            stop := true
        else
            do! nextFrame()
            stop := f()
}

waitUntil uses a while loop, it could have used recursion too. I initially refrained from using recursion in all code meant to be executed on the Xbox 360, because tail calls are not available on this platform. On second thoughts, I don't think that's a problem, as the kind of recursion that would appear inside of tasks is of the loose kind. Recursive calls a interrupted by calls to nextTask and nextFrame, which should prevent the stack from overflowing.

Although I have not had any use for synchronization between tasks yet, I have provided two functions to that effect:

// Lock, can be used for mutual exclusion.
// Locks should not be shared across instances of Scheduler.
type Lock() =
    let mutable locked = false;

    member this.Grab() =
        task {
            do! waitUntil (fun() -> not locked)
            locked <- true
        }

    member this.Release() =
        task {
            locked <- false
            do! nextTask()
            ()
        }

// A blocking channel which can be used for cross-task communication.
// Note that sending blocks until the message is received.
type BlockingChannel<'M>() =
    let mutable content = None
    let mutable flag_send = false
    let mutable flag_receive = false

    member this.Send(m : 'M) =
        task {
            do! waitUntil (fun () -> not flag_send)
            content <- Some m
            flag_send <- true
            do! waitUntil (fun () -> flag_receive)
            flag_send <- false
            content <- None
        }

    member this.Receive() =
        task {
            do! waitUntil (fun () -> flag_send)
            let ret = content.Value
            flag_receive <- true
            do! waitUntil (fun () -> not flag_send)
            flag_receive <- false
            return ret
        }

Cooperative multi-tasking makes synchronization between tasks easy, as there is no concurrency involved.

That's all for this time, in the next article I will describe how multiple tasks are executed by a single scheduler.

How to spread a computation over multiple update cycles

Let us consider a simple example: We want to implement an animation effect which can be used for "press start screens", among other things. The animation can be decomposed into three phases:

1. Fade-in effect where the text "press start" appears from the void. To achieve that, the text is rendered with full transparency initially, then gradually goes to fully opaque. This effect should be short, e.g. half a second.
2. Blinking effect. The text is rendered alternating between fully transparent and opaque. We don't want to alternate between the two modes every frame, as that would be two fast. The text should be rendered opaque for half a second, then transparent (or not rendered at all) for half a second, and so on...
3. Fade-out effect, which is triggered when the player presses the start button. It's similar to the fade-in effect, but in reverse.

The game update loop

The XNA framework, just as most other frameworks, encourages the developer to build their game in a specific way. The main function, which is implemented by the framework, repeatedly calls a function Update provided by the developer, followed by a call to another function Draw, also provided by the user. The combine execution time of these two functions should not exceed the amount of time separating two frames, which is about 16ms for a game running at 60 frames per second.
In this context, implementing computations that need to span over multiple frames is a bit tricky. Not very complicated, and all experienced game developers can do that during their sleep. Nevertheless, I always found that annoying enough that it has often stopped me from implementing a cool animation that would have made my application look so much more professional.

Imperative code

For a moment, let us forget about the game loop and write some simple imperative code.

let sleep time dt exit =
    let t = ref 0.0f
    let dt = int (dt * 1000.0f)
    while !t < time && not !exit do
        System.Threading.Thread.Sleep(dt)

let fade_time = 0.5f   // half a second
let blink_time = 0.25f

let alpha = ref 0.0f
let is_visible = ref true

            
let run dt goto_fade_out =
    let t = ref 0.0f
    while !t < fade_time do
        alpha := !alpha + dt / fade_time
        t := !t + dt
        sleep dt dt (ref false)

    while not !goto_fade_out do
        is_visible := true
        sleep blink_time dt goto_fade_out
        is_visible := false
        sleep blink_time dt goto_fade_out

    let t = ref 0.0f
    while !t < fade_time do
        alpha := !alpha - dt / fade_time
        t := !t + dt
        sleep dt dt (ref false)

Implementation using a state machine

Back to reality (where the game update loop rules), one way to break a computation over multiple update cycles is to use a state machine. Transitions are taken every cycle. Our state machine could have four states: FadeIn, BlinkOn, BlinkOff, FadeOut. It would have the following transitions: FadeIn to FadeIn, FadeIn to BlinkOn, BlinkOn to BlinkOff, BlinkOff to BlinkOn, BlinkOn to FadeOut, BlinkOff to FadeOut. While in FadeIn and FadeOut, the state machine maintains a single float representing the degree of transparency of the text. This can be implemented in F# using discriminated unions, as shown below.

type States =
    | FadeIn of float32        // 0.0 -> 1.0
    | Blink of bool * float32  // On/Off, Time left before transition
    | FadeOut of float32       // 1.0 -> 0.0

let fade_time = 0.5f   // half a second
let blink_time = 0.25f

let initial = FadeIn 0.0f

let update dt goto_fade_out state =
    match state with
    | FadeIn k ->
        let delta_k = dt / fade_time
        let k = k + delta_k
        if k > 1.0f then
            Blink (true, blink_time)
        else
            FadeIn k

    | Blink (b, t) ->
        if goto_fade_out then
            FadeOut 1.0f
        else if t <= dt then
            Blink (not b, blink_time)
        else
            Blink (b, t - dt)

    | FadeOut k ->
        let delta_k = dt / fade_time
        let k = max (k - delta_k) 0.0f
        FadeOut k

Implementation using continuations

To an imperative programmer, functional programmers can seem a bit special. They like to do things in a complicated, twisted way. The method I will now show may appear unnecessarily complex, but it has its benefits, as we shall see.

type States =
    | Transparent of float32 * (bool * float32 -> States)
    | Blinking of bool * (bool * float32 -> States)

let fade_time = 0.5f   // half a second
let blink_time = 0.25f

let rec updateFadeIn alpha (_, dt) =
    let delta_alpha = dt / fade_time
    let alpha = alpha + delta_alpha
    if alpha > 1.0f then
        Blinking (true, updateBlinking true blink_time)
    else 
        Transparent (alpha, updateFadeIn alpha)

and updateBlinking is_visible remaining (goto_fade_out, dt) =
    if goto_fade_out then
        Transparent (1.0f, updateFadeOut 1.0f)
    else if remaining >= dt then
        Blinking (is_visible, updateBlinking is_visible (remaining - dt))
    else
        Blinking (not is_visible, updateBlinking (not is_visible) remaining)

and updateFadeOut alpha (_, dt) =
    let delta_alpha = dt / fade_time
    let alpha = max (alpha - delta_alpha) 0.0f
    Transparent (alpha, updateFadeOut alpha)

let initial =
    Transparent (0.0f, updateFadeIn 0.0f)

let update state x =
    match state with
    | Transparent (_, cont) | Blinking (_, cont) -> cont x

What I did here was move the guts of update into the state itself. A state now includes a function which when called returns a new state (which itself includes a function which when called... you get the idea).

Strengths and weaknesses of each approach

The first method I exposed looks nice and easy to understand, but it won't work as it is. The problem is that it retains full control of the execution. There is not update function which can be called every cycle to update the state.

A solution consists of executing this code on a separate thread, but that brings problems of its own. Access to shared data between the main thread which does the rendering and the update thread is one of them, another is stopping/continuing the update thread.

The second method has only one problem, it becomes hard to read and maintain when the number of states grows. It's perfectly viable for simple animations, but it can't be used for the top level of the application (which can itself be seen as some sort of animation, the complex and interactive kind).

Statistics show that the third method will cause 95% of the population of programmers to get headaches. You'll it's actually very close to the second method, once you get the idea. I'm sure motivated programmers can train themselves to master this technique, but in this context, it's pointless.

The only reason I showed the third technique is to introduce features of F# called computation expressions and custom workflows. These features make it possible to write code using an extended subset of F# usual syntax and have it processed and executed in a manner controlled by the programmer. Understanding continuations is required in order to implement new custom workflows, but it's not necessary to take advantage of existing workflows.

These features are described in the F# specification. There is also a chapter in the F# wikibook. Tomas Petricek has some articles (1 2) on his blog.