I'm trying to explore the dynamic capabilities of F# for situations where I can't express some function with the static type system. As such, I'm trying to create a mapN function for (say) Option types, but I'm having trouble creating a function with a dynamic number of arguments. I've tried:
let mapN<'output> (f : obj) args =
let rec mapN' (state:obj) (args' : (obj option) list) =
match args' with
| Some x :: xs -> mapN' ((state :?> obj -> obj) x) xs
| None _ :: _ -> None
| [] -> state :?> 'output option
mapN' f args
let toObjOption (x : #obj option) =
Option.map (fun x -> x :> obj) x
let a = Some 5
let b = Some "hi"
let c = Some true
let ans = mapN<string> (fun x y z -> sprintf "%i %s %A" x y z) [a |> toObjOption; b |> toObjOption; c |> toObjOption]
(which takes the function passed in and applies one argument at a time) which compiles, but then at runtime I get the following:
System.InvalidCastException: Unable to cast object of type 'ans#47' to type
'Microsoft.FSharp.Core.FSharpFunc`2[System.Object,System.Object]'.
I realize that it would be more idiomatic to either create a computation expression for options, or to define map2 through map5 or so, but I specifically want to explore the dynamic capabilities of F# to see whether something like this would be possible.
Is this just a concept that can't be done in F#, or is there an approach that I'm missing?
I think you would only be able to take that approach with reflection.
However, there are other ways to solve the overall problem without having to go dynamic or use the other static options you mentioned. You can get a lot of the same convenience using Option.apply, which you need to define yourself (or take from a library). This code is stolen and adapted from F# for fun and profit:
module Option =
let apply fOpt xOpt =
match fOpt,xOpt with
| Some f, Some x -> Some (f x)
| _ -> None
let resultOption =
let (<*>) = Option.apply
Some (fun x y z -> sprintf "%i %s %A" x y z)
<*> Some 5
<*> Some "hi"
<*> Some true
To explain why your approach does not work, the problem is that you cannot cast a function of type int -> int (represented as FSharpFunc<int, int>) to a value of type obj -> obj (represented as FSharpFunc<obj, obj>). The types are the same generic types, but the cast fails because the generic parameters are different.
If you insert a lot of boxing and unboxing, then your function actually works, but this is probably not something you want to write:
let ans = mapN<string> (fun (x:obj) -> box (fun (y:obj) -> box (fun (z:obj) ->
box (Some(sprintf "%i %s %A" (unbox x) (unbox y) (unbox z))))))
[a |> toObjOption; b |> toObjOption; c |> toObjOption]
If you wanted to explore more options possible thanks to dynamic hacks - then you can probably do more using F# reflection. I would not typically use this in production (simple is better - I'd just define multiple map functions by hand or something like that), but the following runs:
let rec mapN<'R> f args =
match args with
| [] -> unbox<'R> f
| x::xs ->
let m = f.GetType().GetMethods() |> Seq.find (fun m ->
m.Name = "Invoke" && m.GetParameters().Length = 1)
mapN<'R> (m.Invoke(f, [| x |])) xs
mapN<obj> (fun a b c -> sprintf "%d %s %A" a b c) [box 1; box "hi"; box true]
Related
type Interpreter<'a> =
| RegularInterpreter of (int -> 'a)
| StringInterpreter of (string -> 'a)
let add<'a> (x: 'a) (y: 'a) (in_: Interpreter<'a>): 'a =
match in_ with
| RegularInterpreter r ->
x+y |> r
| StringInterpreter r ->
sprintf "(%s + %s)" x y |> r
The error message of it not being able to resolve 'a at compile time is pretty clear to me. I am guessing that the answer to the question of whether it is possible to make the above work is no, short of adding functions directly into the datatype. But then I might as well use an interface, or get rid of generic parameters entirely.
Edit: Mark's reply does in fact do what I asked, but let me extend the question as I did not explain it adequately. What I am trying to do is do with the technique above is imitate what what was done in this post. The motivation for this is to avoid inlined functions as they have poor composability - they can't be passed as lambdas without having their generic arguments specialized.
I was hoping that I might be able to work around it by passing an union type with a generic argument into a closure, but...
type Interpreter<'a> =
| RegularInterpreter of (int -> 'a)
| StringInterpreter of (string -> 'a)
let val_ x in_ =
match in_ with
| RegularInterpreter r -> r x
| StringInterpreter r -> r (string x)
let inline add x y in_ =
match in_ with
| RegularInterpreter r ->
x in_ + y in_ |> r
| StringInterpreter r ->
sprintf "(%A + %A)" (x in_) (y in_) |> r
let inline mult x y in_ =
match in_ with
| RegularInterpreter r ->
x in_ * y in_ |> r
| StringInterpreter r ->
sprintf "(%A * %A)" (x in_) (y in_) |> r
let inline r2 in_ = add (val_ 1) (val_ 3) in_
r2 (RegularInterpreter id)
r2 (StringInterpreter id) // Type error.
This last line gives a type error. Is there a way around this? Though I'd prefer the functions to not be inlined due to the limits they place on composability.
Remove the type annotations:
let inline add x y in_ =
match in_ with
| RegularInterpreter r ->
x + y |> r
| StringInterpreter r ->
sprintf "(%A + %A)" x y |> r
You'll also need to make a few other changes, which I've also incorporated above:
Change the format specifiers used with sprintf to something more generic. When you use %s, you're saying that the argument for that placeholder must be a string, so the compiler would infer x and y to be string values.
Add the inline keyword.
With these changes, the inferred type of add is now:
x: ^a -> y: ^b -> in_:Interpreter<'c> -> 'c
when ( ^a or ^b) : (static member ( + ) : ^a * ^b -> int)
You'll notice that it works for any type where + is defined as turning the input arguments into int. In practice, that's probably going to mean only int itself, unless you define a custom operator.
FSI smoke tests:
> add 3 2 (RegularInterpreter id);;
val it : int = 5
> add 2 3 (StringInterpreter (fun _ -> 42));;
val it : int = 42
The compiler ends up defaulting to int, and the kind of polymorphism you want is difficult to achieve in F#. This article articulates the point.
Perhaps, you could work the dark arts using FSharp.Interop.Dynamic but you lose compile time checking which sort of defeats the point.
I've come to the conclusion that what I am trying to is impossible. I had a hunch that it was already, but the proof is in the following:
let vale (x,_,_) = x
let adde (_,x,_) = x
let multe (_,_,x) = x
let val_ x d =
let f = vale d
f x
let add x y d =
let f = adde d
f (x d) (y d)
let mult x y d =
let f = multe d
f (x d) (y d)
let in_1 =
let val_ (x: int) = x
let add x y = x+y
let mult x y = x*y
val_,add,mult
let in_2 =
let val_ (x: int) = string x
let add x y = sprintf "(%s + %s)" x y
let mult x y = sprintf "(%s * %s)" x y
val_,add,mult
let r2 d = add (val_ 1) (val_ 3) d
//let test x = x in_1, x in_2 // Type error.
let a2 = r2 in_1 // Works
let b2 = r2 in_2 // Works
The reasoning goes that if it cannot be done with plain functions passed as arguments, then it definitely won't be possible with interfaces, records, discriminated unions or any other scheme. The standard functions are more generic than any of the above, and if they cannot do it then this is a fundamental limitation of the language.
It is not the lack of HKTs that make the code ungeneric, but something as simple as this. In fact, going by the Finally Tagless paper linked to in the Reddit post, Haskell has the same problem with needing to duplicate interpreters without the impredicative types extension - though I've looked around and it seem that impredicative types will be removed in the future as the extension is difficult to maintain.
Nevertheless, I do hope this is only a current limitation of F#. If the language was dynamic, the code segment above would in fact run correctly.
Unfortunately, it's not completely clear to me what you're trying to do. However, it seems likely that it's possible by creating an interface with a generic method. For example, here's how you could get the code from your answer to work:
type I = abstract Apply : ((int -> 'a) * ('a -> 'a -> 'a) * ('a -> 'a -> 'a)) -> 'a
//let test x = x in_1, x in_2 // Type error.
let test (i:I) = i.Apply in_1, i.Apply in_2
let r2' = { new I with member __.Apply d = add (val_ 1) (val_ 3) d }
test r2' // no problem
If you want to use a value (e.g. a function input) generically, then in most cases the cleanest way is to create an interface with a generic method whose signature expresses the required polymorphism.
[<ReflectedDefinition>]
module Foo =
let x = 5
let y () = 6
let z a = a
I tried to find out how to get the AST in this situation a couple of times now and keep failing. Time to ask the question here.
So far, I thought that a module would be mappped to a class with static members internally and as such, it should be the equivalent of:
[<ReflectedDefinition>]
type Foo =
static member x = 5
static member y () = 6
static member z a = a
let bar_members =
typeof<Bar>.GetMethods()
|> Array.filter (fun mi -> match mi with | MethodWithReflectedDefinition x -> true | _ -> false)
|> Array.map (fun m -> sprintf "%s: %A" (m.Name) (Expr.TryGetReflectedDefinition(m :> MethodBase) ) )
In the latter case, I could use typeof<Foo>.GetMembers() (or GetMethods()?!), cast it to Reflection.MethodBase and use this as an argument for Expr.TryGetReflectedDefinition().
But unfortunately, this is not working with the module version.
So, how to do it?
If you want to play with the code, you might want to open some namespaces:
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.DerivedPatterns
open Microsoft.FSharp.Reflection
open System.Reflection
The problem comes go down to actually getting the type of the Module. In order to do that, there's a great answer here by Phillip Trelford: https://stackoverflow.com/a/14706890/5438433
Basically, you add a helper value to your module which returns the type of that module:
[<ReflectedDefinition>]
module Foo =
type internal IMarker = interface end
let fooType = typeof<IMarker>.DeclaringType
let x = 5
let y () = 6
let z a = a
You can then use fooType to retrieve the reflected definitions.
let foo_members =
Foo.fooType.GetMethods()
|> Array.filter (fun mi -> match mi with | MethodWithReflectedDefinition x -> true | _ -> false)
|> Array.map (fun m -> sprintf "%s: %A" (m.Name) (Expr.TryGetReflectedDefinition(m :> MethodBase) ) )
I can then, e.g. print the results:
[|"get_fooType: Some PropertyGet (Some (Call (None, TypeOf, [])), DeclaringType, [])";
"get_x: Some Value (5)";
"y: Some Lambda (unitVar0, Value (6))";
"z: Some Lambda (a, a)"|]
For the use case, when the reflected definitions are in another assembly (like an F# dll, for example), you can do without the marker interface trick, as shown below:
open System
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.DerivedPatterns
open Microsoft.FSharp.Reflection
open System.Reflection
open FSharp.Reflection.FSharpReflectionExtensions
let tryGetReflectedModules (a : Assembly) : seq<TypeInfo> =
a.DefinedTypes
|> Seq.filter
(fun dt ->
dt.CustomAttributes
|> Seq.map (fun cad -> cad.AttributeType)
|> Seq.filter ((=) (typeof<ReflectedDefinitionAttribute>))
|> Seq.isEmpty
|> not
)
let astFromReflectedDefinition (mi : MethodInfo) : Expr option =
mi :> MethodBase |> Expr.TryGetReflectedDefinition
let reflectedMethodsOfAModule (m : System.Type) : (MethodInfo * Expr) [] =
m.GetMethods()
|> Array.map (fun m -> (m,astFromReflectedDefinition m))
|> Array.filter (snd >> Option.isSome)
|> Array.map (fun (x,y) -> (x, Option.get y))
let reflectAssembly (assemblyPath : string) =
let a = System.Reflection.Assembly.LoadFile(assemblyPath)
a
|> tryGetReflectedModules
|> Seq.map (fun x -> (x,reflectedMethodsOfAModule (x.AsType())))
Where, for example, the assembly I used for testing the code above looked like this:
namespace Input
[<ReflectedDefinition>]
module Api =
let trace s =
for _ in [0..3] do System.Diagnostics.Trace.WriteLine s
[<ReflectedDefinition>]
module Foo =
let foobar (x : string) : string =
x.ToUpper()
You get the top level types in the assembly, which just so happen to be the (static) classes, representing the modules of the Fsharp assembly and test for the ReflectedDefinitionAttribute presence. Then, you take it from there.
I have asked a related question here. I want to do a similar thing but this time thread an accumulator though the array of functions. I immediately thought of Array.Reduce or Array.Fold but they are not working for me:
let AddTen x =
x + 10
let MultiplyFive x =
x * 5
let SubtractTwo x =
x - 2
let functionArray = [| AddTen; MultiplyFive; SubtractTwo |]
let calculateAnswer functionArray x = functionArray |>Array.reduce(fun acc f -> f acc)
The last line throws this exception:
Type mismatch. Expecting a
'a -> 'b but given a
'b The resulting type would be infinite when unifying ''a' and ''b -> 'a'
Am I thinking about the problem incorrectly?
Take a look at these two:
let calculateReduce = functionArray |> Array.reduce (fun f g -> f >> g)
let calculateFold x = functionArray |> Array.fold (fun acc f -> f acc) x
In the reduce version, you take an array of functions and compose them into a single function which you can later call on x.
In the fold version you fold over the array of functions, threading the accumulator through and applying each function to it in sequence. x is the initial value of the accumulator here.
Your original code didn't work, because a reduce expects a 'a -> 'a -> 'a function, which in case of an array of functions would imply composition, while you were trying to apply one function of type int -> int to another.
It is powerful technique using recursion because its strong describable feature. Tail recursion provides more powerful computation than normal recursion because it changes recursion into iteration. Continuation-Passing Style (CPS) can change lots of loop codes into tail recursion. Continuation Monad provides recursion syntax but in essence it is tail recursion, which is iteration. It is supposed to reasonable use Continuation Monad for 100000 factorial. Here is the code.
type ContinuationBuilder() =
member b.Bind(x, f) = fun k -> x (fun x -> f x k)
member b.Return x = fun k -> k x
member b.ReturnFrom x = x
(*
type ContinuationBuilder =
class
new : unit -> ContinuationBuilder
member Bind : x:(('d -> 'e) -> 'f) * f:('d -> 'g -> 'e) -> ('g -> 'f)
member Return : x:'b -> (('b -> 'c) -> 'c)
member ReturnFrom : x:'a -> 'a
end
*)
let cont = ContinuationBuilder()
//val cont : ContinuationBuilder
let fac n =
let rec loop n =
cont {
match n with
| n when n = 0I -> return 1I
| _ -> let! x = fun f -> f n
let! y = loop (n - 1I)
return x * y
}
loop n (fun x -> x)
let x2 = fac 100000I
There is wrong message: "Process is terminated due to StackOverflowException."
What is wrong with 100000 factorial using ContinuationMonad?
You need to compile the project in Release mode or check the "Generate tail calls" option in project properties (or use --tailcalls+ if you're running the compiler via command line).
By default, tail call optimization is not enabled in Debug mode. The reason is that, if tail-calls are enabled, you will not see as useful information about stack traces. So, disabling them by default gives you more pleasant debugging experience (even in Debug mode, the compiler optimizes tail-recursive functions that call themselves, which handles most situations).
You probably need to add this memeber to your monad builder:
member this.Delay(mk) = fun c -> mk () c
I'm trying to make test for this function
let extract_one_rule (rule:Rule.t<'a,'b>) =
let rec expand = function
|PAlt (a,b) -> expand a # expand b
|PSeq (a,b) -> let wrap = List.map (fun x -> (x.rule, fun r -> {x with rule = r})) a
|> List.unzip
in
let rec gen = function
| hd::tl -> [for x in hd -> x :: ( gen tl |> List.concat)]
| [] -> []
in
fst wrap |> List.map expand |> gen
|> List.map (fun x -> PSeq ((List.map2 ( |> ) x (snd wrap)),b))
|PRef _
|PLiteral _
|PToken _ as t -> [t]
| _ -> (System.Console.WriteLine("incorrect tree for alternative expanding!")
; failwith "incorrect tree for alternative expanding!")
in
expand rule.body |> List.map (fun x -> {rule with body = x})
using FsCheck
so i have this
let ExpandAlterTest(t : Rule.t<Source.t,Source.t> ) = convertToMeta t |> List.forall (fun x -> ruleIsAfterEBNF x)
but i'l see exception "incorrect tree for alternative expanding!"
but when i use smth like that
let ExpandAlterTest(t : Rule.t<Source.t,Source.t> ) = (correctForAlExp t.body) ==> lazy ( convertToMeta t |> List.forall (fun x -> ruleIsAfterEBNF x))
NUnit doesn't stop working
Why it can be?
It could be that the precondition you added is very restrictive, so that it takes a long time before a good value (one that actually passes the precondition) is found. FsCheck is hardened against this - by default, it tries to find 100 values but when it has rejected 1000 it gives up and you should see a "Arguments exhausted after x tests" output. But this might take a long time, if generating and checking the value takes a long time.
Could also be that you actually have a bug somewhere, like an infinite loop.
Try changing the FsCheck config to run less tests, doing a verbose run (verboseCheck), and breaking in the debugger when it seems to hang.