How to implement delay in the maybe computation builder? - f#

Here is what I have so far:
type Maybe<'a> = option<'a>
let succeed x = Some(x)
let fail = None
let bind rest p =
match p with
| None -> fail
| Some r -> rest r
let rec whileLoop cond body =
if cond() then
match body() with
| Some() ->
whileLoop cond body
| None ->
fail
else
succeed()
let forLoop (xs : 'T seq) f =
using (xs.GetEnumerator()) (fun it ->
whileLoop
(fun () -> it.MoveNext())
(fun () -> it.Current |> f)
)
whileLoop works fine to support for loops, but I don't see how to get while loops supported. Part of the problem is that the translation of while loops uses delay, which I could not figure out in this case. The obvious implementation below is probably wrong, as it does not delay the computation, but runs it instead!
let delay f = f()
Not having delay also hinders try...with and try...finally.

There are actually two different ways of implementing continuation builders in F#. One is to represent delayed computations using the monadic type (if it supports some way of representing delayed computations, like Async<'T> or the unit -> option<'T> type as shown by kkm.
However, you can also use the flexibility of F# computation expressions and use a different type as a return value of Delay. Then you need to modify the Combine operation accordingly and also implement Run member, but it all works out quite nicely:
type OptionBuilder() =
member x.Bind(v, f) = Option.bind f v
member x.Return(v) = Some v
member x.Zero() = Some ()
member x.Combine(v, f:unit -> _) = Option.bind f v
member x.Delay(f : unit -> 'T) = f
member x.Run(f) = f()
member x.While(cond, f) =
if cond() then x.Bind(f(), fun _ -> x.While(cond, f))
else x.Zero()
let maybe = OptionBuilder()
The trick is that F# compiler uses Delay when you have a computation that needs to be delayed - that is: 1) to wrap the whole computation, 2) when you sequentially compose computations, e.g. using if inside the computation and 3) to delay bodies of while or for.
In the above definition, the Delay member returns unit -> M<'a> instead of M<'a>, but that's perfectly fine because Combine and While take unit -> M<'a> as their second argument. Moreover, by adding Run that evaluates the function, the result of maybe { .. } block (a delayed function) is evaluated, because the whole block is passed to Run:
// As usual, the type of 'res' is 'Option<int>'
let res = maybe {
// The whole body is passed to `Delay` and then to `Run`
let! a = Some 3
let b = ref 0
while !b < 10 do
let! n = Some () // This body will be delayed & passed to While
incr b
if a = 3 then printfn "got 3"
else printfn "got something else"
// Code following `if` is delayed and passed to Combine
return a }
This is a way to define computation builder for non-delayed types that is most likely more efficient than wrapping type inside a function (as in kkm's solution) and it does not require defining a special delayed version of the type.
Note that this problem does not happen in e.g. Haskell, because that is a lazy language, so it does not need to delay computations explicitly. I think that the F# translation is quite elegant as it allows dealing with both types that are delayed (using Delay that returns M<'a>) and types that represent just an immediate result (using Delay that returns a function & Run).

According to monadic identities, your delay should always be equivalent to
let delay f = bind (return ()) f
Since
val bind : M<'T> -> ('T -> M<'R>) -> M<'R>
val return : 'T -> M<'T>
the delay has the signature of
val delay : (unit -> M<'R>) -> M<'R>
'T being type-bound to unit. Note that your bind function has its arguments reversed from the customary order bind p rest. This is technically same but does complicate reading code.
Since you are defining the monadic type as type Maybe<'a> = option<'a>, there is no delaying a computation, as the type does not wrap any computation at all, only a value. So you definition of delay as let delay f = f() is theoretically correct. But it is not adequate for a while loop: the "body" of the loop will be computed before its "test condition," really before the bind is bound. To avoid this, you redefine your monad with an extra layer of delay: instead of wrapping a value, you wrap a computation that takes a unit and computes the value.
type Maybe<'a> = unit -> option<'a>
let return x = fun () -> Some(x)
let fail = fun() -> None
let bind p rest =
match p() with
| None -> fail
| Some r -> rest r
Note that the wrapped computation is not run until inside the bind function, i. e. not run until after the arguments to bind are bound themselves.
With the above expression, delay is correctly simplified to
let delay f = fun () -> f()

Related

Stackless trampoline Monad/Computation Expression

I am working on a functional programming language of my own design and I stumbled on a problem that is beyond my skills to solve. I would like to know if anyone has any advice on how to solve it or a reason for why it is impossible.
The code below is an overview of a solution that is not the ideal but a compromise.
This problem is at the heart of the runtime system I am currently using. Instead of relying on the .Net stack I am using a monad to perform operations on a trampoline. This should help with step through debugging and allow for users to not have to worry about stack space. Here is a simplified version of the monad I am currently using.
type 't StackFree =
|Return of 't //Return a value
|StackPush of ('t->'t StackFree)*'t StackFree //Pushes a return handler onto the "Stack"
|Continuation of (unit->'t StackFree) //Perform a simple opperation
type StackFreeMonad() =
member this.Delay(fn) =
Continuation(fn)
member this.Bind(expr,fn) =
StackPush(fn,expr)
member this.Return(value) =
Return(value)
member this.ReturnFrom(x) =x
let stackfree = StackFreeMonad()
This was not the original design but it was the best I could get to work with F# computation expressions in an ideal world the above computation expression would work on this type.
type 't Running =
|Result of 't
|Step of (unit->'t Running)
So in order to convert a StackFree into a Running type I have to use this conversion function
//this method loops through the StackFree structure finding the next computation and managing a pseudo stack with a list.
let prepareStackFree<'t> :'t StackFree->'t Running =
let rec inner stack stackFree =
Step(fun ()->
match stackFree with
//takes the return values and passes it to the next function on the "Stack"
|Return(value)->
match stack with
|[]->Result(value)
|x::xs -> inner xs (x value)
//pushes a new value on the the "Stack"
|StackPush(ret,next) ->
inner (ret::stack) next
//performs a single step
|Continuation(fn)->
inner stack (fn()))
inner []
Here is a brief example of the two types in action.
let run<'t> :'t StackFree->'t =
let rec inner = function
|Step(x)-> inner (x())
|Result(x)-> x
stackFreeToRunning>>inner
//silly function to recompute an intiger value using recursion
let rec recompute number = stackfree {
if number = 0 then return 0
else
let! next = recompute (number-1)
return next+1
}
let stackFreeValue = recompute 100000
let result = run stackFreeValue
do printfn "%i" result
I have spent several hours trying to get a Computation Expression that works directly on the Running type and cutting out the middleman StackFree. However I cannot figure out how to do it. At this point I am seriously considering the possibility that a solution to this problem is impossible. However I cannot figure out the reason that it is impossible.
I have gotten close a few times but the resulting solutions ended up using the stack in some confusing way.
Is it possible to have a computation expression that operates on the Running type without utilizing the .Net stack? If this is not possible why is it not possible. There must be some simple mathematical reasoning that I am missing.
NB: These are not the actual types I am using they are simplified for this questions the real ones keep track of scope and position in the script. Furthermore I am aware of the serious performance cost of this type of abstraction
Edit: Here is another way to approach the problem. This implementation is flawed because it uses the stack. Is there anyway to get the exact behavior below without using the stack?
type RunningMonad() =
member this.Delay(fn) =
Step(fun ()->fn ())
member this.Bind(m, fn) =
Step(fun ()->
match m with
|Result(value)-> fn value
//Here is the problem
|Step(next)-> this.Bind(next(),fn))
member this.Return(v) =
Result(v)
member this.ReturnFrom(x) = x
The bind implementation in the above computation expression creates a function that calls another function. So as you go deeper and call bind more and more you have to chase a bunch of function calls and then eventually you hit a stackoverflow exception.
Edit2: Clarity.
Better late than never!
This is addressed in section 4 of Stackless Scala with Free Monads. Bjarnason tackles the problem by adding a new constructor to the Trampoline datatype, representing a subroutine call to another trampoline. He keeps this new constructor private, in order to ensure that you can't build left-nested Binds (which would overflow the stack when executing the trampoline).
I am by no means an F#er, but I'll muddle through. In WishF#ul, an imaginary dialect of F# which I just made up, you can express the new existentially quantified constructor directly:
type Tram<'a> =
| Done of 'a
| Step of (unit -> Tram<'a>)
| Call<'x> of Tram<'x> * ('x -> Tram<'a>) // don't export this
type TramMonad() =
member this.Return(x) = Done(x)
member this.Bind(ma, f) = match ma with
| Call(mx, k) -> Call(mx, fun x -> this.Bind(k(x), f))
| _ -> Call(ma, f)
// i confess to not quite understanding what your Delay and ReturnFrom methods are for
let tram = new TramMonad()
let rec runTram t =
let next mx f = match mx with
| Done(x) -> f x
| Step(k) -> Step(fun () -> tram.Bind(k(), f))
| Call(my, g) -> tram.Bind(my, fun x -> tram.Bind(g x, f))
match t with
| Done(x) -> x
| Step(k) -> runTram(k())
| Call(mx, f) -> runTram(next mx f)
Note that all of the recursive calls to runTram are in tail position. It takes a bit of puzzling, but you can convince yourself that Bind won't construct a deeply-nested continuation, so runT will always operate in O(1) stack space.
Sadly we're working in F#, not WishF#ul, so we have to resort to an object-oriented encoding of the existential type in the Call constructor. Here goes...
module rec Trampoline =
type Call<'a> =
abstract member Rebind<'b> : ('a -> Tram<'b>) -> Tram<'b>
abstract member Next : unit -> Tram<'a>
type Tram<'a> =
| Done of 'a
| Step of (unit -> Tram<'a>)
| Call of Call<'a>
type TramMonad() =
member this.Return(x) = Done(x)
member this.Bind(ma, f) =
match ma with
| Call(aCall) -> aCall.Rebind(f)
| _ -> call ma f
let tram = new TramMonad()
let rec call<'a, 'x>(mx : Tram<'x>) (f : 'x -> Tram<'a>) : Tram<'a> = Call {
new Call<'a> with
member this.Rebind<'b>(g : 'a -> Tram<'b>) : Tram<'b> =
call<'b, 'x> mx (fun x -> tram.Bind(f x, g) : Tram<'b>)
member this.Next() =
match mx with
| Done(x) -> f x
| Step(k) -> Step(fun () -> tram.Bind(k(), f))
| Call(aCall) -> aCall.Rebind(f)
}
let rec runTram t =
match t with
| Done(x) -> x
| Step(k) -> runTram(k())
| Call(aCall) -> runTram(aCall.Next())
I recommend reading the whole paper, which goes on to generalise this stackless construction to any free monad, not just trampolines (which are Free (Unit -> _)). Phil Freeman's Stack Safety for Free builds on this work, generalising the trampoline paper's free monad to a free monad transformer.

Random / State workflow in F#

I'm trying to wrap my head around mon-, err, workflows in F# and while I think that I have a pretty solid understanding of the basic "Maybe" workflow, trying to implement a state workflow to generate random numbers has really got me stumped.
My non-completed attempt can be seen here:
let randomInt state =
let random = System.Random(state)
// Generate random number and a new state as well
random.Next(0,1000), random.Next()
type RandomWF (initState) =
member this.Bind(rnd,rest) =
let value, newState = rnd initState
// How to feed "newState" into "rest"??
value |> rest
member this.Return a = a // Should I maybe feed "initState" into the computation here?
RandomWF(0) {
let! a = randomInt
let! b = randomInt
let! c = randomInt
return [a; b; c]
} |> printfn "%A"
Edit: Actually got it to work! Not exactly sure how it works though, so if anyone wants to lay it out in a good answer, it's still up for grabs. Here's my working code:
type RandomWF (initState) =
member this.Bind(rnd,rest) =
fun state ->
let value, nextState = rnd state
rest value nextState
member this.Return a = fun _ -> a
member this.Run x = x initState
There are two things that make it harder to see what your workflow is doing:
You're using a function type for the type of your monad,
Your workflow not only builds up the computation, it also runs it.
I think it's clearer to follow once you see how it would look without those two impediments. Here's the workflow defined using a DU wrapper type:
type Random<'a> =
Comp of (int -> 'a * int)
let run init (Comp f) = f init
type Random<'a> with
member this.Run(state) = fst <| run state this
type RandomBuilder() =
member this.Bind(Comp m, f: 'a -> Random<_>) =
Comp <| fun state ->
let value, nextState = m state
let comp = f value
run nextState comp
member this.Return(a) = Comp (fun s -> a, s)
let random = RandomBuilder()
And here is how you use it:
let randomInt =
Comp <| fun state ->
let rnd = System.Random(state)
rnd.Next(0,1000), rnd.Next()
let rand =
random {
let! a = randomInt
let! b = randomInt
let! c = randomInt
return [a; b; c ]
}
rand.Run(0)
|> printfn "%A"
In this version you separately build up the computation (and store it inside the Random type), and then you run it passing in the initial state. Look at how types on the builder methods are inferred and compare them to what MSDN documentation describes.
Edit: Constructing a builder object once and using the binding as an alias of sorts is mostly convention, but it's well justified in that it makes sense for the builders to be stateless. I can see why having parameterized builders seems like a useful feature, but I can't honestly imagine a convincing use case for it.
The key selling point of monads is the separation of definition and execution of a computation.
In your case - what you want to be able to do is to take a representation of your computation and be able to run it with some state - perhaps 0, perhaps 42. You don't need to know the initial state to define a computation that will use it. By passing in the state to the builder, you end up blurring the line between definition and execution, and this simply makes the workflow less useful.
Compare that with async workflow - when you write an async block, you don't make the code run asynchronously. You only create an Async<'a> object representing a computation that will produce an object of 'a when you run it - but how you do it, is up to you. The builder doesn't need to know.

Memoize a function of type () -> 'a

This memoize function fails on any functions of type () -> 'a at runtime with a Null-Argument-Exception.
let memoize f =
let cache = System.Collections.Generic.Dictionary()
fun x ->
if cache.ContainsKey(x) then
cache.[x]
else
let res = f x
cache.[x] <- res
res
Is there a way to write a memoize function that also works for a () -> 'a ?
(My only alternative for now is using a Lazy type. calling x.Force() to get the value.)
The reason why the function fails is that F# represents unit () using null of type unit. The dictionary does not allow taking null values as keys and so it fails.
In your specific case, there is not much point in memoizing function of type unit -> 'a (because it is better to use lazy for this), but there are other cases where this would be an issue - for example None is also represented by null so this fails too:
let f : int option -> int = memoize (fun a -> defaultArg a 42)
f None
The easy way to fix this is to wrap the key in another data type to make sure it is never null:
type Key<'K> = K of 'K
Then you can just wrap the key with the K constructor and everything will work nicely:
let memoize f =
let cache = System.Collections.Generic.Dictionary()
fun x ->
if cache.ContainsKey(K x) then
cache.[K x]
else
let res = f x
cache.[K x] <- res
res
I just found that the last memoize function on the same website using Map instead of Dictionary works for 'a Option -> 'b and () -> 'a too:
let memoize1 f =
let cache = ref Map.empty
fun x ->
match cache.Value.TryFind(x) with
| Some res -> res
| None ->
let res = f x
cache.Value <- cache.Value.Add(x, res)
res
Memoization having a pure function (not just of type unit -> 'a, but any other too) as a lookup key is impossible because functions in general do not have equality comparer for the reason.
It may seem that for this specific type of function unit -> 'a it would be possible coming up with a custom equality comparer. But the only approach for implementing such comparer beyond extremes (reflection, IL, etc.) would be invoking the lookup function as f1 = f2 iff f1() = f2(), which apparently nullifies any performance improvement expected from memoization.
So, perhaps, as it was already noted, for this case optimizations should be built around lazy pattern, but not memoization one.
UPDATE: Indeed, after second look at the question all talking above about functions missing equality comparer is correct, but not applicable, because memoization happens within each function's individual cache from the closure. On the other side, for this specific kind of functions with signature unit->'a, i.e. at most single value of argument, using Dictionary with most one entry is an overkill. The following similarly stateful, but simpler implementation with just one memoized value will do:
let memoize2 f =
let notFilled = ref true
let cache = ref Unchecked.defaultof<'a>
fun () ->
if !notFilled then
cache := f ()
notFilled := false
!cache
used as let foo = memoize2(fun () -> ...heavy on time and/or space calculation...)
with first use foo() performing and storing the result of calculation and all successive foo() just reusing the stored value.
Solution with mutable dictionary and single dictionary lookup call:
let memoize1 f =
// printfn "Dictionary"
let cache = System.Collections.Generic.Dictionary()
fun x ->
let result, value = cache.TryGetValue(x)
match result with
| true -> value
| false ->
// printfn "f x"
let res = f x
cache.Add(x, res)
res

Is there a way to make different implementation of do! and let! in a computation expression?

I need a different behavior for do! and let! in my custom computation expression.
I try to achieve this in the following way:
type FooBuilder() = class
member b.Bind<'T, 'U>(x:'T, f:unit->'U):'U = failwith "not implemented" //do! implementation
member b.Bind<'T, 'U>(x:'T, f:'T->'U):'U = failwith "not implemented" //let! implementation
member b.Return<'T>(x:'T):'T = failwith "not implemented" //return implementation
end
let foo = FooBuilder()
let x = foo {
do! ()
return 2
}
But compiler gives me an error:
A unique overload for method 'Bind' could not be determined based on type information prior to this program point. The available overloads are shown below (or in the Error List window). A type annotation may be needed.
Is there a way to have a different implementation of do! and let!?
If you want to keep the Bind operation used in let! generic, then there is no way to say that F# should use different implementation when translating do! (the overloads will necessarily have to overlap).
In general, if you want to get different behavior for let! and for do! then it suggests that your computation expression is probably incorrectly defined. The concept is quite flexible and it can be used for more things than just for declaring monads, but you may be stretching it too far. If you can write more information about what you want to achieve, that would be useful. Anyway, here are some possible workarounds...
You can add some additional wrapping and write something like do! wrap <| expr.
type Wrapped<'T> = W of 'T
type WrappedDo<'T> = WD of 'T
type FooBuilder() =
member b.Bind<'T, 'U>(x:Wrapped<'T>, f:'T->'U):'U = failwith "let!"
member b.Bind<'T, 'U>(x:WrappedDo<unit>, f:unit->'U):'U = failwith "do!"
member b.Return<'T>(x:'T):Wrapped<'T> = failwith "return"
let wrap (W a) = WD a
let bar arg = W arg
let foo = FooBuilder()
// Thanks to the added `wrap` call, this will use the second overload
foo { do! wrap <| bar()
return 1 }
// But if you forget to add `wrap` then you still get the usual `let!` implementation
foo { do! wrap <| bar()
return 1 }
Another alternative would be to use dynamic type tests. This is a bit inefficient (and a bit inelegant), but it may do the trick, depending on your scenario:
member b.Bind<'T, 'U>(x:Wrapped<'T>, f:'T->'U):'U =
if typeof<'T> = typeof<unit> then
failwith "do!"
else
failwith "let!"
However, this would still use the do! overload when you write let! () = bar.
You could try something else, a bit ugly, but should work:
let bindU (x, f) = f x // you must use x, or it'll make the Bind method less generic.
let bindG (x, f) = f x
member b.Bind(x : 'a, f : 'a -> 'b) =
match box x with
| :? unit -> bindU (x, f)
| _ -> bindG (x, f)
It boxes a (converts it to obj) and checks if it is of type unit, then redirects to the correct overload.

Working with Nullable<'T> in F#

I'm wondering what others have come up with for dealing with Nullable<'T> in F#. I want to use Nullable<'T> on data types so that serialization works properly (i.e., doesn't write out F# option type to XML). But, I don't want my code stuck dealing with the ugliness of dealing with Nullable<'T> directly. Any suggestions?
Is it better to use active patterns to match directly on Nullable, or just a converter to option and use Some/None matching?
Additionally, I'd love to hear ideas on dealing with nullable references in a nice manner too. If I use, say "string option", then I end up with the F# option type wrapping things. If I don't then I can't distinguish between truly optional strings and strings that shouldn't be null.
Any chance .NET 4 will take on an Option<'T> to help out? (If it's part of the BCL, then we might see better support for it...)
As active patterns as options plays nicely with pattern matching, but is seems by using active patterns (i.e. typeof and ??) your code will eat more ticks.
The base question is how you will deal with your nullable references?
In case your code is long chained computations it's nice to use monadic syntax:
type Maybe<'a> = (unit -> 'a option)
let succeed x : Maybe<'a> = fun () -> Some(x)
let fail : Maybe<'a> = fun () -> None
let run (a: Maybe<'a>) = a()
let bind p rest = match run p with None -> fail | Some r -> (rest r)
let delay f = fun () -> run (f ())
type MaybeBuilder() =
member this.Return(x) = succeed x
member this.Let(p,rest) = rest p
member this.Bind(p,rest) = bind p rest
member this.Delay(f) = delay f
let maybe = new MaybeBuilder()
let add (a:'a) (b:'a) =
maybe {
match TryGetNumericAssociation<'a>() with
| Some v -> return (v.Add(a,b))
| _ -> return! fail
}
let add3 (a:'a) (b:'a) (c:'a) =
maybe {
let! ab = add a b
let! abc = add ab c
return abc
}
> let r1 = add 1 2;;
val r1 : (unit -> int option)
> r1();;
val it : int option = Some 3
> let r2 = add "1" "2";;
val r2 : (unit -> string option)
> r2();;
val it : string option = None
> let r3 = add3 "one" "two" "three";;
val r3 : (unit -> string option)
> r3();;
val it : string option = None

Resources