Quotations and pattern matching in F# - f#

In a new console application, just pasting the following code leads to the exception "The parameter is not a recognized method name".
Does the following code work on your installation?
Joker: Do you know any reason why it would not work on mine?
// Learn more about F# at http://fsharp.net
// See the 'F# Tutorial' project for more help.
let somefunction1 arg = ()
let somefunction2 () = ()
open Quotations.DerivedPatterns
let test() =
let d = <# somefunction1() #>
let e = <# somefunction2() #>
match d with
| SpecificCall <# somefunction1() #> (a,b ,c) -> printfn "somefunction"
| _ -> printfn "something else"
match d with
| SpecificCall <# somefunction1 #> (a,b ,c) -> printfn "somefunction"
| _ -> printfn "something else"
match e with
| SpecificCall <# somefunction2() #> (a,b ,c) -> printfn "somefunction"
| _ -> printfn "something else"
//THIS FAILS HERE saying "The parameter is not a recognized method name"
match e with
| SpecificCall <# somefunction2 #> (a,b ,c) -> printfn "somefunction"
| _ -> printfn "something else"
[<EntryPoint>]
let main argv =
test()
printfn "%A" argv
0 // return an integer exit code
Looking at the definition of active pattern SpecificCall defined in the compiler I find:
[<CompiledName("SpecificCallPattern")>]
let (|SpecificCall|_|) templateParameter =
// Note: precomputation
match templateParameter with
| (Lambdas(_,Call(_,minfo1,_)) | Call(_,minfo1,_)) ->
let isg1 = minfo1.IsGenericMethod
let gmd = if isg1 then minfo1.GetGenericMethodDefinition() else null
// end-of-precomputation
(fun tm ->
match tm with
| Call(obj,minfo2,args)
#if FX_NO_REFLECTION_METADATA_TOKENS
when (minfo1.MethodHandle = minfo2.MethodHandle &&
#else
when (minfo1.MetadataToken = minfo2.MetadataToken &&
#endif
if isg1 then
minfo2.IsGenericMethod && gmd = minfo2.GetGenericMethodDefinition()
else
minfo1 = minfo2) ->
Some(obj,(minfo2.GetGenericArguments() |> Array.toList),args)
| _ -> None)
| _ ->
invalidArg "templateParameter" (SR.GetString(SR.QunrecognizedMethodCall))

Offhand, that looks okay to me... Is it possible that you've shadowed the original definition of var somehow? For instance, the following self-contained example works fine for me:
let var<'a>() = Unchecked.defaultof<'a>
match <# var<int>() #> with
| Quotations.DerivedPatterns.SpecificCall <# var #> (obj,_,[]) ->
printfn "var"
| _ -> printfn "something else"

Related

How to use bind and map in place of nested matches

F# 6.0.3
I have seen some solutions on Google that are close to what I need; but being a Newbie I can't quite get how to use bind and map to get the solution.
I have many working procedures of the following format:
Example #1:
let saveAllDiagnosis =
let savealldiagnosis = match m.Encounter with
| None -> failwith "No encounter found"
| Some e -> match e.EncounterId with
| None -> failwith "No Encounter id found"
| Some id -> m.AllDiagnosisList
|> List.iter ( fun dx -> match dx.Key with
| None -> ()
| Some k -> Async.RunSynchronously (editAllDiagnosisInPreviousEncountersAsync id dx))
savealldiagnosis
Example #2
let saveEncounterDiagnosis =
let savedx = match m.Encounter with
| None -> failwith "No encounter found"
| Some e -> match e.EncounterId with
| None -> failwith "No Encounter id found"
| Some id -> m.BillingDiagnosisList |> List.iter ( fun dx -> Async.RunSynchronously (saveDxAsync id dx))
savedx
As can be seen, these are nested methods with almost identical behavior--differing only in the async procedure being called and the initializing list. What I would like to do is something along the lines of:
let runProcedures (fn: Model->Async) Model = ????
That is, a single procedue that encapsulates everything except the Async method and it's parameters but manages all the "None"s in a better way.
I hope my intent is clear.
TIA
If you are happy with using exceptions, then you do not even need railway-oriented programming (ROP). ROP is useful for more complex validation tasks, but I think exceptions are often perfectly reasonable and easy way of handling errors. In your case, you could define a helper that extracts a value of option<'T> or fails with a given error message:
let orFailWith msg opt =
match opt with
| Some v -> v
| None -> failwithf "%s" msg
Using this, you can then rewrite your code as follows:
let saveAllDiagnosis =
let e = m.Encounter |> orFailWith "No encounter found"
let id = e.EncounterId |> orFailWith "No Encounter id found"
for dx in m.AllDiagnosisList do
dx.Key |> Option.iter (fun k ->
editAllDiagnosisInPreviousEncountersAsync id dx |> Async.RunSynchronously)
let saveEncounterDiagnosis =
let e = m.Encounter |> orFailWith "No encounter found"
let id = e.EncounterId |> orFailWith "No Encounter id found"
for dx in m.BillingDiagnosisList do
saveDxAsync id dx |> Async.RunSynchronously
As I do not know the broader context of this, it is hard to say more - your code is imperative, but that may be perfectly fine if you are following the sandwich pattern.
Using mentioned ROP code can be rewritten as such. Result is used to track error and throw it at the end of pipeline. With current design is possible to avoid exceptions by just logging error instead of throwing at before last line.
type Encounter = { EncounterId : int option }
type Diagnostic = { Key : int option }
type Thing = {
Encounter : Encounter option
AllDiagnosisList : Diagnostic list
}
let editAllDiagnosisInPreviousEncountersAsync id diag = async { return () }
module Result =
let ofOption err opt =
match opt with
| Some v -> Ok v
| None -> Error err
let join res =
match res with
| Error v
| Ok v -> v
let saveAllDiagnosis m =
m.Encounter
|> Result.ofOption "No encounter found" // get value from option or log error
|> Result.map (fun e -> e.EncounterId)
|> Result.bind (Result.ofOption "No Encounter id found") // get EncounterId or log error
|> Result.map (fun id -> (
m.AllDiagnosisList
|> Seq.where (fun dx -> dx.Key.IsSome)
|> Seq.iter (fun dx -> Async.RunSynchronously (editAllDiagnosisInPreviousEncountersAsync id dx))
))
|> Result.mapError failwith // throw error
|> Result.join // Convert Result<unit, unit> into unit
The solutions posted above are very helpful to this newbie. But adding my own two cents worth, I going with this:
let _deleteDxFromEncounterAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = deleteDxFromEncounterAsync encounterId dx.Description
let _deleteDxFromAllPreviousEncountersAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = deleteDxFromAllPreviousEncountersAsync encounterId dx.Description
let _saveDxAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = saveDxAsync encounterId dx
let _editAllDiagnosisInPreviousEncountersAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = editAllDiagnosisInPreviousEncountersAsync encounterId dx
let listchk (dxs:Diagnosis list) : Diagnosis list option =
match dxs with
| [] -> None
| _ -> Some dxs
let _save (fn:int -> Diagnosis-> Async<unit>) (dxs:Diagnosis list) : unit =
match dxs |> listchk, m.Encounter |> Option.bind (fun v -> v.EncounterId) with
| Some dxs, Some id -> dxs |> List.iter (fun dx -> Async.RunSynchronously(fn id dx))
| _,_ -> failwith "Missing Encounter or EncounterId or Empty List"
m.DeletedBillingDiagnosis |>_save _deleteDxFromEncounterAsync
m.DeletedAllDiagnosis |>_save _deleteDxFromAllPreviousEncountersAsync
m.BillingDiagnosisList |>_save _saveDxAsync
m.AllDiagnosisList |> List.filter (fun dx -> dx.Key.IsSome) |>_save _editAllDiagnosisInPreviousEncountersAsync
For speed, in the future, I will probably have the Async functions act on the entire list at one time rather then one item; but for now, this code comes closest to my intent in asking the question. IMPROVEMENTS AND CRITISM IS GLADDLY APPRECIATED! F# is fun!
Thanks to all.

InvalidOperationException on conversion from F# quotation to Linq Expression

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)))

