Infinite Function in F#

InfiniteFunction.fsx

// a recursive type
type AnonResult<'T> =
    | Value of 'T
    | Fn of ('T-> AnonResult<'T>)

// only accepts functions that take two args
let rec create (fn : 'T -> 'T -> 'T) =
    // this can probably be achieved more idiomatically with recursion
    // but the mutation is localised...
    let mutable accumulatedValue : 'T option = None

    let callFnAndUpdateAccum a =
        let newVal =
            match accumulatedValue with
            | Some accum -> fn accum a
            | None -> a
            |> Some

        accumulatedValue <- newVal

    // return a function that takes a single argument of type 'T
    // and returns a type AnonResult
    let rec createdFn x =
        match x with
        | None -> Value accumulatedValue
        | Some x ->
            callFnAndUpdateAccum x |> ignore
            Fn createdFn

    // return composed function that takes arg of 'T
    // wraps it with Some
    // and calls createdFn
    Some >> createdFn

let call value result =
    match result with
    | Fn fn -> fn (Some value)

let getResult result =
    match result with
    | Fn fn ->
        // call function with None to retrieve accumulated value
        match fn None with
        | Value valueOption ->
            match valueOption with
            | Some accumulatedValue -> accumulatedValue

let printResult res =
    res
    |> getResult
    |> printf "%A\n"


let intAdder = create (+)
let strAdder = create (+)

intAdder 7
|> call 7
|> call 8
|> printResult

strAdder "Peter"
|> call "Paul"
|> call "Mary"
|> printResult

"Peter"
|> create (fun (a:string) b -> a + " " + b)
|> call "Paul"
|> call "Mary"
|> printResult

7M
|> create (*)
|> call 7.34M
|> call 10M
|> printResult

// example how it works with any type
type WaterTemperature =
    | Cold
    | Hot
    | JustRight

let mixWater t1 t2 =
    match t1, t2 with
    | JustRight, JustRight -> JustRight
    | JustRight, Hot -> Hot
    | JustRight, Cold -> Cold
    | Cold, Hot -> JustRight
    | Cold, _ -> Cold
    | Hot, Cold -> JustRight
    | Hot, _ -> Hot


let waterMixer = create mixWater

waterMixer Cold
|> call Cold
|> call JustRight
|> call Hot
|> getResult
|> printf "The temperature is %A and should be JustRight"