MapReduce.fs

let MapReduce (map: 'T1 -> 'T2)
              (reduce: 'T2 -> 'T2 -> 'T2)
              (zero: 'T2)
              (inputs: seq<'T1>) =
    let ( >>= ) x f = async.Bind(x, f)
    Async.FromContinuations <| fun (ok, no, _) ->
        let n = Seq.length inputs
        let reducer =
            MailboxProcessor.Start <| fun inbox ->
                let rec loop n s =
                    if n = 0 then
                        async.Return (ok s)
                    else
                        inbox.Receive() >>= fun x ->
                            try loop (n - 1) (reduce s x)
                            with e -> async.Return (no e)
                loop n zero
        for x in inputs do
            async { return try reducer.Post (map x) with e -> no e }
            |> Async.Start

The reductions/joins are not completely parallel.