Right now I'm experimenting with F# computation expressions. General idea is to return control mechanism to drive actions executed after each step of recursive function call build from computation expression. Whole example can be seen here.
Using following example:
let rec loop () =
actor {
let! msg = m.Receive ()
match msg with
| "stop" -> return 0 // expected result: Return (0)
| "unhandled" -> unhandled // expected result: Unhandled
| x ->
mailbox.Sender() <! x
return! loop () // expected result: (Become(fun m -> loop ()))
}
loop ()
Unfortunately this ends with compile time error on unhandled: A custom operation may not be used in conjunction with 'use', 'try/with', 'try/finally', 'if/then/else' or 'match' operators within this computation expression.
Is it possible in any way to use custom operators inside match statements?
I'm not sure what the details of the actor computation are, but if Unhandled is a value of the underlying computation type, you can certainly produce it using return!
Without knowing the details, I think something like this should work:
match msg with
| "stop" -> return 0
| "unhandled" -> return! Unhandled
| x ->
mailbox.Sender() <! x
return! loop ()
Related
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.
I would like to do some unit tests on a function that accepts a DU and returns another :
type Commands =
| Schedule of string
| Abandon of string
type Events =
| Scheduled of string
| Abandonned of string
the function is the following :
let exec state = function
| Schedule (cmd) -> Choice1Of2( Scheduled("yes"))
| Abandon(cmd) -> Choice1Of2( Abandonned ("no"))
My tests are as follows :
let result:Choice<Events,string> = exec "initial state" <| Schedule("myCommand");;
result has the following type Choice<Events,string>, I would have loved to get some quick function in order to use them like this :
assertEvent Scheduled (fun e -> Assert.Equal("should produce GameScheduled Event",gameScheduled, e)) result
But to do that I would have the following home made assert function :
let assertEvent<'TEvent> f g result =
match result with
| Choice1Of2(e) ->
match e with
| f(evt) -> g(evt)
| _ -> Assert.None("event not recognised",Some(e))
| Choice2Of2(reason) -> Assert.None("reason",Some(reason))
I was expecting the function f to allow pattern matching on the fly but it does not. Instead I have the following error :
The pattern disciminator 'f' is not defined
Am I doing somthing wrong somewhere ? my fsharp skills are not that high...
A normal function like f can't be used as a pattern discriminator, but you can pass Active Patterns around as arguments:
let assertEvent<'TEvent> (|F|_|) g result =
match result with
| Choice1Of2(e) ->
match e with
| F(evt) -> g(evt)
| _ -> Assert.None("event not recognised",Some(e))
| Choice2Of2(reason) -> Assert.None("reason",Some(reason))
This does, however, require you to also pass an Active Pattern as an argument, which is a bit cumbersome:
assertEvent
(function Scheduled(x) -> Some x | _ -> None)
(fun e -> Assert.Equal("should produce GameScheduled Event",gameScheduled, e))
result
This isn't the way I'd approach the problem, though. What I'd prefer is to write a boolean expression that attempts to pull out and compare the values that I want to verify.
For starters, you could create a little generic helper function to pull out one of the choices from Choice<'a, 'b>:
let toOption1 = function Choice1Of2 x -> Some x | _ -> None
This function has the type Choice<'a,'b> -> 'a option. (I'll leave it as an exercise to define an equivalent toOption2 function.)
Now you can define a boolean expression that pulls out the data if it's there, and compares it with an expected value:
result
|> toOption1
|> Option.map (function Scheduled x -> x | _ -> "")
|> Option.exists ((=) expected)
This is a boolean expression, so you can use Unquote to turn it into an assertion. This is similar to this approach that I've previously described.
Given the following agent, which is a simple cache mechanism:
type CacheMsg<'a,'b> = Add of 'a * 'b | ForceFlush
type CacheAgent<'a, 'b when 'a : comparison>(size:int, flushCont:Map<'a, 'b> -> unit) =
let agent = MailboxProcessor.Start(fun inbox ->
let rec loop (cache : Map<'a, 'b>) = async {
let inline flush() =
flushCont cache
loop Map.empty
if cache.Count > size then return! flush()
let! msg = inbox.Receive()
match msg with
| Add (key, value) ->
if cache.ContainsKey key then
return! loop cache
else return! loop (cache.Add(key, value))
| ForceFlush -> return! flush() }
loop Map.empty)
member x.AddIfNotExists key value = Add(key,value) |> agent.Post
member x.ForceFlush() = agent.Post ForceFlush
This agent will keep taking up memory (seems like the memory is not freed when the flushCont has been called).
Given the same code, but with a minor change:
type CacheMsg<'a,'b> = Add of 'a * 'b | ForceFlush
type CacheAgent<'a, 'b when 'a : comparison>(size:int, flushCont:Map<'a, 'b> -> unit) =
let agent = MailboxProcessor.Start(fun inbox ->
let rec loop (cache : Map<'a, 'b>) = async {
let inline flush() =
flushCont cache
loop Map.empty
let! msg = inbox.Receive()
match msg with
| Add (key, value) ->
if cache.ContainsKey key then
return! loop cache
else
let newCache = cache.Add(key, value)
if newCache.Count > size then
return! flush()
else return! loop (cache.Add(key, value))
| ForceFlush -> return! flush() }
loop Map.empty)
member x.AddIfNotExists key value = Add(key,value) |> agent.Post
member x.ForceFlush() = agent.Post ForceFlush
I have moved the expression that decides when to flush, into the union case Add. This results in the memory is freed as expected.
What's wrong about the first approach, since it leaks memory?
The first version isn't tail recursive.
It's not tail recursive, because this expression isn't the last expression in the function:
if cache.Count > size then return! flush()
After that expression, you call
let! msg = inbox.Receive()
so the flush() call isn't the last thing happening. After the recursive call implicit in flush has completed, the execution will need to return to the next expression, where you invoke inbox.Receive(). That means that the context will have to keep the previous invocation on the stack, because the recursion isn't in a tail position: there's still more work to do.
In the second example, all calls to flush and loop are in tail positions.
If you're coming from a C# background, you'd be inclined to think that return! flush() exits the function, but that's not really the case here. The only reason
if cache.Count > size then return! flush()
even compiles without a corresponding else branch is because the expression returns unit. This means that the code inside the then branch doesn't truly exit the function - it just performs the work in the branch (in this case flush()), and then continues executing the subsequent expressions.
Why doesn't this work?
type RetryBuilder(max) =
member x.Return(a) = a // Enable 'return'
member x.Delay(f) = f // Gets wrapped body and returns it (as it is)
// so that the body is passed to 'Run'
member x.Zero() = failwith "Zero" // Support if .. then
member x.Run(f) = // Gets function created by 'Delay'
let rec loop 0 (Some(ex)) = raise ex
let rec loop n maybeEx = try f() with ex -> loop (n-1) (Some(ex))
loop max None
let retry = RetryBuilder(4)
It says 'incomplete pattern matches on this expression. For example, the value '1' may indicate a case not covered by the pattern'.
But why wouldn't that match the one below? If I remember correctly, Haskell would match that, why doesn't F#?
You're writing F# code in Haskell syntax. The reason why your code compiles is F# compiler thought there are two loop functions where the former is shadowed by the latter. Obviously in the first loop function, pattern matching fails with any integer different from 0 for the first parameter and None for the second parameter.
A declaration close to Haskell syntax could be:
let rec loop = function
| 0, Some ex -> raise ex
| n, maybeEx -> try f() with ex -> loop (n-1, Some ex)
loop(max, None)
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()