From 63921e6d72fc66aeb82418c60d99f769445e42b4 Mon Sep 17 00:00:00 2001 From: Tuomas Hietanen Date: Tue, 14 Jul 2026 21:16:40 +0100 Subject: [PATCH] feat(rust): quotations --- src/Fable.Transforms/Rust/Fable2Rust.fs | 40 ++- src/Fable.Transforms/Rust/Replacements.fs | 11 +- .../src/Fable.Library.Rust.fsproj | 2 + src/fable-library-rust/src/Quotation.fs | 287 ++++++++++++++++++ src/fable-library-rust/src/QuotationTypes.fs | 45 +++ tests/Rust/Fable.Tests.Rust.fsproj | 1 + tests/Rust/tests/src/QuotationTests.fs | 262 ++++++++++++++++ 7 files changed, 641 insertions(+), 7 deletions(-) create mode 100644 src/fable-library-rust/src/Quotation.fs create mode 100644 src/fable-library-rust/src/QuotationTypes.fs create mode 100644 tests/Rust/tests/src/QuotationTests.fs diff --git a/src/Fable.Transforms/Rust/Fable2Rust.fs b/src/Fable.Transforms/Rust/Fable2Rust.fs index 632adbd4f9..e04491b030 100644 --- a/src/Fable.Transforms/Rust/Fable2Rust.fs +++ b/src/Fable.Transforms/Rust/Fable2Rust.fs @@ -632,12 +632,15 @@ module TypeInfo = // always not Rc-wrapped | Fable.Unit | Fable.Measure _ - | Fable.MetaType | Fable.Boolean | Fable.Char | Fable.Number _ -> None // should be Rc-wrapped + // MetaType (System.Type) is erased to Any and carries a boxed reflection + // object at runtime, so it must be Lrc-wrapped like Any (a bare `dyn Any` + // is unsized and cannot appear as a value/argument). + | Fable.MetaType | Fable.Any | Fable.Regex | Replacements.Util.Builtin(Replacements.Util.FSharpReference _) @@ -1128,7 +1131,11 @@ module TypeInfo = | Fable.Char -> primitiveType "char" | Fable.Boolean -> primitiveType "bool" | Fable.String -> transformStringType com ctx - | Fable.MetaType -> transformMetaType com ctx + // System.Type has no faithful runtime on Rust (reflection is a stub), so erase it + // to Any. This lets the NewRecord quotation deconstruction bind its type slot to the + // boxed value the quotation runtime returns; typeof-based reflection is unsupported + // regardless (see the disabled ReflectionTests). + | Fable.MetaType -> transformAnyType com ctx | Fable.Number(kind, _) -> transformNumberType com ctx kind | Fable.LambdaType(argType, returnType) -> let argTypes, returnType = ([ argType ], returnType) @@ -1184,6 +1191,28 @@ module TypeInfo = // built-in types | Replacements.Util.Builtin kind -> transformBuiltinType com ctx typ kind + // Typed quotation Expr<'T>: erase the type argument so it shares the untyped + // FSharpExpr runtime representation. This lets a typed quotation (e.g. <@ 42 @>) + // be matched directly against the Patterns active patterns, which operate on + // the untyped Expr. + | Fable.DeclaredType(entRef, _) when entRef.FullName = Types.fsharpExprGeneric -> + transformEntityType com ctx { entRef with FullName = Types.fsharpExpr } [] + + // UnionCaseInfo (from a NewUnionCase quotation deconstruction) is erased to the + // Rust-native FSharpUnionCaseInfo carrier so uci.Name/uci.Tag resolve to the + // quotation runtime accessors. We build the import path directly (rather than via + // transformEntityType) because that carrier type does not exist in FSharp.Core, so + // com.GetEntity on the renamed ref would fail; getEntityFullName imports the type + // from fable_library_rust purely by FullName. + | Fable.DeclaredType(entRef, _) when entRef.FullName = "Microsoft.FSharp.Reflection.UnionCaseInfo" -> + let entName = + getEntityFullName + com + ctx + { entRef with FullName = "Microsoft.FSharp.Quotations.FSharpUnionCaseInfo" } + + makeFullNamePathTy entName None + // other declared types | Fable.DeclaredType(entRef, genArgs) -> transformEntityType com ctx entRef genArgs @@ -3698,9 +3727,10 @@ module Util = mkUnitExpr () - | Fable.Quote _ -> - addError com [] None "Quotations are not yet supported for Rust target" - mkUnitExpr () + | Fable.Quote(body, _isTyped, _r) -> + // Lower the quoted body to runtime calls that build the quotation AST, + // then transform those like any other expression (mirrors JS/Python/Beam). + QuotationEmitter.emitQuotedExpr com body |> transformExpr com ctx let rec tryFindEntryPoint (com: IRustCompiler) decl : string list option = match decl with diff --git a/src/Fable.Transforms/Rust/Replacements.fs b/src/Fable.Transforms/Rust/Replacements.fs index 0af218b01a..38626614dc 100644 --- a/src/Fable.Transforms/Rust/Replacements.fs +++ b/src/Fable.Transforms/Rust/Replacements.fs @@ -3695,7 +3695,13 @@ let tryCall (com: ICompiler) (ctx: Context) r t (info: CallInfo) (thisArg: Expr fsharpType com methName r t info args else fsharpValue com methName r t info args - | "Microsoft.FSharp.Reflection.UnionCaseInfo" + | "Microsoft.FSharp.Reflection.UnionCaseInfo" -> + // UnionCaseInfo from a NewUnionCase quotation deconstruction is a Rust-native + // FSharpUnionCaseInfo carrier; route member access to the quotation runtime. + match thisArg, info.CompiledName with + | Some c, "get_Name" -> Helper.LibCall(com, "quotation", "unionCaseName", t, [ c ], ?loc = r) |> Some + | Some c, "get_Tag" -> Helper.LibCall(com, "quotation", "unionCaseTag", t, [ c ], ?loc = r) |> Some + | _ -> None | "System.Reflection.PropertyInfo" | "System.Reflection.ParameterInfo" | "System.Reflection.MethodBase" @@ -3716,7 +3722,8 @@ let tryCall (com: ICompiler) (ctx: Context) r t (info: CallInfo) (thisArg: Expr getTypeName com ctx loc exprType |> StringConstant |> makeValue r |> Some | c -> Helper.LibCall(com, "Reflection", "name", t, [ c ], ?loc = r) |> Some | _ -> None - | _ -> None + // F# Quotations + | typeName -> Quotations.tryQuotationCall "quotation" com ctx r t info thisArg args typeName let tryBaseConstructor com ctx (ent: EntityRef) (argTypes: Lazy) genArgs args = match ent.FullName with diff --git a/src/fable-library-rust/src/Fable.Library.Rust.fsproj b/src/fable-library-rust/src/Fable.Library.Rust.fsproj index 0dffee4111..30ccc1242e 100644 --- a/src/fable-library-rust/src/Fable.Library.Rust.fsproj +++ b/src/fable-library-rust/src/Fable.Library.Rust.fsproj @@ -27,6 +27,8 @@ + + diff --git a/src/fable-library-rust/src/Quotation.fs b/src/fable-library-rust/src/Quotation.fs new file mode 100644 index 0000000000..72d6952e71 --- /dev/null +++ b/src/fable-library-rust/src/Quotation.fs @@ -0,0 +1,287 @@ +// F# quotation runtime for the Fable Rust target (functions). +// +// Authored in F# and transpiled by Fable so the FSharpExpr/FSharpVar types land at the +// right namespace and every mk*/is* signature matches what generated user code expects. +// The module is named `quotation_` to match the `libModule = "quotation"` import path. +module quotation_ + +open Microsoft.FSharp.Quotations + +// --- Var constructor + accessors --- + +let mkQuotVar (name: string) (typ: string) (isMutable: bool) : FSharpVar = + { + Name = name + Type = typ + IsMutable = isMutable + } + +let varGetName (v: FSharpVar) : string = v.Name +let varGetType (v: FSharpVar) : string = v.Type +let varGetIsMutable (v: FSharpVar) : bool = v.IsMutable + +// --- Expr constructors --- + +// Generic so callers can pass an unboxed literal (i32/bool/string/...); `box` erases +// it to obj. A non-generic obj parameter would require the caller to box, which the +// emitter does not do on statically typed targets. +let mkValue<'T> (value: 'T) (typ: string) : FSharpExpr = ExprValue(box value, typ) + +// A null-value node (no instance / null literal / empty option or list). +// The payload is a boxed sentinel (not a null literal, which the Rust target can't +// represent for an untyped obj); consumers distinguish null nodes by the type tag. +let mkNull (typ: string) : FSharpExpr = ExprValue(box 0, typ) + +let mkVar (v: FSharpVar) : FSharpExpr = ExprVarExpr v +let mkLambda (v: FSharpVar) (body: FSharpExpr) : FSharpExpr = ExprLambda(v, body) +let mkApplication (func: FSharpExpr) (arg: FSharpExpr) : FSharpExpr = ExprApplication(func, arg) +let mkLet (v: FSharpVar) (value: FSharpExpr) (body: FSharpExpr) : FSharpExpr = ExprLet(v, value, body) + +let mkIfThenElse (guard: FSharpExpr) (thenExpr: FSharpExpr) (elseExpr: FSharpExpr) : FSharpExpr = + ExprIfThenElse(guard, thenExpr, elseExpr) + +let mkCall (instance: FSharpExpr) (method: string) (args: FSharpExpr[]) (declaringType: string) : FSharpExpr = + ExprCall(instance, method, args, declaringType) + +let mkSequential (first: FSharpExpr) (second: FSharpExpr) : FSharpExpr = ExprSequential(first, second) + +// A correctly-typed empty argument array. Rust is statically typed, so an empty +// obj[] built by the emitter won't unify with the FSharpExpr[] parameters of +// mkCall/mkNewUnion/mkNewTuple (zero-arg calls like property getters, nullary +// union cases). The emitter routes empty expr-arrays here for the Rust target. +let emptyExprArray () : FSharpExpr[] = [||] + +let mkNewTuple (elements: FSharpExpr[]) : FSharpExpr = ExprNewTuple elements + +let mkNewUnion (typeName: string) (tag: int) (caseName: string) (fields: FSharpExpr[]) : FSharpExpr = + ExprNewUnion(typeName, tag, caseName, fields) + +let mkNewRecord (typeName: string) (fieldNames: string[]) (values: FSharpExpr[]) : FSharpExpr = + ExprNewRecord(typeName, fieldNames, values) + +// --- UnionCaseInfo accessors (backing uci.Name / uci.Tag on a NewUnionCase binding) --- + +let unionCaseName (u: FSharpUnionCaseInfo) : string = u.Name +let unionCaseTag (u: FSharpUnionCaseInfo) : int = u.Tag +let mkNewList (head: FSharpExpr) (tail: FSharpExpr) : FSharpExpr = ExprNewList(head, tail) +let mkTupleGet (e: FSharpExpr) (index: int) : FSharpExpr = ExprTupleGet(e, index) +let mkUnionTag (e: FSharpExpr) : FSharpExpr = ExprUnionTag e +let mkUnionField (e: FSharpExpr) (fieldIndex: int) : FSharpExpr = ExprUnionField(e, fieldIndex) +let mkFieldGet (e: FSharpExpr) (fieldName: string) : FSharpExpr = ExprFieldGet(e, fieldName) +let mkFieldSet (e: FSharpExpr) (fieldName: string) (value: FSharpExpr) : FSharpExpr = ExprFieldSet(e, fieldName, value) +let mkVarSet (target: FSharpExpr) (value: FSharpExpr) : FSharpExpr = ExprVarSet(target, value) + +// --- Type accessor --- + +let getType (e: FSharpExpr) : string = + match e with + | ExprValue(_, t) -> t + | ExprLambda(v, _) -> v.Type + | _ -> "obj" + +// --- Pattern helpers (return option, following the active-pattern convention) --- + +let isValue (e: FSharpExpr) = + match e with + | ExprValue(v, t) -> Some(v, t) + | _ -> None + +let isVar (e: FSharpExpr) = + match e with + | ExprVarExpr v -> Some v + | _ -> None + +let isLambda (e: FSharpExpr) = + match e with + | ExprLambda(v, b) -> Some(v, b) + | _ -> None + +let isApplication (e: FSharpExpr) = + match e with + | ExprApplication(f, a) -> Some(f, a) + | _ -> None + +let isLet (e: FSharpExpr) = + match e with + | ExprLet(v, value, body) -> Some(v, value, body) + | _ -> None + +let isIfThenElse (e: FSharpExpr) = + match e with + | ExprIfThenElse(g, t, el) -> Some(g, t, el) + | _ -> None + +let isCall (e: FSharpExpr) = + match e with + | ExprCall(instance, m, args, _dt) -> + // A static/operator call carries the "novalue" node as its instance; + // expose it as None so Patterns.Call matches F#. The tag is distinct from + // "null", which is a genuine quoted null value. + let inst = + match instance with + | ExprValue(_, "novalue") -> None + | _ -> Some instance + + Some(inst, m, List.ofArray args) + | _ -> None + +let isSequential (e: FSharpExpr) = + match e with + | ExprSequential(f, s) -> Some(f, s) + | _ -> None + +let isNewTuple (e: FSharpExpr) = + match e with + | ExprNewTuple els -> Some(List.ofArray els) + | _ -> None + +let isNewUnionCase (e: FSharpExpr) = + match e with + | ExprNewUnion(typeName, tag, caseName, fields) -> + // Return F#'s (UnionCaseInfo * Expr list) shape. The UnionCaseInfo carrier + // backs uci.Name/uci.Tag via unionCaseName/unionCaseTag. + let uci: FSharpUnionCaseInfo = + { + Name = caseName + Tag = tag + DeclaringType = typeName + } + + Some(uci, List.ofArray fields) + | _ -> None + +let isNewRecord (e: FSharpExpr) = + match e with + | ExprNewRecord(typeName, _names, values) -> + // Return F#'s (Type * Expr list) shape. Rust has no faithful System.Type runtime, + // so the type slot is erased to a boxed value (the record type name). The Rust + // compiler erases the pattern's System.Type slot to Any to match (see Replacements). + Some(box typeName, List.ofArray values) + | _ -> None + +let isTupleGet (e: FSharpExpr) = + match e with + | ExprTupleGet(inner, i) -> Some(inner, i) + | _ -> None + +let isFieldGet (e: FSharpExpr) = + match e with + | ExprFieldGet(inner, n) -> Some(inner, n) + | _ -> None + +// --- Free variables --- + +let getFreeVars (e: FSharpExpr) : FSharpVar list = + let seen = System.Collections.Generic.HashSet() + let acc = ResizeArray() + + let rec walk (bound: Set) (e: FSharpExpr) = + match e with + | ExprVarExpr v -> + if not (bound.Contains v.Name) && seen.Add v.Name then + acc.Add v + | ExprLambda(v, body) -> walk (bound.Add v.Name) body + | ExprLet(v, value, body) -> + walk bound value + walk (bound.Add v.Name) body + | ExprApplication(f, a) -> + walk bound f + walk bound a + | ExprIfThenElse(g, t, el) -> + walk bound g + walk bound t + walk bound el + | ExprCall(_, _, args, _) -> + for a in args do + walk bound a + | ExprSequential(f, s) -> + walk bound f + walk bound s + | ExprNewTuple els -> + for el in els do + walk bound el + | ExprTupleGet(inner, _) -> walk bound inner + | ExprFieldGet(inner, _) -> walk bound inner + | _ -> () + + walk Set.empty e + List.ofSeq acc + +// --- Evaluation (structural cases + common operators; SQL translation deconstructs +// rather than evaluates, so this covers the tested subset). --- + +let private applyOperator (method: string) (args: obj list) : obj = + // Extract args positionally rather than binding them in the match: pattern-binding + // obj (Rc) variables makes Fable zero-initialize a fat pointer, which is + // invalid at runtime. Matching only on the method string avoids that. + // if/elif (not match): Fable-Rust would emit string literals as match patterns, + // which isn't valid Rust; an if-chain compiles to string == comparisons. + let i (n: int) : int = unbox (List.item n args) + let b (n: int) : bool = unbox (List.item n args) + + if method = "op_Addition" then + box (i 0 + i 1) + elif method = "op_Subtraction" then + box (i 0 - i 1) + elif method = "op_Multiply" then + box (i 0 * i 1) + elif method = "op_Division" then + box (i 0 / i 1) + elif method = "op_Modulus" then + box (i 0 % i 1) + elif method = "op_UnaryNegation" then + box (-(i 0)) + elif method = "op_Equality" then + box (i 0 = i 1) + elif method = "op_Inequality" then + box (i 0 <> i 1) + elif method = "op_LessThan" then + box (i 0 < i 1) + elif method = "op_LessThanOrEqual" then + box (i 0 <= i 1) + elif method = "op_GreaterThan" then + box (i 0 > i 1) + elif method = "op_GreaterThanOrEqual" then + box (i 0 >= i 1) + elif method = "op_BooleanAnd" then + box (b 0 && b 1) + elif method = "op_BooleanOr" then + box (b 0 || b 1) + elif method = "op_LogicalNot" then + box (not (b 0)) + else + failwithf "Cannot evaluate method: %s" method + +let evaluate (e: FSharpExpr) : obj = + let rec eval (env: Map) (e: FSharpExpr) : obj = + match e with + | ExprValue(v, _) -> v + | ExprVarExpr v -> Map.find v.Name env + | ExprLambda(v, body) -> box (fun (arg: obj) -> eval (Map.add v.Name arg env) body) + | ExprApplication(f, a) -> + let func = unbox obj> (eval env f) + func (eval env a) + | ExprLet(v, value, body) -> eval (Map.add v.Name (eval env value) env) body + | ExprIfThenElse(g, t, el) -> + if unbox (eval env g) then + eval env t + else + eval env el + | ExprSequential(a, b) -> + eval env a |> ignore + eval env b + | ExprCall(_, method, args, _) -> applyOperator method [ for a in args -> eval env a ] + // A tuple literal evaluates to a boxed obj[] of its evaluated elements, mirroring + // PHP (which produces a plain array). TupleGet then indexes into that array; without + // this arm `eval inner` on a tuple literal would fall through to failwith and there + // would be nothing indexable, so both arms are needed together. + | ExprNewTuple els -> box [| for el in els -> eval env el |] + | ExprTupleGet(inner, index) -> + // The match-bound `index` is a borrowed &i32 on Rust while the array Index + // operator wants an owned i32; `index + 0` forces an owned i32 rvalue (the + // arithmetic dereferences the borrow) so the indexing type-checks. + let i = index + 0 + (unbox (eval env inner)).[i] + | _ -> failwith "Cannot evaluate expression" + + eval Map.empty e diff --git a/src/fable-library-rust/src/QuotationTypes.fs b/src/fable-library-rust/src/QuotationTypes.fs new file mode 100644 index 0000000000..1dbe9c2167 --- /dev/null +++ b/src/fable-library-rust/src/QuotationTypes.fs @@ -0,0 +1,45 @@ +// F# quotation AST types for the Fable Rust target. +// +// Declared in the Microsoft.FSharp.Quotations namespace with the *compiled* names +// (FSharpExpr / FSharpVar) that Fable maps the real FSharp.Core Quotations.Expr / .Var +// to on the Rust target. Using the compiled names (rather than Expr/Var) means no clash +// with FSharp.Core during F# type-checking, while still resolving to the same Rust path +// (Microsoft::FSharp::Quotations::FSharpExpr) that generated user code references. +namespace Microsoft.FSharp.Quotations + +type FSharpVar = + { + Name: string + Type: string + IsMutable: bool + } + +// Rust-native carrier for Microsoft.FSharp.Reflection.UnionCaseInfo. Fable-Rust +// erases the F# UnionCaseInfo type to this struct (see Fable2Rust.transformType), +// so `uci.Name`/`uci.Tag` on a NewUnionCase binding route to the accessors below. +type FSharpUnionCaseInfo = + { + Name: string + Tag: int + DeclaringType: string + } + +type FSharpExpr = + | ExprValue of value: obj * typ: string + | ExprVarExpr of var: FSharpVar + | ExprLambda of var: FSharpVar * body: FSharpExpr + | ExprApplication of func: FSharpExpr * arg: FSharpExpr + | ExprLet of var: FSharpVar * value: FSharpExpr * body: FSharpExpr + | ExprIfThenElse of guard: FSharpExpr * thenExpr: FSharpExpr * elseExpr: FSharpExpr + | ExprCall of instance: FSharpExpr * method: string * args: FSharpExpr[] * declaringType: string + | ExprSequential of first: FSharpExpr * second: FSharpExpr + | ExprNewTuple of elements: FSharpExpr[] + | ExprNewUnion of typeName: string * tag: int * caseName: string * fields: FSharpExpr[] + | ExprNewRecord of typeName: string * fieldNames: string[] * values: FSharpExpr[] + | ExprNewList of head: FSharpExpr * tail: FSharpExpr + | ExprTupleGet of expr: FSharpExpr * index: int + | ExprUnionTag of expr: FSharpExpr + | ExprUnionField of expr: FSharpExpr * fieldIndex: int + | ExprFieldGet of expr: FSharpExpr * fieldName: string + | ExprFieldSet of expr: FSharpExpr * fieldName: string * value: FSharpExpr + | ExprVarSet of target: FSharpExpr * value: FSharpExpr diff --git a/tests/Rust/Fable.Tests.Rust.fsproj b/tests/Rust/Fable.Tests.Rust.fsproj index c4e4ee646f..c9cd2a28a7 100644 --- a/tests/Rust/Fable.Tests.Rust.fsproj +++ b/tests/Rust/Fable.Tests.Rust.fsproj @@ -58,6 +58,7 @@ + diff --git a/tests/Rust/tests/src/QuotationTests.fs b/tests/Rust/tests/src/QuotationTests.fs new file mode 100644 index 0000000000..95be8c3fa1 --- /dev/null +++ b/tests/Rust/tests/src/QuotationTests.fs @@ -0,0 +1,262 @@ +module Fable.Tests.QuotationTests + +open Util.Testing +open Microsoft.FSharp.Quotations +open Microsoft.FSharp.Quotations.Patterns +open Microsoft.FSharp.Linq.RuntimeHelpers + +// NOTE: quotations are deconstructed through an untyped `Expr` parameter (helpers below +// take `(e: Expr)`); matching a typed `Expr<'T>` binding directly is not yet supported on +// Rust (see quotation notes). Binding the boxed `obj` payload out of a Value node now works +// (the getZeroObj fix); the type element is bound as a wildcard since the runtime models it +// as a string rather than System.Type. Array-valued nodes now deconstruct: NewTuple exposes +// its elements, NewUnionCase binds a real UnionCaseInfo (uci.Name / uci.Tag) plus its args, and +// NewRecord binds its (erased) type slot plus its args. The NewRecord type slot and +// UnionCaseInfo.GetFields() are not modelled (System.Type / PropertyInfo have no Rust runtime). + +let private lambdaVarName (e: Expr) = + match e with + | Lambda(v, _body) -> v.Name + | _ -> "?" + +let private letVarName (e: Expr) = + match e with + | Let(v, _value, _body) -> v.Name + | _ -> "?" + +let private isIfThenElseNode (e: Expr) = + match e with + | IfThenElse(_g, _t, _e) -> true + | _ -> false + +[] +let ``Evaluate a value`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ 42 @> + unbox r |> equal 42 + +// Typed Expr<'T> matched directly (not routed through an (e: Expr) helper): the type +// argument is erased so the quotation shares the untyped FSharpExpr representation. + +[] +let ``Typed quotation matches Value directly`` () = + match <@ 42 @> with + | Value(v, _) -> unbox v |> equal 42 + | _ -> failwith "Expected Value" + +[] +let ``Typed quotation matches Lambda directly`` () = + match <@ fun (x: int) -> x + 1 @> with + | Lambda(v, _) -> v.Name |> equal "x" + | _ -> failwith "Expected Lambda" + +[] +let ``Lambda quotation exposes the parameter name`` () = + lambdaVarName <@ fun (x: int) -> x + 1 @> |> equal "x" + +[] +let ``Let quotation exposes the bound name`` () = + letVarName <@ let y = 5 in y + 1 @> |> equal "y" + +[] +let ``IfThenElse quotation deconstructs`` () = + isIfThenElseNode <@ if true then 1 else 2 @> |> equal true + +[] +let ``Evaluate addition`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ 2 + 3 @> + unbox r |> equal 5 + +[] +let ``Evaluate subtraction`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ 10 - 4 @> + unbox r |> equal 6 + +[] +let ``Evaluate comparison`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ 5 > 3 @> + unbox r |> equal true + +[] +let ``Evaluate let binding`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ let x = 10 in x + 5 @> + unbox r |> equal 15 + +[] +let ``Evaluate lambda application`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ (fun a -> a * 2) 21 @> + unbox r |> equal 42 + +[] +let ``Evaluate let-bound lambda`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ let f = (fun x -> x + 1) in f 41 @> + unbox r |> equal 42 + +// --- Parity expansion (toward the Python 27) --- +// Binding the boxed obj payload out of a Value node previously tripped getZero on Rust; +// the getZeroObj / active-pattern fixes should now allow these. Type element bound as +// wildcard (`Value(v, _)`) to sidestep the System.Type-vs-string model difference. + +let private valueInt (e: Expr) = + match e with + | Value(v, _) -> unbox v + | _ -> -1 + +let private valueBool (e: Expr) = + match e with + | Value(v, _) -> unbox v + | _ -> false + +let private valueStr (e: Expr) = + match e with + | Value(v, _) -> unbox v + | _ -> "?" + +let private letBoundInt (e: Expr) = + match e with + | Let(_, Value(v, _), _) -> unbox v + | _ -> -1 + +let private seqSecondInt (e: Expr) = + match e with + | Sequential(_, Value(v, _)) -> unbox v + | _ -> -1 + +let private newTupleLen (e: Expr) = + match e with + | NewTuple(exprs) -> List.length exprs + | _ -> -1 + +let private isAppLambdaValue (e: Expr) = + match e with + | Application(Lambda _, Value _) -> true + | _ -> false + +let private lambdaVarBodyName (e: Expr) = + match e with + | Lambda(v, Var v2) -> v.Name + "/" + v2.Name + | _ -> "?" + +let private isLambdaIfThenElse (e: Expr) = + match e with + | Lambda(_, IfThenElse(_, _, _)) -> true + | _ -> false + +[] +let ``Value node binds int payload`` () = + valueInt <@ 42 @> |> equal 42 + +[] +let ``Value node binds bool payload`` () = + valueBool <@ true @> |> equal true + +[] +let ``Value node binds string payload`` () = + valueStr <@ "hello" @> |> equal "hello" + +[] +let ``Let binds value node payload`` () = + letBoundInt <@ let x = 5 in x @> |> equal 5 + +[] +let ``Sequential exposes second value payload`` () = + seqSecondInt <@ (); 42 @> |> equal 42 + +[] +let ``NewTuple exposes element count`` () = + newTupleLen <@ (1, 2, 3) @> |> equal 3 + +[] +let ``Application of lambda to value deconstructs`` () = + isAppLambdaValue <@ (fun x -> x) 42 @> |> equal true + +[] +let ``Lambda body Var refers to the parameter`` () = + lambdaVarBodyName <@ fun x -> x @> |> equal "x/x" + +[] +let ``Option match in quotation lowers to IfThenElse`` () = + isLambdaIfThenElse <@ fun (o: int option) -> match o with Some v -> v | None -> 0 @> |> equal true + +[] +let ``Literal match in quotation lowers to IfThenElse`` () = + isLambdaIfThenElse <@ fun (x: int) -> match x with 0 -> "zero" | _ -> "other" @> |> equal true + +[] +let ``Evaluate multiplication`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ 6 * 7 @> + unbox r |> equal 42 + +[] +let ``Evaluate nested let bindings`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ let x = 3 in let y = 4 in x * y @> + unbox r |> equal 12 + +[] +let ``Evaluate nested lambda`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ (fun x -> (fun y -> x + y)) 3 4 @> + unbox r |> equal 7 + +// --- NewUnionCase / NewRecord deconstruction --- + +type private MyRec = { X: int; Y: int } + +let private newUnionCaseName (e: Expr) = + match e with + | NewUnionCase(uci, _args) -> uci.Name + | _ -> "?" + +let private newUnionCaseArgCount (e: Expr) = + match e with + | NewUnionCase(_uci, args) -> List.length args + | _ -> -1 + +let private newUnionCaseTag (e: Expr) = + match e with + | NewUnionCase(uci, _args) -> uci.Tag + | _ -> -1 + +let private newRecordArgCount (e: Expr) = + match e with + | NewRecord(_t, args) -> List.length args + | _ -> -1 + +[] +let ``NewUnionCase exposes the case name`` () = + newUnionCaseName <@ Some 42 @> |> equal "Some" + +[] +let ``NewUnionCase exposes the argument count`` () = + newUnionCaseArgCount <@ Some 42 @> |> equal 1 + +[] +let ``NewUnionCase exposes the tag`` () = + newUnionCaseTag <@ Some 42 @> |> equal 1 + +[] +let ``NewRecord exposes the argument count`` () = + newRecordArgCount <@ ({ X = 1; Y = 2 }: MyRec) @> |> equal 2 + +// --- TupleGet evaluation (B3) --- +// A tuple-deconstructing let lowers to a NewTuple bound to a var, then TupleGet nodes +// pulling out each element. Evaluating it exercises both the ExprNewTuple arm (builds a +// boxed obj[]) and the ExprTupleGet arm (indexes into it). Before the fix, TupleGet +// returned the whole tuple, so `a`/`b` were the obj[] and `a + b` would not evaluate. + +[] +let ``Evaluate tuple-get picks the element at the index`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ let (a, b) = (10, 20) in a + b @> + unbox r |> equal 30 + +[] +let ``Evaluate tuple-get picks the second element`` () = + let r = LeafExpressionConverter.EvaluateQuotation <@ let (a, b, c) = (1, 2, 3) in b @> + unbox r |> equal 2 + +// --- Typed Expr.Call builder (B2) --- +// The B2 arity fix (quotationExprs now passes a 4th declaringType arg to mkCall) is verified +// by inspecting the generated Rust: Expr.Call(instance, mi, args) emits the full 4-arg +// `mkCall(instance, mi, args, string(""))` instead of a 3-arg partial application. An +// end-to-end Rust test cannot compile, though: deconstructing a Call binds `mi: MethodInfo`, +// and MethodInfo has no Rust runtime type (Fable emits an unresolved +// `System::Reflection::MethodInfo` import). Constructing/round-tripping a MethodInfo is the +// separate MethodInfo/declaringType task, so no runnable Rust test is added here.