Injecting a variable definition into F# quotation - f#

I have a custom variable definition, that I want to insert into a quotation. Is it even possible with the quotations syntax sugar?
What I wanted to do:
open Microsoft.FSharp.Quotations
let var = Var("myvar", typeof<int>)
let op = <## fun l -> match l with
| [] -> 0
| %%myvar :: _ -> ... ##>
I've also tried <## let %%myvar = ... ##> with a similar purpose.
In both cases I got FS0010 "Unexpected prefix operator in binding", or "... in pattern matching".
Is there a way to inject an existing Var like this? Or do I have to resort to manually generating the entire expression?
PS: I am using the whole thing to translate some other AST into an F# quotation.

What you describe in your question is really kind of nonsensical. You cannot splice a Var into an expression. Only a value of type Expr can be spliced. If you created an instance of Expr our of your var via the Expr.Var constructor, then the splicing would be possible:
let var = Expr.Var( Var("myvar", typeof<int>) )
let op = <## fun l -> %%var ##>
But this won't let you do what you're trying to do: you can't splice an expression in a pattern position (the left side of an arrow -> inside a match is what we call a "pattern", and so is the left side of equal sign = inside a let). You can only splice expressions, not other parts of the syntax. F# code quotations are not quite as free-for-all as Lisp macros or TemplateHaskell.
Admittedly, it is not entirely clear what you're actually trying to do.
One possibility of your true intent that comes to mind is this: you want to match this variable on the left side of the arrow ->, then pass it to some other function which would construct the right side of the arrow ->. Something like this:
let mkRightSide var = <## %%var + 42 ##>
let var = Expr.Var( Var("myvar", typeof<int>) )
let op = <## fun l -> match l with
| [] -> 0
| %%var :: _ -> %%(mkRightSide var) // Doesn't compile
##>
Which would yield the following quotation:
fun l -> match l with
| [] -> 0
| myvar :: _ -> myvar + 42
If this is your intent, then I suggest having mkRightSide return a function, which would simply take myvar as a parameter:
let mkRightSide = <## fun myvar -> myvar + 42 ##>
let op = <## fun l -> match l with
| [] -> 0
| (myvar:int) :: _ -> (%%mkRightSide) myvar ##>
The above would yield the following quotation:
fun l -> match l with
| [] -> 0
| myvar :: _ -> (fun myvar -> myvar + 42) myvar
Note 1: the type annotation on myvar is necessary because your quotations are untyped. Since mkRigthSide carries no type information, the compiler can't infer myvar to be int and makes it generic instead, which causes type mismatch when the splicing is attempted.
Note 2: the parentheses around (%%mkRightSide) are necessary. Without them, the compiler would understand it as %%(mkRightSide myvar), because function application has a higher priority than the %% operator.
If I am wrong in guessing your intent, please clarify it, and I'll be happy to amend the answer.

Related

Pattern matching warning

