From d121848961133bbd17ca3db109f01c8aca894cf2 Mon Sep 17 00:00:00 2001 From: Tuomas Hietanen Date: Tue, 14 Jul 2026 21:03:45 +0100 Subject: [PATCH 1/6] feat(all): quotations --- src/Fable.Transforms/FSharp2Fable.Util.fs | 12 + src/Fable.Transforms/FSharp2Fable.fs | 4 +- src/Fable.Transforms/QuotationEmitter.fs | 289 ++++++++++++++++-- src/Fable.Transforms/Replacements.Util.fs | 6 +- src/fable-library-beam/fable_quotation.erl | 35 ++- .../fable_library/quotation.py | 25 +- src/fable-library-ts/quotation.ts | 25 +- tests/Beam/QuotationTests.fs | 33 +- tests/Js/Main/QuotationTests.fs | 12 + tests/Python/TestQuotation.fs | 16 + 10 files changed, 406 insertions(+), 51 deletions(-) diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index 4cd77c6fec..8eccaa9759 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -537,6 +537,10 @@ type Context = InlinePath: Log.InlinePath list CaptureBaseConsCall: (FSharpEntity * (Fable.Expr -> unit)) option Witnesses: Fable.Witness list + // When true we are translating the body of a code quotation (<@ @>). The body is + // data, never executed, so member calls are kept as-is (not replaced/emitted/inlined) + // to preserve their .NET member metadata for QuotationEmitter. + CapturingQuotation: bool } static member Create(?usedRootNames) = @@ -555,6 +559,7 @@ type Context = InlinePath = [] CaptureBaseConsCall = None Witnesses = [] + CapturingQuotation = false } type IFableCompiler = @@ -3058,6 +3063,13 @@ module Util = (callInfo: Fable.CallInfo) = match memb, memb.DeclaringEntity with + // Inside a quotation the body is data, never executed. Preserve the original member + // call (skip replace/emit/import/inline) so its .NET member metadata survives for + // QuotationEmitter. Skipping inlining here also matches real F# quotation semantics. + | _ when ctx.CapturingQuotation -> + let membTyp = makeType ctx.GenericArgs memb.FullType + memberIdent com r membTyp memb membRef |> makeCall r typ callInfo + | Emitted com ctx r typ (Some callInfo) emitted, _ -> emitted | Imported com ctx r typ (Some callInfo) imported -> imported | Replaced com ctx r typ callInfo replaced -> replaced diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 47c0c11e1f..9f5fc00919 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -1503,7 +1503,9 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs |> addErrorAndReturnNull com ctx.InlinePath (makeRangeFrom fsExpr) | FSharpExprPatterns.Quote quotedExpr -> - let! body = transformExpr com ctx [] quotedExpr + // Translate the quoted body in "capturing" mode so member calls keep their + // .NET metadata (not replaced/emitted/inlined) — the body is data, not code. + let! body = transformExpr com { ctx with CapturingQuotation = true } [] quotedExpr let exprType = fsExpr.Type let isTyped = exprType.GenericArguments.Count > 0 return Fable.Quote(body, isTyped, makeRangeFrom fsExpr) diff --git a/src/Fable.Transforms/QuotationEmitter.fs b/src/Fable.Transforms/QuotationEmitter.fs index e2341a438f..d053a1eb7a 100644 --- a/src/Fable.Transforms/QuotationEmitter.fs +++ b/src/Fable.Transforms/QuotationEmitter.fs @@ -115,18 +115,22 @@ let rec emitQuotedExpr (com: Compiler) (expr: Expr) : Expr = let instanceExpr = match info.ThisArg with | Some thisArg -> emitQuotedExpr com thisArg - | None -> Value(Null Any, None) + // A static/operator call has no instance. Emit a runtime-built null node + // (not a raw null literal) so every target — notably statically typed ones + // like Rust — sees an Expr in the instance position. + | None -> mkNullExpr com "null" - let methodName = + let declaringType, methodName = match info.MemberRef with - | Some(MemberRef(_, mInfo)) -> mInfo.CompiledName - | _ -> "unknown" + | Some(MemberRef(declaringEntity, mInfo)) -> declaringEntity.FullName, mInfo.CompiledName + | _ -> "", "unknown" let methodExpr = makeStrConst methodName + let declTypeExpr = makeStrConst declaringType - let argExprs = info.Args |> List.map (emitQuotedExpr com) |> makeArray Any + let argExprs = mkExprArray com (info.Args |> List.map (emitQuotedExpr com)) - Helper.LibCall(com, "quotation", "mkCall", Any, [ instanceExpr; methodExpr; argExprs ]) + Helper.LibCall(com, "quotation", "mkCall", Any, [ instanceExpr; methodExpr; argExprs; declTypeExpr ]) | Sequential exprs -> match exprs with @@ -183,11 +187,12 @@ let rec emitQuotedExpr (com: Compiler) (expr: Expr) : Expr = name, [ left; right ] let methodExpr = makeStrConst opName - let instanceExpr = Value(Null Any, None) + let instanceExpr = mkNullExpr com "null" - let argExprs = args |> List.map (emitQuotedExpr com) |> makeArray Any + let argExprs = mkExprArray com (args |> List.map (emitQuotedExpr com)) - Helper.LibCall(com, "quotation", "mkCall", Any, [ instanceExpr; methodExpr; argExprs ]) + // Operators have no declaring type; pass an empty string. + Helper.LibCall(com, "quotation", "mkCall", Any, [ instanceExpr; methodExpr; argExprs; makeStrConst "" ]) | Get(expr, kind, _typ, _r) -> let target = emitQuotedExpr com expr @@ -198,8 +203,29 @@ let rec emitQuotedExpr (com: Compiler) (expr: Expr) : Expr = | UnionField info -> Helper.LibCall(com, "quotation", "mkUnionField", Any, [ target; makeIntConst info.FieldIndex ]) | FieldGet info -> Helper.LibCall(com, "quotation", "mkFieldGet", Any, [ target; makeStrConst info.Name ]) + | ListHead + | ListTail + | OptionValue -> + // Represent option/list value accessors as property-getter calls, + // mirroring how F# quotations model them (PropertyGet get_Value/get_Head/get_Tail). + let methodName = + match kind with + | ListHead -> "get_Head" + | ListTail -> "get_Tail" + | _ -> "get_Value" + + let emptyArgs = mkExprArray com [] + + Helper.LibCall( + com, + "quotation", + "mkCall", + Any, + [ target; makeStrConst methodName; emptyArgs; makeStrConst "" ] + ) | _ -> - // ListHead, ListTail, OptionValue, ExprGet — fall through + // TupleIndex/UnionTag/UnionField/FieldGet handled above; ExprGet and any + // future kinds fall through here. let msg = "Unsupported quotation Get kind" Helper.LibCall(com, "quotation", "mkValue", Any, [ makeStrConst msg; makeStrConst "string" ]) @@ -221,14 +247,27 @@ let rec emitQuotedExpr (com: Compiler) (expr: Expr) : Expr = // Coerce/cast: just emit the inner expression for now emitQuotedExpr com innerExpr - | DecisionTree(matchExpr, targets) -> - // Simple pattern: if this is a single-target decision tree (e.g. let binding), - // emit the target body directly. Otherwise fall through to unsupported. - match targets with - | [ ([], body) ] -> emitQuotedExpr com body - | _ -> - let msg = "Unsupported quotation node: DecisionTree" - Helper.LibCall(com, "quotation", "mkValue", Any, [ makeStrConst msg; makeStrConst "string" ]) + | DecisionTree(decisionExpr, targets) -> + // Inline every DecisionTreeSuccess leaf into its target body, binding the + // target's captured idents to the success's bound values with nested Lets. + // This turns the compiled match into a plain IfThenElse/Let tree that the + // quotation representation can express faithfully (a shared target is simply + // inlined at each reference site). + let inlined = + decisionExpr + |> visitFromInsideOut (fun e -> + match e with + | DecisionTreeSuccess(idx, boundValues, _) when idx < List.length targets -> + let idents, body = List.item idx targets + + if List.length idents = List.length boundValues then + List.foldBack (fun (id, v) acc -> Let(id, v, acc)) (List.zip idents boundValues) body + else + e + | e -> e + ) + + emitQuotedExpr com inlined | DecisionTreeSuccess(idx, boundValues, _typ) -> match boundValues with @@ -238,12 +277,91 @@ let rec emitQuotedExpr (com: Compiler) (expr: Expr) : Expr = let msg = "Unsupported quotation node: DecisionTreeSuccess" Helper.LibCall(com, "quotation", "mkValue", Any, [ makeStrConst msg; makeStrConst "string" ]) + | Test(testExpr, kind, _r) -> + let target = emitQuotedExpr com testExpr + + match kind with + | UnionCaseTest tag -> + // Represent as: (unionTag target) = tag + let tagExpr = Helper.LibCall(com, "quotation", "mkUnionTag", Any, [ target ]) + let tagConst = emitQuotedExpr com (makeIntConst tag) + + Helper.LibCall( + com, + "quotation", + "mkCall", + Any, + [ + mkNullExpr com "null" + makeStrConst "op_Equality" + mkExprArray com [ tagExpr; tagConst ] + makeStrConst "" + ] + ) + | OptionTest isSome -> + let methodName = + if isSome then + "get_IsSome" + else + "get_IsNone" + + Helper.LibCall( + com, + "quotation", + "mkCall", + Any, + [ + target + makeStrConst methodName + mkExprArray com [] + makeStrConst "Microsoft.FSharp.Core.FSharpOption`1" + ] + ) + | ListTest isCons -> + let methodName = + if isCons then + "get_IsCons" + else + "get_IsEmpty" + + Helper.LibCall( + com, + "quotation", + "mkCall", + Any, + [ + target + makeStrConst methodName + mkExprArray com [] + makeStrConst "Microsoft.FSharp.Collections.FSharpList`1" + ] + ) + | TypeTest typ -> + Helper.LibCall( + com, + "quotation", + "mkCall", + Any, + [ + target + makeStrConst "op_TypeTest" + mkExprArray com [] + makeStrConst (typeToString typ) + ] + ) + | _ -> // Unsupported node: emit an error value let msg = $"Unsupported quotation node: %A{expr.GetType().Name}" Helper.LibCall(com, "quotation", "mkValue", Any, [ makeStrConst msg; makeStrConst "string" ]) +and private mkNullExpr (com: Compiler) (typ: string) : Expr = + // A runtime-built null node. Emitting this (rather than a raw null literal) + // keeps generated code compiling on statically typed targets like Rust, while + // producing the same ExprValue(null, typ) shape the other runtimes had before. + Helper.LibCall(com, "quotation", "mkNull", Any, [ makeStrConst typ ]) + and private emitQuotedValue (com: Compiler) (kind: ValueKind) (_r: SourceLocation option) : Expr = match kind with | BoolConstant b -> Helper.LibCall(com, "quotation", "mkValue", Any, [ makeBoolConst b; makeStrConst "bool" ]) @@ -258,15 +376,19 @@ and private emitQuotedValue (com: Compiler) (kind: ValueKind) (_r: SourceLocatio | StringConstant s -> Helper.LibCall(com, "quotation", "mkValue", Any, [ makeStrConst s; makeStrConst "string" ]) | UnitConstant -> - Helper.LibCall(com, "quotation", "mkValue", Any, [ Value(UnitConstant, None); makeStrConst "unit" ]) + // A unit carries no data. Emit a null node (as for Null) rather than mkValue with a + // literal unit: statically typed targets can't pass a unit/void literal as an + // argument (Dart lowers `()` to a `void` expression; Rust similarly can't box it + // meaningfully). mkNull produces a valid ExprValue(, "unit"). + mkNullExpr com "unit" - | Null _ -> Helper.LibCall(com, "quotation", "mkValue", Any, [ Value(Null Any, None); makeStrConst "null" ]) + | Null _ -> mkNullExpr com "null" | CharConstant c -> Helper.LibCall(com, "quotation", "mkValue", Any, [ Value(CharConstant c, None); makeStrConst "char" ]) | NewTuple(values, _isStruct) -> - let emittedValues = values |> List.map (emitQuotedExpr com) |> makeArray Any + let emittedValues = mkExprArray com (values |> List.map (emitQuotedExpr com)) Helper.LibCall(com, "quotation", "mkNewTuple", Any, [ emittedValues ]) @@ -276,9 +398,31 @@ and private emitQuotedValue (com: Compiler) (kind: ValueKind) (_r: SourceLocatio | Some ent -> ent.FullName | None -> entRef.FullName - let emittedValues = values |> List.map (emitQuotedExpr com) |> makeArray Any + let emittedValues = mkExprArray com (values |> List.map (emitQuotedExpr com)) - Helper.LibCall(com, "quotation", "mkNewUnion", Any, [ makeStrConst entName; makeIntConst tag; emittedValues ]) + if com.Options.Language = Rust then + // Rust deconstructs NewUnionCase into a real UnionCaseInfo carrier, so it + // needs the case name. Other targets keep the original (name, tag, fields) form. + let caseName = + match com.TryGetEntity(entRef) with + | Some ent -> ent.UnionCases.[tag].Name + | None -> "" + + Helper.LibCall( + com, + "quotation", + "mkNewUnion", + Any, + [ makeStrConst entName; makeIntConst tag; makeStrConst caseName; emittedValues ] + ) + else + Helper.LibCall( + com, + "quotation", + "mkNewUnion", + Any, + [ makeStrConst entName; makeIntConst tag; emittedValues ] + ) | NewRecord(values, entRef, _genArgs) -> let fieldNames = @@ -286,16 +430,54 @@ and private emitQuotedValue (com: Compiler) (kind: ValueKind) (_r: SourceLocatio | Some ent -> ent.FSharpFields |> List.map (fun f -> makeStrConst f.Name) |> makeArray Any | None -> makeArray Any [] - let emittedValues = values |> List.map (emitQuotedExpr com) |> makeArray Any + let emittedValues = mkExprArray com (values |> List.map (emitQuotedExpr com)) + + if com.Options.Language = Rust then + // Rust deconstructs NewRecord into a (Type * Expr list) shape; pass the + // record type name for the type slot. Other targets keep (fieldNames, values). + let typeName = + match com.TryGetEntity(entRef) with + | Some ent -> ent.FullName + | None -> entRef.FullName - Helper.LibCall(com, "quotation", "mkNewRecord", Any, [ fieldNames; emittedValues ]) + Helper.LibCall(com, "quotation", "mkNewRecord", Any, [ makeStrConst typeName; fieldNames; emittedValues ]) + else + Helper.LibCall(com, "quotation", "mkNewRecord", Any, [ fieldNames; emittedValues ]) + + | NewOption(value, _typ, _isStruct) when com.Options.Language = Rust -> + // On Rust, model an option construction as F# does in quotations: a NewUnionCase + // of FSharpOption`1 (None = tag 0, Some = tag 1). This lets `<@ Some x @>` match the + // NewUnionCase active pattern. Other targets keep the mkValue "option" form below. + let optName = "Microsoft.FSharp.Core.FSharpOption`1" + + match value with + | Some v -> + let emitted = mkExprArray com [ emitQuotedExpr com v ] + + Helper.LibCall( + com, + "quotation", + "mkNewUnion", + Any, + [ makeStrConst optName; makeIntConst 1; makeStrConst "Some"; emitted ] + ) + | None -> + let emitted = mkExprArray com [] + + Helper.LibCall( + com, + "quotation", + "mkNewUnion", + Any, + [ makeStrConst optName; makeIntConst 0; makeStrConst "None"; emitted ] + ) | NewOption(value, _typ, _isStruct) -> match value with | Some v -> let emitted = emitQuotedExpr com v Helper.LibCall(com, "quotation", "mkValue", Any, [ emitted; makeStrConst "option" ]) - | None -> Helper.LibCall(com, "quotation", "mkValue", Any, [ Value(Null Any, None); makeStrConst "option" ]) + | None -> mkNullExpr com "option" | NewList(headAndTail, _typ) -> match headAndTail with @@ -303,24 +485,73 @@ and private emitQuotedValue (com: Compiler) (kind: ValueKind) (_r: SourceLocatio let headExpr = emitQuotedExpr com head let tailExpr = emitQuotedExpr com tail Helper.LibCall(com, "quotation", "mkNewList", Any, [ headExpr; tailExpr ]) - | None -> Helper.LibCall(com, "quotation", "mkValue", Any, [ Value(Null Any, None); makeStrConst "list" ]) + | None -> mkNullExpr com "list" | _ -> // Fallback for other value kinds let msg = "Unsupported quotation value" Helper.LibCall(com, "quotation", "mkValue", Any, [ makeStrConst msg; makeStrConst "string" ]) +and private numberKindToString (kind: NumberKind) : string = + match kind with + | Int8 -> "int8" + | UInt8 -> "uint8" + | Int16 -> "int16" + | UInt16 -> "uint16" + | Int32 -> "int32" + | UInt32 -> "uint32" + | Int64 -> "int64" + | UInt64 -> "uint64" + | Int128 -> "int128" + | UInt128 -> "uint128" + | BigInt -> "bigint" + | NativeInt -> "nativeint" + | UNativeInt -> "unativeint" + | Float16 -> "float16" + | Float32 -> "float32" + | Float64 -> "float64" + | Decimal -> "decimal" + and private typeToString (t: Type) : string = match t with | Boolean -> "bool" - | Number(Int32, _) -> "int32" - | Number(Float64, _) -> "float64" + | Number(kind, _) -> numberKindToString kind | String -> "string" + | Char -> "char" | Unit -> "unit" + | Regex -> "regex" | Any -> "obj" + | Option(genArg, isStruct) -> + $"""%s{typeToString genArg} %s{if isStruct then + "voption" + else + "option"}""" + | List genArg -> $"%s{typeToString genArg} list" + | Array(genArg, _) -> $"%s{typeToString genArg}[]" + | Nullable(genArg, _) -> $"%s{typeToString genArg} nullable" + | DeclaredType(ref, genArgs) -> + match ref.FullName, genArgs with + | "System.Collections.Generic.IEnumerable`1", [ t ] -> $"%s{typeToString t} seq" + | "System.Guid", _ -> "guid" + | "System.DateTime", _ -> "datetime" + | "System.DateTimeOffset", _ -> "datetimeoffset" + | "System.TimeSpan", _ -> "timespan" + | fullName, _ -> fullName + | GenericParam(name, _, _) -> $"'%s{name}" | LambdaType(argType, returnType) -> $"%s{typeToString argType} -> %s{typeToString returnType}" + | DelegateType(argTypes, returnType) -> (argTypes @ [ returnType ]) |> List.map typeToString |> String.concat " -> " | Tuple(genArgs, _) -> genArgs |> List.map typeToString |> String.concat " * " | _ -> "obj" and private makeArray (elementType: Type) (elements: Expr list) : Expr = Value(NewArray(ArrayValues elements, elementType, ImmutableArray), None) + +// Build an array of quotation-expr children. On the statically typed Rust target an +// empty `Any[]` won't unify with the runtime's FSharpExpr[] parameters, so route +// empty arrays through a runtime helper that returns a correctly-typed empty array. +// A non-empty array's element type is inferred from its (FSharpExpr-returning) items, +// and dynamically typed targets are unaffected either way. +and private mkExprArray (com: Compiler) (elements: Expr list) : Expr = + match elements with + | [] when com.Options.Language = Rust -> Helper.LibCall(com, "quotation", "emptyExprArray", Any, []) + | _ -> makeArray Any elements diff --git a/src/Fable.Transforms/Replacements.Util.fs b/src/Fable.Transforms/Replacements.Util.fs index ff03bd33aa..536404947b 100644 --- a/src/Fable.Transforms/Replacements.Util.fs +++ b/src/Fable.Transforms/Replacements.Util.fs @@ -1551,7 +1551,11 @@ module Quotations = Helper.LibCall(com, libModule, "mkIfThenElse", t, [ guard; thenExpr; elseExpr ], ?loc = r) |> Some | "Call", _, [ instance; methodInfo; argList ] -> - Helper.LibCall(com, libModule, "mkCall", t, [ instance; methodInfo; argList ], ?loc = r) + // Pass an explicit (empty) declaringType as the 4th arg. Rust's mkCall is curried + // with 4 non-defaulted params, so only 3 args would partial-apply into a function + // instead of an FSharpExpr. TS/Python/Dart/PHP default declaringType="" and Beam + // defines mk_call/3 and /4, so the extra arg is back-compatible for every target. + Helper.LibCall(com, libModule, "mkCall", t, [ instance; methodInfo; argList; makeStrConst "" ], ?loc = r) |> Some | "NewTuple", _, [ elements ] -> Helper.LibCall(com, libModule, "mkNewTuple", t, [ elements ], ?loc = r) |> Some | "Sequential", _, [ first; second ] -> diff --git a/src/fable-library-beam/fable_quotation.erl b/src/fable-library-beam/fable_quotation.erl index 117d4f967c..7523476a2f 100644 --- a/src/fable-library-beam/fable_quotation.erl +++ b/src/fable-library-beam/fable_quotation.erl @@ -1,13 +1,13 @@ -module(fable_quotation). -export([ - mk_quot_var/3, mk_var/1, mk_value/2, mk_lambda/2, - mk_application/2, mk_let/3, mk_if_then_else/3, mk_call/3, + mk_quot_var/3, mk_var/1, mk_value/2, mk_null/1, mk_lambda/2, + mk_application/2, mk_let/3, mk_if_then_else/3, mk_call/3, mk_call/4, mk_sequential/2, mk_new_tuple/1, mk_new_union/3, mk_new_record/2, mk_new_list/2, mk_tuple_get/2, mk_union_tag/1, mk_union_field/2, mk_field_get/2, mk_field_set/3, mk_var_set/2, var_get_name/1, var_get_type/1, var_get_is_mutable/1, - get_type/1, + get_type/1, call_declaring_type/1, is_value/1, is_var/1, is_lambda/1, is_application/1, is_let/1, is_if_then_else/1, is_call/1, is_sequential/1, is_new_tuple/1, is_new_union_case/1, is_new_record/1, @@ -33,11 +33,16 @@ var_get_is_mutable({var, _, _, IsMutable}) -> IsMutable. mk_var(Var) -> {expr, var_expr, Var}. mk_value(Value, Type) -> {expr, value, Value, Type}. +%% A null-value node (no instance / null literal / empty option or list). +mk_null(Type) -> {expr, value, undefined, Type}. mk_lambda(Var, Body) -> {expr, lambda, Var, Body}. mk_application(Func, Arg) -> {expr, application, Func, Arg}. mk_let(Var, Value, Body) -> {expr, 'let', Var, Value, Body}. mk_if_then_else(Guard, Then, Else) -> {expr, if_then_else, Guard, Then, Else}. -mk_call(Instance, Method, Args) -> {expr, call, Instance, Method, Args}. +%% 3-arg form kept for backward compatibility (e.g. the programmatic Expr.Call API, +%% which has no separate declaring type); delegates to the 4-arg form. +mk_call(Instance, Method, Args) -> mk_call(Instance, Method, Args, <<"">>). +mk_call(Instance, Method, Args, DeclaringType) -> {expr, call, Instance, Method, Args, DeclaringType}. mk_sequential(First, Second) -> {expr, sequential, First, Second}. mk_new_tuple(Elements) -> {expr, new_tuple, Elements}. mk_new_union(TypeName, Tag, Fields) -> {expr, new_union, TypeName, Tag, Fields}. @@ -87,10 +92,22 @@ is_let(_) -> undefined. is_if_then_else({expr, if_then_else, G, T, E}) -> {G, T, E}; is_if_then_else(_) -> undefined. -%% Call pattern: returns {Instance, Method, Args} (dereference Args) -is_call({expr, call, I, M, A}) -> {I, M, deref(A)}; +%% Call pattern: returns {Instance, Method, Args} (dereference Args). +%% DeclaringType is stored but not part of the Patterns.Call active pattern. +%% A static/operator call carries the null-value node as its instance +%% (see QuotationEmitter); expose it as undefined so Patterns.Call matches F#. +is_call({expr, call, I, M, A, _DT}) -> + Instance = case I of + {expr, value, _, <<"null">>} -> undefined; + _ -> I + end, + {Instance, M, deref(A)}; is_call(_) -> undefined. +%% DeclaringType accessor for the Call node. +call_declaring_type({expr, call, _, _, _, DT}) -> DT; +call_declaring_type(_) -> <<"">>. + %% Sequential pattern: returns {First, Second} is_sequential({expr, sequential, F, S}) -> {F, S}; is_sequential(_) -> undefined. @@ -150,7 +167,7 @@ evaluate({expr, new_tuple, Elements}, Env) -> list_to_tuple([evaluate(E, Env) || E <- deref(Elements)]); evaluate({expr, tuple_get, Inner, Index}, Env) -> element(Index + 1, evaluate(Inner, Env)); -evaluate({expr, call, _Instance, Method, Args}, Env) -> +evaluate({expr, call, _Instance, Method, Args, _DT}, Env) -> EvaluatedArgs = [evaluate(A, Env) || A <- deref(Args)], apply_operator(Method, EvaluatedArgs). @@ -195,7 +212,7 @@ expr_to_string({expr, 'let', {var, Name, _, _}, Value, Body}) -> iolist_to_binary(["let ", Name, " = ", expr_to_string(Value), " in ", expr_to_string(Body)]); expr_to_string({expr, if_then_else, Guard, Then, Else}) -> iolist_to_binary(["if ", expr_to_string(Guard), " then ", expr_to_string(Then), " else ", expr_to_string(Else)]); -expr_to_string({expr, call, _, Method, Args}) -> +expr_to_string({expr, call, _, Method, Args, _DT}) -> ArgsList = deref(Args), ArgsStr = lists:join(", ", [expr_to_string(A) || A <- ArgsList]), case op_symbol(Method) of @@ -260,7 +277,7 @@ collect_free_vars({expr, if_then_else, Guard, Then, Else}, Bound) -> {F2, _} = collect_free_vars(Then, Bound), {F3, _} = collect_free_vars(Else, Bound), {F1 ++ F2 ++ F3, Bound}; -collect_free_vars({expr, call, _, _, Args}, Bound) -> +collect_free_vars({expr, call, _, _, Args, _DT}, Bound) -> Fs = [F || A <- deref(Args), F <- element(1, collect_free_vars(A, Bound))], {Fs, Bound}; collect_free_vars({expr, sequential, First, Second}, Bound) -> diff --git a/src/fable-library-py/fable_library/quotation.py b/src/fable-library-py/fable_library/quotation.py index b3d817eec2..1809f17202 100644 --- a/src/fable-library-py/fable_library/quotation.py +++ b/src/fable-library-py/fable_library/quotation.py @@ -90,6 +90,7 @@ class ExprCall: instance: Any method: str args: Array[Any] + declaring_type: str = "" @dataclass @@ -190,6 +191,11 @@ def mk_value(value: Any, type: str) -> ExprValue: return ExprValue(value, type) +def mk_null(type: str) -> ExprValue: + # A null-value node (no instance / null literal / empty option or list). + return ExprValue(None, type) + + def mk_var(var: Var) -> ExprVarExpr: return ExprVarExpr(var) @@ -210,8 +216,8 @@ def mk_if_then_else(guard: Expr, then_expr: Expr, else_expr: Expr) -> ExprIfThen return ExprIfThenElse(guard, then_expr, else_expr) -def mk_call(instance: Any, method: str, args: Array[Any]) -> ExprCall: - return ExprCall(instance, method, args) +def mk_call(instance: Any, method: str, args: Array[Any], declaring_type: str = "") -> ExprCall: + return ExprCall(instance, method, args, declaring_type) def mk_sequential(first: Expr, second: Expr) -> ExprSequential: @@ -316,10 +322,19 @@ def is_if_then_else(expr: Expr) -> tuple[Expr, Expr, Expr] | None: def is_call(expr: Expr) -> tuple[Any, str, Array[Any]] | None: if isinstance(expr, ExprCall): - return (expr.instance, expr.method, expr.args) + # A static/operator call carries the null-value node as its instance + # (see QuotationEmitter). Expose it as None so Patterns.Call matches F#. + instance = None if (isinstance(expr.instance, ExprValue) and expr.instance.type == "null") else expr.instance + return (instance, expr.method, expr.args) return None +def call_declaring_type(expr: Expr) -> str: + if isinstance(expr, ExprCall): + return expr.declaring_type + return "" + + def is_sequential(expr: Expr) -> tuple[Expr, Expr] | None: if isinstance(expr, ExprSequential): return (expr.first, expr.second) @@ -601,7 +616,7 @@ def sub(e: Expr) -> Expr: return ExprApplication(sub(func), sub(arg)) case ExprIfThenElse(guard=guard, then_expr=then_expr, else_expr=else_expr): return ExprIfThenElse(sub(guard), sub(then_expr), sub(else_expr)) - case ExprCall(instance=instance, method=method, args=args): + case ExprCall(instance=instance, method=method, args=args, declaring_type=declaring_type): new_inst = ( sub(instance) if isinstance( @@ -620,7 +635,7 @@ def sub(e: Expr) -> Expr: ) else instance ) - return ExprCall(new_inst, method, type(args)([sub(a) for a in args])) + return ExprCall(new_inst, method, type(args)([sub(a) for a in args]), declaring_type) case ExprSequential(first=first, second=second): return ExprSequential(sub(first), sub(second)) case ExprNewTuple(elements=elements): diff --git a/src/fable-library-ts/quotation.ts b/src/fable-library-ts/quotation.ts index 1a8e6c02a9..7777a99cdb 100644 --- a/src/fable-library-ts/quotation.ts +++ b/src/fable-library-ts/quotation.ts @@ -88,7 +88,8 @@ export class ExprCall { instance: Expr | null; method: string; args: Expr[]; - constructor(instance: Expr | null, method: string, args: Expr[]) { this.instance = instance; this.method = method; this.args = args; } + declaringType: string; + constructor(instance: Expr | null, method: string, args: Expr[], declaringType: string = "") { this.instance = instance; this.method = method; this.args = args; this.declaringType = declaringType; } toJSON() { return ["Call", this.instance, this.method, this.args]; } } @@ -208,6 +209,11 @@ export function mkValue(value: any, type: string): ExprValue { return new ExprValue(value, type); } +export function mkNull(type: string): ExprValue { + // A null-value node (no instance / null literal / empty option or list). + return new ExprValue(null, type); +} + export function mkVar(v: Var): ExprVarExpr { return new ExprVarExpr(v); } @@ -228,8 +234,8 @@ export function mkIfThenElse(guard: Expr, thenExpr: Expr, elseExpr: Expr): ExprI return new ExprIfThenElse(guard, thenExpr, elseExpr); } -export function mkCall(instance: Expr | null, method: string, args: Expr[]): ExprCall { - return new ExprCall(instance, method, args); +export function mkCall(instance: Expr | null, method: string, args: Expr[], declaringType: string = ""): ExprCall { + return new ExprCall(instance, method, args, declaringType); } export function mkSequential(first: Expr, second: Expr): ExprSequential { @@ -323,10 +329,19 @@ export function isIfThenElse(expr: Expr): [Expr, Expr, Expr] | undefined { } export function isCall(expr: Expr): [Expr | null, string, Expr[]] | undefined { - if (expr instanceof ExprCall) return [expr.instance, expr.method, expr.args]; + if (expr instanceof ExprCall) { + // A static/operator call carries the null-value node as its instance + // (see QuotationEmitter). Expose it as null so Patterns.Call matches F#. + const instance = (expr.instance instanceof ExprValue && expr.instance.type === "null") ? null : expr.instance; + return [instance, expr.method, expr.args]; + } return undefined; } +export function callDeclaringType(expr: Expr): string { + return expr instanceof ExprCall ? expr.declaringType : ""; +} + export function isSequential(expr: Expr): [Expr, Expr] | undefined { if (expr instanceof ExprSequential) return [expr.first, expr.second]; return undefined; @@ -590,7 +605,7 @@ export function substitute(expr: Expr, fn: (v: Var) => Expr | undefined): Expr { if (e instanceof ExprIfThenElse) return new ExprIfThenElse(sub(e.guard), sub(e.thenExpr), sub(e.elseExpr)); if (e instanceof ExprCall) { const newInst = e.instance != null ? sub(e.instance) : e.instance; - return new ExprCall(newInst, e.method, e.args.map(sub)); + return new ExprCall(newInst, e.method, e.args.map(sub), e.declaringType); } if (e instanceof ExprSequential) return new ExprSequential(sub(e.first), sub(e.second)); if (e instanceof ExprNewTuple) return new ExprNewTuple(e.elements.map(sub)); diff --git a/tests/Beam/QuotationTests.fs b/tests/Beam/QuotationTests.fs index 8163afde08..3487d38089 100644 --- a/tests/Beam/QuotationTests.fs +++ b/tests/Beam/QuotationTests.fs @@ -62,6 +62,16 @@ let ``test Evaluate simple value`` () = let result = LeafExpressionConverter.EvaluateQuotation <@ 42 @> equal 42 (result :?> int) +[] +let ``test Evaluate boolean value`` () = + let result = LeafExpressionConverter.EvaluateQuotation <@ true @> + equal true (result :?> bool) + +[] +let ``test Evaluate string value`` () = + let result = LeafExpressionConverter.EvaluateQuotation <@ "hello" @> + equal "hello" (result :?> string) + [] let ``test Evaluate addition`` () = let result = LeafExpressionConverter.EvaluateQuotation <@ 1 + 2 @> @@ -73,10 +83,15 @@ let ``test Evaluate let binding`` () = equal 15 (result :?> int) [] -let ``test Evaluate if then else`` () = +let ``test Evaluate if then else true branch`` () = let result = LeafExpressionConverter.EvaluateQuotation <@ if true then 1 else 2 @> equal 1 (result :?> int) +[] +let ``test Evaluate if then else false branch`` () = + let result = LeafExpressionConverter.EvaluateQuotation <@ if false then 1 else 2 @> + equal 2 (result :?> int) + [] let ``test Evaluate lambda application`` () = let result = LeafExpressionConverter.EvaluateQuotation <@ (fun x -> x + 1) 5 @> @@ -146,3 +161,19 @@ let ``test Expr.GetFreeVars returns empty for closed expr`` () = let q = <@ fun x -> x + 1 @> let freeVars = q.GetFreeVars() |> Seq.length equal 0 freeVars + +// --- Pattern matches lower to IfThenElse (DecisionTree/Test handling) --- + +[] +let ``test Option match deconstructs to IfThenElse`` () = + let q = <@ fun (o: int option) -> match o with Some v -> v | None -> 0 @> + match q with + | Lambda(_, IfThenElse(_, _, _)) -> () + | _ -> failwith "Expected Lambda with IfThenElse body" + +[] +let ``test Literal match deconstructs to IfThenElse`` () = + let q = <@ fun (x: int) -> match x with 0 -> "zero" | _ -> "other" @> + match q with + | Lambda(_, IfThenElse(_, _, _)) -> () + | _ -> failwith "Expected Lambda with IfThenElse body" diff --git a/tests/Js/Main/QuotationTests.fs b/tests/Js/Main/QuotationTests.fs index 7366cde640..9b8bfb01c6 100644 --- a/tests/Js/Main/QuotationTests.fs +++ b/tests/Js/Main/QuotationTests.fs @@ -135,6 +135,18 @@ let tests = let freeVars = q.GetFreeVars() |> Seq.length equal 0 freeVars + testCase "Option match deconstructs to IfThenElse" <| fun () -> + let q = <@ fun (o: int option) -> match o with Some v -> v | None -> 0 @> + match q with + | Lambda(_, IfThenElse(_, _, _)) -> () + | _ -> failwith "Expected Lambda with IfThenElse body" + + testCase "Literal match deconstructs to IfThenElse" <| fun () -> + let q = <@ fun (x: int) -> match x with 0 -> "zero" | _ -> "other" @> + match q with + | Lambda(_, IfThenElse(_, _, _)) -> () + | _ -> failwith "Expected Lambda with IfThenElse body" + testCase "JSON serialization produces Thoth Auto-compatible format" <| fun () -> let q = <@ 42 @> let json = Fable.Core.JS.JSON.stringify(q) diff --git a/tests/Python/TestQuotation.fs b/tests/Python/TestQuotation.fs index 9d0cb8705a..3487d38089 100644 --- a/tests/Python/TestQuotation.fs +++ b/tests/Python/TestQuotation.fs @@ -161,3 +161,19 @@ let ``test Expr.GetFreeVars returns empty for closed expr`` () = let q = <@ fun x -> x + 1 @> let freeVars = q.GetFreeVars() |> Seq.length equal 0 freeVars + +// --- Pattern matches lower to IfThenElse (DecisionTree/Test handling) --- + +[] +let ``test Option match deconstructs to IfThenElse`` () = + let q = <@ fun (o: int option) -> match o with Some v -> v | None -> 0 @> + match q with + | Lambda(_, IfThenElse(_, _, _)) -> () + | _ -> failwith "Expected Lambda with IfThenElse body" + +[] +let ``test Literal match deconstructs to IfThenElse`` () = + let q = <@ fun (x: int) -> match x with 0 -> "zero" | _ -> "other" @> + match q with + | Lambda(_, IfThenElse(_, _, _)) -> () + | _ -> failwith "Expected Lambda with IfThenElse body" From db8f5488d6b1dba7815f0c9690967dbba4e7354c Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Wed, 15 Jul 2026 11:00:02 +0200 Subject: [PATCH 2/6] chore: simplify comments --- src/Fable.Transforms/FSharp2Fable.Util.fs | 10 ++--- src/Fable.Transforms/FSharp2Fable.fs | 3 +- src/Fable.Transforms/QuotationEmitter.fs | 47 ++++++++-------------- src/Fable.Transforms/Replacements.Util.fs | 6 +-- src/fable-library-beam/fable_quotation.erl | 9 ++--- 5 files changed, 26 insertions(+), 49 deletions(-) diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index 8eccaa9759..a6dd95b631 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -537,9 +537,8 @@ type Context = InlinePath: Log.InlinePath list CaptureBaseConsCall: (FSharpEntity * (Fable.Expr -> unit)) option Witnesses: Fable.Witness list - // When true we are translating the body of a code quotation (<@ @>). The body is - // data, never executed, so member calls are kept as-is (not replaced/emitted/inlined) - // to preserve their .NET member metadata for QuotationEmitter. + // True while translating a quotation body (<@ @>): member calls are kept as-is, + // not replaced/emitted/inlined, to preserve .NET metadata for QuotationEmitter. CapturingQuotation: bool } @@ -3063,9 +3062,8 @@ module Util = (callInfo: Fable.CallInfo) = match memb, memb.DeclaringEntity with - // Inside a quotation the body is data, never executed. Preserve the original member - // call (skip replace/emit/import/inline) so its .NET member metadata survives for - // QuotationEmitter. Skipping inlining here also matches real F# quotation semantics. + // Inside a quotation, keep the original member call as-is (skip replace/emit/import/inline) + // so QuotationEmitter gets the real .NET metadata. | _ when ctx.CapturingQuotation -> let membTyp = makeType ctx.GenericArgs memb.FullType memberIdent com r membTyp memb membRef |> makeCall r typ callInfo diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index 9f5fc00919..4e25f6b74c 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -1503,8 +1503,7 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) appliedGenArgs fs |> addErrorAndReturnNull com ctx.InlinePath (makeRangeFrom fsExpr) | FSharpExprPatterns.Quote quotedExpr -> - // Translate the quoted body in "capturing" mode so member calls keep their - // .NET metadata (not replaced/emitted/inlined) — the body is data, not code. + // Capturing mode: member calls keep their .NET metadata instead of being replaced/emitted/inlined. let! body = transformExpr com { ctx with CapturingQuotation = true } [] quotedExpr let exprType = fsExpr.Type let isTyped = exprType.GenericArguments.Count > 0 diff --git a/src/Fable.Transforms/QuotationEmitter.fs b/src/Fable.Transforms/QuotationEmitter.fs index d053a1eb7a..0b2af8466b 100644 --- a/src/Fable.Transforms/QuotationEmitter.fs +++ b/src/Fable.Transforms/QuotationEmitter.fs @@ -115,9 +115,8 @@ let rec emitQuotedExpr (com: Compiler) (expr: Expr) : Expr = let instanceExpr = match info.ThisArg with | Some thisArg -> emitQuotedExpr com thisArg - // A static/operator call has no instance. Emit a runtime-built null node - // (not a raw null literal) so every target — notably statically typed ones - // like Rust — sees an Expr in the instance position. + // Static/operator call: no instance. Use a runtime-built null node instead of a raw + // literal so statically typed targets like Rust see an Expr in the instance position. | None -> mkNullExpr com "null" let declaringType, methodName = @@ -206,8 +205,7 @@ let rec emitQuotedExpr (com: Compiler) (expr: Expr) : Expr = | ListHead | ListTail | OptionValue -> - // Represent option/list value accessors as property-getter calls, - // mirroring how F# quotations model them (PropertyGet get_Value/get_Head/get_Tail). + // Model as property-getter calls (PropertyGet get_Value/get_Head/get_Tail), matching F# quotations. let methodName = match kind with | ListHead -> "get_Head" @@ -224,8 +222,7 @@ let rec emitQuotedExpr (com: Compiler) (expr: Expr) : Expr = [ target; makeStrConst methodName; emptyArgs; makeStrConst "" ] ) | _ -> - // TupleIndex/UnionTag/UnionField/FieldGet handled above; ExprGet and any - // future kinds fall through here. + // ExprGet and any other kinds fall through here as unsupported. let msg = "Unsupported quotation Get kind" Helper.LibCall(com, "quotation", "mkValue", Any, [ makeStrConst msg; makeStrConst "string" ]) @@ -248,11 +245,8 @@ let rec emitQuotedExpr (com: Compiler) (expr: Expr) : Expr = emitQuotedExpr com innerExpr | DecisionTree(decisionExpr, targets) -> - // Inline every DecisionTreeSuccess leaf into its target body, binding the - // target's captured idents to the success's bound values with nested Lets. - // This turns the compiled match into a plain IfThenElse/Let tree that the - // quotation representation can express faithfully (a shared target is simply - // inlined at each reference site). + // Inline each DecisionTreeSuccess leaf into its target body via nested Lets, turning + // the compiled match into a plain IfThenElse/Let tree the quotation model can express. let inlined = decisionExpr |> visitFromInsideOut (fun e -> @@ -357,9 +351,8 @@ let rec emitQuotedExpr (com: Compiler) (expr: Expr) : Expr = Helper.LibCall(com, "quotation", "mkValue", Any, [ makeStrConst msg; makeStrConst "string" ]) and private mkNullExpr (com: Compiler) (typ: string) : Expr = - // A runtime-built null node. Emitting this (rather than a raw null literal) - // keeps generated code compiling on statically typed targets like Rust, while - // producing the same ExprValue(null, typ) shape the other runtimes had before. + // Runtime-built null node (ExprValue(null, typ)) instead of a raw literal, so + // statically typed targets like Rust also get a valid Expr. Helper.LibCall(com, "quotation", "mkNull", Any, [ makeStrConst typ ]) and private emitQuotedValue (com: Compiler) (kind: ValueKind) (_r: SourceLocation option) : Expr = @@ -376,10 +369,8 @@ and private emitQuotedValue (com: Compiler) (kind: ValueKind) (_r: SourceLocatio | StringConstant s -> Helper.LibCall(com, "quotation", "mkValue", Any, [ makeStrConst s; makeStrConst "string" ]) | UnitConstant -> - // A unit carries no data. Emit a null node (as for Null) rather than mkValue with a - // literal unit: statically typed targets can't pass a unit/void literal as an - // argument (Dart lowers `()` to a `void` expression; Rust similarly can't box it - // meaningfully). mkNull produces a valid ExprValue(, "unit"). + // Unit carries no data; emit a null node instead of mkValue since statically typed + // targets (Dart, Rust) can't pass a unit/void literal as an argument. mkNullExpr com "unit" | Null _ -> mkNullExpr com "null" @@ -401,8 +392,7 @@ and private emitQuotedValue (com: Compiler) (kind: ValueKind) (_r: SourceLocatio let emittedValues = mkExprArray com (values |> List.map (emitQuotedExpr com)) if com.Options.Language = Rust then - // Rust deconstructs NewUnionCase into a real UnionCaseInfo carrier, so it - // needs the case name. Other targets keep the original (name, tag, fields) form. + // Rust needs the case name to build a real UnionCaseInfo; other targets keep (name, tag, fields). let caseName = match com.TryGetEntity(entRef) with | Some ent -> ent.UnionCases.[tag].Name @@ -433,8 +423,7 @@ and private emitQuotedValue (com: Compiler) (kind: ValueKind) (_r: SourceLocatio let emittedValues = mkExprArray com (values |> List.map (emitQuotedExpr com)) if com.Options.Language = Rust then - // Rust deconstructs NewRecord into a (Type * Expr list) shape; pass the - // record type name for the type slot. Other targets keep (fieldNames, values). + // Rust needs the record type name; other targets keep (fieldNames, values). let typeName = match com.TryGetEntity(entRef) with | Some ent -> ent.FullName @@ -445,9 +434,8 @@ and private emitQuotedValue (com: Compiler) (kind: ValueKind) (_r: SourceLocatio Helper.LibCall(com, "quotation", "mkNewRecord", Any, [ fieldNames; emittedValues ]) | NewOption(value, _typ, _isStruct) when com.Options.Language = Rust -> - // On Rust, model an option construction as F# does in quotations: a NewUnionCase - // of FSharpOption`1 (None = tag 0, Some = tag 1). This lets `<@ Some x @>` match the - // NewUnionCase active pattern. Other targets keep the mkValue "option" form below. + // Rust models option construction as F# quotations do: a NewUnionCase of FSharpOption`1 + // (None = tag 0, Some = tag 1), so `<@ Some x @>` matches the NewUnionCase active pattern. let optName = "Microsoft.FSharp.Core.FSharpOption`1" match value with @@ -546,11 +534,8 @@ and private typeToString (t: Type) : string = and private makeArray (elementType: Type) (elements: Expr list) : Expr = Value(NewArray(ArrayValues elements, elementType, ImmutableArray), None) -// Build an array of quotation-expr children. On the statically typed Rust target an -// empty `Any[]` won't unify with the runtime's FSharpExpr[] parameters, so route -// empty arrays through a runtime helper that returns a correctly-typed empty array. -// A non-empty array's element type is inferred from its (FSharpExpr-returning) items, -// and dynamically typed targets are unaffected either way. +// Build an array of quotation-expr children. On Rust an empty `Any[]` won't unify with +// FSharpExpr[], so route empty arrays through a runtime helper instead; other targets are unaffected. and private mkExprArray (com: Compiler) (elements: Expr list) : Expr = match elements with | [] when com.Options.Language = Rust -> Helper.LibCall(com, "quotation", "emptyExprArray", Any, []) diff --git a/src/Fable.Transforms/Replacements.Util.fs b/src/Fable.Transforms/Replacements.Util.fs index 536404947b..ef005149e8 100644 --- a/src/Fable.Transforms/Replacements.Util.fs +++ b/src/Fable.Transforms/Replacements.Util.fs @@ -1551,10 +1551,8 @@ module Quotations = Helper.LibCall(com, libModule, "mkIfThenElse", t, [ guard; thenExpr; elseExpr ], ?loc = r) |> Some | "Call", _, [ instance; methodInfo; argList ] -> - // Pass an explicit (empty) declaringType as the 4th arg. Rust's mkCall is curried - // with 4 non-defaulted params, so only 3 args would partial-apply into a function - // instead of an FSharpExpr. TS/Python/Dart/PHP default declaringType="" and Beam - // defines mk_call/3 and /4, so the extra arg is back-compatible for every target. + // Pass an explicit empty declaringType: Rust's mkCall has 4 non-defaulted params, so + // 3 args would partial-apply instead of returning an FSharpExpr. Harmless elsewhere. Helper.LibCall(com, libModule, "mkCall", t, [ instance; methodInfo; argList; makeStrConst "" ], ?loc = r) |> Some | "NewTuple", _, [ elements ] -> Helper.LibCall(com, libModule, "mkNewTuple", t, [ elements ], ?loc = r) |> Some diff --git a/src/fable-library-beam/fable_quotation.erl b/src/fable-library-beam/fable_quotation.erl index 7523476a2f..e976da357a 100644 --- a/src/fable-library-beam/fable_quotation.erl +++ b/src/fable-library-beam/fable_quotation.erl @@ -39,8 +39,7 @@ mk_lambda(Var, Body) -> {expr, lambda, Var, Body}. mk_application(Func, Arg) -> {expr, application, Func, Arg}. mk_let(Var, Value, Body) -> {expr, 'let', Var, Value, Body}. mk_if_then_else(Guard, Then, Else) -> {expr, if_then_else, Guard, Then, Else}. -%% 3-arg form kept for backward compatibility (e.g. the programmatic Expr.Call API, -%% which has no separate declaring type); delegates to the 4-arg form. +%% 3-arg form kept for backward compatibility; delegates to the 4-arg form. mk_call(Instance, Method, Args) -> mk_call(Instance, Method, Args, <<"">>). mk_call(Instance, Method, Args, DeclaringType) -> {expr, call, Instance, Method, Args, DeclaringType}. mk_sequential(First, Second) -> {expr, sequential, First, Second}. @@ -92,10 +91,8 @@ is_let(_) -> undefined. is_if_then_else({expr, if_then_else, G, T, E}) -> {G, T, E}; is_if_then_else(_) -> undefined. -%% Call pattern: returns {Instance, Method, Args} (dereference Args). -%% DeclaringType is stored but not part of the Patterns.Call active pattern. -%% A static/operator call carries the null-value node as its instance -%% (see QuotationEmitter); expose it as undefined so Patterns.Call matches F#. +%% Call pattern: returns {Instance, Method, Args}. A static/operator call carries the +%% null-value node as its instance; expose it as undefined so Patterns.Call matches F#. is_call({expr, call, I, M, A, _DT}) -> Instance = case I of {expr, value, _, <<"null">>} -> undefined; From c30bb2d3387b7adf5e407f6004260fcdfdd544f4 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Wed, 15 Jul 2026 12:21:21 +0200 Subject: [PATCH 3/6] chore: add tests --- src/Fable.Transforms/FSharp2Fable.Util.fs | 10 ++- src/Fable.Transforms/QuotationEmitter.fs | 41 ++++----- src/fable-library-beam/fable_quotation.erl | 10 ++- .../fable_library/quotation.py | 10 ++- src/fable-library-ts/quotation.ts | 10 ++- tests/Beam/QuotationTests.fs | 89 +++++++++++++++++++ tests/Js/Main/QuotationTests.fs | 81 +++++++++++++++++ tests/Python/TestQuotation.fs | 89 +++++++++++++++++++ 8 files changed, 314 insertions(+), 26 deletions(-) diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index a6dd95b631..8899c69825 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -3063,9 +3063,17 @@ module Util = = match memb, memb.DeclaringEntity with // Inside a quotation, keep the original member call as-is (skip replace/emit/import/inline) - // so QuotationEmitter gets the real .NET metadata. + // so QuotationEmitter gets the real .NET metadata. Tag plain property getters so + // QuotationEmitter can represent them as PropertyGet instead of a method Call. | _ when ctx.CapturingQuotation -> let membTyp = makeType ctx.GenericArgs memb.FullType + + let callInfo = + if memb.IsPropertyGetterMethod && countNonCurriedParams memb = 0 then + { callInfo with Tags = "property" :: callInfo.Tags } + else + callInfo + memberIdent com r membTyp memb membRef |> makeCall r typ callInfo | Emitted com ctx r typ (Some callInfo) emitted, _ -> emitted diff --git a/src/Fable.Transforms/QuotationEmitter.fs b/src/Fable.Transforms/QuotationEmitter.fs index 0b2af8466b..99eb0f5e07 100644 --- a/src/Fable.Transforms/QuotationEmitter.fs +++ b/src/Fable.Transforms/QuotationEmitter.fs @@ -124,12 +124,20 @@ let rec emitQuotedExpr (com: Compiler) (expr: Expr) : Expr = | Some(MemberRef(declaringEntity, mInfo)) -> declaringEntity.FullName, mInfo.CompiledName | _ -> "", "unknown" - let methodExpr = makeStrConst methodName - let declTypeExpr = makeStrConst declaringType - - let argExprs = mkExprArray com (info.Args |> List.map (emitQuotedExpr com)) - - Helper.LibCall(com, "quotation", "mkCall", Any, [ instanceExpr; methodExpr; argExprs; declTypeExpr ]) + // A plain property getter preserved via CapturingQuotation (tagged "property" in + // FSharp2Fable.Util.fs) is represented as PropertyGet (mkFieldGet), matching how real + // F# quotations model property access — not as a method Call. + if + info.Tags |> List.contains "property" + && methodName.StartsWith("get_", System.StringComparison.Ordinal) + then + let propName = methodName.Substring(4) + Helper.LibCall(com, "quotation", "mkFieldGet", Any, [ instanceExpr; makeStrConst propName ]) + else + let methodExpr = makeStrConst methodName + let declTypeExpr = makeStrConst declaringType + let argExprs = mkExprArray com (info.Args |> List.map (emitQuotedExpr com)) + Helper.LibCall(com, "quotation", "mkCall", Any, [ instanceExpr; methodExpr; argExprs; declTypeExpr ]) | Sequential exprs -> match exprs with @@ -205,22 +213,15 @@ let rec emitQuotedExpr (com: Compiler) (expr: Expr) : Expr = | ListHead | ListTail | OptionValue -> - // Model as property-getter calls (PropertyGet get_Value/get_Head/get_Tail), matching F# quotations. - let methodName = + // Model as property gets (PropertyGet Value/Head/Tail), matching how F# quotations + // and the FieldGet case above both represent property/field access. + let propName = match kind with - | ListHead -> "get_Head" - | ListTail -> "get_Tail" - | _ -> "get_Value" - - let emptyArgs = mkExprArray com [] + | ListHead -> "Head" + | ListTail -> "Tail" + | _ -> "Value" - Helper.LibCall( - com, - "quotation", - "mkCall", - Any, - [ target; makeStrConst methodName; emptyArgs; makeStrConst "" ] - ) + Helper.LibCall(com, "quotation", "mkFieldGet", Any, [ target; makeStrConst propName ]) | _ -> // ExprGet and any other kinds fall through here as unsupported. let msg = "Unsupported quotation Get kind" diff --git a/src/fable-library-beam/fable_quotation.erl b/src/fable-library-beam/fable_quotation.erl index e976da357a..709f1987af 100644 --- a/src/fable-library-beam/fable_quotation.erl +++ b/src/fable-library-beam/fable_quotation.erl @@ -126,7 +126,15 @@ is_tuple_get({expr, tuple_get, E, I}) -> {E, I}; is_tuple_get(_) -> undefined. %% FieldGet/PropertyGet pattern: returns {Expr, FieldName} -is_field_get({expr, field_get, E, N}) -> {E, N}; +%% Third element mirrors PropertyGet's indexer-args slot; field/property access here is +%% never indexed, so it's always empty. A static property getter carries the null-value +%% node as its instance (see QuotationEmitter); expose it as undefined so PropertyGet matches F#. +is_field_get({expr, field_get, I, N}) -> + Instance = case I of + {expr, value, _, <<"null">>} -> undefined; + _ -> I + end, + {Instance, N, []}; is_field_get(_) -> undefined. %% =================================================================== diff --git a/src/fable-library-py/fable_library/quotation.py b/src/fable-library-py/fable_library/quotation.py index 1809f17202..9cff37796a 100644 --- a/src/fable-library-py/fable_library/quotation.py +++ b/src/fable-library-py/fable_library/quotation.py @@ -365,9 +365,15 @@ def is_tuple_get(expr: Expr) -> tuple[Expr, int] | None: return None -def is_field_get(expr: Expr) -> tuple[Expr, str] | None: +def is_field_get(expr: Expr) -> tuple[Any, str, FSharpList[Any]] | None: + # Third element mirrors PropertyGet's indexer-args slot; field/property access here is + # never indexed, so it's always empty. Must be a real FSharpList (not a plain Python list) + # since compiled F# `[]` patterns call FSharpList__get_IsEmpty on it. A static property + # getter carries the null-value node as its instance (see QuotationEmitter); expose it as + # None so PropertyGet matches F#. if isinstance(expr, ExprFieldGet): - return (expr.expr, expr.field_name) + instance = None if (isinstance(expr.expr, ExprValue) and expr.expr.type == "null") else expr.expr + return (instance, expr.field_name, of_array([])) return None diff --git a/src/fable-library-ts/quotation.ts b/src/fable-library-ts/quotation.ts index 7777a99cdb..0d1f494b4a 100644 --- a/src/fable-library-ts/quotation.ts +++ b/src/fable-library-ts/quotation.ts @@ -367,8 +367,14 @@ export function isTupleGet(expr: Expr): [Expr, number] | undefined { return undefined; } -export function isFieldGet(expr: Expr): [Expr, string] | undefined { - if (expr instanceof ExprFieldGet) return [expr.expr, expr.fieldName]; +export function isFieldGet(expr: Expr): [Expr | null, string, Expr[]] | undefined { + // Third element mirrors PropertyGet's indexer-args slot; field/property access here is + // never indexed, so it's always empty. A static property getter carries the null-value + // node as its instance (see QuotationEmitter); expose it as null so PropertyGet matches F#. + if (expr instanceof ExprFieldGet) { + const instance = (expr.expr instanceof ExprValue && expr.expr.type === "null") ? null : expr.expr; + return [instance, expr.fieldName, []]; + } return undefined; } diff --git a/tests/Beam/QuotationTests.fs b/tests/Beam/QuotationTests.fs index 3487d38089..d1d3f38355 100644 --- a/tests/Beam/QuotationTests.fs +++ b/tests/Beam/QuotationTests.fs @@ -6,6 +6,12 @@ open Microsoft.FSharp.Quotations open Microsoft.FSharp.Quotations.Patterns open Microsoft.FSharp.Linq.RuntimeHelpers +type QuotationTestUnion = + | QuotCircle of float + | QuotSquare of float + +let inline quotTestDouble x = x * 2 + [] let ``test Simple integer value quotation`` () = let q = <@ 42 @> @@ -177,3 +183,86 @@ let ``test Literal match deconstructs to IfThenElse`` () = match q with | Lambda(_, IfThenElse(_, _, _)) -> () | _ -> failwith "Expected Lambda with IfThenElse body" + +[] +let ``test Union case match deconstructs to IfThenElse`` () = + let q = + <@ fun (s: QuotationTestUnion) -> + match s with + | QuotCircle _ -> true + | QuotSquare _ -> false @> + + match q with + | Lambda(_, IfThenElse(_, _, _)) -> () + | _ -> failwith "Expected Lambda with IfThenElse body" + +[] +let ``test List match deconstructs to IfThenElse`` () = + let q = + <@ fun (xs: int list) -> + match xs with + | [] -> true + | _ :: _ -> false @> + + match q with + | Lambda(_, IfThenElse(_, _, _)) -> () + | _ -> failwith "Expected Lambda with IfThenElse body" + +[] +let ``test Type test match deconstructs to IfThenElse`` () = + let q = + <@ fun (o: obj) -> + match o with + | :? int -> true + | _ -> false @> + + match q with + | Lambda(_, IfThenElse(_, _, _)) -> () + | _ -> failwith "Expected Lambda with IfThenElse body" + +// --- Member calls inside quotations keep original .NET metadata (not inlined) --- + +[] +let ``test Inline function call inside quotation is preserved, not inlined`` () = + let q = <@ quotTestDouble 5 @> + + match q with + | Call(None, _mi, args) -> equal 1 (Seq.length args) + | _ -> failwith "Expected a preserved Call node with a single argument" + +// --- Option/List property-getter accessors (ListHead/ListTail/OptionValue) deconstruct +// as PropertyGet, matching real F# quotations --- + +[] +let ``test Option.Value access inside a quotation is a PropertyGet`` () = + let q = <@ fun (o: int option) -> o.Value @> + + match q with + | Lambda(_, PropertyGet(Some _, _, [])) -> () + | _ -> failwith "Expected Lambda with PropertyGet body" + +[] +let ``test List.Head access inside a quotation is a PropertyGet`` () = + let q = <@ fun (xs: int list) -> xs.Head @> + + match q with + | Lambda(_, PropertyGet(Some _, _, [])) -> () + | _ -> failwith "Expected Lambda with PropertyGet body" + +[] +let ``test List.Tail access inside a quotation is a PropertyGet`` () = + let q = <@ fun (xs: int list) -> xs.Tail @> + + match q with + | Lambda(_, PropertyGet(Some _, _, [])) -> () + | _ -> failwith "Expected Lambda with PropertyGet body" + +// --- Runtime-built null nodes (mkNullExpr) --- + +[] +let ``test Unit quotation still matches Value node`` () = + let q = <@ () @> + + match q with + | Value(_, _) -> () + | _ -> failwith "Expected Value" diff --git a/tests/Js/Main/QuotationTests.fs b/tests/Js/Main/QuotationTests.fs index 9b8bfb01c6..196010e391 100644 --- a/tests/Js/Main/QuotationTests.fs +++ b/tests/Js/Main/QuotationTests.fs @@ -9,6 +9,12 @@ open Microsoft.FSharp.Linq.RuntimeHelpers open Fable.Core.JsInterop #endif +type QuotationTestUnion = + | QuotCircle of float + | QuotSquare of float + +let inline quotTestDouble x = x * 2 + let tests = testList "Quotations" [ #if FABLE_COMPILER @@ -147,6 +153,81 @@ let tests = | Lambda(_, IfThenElse(_, _, _)) -> () | _ -> failwith "Expected Lambda with IfThenElse body" + testCase "Union case match deconstructs to IfThenElse" <| fun () -> + let q = + <@ fun (s: QuotationTestUnion) -> + match s with + | QuotCircle _ -> true + | QuotSquare _ -> false @> + + match q with + | Lambda(_, IfThenElse(_, _, _)) -> () + | _ -> failwith "Expected Lambda with IfThenElse body" + + testCase "List match deconstructs to IfThenElse" <| fun () -> + let q = + <@ fun (xs: int list) -> + match xs with + | [] -> true + | _ :: _ -> false @> + + match q with + | Lambda(_, IfThenElse(_, _, _)) -> () + | _ -> failwith "Expected Lambda with IfThenElse body" + + testCase "Type test match deconstructs to IfThenElse" <| fun () -> + let q = + <@ fun (o: obj) -> + match o with + | :? int -> true + | _ -> false @> + + match q with + | Lambda(_, IfThenElse(_, _, _)) -> () + | _ -> failwith "Expected Lambda with IfThenElse body" + + // --- Member calls inside quotations keep original .NET metadata (not inlined) --- + + testCase "Inline function call inside quotation is preserved, not inlined" <| fun () -> + let q = <@ quotTestDouble 5 @> + + match q with + | Call(None, _mi, args) -> equal 1 (Seq.length args) + | _ -> failwith "Expected a preserved Call node with a single argument" + + // --- Option/List property-getter accessors (ListHead/ListTail/OptionValue) deconstruct + // as PropertyGet, matching real F# quotations --- + + testCase "Option.Value access inside a quotation is a PropertyGet" <| fun () -> + let q = <@ fun (o: int option) -> o.Value @> + + match q with + | Lambda(_, PropertyGet(Some _, _, [])) -> () + | _ -> failwith "Expected Lambda with PropertyGet body" + + testCase "List.Head access inside a quotation is a PropertyGet" <| fun () -> + let q = <@ fun (xs: int list) -> xs.Head @> + + match q with + | Lambda(_, PropertyGet(Some _, _, [])) -> () + | _ -> failwith "Expected Lambda with PropertyGet body" + + testCase "List.Tail access inside a quotation is a PropertyGet" <| fun () -> + let q = <@ fun (xs: int list) -> xs.Tail @> + + match q with + | Lambda(_, PropertyGet(Some _, _, [])) -> () + | _ -> failwith "Expected Lambda with PropertyGet body" + + // --- Runtime-built null nodes (mkNullExpr) --- + + testCase "Unit quotation still matches Value node" <| fun () -> + let q = <@ () @> + + match q with + | Value(_, _) -> () + | _ -> failwith "Expected Value" + testCase "JSON serialization produces Thoth Auto-compatible format" <| fun () -> let q = <@ 42 @> let json = Fable.Core.JS.JSON.stringify(q) diff --git a/tests/Python/TestQuotation.fs b/tests/Python/TestQuotation.fs index 3487d38089..d1d3f38355 100644 --- a/tests/Python/TestQuotation.fs +++ b/tests/Python/TestQuotation.fs @@ -6,6 +6,12 @@ open Microsoft.FSharp.Quotations open Microsoft.FSharp.Quotations.Patterns open Microsoft.FSharp.Linq.RuntimeHelpers +type QuotationTestUnion = + | QuotCircle of float + | QuotSquare of float + +let inline quotTestDouble x = x * 2 + [] let ``test Simple integer value quotation`` () = let q = <@ 42 @> @@ -177,3 +183,86 @@ let ``test Literal match deconstructs to IfThenElse`` () = match q with | Lambda(_, IfThenElse(_, _, _)) -> () | _ -> failwith "Expected Lambda with IfThenElse body" + +[] +let ``test Union case match deconstructs to IfThenElse`` () = + let q = + <@ fun (s: QuotationTestUnion) -> + match s with + | QuotCircle _ -> true + | QuotSquare _ -> false @> + + match q with + | Lambda(_, IfThenElse(_, _, _)) -> () + | _ -> failwith "Expected Lambda with IfThenElse body" + +[] +let ``test List match deconstructs to IfThenElse`` () = + let q = + <@ fun (xs: int list) -> + match xs with + | [] -> true + | _ :: _ -> false @> + + match q with + | Lambda(_, IfThenElse(_, _, _)) -> () + | _ -> failwith "Expected Lambda with IfThenElse body" + +[] +let ``test Type test match deconstructs to IfThenElse`` () = + let q = + <@ fun (o: obj) -> + match o with + | :? int -> true + | _ -> false @> + + match q with + | Lambda(_, IfThenElse(_, _, _)) -> () + | _ -> failwith "Expected Lambda with IfThenElse body" + +// --- Member calls inside quotations keep original .NET metadata (not inlined) --- + +[] +let ``test Inline function call inside quotation is preserved, not inlined`` () = + let q = <@ quotTestDouble 5 @> + + match q with + | Call(None, _mi, args) -> equal 1 (Seq.length args) + | _ -> failwith "Expected a preserved Call node with a single argument" + +// --- Option/List property-getter accessors (ListHead/ListTail/OptionValue) deconstruct +// as PropertyGet, matching real F# quotations --- + +[] +let ``test Option.Value access inside a quotation is a PropertyGet`` () = + let q = <@ fun (o: int option) -> o.Value @> + + match q with + | Lambda(_, PropertyGet(Some _, _, [])) -> () + | _ -> failwith "Expected Lambda with PropertyGet body" + +[] +let ``test List.Head access inside a quotation is a PropertyGet`` () = + let q = <@ fun (xs: int list) -> xs.Head @> + + match q with + | Lambda(_, PropertyGet(Some _, _, [])) -> () + | _ -> failwith "Expected Lambda with PropertyGet body" + +[] +let ``test List.Tail access inside a quotation is a PropertyGet`` () = + let q = <@ fun (xs: int list) -> xs.Tail @> + + match q with + | Lambda(_, PropertyGet(Some _, _, [])) -> () + | _ -> failwith "Expected Lambda with PropertyGet body" + +// --- Runtime-built null nodes (mkNullExpr) --- + +[] +let ``test Unit quotation still matches Value node`` () = + let q = <@ () @> + + match q with + | Value(_, _) -> () + | _ -> failwith "Expected Value" From 8654edb85ed29633b2223b67384a13535d74c019 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Wed, 15 Jul 2026 14:08:48 +0200 Subject: [PATCH 4/6] chore: more fixes and tests --- src/Fable.Transforms/QuotationEmitter.fs | 18 +++++++---- src/fable-library-beam/fable_quotation.erl | 15 +++++----- .../fable_library/quotation.py | 16 +++++----- src/fable-library-ts/quotation.ts | 12 ++++---- tests/Beam/QuotationTests.fs | 17 +++++++++++ tests/Js/Main/QuotationTests.fs | 30 +++++++++++++++++++ tests/Python/TestQuotation.fs | 17 +++++++++++ 7 files changed, 96 insertions(+), 29 deletions(-) diff --git a/src/Fable.Transforms/QuotationEmitter.fs b/src/Fable.Transforms/QuotationEmitter.fs index 99eb0f5e07..48ea46f98f 100644 --- a/src/Fable.Transforms/QuotationEmitter.fs +++ b/src/Fable.Transforms/QuotationEmitter.fs @@ -115,9 +115,8 @@ let rec emitQuotedExpr (com: Compiler) (expr: Expr) : Expr = let instanceExpr = match info.ThisArg with | Some thisArg -> emitQuotedExpr com thisArg - // Static/operator call: no instance. Use a runtime-built null node instead of a raw - // literal so statically typed targets like Rust see an Expr in the instance position. - | None -> mkNullExpr com "null" + // Static/operator call: no instance. + | None -> mkNoInstanceExpr com let declaringType, methodName = match info.MemberRef with @@ -194,7 +193,7 @@ let rec emitQuotedExpr (com: Compiler) (expr: Expr) : Expr = name, [ left; right ] let methodExpr = makeStrConst opName - let instanceExpr = mkNullExpr com "null" + let instanceExpr = mkNoInstanceExpr com let argExprs = mkExprArray com (args |> List.map (emitQuotedExpr com)) @@ -275,6 +274,10 @@ let rec emitQuotedExpr (com: Compiler) (expr: Expr) : Expr = | Test(testExpr, kind, _r) -> let target = emitQuotedExpr com testExpr + // Note: real .NET quotations use dedicated UnionCaseTest/TypeTest node kinds here, not + // Call — this emitter renders all of these as synthetic Calls instead (e.g. "get_IsCons", + // "op_TypeTest" aren't real .NET members). UnionCaseTestPattern/TypeTestPattern won't + // match this runtime's output. For TypeTest, "declaringType" carries the tested type. match kind with | UnionCaseTest tag -> // Represent as: (unionTag target) = tag @@ -287,7 +290,7 @@ let rec emitQuotedExpr (com: Compiler) (expr: Expr) : Expr = "mkCall", Any, [ - mkNullExpr com "null" + mkNoInstanceExpr com makeStrConst "op_Equality" mkExprArray com [ tagExpr; tagConst ] makeStrConst "" @@ -356,6 +359,11 @@ and private mkNullExpr (com: Compiler) (typ: string) : Expr = // statically typed targets like Rust also get a valid Expr. Helper.LibCall(com, "quotation", "mkNull", Any, [ makeStrConst typ ]) +and private mkNoInstanceExpr (com: Compiler) : Expr = + // "novalue" tag distinguishes "no instance" from a genuine quoted null value ("null"), + // so isCall/isFieldGet don't conflate the two. + mkNullExpr com "novalue" + and private emitQuotedValue (com: Compiler) (kind: ValueKind) (_r: SourceLocation option) : Expr = match kind with | BoolConstant b -> Helper.LibCall(com, "quotation", "mkValue", Any, [ makeBoolConst b; makeStrConst "bool" ]) diff --git a/src/fable-library-beam/fable_quotation.erl b/src/fable-library-beam/fable_quotation.erl index 709f1987af..0abef8bb2a 100644 --- a/src/fable-library-beam/fable_quotation.erl +++ b/src/fable-library-beam/fable_quotation.erl @@ -91,11 +91,11 @@ is_let(_) -> undefined. is_if_then_else({expr, if_then_else, G, T, E}) -> {G, T, E}; is_if_then_else(_) -> undefined. -%% Call pattern: returns {Instance, Method, Args}. A static/operator call carries the -%% null-value node as its instance; expose it as undefined so Patterns.Call matches F#. +%% Call pattern: returns {Instance, Method, Args}. "novalue" is the "no instance" sentinel, +%% distinct from a genuine quoted null ("null"). is_call({expr, call, I, M, A, _DT}) -> Instance = case I of - {expr, value, _, <<"null">>} -> undefined; + {expr, value, _, <<"novalue">>} -> undefined; _ -> I end, {Instance, M, deref(A)}; @@ -125,13 +125,12 @@ is_new_record(_) -> undefined. is_tuple_get({expr, tuple_get, E, I}) -> {E, I}; is_tuple_get(_) -> undefined. -%% FieldGet/PropertyGet pattern: returns {Expr, FieldName} -%% Third element mirrors PropertyGet's indexer-args slot; field/property access here is -%% never indexed, so it's always empty. A static property getter carries the null-value -%% node as its instance (see QuotationEmitter); expose it as undefined so PropertyGet matches F#. +%% FieldGet/PropertyGet pattern: returns {Expr, FieldName}. Third element mirrors +%% PropertyGet's indexer-args slot, always empty here. "novalue" is the "no instance" +%% sentinel, distinct from a genuine quoted null ("null"). is_field_get({expr, field_get, I, N}) -> Instance = case I of - {expr, value, _, <<"null">>} -> undefined; + {expr, value, _, <<"novalue">>} -> undefined; _ -> I end, {Instance, N, []}; diff --git a/src/fable-library-py/fable_library/quotation.py b/src/fable-library-py/fable_library/quotation.py index 9cff37796a..26f5feef31 100644 --- a/src/fable-library-py/fable_library/quotation.py +++ b/src/fable-library-py/fable_library/quotation.py @@ -322,9 +322,8 @@ def is_if_then_else(expr: Expr) -> tuple[Expr, Expr, Expr] | None: def is_call(expr: Expr) -> tuple[Any, str, Array[Any]] | None: if isinstance(expr, ExprCall): - # A static/operator call carries the null-value node as its instance - # (see QuotationEmitter). Expose it as None so Patterns.Call matches F#. - instance = None if (isinstance(expr.instance, ExprValue) and expr.instance.type == "null") else expr.instance + # "novalue" is the "no instance" sentinel, distinct from a genuine quoted null ("null"). + instance = None if (isinstance(expr.instance, ExprValue) and expr.instance.type == "novalue") else expr.instance return (instance, expr.method, expr.args) return None @@ -366,13 +365,12 @@ def is_tuple_get(expr: Expr) -> tuple[Expr, int] | None: def is_field_get(expr: Expr) -> tuple[Any, str, FSharpList[Any]] | None: - # Third element mirrors PropertyGet's indexer-args slot; field/property access here is - # never indexed, so it's always empty. Must be a real FSharpList (not a plain Python list) - # since compiled F# `[]` patterns call FSharpList__get_IsEmpty on it. A static property - # getter carries the null-value node as its instance (see QuotationEmitter); expose it as - # None so PropertyGet matches F#. + # Third element mirrors PropertyGet's indexer-args slot, always empty here (never indexed). + # Must be a real FSharpList (not a plain Python list) since compiled F# `[]` patterns call + # FSharpList__get_IsEmpty on it. "novalue" is the "no instance" sentinel, distinct from a + # genuine quoted null ("null"). if isinstance(expr, ExprFieldGet): - instance = None if (isinstance(expr.expr, ExprValue) and expr.expr.type == "null") else expr.expr + instance = None if (isinstance(expr.expr, ExprValue) and expr.expr.type == "novalue") else expr.expr return (instance, expr.field_name, of_array([])) return None diff --git a/src/fable-library-ts/quotation.ts b/src/fable-library-ts/quotation.ts index 0d1f494b4a..07bd7afcfd 100644 --- a/src/fable-library-ts/quotation.ts +++ b/src/fable-library-ts/quotation.ts @@ -330,9 +330,8 @@ export function isIfThenElse(expr: Expr): [Expr, Expr, Expr] | undefined { export function isCall(expr: Expr): [Expr | null, string, Expr[]] | undefined { if (expr instanceof ExprCall) { - // A static/operator call carries the null-value node as its instance - // (see QuotationEmitter). Expose it as null so Patterns.Call matches F#. - const instance = (expr.instance instanceof ExprValue && expr.instance.type === "null") ? null : expr.instance; + // "novalue" is the "no instance" sentinel, distinct from a genuine quoted null ("null"). + const instance = (expr.instance instanceof ExprValue && expr.instance.type === "novalue") ? null : expr.instance; return [instance, expr.method, expr.args]; } return undefined; @@ -368,11 +367,10 @@ export function isTupleGet(expr: Expr): [Expr, number] | undefined { } export function isFieldGet(expr: Expr): [Expr | null, string, Expr[]] | undefined { - // Third element mirrors PropertyGet's indexer-args slot; field/property access here is - // never indexed, so it's always empty. A static property getter carries the null-value - // node as its instance (see QuotationEmitter); expose it as null so PropertyGet matches F#. + // Third element mirrors PropertyGet's indexer-args slot, always empty here (never indexed). + // "novalue" is the "no instance" sentinel, distinct from a genuine quoted null ("null"). if (expr instanceof ExprFieldGet) { - const instance = (expr.expr instanceof ExprValue && expr.expr.type === "null") ? null : expr.expr; + const instance = (expr.expr instanceof ExprValue && expr.expr.type === "novalue") ? null : expr.expr; return [instance, expr.fieldName, []]; } return undefined; diff --git a/tests/Beam/QuotationTests.fs b/tests/Beam/QuotationTests.fs index d1d3f38355..f0a5d41a22 100644 --- a/tests/Beam/QuotationTests.fs +++ b/tests/Beam/QuotationTests.fs @@ -169,6 +169,8 @@ let ``test Expr.GetFreeVars returns empty for closed expr`` () = equal 0 freeVars // --- Pattern matches lower to IfThenElse (DecisionTree/Test handling) --- +// Note: these only check the outer IfThenElse shape. The guard itself is a synthetic Call +// here (e.g. "get_IsNone", "op_TypeTest"), not the real UnionCaseTest/TypeTest node .NET uses. [] let ``test Option match deconstructs to IfThenElse`` () = @@ -266,3 +268,18 @@ let ``test Unit quotation still matches Value node`` () = match q with | Value(_, _) -> () | _ -> failwith "Expected Value" + +[] +let ``test Call on an instance whose value is null keeps a Some instance`` () = + // Guards against conflating "no instance" (static/operator call) with "instance value is + // null" — both used to serialize to the same node. .NET wraps this in a Let (struct copy). + let q = <@ (Unchecked.defaultof>).HasValue @> + + let rec hasSomeInstancePropertyGet expr = + match expr with + | PropertyGet(Some _, _, []) -> true + | Let(_, _, body) -> hasSomeInstancePropertyGet body + | _ -> false + + if not (hasSomeInstancePropertyGet q) then + failwith "Expected a PropertyGet with a Some instance, even though its value is null" diff --git a/tests/Js/Main/QuotationTests.fs b/tests/Js/Main/QuotationTests.fs index 196010e391..892fc9a753 100644 --- a/tests/Js/Main/QuotationTests.fs +++ b/tests/Js/Main/QuotationTests.fs @@ -15,6 +15,10 @@ type QuotationTestUnion = let inline quotTestDouble x = x * 2 +type QuotationIndexerTest(values: int[]) = + member _.Item + with get (i: int) = values.[i] + let tests = testList "Quotations" [ #if FABLE_COMPILER @@ -141,6 +145,8 @@ let tests = let freeVars = q.GetFreeVars() |> Seq.length equal 0 freeVars + // Note: these only check the outer IfThenElse shape. The guard itself is a synthetic Call + // here (e.g. "get_IsNone", "op_TypeTest"), not the real UnionCaseTest/TypeTest node .NET uses. testCase "Option match deconstructs to IfThenElse" <| fun () -> let q = <@ fun (o: int option) -> match o with Some v -> v | None -> 0 @> match q with @@ -228,6 +234,30 @@ let tests = | Value(_, _) -> () | _ -> failwith "Expected Value" + testCase "Call on an instance whose value is null keeps a Some instance" <| fun () -> + // Guards against conflating "no instance" (static/operator call) with "instance value + // is null" — both used to serialize to the same node. + let q = <@ (Unchecked.defaultof>).HasValue @> + + let rec hasSomeInstancePropertyGet expr = + match expr with + | PropertyGet(Some _, _, []) -> true + | Let(_, _, body) -> hasSomeInstancePropertyGet body + | _ -> false + + if not (hasSomeInstancePropertyGet q) then + failwith "Expected a PropertyGet with a Some instance, even though its value is null" + + // Known limitation: only zero-arg getters are tagged "property", so an indexer still + // surfaces as a plain Call instead of PropertyGet(instance, propInfo, args) like real F# + // quotations. FABLE_COMPILER-only: real .NET already represents indexers as PropertyGet. + testCase "Indexer property access inside a quotation is a Call, not yet PropertyGet" <| fun () -> + let q = <@ fun (t: QuotationIndexerTest) -> t.[0] @> + + match q with + | Lambda(_, Call(Some _, _, args)) -> equal 1 (Seq.length args) + | _ -> failwith "Expected Lambda with a Call(Some instance, _, [index]) body" + testCase "JSON serialization produces Thoth Auto-compatible format" <| fun () -> let q = <@ 42 @> let json = Fable.Core.JS.JSON.stringify(q) diff --git a/tests/Python/TestQuotation.fs b/tests/Python/TestQuotation.fs index d1d3f38355..f0a5d41a22 100644 --- a/tests/Python/TestQuotation.fs +++ b/tests/Python/TestQuotation.fs @@ -169,6 +169,8 @@ let ``test Expr.GetFreeVars returns empty for closed expr`` () = equal 0 freeVars // --- Pattern matches lower to IfThenElse (DecisionTree/Test handling) --- +// Note: these only check the outer IfThenElse shape. The guard itself is a synthetic Call +// here (e.g. "get_IsNone", "op_TypeTest"), not the real UnionCaseTest/TypeTest node .NET uses. [] let ``test Option match deconstructs to IfThenElse`` () = @@ -266,3 +268,18 @@ let ``test Unit quotation still matches Value node`` () = match q with | Value(_, _) -> () | _ -> failwith "Expected Value" + +[] +let ``test Call on an instance whose value is null keeps a Some instance`` () = + // Guards against conflating "no instance" (static/operator call) with "instance value is + // null" — both used to serialize to the same node. .NET wraps this in a Let (struct copy). + let q = <@ (Unchecked.defaultof>).HasValue @> + + let rec hasSomeInstancePropertyGet expr = + match expr with + | PropertyGet(Some _, _, []) -> true + | Let(_, _, body) -> hasSomeInstancePropertyGet body + | _ -> false + + if not (hasSomeInstancePropertyGet q) then + failwith "Expected a PropertyGet with a Some instance, even though its value is null" From 0069bbd5bfdfc36ef6bed1a4f1ae2806b7884a6c Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Wed, 15 Jul 2026 16:03:36 +0200 Subject: [PATCH 5/6] chore: fix types --- src/fable-library-py/fable_library/quotation.py | 5 +++-- src/fable-library-ts/quotation.ts | 7 +++++-- tests/Js/Main/QuotationTests.fs | 2 +- 3 files changed, 9 insertions(+), 5 deletions(-) diff --git a/src/fable-library-py/fable_library/quotation.py b/src/fable-library-py/fable_library/quotation.py index 26f5feef31..304a81b444 100644 --- a/src/fable-library-py/fable_library/quotation.py +++ b/src/fable-library-py/fable_library/quotation.py @@ -320,11 +320,12 @@ def is_if_then_else(expr: Expr) -> tuple[Expr, Expr, Expr] | None: return None -def is_call(expr: Expr) -> tuple[Any, str, Array[Any]] | None: +def is_call(expr: Expr) -> tuple[Any, str, FSharpList[Any]] | None: if isinstance(expr, ExprCall): # "novalue" is the "no instance" sentinel, distinct from a genuine quoted null ("null"). instance = None if (isinstance(expr.instance, ExprValue) and expr.instance.type == "novalue") else expr.instance - return (instance, expr.method, expr.args) + # Must be a real FSharpList (not the raw Array), same reasoning as is_field_get below. + return (instance, expr.method, of_array(expr.args)) return None diff --git a/src/fable-library-ts/quotation.ts b/src/fable-library-ts/quotation.ts index 07bd7afcfd..bf934c8859 100644 --- a/src/fable-library-ts/quotation.ts +++ b/src/fable-library-ts/quotation.ts @@ -6,6 +6,8 @@ * (undefined = no match, value/tuple = match). */ +import { FSharpList, ofArray } from "./List.ts"; + // =================================================================== // Var: represents an F# quotation variable // =================================================================== @@ -328,11 +330,12 @@ export function isIfThenElse(expr: Expr): [Expr, Expr, Expr] | undefined { return undefined; } -export function isCall(expr: Expr): [Expr | null, string, Expr[]] | undefined { +export function isCall(expr: Expr): [Expr | null, string, FSharpList] | undefined { if (expr instanceof ExprCall) { // "novalue" is the "no instance" sentinel, distinct from a genuine quoted null ("null"). const instance = (expr.instance instanceof ExprValue && expr.instance.type === "novalue") ? null : expr.instance; - return [instance, expr.method, expr.args]; + // Must be a real FSharpList (not the raw array), same reasoning as isFieldGet below. + return [instance, expr.method, ofArray(expr.args)]; } return undefined; } diff --git a/tests/Js/Main/QuotationTests.fs b/tests/Js/Main/QuotationTests.fs index 892fc9a753..4149b9ba92 100644 --- a/tests/Js/Main/QuotationTests.fs +++ b/tests/Js/Main/QuotationTests.fs @@ -255,7 +255,7 @@ let tests = let q = <@ fun (t: QuotationIndexerTest) -> t.[0] @> match q with - | Lambda(_, Call(Some _, _, args)) -> equal 1 (Seq.length args) + | Lambda(_, Call(Some _, _, [ _ ])) -> () | _ -> failwith "Expected Lambda with a Call(Some instance, _, [index]) body" testCase "JSON serialization produces Thoth Auto-compatible format" <| fun () -> From d0b1546675a6d13e07cc85e0f1209bc1204fcfb2 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Wed, 15 Jul 2026 17:39:18 +0200 Subject: [PATCH 6/6] chore: fix types --- src/fable-library-py/fable_library/quotation.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fable-library-py/fable_library/quotation.py b/src/fable-library-py/fable_library/quotation.py index 304a81b444..1063607ad5 100644 --- a/src/fable-library-py/fable_library/quotation.py +++ b/src/fable-library-py/fable_library/quotation.py @@ -372,7 +372,7 @@ def is_field_get(expr: Expr) -> tuple[Any, str, FSharpList[Any]] | None: # genuine quoted null ("null"). if isinstance(expr, ExprFieldGet): instance = None if (isinstance(expr.expr, ExprValue) and expr.expr.type == "novalue") else expr.expr - return (instance, expr.field_name, of_array([])) + return (instance, expr.field_name, of_array(Array([]))) return None