Embed a variable inside an F# quotation - reflection

I'm writing an F# dsl for SQL (http://github.com/kolosy/furious).
A select statement would look like this:
type person = {
personId: string
firstname: string
lastname: string
homeAddress: address
workAddress: address
altAddresses: address seq
}
and address = {
addressId: string
street1: string
zip: string
}
let (neighbor: person seq) =
db.Yield <# Seq.filter (fun p -> p.homeAddress.zip = '60614') #>
The obvious (and silly) question is... How do I parametrize the quotation?
If I just somehting like:
let z = "60614"
let (neighbor: person seq) =
db.Yield <# Seq.filter (fun p -> p.homeAddress.zip = z) #>
then z gets resolved into a static property accessor (PropertyGet(None, String z, [])). I need something that will let me retrieve the value of the variable/let binding based solely on the quotation. Ideas?

Quotations are not my forte, but check out the difference here:
let z = "60614"
let foo = <# List.filter (fun s -> s = z) #>
printfn "%A" foo
let foo2 =
let z = z
<# List.filter (fun s -> s = z) #>
printfn "%A" foo2
I think maybe having 'z' be local to the expression means the value is captured, rather than a property reference.

In addition to what Brian wrote - I believe that the encoding of access to global let bound values is also pretty stable and they will quite likely continue to be encoded as PropGet in the future.
This means that you could support this case explicitly in your translator and add a simple pre-processing step to get values of these properties. This can be done using ExprShape (which allows you to fully traverse quotation just using 4 cases). This would allow your DSL to support the general case as well.
The following function traverses quotation and replaces access to global lets with their value:
open Microsoft.FSharp.Quotations
let rec expand e =
match e with
// Extract value of global 'let' bound symbols
| Patterns.PropertyGet(None, pi, []) ->
Expr.Value(pi.GetValue(null, [| |]), e.Type)
// standard recursive processing of quotations
| ExprShape.ShapeCombination(a, b) ->
ExprShape.RebuildShapeCombination(a, b |> List.map expand)
| ExprShape.ShapeLambda(v, b) -> Expr.Lambda(v, expand b)
| ExprShape.ShapeVar(v) -> Expr.Var(v)
Then you can write the following to get a quotation that contains value instead of PropGet:
let z = 5
let eOrig = <# Seq.filter (fun p -> p = z) [ 1 .. 10 ]#>
let eNice = expand eOrig

Related

How can I determine the json path to a field within a record without actually hard coding the path?

