I made this example up to better understand how lazy evaluation works in OCaml - using thonks.
let rec imp n = fun () -> imp(n*n);;
My understanding of lazy evaluation / thonks is that impl will
square an initial number as often as I'm calling
imp ().
However this function imp raises the following error:
---
let rec imp n acc = fun()->(***imp (n\*acc)***);;
This expression has type int -> unit -> 'a
but an expression was expected of type 'a
The type variable 'a occurs inside int -> unit -> 'a
---
The compiler is telling you that your function has a recursive type. You can work with recursive types if you supply -rectypes when you run ocaml:
$ ocaml -rectypes
OCaml version 4.10.0
# let rec imp n = fun () -> imp(n*n);;
val imp : int -> (unit -> 'a as 'a) = <fun>
On the other hand I don't think your function works like you think. Or at least I don't see any way to find out what number it has recently calculated. You'll have to take it on faith that it is calculating larger and larger numbers, I guess.
I would investigate the Seq module and use that.
Here's an example that demonstrates what you are trying to accomplish:
type func = Func of (unit -> int * func)
let rec incr_by_2 x =
let ans = x + 2 in
(ans, Func(fun () -> incr_by_2 ans))
let ans = incr_by_2 10
let () =
match ans with
| (d, Func f) -> print_endline(string_of_int d);
match f() with
| (d, Func f) -> print_endline(string_of_int d);
match f() with
| (d, _) -> print_endline(string_of_int d);
Please note the type constructor Func which is used to resolve the type problem in the function incr_by_2.
Here's an example using the Seq module's unfold function.
type func = Func of (unit -> int * func)
let rec incr_by_2 x =
let ans = x + 2 in
(ans, Func(fun () -> incr_by_2 ans))
let seq x =
Seq.unfold
(
fun (d, Func f) ->
if d < x
then
Some(d, f())
else
None
)
(incr_by_2 10)
let () =
(seq 100) |> Seq.iter (Printf.printf "%d\n"); print_newline()
Related
Consider for example let f x = f x in f 1. Is its signature defined?
If so, what is it?
One could argue, that OCaml doesn't know about the fact that it's not terminating and that its type is simply inferred as 'a. Is that correct?
let a b = let rec f x = f x in f 1;;
is for example val a : 'a -> 'b eventhough it is very clear, that when a is applied, there won't be a 'b
Then requirement for a sound type system when you have type(E) = T is that if E evaluates to some value v, then v is a value that belongs to type T. A type is meaningful when the expression gives a value, and exceptions and infinite loops do not.
The type checker however is total, and gives a type for all expression, even if it is just a free type variable.
Here the return type is left unbound, and is printed as 'a.
# let f x = if x then (failwith "A") else (failwith "B");;
val f : bool -> 'a = <fun>
Here the return type of the then branch is unified with the type of the else branch:
# let f x = if x then (failwith "A") else 5;;
val f : bool -> int = <fun>
#
One way to read function types like unit -> 'a is to remember that the
type variable 'a encompasses empty types.
For example, if I have a function f
let rec f:'a. _ -> 'a = fun () -> f ()
and an empty type
type empty = |
(* using 4.07 empty variants *)
(* or *)
type (_,_) eq = Refl: ('a,'a) eq
type empty = (float,int) eq
then I can restrict the type of f to unit -> empty:
let g: unit -> empty = f
Moreover, the more general type of f can be useful in presence of branches.
For instance, I could define a return that raises an exception in order
to exit early from a for-loop:
let search pred n =
let exception Return of int in
let return: 'a. int -> 'a = fun n -> raise (Return n) in
try
for i = 0 to n do
if pred i then return i
done;
None
with Return n -> Some n
Here, the polymorphic type of return makes it possible to use it in a context
where unit was expected.
I'm studying continuations because I want to make some interesting use of coroutines... anyway, I want to better understand one implementation I found.
To do so I want to rewrite the implementation without using the computation expression (continuation Monad), but I'm not quite able to do it.
I have this:
type K<'T,'r> = (('T -> 'r) -> 'r)
let returnK x = (fun k -> k x)
let bindK m f = (fun k -> m (fun a -> f a k))
let runK (c:K<_,_>) cont = c cont
let callcK (f: ('T -> K<'b,'r>) -> K<'T,'r>) : K<'T,'r> =
fun cont -> runK (f (fun a -> (fun _ -> cont a))) cont
type ContinuationBuilder() =
member __.Return(x) = returnK x
member __.ReturnFrom(x) = x
member __.Bind(m,f) = bindK m f
member this.Zero () = this.Return ()
let K = new ContinuationBuilder()
/// The coroutine type from http://fssnip.net/7M
type Coroutine() =
let tasks = new System.Collections.Generic.Queue<K<unit,unit>>()
member this.Put(task) =
let withYield = K {
do! callcK (fun exit ->
task (fun () ->
callcK (fun c ->
tasks.Enqueue(c())
exit ())))
if tasks.Count <> 0 then
do! tasks.Dequeue() }
tasks.Enqueue(withYield)
member this.Run() =
runK (tasks.Dequeue()) ignore
// from FSharpx tests
let ``When running a coroutine it should yield elements in turn``() =
// This test comes from the sample on http://fssnip.net/7M
let actual = System.Text.StringBuilder()
let coroutine = Coroutine()
coroutine.Put(fun yield' -> K {
actual.Append("A") |> ignore
do! yield' ()
actual.Append("B") |> ignore
do! yield' ()
actual.Append("C") |> ignore
do! yield' ()
})
coroutine.Put(fun yield' -> K {
actual.Append("1") |> ignore
do! yield' ()
actual.Append("2") |> ignore
do! yield' ()
})
coroutine.Run()
actual.ToString() = "A1B2C"
``When running a coroutine it should yield elements in turn``()
So, I want rewrite the Put member of the Coroutine class without using the computation expression K.
I have read of course this and this and several other articles about catamorphisms but it is not quite easy to rewrite this continuation monand as it is to rewrite the Write Monad for example...
I try several ways, this is one of them:
member this.Put(task) =
let withYield =
bindK
(callcK (fun exit ->
task (fun () ->
callcK (fun c ->
tasks.Enqueue(c())
exit ()))))
(fun () ->
if tasks.Count <> 0
then tasks.Dequeue()
else returnK ())
tasks.Enqueue(withYield)
Of course it does not work :(
(By the way: there is some extensive documentation of all rules the compiler apply to rewrite the computation in plain F#?)
Your version of Put is almost correct. Two issues though:
The bindK function is being used backwards, the parameters need to be swaped.
task should be passed a Cont<_,_> -> Cont<_,_>, not a unit -> Cont<_,_> -> Cont<_,_>.
Fixing those issues it could look like this:
member this.Put(task) =
let withYield =
bindK
(fun () ->
if tasks.Count <> 0
then tasks.Dequeue()
else returnK ())
(callcK (fun exit ->
task (
callcK (fun c ->
tasks.Enqueue(c())
exit ()))))
tasks.Enqueue(withYield)
Of course it is not too elegant.
When using bind it is better to declare an operator >>=:
let (>>=) c f = bindK f c
that way
do! translates to putting >>= fun () -> after
let! a = translates to putting >>= fun a -> after
and then your code will look a little bit better:
member this.Put2(task) =
let withYield =
callcK( fun exit ->
task( callcK (fun c ->
tasks.Enqueue(c())
exit())
)
) >>= fun () ->
if tasks.Count <> 0 then
tasks.Dequeue()
else returnK ()
tasks.Enqueue withYield
For the following example, Array.mapFold produces the result ([|1; 4; 12|], 7).
let mapping s x = (s * x, s + x)
[| 1..3 |]
|> Array.mapFold mapping 1
Now suppose our mapping is asynchronous.
let asyncMapping s x = async { return (s * x, s + x) }
I am able to create Array.mapFoldAsync for the following to work.
[| 1..3 |]
|> Array.mapFoldAsync asyncMapping 1
|> Async.RunSynchronously
Is there a succinct way to achieve this without creating Array.mapFoldAsync?
I am asking as a way to learn other techniques - my attempts using Array.fold were horrible.
I don't think it would generally be of much benefit to combine mapFold with an Async function, because the expected result is a tuple ('values * 'accumulator), but using an Async function will at best give you an Async<'values * 'accumulator>. Consider the following attempt to make Array.mapFold work with Async:
let mapping s x = async {
let! s' = s
let! x' = x
return (s' * x', s' + x')
}
[| 1..3 |]
|> Array.map async.Return
|> Array.mapFold mapping (async.Return 1)
Even this doesn't work, because of the type mismatch: The type ''a * Async<'b>' does not match the type 'Async<'c * 'd>'.
You may also have noticed that while there is an Array.Parallel.map, there's no Array.Parallel.fold or Array.Parallel.mapFold. If you try to write your own mapFoldAsync, you may see why. The mapping part is pretty easy, just partially apply Array.map and compose with Async.Parallel:
let mapAsync f = Array.map f >> Async.Parallel
You can implement an async fold as well, but since each evaluation depends on the previous result, you can't leverage Async.Parallel this time:
let foldAsync f state array =
match array |> Array.length with
| 0 -> async.Return state
| length ->
async {
let mutable acc = state
for i = 0 to length - 1 do
let! value = f acc array.[i]
acc <- value
return acc
}
Now, when we try to combine these to build a mapFoldAsync, it becomes apparent that we can't leverage parallel execution on the mapping anymore, because both the values and the accumulator can be based on the result of the previous evaluation. That means our mapFoldAsync will be a modified 'foldAsync', not a composition of it with mapAsync:
let mapFoldAsync (f: 's -> 'a -> Async<'b * 's>) (state: 's) (array: 'a []) =
match array |> Array.length with
| 0 -> async.Return ([||], state)
| length ->
async {
let mutable acc = state
let results = Array.init length <| fun _ -> Unchecked.defaultof<'b>
for i = 0 to length - 1 do
let! (x,y) = f acc array.[i]
results.[i] <- x
acc <- y
return (results, acc)
}
While this will give you a way to do a mapFold with an async mapping function, the only real benefit would be if the mapping function did something with high-latency, such as a service call. You won't be able to leverage parallel execution for speed-up. If possible, I would suggest considering an alternative solution, based on your real-world scenario.
Without external libraries (I recommend to try AsyncSeq or Hopac.Streams)
you could do this:
let mapping s x = (fst s * x, snd s + x) |> async.Return
module Array =
let mapFoldAsync folderAsync (state: 'state) (array: 'elem []) = async {
let mutable finalState = state
for elem in array do
let! nextState = folderAsync finalState elem
finalState <- nextState
return finalState
}
[| 1..4 |]
|> Array.mapFoldAsync mapping (1,0)
|> Async.RunSynchronously
I'm trying to build pipeline for message handling using free monad pattern, my code looks like that:
module PipeMonad =
type PipeInstruction<'msgIn, 'msgOut, 'a> =
| HandleAsync of 'msgIn * (Async<'msgOut> -> 'a)
| SendOutAsync of 'msgOut * (Async -> 'a)
let private mapInstruction f = function
| HandleAsync (x, next) -> HandleAsync (x, next >> f)
| SendOutAsync (x, next) -> SendOutAsync (x, next >> f)
type PipeProgram<'msgIn, 'msgOut, 'a> =
| Act of PipeInstruction<'msgIn, 'msgOut, PipeProgram<'msgIn, 'msgOut, 'a>>
| Stop of 'a
let rec bind f = function
| Act x -> x |> mapInstruction (bind f) |> Act
| Stop x -> f x
type PipeBuilder() =
member __.Bind (x, f) = bind f x
member __.Return x = Stop x
member __.Zero () = Stop ()
member __.ReturnFrom x = x
let pipe = PipeBuilder()
let handleAsync msgIn = Act (HandleAsync (msgIn, Stop))
let sendOutAsync msgOut = Act (SendOutAsync (msgOut, Stop))
which I wrote according to this article
However it's important to me to have those methods asynchronous (Task preferably, but Async is acceptable), but when I created a builder for my pipeline, I can't figure out how to use it - how can I await a Task<'msgOut> or Async<'msgOut> so I can send it out and await this "send" task?
Now I have this piece of code:
let pipeline log msgIn =
pipe {
let! msgOut = handleAsync msgIn
let result = async {
let! msgOut = msgOut
log msgOut
return sendOutAsync msgOut
}
return result
}
which returns PipeProgram<'b, 'a, Async<PipeProgram<'c, 'a, Async>>>
In my understanding, the whole point of the free monad is that you don't expose effects like Async, so I don't think they should be used in the PipeInstruction type. The interpreter is where the effects get added.
Also, the Free Monad really only makes sense in Haskell, where all you need to do is define a functor, and then you get the rest of the implementation automatically. In F# you have to write the rest of the code as well, so there is not much benefit to using Free over a more traditional interpreter pattern.
That TurtleProgram code you linked to was just an experiment -- I would not recommend using Free for real code at all.
Finally, if you already know the effects you are going to use, and you are not going to have more than one interpretation, then using this approach doesn't make sense. It only makes sense when the benefits outweigh the complexity.
Anyway, if you did want to write an interpreter version (rather than Free) this is how I would do it:
First, define the instructions without any effects.
/// The abstract instruction set
module PipeProgram =
type PipeInstruction<'msgIn, 'msgOut,'state> =
| Handle of 'msgIn * ('msgOut -> PipeInstruction<'msgIn, 'msgOut,'state>)
| SendOut of 'msgOut * (unit -> PipeInstruction<'msgIn, 'msgOut,'state>)
| Stop of 'state
Then you can write a computation expression for it:
/// A computation expression for a PipeProgram
module PipeProgramCE =
open PipeProgram
let rec bind f instruction =
match instruction with
| Handle (x,next) -> Handle (x, (next >> bind f))
| SendOut (x, next) -> SendOut (x, (next >> bind f))
| Stop x -> f x
type PipeBuilder() =
member __.Bind (x, f) = bind f x
member __.Return x = Stop x
member __.Zero () = Stop ()
member __.ReturnFrom x = x
let pipe = PipeProgramCE.PipeBuilder()
And then you can start writing your computation expressions. This will help flush out the design before you start on the interpreter.
// helper functions for CE
let stop x = PipeProgram.Stop x
let handle x = PipeProgram.Handle (x,stop)
let sendOut x = PipeProgram.SendOut (x, stop)
let exampleProgram : PipeProgram.PipeInstruction<string,string,string> = pipe {
let! msgOut1 = handle "In1"
do! sendOut msgOut1
let! msgOut2 = handle "In2"
do! sendOut msgOut2
return msgOut2
}
Once you have described the the instructions, you can then write the interpreters. And as I said, if you are not writing multiple interpreters, then perhaps you don't need to do this at all.
Here's an interpreter for a non-async version (the "Id monad", as it were):
module PipeInterpreterSync =
open PipeProgram
let handle msgIn =
printfn "In: %A" msgIn
let msgOut = System.Console.ReadLine()
msgOut
let sendOut msgOut =
printfn "Out: %A" msgOut
()
let rec interpret instruction =
match instruction with
| Handle (x, next) ->
let result = handle x
result |> next |> interpret
| SendOut (x, next) ->
let result = sendOut x
result |> next |> interpret
| Stop x ->
x
and here's the async version:
module PipeInterpreterAsync =
open PipeProgram
/// Implementation of "handle" uses async/IO
let handleAsync msgIn = async {
printfn "In: %A" msgIn
let msgOut = System.Console.ReadLine()
return msgOut
}
/// Implementation of "sendOut" uses async/IO
let sendOutAsync msgOut = async {
printfn "Out: %A" msgOut
return ()
}
let rec interpret instruction =
match instruction with
| Handle (x, next) -> async {
let! result = handleAsync x
return! result |> next |> interpret
}
| SendOut (x, next) -> async {
do! sendOutAsync x
return! () |> next |> interpret
}
| Stop x -> x
First of all, I think that using free monads in F# is very close to being an anti-pattern. It is a very abstract construction that does not fit all that great with idiomatic F# style - but that is a matter of preference and if you (and your team) finds this way of writing code readable and easy to understand, then you can certainly go in this direction.
Out of curiosity, I spent a bit of time playing with your example - although I have not quite figured out how to fix your example completely, I hope the following might help to steer you in the right direction. The summary is that I think you will need to integrate Async into your PipeProgram so that the pipe program is inherently asynchronous:
type PipeInstruction<'msgIn, 'msgOut, 'a> =
| HandleAsync of 'msgIn * (Async<'msgOut> -> 'a)
| SendOutAsync of 'msgOut * (Async<unit> -> 'a)
| Continue of 'a
type PipeProgram<'msgIn, 'msgOut, 'a> =
| Act of Async<PipeInstruction<'msgIn, 'msgOut, PipeProgram<'msgIn, 'msgOut, 'a>>>
| Stop of Async<'a>
Note that I had to add Continue to make my functions type-check, but I think that's probably a wrong hack and you might need to remote that. With these definitions, you can then do:
let private mapInstruction f = function
| HandleAsync (x, next) -> HandleAsync (x, next >> f)
| SendOutAsync (x, next) -> SendOutAsync (x, next >> f)
| Continue v -> Continue v
let rec bind (f:'a -> PipeProgram<_, _, _>) = function
| Act x ->
let w = async {
let! x = x
return mapInstruction (bind f) x }
Act w
| Stop x ->
let w = async {
let! x = x
let pg = f x
return Continue pg
}
Act w
type PipeBuilder() =
member __.Bind (x, f) = bind f x
member __.Return x = Stop x
member __.Zero () = Stop (async.Return())
member __.ReturnFrom x = x
let pipe = PipeBuilder()
let handleAsync msgIn = Act (async.Return(HandleAsync (msgIn, Stop)))
let sendOutAsync msgOut = Act (async.Return(SendOutAsync (msgOut, Stop)))
let pipeline log msgIn =
pipe {
let! msgOut = handleAsync msgIn
log msgOut
return! sendOutAsync msgOut
}
pipeline ignore 0
This now gives you just plain PipeProgram<int, unit, unit> which you should be able to evaluate by having a recursive asynchronous functions that acts on the commands.
Suppose a function g is defined as follows.
utop # let g ~y ~x = x + y ;;
val g : y:int -> x:int -> int = <fun>
utop # g ~x:1 ;;
- : y:int -> int = <fun>
utop # g ~y:2 ;;
- : x:int -> int = <fun>
utop # g ~x:1 ~y:2 ;;
- : int = 3
utop # g ~y:2 ~x:1 ;;
- : int = 3
Now there is another function foo
utop # let foobar (f: x:int -> y:int -> int) = f ~x:1 ~y:2 ;;
val foobar : (x:int -> y:int -> int) -> int = <fun>
Sadly when I try to provide g as the parameter of foobar, it complains:
utop # foobar g ;;
Error: This expression has type y:int -> x:int -> int
but an expression was expected of type x:int -> y:int -> int
This is quite surprising as I can successfully currify g but cannot pass it as the parameter. I googled and found this article which doesn't help much. I guess this is related to the underlying type system of OCaml (e.g. subtyping rules of labeled arrow types).
So is it possible to pass g as the parameter to foobar by any means in OCaml? If not, why is it not allowed? Any supporting articles/books/papers would be sufficient.
The key is that labels do not exist at runtime. A function of type X:int -> y:float -> int is really a function whose first argument is an int and whose second argument is a float.
Calling g ~y:123 means that we store the second argument 123 somewhere (in a closure) and we will use it automatically later when the original function g is finally called with all its arguments.
Now consider a higher-order function such as foobar:
let foobar (f : y:float -> x:int -> int) = f ~x:1 ~y:2.
(* which is the same as: *)
let foobar (f : y:float -> x:int -> int) = f 2. 1
The function f passed to foobar takes two arguments, and the float must be the first argument, at runtime.
Maybe it would be possible to support your wish, but it would add some overhead. In order for the following to work:
let g ~x ~y = x + truncate y;;
foobar g (* rejected *)
the compiler would have to create an extra closure. Instead you are required to do it yourself, as follows:
let g ~x ~y = x + truncate y;;
foobar (fun ~y ~x -> g ~x ~y)
In general, the OCaml compiler is very straightforward and won't perform this kind of hard-to-guess code insertion for you.
(I'm not a type theorist either)
Think instead of the types x:int -> y:float -> int and y:float -> x:int -> int. I claim these are not the same type because you can call them without labels if you like. When you do this, the first requires an int as its first parameter and a float as the second. The second type requires them in the reverse order.
# let f ~x ~y = x + int_of_float y;;
val f : x:int -> y:float -> int = <fun>
# f 3 2.5;;
- : int = 5
# f 2.5 3;;
Error: This expression has type float but an expression was
expected of type intÂ
Another complication is that functions can have some labelled and some unlabelled parameters.
As a result, the labeled parameters of a function are treated as a sequence (in a particular order) rather than a set (without an inherent order).
Possibly if you required all parameters to be labelled and removed the capability of calling without labels, you could make things work the way you expect.
(Disclaimer: I'm not a type theorist, though I wish I was.)
This pitfall of labels in OCaml is described in detail in the Labels and type inference subsection of the OCaml manual, giving an example similar to yours.
If I remember correctly, some type systems for labels lift that restriction, but at the cost of additional overall complexity that was judged "not worth it" for the OCaml language itself. Labels can be rearranged automatically at first-order application sites, but not when abstracting over labelled functions (or using such abstractions).
You can have your example accepted by manually eta-expanding the labelled function to make a reorderable application appear (a type-theorist would say this is a retyping eta-conversion):
# let f ~x ~y = x+y;;
val f : x:int -> y:int -> int = <fun>
# let yx f = f ~y:0 ~x:1;;
val yx : (y:int -> x:int -> 'a) -> 'a = <fun>
# yx f;;
Error: This expression has type x:int -> y:int -> int
but an expression was expected of type y:int -> x:int -> 'a
# yx (fun ~y ~x -> f ~y ~x);;
- : int = 1