Some experimental computation expression builds for expressing folds

FoldBuilder_1.fsx

open System
open System.Runtime.CompilerServices

#nowarn "1204"

[<CompilerMessage("This construct is for use by compiled F# code and should not be used directly.", 1204, IsHidden=true)>]
type FoldBuilderCode<'T> = delegate of byref<'T> -> unit

[<Struct; IsReadOnly; NoComparison; NoEquality>]
type FoldBuilder<'T> (state : 'T) =
    member _.State = state

    member inline _.Combine ([<InlineIfLambda>] f1 : FoldBuilderCode<_>, [<InlineIfLambda>] f2 : FoldBuilderCode<_>) =
        FoldBuilderCode<'T> (fun sm -> f1.Invoke &sm; f2.Invoke &sm)

    member inline _.Delay ([<InlineIfLambda>] f : unit -> FoldBuilderCode<_>) =
        FoldBuilderCode<'T> (fun sm -> (f ()).Invoke &sm)

    member inline _.Zero () = FoldBuilderCode<'T> (fun _ -> ())

    member inline _.While ([<InlineIfLambda>] condition : unit -> bool, [<InlineIfLambda>] body : FoldBuilderCode<_>) =
        FoldBuilderCode<'T> (fun sm ->
            while condition () do
                body.Invoke &sm)

    member inline _.TryWith ([<InlineIfLambda>] body : FoldBuilderCode<_>, [<InlineIfLambda>] handle : exn -> FoldBuilderCode<_>) =
        FoldBuilderCode<'T> (fun sm ->
            try body.Invoke &sm
            with e -> (handle e).Invoke &sm)

    member inline _.TryFinally ([<InlineIfLambda>] body : FoldBuilderCode<_>, compensation : unit -> unit) =
        FoldBuilderCode<'T> (fun sm ->
            try body.Invoke &sm
            with _ ->
                compensation ()
                reraise ()
            compensation ())

    member inline builder.Using (disposable : #IDisposable, [<InlineIfLambda>] body : #IDisposable -> FoldBuilderCode<_>) =
        builder.TryFinally ((fun sm -> (body disposable).Invoke &sm), (fun () -> if not (isNull (box disposable)) then disposable.Dispose ()))

    member inline _.Yield ([<InlineIfLambda>] f) = FoldBuilderCode<'T> (fun sm -> sm <- f sm)

    member inline builder.For (sequence : #seq<_>, [<InlineIfLambda>] body : _ -> FoldBuilderCode<_>) =
        let builder = builder
        builder.Using (sequence.GetEnumerator (), fun e -> builder.While ((fun () -> e.MoveNext ()), (fun sm -> (body e.Current).Invoke &sm)))

    member inline this.Run ([<InlineIfLambda>] f : FoldBuilderCode<_>) =
        let mutable sm = this.State
        f.Invoke &sm
        sm

let fold state = FoldBuilder state

let sum xs = fold 0 { for x in xs -> (+) x }

sum [1..100]

let ``10 + 3 + 1..100`` = fold 10 { yield (+) 3; for x in [1..100] -> (+) x }

let rev xs = fold [] { for x in xs -> fun acc -> x :: acc }

rev [1..100]

let rebuild m = fold Map.empty { for KeyValue (k, v) in m -> Map.add k v }

rebuild (Map.ofList [for x in 1..100 -> x, x])

type FoldBuilder<'T> with
    member inline builder.For (option : _ option, [<InlineIfLambda>] body : _ -> FoldBuilderCode<_>) =
        FoldBuilderCode<'T> (fun sm ->
            match option with
            | Some x -> (body x).Invoke &sm
            | None -> ())

let two = fold 1 { for x in Some 1 -> (+) x }

type FoldBuilder<'T> with
    member inline builder.For (result : Result<_, _>, [<InlineIfLambda>] body : _ -> FoldBuilderCode<_>) =
        FoldBuilderCode<'T> (fun sm ->
            match result with
            | Ok x -> (body x).Invoke &sm
            | Error _ -> ())

let three = fold 1 { for x in Ok 2 -> (+) x }

FoldBuilder_2.fsx

open System
open System.Runtime.CompilerServices

#nowarn "1204"

[<CompilerMessage("This construct is for use by compiled F# code and should not be used directly.", 1204, IsHidden=true)>]
type FoldBuilderCode<'T> = delegate of byref<'T> -> unit