I would like to work with the following type
type RecordPath<'a,'b> = {
Get: 'a -> 'b
Path:string
}
It's purpose is to define a getter for going from record type 'a to some field within 'a of type 'b. It also gives the path to that field for the json representation of the record.
For example, consider the following fields.
type DateWithoutTimeBecauseWeirdlyDotnetDoesNotHaveThisConcept = {
Year:uint
Month:uint
Day:uint
}
type Person = {
FullName:string
PassportNumber:string
BirthDate:DateWithoutTimeBecauseWeirdlyDotnetDoesNotHaveThisConcept
}
type Team = {
TeamName:string
TeamMembers:Person list
}
An example RecordPath might be
let birthYearPath = {
Get = fun (team:Team) -> team.TeamMembers |> List.map (fun p -> p.BirthDate.Year)
Path = "$.TeamMember[*].BirthDate.Year" //using mariadb format for json path
}
Is there some way of letting a library user create this record without ever actually needing to specify the string explicitly. Ideally there is some strongly typed way of the user specifying the fields involved. Maybe some kind of clever use of reflection?
It just occurred to me that with a language that supports macros, this would be possible. But can it be done in F#?
PS: I notice that I left out the s in "TeamMembers" in the path. This is the kind of thing I want to guard against to make it easier on the user.
As you noted in the comments, F# has a quotation mechanism that lets you do this. You can create those explicitly using <# ... #> notation or implicitly using a somewhat more elengant automatic quoting mechanism. The quotations are farily close representations of the F# code, so converting them to the desired path format is not going to be easy, but I think it can be done.
I tried to get this to work at least for your small example. First, I needed a helper function that does two transformations on the code and turns:
let x = e1 in e2 into e2[x <- e1] (using the notation e2[x <- e1] to mean a subsitution, i.e. expression e2 with all occurences of x replaced by e1)
e1 |> fun x -> e2 into e2[x <- e1]
This is all I needed for your example, but it's likely you'll need a few more cases:
open Microsoft.FSharp.Quotations
let rec simplify dict e =
let e' = simplifyOne dict e
if e' <> e then simplify dict e' else e'
and simplifyOne dict = function
| Patterns.Call(None, op, [e; Patterns.Lambda(v, body)])
when op.Name = "op_PipeRight" ->
simplify (Map.add v e dict) body
| Patterns.Let(v, e, body) -> simplify (Map.add v e dict) body
| ExprShape.ShapeVar(v) when Map.containsKey v dict -> dict.[v]
| ExprShape.ShapeVar(v) -> Expr.Var(v)
| ExprShape.ShapeLambda(v, e) -> Expr.Lambda(v, simplify dict e)
| ExprShape.ShapeCombination(o, es) ->
ExprShape.RebuildShapeCombination(o, List.map (simplify dict) es)
With this pre-processing, I managed to write an extractPath function like this:
let rec extractPath var = function
| Patterns.Call(None, op, [Patterns.Lambda(v, body); inst]) when op.Name = "Map" ->
extractPath var inst + "[*]." + extractPath v.Name body
| Patterns.PropertyGet(Some(Patterns.Var v), p, []) when v.Name = var -> p.Name
| Patterns.PropertyGet(Some e, p, []) -> extractPath var e + "." + p.Name
| e -> failwithf "Unexpected expression: %A" e
This looks for (1) a call to map function, (2) a property access on a variable that represents the data source and (3) a property access where the instance has some more property accesses.
The following now works for your small example (but probably for nothing else!)
type Path =
static member Make([<ReflectedDefinition(true)>] f:Expr<'T -> 'R>) =
match f with
| Patterns.WithValue(f, _, Patterns.Lambda(v, body)) ->
{ Get = f :?> 'T -> 'R
Path = "$." + extractPath v.Name (simplify Map.empty body) }
| _ -> failwith "Unexpected argument"
Path.Make(fun (team:Team) -> team.TeamMembers |> List.map (fun p -> p.BirthDate.Year))
The way I solved this is
let jsonPath userExpr =
let rec innerLoop expr state =
match expr with
|Patterns.Lambda(_, body) ->
innerLoop body state
|Patterns.PropertyGet(Some parent, propInfo, []) ->
sprintf ".%s%s" propInfo.Name state |> innerLoop parent
|Patterns.Call (None, _, expr1::[Patterns.Let (v, expr2, _)]) when v.Name = "mapping"->
let parentPath = innerLoop expr1 "[*]"
let childPath = innerLoop expr2 ""
parentPath + childPath
|ExprShape.ShapeVar x ->
state
|_ ->
failwithf "Unsupported expression: %A" expr
innerLoop userExpr "" |> sprintf "$%s"
type Path =
static member Make([<ReflectedDefinition(true)>] f:Expr<'T -> 'R>) =
match f with
|Patterns.WithValue(f, _, expr) ->
let path = jsonPath expr
{
Get = f :?> 'T -> 'R
Path = path
}
| _ -> failwith "Unexpected argument"
Caveat: I don't know enough about these techniques to tell if Tomas' answer performs better in some edge cases than mine.

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 a cached recursive type?

open System
open System.Collections.Generic
type Node<'a>(expr:'a, symbol:int) =
member x.Expression = expr
member x.Symbol = symbol
override x.GetHashCode() = symbol
override x.Equals(y) =
match y with
| :? Node<'a> as y -> symbol = y.Symbol
| _ -> failwith "Invalid equality for Node."
interface IComparable with
member x.CompareTo(y) =
match y with
| :? Node<'a> as y -> compare symbol y.Symbol
| _ -> failwith "Invalid comparison for Node."
type Ty =
| Int
| String
| Tuple of Ty list
| Rec of Node<Ty>
| Union of Ty list
type NodeDict<'a> = Dictionary<'a,Node<'a>>
let get_nodify_tag =
let mutable i = 0
fun () -> i <- i+1; i
let nodify (dict: NodeDict<_>) x =
match dict.TryGetValue x with
| true, x -> x
| false, _ ->
let x' = Node(x,get_nodify_tag())
dict.[x] <- x'
x'
let d = Dictionary(HashIdentity.Structural)
let nodify_ty x = nodify d x
let rec int_string_stream =
Union
[
Tuple [Int; Rec (nodify_ty (int_string_stream))]
Tuple [String; Rec (nodify_ty (int_string_stream))]
]
In the above example, the int_string_stream gives a type error, but it neatly illustrates what I want to do. Of course, I want both sides to get tagged with the same symbol in nodify_ty. When I tried changing the Rec type to Node<Lazy<Ty>> I've found that it does not compare them correctly and each sides gets a new symbol which is useless to me.
I am working on a language, and the way I've dealt with storing recursive types up to now is by mapping Rec to an int and then substituting that with the related Ty in a dictionary whenever I need it. Currently, I am in the process of cleaning up the language, and would like to have the Rec case be Node<Ty> rather than an int.
At this point though, I am not sure what else could I try here. Could this be done somehow?
I think you will need to add some form of explicit "delay" to the discriminated union that represents your types. Without an explicit delay, you'll always end up fully evaluating the types and so there is no potential for closing the loop.
Something like this seems to work:
type Ty =
| Int
| String
| Tuple of Ty list
| Rec of Node<Ty>
| Union of Ty list
| Delayed of Lazy<Ty>
// (rest is as before)
let rec int_string_stream = Delayed(Lazy.Create(fun () ->
Union
[
Tuple [Int; Rec (nodify_ty (int_string_stream))]
Tuple [String; Rec (nodify_ty (int_string_stream))]
]))
This will mean that when you pattern match on Ty, you'll always need to check for Delayed, evaluate the lazy value and then pattern match again, but that's probably doable!

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

