How do I write a function that can compose `FnMut` closures? - closures

Here's a compose function that can compose Fn closures:
fn compose<'a, T1, T2, T3, F1, F2>(f: F1, g: F2) -> Box<Fn(T1) -> T3 + 'a>
where F1: Fn(T1) -> T2 + 'a,
F2: Fn(T2) -> T3 + 'a
{
box move |x| g(f(x))
}
How do I make it so that this compose function can take FnMut closures? I tried:
fn compose<'a, T1, T2, T3, F1, F2>(f: F1, g: F2) -> Box<FnMut(T1) -> T3 + 'a>
where F1: FnMut(T1) -> T2 + 'a,
F2: FnMut(T2) -> T3 + 'a
{
box move |x| g(f(x))
}
But it complains about:
error: cannot borrow captured outer variable in an `FnMut` closure as mutable
box move |x| g(f(x))
^
error: cannot borrow captured outer variable in an `FnMut` closure as mutable
box move |x| g(f(x))
^
Extending this, can it be made to work with FnOnce closures?


Local variables f and g must be mutable:
fn compose<'a, T1, T2, T3, F1, F2>(mut f: F1, mut g: F2) -> Box<FnMut(T1) -> T3 + 'a>
where F1: FnMut(T1) -> T2 + 'a,
F2: FnMut(T2) -> T3 + 'a
{
Box::new(move |x| g(f(x)))
}

Related

Calling one-parameter function with two arguments?

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)

Railway Oriented Programming and partial application

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

Purescript Union of Rows

