I have this code:
type Sym = (string * float) list
let rec lookup v = function
| (v', k) :: vtab -> if v = v' then k else lookup v vtab
| (_ : Sym) -> failwith ("unbound: " + v)
To me, it looks like that lookup takes one argument v. But then we do lookup v vtab - now it seems like two arguments are being passed to lookup? How can this be valid when lookup only takes one argument?
It does take two parameters. The first one is v, the second one comes from function.
In F# function is syntactic sugar for match. More specifically, the word function means fun x -> match x with.
So you can read your code as:
let rec lookup v = fun x -> match x with
| (v', k) :: vtab -> if v = v' then k else lookup v vtab
| (_ : Sym) -> failwith ("unbound: " + v)
Which in turn is the same as:
let rec lookup v x = match x with
| (v', k) :: vtab -> if v = v' then k else lookup v vtab
| (_ : Sym) -> failwith ("unbound: " + v)
Related
I like using ROP when I have to deal with IO/Parsing strings/...
However let's say that I have a function taking 2 parameters. How can you do clean/readable partial application when your 2 parameters are already a Result<'a,'b> (not necessary same 'a, 'b)?
For now, what I do is that I use tuple to pass parameters and use the function below to get a Result of a tuple so I can then bind my function with this "tuple-parameter".
/// Transform a tuple of Result in a Result of tuple
let tupleAllResult x =
match (fst x, snd x) with
| Result.Ok a, Result.Ok b -> (a,b) |> Result.Ok
| Result.Ok a, Result.Error b -> b |> Result.Error
| Result.Error a, _ -> a |> Result.Error
let f (a: 'T, b: 'U) = // something
(A, B) |> tupleAllResult
|> (Result.bind f)
Any good idea?
Here what I wrote, which works but might not be the most elegant
let resultFunc (f: Result<('a -> Result<'b, 'c>), 'd>) a =
match f with
| Result.Ok g -> (g a) |> Result.Ok |> Result.flatten
| Result.Error e -> e |> Result.Error |> Result.flatten
I am not seeing partial application in your example, a concept related to currying and argument passing -- that's why I am assuming that you are after the monadic apply, in that you want to transform a function wrapped as a Result value into a function that takes a Result and returns another Result.
let (.>>.) aR bR = // This is "tupleAllResult" under a different name
match aR, bR with
| Ok a, Ok b -> Ok(a, b)
| Error e, _ | _, Error e -> Error e
// val ( .>>. ) : aR:Result<'a,'b> -> bR:Result<'c,'b> -> Result<('a * 'c),'b>
let (<*>) fR xR = // This is another name for "apply"
(fR .>>. xR) |> Result.map (fun (f, x) -> f x)
// val ( <*> ) : fR:Result<('a -> 'b),'c> -> xR:Result<'a,'c> -> Result<'b,'c>
The difference to what you have in your question is map instead of bind in the last line.
Now you can start to lift functions into the Result world:
let lift2 f xR yR =
Ok f <*> xR <*> yR
// val lift2 :
// f:('a -> 'b -> 'c) -> xR:Result<'a,'d> -> yR:Result<'b,'d> -> Result<'c,'d>
let res : Result<_,unit> = lift2 (+) (Ok 1) (Ok 2)
// val res : Result<int,unit> = Ok 3
I am trying to express the Church encoding of the Free monad in F#. Free is specialized to a particular functor, Effect.
I am able to write both return_ : 'T -> Free<'T> and bind: ('T -> Free<'U>) -> Free<'T> -> Free<'U> without any problems.
A sketch of my implementation is given below.
type Effect<'T>
= GetStr of (string -> 'T)
| PutStr of string * 'T
module Effect =
let map (f: 'a -> 'b) : Effect<'a> -> Effect<'b> = function
| GetStr k ->
GetStr(f << k)
| PutStr (s,t) ->
PutStr(s, f t)
type Free<'T> =
abstract Apply : ('T -> 'R) -> (Effect<'R> -> 'R) -> 'R
module Free =
let inline runFree (f:Free<'T>) (kp: 'T -> 'R) (kf: Effect<'R> -> 'R) : 'R =
f.Apply kp kf
let return_ (x: 'a) : Free<'a> =
{ new Free<'a>
with
member __.Apply kp _ =
kp x
}
let bind (f: 'a -> Free<'b>) (m: Free<'a>) : Free<'b> =
{ new Free<'b>
with
member __.Apply kp kf =
runFree m
(fun a ->
runFree (f a) kp kf
)
kf
}
When I try to write an interpreter for this encoding, I hit a problem.
Given the following code:
module Interpret =
let interpretEffect = function
| GetStr k ->
let s = System.Console.ReadLine()
(k s , String.length s)
| PutStr(s,t) ->
do System.Console.WriteLine s
(t , 0)
let rec interpret (f: Free<string * int>) =
Free.runFree
f
(fun (str,len) -> (str,len))
(fun (a: Effect<Free<string*int>>) ->
let (b,n) = interpretEffect a
let (c,n') = interpret b
(c, n + n')
)
I get a type error in the third argument to Free.runFree within the interpret function:
...
(fun (a: Effect<Free<string*int>>) ->
^^^^^^^^^^^^^^^^^^ ------ Expecting a Effect<string * int> but given a Effect<Free<string*int>>
I understand why this is happening (the result type of the first function determines 'R === string*int) and suspect that can be solved using a rank-2 function (which can be encoded in F# e.g. http://eiriktsarpalis.github.io/typeshape/#/33) but I am not sure how to apply it.
Any pointers would be much appreciated.
Michael
You do not need to do anything there, the compiler suggested type is in fact correct (and in line with the type of runFree).
It seems that what you're thinking of there is Scott encoding (ripped from this Haskell question):
runFree :: Functor f => (a -> r) -> (f (F f a) -> r) -> F f a -> r
where F f a would be your Effect-specialised Free<'a>, and f (F f a) would be Effect<Free<'a>>, which is what you're trying to use.
Whereas Church encoding would be:
runFree :: Functor f => (a -> r) -> (f r -> r) -> F f a -> r
where f r is Effect<'a> - thus making it easier to express in F# (which is why I assume you're using it in the first place.
This is what I had for interpret:
let rec interpret (f: Free<string * int>) =
Free.runFree
f
(fun (str,len) -> (str,len))
(fun (a: Effect<_>) ->
let (b,n) = interpretEffect a
let (c,n') = interpret (Free.pureF b)
(c, n + n')
)
where pureF is
let pureF (x: 'a) : Free<'a> =
{ new Free<'a> with member __.Apply kp _ = kp x }
i.e. your return_ function.
I think defining the corresponding freeF function would clear some things (like why is Effect<'a> a functor - you're not making use of this fact anywhere in the code you pasted).
I have a sequence of value that I would like to apply to a function partially :
let f a b c d e= a+b+c+d+e
let items = [1,2,3,4,5]
let result = applyPartially f items
Assert.Equal(15, result)
I am looking after the applyPartially function. I have tried writing recursive functions like this :
let rec applyPartially f items =
| [] -> f
| [x] -> f x
| head :: tail -> applyPartially (f head) tail
The problem I have encountered is that the f type is at the beginning of my iteration 'a->'b->'c->'d->'e, and for every loop it should consume an order.
'a->'b->'c->'d->'e
'b->'c->'d->'e
'c->'d->'e
'd->'e
That means that the lower interface I can think of would be 'd->'e. How could I hide the complexity of my function so that only 'd->'e is shown in the recursive function?
The F# type system does not have a nice way of working with ordinary functions in a way you are suggesting - to do this, you'd need to make sure that the length of the list matches the number of arguments of the function, which is not possible with ordinary lists and functions.
However, you can model this nicely using a discriminated union. You can define a partial function, which has either completed, or needs one more input:
type PartialFunction<'T, 'R> =
| Completed of 'R
| NeedsMore of ('T -> PartialFunction<'T, 'R>)
Your function f can now be written (with a slightly ugly syntax) as a PartialFunction<int, int> that keeps taking 5 inputs and then returns the result:
let f =
NeedsMore(fun a -> NeedsMore(fun b ->
NeedsMore(fun c -> NeedsMore(fun d ->
NeedsMore(fun e -> Completed(a+b+c+d+e))))))
Now you can implement applyPartially by deconstructing the list of arguments and applying them one by one to the partial function until you get the result:
let rec applyPartially f items =
match f, items with
| Completed r, _ -> r
| NeedsMore f, head::tail -> applyPartially (f head) tail
| NeedsMore _, _ -> failwith "Insufficient number of arguments"
The following now returns 15 as expected:
applyPartially f [1;2;3;4;5]
Disclaimer: Please don't use this. This is just plain evil.
let apply f v =
let args = v |> Seq.toArray
f.GetType().GetMethods()
|> Array.tryFind (fun m -> m.Name = "Invoke" && Array.length (m.GetParameters()) = Array.length args)
|> function None -> failwith "Not enough args" | Some(m) -> m.Invoke(f, args)
Just like you would expect:
let f a b c d e= a+b+c+d+e
apply f [1; 2; 3; 4; 5] //15
I have a code which works fine:
let rec calculate s l acc =
if length s = 0 then
acc
else
if first s = l then
calculate (rest s) l (acc+1)
else
calculate (rest s) (first s) acc
I want to rewrite it using pattern matching:
let rec calculate s l acc =
function
| _, _, _ when length s = 0 -> acc
| _, _, _ when first s = l -> calculate (rest s) l (acc+1)
| _, _, _ -> calculate (rest s) (first s) acc
But last function returns the error message:
| _, _, _ when first s = l -> calculate (rest s) l (acc+1) -----------------------------------^^^^^^^^^^^^^^^^^^^^^^^^^^^^
/Users/demas/temporary/stdin(512,36): error FS0001: Type mismatch.
Expecting a
'a but given a
'b * 'c * 'd -> 'a The resulting type would be infinite when unifying ''a' and ''b * 'c * 'd -> 'a'
Why ?
Keyword function implies that the last (implicit) parameter of the function calculate should be tuple containing 3 elements because you are matching on _, _, _
You could rewrite it as:
let rec calculate s l acc =
match s, l, acc with
| _, _, _ when length s = 0 -> acc
| _, _, _ when first s = l -> calculate (rest s) l (acc+1)
| _, _, _ -> calculate (rest s) (first s) acc
Also you could make pattern matching more clear rewriting it like:
let rec calculate s l acc =
match (length s), (first s = l) with
| 0, _ -> acc
| _, true -> calculate (rest s) l (acc+1)
| _, _ -> calculate (rest s) (first s) acc
Disclosure: this came up in FsCheck, an F# random testing framework I maintain. I have a solution, but I do not like it. Moreover, I do not understand the problem - it was merely circumvented.
A fairly standard implementation of (monadic, if we're going to use big words) sequence is:
let sequence l =
let k m m' = gen { let! x = m
let! xs = m'
return (x::xs) }
List.foldBack k l (gen { return [] })
Where gen can be replaced by a computation builder of choice. Unfortunately, that implementation consumes stack space, and so eventually stack overflows if the list is long enough.The question is: why? I know in principle foldBack is not tail recursive, but the clever bunnies of the F# team have circumvented that in the foldBack implementation. Is there a problem in the computation builder implementation?
If I change the implementation to the below, everything is fine:
let sequence l =
let rec go gs acc size r0 =
match gs with
| [] -> List.rev acc
| (Gen g)::gs' ->
let r1,r2 = split r0
let y = g size r1
go gs' (y::acc) size r2
Gen(fun n r -> go l [] n r)
For completeness, the Gen type and computation builder can be found in the FsCheck source
Building on Tomas's answer, let's define two modules:
module Kurt =
type Gen<'a> = Gen of (int -> 'a)
let unit x = Gen (fun _ -> x)
let bind k (Gen m) =
Gen (fun n ->
let (Gen m') = k (m n)
m' n)
type GenBuilder() =
member x.Return(v) = unit v
member x.Bind(v,f) = bind f v
let gen = GenBuilder()
module Tomas =
type Gen<'a> = Gen of (int -> ('a -> unit) -> unit)
let unit x = Gen (fun _ f -> f x)
let bind k (Gen m) =
Gen (fun n f ->
m n (fun r ->
let (Gen m') = k r
m' n f))
type GenBuilder() =
member x.Return v = unit v
member x.Bind(v,f) = bind f v
let gen = GenBuilder()
To simplify things a bit, let's rewrite your original sequence function as
let rec sequence = function
| [] -> gen { return [] }
| m::ms -> gen {
let! x = m
let! xs = sequence ms
return x::xs }
Now, sequence [for i in 1 .. 100000 -> unit i] will run to completion regardless of whether sequence is defined in terms of Kurt.gen or Tomas.gen. The issue is not that sequence causes a stack overflow when using your definitions, it's that the function returned from the call to sequence causes a stack overflow when it is called.
To see why this is so, let's expand the definition of sequence in terms of the underlying monadic operations:
let rec sequence = function
| [] -> unit []
| m::ms ->
bind (fun x -> bind (fun xs -> unit (x::xs)) (sequence ms)) m
Inlining the Kurt.unit and Kurt.bind values and simplifying like crazy, we get
let rec sequence = function
| [] -> Kurt.Gen(fun _ -> [])
| (Kurt.Gen m)::ms ->
Kurt.Gen(fun n ->
let (Kurt.Gen ms') = sequence ms
(m n)::(ms' n))
Now it's hopefully clear why calling let (Kurt.Gen f) = sequence [for i in 1 .. 1000000 -> unit i] in f 0 overflows the stack: f requires a non-tail-recursive call to sequence and evaluation of the resulting function, so there will be one stack frame for each recursive call.
Inlining Tomas.unit and Tomas.bind into the definition of sequence instead, we get the following simplified version:
let rec sequence = function
| [] -> Tomas.Gen (fun _ f -> f [])
| (Tomas.Gen m)::ms ->
Tomas.Gen(fun n f ->
m n (fun r ->
let (Tomas.Gen ms') = sequence ms
ms' n (fun rs -> f (r::rs))))
Reasoning about this variant is tricky. You can empirically verify that it won't blow the stack for some arbitrarily large inputs (as Tomas shows in his answer), and you can step through the evaluation to convince yourself of this fact. However, the stack consumption depends on the Gen instances in the list that's passed in, and it is possible to blow the stack for inputs that aren't themselves tail recursive:
// ok
let (Tomas.Gen f) = sequence [for i in 1 .. 1000000 -> unit i]
f 0 (fun list -> printfn "%i" list.Length)
// not ok...
let (Tomas.Gen f) = sequence [for i in 1 .. 1000000 -> Gen(fun _ f -> f i; printfn "%i" i)]
f 0 (fun list -> printfn "%i" list.Length)
You're correct - the reason why you're getting a stack overflow is that the bind operation of the monad needs to be tail-recursive (because it is used to aggregate values during folding).
The monad used in FsCheck is essentially a state monad (it keeps the current generator and some number). I simplified it a bit and got something like:
type Gen<'a> = Gen of (int -> 'a)
let unit x = Gen (fun n -> x)
let bind k (Gen m) =
Gen (fun n ->
let (Gen m') = k (m n)
m' n)
Here, the bind function is not tail-recursive because it calls k and then does some more work. You can change the monad to be a continuation monad. It is implemented as a function that takes the state and a continuation - a function that is called with the result as an argument. For this monad, you can make bind tail recursive:
type Gen<'a> = Gen of (int -> ('a -> unit) -> unit)
let unit x = Gen (fun n f -> f x)
let bind k (Gen m) =
Gen (fun n f ->
m n (fun r ->
let (Gen m') = k r
m' n f))
The following example will not stack overflow (and it did with the original implementation):
let sequence l =
let k m m' =
m |> bind (fun x ->
m' |> bind (fun xs ->
unit (x::xs)))
List.foldBack k l (unit [])
let (Gen f) = sequence [ for i in 1 .. 100000 -> unit i ]
f 0 (fun list -> printfn "%d" list.Length)