F# stop Seq.map when a predicate evaluates true

I'm currently generating a sequence in a similar way to:
migrators
|> Seq.map (fun m -> m())
The migrator function is ultimately returning a discriminated union like:
type MigratorResult =
| Success of string * TimeSpan
| Error of string * Exception
I want to stop the map once I encounter my first Error but I need to include the Error in the final sequence.
I have something like the following to display a final message to the user
match results |> List.rev with
| [] -> "No results equals no migrators"
| head :: _ ->
match head with
| Success (dt, t) -> "All migrators succeeded"
| Error (dt, ex) -> "Migration halted owing to error"
So I need:
A way to stop the mapping when one of the map steps produces an Error
A way to have that error be the final element added to the sequence
I appreciate there may be a different sequence method other than map that will do this, I'm new to F# and searching online hasn't yielded anything as yet!
I guess there are multiple approaches here, but one way would be to use unfold:
migrators
|> Seq.unfold (fun ms ->
match ms with
| m :: tl ->
match m () with
| Success res -> Some (Success res, tl)
| Error res -> Some (Error res, [])
| [] -> None)
|> List.ofSeq
Note the List.ofSeq at the end, that's just there for realizing the sequence. A different way to go would be to use sequence comprehensions, some might say it results in a clearer code.
The ugly things Tomaš alludes to are 1) mutable state, and 2) manipulation of the underlying enumerator. A higher-order function which returns up to and including when the predicate holds would then look like this:
module Seq =
let takeUntil pred (xs : _ seq) = seq{
use en = xs.GetEnumerator()
let flag = ref true
while !flag && en.MoveNext() do
flag := not <| pred en.Current
yield en.Current }
seq{1..10} |> Seq.takeUntil (fun x -> x % 5 = 0)
|> Seq.toList
// val it : int list = [1; 2; 3; 4; 5]
For your specific application, you'd map the cases of the DU to a boolean.
(migrators : seq<MigratorResult>)
|> Seq.takeUntil (function Success _ -> false | Error _ -> true)
I think the answer from #scrwtp is probably the nicest way to do this if your input is reasonably small (and you can turn it into an F# list to use pattern matching). I'll add one more version, which works when your input is just a sequence and you do not want to turn it into a list.
Essentially, you want to do something that's almost like Seq.takeWhile, but it gives you one additional item at the end (the one, for which the predicate fails).
To use a simpler example, the following returns all numbers from a sequence until one that is divisible by 5:
let nums = [ 2 .. 10 ]
nums
|> Seq.map (fun m -> m % 5)
|> Seq.takeWhile (fun n -> n <> 0)
So, you basically just need to look one element ahead - to do this, you could use Seq.pairwise which gives you the current and the next element in the sequence"
nums
|> Seq.map (fun m -> m % 5)
|> Seq.pairwise // Get sequence of pairs with the next value
|> Seq.takeWhile (fun (p, n) -> p <> 0) // Look at the next value for test
|> Seq.mapi (fun i (p, n) -> // For the first item, we return both
if i = 0 then [p;n] else [n]) // for all other, we return the second
|> Seq.concat
The only ugly thing here is that you then need to flatten the sequence again using mapi and concat.
This is not very nice, so a good thing to do would be to define your own higher-order function like Seq.takeUntilAfter that encapsulates the behavior you need (and hides all the ugly things). Then your code could just use the function and look nice & readable (and you can experiment with other ways of implementing this).

Resources