I am using patternmatching within a function as follows :
let rec calculate : Calculation<MyType> -> MyVO -> Calculation<MyType list>=
fun c l ->
fun arrayA arrayC ->
myComputationExpression {
if arrayA.Length<>arrayC.Length then
yield! l
else
match arrayA, arrayC with
| [], [] -> yield! C
| [a], [c] -> yield! calculate a c
| headA :: tailA, headC :: tailC ->
yield! calculateOpenAny headA headC
yield! calculate c l tailA tailC
}
I have the following warning :
Fsc: C:\myfile.fs(17,27): warning FS0025: Incomplete pattern matches on this expression. For example, the value '( _ , [_] )' may indicate a case not covered by the pattern(s).
I quite don't get it because, it should not happen becuse of the first conditionnal statement :
if arrayA.Length<>arrayC.Length then
Is there something I am missing here, or could I overlook the warning?
The problem is that the compiler is not all-seeing. It can prove some things, but it cannot analyse your program fully, paying attention to semantics, like a human could.
In particular, the compiler doesn't know the relationship between the value of property .Length and the shape of the list (i.e. whether it's empty or not). From the compiler's point of view, Length is just a random property, you might as well have compared the results of .ToString() calls.
A better way to go about this would be incorporating different-lengths case in the pattern match:
let rec calculate : Calculation<MyType> -> MyVO -> Calculation<MyType list>=
fun c l ->
fun arrayA arrayC ->
myComputationExpression {
match arrayA, arrayC with
| [], [] -> yield! C
| [a], [c] -> yield! calculate a c
| headA :: tailA, headC :: tailC ->
yield! calculateOpenAny headA headC
yield! calculate c l tailA tailC
| _, _ -> yield! l
}
An additional bonus here would be performance: computing length of a list is actually an O(n) operation, so you'd do better by avoiding it.
On an unrelated note, keep in mind that all of these are equivalent:
fun a -> fun b -> fun c -> ...
fun a -> fun b c -> ...
fun a b -> fun c -> ...
fun a b c -> ...
This is because of how parameters work in F# (and in all of ML family): functions take parameters "one by one", not all at once, at each step returning another function that "expects" the rest of parameters. This is called "currying". Functions in F# are curried by default.
In your case this means that your function could be declared shorter like this:
let rec calculate =
fun c l arrayA arrayC ->
...
Or even shorter like this:
let rec calculate c l arrayA arrayC =
...

Can I make return type vary with parameter a bit like sprintf in F#?

