Initial implementation

src/FSharpPlus/Control/Monad.fs

@@ -35,6 +35,8 @@ type Bind =
     static member        (>>=) (source             , k: 'T -> _           ) = Result.bind k source                                          : Result<'U,'E>
     static member        (>>=) (source             , k: 'T -> _           ) = Choice.bind k source                                          : Choice<'U,'E>
 
+    static member        (>>=) (source: Expr<'T>   , f: 'T -> Expr<'U>    ) = Expr.bind f source                                            : Expr<'U>
+
     static member (>>=) (source: Map<'Key,'T>, f: 'T -> Map<'Key,'U>) = Map (seq {
                    for KeyValue(k, v) in source do
                        match Map.tryFind k (f v) with
@@ -158,7 +160,7 @@ type Delay =
     static member        Delay (_mthd: Default2, x: unit-> 'R -> _                                        , _          ) = (fun s -> x () s): 'R -> _
     static member        Delay (_mthd: Delay   , x: unit-> _                                              , _          ) = async.Delay x    : Async<'T>
     static member        Delay (_mthd: Delay   , x: unit-> Lazy<_>                                        , _          ) = lazy (x().Value) : Lazy<'T>
-
+    static member        Delay (_mthd: Delay   , x: unit-> Expr<_>                                        , _          ) = Expr.bind x (Return.Invoke ()) : Expr<'T>
 
     static member inline Invoke source : 'R =
         let inline call (mthd: ^M, input: unit -> ^I) = ((^M or ^I) : (static member Delay : _*_*_ -> _) mthd, input, Unchecked.defaultof<Delay>)

src/FSharpPlus/Extensions/Expr.fs

@@ -0,0 +1,36 @@
+namespace FSharpPlus
+
+/// Additional operations on Quotations.Expr
+[<RequireQualifiedAccess>]
+module Expr =
+
+    open System
+    open Microsoft.FSharp.Quotations
+    open Microsoft.FSharp.Quotations.Patterns
+    open Microsoft.FSharp.Quotations.ExprShape
+
+    let [<Literal>] private fsNamespace = "Microsoft.FSharp.Core"
+
+    let [<Literal>] private opSliceName = "SpliceExpression"
+    let [<Literal>] private opSliceType = "ExtraTopLevelOperators"
+
+    let private fsCoreAs = AppDomain.CurrentDomain.GetAssemblies () |> Seq.find (fun a -> a.GetName().Name = "FSharp.Core")
+    let private miSplice = fsCoreAs.GetType(fsNamespace + "." + opSliceType).GetMethod opSliceName
+
+    let bind (f: 'T -> Expr<'U>) (x: Expr<'T>) : Expr<'U> =
+        Expr.Coerce (Expr.Call (miSplice.MakeGenericMethod typeof<'U>, [Expr.Application (Expr.Value f, x)]), typeof<'U>)
+        |> Expr.Cast
+
+    let rec runWithUntyped (eval: Expr -> obj) (exp: Expr) s =
+        let m = if isNull s 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)
+
+    /// Executes quoted expression, given a quotation evaluator function.
+    let run (eval: Expr -> obj) (exp: Expr<'T>) : 'T = runWithUntyped eval exp.Raw null :?> 'T

src/FSharpPlus/FSharpPlus.fsproj

@@ -47,6 +47,7 @@
     <Compile Include="Extensions/Task.fs" />
     <Compile Include="Extensions/Async.fs" />
     <Compile Include="Extensions/Extensions.fs" />
+    <Compile Include="Extensions/Expr.fs" />
     <Compile Include="Extensions/Tuple.fs" />
     <Compile Include="TypeLevel/TypeLevelOperators.fs" />
     <Compile Include="TypeLevel/TypeBool.fs" />