diff --git a/src/fable-library-py/fable_library/quotation.py b/src/fable-library-py/fable_library/quotation.py index 1063607ad5..8f2a821dd3 100644 --- a/src/fable-library-py/fable_library/quotation.py +++ b/src/fable-library-py/fable_library/quotation.py @@ -653,3 +653,48 @@ def sub(e: Expr) -> Expr: return e return sub(expr) + + +# =================================================================== +# DerivedPatterns +# F# defines these on top of Patterns. AndAlso and OrElse recover the +# shape `&&` and `||` desugar into; SpecificCall matches a call by the +# identity of a template quotation rather than by compiled name. +# =================================================================== + + +def is_and_also(expr: Expr) -> tuple[Expr, Expr] | None: + """Match `a && b`, represented as `if a then b else false`.""" + if isinstance(expr, ExprIfThenElse) and isinstance(expr.else_expr, ExprValue) and expr.else_expr.value is False: + return (expr.guard, expr.then_expr) + return None + + +def is_or_else(expr: Expr) -> tuple[Expr, Expr] | None: + """Match `a || b`, represented as `if a then true else b`.""" + if isinstance(expr, ExprIfThenElse) and isinstance(expr.then_expr, ExprValue) and expr.then_expr.value is True: + return (expr.guard, expr.else_expr) + return None + + +def _template_call(expr: Expr) -> ExprCall | None: + """Find the call identifying a template quotation under its lambdas.""" + current = expr + while isinstance(current, ExprLambda): + current = current.body + return current if isinstance(current, ExprCall) else None + + +def is_specific_call(template: Expr, expr: Expr) -> tuple[Expr | None, FSharpList[str], FSharpList[Expr]] | None: + """Match a call by the method identity represented by a template quotation.""" + wanted = _template_call(template) + if not isinstance(expr, ExprCall) or wanted is None: + return None + if expr.method != wanted.method or expr.declaring_type != wanted.declaring_type: + return None + + instance = None if isinstance(expr.instance, ExprValue) and expr.instance.type == "novalue" else expr.instance + # The middle slot is F#'s generic-argument list. This runtime models types as + # names rather than System.Type, so it is always empty; callers match it with + # a wildcard. + return (instance, of_array(Array([])), of_array(expr.args)) diff --git a/tests/Python/TestQuotation.fs b/tests/Python/TestQuotation.fs index f0a5d41a22..775cfff491 100644 --- a/tests/Python/TestQuotation.fs +++ b/tests/Python/TestQuotation.fs @@ -4,6 +4,7 @@ open Fable.Tests.Util open Util.Testing open Microsoft.FSharp.Quotations open Microsoft.FSharp.Quotations.Patterns +open Microsoft.FSharp.Quotations.DerivedPatterns open Microsoft.FSharp.Linq.RuntimeHelpers type QuotationTestUnion = @@ -12,6 +13,26 @@ type QuotationTestUnion = let inline quotTestDouble x = x * 2 +// DerivedPatterns: AndAlso and OrElse recover the shape `&&` and `||` desugar +// into, and SpecificCall matches a call by the identity of a template quotation +// rather than by its compiled name. All three previously reported +// "not supported by Fable". +type private DpRec = { Country: string; Balance: float; Id: int } + +let rec private dpToSql (e: Expr) : string = + match e with + | Lambda(_, body) -> dpToSql body + | AndAlso(l, r) -> "(" + dpToSql l + " AND " + dpToSql r + ")" + | OrElse(l, r) -> "(" + dpToSql l + " OR " + dpToSql r + ")" + | SpecificCall <@ (=) @> (_, _, [ l; r ]) -> "(" + dpToSql l + " = " + dpToSql r + ")" + | SpecificCall <@ (>) @> (_, _, [ l; r ]) -> "(" + dpToSql l + " > " + dpToSql r + ")" + | SpecificCall <@ (<) @> (_, _, [ l; r ]) -> "(" + dpToSql l + " < " + dpToSql r + ")" + // Bound as a wildcard: PropertyGet exposes a PropertyInfo on Rust but the + // bare name on the other targets, and this test is about DerivedPatterns. + | PropertyGet _ -> "col" + | Value _ -> "?" + | _ -> "" + [] let ``test Simple integer value quotation`` () = let q = <@ 42 @> @@ -283,3 +304,35 @@ let ``test Call on an instance whose value is null keeps a Some instance`` () = if not (hasSomeInstancePropertyGet q) then failwith "Expected a PropertyGet with a Some instance, even though its value is null" + +[] +let ``test DerivedPatterns AndAlso, OrElse and SpecificCall work`` () = + dpToSql <@ fun (c: DpRec) -> c.Country = "UK" @> |> equal "(col = ?)" + + dpToSql <@ fun (c: DpRec) -> c.Country = "UK" && c.Balance > 100.0 @> + |> equal "((col = ?) AND (col > ?))" + + dpToSql <@ fun (c: DpRec) -> c.Id < 5 || c.Balance > 1.0 @> + |> equal "((col < ?) OR (col > ?))" + +[] +let ``test a captured local is a Value, not a Var`` () = + let captured = "SE" + + let describe (e: Expr) = + match e with + | Lambda(_, body) -> + match body with + | Value(v, _) -> "Value:" + unbox v + | Var v -> "Var:" + v.Name + | _ -> "other" + | _ -> "not a lambda" + + describe <@ fun (_: int) -> captured @> |> equal "Value:SE" + describe <@ fun (_: int) -> "SE" @> |> equal "Value:SE" + + // Checks that a bound variable remains a Var, rather than being spliced in. + (match <@ fun (x: string) -> x @> with + | Lambda(_, Var _) -> "Var" + | _ -> "?") + |> equal "Var"