Struct Composition

open System.Diagnostics

[<Struct; NoComparison; NoEquality>]
type Component<'T,'U,'V,'Action,'Next when 'Action :> IAction<'T,'U> and 'Next :> IActionInvoker<'U,'V>> =
    val mutable T      : 'T
    val mutable Action : 'Action
    val mutable Next   : 'Next

    member first.Invoke (b:byref<bool>) =
        first.Next.Invoke (&first, &b)

    interface IActionInvoker<'T,'U> with
        member second.Invoke (first, halt) = first.Action.Do (&first, &halt, &second)

and IAction<'T, 'U> =
    abstract Do : byref<Component<'T,'U,'V,'Action1,'Next1>> * byref<bool> * byref<Component<'U,'V,'W,'Action2,'Next2>> -> bool

and IActionInvoker<'U,'V> =
    abstract Invoke : byref<Component<'T,'U,'V,'Action1,'Next1>> * byref<bool> -> bool

let inline callInvoker (first:byref<_>, c:byref<_>, second:byref<#IActionInvoker<'U,'V>>) = second.Invoke (&first, &c)

type ITypeContainer<'componentComposite, 'result> =
    abstract Allocate  : unit -> 'componentComposite
    abstract Construct : byref<'componentComposite> -> unit
    abstract GetResult : byref<'componentComposite> -> 'result

[<Struct; NoComparison; NoEquality>]        
type EmptyStruct = struct end

[<Struct; NoComparison; NoEquality>]        
type EmptyActionInvoker<'T,'U> =
    interface IActionInvoker<'T,'U> with
        member x.Invoke (_,_) = true

[<Struct; NoComparison; NoEquality>]        
type EmptyAction<'T,'U> =
    interface IAction<'T,'U> with
        member x.Do (_,_,_) = true

[<Struct; NoComparison; NoEquality>]        
type Map<'T,'U> (f:'T->'U) =
    interface IAction<'T,'U> with
        member x.Do (t, b, u) =
            u.T <- f t.T
            callInvoker (&u, &b, &u.Next)

let createResultContainer () =
    { new ITypeContainer<Component<'Result, EmptyStruct, EmptyStruct, EmptyAction<_,_>, EmptyActionInvoker<_,_>>, 'Result> with
        member x.Allocate () = failwith "The results container should not be allocated"
        member x.Construct emptyComponent = ()
        member x.GetResult emptyComponent = emptyComponent.T }

module Builder =
    let buildMap (f:'T->'U) (secondContainer:ITypeContainer<Component<'U,'V,'W,'action,'next>, 'result>) = 
        { new ITypeContainer<Component<'T,'U,'V,Map<'T,'U>,Component<'U,'V,'W,'action,'next>>, 'result> with
                member __.Construct firstComponent =
                    secondContainer.Construct (&firstComponent.Next)
                    firstComponent.Action <- Map<'T,'U> f

                member __.Allocate() = Unchecked.defaultof<_>
              
                member __.GetResult firstComponent = secondContainer.GetResult (&firstComponent.Next) }

let compose a b =
    a >> b

let getFunction () =
    let r = System.Random ()
    if r.Next() < 0 then failwith "boom"
    (+) 1

[<EntryPoint>]
let main argv =
#if MAGIC 
    let composed =
        createResultContainer ()
        |> Builder.buildMap (getFunction ())
        |> Builder.buildMap (getFunction ())
        |> Builder.buildMap (getFunction ())
        |> Builder.buildMap (getFunction ())
        |> Builder.buildMap (getFunction ())
        |> Builder.buildMap (getFunction ())

    let mutable composition = composed.Allocate ()
    let x = composed.Construct (&composition)
#else
    let composed =
        (getFunction ())
        |> compose (getFunction ())
        |> compose (getFunction ())
        |> compose (getFunction ())
        |> compose (getFunction ())
        |> compose (getFunction ())
#endif

    for j = 1 to 10 do
        let sw = Stopwatch.StartNew ()
        for i = 0 to 10000000 do
#if MAGIC
            composition.T <- i
            let mutable halt = false
            let xxx = composition.Invoke (&halt)
            if not xxx then failwith "boom"

            if composition.Next.Next.Next.Next.Next.Next.T <> i + 6 then failwith "boom"
            //if composed.GetResult (&blah) <> i + 6 then failwith "boom" -- much slower; need better way to get result out
#else
            let m = composed i 
            if m <> i + 6 then failwith "boom"
#endif
        printfn "%d" sw.ElapsedMilliseconds

    0 // return an integer exit code