[<Struct; IsReadOnly; NoComparison; NoEquality>]
type FoldBuilder<'T> (state : 'T) =
    member _.State = state

    member inline _.Combine ([<InlineIfLambda>] f1 : FoldBuilderCode<_>, [<InlineIfLambda>] f2 : FoldBuilderCode<_>) =
        FoldBuilderCode<'T> (fun sm -> f1.Invoke &sm; f2.Invoke &sm)

    member inline _.Delay ([<InlineIfLambda>] f : unit -> FoldBuilderCode<_>) =
        FoldBuilderCode<'T> (fun sm -> (f ()).Invoke &sm)

    member inline _.Zero () = FoldBuilderCode<'T> (fun _ -> ())

    member inline _.While ([<InlineIfLambda>] condition : unit -> bool, [<InlineIfLambda>] body : FoldBuilderCode<_>) =
        FoldBuilderCode<'T> (fun sm ->
            while condition () do
                body.Invoke &sm)

    member inline _.TryWith ([<InlineIfLambda>] body : FoldBuilderCode<_>, [<InlineIfLambda>] handle : exn -> FoldBuilderCode<_>) =
        FoldBuilderCode<'T> (fun sm ->
            try body.Invoke &sm
            with e -> (handle e).Invoke &sm)

    member inline _.TryFinally ([<InlineIfLambda>] body : FoldBuilderCode<_>, compensation : unit -> unit) =
        FoldBuilderCode<'T> (fun sm ->
            try body.Invoke &sm
            with _ ->
                compensation ()
                reraise ()
            compensation ())

    member inline builder.Using (disposable : #IDisposable, [<InlineIfLambda>] body : #IDisposable -> FoldBuilderCode<_>) =
        builder.TryFinally ((fun sm -> (body disposable).Invoke &sm), (fun () -> if not (isNull (box disposable)) then disposable.Dispose ()))

    member inline _.Yield x = FoldBuilderCode<'T> (fun sm -> sm <- x)
    member inline _.Yield ([<InlineIfLambda>] f) = FoldBuilderCode<'T> (fun sm -> sm <- f sm)

    member inline builder.For (sequence : #seq<_>, [<InlineIfLambda>] body : _ -> FoldBuilderCode<_>) =
        let builder = builder
        builder.Using (sequence.GetEnumerator (), fun e -> builder.While ((fun () -> e.MoveNext ()), (fun sm -> (body (sm, e.Current)).Invoke &sm)))

    member inline this.Run ([<InlineIfLambda>] f : FoldBuilderCode<_>) =
        let mutable sm = this.State
        f.Invoke &sm
        sm

let fold<'T> state = FoldBuilder<'T> state

let sum xs = fold 0 { for acc, x in xs -> acc + x }

sum [1..100]

let ``10 + 3 + 1..100`` = fold 10 { yield (+) 3; for acc, x in [1..100] -> acc + x }

let rev xs = fold [] { for acc, x in xs -> x :: acc }

rev [1..100]

let rebuild m = fold Map.empty { for acc, KeyValue (k, v) in m -> acc.Add (k, v) }

rebuild (Map.ofList [for x in 1..100 -> x, x])

FoldBuilder_3.fsx

open System

#nowarn "1204"

[<CompilerMessage("This construct is for use by compiled F# code and should not be used directly.", 1204, IsHidden=true)>]
type FoldBuilderCode<'T> = delegate of byref<'T> -> unit

[<Struct; NoComparison; NoEquality>]
type FoldBuilder<'T> =
    [<DefaultValue(false)>]
    val mutable StateSet : bool

    [<DefaultValue(false)>]
    val mutable State : 'T

    member inline _.Combine ([<InlineIfLambda>] f1 : FoldBuilderCode<_>, [<InlineIfLambda>] f2 : FoldBuilderCode<_>) =
        FoldBuilderCode<FoldBuilder<'T>> (fun sm -> f1.Invoke &sm; f2.Invoke &sm)

    member inline _.Delay ([<InlineIfLambda>] f : unit -> FoldBuilderCode<_>) =
        FoldBuilderCode<FoldBuilder<'T>> (fun sm -> (f ()).Invoke &sm)

    member inline _.Zero () = FoldBuilderCode<FoldBuilder<'T>> (fun _ -> ())

    member inline _.While (state, [<InlineIfLambda>] condition : unit -> bool, [<InlineIfLambda>] body : FoldBuilderCode<_>) =
        FoldBuilderCode<FoldBuilder<'T>> (fun sm ->
            if not sm.StateSet then
                sm.State <- state
                sm.StateSet <- true

            while condition () do
                body.Invoke &sm)

    member inline _.TryWith ([<InlineIfLambda>] body : FoldBuilderCode<_>, [<InlineIfLambda>] handle : exn -> FoldBuilderCode<_>) =
        FoldBuilderCode<FoldBuilder<'T>> (fun sm ->
            try body.Invoke &sm
            with e -> (handle e).Invoke &sm)

    member inline _.TryFinally ([<InlineIfLambda>] body : FoldBuilderCode<_>, compensation : unit -> unit) =
        FoldBuilderCode<FoldBuilder<'T>> (fun sm ->
            try body.Invoke &sm
            with _ ->
                compensation ()
                reraise ()
            compensation ())

    member inline builder.Using (disposable : #IDisposable, [<InlineIfLambda>] body : #IDisposable -> FoldBuilderCode<_>) =
        builder.TryFinally ((fun sm -> (body disposable).Invoke &sm), (fun () -> if not (isNull (box disposable)) then disposable.Dispose ()))

    member inline _.Yield x = FoldBuilderCode<FoldBuilder<'T>> (fun sm -> sm.State <- x)

    member inline builder.For ((state, sequence : #seq<_>), [<InlineIfLambda>] body : _ -> FoldBuilderCode<_>) =
        let mutable builder = builder
        builder.Using (sequence.GetEnumerator (), fun e -> builder.While (state, (fun () -> e.MoveNext ()), (fun sm -> (body (sm.State, e.Current)).Invoke &sm)))

    member inline this.Run ([<InlineIfLambda>] f : FoldBuilderCode<_>) =
        let mutable sm = this
        f.Invoke &sm
        sm.State

let fold<'T> = Unchecked.defaultof<FoldBuilder<'T>>

let sum xs = fold { for acc, x in 0, xs -> acc + x }

sum [1..100]

let rev xs = fold { for acc, x in [], xs -> x :: acc }

rev [1..100]

let rebuild m = fold { for acc, KeyValue (k, v) in Map.empty, m -> acc.Add (k, v) }

rebuild (Map.ofList [for x in 1..100 -> x, x])

FoldBuilder_4.fsx

open System
open System.Runtime.CompilerServices

#nowarn "1204"

[<CompilerMessage("This construct is for use by compiled F# code and should not be used directly.", 1204, IsHidden=true)>]
type FoldBuilderCode<'T> = delegate of byref<'T> -> unit

[<Struct; IsReadOnly; NoComparison; NoEquality>]
type FoldBuilder<'T, 'TExt> (state : 'T) =
    member _.State = state

    member inline _.Combine ([<InlineIfLambda>] f1 : FoldBuilderCode<_>, [<InlineIfLambda>] f2 : FoldBuilderCode<_>) =
        FoldBuilderCode<'T> (fun sm -> f1.Invoke &sm; f2.Invoke &sm)

    member inline _.Delay ([<InlineIfLambda>] f : unit -> FoldBuilderCode<_>) =
        FoldBuilderCode<'T> (fun sm -> (f ()).Invoke &sm)

    member inline _.Zero () = FoldBuilderCode<'T> (fun _ -> ())

    member inline _.While ([<InlineIfLambda>] condition : unit -> bool, [<InlineIfLambda>] body : FoldBuilderCode<_>) =
        FoldBuilderCode<'T> (fun sm ->
            while condition () do
                body.Invoke &sm)

    member inline _.TryWith ([<InlineIfLambda>] body : FoldBuilderCode<_>, [<InlineIfLambda>] handle : exn -> FoldBuilderCode<_>) =
        FoldBuilderCode<'T> (fun sm ->
            try body.Invoke &sm
            with e -> (handle e).Invoke &sm)

    member inline _.TryFinally ([<InlineIfLambda>] body : FoldBuilderCode<_>, compensation : unit -> unit) =
        FoldBuilderCode<'T> (fun sm ->
            try body.Invoke &sm
            with _ ->
                compensation ()
                reraise ()
            compensation ())

    member inline builder.Using (disposable : #IDisposable, [<InlineIfLambda>] body : #IDisposable -> FoldBuilderCode<_>) =
        builder.TryFinally ((fun sm -> (body disposable).Invoke &sm), (fun () -> if not (isNull (box disposable)) then disposable.Dispose ()))

    member inline _.Yield ([<InlineIfLambda>] f) = FoldBuilderCode<'T> (fun sm -> sm <- f sm)

    member inline this.Run ([<InlineIfLambda>] f : FoldBuilderCode<_>) =
        let mutable sm = this.State
        f.Invoke &sm
        sm

[<Extension>]
type FoldBuilderExtensions =
    [<Extension>]
    static member inline For<
        'Input,
        'Extensions,
        'Intermediate,
        'State when ('Input or 'Extensions) : (static member Fold : ('State -> 'Intermediate -> 'State) * 'State * 'Input -> 'State)
        > (
            _builder : FoldBuilder<'State, 'Extensions>,
            foldable : 'Input,
            [<InlineIfLambda>] body : 'Intermediate -> FoldBuilderCode<'State>
        ) =
        let folder sm x =
            let mutable sm = sm
            (body x).Invoke &sm
            sm

        let inline call folder state input = ((^Input or ^Extensions) : (static member Fold : ('State -> 'Intermediate -> 'State) * 'State * 'Input -> 'State) (folder, state, input))

        FoldBuilderCode<'State> (fun sm -> sm <- call folder sm foldable)

[<Extension>]
type FoldExtensions =
    [<Extension>]
    static member Fold (folder, state, input) = List.fold folder state input

    [<Extension>]
    static member Fold (folder, state, input) = Array.fold folder state input

    [<Extension>]
    static member Fold (folder, state, input) = Set.fold folder state input

    [<Extension>]
    static member Fold (folder, state, input) = Option.fold folder state input

    [<Extension>]
    static member Fold (folder, state, input) = ValueOption.fold folder state input

    [<Extension>]
    static member Fold (folder, state, input) = Result.fold folder state input

    [<Extension>]
    static member Fold (folder, state, input) = Seq.fold folder state input

let fold<'T> state = FoldBuilder<'T, FoldExtensions> state

let sum = fold 0 { for x in [1..100] -> (+) x }

let sum' = fold 2 { for x in Some 1 -> (+) x }

let sum'' = fold 2 { for x in set [1..100] -> (+) x }

let sum''' = fold 2 { for x in [|1..100|] -> (+) x }