I'm trying to substitute types in a F# Expr, before converting it to an Expression for consumption by a c# lib.
But upon the call to LeafExpressionConverter.QuotationToExpression I receive the error
InvalidOperationException: The variable 't' was not found in the translation context
Basically I'm trying to substitute the equivalent of
<# fun (t: Record) -> t.A = 10 #> to
<# fun (t: Dict) -> t["A"] = 10 #>
Here is the code
type Record = {
A: int
}
type Dict () = //this is the type the c# lib wants (a dictionary representation of a type)
inherit Dictionary<string, obj>()
let substitute<'a> (ex: Expr<'a->bool>) =
let replaceVar (v: Var) = if v.Type = typeof<'a> then Var(v.Name, typeof<Dict>) else v
let tEntityItem = typeof<Dict>.GetProperty("Item")
let isATypeShapeVar = function | ShapeVar var -> var.Type = typeof<'a> | _ -> false
let rec substituteExpr =
function
| PropertyGet(exOpt, propOrValInfo, c) ->
match exOpt with
| None -> Expr.PropertyGet(propOrValInfo)
| Some ex ->
let args = c |> List.map substituteExpr
let newex = substituteExpr ex
match isATypeShapeVar ex with
| true ->
let getter = Expr.PropertyGet(newex, tEntityItem, [Expr.Value(propOrValInfo.Name)] )
Expr.Coerce(getter, propOrValInfo.PropertyType)
| false -> Expr.PropertyGet(newex, propOrValInfo, args)
| ShapeVar var -> Expr.Var (var |> replaceVar)
| ShapeLambda (var, expr) -> Expr.Lambda(var |> replaceVar, substituteExpr expr)
| ShapeCombination(shapeComboObject, exprList) ->
RebuildShapeCombination(shapeComboObject, List.map substituteExpr exprList)
substituteExpr ex |> LeafExpressionConverter.QuotationToExpression
substitute<Record> (<# fun t -> t.A = 10 #>)
I suspect I've missed something in the substitution, but I'm stumped as to what.
The the .ToString() result of the substituted F# Expr is
Lambda (t,
Call (None, op_Equality,
[Coerce (PropertyGet (Some (t), Item, [Value ("A")]), Int32),
Value (10)]))
which looks correct. And other than the coersion, is the equivalent of <# fun (t: Dict) -> t["A"] = 10 #>.ToString()
Why is the QuotationToExpression failing ?
Every time you call replaceVar, you return a different instance of Var. So when you replace the lambda parameter, it's one instance of Var, and later, when you replace newex, that's another instance of Var.
Lambda (t, Call (None, op_Equality, [Coerce (PropertyGet (Some (t), ... ))
^ ^
| |
---------------------------------------------------------
These are different `t`, unrelated, despite the same name
To make this work, you have to make it the same t. The dumbest, most straightforward way would be this:
let substitute<'a> (ex: Expr<'a->bool>) =
let newArg = Var("arg", typeof<Dict>)
let replaceVar (v: Var) = if v.Type = typeof<'a> then newArg else v
...
This will make your particular example work as expected, but it is still unsound, because you're replacing not just specifically the lambda parameter, but any variable of the same type. Which means that if the expression happens to contain any variables of the same type as the parameter, you'd still hit the same problem. For example, try converting this:
<# fun t -> let z = { A = 15 } in z.A = 15 && t.A = 10 #>
You'll get a similar error, but this time complaining about variable z.
A better way would be to maintain a map of variable substitutions as you go, insert new variables as you encounter them for the first time, but get them from the map on subsequent encounters.
An alternative approach would be to fish out specifically the lambda parameter and then replace only it, rather than comparing variable types.
But then there's the next level of weirdness: you're converting any property accessor to an indexer accessor, but in my example above, z.A shouldn't be thus converted. So you have to somehow recognize whether the object of property access is in fact the argument, and that may not be as trivial.
If you're willing to settle for just the case of t.A and fail on more complicated cases like (if true then t else t).A, then you can just match on the lambda argument and pass through any other expression:
let substitute<'a> (ex: Expr<'a->bool>) =
let arg =
match ex with
| ShapeLambda (v, _) -> v
| _ -> failwith "This is not a lambda. Shouldn't happen."
let newArg = Var("arg", typeof<Dict>)
let replaceVar (v: Var) = if v = arg then newArg else v
let tEntityItem = typeof<Dict>.GetProperty("Item")
let isATypeShapeVar = function | ShapeVar var -> var.Type = typeof<'a> | _ -> false
let rec substituteExpr =
function
| PropertyGet(Some (ShapeVar a), propOrValInfo, c) when a = arg ->
let getter = Expr.PropertyGet(Expr.Var newArg, tEntityItem, [Expr.Value(propOrValInfo.Name)] )
Expr.Coerce(getter, propOrValInfo.PropertyType)
| ShapeVar var -> Expr.Var (var |> replaceVar)
| ShapeLambda (var, expr) -> Expr.Lambda(var |> replaceVar, substituteExpr expr)
| ShapeCombination(shapeComboObject, exprList) ->
RebuildShapeCombination(shapeComboObject, List.map substituteExpr exprList)
| ex -> ex
substituteExpr ex |> LeafExpressionConverter.QuotationToExpression
> substituteExpr <# fun t -> let z = { A = 15 } in z.A = 15 && t.A = 10 #>
val it: System.Linq.Expressions.Expression =
ToFSharpFunc(arg => z => ((z.A == 15) AndAlso (Convert(arg.get_Item("A"), Int32) == 10)).Invoke(new Record(15)))
Related
I have the following types:
type Foo = { Name : string}
type Bar = {Name : string}
And I have the following Quoted expression:
<# fun (x : Foo) -> x.Name = "1" #>
Basically from this I would like to generate another quoted expression as:
<# fun (x : Bar) -> x.Name = "1" #>
How can I do this?
OK I got the following solution :
let subst expression newType =
let newVar name = Var.Global(name,newType)
let rec substituteExpr expression =
match expression with
| Call(Some (ShapeVar var),mi,other) ->
Expr.Call(Expr.Var(newVar var.Name), newType.GetMethod(mi.Name),other)
| PropertyGet (Some (ShapeVar var) ,pi, _) ->
Expr.PropertyGet(Expr.Var( newVar var.Name), newType.GetProperty(pi.Name),[])
| ShapeVar var -> Expr.Var <| newVar var.Name
| ShapeLambda (var, expr) ->
Expr.Lambda (newVar var.Name, substituteExpr expr)
| ShapeCombination(shapeComboObject, exprList) ->
RebuildShapeCombination(shapeComboObject, List.map substituteExpr exprList)
substituteExpr expression
then I can do
let f = <# fun (x : Foo) -> x.Name = "1" #>
let transformed = subst f typeof<Bar>
let typedExpression: Expr<Bar -> bool> = downcast <# %%transformed #>
I have a series of validation functions I want to put into an array to execute:
type result = {D: int; E: int; F: int; G: int}
type InvalidReason =
| AAA
| BBB
| CCC
| DDD
| EEE
type Validation =
| Valid
| Invalid of InvalidReason
let validators = [|AAA; BBB; CCC; DDD; EEE|]
let validateStuff result =
validators
|> Array.map(fun v -> v result)
|> Array.contains(Validation.Invalid _)
The problem is that last line of code. I am getting an "Unexpected value _ in the expression." The following does work
|> Array.contains(Validation.Valid)
|> Array.contains(Validation.Invalid InvalidReason.AAA)
But I don't want to spell out each of the sub types for InvalidReasons. Is there some syntax I am overlooking?
The function Array.contains takes a value and checks if that value is in the array. What you're trying to do is to give it a whole bunch of values to check. Well, this won't work: the function only takes one. And it doesn't help that there is no syntax like that in F# :-)
You might use another function that takes multiple values, but a better way to accomplish what you want is to use a function that takes a predicate - Array.exists. Make yourself a predicate to check if a value is "invalid":
let isInvalid x = match x with
| Valid -> false
| Invalid _ -> true
And pass it to Array.exists:
let validateStuff result =
validators
|> Array.map(fun v -> v result)
|> Array.exists isInvalid
Or you could even put that function inline:
let validateStuff result =
validators
|> Array.map(fun v -> v result)
|> Array.exists ( fun x -> match x with
| Valid -> false
| Invalid _ -> true )
Or even shorter, using the function keyword:
let validateStuff result =
validators
|> Array.map(fun v -> v result)
|> Array.exists ( function | Valid -> false | Invalid _ -> true )
Or even shorter, getting rid of as much noise as possible:
let validateStuff result =
validators
|> Array.map(fun v -> v result)
|> Array.exists ( function Invalid _ -> true | _ -> false )
I came across this question about the "pyramid of doom" in F#. The accepted answer there involves using Active Patterns, however my understanding is that it can also be solved using Computation Expressions.
How can I remove the "pyramid of doom" from this code using Computation Expressions?
match a.TryGetValue(key) with
| (true, v) -> v
| _ ->
match b.TryGetValue(key) with
| (true, v) -> v
| _ ->
match c.TryGetValue(key) with
| (true, v) -> v
| _ -> defaultValue
F# for fun and profit has an example for this specific case:
type OrElseBuilder() =
member this.ReturnFrom(x) = x
member this.Combine (a,b) =
match a with
| Some _ -> a // a succeeds -- use it
| None -> b // a fails -- use b instead
member this.Delay(f) = f()
let orElse = new OrElseBuilder()
But if you want to use it with IDictionary you need a lookup function that returns an option:
let tryGetValue key (d:System.Collections.Generic.IDictionary<_,_>) =
match d.TryGetValue key with
| true, v -> Some v
| false, _ -> None
Now here's a modified example of its usage from F# for fun and profit:
let map1 = [ ("1","One"); ("2","Two") ] |> dict
let map2 = [ ("A","Alice"); ("B","Bob") ] |> dict
let map3 = [ ("CA","California"); ("NY","New York") ] |> dict
let multiLookup key = orElse {
return! map1 |> tryGetValue key
return! map2 |> tryGetValue key
return! map3 |> tryGetValue key
}
multiLookup "A" // Some "Alice"
The pattern I like for "pyramid of doom" removal is this:
1) Create a lazy collection of inputs
2) Map them with a computation function
3) skip all the computations that yield unacceptable results
4) pick the first one that matches your criteria.
This approach, however, does not use Computation Expressions
open System.Collections
let a = dict [1, "hello1"]
let b = dict [2, "hello2"]
let c = dict [2, "hello3"]
let valueGetter (key:'TKey) (d:Generic.IDictionary<'TKey, 'TVal>) =
(
match d.TryGetValue(key) with
| (true, v) -> Some(v)
| _ -> None
)
let dicts = Seq.ofList [a; b; c] // step 1
let computation data key =
data
|> (Seq.map (valueGetter key)) // step 2
|> Seq.skipWhile(fun x -> x = None) // step 3
|> Seq.head // step 4
computation dicts 2
A short-circuiting expression can be achieved if we subvert the Bind method, where we are in a position to simply ignore the rest of the computation and replace it with the successful match. Also, we can cater for the bool*string signature of the standard dictionary lookup.
type OrElseBuilder() =
member __.Return x = x
member __.Bind(ma, f) =
match ma with
| true, v -> v
| false, _ -> f ()
let key = 2 in OrElseBuilder() {
do! dict[1, "1"].TryGetValue key
do! dict[2, "2"].TryGetValue key
do! dict[3, "3"].TryGetValue key
return "Nothing found" }
// val it : string = "2"
given the following type
type Foo = { foo: string; bar: int };;
and the following code quotation
<#fun v x -> { x with foo = v; bar = 99 } #>;;
this will result in
val it : Quotations.Expr<(string -> Foo -> Foo)> =
Lambda (v, Lambda (x, NewRecord (Foo, v, Value (99))))
Which is expected. Also the following code quotation
<#fun v x -> { x with bar = v;foo = "foo" } #>;;
yields the expected result.
val it : Quotations.Expr<(int -> Foo -> Foo)> =
Lambda (v, Lambda (x, NewRecord (Foo, Value ("foo"), v)))
However this (changing the order and assigning the value to the second field)
<#fun v x -> { x with bar = 66;foo = v } #>;;
yields
val it : Quotations.Expr<(string -> Foo -> Foo)> =
Lambda (v, Lambda (x, Let (bar, Value (66), NewRecord (Foo, v, bar))))
a let. But there is no let in the code. Why is this?
Quotations only guarantee that they'll generate expressions with the correct behaviour, not any specific shape.
For example the quotation <## 1 = 2 || 2 = 3 ##> will generate an expression comprising of an if statement (i.e. if 1 = 2 then true else 2 = 3).
Normalising the resulting expressions is a pretty deep rabbit hole, but you can see some basic normalisers here: https://github.com/mavnn/Algebra.Boolean/blob/master/Algebra.Boolean/Transforms.fs
Specifically, check unbind at the end of the file.
let unbind quote =
let rec findLet q =
match q with
| Let (var, value, body) ->
findLet (replaceVar var.Name value body)
| ShapeLambda (v, e) ->
Expr.Lambda(v, findLet e)
| ShapeVar v ->
Expr.Var v
| ShapeCombination (o, es) ->
RebuildShapeCombination(o, es |> List.map findLet)
and replaceVar name value q =
match q with
| Let (v, e, e') ->
if v.Name = name then
findLet (Expr.Let(v, e, e'))
else
Expr.Let(v, replaceVar name value e, replaceVar name value e')
| ShapeLambda (v, e) ->
Expr.Lambda(v, replaceVar name value e)
| ShapeVar v ->
if v.Name = name then
value
else
Expr.Var v
| ShapeCombination (o, es) ->
RebuildShapeCombination(o, es |> List.map (replaceVar name value))
findLet quote
As to why these specific expressions are different? No idea, I'm afraid!
I believe what you are seeing here is a particular case of de-sugaring of the with syntax on records. I think what is happening here it is using the v to capture the value to ensure that the expressions are evaluated in the correct order of the fields. So in this case the let binding is introduce as the passed in parameter is the 2nd value being utilised.
This is from the F# language spec.
Primitive record constructions are an elaborated form in which the
fields appear in the same order as in the record type definition.
Record expressions themselves elaborate to a form that may introduce
local value definitions to ensure that expressions are evaluated in
the same order that the field definitions appear in the original
expression
The class below is a wrapper around an async MailboxProcessor that exposes
a few operations to C# assemblies. However, I don't want just a few
Map<string,int>
instances, I need several different Map<'K,'V> instances where 'K and 'V vary.
I hope I don't need a functor for that (it probably doesn't exist in F#).
module Flib.AsyncEvents
open System.Collections.Generic
type KVcoll = Map<string,int>
type Msg = Request of string * int option | Fetch of AsyncReplyChannel<KVcoll> | Clear
#nowarn "40"
type myAgent () = class
let dictAgent = MailboxProcessor.Start(fun inbox->
let dict = ref Map.empty
let rec loop = async {
let! msg = inbox.Receive()
match msg with
| Request (key, Some value) -> dict := Map.add key value !dict
| Request (key, None) -> dict := Map.remove key !dict
| Fetch(reply) -> reply.Reply(!dict)
| Clear -> dict := Map.empty
return! loop
}
loop)
member this.add(key, value) = dictAgent.Post (Request (key, Some value))
member this.del(key) = dictAgent.Post (Request(key, None))
member this.fetch() = dictAgent.PostAndReply((fun reply -> Fetch(reply)), timeout = 9000)
member this.lookup(key) = try 0, Map.find key (this.fetch()) // success
with | :? KeyNotFoundException -> -1, 0 // failure
member this.size() = this.fetch().Count
member this.clear() = dictAgent.Post (Clear)
member this.print() =
this.fetch() |> Map.iter (fun k v -> printfn "%s => %d" k v)
printfn "done"
end
By the way, this is prototype quality code, clearly not as good as it can be.
I'm not sure I understand the question fully, but if you want to create a type that can be used with different types of values, you can define the class as generic:
type Msg<'K, 'V when 'K : comparison> =
| Request of 'K * 'V option
| Fetch of AsyncReplyChannel<Map<'K, 'V>>
| Clear
type MyAgent<'K, 'V when 'K : comparison> () = class
let dictAgent = MailboxProcessor.Start(fun inbox->
let dict : Map<'K, 'V> ref = ref Map.empty
let rec loop = async {
// (same as before)
}
loop)
To make this work, you'll need to avoid code that restricts the type of keys and values to a particular type. In you case lookup was returning 0 as the default value and print was expecting strings. So you can replace those with something like:
member this.lookup(key) = Map.tryFind key (this.fetch())
member this.print() =
this.fetch() |> Map.iter (fun k v -> printfn "%A => %A" k v)
printfn "done"