Quotation Transformation in F# to another type

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 #>

Match an Array in F#

I want to pattern match on the command line arguments array.
What I want to do is have a case that matches any case where there's at least one parameter or more and put that first parameter in a variable and then have another case that handles when there are no parameters.
match argv with
| [| first |] -> // this only matches when there is one
| [| first, _ |] -> // this only matches when there is two
| [| first, tail |] -> // not working
| argv.[first..] -> // this doesn't compile
| [| first; .. |] -> // this neither
| _ -> // the other cases
You can use truncate:
match args |> Array.truncate 1 with
| [| x |] -> x
| _ -> "No arguments"
If you convert argv to a list using Array.toList, you can then pattern match on it as a list using the cons operator, :::
match argv |> Array.toList with
| x::[] -> printfn "%s" x
| x::xs -> printfn "%s, plus %i more" x (xs |> Seq.length)
| _ -> printfn "nothing"
The closest thing you'll get without converting to a list is:
match argv with
| arr when argv.Length > 0 ->
let first = arr.[0]
printfn "%s" first
| _ -> printfn "none"
If you just want the first item, I prefer Array.tryHead:
match Array.tryHead items with
| Some head -> printfn "%O" head
| None -> printfn "%s" "No items"

Pattern matching numeric strings

I have a function that pattern matches its argument, which is a string:
let processLexime lexime
match lexime with
| "abc" -> ...
| "bar" -> ...
| "cat" -> ...
| _ -> ...
This works as expected. However, I'm now trying to extend this by expressing "match a string containing only the following characters". In my specific example, I want anything containing only digits to be matched.
My question is, how can I express this in F#? I'd prefer to do this without any libraries such as FParsec, since I'm mainly doing this for learning purposes.
You can use active patterns: https://msdn.microsoft.com/en-us/library/dd233248.aspx
let (|Integer|_|) (str: string) =
let mutable intvalue = 0
if System.Int32.TryParse(str, &intvalue) then Some(intvalue)
else None
let parseNumeric str =
match str with
| Integer i -> printfn "%d : Integer" i
| _ -> printfn "%s : Not matched." str
One way would be an active pattern
let (|Digits|_|) (s:string) =
s.ToCharArray() |> Array.forall (fun c -> System.Char.IsDigit(c)) |> function |true -> Some(s) |false -> None
then you can do
match "1" with
|Digits(t) -> printf "matched"
I would use regular expressions combined with active patterns. With regular expressions you can easily match digits with \d and active patterns makes the syntax nice inside your match.
open System.Text.RegularExpressions
let (|ParseRegex|_|) regex str =
let m = Regex("^"+regex+"$").Match(str)
if (m.Success) then Some true else None
let Printmatch s =
match s with
| ParseRegex "w+" d -> printfn "only w"
| ParseRegex "(w+|s+)+" d -> printfn "only w and s"
| ParseRegex "\d+" d -> printfn "only digis"
|_ -> printfn "wrong"
[<EntryPoint>]
let main argv =
Printmatch "www"
Printmatch "ssswwswwws"
Printmatch "134554"
Printmatch "1dwd3ddwwd"
0
which prints
only w
only w and s
only digis
wrong

Resources