QuotationBinder

open System
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.Patterns
open Microsoft.FSharp.Quotations.ExprShape

[<RequireQualifiedAccess>]
module Expr =

    let [<Literal>] opSliceName = "SpliceExpression"
    let [<Literal>] fsNamespace = "Microsoft.FSharp.Core"
    let [<Literal>] opSliceType = "ExtraTopLevelOperators"
         
    let fsCoreAs = AppDomain.CurrentDomain.GetAssemblies() |> Seq.find (fun a -> a.GetName().Name = "FSharp.Core")
    let miSplice = fsCoreAs.GetType(fsNamespace + "." + opSliceType).GetMethod opSliceName
        
    let bind (f:'a->Expr<'b>) (x:Expr<'a>): Expr<'b> =
        Expr.Coerce(Expr.Call(miSplice.MakeGenericMethod(typeof<'b>), [Expr.Application(Expr.Value f, x)]), typeof<'b>)
        |> Expr.Cast

    let rec runWithUntyped (eval:Expr -> obj) (exp:Expr) s =
        let m = if s = null then let x = Reflection.MethodInfo.GetCurrentMethod() in x.DeclaringType.GetMethod x.Name else s
        let rec subsExpr = function
            | Call(None, mi, exprLst) 
                when (mi.Name, mi.DeclaringType.Name, mi.DeclaringType.Namespace) = (opSliceName, opSliceType, fsNamespace)
                -> Expr.Call(m, [Expr.Value eval; subsExpr exprLst.Head; Expr.Value m])
            | ShapeVar var                       -> Expr.Var var
            | ShapeLambda (var, expr)            -> Expr.Lambda (var, subsExpr expr)
            | ShapeCombination(shpComb, exprLst) -> RebuildShapeCombination(shpComb, List.map subsExpr exprLst)
        eval (subsExpr exp)
    let runWith (eval:Expr -> obj) (exp:Expr<'a>) : 'a = runWithUntyped eval exp.Raw null :?> 'a
 
 
// usage
 
let (>>=) x f = Expr.bind f x
let x = <@ 1 @>
let f x = let a = string (x + 10) in <@ a @>
let fx = x >>= f
let fl = (<@ 4 + 5 @> >>= (fun x -> let a = x + 10 in <@ (a,a*a) @>)) >>= (fun (x,y) -> <@ [x+y] , x, y, [|x;y|] @>)
 
#r "FSharp.PowerPack.Linq.dll"
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Linq
 
Expr.runWith QuotationEvaluator.EvaluateUntyped fx
Expr.runWith QuotationEvaluator.EvaluateUntyped fl