In the F# core libraries there are functions whose signature seemingly changes based on the parameter at compile-time:
> sprintf "Hello %i" ;;
val it : (int -> string) = <fun:it#1>
> sprintf "Hello %s" ;;
val it : (string -> string) = <fun:it#2-1>
Is it possible to implement my own functions that have this property?
For example, could I design a function that matches strings with variable components:
matchPath "/products/:string/:string" (fun (category : string) (sku : string) -> ())
matchPath "/tickets/:int" (fun (id : int) -> ())
Ideally, I would like to do avoid dynamic casts.
There are two relevant F# features that make it possible to do something like this.
Printf format strings. The compiler handles format strings like "hi %s" in a special way. They are not limited just to printf and it's possible to use those in your library in a somewhat different way. This does not let you change the syntax, but if you were happy to specify your paths using e.g. "/products/%s/%d", then you could use this. The Giraffe library defines routef function, which uses this trick for request routing:
let webApp =
choose [
routef "/foo/%s/%s/%i" fooHandler
routef "/bar/%O" (fun guid -> text (guid.ToString()))
]
Type providers. Another option is to use F# type providers. With parameterized type providers, you can write a type that is parameterized by a literal string and has members with types that are generated by some F# code you write based on the literal string parameter. An example is the Regex type provider:
type TempRegex = Regex< #"^(?<Temperature>[\d\.]+)\s*°C$", noMethodPrefix = true >
TempRegex().Match("21.3°C").Temperature.TryValue
Here, the regular expression on the first line is static parameter of the Regex type provider. The type provider generates a Match method which returns an object with properties like Temperature that are based on the literal string. You would likely be able to use this and write something like:
MatchPath<"/products/:category/:sku">.Match(fun r ->
printfn "Got category %s and sku %s" r.Category r.Sku)
I tweaked your example so that r is an object with properties that have names matching to those in the string, but you could use a lambda with multiple parameters too. Although, if you wanted to specify types of those matches, you might need a fancier syntax like "/product/[category:int]/[sku:string]" - this is just a string you have to parse in the type provider, so it's completely up to you.
1st: Tomas's answer is the right answer.
But ... I had the same question.
And while I could understand it conceptually as "it has to be 'the string format thing' or 'the provider stuff'"
I could not tell my self that I got until I tried an implementation
... And it took me a bit .
I used FSharp.Core's printfs and Giraffe's FormatExpressions.fs as guidelines
And came up with this naive gist/implementation, inspired by Giraffe FormatExpressions.fs
BTW The trick is in this bit of magic fun (format: PrintfFormat<_, _, _, _, 'T>) (handle: 'T -> 'R)
open System.Text.RegularExpressions
// convert format pattern to Regex Pattern
let rec toRegexPattern =
function
| '%' :: c :: tail ->
match c with
| 'i' ->
let x, rest = toRegexPattern tail
"(\d+)" + x, rest
| 's' ->
let x, rest = toRegexPattern tail
"(\w+)" + x, rest
| x ->
failwithf "'%%%c' is Not Implemented\n" x
| c :: tail ->
let x, rest = toRegexPattern tail
let r = c.ToString() |> Regex.Escape
r + x, rest
| [] -> "", []
// Handler Factory
let inline Handler (format: PrintfFormat<_, _, _, _, 'T>) (handle: 'T -> string) (decode: string list -> 'T) =
format.Value.ToCharArray()
|> List.ofArray
|> toRegexPattern
|> fst, handle, decode
// Active Patterns
let (|RegexMatch|_|) pattern input =
let m = Regex.Match(input, pattern)
if m.Success then
let values =
[ for g in Regex(pattern).Match(input).Groups do
if g.Success && g.Name <> "0" then yield g.Value ]
Some values
else
None
let getPattern (pattern, _, _) = pattern
let gethandler (_, handle, _) = handle
let getDecoder (_, _, decode) = decode
let Router path =
let route1 =
Handler "/xyz/%s/%i"
(fun (category, id) ->
// process request
sprintf "handled: route1: %s/%i" category id)
(fun values ->
// convert matches
values |> List.item 0,
values
|> List.item 1
|> int32)
let route2 =
Handler "/xyz/%i"
(fun (id) -> sprintf "handled: route2: id: %i" id) // handle
(fun values -> values|> List.head |> int32) // decode
// Router
(match path with
| RegexMatch (getPattern route2) values ->
values
|> getDecoder route2
|> gethandler route2
| RegexMatch (getPattern route1) values ->
values
|> getDecoder route1
|> gethandler route1
| _ -> failwith "No Match")
|> printf "routed: %A\n"
let main argv =
try
let arg = argv |> Array.skip 1 |> Array.head
Router arg
0 // return an integer exit code
with
| Failure msg ->
eprintf "Error: %s\n" msg
-1

What happened to deepMacroExpandUntil

FLINQ and the Quotation Visualizer samples used this function but I cannot find it anywhere. Thanks.
The deepMacroExpandUntil function was quite a simple utility that only did two things:
It replaced all method calls with ReflectedDefinition attribute with the body of the method
It reduced lambda applications, so (fun x -> x * x) (1+2) would become (1+2)*(1+2)
This was quite useful when writing some quotation processing code, but newer versions of F# include ExprShape active patterns that make it quite easy to write quotation processing by hand.
To implement something like deepMacroExpandUntil, you would write something like:
open Microsoft.FSharp.Quotations
/// The parameter 'vars' is an immutable map that assigns expressions to variables
/// (as we recursively process the tree, we replace all known variables)
let rec expand vars expr =
// First recursively process & replace variables
let expanded =
match expr with
// If the variable has an assignment, then replace it with the expression
| ExprShape.ShapeVar v when Map.containsKey v vars -> vars.[v]
// Apply 'expand' recursively on all sub-expressions
| ExprShape.ShapeVar v -> Expr.Var v
| Patterns.Call(body, DerivedPatterns.MethodWithReflectedDefinition meth, args) ->
let this = match body with Some b -> Expr.Application(meth, b) | _ -> meth
let res = Expr.Applications(this, [ for a in args -> [a]])
expand vars res
| ExprShape.ShapeLambda(v, expr) ->
Expr.Lambda(v, expand vars expr)
| ExprShape.ShapeCombination(o, exprs) ->
ExprShape.RebuildShapeCombination(o, List.map (expand vars) exprs)
// After expanding, try reducing the expression - we can replace 'let'
// expressions and applications where the first argument is lambda
match expanded with
| Patterns.Application(ExprShape.ShapeLambda(v, body), assign)
| Patterns.Let(v, assign, body) ->
expand (Map.add v (expand vars assign) vars) body
| _ -> expanded
The following example shows both aspects of the function - it replaces the function foo with its body and then replaces the application, so you end up with (10 + 2) * (10 + 2):
[<ReflectedDefinition>]
let foo a = a * a
expand Map.empty <# foo (10 + 2) #>
EDIT: I also posted the sample to F# snippets.

F# Quotations - traversing into function calls represented by a Value

I've spent a few hours trying to get to grips with F# Quotations, but I've come across a bit of a road block. My requirement is to take simple functions (just integers,+,-,/,*) out of a discriminated union type and generate an expression tree that will eventually be used to generate C code. I know this is possible using Quotations with 'direct' functions.
My problem is that the expression tree seems to terminate with a "Value", and I can't figure out how to traverse into that value.
My questions is
whether this is actually possible in this situation? or are there any other approaches that are worth considering.
type FuncType =
| A of (int -> int -> int)
| B
| C
[<ReflectedDefinition>]
let add x y = x + y
let myFunc1 = A (fun x y -> x + y )
let myFunc2 = A add
let thefunc expr =
match expr with
| A(x) ->
<# x #>
| _ ->
failwith "fail"
printfn "%A" (thefunc myFunc1) // prints "Value (<fun:myFunc1#14>)"
printfn "%A" (thefunc myFunc2) // prints "Value (<fun:myFunc2#15>)"
printfn "%A" <# fun x y -> x + y #> // generates usable expression tree
Quotations represent the F# code that was quoted syntactically. This means that if you write something like <# x #>, the quotation will contain just Value case specifying that you quoted something which has the specified value. (Variables are automatically replaced with values if the variable is defined outside of the quotation).
You can only get quotation of code that was explicitly quoted using <# .. #> or of a function that was marked as ReflectedDefinition and is referred to by name in a quotation (e.g. <# add #> but not for example let f = add in <# f #>).
To be able to do what your snippet suggests, you'll need to store quotations in your FuncType too (so that the lambda function that you write is also quoted and you can get its body). Something like:
type FuncType =
| A of Expr<int -> int -> int>
| B | C
[<ReflectedDefinition>]
let add x y = x + y
let myFunc1 = A <# fun x y -> x + y #>
let myFunc2 = A <# add #>
let thefunc expr =
match expr with
| A(x) -> x
| _ -> failwith "fail"
This should work for functions marked as ReflectedDefinition too. To extract the body of the function you need to add something like (you'll need to substitute arguments of the function for parameters, but this should give you some idea):
match expr with
| Lambdas(_, body) ->
match body with
| Call(_, mi, _) when Expr.TryGetReflectedDefinition(mi) <> None ->
let func = Expr.TryGetReflectedDefinition(mi)
match func with
| Some(Lambdas(_, body)) ->
// 'body' is the quotation of the body
| _ -> failwith "Not supported function"
| _ -> failwith "Not supported function"
| _ -> failwith "Not supported expression"

Generating parameterized F# quotations

Let's say we have a simple F# quotation:
type Pet = { Name : string }
let exprNonGeneric = <## System.Func(fun (x : Pet) -> x.Name) ##>
The resulting quotation is like:
val exprNonGeneri : Expr =
NewDelegate (System.Func`2[[FSI_0152+Pet, FSI-ASSEMBLY, Version=0.0.0.0, Culture=neutral, PublicKeyToken=null],[System.String, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089]],
x, PropertyGet (Some (x), System.String Name, []))
Now I want to generalize it, so I instead of type "Pet" and property "Name" I could use an arbitrary type and method/property defined on it. Here is what I am trying to do:
let exprGeneric<'T, 'R> f = <## System.Func<'T, 'R>( %f ) ##>
let exprSpecialized = exprGeneric<Pet, string> <# (fun (x : Pet) -> x.Name) #>
The resulting expression is now different:
val exprSpecialized : Expr =
NewDelegate (System.Func`2[[FSI_0152+Pet, FSI-ASSEMBLY, Version=0.0.0.0, Culture=neutral, PublicKeyToken=null],[System.String, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089]],
delegateArg,
Application (Lambda (x,
PropertyGet (Some (x), System.String Name, [])),
delegateArg))
As you can see, the difference between the first and the second expression is that in first case the top level NewDelegate expression contains PropertyGet, while the second expression wraps PropertyGet in a Application/Lambda expression. And when I pass this expression to an external code it does not expect such expression structure and fails.
So I need some way to build a generalized version of quotation, so when it gets specialized, the resulting quotation is an exact match of <## System.Func(fun (x : Pet) -> x.Name) ##>. Is this possible? Or it there only choice to manually apply pattern matching to a generated quotation and transform it to what I need?
UPDATE. As a workaround I implemented the following adapter:
let convertExpr (expr : Expr) =
match expr with
| NewDelegate(t, darg, appl) ->
match (darg, appl) with
| (delegateArg, appl) ->
match appl with
| Application(l, ldarg) ->
match (l, ldarg) with
| (Lambda(x, f), delegateArg) ->
Expr.NewDelegate(t, [x], f)
| _ -> expr
| _ -> expr
| _ -> expr
It does the job - I can now convert expression from 1st to 2nd form. But I am interested in finding out if this can be achieved in a simple way, without traversing expression trees.
I don't think it will be possible to do this; in the second case, you are plugging in the expression <# (fun (x : Pet) -> x.Name) #>, which is represented using a Lambda node, into the hole in the other expression. The compiler does not simplify expressions during this plugging process, so the Lambda node won't be removed no matter what you do.
However your pattern matching workaround can be greatly simplified:
let convertExpr = function
| NewDelegate(t, [darg], Application(Lambda(x,f), Var(arg)))
when darg = arg -> Expr.NewDelegate(t, [x], f)
| expr -> expr
In fact, your more complicated version is incorrect. This is because the delegateArg in your innermost pattern is not matching against the value of the previously bound delegateArg identifier from the outer pattern; it is a new, freshly bound identifier which also happens to be called delegateArg. In fact, the outer delegateArg identifier has type Var list while the inner one has type Expr! However, given the limited range of expression forms generated by the compiler your broken version may not be problematic in practice.
EDIT
Regarding your followup questions, if I understand you correctly it may not be possible to achieve what you want. Unlike C#, where x => x + 1 could be interpreted as having a type of either Func<int,int> or Expression<Func<int,int>>, in F# fun x -> x + 1 is always of type int->int. If you want to get a value of type Expr<int->int> then you generally need to use the quotation operator (<# #>).
There is one alternative that may be of use, however. You can use the [<ReflectedDefinition>] attribute on let bound functions to make their quotations available as well. Here's an example:
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.ExprShape
open Microsoft.FSharp.Quotations.Patterns
open Microsoft.FSharp.Quotations.DerivedPatterns
let rec exprMap (|P|_|) = function
| P(e) -> e
| ShapeVar(v) -> Expr.Var v
| ShapeLambda(v,e) -> Expr.Lambda(v, exprMap (|P|_|) e)
| ShapeCombination(o,l) -> RebuildShapeCombination(o, l |> List.map (exprMap (|P|_|)))
let replaceDefn = function
| Call(None,MethodWithReflectedDefinition(e),args)
-> Some(Expr.Applications(e, [args]))
| _ -> None
(* plugs all definitions into an expression *)
let plugDefs e = exprMap replaceDefn e
[<ReflectedDefinition>]
let f x = x + 1
(* inlines f into the quotation since it uses the [<ReflectedDefinition>] attribute *)
let example = plugDefs <# fun y z -> (f y) - (f 2) #>

Resources