I've been trying to develop a component system in Purescript, using a Component typeclass which specifies an eval function. The eval function for can be recursively called by a component for each sub-component of the component, in essence fetching the input's values.
As components may wish to use run-time values, a record is also passed into eval. My goal is for the rows in the Record argument of the top-level eval to be required to include all the rows of every sub-component. This is not too difficult for components which do not use any rows themselves, but their single sub-component does, as we can simply pass along the sub-components rows to the component's. This is shown in evalIncrement.
import Prelude ((+), one)
import Data.Symbol (class IsSymbol, SProxy(..))
import Record (get)
import Prim.Row (class Cons, class Union)
class Component a b c | a -> b where
eval :: a -> Record c -> b
data Const a = Const a
instance evalConst :: Component (Const a) a r where
eval (Const v) r = v
data Var (a::Symbol) (b::Type) = Var
instance evalVar ::
( IsSymbol a
, Cons a b r' r) => Component (Var a b) b r where
eval _ r = get (SProxy :: SProxy a) r
data Inc a = Inc a
instance evalInc ::
( Component a Int r
) => Component (Inc a) Int r where
eval (Inc a) r = (eval a r) + one
All of the above code works correctly. However, once I try to introduce a component which takes multiple input components and merges their rows, I cannot seem to get it to work. For example, when trying to use the class Union from Prim.Row:
data Add a b = Add a b
instance evalAdd ::
( Component a Int r1
, Component b Int r2
, Union r1 r2 r3
) => Component (Add a b) Int r3 where
eval (Add a b) r = (eval a r) + (eval b r)
The following error is produced:
No type class instance was found for
Processor.Component a3
Int
r35
while applying a function eval
of type Component t0 t1 t2 => t0 -> { | t2 } -> t1
to argument a
while inferring the type of eval a
in value declaration evalAdd
where a3 is a rigid type variable
r35 is a rigid type variable
t0 is an unknown type
t1 is an unknown type
t2 is an unknown type
In fact, even modifying the evalInc instance to use a dummy Union with an empty row produces a similar error, like so:
instance evalInc :: (Component a Int r, Union r () r1)
=> Component (Increment a) Int r1 where
Am I using Union incorrectly? Or do I need further functional dependencies for my class - I do not understand them very well.
I am using purs version 0.12.0

r ∷ r3 but it is being used where an r1 and r2 are required, so there is a type mismatch. A record {a ∷ A, b ∷ B} cannot be given where {a ∷ A} or {b ∷ B} or {} is expected. However, one can say this:
f ∷ ∀ s r. Row.Cons "a" A s r ⇒ Record r → A
f {a} = a
In words, f is a function polymorphic on any record containing a label "a" with type A. Similarly, you could change eval to:
eval ∷ ∀ s r. Row.Union c s r ⇒ a → Record r → b
In words, eval is polymorphic on any record which contains at least the fields of c. This introduces a type ambiguity which you will have to resolve with a proxy.
eval ∷ ∀ proxy s r. Row.Union c s r ⇒ proxy c → a → Record r → b
The eval instance of Add becomes:
instance evalAdd ∷
( Component a Int r1
, Component b Int r2
, Union r1 s1 r3
, Union r2 s2 r3
) => Component (Add a b) Int r3 where
eval _ (Add a b) r = eval (RProxy ∷ RProxy r1) a r + eval (RProxy ∷ RProxy r2) b r
From here, r1 and r2 become ambiguous because they're not determined from r3 alone. With the given constraints, s1 and s2 would also have to be known. Possibly there is a functional dependency you could add. I am not sure what is appropriate because I am not sure what the objectives are of the program you are designing.

As the instance for Var is already polymorphic (or technically open?) due to the use of Row.Cons, ie
eval (Var :: Var "a" Int) :: forall r. { "a" :: Int | r } -> Int
Then all we have to is use the same record for the left and right evaluation, and the type system can infer the combination of the two without requiring a union:
instance evalAdd ::
( Component a Int r
, Component b Int r
) => Component (Add a b) Int r where
eval (Add a b) r = (eval a r) + (eval b r)
This is more obvious when not using typeclasses:
> f r = r.foo :: Int
> g r = r.bar :: Int
> :t f
forall r. { foo :: Int | r } -> Int
> :t g
forall r. { bar :: Int | r } -> Int
> fg r = (f r) + (g r)
> :t fg
forall r. { foo :: Int, bar :: Int | r } -> Int
I think the downside to this approach compared to #erisco's is that the open row must be in the definition of instances like Var, rather than in the definition of eval? It is also not enforced, so if a Component doesn't use open rows then a combinator such as Add no longer works.
The benefit is the lack of the requirement for the RProxies, unless they are not actually needed for eriscos implementation, I haven't checked.
Update:
I worked out a way of requiring eval instances to be closed, but it makes it quite ugly, making use of pick from purescript-record-extra.
I'm not really sure why this would be better over the above option, feels like I'm just re-implementing row polymorphism
import Record.Extra (pick, class Keys)
...
instance evalVar ::
( IsSymbol a
, Row.Cons a b () r
) => Component (Var a b) b r where
eval _ r = R.get (SProxy :: SProxy a) r
data Add a b = Add a b
evalp :: forall c b r r_sub r_sub_rl trash
. Component c b r_sub
=> Row.Union r_sub trash r
=> RL.RowToList r_sub r_sub_rl
=> Keys r_sub_rl
=> c -> Record r -> b
evalp c r = eval c (pick r)
instance evalAdd ::
( Component a Int r_a
, Component b Int r_b
, Row.Union r_a r_b r
, Row.Nub r r_nub
, Row.Union r_a trash_a r_nub
, Row.Union r_b trash_b r_nub
, RL.RowToList r_a r_a_rl
, RL.RowToList r_b r_b_rl
, Keys r_a_rl
, Keys r_b_rl
) => Component (Add a b) Int r_nub where
eval (Add a b) r = (evalp a r) + (evalp b r)
eval (Add (Var :: Var "a" Int) (Var :: Var "b" Int) ) :: { a :: Int , b :: Int } -> Int
eval (Add (Var :: Var "a" Int) (Var :: Var "a" Int) ) :: { a :: Int } -> Int

(How) can I make this monadic bind tail-recursive?

I have this monad called Desync -
[<AutoOpen>]
module DesyncModule =
/// The Desync monad. Allows the user to define in a sequential style an operation that spans
/// across a bounded number of events. Span is bounded because I've yet to figure out how to
/// make Desync implementation tail-recursive (see note about unbounded recursion in bind). And
/// frankly, I'm not sure if there is a tail-recursive implementation of it...
type [<NoComparison; NoEquality>] Desync<'e, 's, 'a> =
Desync of ('s -> 's * Either<'e -> Desync<'e, 's, 'a>, 'a>)
/// Monadic return for the Desync monad.
let internal returnM (a : 'a) : Desync<'e, 's, 'a> =
Desync (fun s -> (s, Right a))
/// Monadic bind for the Desync monad.
let rec internal bind (m : Desync<'e, 's, 'a>) (cont : 'a -> Desync<'e, 's, 'b>) : Desync<'e, 's, 'b> =
Desync (fun s ->
match (match m with Desync f -> f s) with
// ^--- NOTE: unbounded recursion here
| (s', Left m') -> (s', Left (fun e -> bind (m' e) cont))
| (s', Right v) -> match cont v with Desync f -> f s')
/// Builds the Desync monad.
type DesyncBuilder () =
member this.Return op = returnM op
member this.Bind (m, cont) = bind m cont
/// The Desync builder.
let desync = DesyncBuilder ()
It allows the implementation of game logic that executes across several game ticks to written in a seemingly sequential style using computation expressions.
Unfortunately, when used for tasks that last for an unbounded number of game ticks, it crashes with StackOverflowException. And even when it's not crashing, it's ending up with unwieldy stack traces like this -
InfinityRpg.exe!InfinityRpg.GameplayDispatcherModule.desync#525-20.Invoke(Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen> _arg10) Line 530 F#
Prime.exe!Prime.DesyncModule.bind#20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>>.Invoke(Nu.SimulationModule.World s) Line 24 F#
Prime.exe!Prime.DesyncModule.bind#20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21 F#
Prime.exe!Prime.DesyncModule.bind#20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21 F#
Prime.exe!Prime.DesyncModule.bind#20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21 F#
Prime.exe!Prime.DesyncModule.bind#20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21 F#
Prime.exe!Prime.DesyncModule.bind#20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21 F#
Prime.exe!Prime.DesyncModule.bind#20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21 F#
Prime.exe!Prime.DesyncModule.bind#20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21 F#
Prime.exe!Prime.Desync.step<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit>(Prime.DesyncModule.Desync<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit> m, Nu.SimulationModule.World s) Line 71 F#
Prime.exe!Prime.Desync.advanceDesync<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit>(Microsoft.FSharp.Core.FSharpFunc<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Prime.DesyncModule.Desync<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit>> m, Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen> e, Nu.SimulationModule.World s) Line 75 F#
Nu.exe!Nu.Desync.advance#98<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>.Invoke(Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen> event, Nu.SimulationModule.World world) Line 100 F#
Nu.exe!Nu.Desync.subscription#104-16<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>.Invoke(Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen> event, Nu.SimulationModule.World world) Line 105 F#
Nu.exe!Nu.World.boxableSubscription#165<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>.Invoke(object event, Nu.SimulationModule.World world) Line 166 F#
I am hoping to solve the problem by making the Left case of the bind function tail-recursive. However, I'm not sure of two things -
1) if it can be done at all, and
2) how it would actually be done.
If it's impossible to make bind tail-recursive here, is there some way to restructure my monad to allow it to become tail-recursive?
EDIT 3 (subsumes previous edits): Here is additional code that implements the desync combinators I will use to demonstrate the stack overflow -
module Desync =
/// Get the state.
let get : Desync<'e, 's, 's> =
Desync (fun s -> (s, Right s))
/// Set the state.
let set s : Desync<'e, 's, unit> =
Desync (fun _ -> (s, Right ()))
/// Loop in a desynchronous context while 'pred' evaluate to true.
let rec loop (i : 'i) (next : 'i -> 'i) (pred : 'i -> 's -> bool) (m : 'i -> Desync<'e, 's, unit>) =
desync {
let! s = get
do! if pred i s then
desync {
do! m i
let i = next i
do! loop i next pred m }
else returnM () }
/// Loop in a desynchronous context while 'pred' evaluates to true.
let during (pred : 's -> bool) (m : Desync<'e, 's, unit>) =
loop () id (fun _ -> pred) (fun _ -> m)
/// Step once into a desync.
let step (m : Desync<'e, 's, 'a>) (s : 's) : 's * Either<'e -> Desync<'e, 's, 'a>, 'a> =
match m with Desync f -> f s
/// Run a desync to its end, providing e for all its steps.
let rec runDesync (m : Desync<'e, 's, 'a>) (e : 'e) (s : 's) : ('s * 'a) =
match step m s with
| (s', Left m') -> runDesync (m' e) e s'
| (s', Right v) -> (s', v)
Here is the Either implementation -
[<AutoOpen>]
module EitherModule =
/// Haskell-style Either type.
type Either<'l, 'r> =
| Right of 'r
| Left of 'l
And finally, here's simple a line of code that will yield a stack overflow -
open Desync
ignore <| runDesync (desync { do! during (fun _ -> true) (returnM ()) }) () ()

It seems to me your monad is a State with error handling.
It's basically ErrorT< State<'s,Either<'e,'a>>> but the error branch binds again which is not very clear to me why.
Anyway I was able to reproduce your Stack Overflow with a basic State monad:
type State<'S,'A> = State of ('S->('A * 'S))
module State =
let run (State x) = x :'s->_
let get() = State (fun s -> (s , s)) :State<'s,_>
let put x = State (fun _ -> ((), x)) :State<'s,_>
let result a = State(fun s -> (a, s))
let bind (State m) k = State(fun s ->
let (a, s') = m s
let (State u) = (k a)
u s') :State<'s,'b>
type StateBuilder() =
member this.Return op = result op
member this.Bind (m, cont) = bind m cont
let state = StateBuilder()
let rec loop (i: 'i) (next: 'i -> 'i) (pred: 'i -> 's -> bool) (m: 'i -> State<'s, unit>) =
state {
let! s = get()
do! if pred i s then
state {
do! m i
let i = next i
do! loop i next pred m }
else result () }
let during (pred : 's -> bool) (m : State<'s, unit>) =
loop () id (fun _ -> pred) (fun _ -> m)
// test
open State
ignore <| run (state { do! during (fun c -> true) (result ()) }) () // boom
As stated in the comments one way to solve this is to use a StateT<'s,Cont<'r,'a>>.
Here's an example of the solution. At the end there is a test with the zipIndex function which blows the stack as well when defined with a normal State monad.
Note you don't need to use the Monad Transformers from FsControl (now FSharpPlus), I use them because it's easier for me since I write less code but you can always create your transformed monad by hand.

Array.map2 type inference on records

I ran into something with Array.map2 that I don't understand.
Consider this code:
type r1 = {
v1 : int
X : int
}
type r2 = {
v1 : int
Y : int
}
let a1 = [|{v1=1; X=1}; {v1=2; X=2}|] // val a1 : r1 [] ...
let a2 = [|{v1=100; Y=100}; {v1=200; Y=200}|] // val a2 : r2 [] ...
Array.map2 (fun x1 x2 -> (x1.X, x2.Y)) a1 a2 // works as expected
Array.map2 (fun x1 x2 -> (x1.v1, x2.v1)) a1 a2 // error FS0001: Type mismatch. Expecting a r2 [] but given a r1 []
Both records have a field v1. In the last line, I try to get a tuple of the values of v1, but from the different record types r1 and r2. It seems to throw an error when I try to select fields that have the same name on different records.
Somehow it jumps to the conclusion that x1 must be of type r2, why doesn't the second line infer the type from the two parameters a1 and a2?
edit
This fixes it but I would expect to get the type right from the parameters.
Array.map2 (fun (x1:r1) x2 -> (x1.v1, x2.v1)) a1 a2 // works

The type checker works from left to right, so there isn't enough information to resolve conflicts in the second example. Your first example is fine because .X and .Y are unique fields on r1 and r2 respectively.
That said, in this case you could use piping to make types of a1 and a2 available to the type checker prior accessing record fields:
(a1, a2) ||> Array.map2 (fun x1 x2 -> (x1.v1, x2.v1))
In general, you should use record patterns which contain unique fields to identify correct types:
Array.map2 (fun {v1 = a; X = _} {v1 = b; Y = _} -> (a, b)) a1 a2
or provide fully qualified field names:
Array.map2 (fun {r1.v1 = a} {r2.v1 = b} -> (a, b)) a1 a2

Resources