open Map
open Pretty
let d_doc () (x : doc) : doc = x
let d_str () = text
let d_map d_k d_v () m : doc =
printf "{%a}"
d_doc
(Map.fold (fun k v acc -> printf "%a, %a -> %a" d_doc acc d_k k d_v v) m (text ""))
tells me "Error: Unbound value Map.fold". How do I do this? (I'd like either a pointer to a reference that explains how to use Map functions (or module functions in general), a standard library pretty printer for maps, and/or a fix for my code.)
I realize this post is old, but for the future visitor, the following works:
module IntMap = Map.Make(Int)
type map = string IntMap.t
let pp_map ppf (m : map) =
IntMap.iter (fun k v -> Format.fprintf ppf "%d -> %s#\n" k v) m
let _ =
IntMap.empty
|> IntMap.add 4 "hello"
|> IntMap.add 2 "world"
|> Format.printf "%a" pp_map
You can print out a map using sexplib quite conveniently. Here's how you'd do it using Core.
open Core.Std
let map = Int.Map.of_alist_exn [1,"one"; 2,"two"; 3,"three"]
let () =
(<:sexp_of<string Int.Map.t>> map)
|> Sexp.to_string_hum
|> print_endline
Related
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()
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 implement a parser that looks something like this:
open System
type ParseResult<'a> =
{
Result : Option<'a>;
Rest : string
}
let Fail = fun input -> { Result = None; Rest = input }
let Return a = fun input -> { Result = Some a; Rest = input }
let ThenBind p f =
fun input ->
let r = p input
match r.Result with
| None -> { Result = None; Rest = input } // Recreate the result since p returns a ParseResult<'a>
| _ -> (f r.Result) r.Rest
let Then p1 p2 = ThenBind p1 (fun r -> p2)
let Or p1 p2 =
fun input ->
let r = p1 input
match r.Result with
| None -> p2 input
| _ -> r
let rec Chainl1Helper a p op =
Or
<| ThenBind op (fun f ->
ThenBind p (fun y ->
Chainl1Helper (f.Value a y.Value) p op))
<| Return a
let Chainl1 p op = ThenBind p (fun x -> Chainl1Helper x.Value p op)
let rec Chainr1 p op =
ThenBind p (fun x ->
Or
(ThenBind op (fun f ->
ThenBind (Chainr1 p op) (fun y ->
Return (f.Value x.Value y.Value))))
(Return x.Value))
let Next = fun input ->
match input with
| null -> { Result = None; Rest = input }
| "" -> { Result = None; Rest = input }
| _ -> { Result = Some <| char input.[0..1]; Rest = input.[1..] }
let Sat predicate = ThenBind Next (fun n -> if predicate n.Value then Return n.Value else Fail)
let Digit = ThenBind (Sat Char.IsDigit) (fun c -> Return <| float c.Value)
let rec NatHelper i =
Or
(ThenBind Digit (fun x ->
NatHelper (float 10 * i + x.Value) ))
(Return i)
let Nat = ThenBind Digit (fun d -> NatHelper d.Value)
let LiteralChar c = Sat (fun x -> x = c)
let rec Literal input token =
match input with
| "" -> Return token
| _ -> Then (LiteralChar <| char input.[0..1]) (Literal input.[1..] token)
let AddSub =
Or
<| ThenBind (LiteralChar '+') (fun c -> Return (+))
<| ThenBind (LiteralChar '-') (fun c -> Return (-))
let MulDiv =
Or
<| ThenBind (LiteralChar '*') (fun c -> Return (*))
<| ThenBind (LiteralChar '/') (fun c -> Return (/))
let Exp = ThenBind (LiteralChar '^') (fun c -> Return ( ** ))
let rec Expression = Chainl1 Term AddSub
and Term = Chainl1 Factor MulDiv
and Factor = Chainr1 Part Exp
and Part = Or Nat Paren
and Paren =
Then
<| LiteralChar '('
<| ThenBind Expression (fun e ->
Then (LiteralChar ')') (Return e.Value))
The last functions are mutually recursive in their definitions. Expression's definition depends on Term, which depends on Factor, which depends on Part, which depends on Paren, which depends on Expression.
When I try to compile this, I get an error about mutually recursive definitions with the suggestion to make Expression lazy or a function. I tried both of those, and I get a cryptic InvalidOperationException with both that says something about ValueFactory attempting to access the Value property.
In general, F# lets you use let rec .. and .. not just for defining mutually recursive functions, but also for defining mutually recursive values. This means that you might be able to write something like this:
let rec Expression = Chainl1 Term AddSub
and Paren =
Then
<| LiteralChar '('
<| ThenBind Expression (fun e ->
Then (LiteralChar ')') (Return e.Value))
and Part = Or Nat Paren
and Factor = Chainr1 Part Exp
and Term = Chainl1 Factor MulDiv
However, this only works if the computation is not evaluated immediately (because then the recursive definition would not make sense). This very much depends on the library you're using here (or on the rest of your code). But you can try the above and see if that works - if no, you'll need to provide more details.
EDIT In the updated example, there is an immediate loop in your recursive definition. You need to delay some part of the definition using fun _ -> ... so that not everything needs to be evaluated at once. In your example, you can do that by replacing Then with ThenBind in the definition of Paren:
let rec Expression = Chainl1 Term AddSub
and Term = Chainl1 Factor MulDiv
and Factor = Chainr1 Part Exp
and Part = Or Nat Paren
and Paren =
ThenBind
(LiteralChar '(')
(fun _ -> ThenBind Expression (fun e ->
Then (LiteralChar ')') (Return e.Value)))
I am trying to follow this example (from p137 of Rob Pickering's "Foundations of F#" book) but I can't get it to work with the latest F# CTP.
I appear to be missing the definition of 'Value' on the 3rd line where it does
Value.GetInfo(x)
This generates :
error FS0039: The namespace or module 'Value' is not defined.
Can anyone tell me where this is coming from or what the new syntax is if this is now done differently? (be gentle - this is my first play with F#)
Here's the example I am working from:-
#light
open Microsoft.FSharp.Reflection
let printTupleValues x =
match Value.GetInfo(x) with
| TupleValue vals ->
print_string "("
vals
|> List.iteri
(fun i v ->
if i <> List.length vals - 1 then
Printf.printf " %s, " (any_to_string v)
else
print_any v)
print_string " )"
| _ -> print_string "not a tuple"
printTupleValues ("hello world", 1)
The F# reflection library was rewritten for either Beta 1 or the CTP. Here is your code slightly changed to use the new library, and to avoid using the F# PlusPack (print_string is for OCaml compatibility).
open Microsoft.FSharp.Reflection
let printTupleValues x =
if FSharpType.IsTuple( x.GetType() ) then
let s =
FSharpValue.GetTupleFields( x )
|> Array.map (fun a -> a.ToString())
|> Array.reduce (fun a b -> sprintf "%s, %s" a b)
printfn "(%s)" s
else
printfn "not a tuple"
printTupleValues ("hello world", 1)
Or, if you prefer using match to decompose the tuple, then try this using an active pattern. Advantage is you can add support for additional types pretty easily.
open Microsoft.FSharp.Reflection
let (|ParseTuple|_|) = function
| o when FSharpType.IsTuple( o.GetType() ) ->
Some( FSharpValue.GetTupleFields(o) )
| _ -> None
let printTupleValues = function
| ParseTuple vals ->
let s =
vals
|> Array.map (fun a -> a.ToString())
|> Array.reduce (fun a b -> sprintf "%s, %s" a b)
printfn "(%s)" s
| _ ->
printf "not a tuple"
printTupleValues ("hello world", 1)
I don't know whether your function has been renamed or removed in the current F# versions.
You should take a look at FSharp.Reflection in your IDE's object explorer to check that and maybe read this page.