F#: How to call Expression.Call for a method with discriminated union in a generic type using a case type? - reflection

Let's say, I have a discriminated union type AccountEvent and a class Aggregate that carries two methods:
Apply1(event : AccountEvent)
Apply2(event : Event<AccountEvent>)
Event<'TEvent> being just a dummy class for sake of having a generic type.
I am trying to create an Expression that represents the call to Apply1 and Apply2 supporting for the parameter type the Discriminated union case type.
That is allowing:
AccountEvent.AccountCreated type for Apply1
Event<AccountEvent.AccountCreated> type for Apply2
I want to achieve that without changing the signature of Apply1, Apply2 and the definition the discriminated union.
The code
type AccountCreation = {
Owner: string
AccountId: Guid
CreatedAt: DateTimeOffset
StartingBalance: decimal
}
type Transaction = {
To: Guid
From: Guid
Description: string
Time: DateTimeOffset
Amount: decimal
}
type AccountEvent =
| AccountCreated of AccountCreation
| AccountCredited of Transaction
| AccountDebited of Transaction
type Event<'TEvent>(event : 'TEvent)=
member val Event = event with get
type Aggregate()=
member this.Apply1(event : AccountEvent)=
()
member this.Apply2(event : Event<AccountEvent>)=
()
let createExpression (aggregateType: Type)(eventType: Type)(method: MethodInfo) =
let instance = Expression.Parameter(aggregateType, "a")
let eventParameter = Expression.Parameter(eventType, "e")
let body = Expression.Call(instance, method, eventParameter)
()
[<EntryPoint>]
let main argv =
let accountCreated = AccountEvent.AccountCreated({
Owner = "Khalid Abuhakmeh"
AccountId = Guid.NewGuid()
StartingBalance = 1000m
CreatedAt = DateTimeOffset.UtcNow
})
let accountCreatedType = accountCreated.GetType()
let method1 = typeof<Aggregate>.GetMethods().Single(fun x -> x.Name = "Apply1")
createExpression typeof<Aggregate> typeof<AccountEvent> method1
createExpression typeof<Aggregate> accountCreatedType method1
let method2 = typeof<Aggregate>.GetMethods().Single(fun x -> x.Name = "Apply2")
let eventAccountCreatedType = typedefof<Event<_>>.MakeGenericType(accountCreatedType)
createExpression typeof<Aggregate> typeof<Event<AccountEvent>> method2
createExpression typeof<Aggregate> eventAccountCreatedType method2
0
With my current solution it does not work to generate an expression for Apply2:
System.ArgumentException: Expression of type 'Program+Event`1[Program+AccountEvent+AccountCreated]' cannot be used for parameter of type 'Program+Event`1[Program+AccountEvent]' of method 'Void Apply2(Event`1)'
Parameter name: arg0
at at System.Dynamic.Utils.ExpressionUtils.ValidateOneArgument(MethodBase method, ExpressionType nodeKind, Expression arguments, ParameterInfo pi, String methodParamName, String argumentParamName, Int32 index)
at at System.Linq.Expressions.Expression.Call(Expression instance, MethodInfo method, Expression arg0)
at at System.Linq.Expressions.Expression.Call(Expression instance, MethodInfo method, IEnumerable`1 arguments)
at at System.Linq.Expressions.Expression.Call(Expression instance, MethodInfo method, Expression[] arguments)
at Program.doingStuff(Type aggregateType, Type eventType, MethodInfo method) in C:\Users\eperret\Desktop\ConsoleApp1\ConsoleApp1\Program.fs:40
at Program.main(String[] argv) in C:\Users\eperret\Desktop\ConsoleApp1\ConsoleApp1\Program.fs:61
I am wondering how I can adjust the creation of my expression to accept the Event<AccountEvent.AccountCreated>?
I am thinking that maybe there is a need to have an intermediate layer to have a conversion layer from AccountEvent.AccountCreated to its base classAccountEvent (this is how discriminated unions are compiled), or more precisely considering the generic, from Event<AccountEvent.AccountCreated to Event<AccountEvent>.

hard to say if this answers your question.
open System
open System
type AccountCreation = {
Owner: string
AccountId: Guid
CreatedAt: DateTimeOffset
StartingBalance: decimal
}
type Transaction = {
To: Guid
From: Guid
Description: string
Time: DateTimeOffset
Amount: decimal
}
type AccountEvent =
| AccountCreated of AccountCreation
| AccountCredited of Transaction
| AccountDebited of Transaction
type CheckinEvent =
| CheckedIn
| CheckedOut
type Event<'T> = AccountEvent of AccountEvent | OtherEvent of 'T
let ev : Event<CheckinEvent> = AccountEvent (AccountCreated {
Owner= "string"
AccountId= Guid.NewGuid()
CreatedAt= DateTimeOffset()
StartingBalance=0m
})
let ev2 : Event<CheckinEvent> = OtherEvent CheckedOut
let f ev =
match ev with
| AccountEvent e -> Some e
| OtherEvent (CheckedOut) -> None
| OtherEvent (CheckedIn) -> None
let x = f ev
let y = f ev2
afterwards, a match statement like this might simplify all that. Honestly it's a little complicated for me to follow what precisely what you're doing there, but using a function instead of a method and using a match statement appears to accomplish the same goal. Ideally you should probably fully spell out the types in a DU instead of using a generic so that you'll get compile time checks instead of run time errors and can know for certain that your code is fully covered by the compiler.

Related

Extracting the name of a variable

How can we build a function in F# that outputs the name of the variable passed in? For example:
let someVar1 = "x"
getVarname someVar1 //output would be "someVar1"
let someVar2 = "y"
getVarname someVar2 //output would be "someVar2"
let f toString = fun a -> printfn "%s: %d" (toString a) a
let x = 1
f getVarname x //output would be: "x: 1"
I found a similar question in C# here (get name of a variable or parameter), but I was unable to make it work in F#.
If you use quotations and static methods, you can already capture the name of the variable in F# 4 using the ReflectedDefinition attribute. The Demo.GetVarName static method in the following example returns the name of the variable used as an argument together with the value:
open Microsoft.FSharp.Quotations
type Demo =
static member GetVarName([<ReflectedDefinition(true)>] x:Expr<int>) =
match x with
| Patterns.WithValue(_, _, Patterns.ValueWithName(value, _, name)) ->
name, value :?> int
| _ -> failwithf "Argument was not a variable: %A" x
let test ()=
let yadda = 123
Demo.GetVarName(yadda)
test()
This works for local variables as in the test() function above. For top-level variables (which are actually compiled as properties) you also need to add a case for PropertyGet:
match x with
| Patterns.WithValue(_, _, Patterns.ValueWithName(value, _, name)) ->
name, value :?> int
| Patterns.WithValue(value, _, Patterns.PropertyGet(_, pi, _)) ->
pi.Name, value :?> int
| _ -> failwithf "Argument was not a variable: %A" x
The nameof implementation has the operator in F# core, but the F# 5 compiler bits haven't shipped yet.
When it does, you can use it to get the name of a symbol.
let someVar1 = None
let name = nameof someVar1 // name = "someVar1"
For now, we can maybe abuse the dynamic operator to get us a shim which you can eventually replace with nameof
let name = ()
let (?) _ name = string name
Usage:
let someVar1 = None
let name = name?someVar1
It doesn't read too bad, and you get some degree of auto-completion.
If you really want to be able to retrieve the local name and value at the call-site, there's quotations.
let printVar = function
| ValueWithName(value, _type, name) -> printfn "%s = %A" name value
| _ -> ()
The usage is a bit noisy, though.
let someVar1 = 12
printVar <# someVar1 #> //prints someVar1 = 12

How to create and use my own structure/signature in SML/NJ?

I'm new to functional programming and I want to create my own structure/signature called Dictionary. So far I have this in file called dictionary-en.sml:
(* The signature DICTIONARY defines a type and a programming interface for
the dictionary data structure. The data structure allows us to store
data in the form of (key, value) pairs and to query the data using a key. *)
signature DICTIONARY =
sig
(* The structure has to implement a dictionary type. It defines key type,
which has to support equality checking, and a value type for the data
stored in the dictionary. *)
type (''key, 'value) dict
(* Creates an empty dictionary. *)
val empty: (''key, 'value) dict
(* Returns true if a key exists in the dictionary. *)
val exists: (''key, 'value) dict -> ''key -> bool
end
And I have this in file solution.sml:
structure Dictionary :> DICTIONARY =
struct
type (''key, 'value) dict = (''key * 'value) list
val empty = []
fun exists dict key =
case dict of
[] => false
| (k, _ )::rep => if k = key
then true
else exists rep key
end
But I don't how to use this.
When I wrote in REPL:
- Dictionary.exists [(3,"c"), (5, "e"), (7, "g")] 3;
I got this error:
stdIn:1.2-3.7 Error: operator and operand do not agree [tycon mismatch]
operator domain: (''Z,'Y) Dictionary.dict
operand: ([int ty] * string) list
in expression:
Dictionary.exists ((3,"c") :: (5,"e") :: (<exp>,<exp>) :: nil)
Can someone please help me? I don't know what I did wrong.
In the function
fun exists dict key =
case dict of
[] => []
| (k, _ )::rep => if k = key
then true
else exists rep key
I spot two issues:
You can't return [] in one place and true in another.
Instead of if P then true else Q, write P orelse Q.
You're using :> which means that the module is opaque, so you can only access the things specified in the signature. The internal list representation is not mentioned in the signature, so you can't refer to a dict as a list, even though you may know that that's how it's implemented. This is a feature.
I would probably call exists for member, since List.exists is a higher-order predicate, e.g. List.exists (fn x => x > 5) [3, 6, 9]. You could also deviate from any standard library naming and say containsKey and containsValue, or something like that.
Besides the insert function that molbdnilo suggested, you may like to have a fromList function.
Here's a refactored version (comments omitted for brevity, but I think your comments are good!):
signature DICTIONARY =
sig
type (''key, 'value) dict
val empty: (''key, 'value) dict
val member: ''key -> (''key, 'value) dict -> bool
val insert: (''key * 'value) -> (''key, 'value) dict -> (''key, 'value) dict
val fromList: (''key * 'value) list -> (''key, 'value) dict
end
structure Dictionary :> DICTIONARY =
struct
type (''key, 'value) dict = (''key * 'value) list
val empty = []
fun member key [] = false
| member key ((key2, _)::dict) =
key = key2 orelse member key dict
fun insert (key, value) [] = [(key, value)]
| insert (key, value) ((key2, value2)::dict) =
if key = key2
then (key, value) :: dict
else (key2, value2) :: insert (key, value) dict
fun fromList pairs = foldl (fn (pair, dict) => insert pair dict) empty pairs
end
But since you're building a dictionary module, there are two things you want to consider:
Make it possible to use some kind of binary tree as internal representation, requiring that the keys can be ordered rather than compared for equality.
Since Standard ML doesn't have special syntax like ''key to express that something can be ordered (Haskell generalises this as type classes, but Standard ML has only the special syntax ''key), this is a good case for using functors, which is the name given to higher-order modules, aka parameterised modules.
Here's an example signature, functor and structure that you can fill out:
signature ORD = sig
type t
val compare : t * t -> order
end
signature DICT = sig
type key
type 'value dict
val empty: 'value dict
val member: key -> 'value dict -> bool
val insert: key * 'value -> 'value dict -> 'value dict
val fromList: (key * 'value) list -> 'value dict
end
functor Dict (Ord : ORD) :> DICT = struct
type key = Ord.t
type 'value dict = (key * 'value) list
val empty = ...
fun member _ _ = raise Fail "not implemented"
fun insert _ _ = raise Fail "not implemented"
fun fromList _ = raise Fail "not implemented"
end
At this point you can change type 'value dict into using a binary tree, and when you need to decide whether to go left or right in this binary tree, you can write:
case Ord.compare (key1, key2) of
LESS => ...
| EQUAL => ...
| GREATER => ...
And when you need a dictionary where the key is some particular orderable type, you can create a module using this functor:
structure IntDict = Dict(struct
type t = int
val compare = Int.compare
end)
structure StringDict = Dict(struct
type t = string
val compare = String.compare
end)
See also Standard ML functor examples for more examples.
You can't access the internal representation; the entire interface is given by the signature.
You need to add to the signature some way to create a dictionary without depending on the representation used in a particular structure.
For instance,
val insert : (''key * 'value) -> (''key, 'value) dict -> (''key, 'value) dict
would let you write
Dictionary.exists (Dictionary.insert (3,"c") Dictionary.empty) 3;
Implementation left as an exercise.

Extend mutually recursive functors

I am writing a compiler and need to represent several structures that are co recursive and depend on the data-structure representing expressions. At the beginning of compilation my expressions are not typed but I do type them at a later stage.
I wrote the following functors to be able to reuse code during the process:
module type Exp = sig
type t
end
module type IR = sig
type exp
type ty =
| Unknown
| Typed of exp
type exp_descr =
| Leaf
| Node of exp
end
module MyIR (E: Exp) = struct
type ty =
| Unknown
| Typed of E.t
type exp_descr =
| Leaf
| Node of E.t
type exp = E.t
end
module UntypedExp (TD: IR) : (Exp with type t = TD.exp_descr) = struct
type t = TD.exp_descr
end
module TypedExp (TD: IR) : Exp = struct
type t =
{
ty : TD.ty;
descr : TD.exp_descr;
}
end
module rec UTExp : Exp = UntypedExp(UTIR)
and UTIR : IR = MyIR(UTExp)
module rec TExp : Exp = TypedExp(TIR)
and TIR : IR = MyIR(TExp)
I now have 2 intermediate representations one that uses untyped expressions and the other that uses typed expressions.
I now want to write a printing module and I want to factorize code in the same manner as I did earlier. Below is my unsuccessful attempt, I don't understand how properly extend TExp and UTexp.
More specifically, I don't know how to share the field constructor defined in TypedExp.
module type ExpPrint = sig
type t
val string_of_t: t -> string
end
module type IRPrint = sig
include IR
val string_of_ty: ty -> string
val string_of_exp_descr: exp_descr -> string
val string_of_exp: exp -> string
end
module MyExpPrint (R: IR) (E: ExpPrint with type t = R.exp) : (IRPrint with type exp := R.exp and type exp_descr := R.exp_descr and type ty := R.ty) = struct
open R
let string_of_exp = E.string_of_t
let string_of_ty = function
| R.Unknown -> "Unknown"
| Typed e -> "Typed: " ^ string_of_exp e
let string_of_exp_descr = function
| R.Leaf -> "Leaf"
| Node e -> "Node: " ^ string_of_exp e
end
module UTExpPrint (E : module type of UTExp) (R: IRPrint with type exp = E.t) : (ExpPrint with type t := R.exp_descr) = struct
open E
let string_of_t = R.string_of_exp_descr
end
module TExpPrint (E : module type of TExp) (R: IRPrint with type exp = E.t) : (ExpPrint with type t := R.exp) = struct
open E
let string_of_t e = R.string_of_exp_descr e.TExp.descr ^ " " ^ R.string_of_ty e.ty
end
EDIT: fixes the problems with MyExpPrint
Since the module type Exp is defined as
module type Exp = sig type t end
any signature constraint of the form M: Exp makes M unusable since it hides all information about M, except the existence of an abstract type M.t. This abstract type is unusable since there are no functions between this type and the outside world.
For instance, this module definition defines a type and immediately hides it to the outside world:
module TypedExp (TD: IR) : Exp = struct
type t =
{
ty : TD.ty;
descr : TD.exp_descr;
}
end
What you wanted was simply
module TypedExp (TD: IR) = struct
type t =
{
ty : TD.ty;
descr : TD.exp_descr;
}
end
If you really want to add a signature constraint, the right one would be
module TypedExp (TD: IR): sig
type t =
{
ty : TD.ty;
descr : TD.exp_descr;
}
end
= struct
type t =
{
ty : TD.ty;
descr : TD.exp_descr;
}
end
Note that that I did not use Exp with type t = ... for two reasons: First, the with constraint cannot define new types. Second, Exp with type t = ... is just a complicated way to write sig type t = ... end.
This is the core issue with your code: it is hiding all information that would make possible to manipulate meaningfully the type that you defines.
For instance, after removing the signature constraint on functor result, fixing the signature in the recursive module constraints, simplifying the signature of IRprint to
module type IRPrint = sig
type ty
type exp_descr
type exp
val string_of_ty: ty -> string
val string_of_exp_descr: exp_descr -> string
val string_of_exp: exp -> string
end
then the functor TExpPrint can be fixed with
module TExpPrint
(E : module type of TExp)
(R: IRPrint with type exp_descr = TIR.exp_descr
and type exp = E.t
and type ty = TIR.ty)
=
struct
open E
let string_of_t e =
R.string_of_exp_descr e.E.descr ^ " " ^ R.string_of_ty e.ty
end
and I expect the rest of the errors to follow since it becomes possible to share the right type equalities.

How make .NET Mutable Dictionary<T, T> with StructuralComparison & Equality in F#

I Know F# have the MAP, but I wanna use the .NET Dictionary. This dict have key as string and values as F# values + the dict, ie:
type ExprC =
| StrC of string
| BoolC of bool
| IntC of int32
| DecC of decimal
| ArrayC of int * array<ExprC>
| RelC of RelationC
and RelationC = Dictionary<string, ExprC>
Now, the problem I wanna solve is how provide the RelationC type with structural equality. If is required to encapsulate the actual storage, how create a container that is a replacement for Dictionary, use it for mutable operations and have structural equality?
With the current answer, this code not work (of curse the implementation is not complete, however, this not even compile):
[<CustomEquality; CustomComparison>]
type MyDict() =
inherit Dictionary<string, ExprC>()
override this.Equals x =
match x with
| :? MyDict as y -> (this = y)
| _ -> false
override this.GetHashCode () =
hash this
interface System.IComparable with
member x.CompareTo yobj =
match yobj with
| :? MyDict as y -> compare x y
| _ -> invalidArg "MyDict" "cannot compare values of different types"
and [<StructuralEquality;StructuralComparison>] ExprC =
| IntC of int
| StrC of string
| MapC of MyDict
This is the error:
Error FS0377: This type uses an invalid mix of the attributes
'NoEquality', 'ReferenceEquality', 'StructuralEquality',
'NoComparison' and 'StructuralComparison' (FS0377)
If you absolutely must use Dictionary<string, ExprC>, you could derive from Dictionary<'k, 'v> and override Equals:
type MyDict() =
inherit Dictionary<string, ExprC>()
override this.Equals x =
true // real implementation goes here
override this.GetHashCode () =
0 // real implementation goes here
Here, you'd need to implement Equals to have structural equality, and you'll need to implement GetHashCode to match you Equals implementation.
Another alternative, if you don't need the concrete class Dictionary<'k, 'v>, is to define your own class that implements IDictionary<TKey, TValue>.
While possible, this sounds like a lot of work. It'd be much easier to use a Map, which has structural equality by default:
let m1 = Map.ofList [("foo", 1); ("bar", 2); ("baz", 3)]
let m2 = Map.ofList [("bar", 2); ("foo", 1); ("baz", 3)]
let m3 = Map.ofList [("bar", 2); ("foo", 1); ("baz", 4)]
> m1 = m2;;
val it : bool = true
> m1 = m3;;
val it : bool = false
Regarding the question at the end of the updated original post: What is the reason for "This type uses an invalid mix..."? This is a bug in the F# compiler, the error message is misleading, see Github. The solution is to simply remove all attributes from MyDict.

How to get the name of function argument in F#?

Can I write a function which returns the name of the function given as the argument?
let funName f: string =
// returns the name of f.
For example, if I pass printfn as an argument to funName, it returns "printfn".
> funName printfn;;
val it : string = "printfn"
EDIT: I wanted to write a function doc which returns the XML documentation associated with the given function.
let doc f = // returns the XML documentation of the function `f`.
To retrieve the summary of the function using something like NuDoq, I wanted to know the name of the function.
I cannnot imagine why you would want to do this and I do not think that there's a way to do this with reflection, but F# Code Quotations might get you halfway there.
open Microsoft.FSharp.Quotations
let rec funName = function
| Patterns.Call(None, methodInfo, _) -> methodInfo.Name
| Patterns.Lambda(_, expr) -> funName expr
| _ -> failwith "Unexpected input"
let foo () = 42
funName <# foo #> // "foo"
But note that certain predefined library functions have a divergent internal name.
funName <# printfn #> // "PrintFormatLine"
funName <# id #> // "Identity"
Note that as of F# 4.0, class types can automatically quote their arguments, simplifying the call site compared to kaefer's answer:
open Microsoft.FSharp.Quotations
type DocumentGetter =
static member GetName([<ReflectedDefinition>]x:Expr<_->_>) =
match x with
| DerivedPatterns.Lambdas(_, Patterns.Call(_,methodInfo,_)) ->
methodInfo.Name
let f x y = x + y
DocumentGetter.GetName f

Resources