diff --git a/src/FSharpPlus/Control/Monad.fs b/src/FSharpPlus/Control/Monad.fs
index cfbc24936..e6ac44348 100644
--- a/src/FSharpPlus/Control/Monad.fs
+++ b/src/FSharpPlus/Control/Monad.fs
@@ -20,6 +20,7 @@ type Bind =
static member (>>=) (source: seq<'T> , f: 'T -> seq<'U> ) = Seq.bind f source : seq<'U>
#if !FABLE_COMPILER
static member (>>=) (source: Task<'T> , f: 'T -> Task<'U> ) = source.ContinueWith(fun (x: Task<_>) -> f x.Result).Unwrap () : Task<'U>
+ static member (>>=) (source: Expr<'T> , f: 'T -> Expr<'U> ) = Expr.bind f source : Expr<'U>
static member (>>=) (source , f: 'T -> _ ) = Nullable.bind f source : Nullable<'U>
#endif
static member (>>=) (source , f: 'T -> _ ) = Option.bind f source : option<'U>
@@ -158,7 +159,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>)
diff --git a/src/FSharpPlus/Extensions/Expr.fs b/src/FSharpPlus/Extensions/Expr.fs
new file mode 100644
index 000000000..99b3380fa
--- /dev/null
+++ b/src/FSharpPlus/Extensions/Expr.fs
@@ -0,0 +1,44 @@
+namespace FSharpPlus
+
+#if !FABLE_COMPILER
+
+/// 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 [<Literal>] private ubSliceName = "Unbox"
+ let [<Literal>] private ubSliceType = "Operators"
+
+ 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 private ubSplice = fsCoreAs.GetType(fsNamespace + "." + ubSliceType).GetMethod ubSliceName
+
+ let bind (f: 'T -> Expr<'U>) (x: Expr<'T>) : Expr<'U> =
+ Expr.Call (ubSplice.MakeGenericMethod typeof<'U>,
+ [Expr.Call (miSplice.MakeGenericMethod typeof<'U>, [Expr.Application (Expr.Value f, x)])])
+ |> 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
+
+#endif
\ No newline at end of file
diff --git a/src/FSharpPlus/FSharpPlus.fsproj b/src/FSharpPlus/FSharpPlus.fsproj
index 8c18fba5f..f6c84522d 100644
--- a/src/FSharpPlus/FSharpPlus.fsproj
+++ b/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" />
diff --git a/tests/FSharpPlus.Tests/Expr.fs b/tests/FSharpPlus.Tests/Expr.fs
new file mode 100644
index 000000000..9c327d949
--- /dev/null
+++ b/tests/FSharpPlus.Tests/Expr.fs
@@ -0,0 +1,98 @@
+namespace FSharpPlus.Tests
+
+open System
+open NUnit.Framework
+open FSharpPlus
+open FSharpPlus.Tests.Helpers
+
+module Expr =
+
+ let quotseval x =
+#if NETSTANDARD
+ FSharp.Quotations.Evaluator.QuotationEvaluator.EvaluateUntyped x
+#else
+ Swensen.Unquote.Operators.evalRaw x
+#endif
+ let unquote x = Swensen.Unquote.Operators.evalRaw x
+ let powerpack x = Microsoft.FSharp.Linq.QuotationEvaluator.EvaluateUntyped x
+
+
+
+ let ``Simple quotation combination`` evaluator =
+ let one = <@ 1 @>
+ let add10AndToString x =
+ let a = string (x + 10)
+ <@ a @>
+
+ let expr = one >>= add10AndToString
+ let res = Expr.run evaluator expr
+
+ areEqual "11" res
+
+ let [<Test>] ``Simple quotation combination [QuotationEvaluator]`` () = ``Simple quotation combination`` quotseval
+ let [<Test>] ``Simple quotation combination [Unquote]`` () = ``Simple quotation combination`` unquote
+ let [<Test>] ``Simple quotation combination [PowerPack]`` () = ``Simple quotation combination`` powerpack
+
+
+ let ``2-layers quotation combination`` evaluator =
+ let expr =
+ <@ 4 + 5 @>
+ >>= (fun x ->
+ let a = x + 10
+ <@ (a, a*a) @>
+ >>= fun (x, y) ->
+ <@ ([x + y], x, y, [|x; y|]) @>)
+ let res = Expr.run evaluator expr
+
+ areEqual ([380], 19, 361, [|19; 361|]) res
+
+ let [<Test>] ``2-layers quotation combination [QuotationEvaluator]`` () = ``2-layers quotation combination`` quotseval
+ let [<Test>] ``2-layers quotation combination [Unquote]`` () = ``2-layers quotation combination`` unquote
+ let [<Test>] ``2-layers quotation combination [PowerPack]`` () = ``2-layers quotation combination`` powerpack
+
+
+ let ``2-layers quot comb associative`` evaluator =
+ let expr =
+ (<@ 4 + 5 @>
+ >>= fun x ->
+ let a = x + 10
+ <@ (a, a*a) @>)
+ >>= fun (x, y) ->
+ <@ ([x + y], x, y, [|x; y|]) @>
+ let res = Expr.run evaluator expr
+
+ areEqual ([380], 19, 361, [|19; 361|]) res
+
+ let [<Test>] ``2-layers quot comb associative [QuotationEvaluator]`` () = ``2-layers quot comb associative`` quotseval
+ let [<Test>] ``2-layers quot comb associative [Unquote]`` () = ``2-layers quot comb associative`` unquote
+ let [<Test>] ``2-layers quot comb associative [PowerPack]`` () = ``2-layers quot comb associative`` powerpack
+
+
+ let ``simple CE same type`` evaluator =
+ let expr = monad {
+ let! x = <@ 1 @>
+ let! y = <@ 2 @>
+ return! <@ x + y @>
+ }
+ let res = Expr.run evaluator expr
+
+ areEqual 3 res
+
+ let [<Test>] ``simple CE same type [QuotationEvaluator]`` () = ``simple CE same type`` quotseval
+ let [<Test>] ``simple CE same type [Unquote]`` () = ``simple CE same type`` unquote
+ let [<Test>] ``simple CE same type [PowerPack]`` () = ``simple CE same type`` powerpack
+
+
+ let ``simple CE different types`` evaluator =
+ let expr = monad {
+ let! x = <@ 1 @>
+ let! y = <@ "2" @>
+ return! <@ string x + y @>
+ }
+ let res = Expr.run evaluator expr
+
+ areEqual "12" res
+
+ let [<Test>] ``simple CE different types [QuotationEvaluator]`` () = ``simple CE different types`` quotseval
+ let [<Test>] ``simple CE different types [Unquote]`` () = ``simple CE different types`` unquote
+ let [<Test>] ``simple CE different types [PowerPack]`` () = ``simple CE different types`` powerpack
\ No newline at end of file
diff --git a/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj b/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj
index 68a2efc4f..632c8cf31 100644
--- a/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj
+++ b/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj
@@ -15,6 +15,7 @@
<Compile Include="General.fs" />
<Compile Include="Validations.fs" />
<Compile Include="Free.fs" />
+ <Compile Include="Expr.fs" />
<Compile Include="ComputationExpressions.fs" />
<Compile Include="Lens.fs" />
<Compile Include="Extensions.fs" />
@@ -32,7 +33,9 @@
<ProjectReference Include="..\CSharpLib\CSharpLib.csproj" />
</ItemGroup>
<ItemGroup>
+ <PackageReference Include="FSPowerPack.Linq.Community" Version="3.0.0" />
<PackageReference Include="System.Runtime" Version="4.3.1" />
+ <PackageReference Include="Unquote" Version="5.0.0" />
<PackageReference Update="FSharp.Core" Version="4.6.2" />
<PackageReference Include="MathNet.Numerics.FSharp" Version="4.8.1" />
<PackageReference Include="NUnit" Version="3.11.0" />
@@ -40,4 +43,9 @@
<PackageReference Include="NUnit3TestAdapter" Version="3.11.0" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="15.9.0" />
</ItemGroup>
+ <ItemGroup Condition="'$(TargetFramework)' == 'netcoreapp3.0'">
+ <PackageReference Include="FSharp.Quotations.Evaluator">
+ <Version>2.1.0</Version>
+ </PackageReference>
+ </ItemGroup>
</Project>