From 24b4ead7cd56fe54889b4743305d43b197ff5523 Mon Sep 17 00:00:00 2001 From: Tuomas Hietanen Date: Tue, 14 Jul 2026 21:35:08 +0100 Subject: [PATCH 1/2] feat(dart): quotations --- src/Fable.Transforms/Dart/Fable2Dart.fs | 40 +- src/Fable.Transforms/Dart/Replacements.fs | 3 +- .../Fable.Library.Dart.fsproj | 1 + src/fable-library-dart/quotation.dart | 649 ++++++++++++++++++ tests/Dart/main.dart | 2 + tests/Dart/src/Fable.Tests.Dart.fsproj | 1 + tests/Dart/src/QuotationTests.fs | 187 +++++ 7 files changed, 878 insertions(+), 5 deletions(-) create mode 100644 src/fable-library-dart/quotation.dart create mode 100644 tests/Dart/src/QuotationTests.fs diff --git a/src/Fable.Transforms/Dart/Fable2Dart.fs b/src/Fable.Transforms/Dart/Fable2Dart.fs index 788a68ad0b..15943a8a5d 100644 --- a/src/Fable.Transforms/Dart/Fable2Dart.fs +++ b/src/Fable.Transforms/Dart/Fable2Dart.fs @@ -220,6 +220,20 @@ module Util = match entRef.FullName, genArgs with | Types.enum_, _ -> Integer + // F# Quotation types are modelled dynamically by the quotation runtime, + // so map them to `dynamic` (the runtime returns plain tagged objects). + | Types.fsharpExpr, _ + | Types.fsharpExprGeneric, _ + // The NewUnionCase active pattern's first slot is typed as UnionCaseInfo in + // F#, but Dart's quotation runtime exposes it as a plain (type-name) string, + // so map the type to `dynamic` to keep the generated annotations valid. + | "Microsoft.FSharp.Reflection.UnionCaseInfo", _ + // Likewise the Call/PropertyGet active patterns type their member slot as + // MethodInfo/PropertyInfo, but the quotation runtime exposes those as plain + // (member-name) strings, so map them to `dynamic` too. + | "System.Reflection.MethodInfo", _ + | "System.Reflection.PropertyInfo", _ + | Types.fsharpVar, _ -> Dynamic // List without generics is same as List | Types.array, _ -> List Dynamic | "System.Tuple`1", _ -> transformTupleType com ctx genArgs @@ -1570,13 +1584,30 @@ module Util = ] let transformSwitch (com: IDartCompiler) ctx returnStrategy evalExpr cases defaultCase = + // An empty (unit) branch can only be removed if falling through to the default + // does nothing, otherwise a matching case would wrongly run the default body + // (e.g. `match ... with A -> () | _ -> failwith "..."`). Note that when no + // explicit default is given the last case is promoted to default below, so + // that promoted case is what an removed branch would fall through to. + let effectiveDefault = + match defaultCase with + | Some expr -> Some expr + | None -> cases |> List.tryLast |> Option.map snd + + let canRemoveEmptyBranches = + match effectiveDefault with + | None + | Some(Fable.Value(Fable.UnitConstant, _)) -> true + | Some _ -> false + let cases = cases |> List.choose (fun (guards, expr) -> // Remove empty branches match returnStrategy, expr, guards with - | (Return(isVoid = true) | Ignore), Fable.Value(Fable.UnitConstant, _), _ | _, _, [] -> None + | (Return(isVoid = true) | Ignore), Fable.Value(Fable.UnitConstant, _), _ when canRemoveEmptyBranches -> + None | _, _, guards -> // Switch is only activated when guards are literals so we can ignore the statements let guards = guards |> List.map (transformAndCaptureExpr com ctx >> snd) @@ -2192,9 +2223,10 @@ module Util = ], None - | Fable.Quote _ -> - addError com [] None "Quotations are not yet supported for Dart target" - [], None + | Fable.Quote(body, _isTyped, _r) -> + // Lower the quoted body to runtime calls that build the quotation AST, + // then transform like any other expression (mirrors PHP/Python/JS). + transform com ctx returnStrategy (QuotationEmitter.emitQuotedExpr com body) let getLocalFunctionGenericParams (_com: IDartCompiler) diff --git a/src/Fable.Transforms/Dart/Replacements.fs b/src/Fable.Transforms/Dart/Replacements.fs index aed42ea52d..3b25868286 100644 --- a/src/Fable.Transforms/Dart/Replacements.fs +++ b/src/Fable.Transforms/Dart/Replacements.fs @@ -4110,7 +4110,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 (Expr static methods, Var members, Patterns active patterns, EvaluateQuotation) + | 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-dart/Fable.Library.Dart.fsproj b/src/fable-library-dart/Fable.Library.Dart.fsproj index 9209274957..962c063607 100644 --- a/src/fable-library-dart/Fable.Library.Dart.fsproj +++ b/src/fable-library-dart/Fable.Library.Dart.fsproj @@ -28,6 +28,7 @@ + diff --git a/src/fable-library-dart/quotation.dart b/src/fable-library-dart/quotation.dart new file mode 100644 index 0000000000..85f250e76c --- /dev/null +++ b/src/fable-library-dart/quotation.dart @@ -0,0 +1,649 @@ +// F# Quotation runtime support for the Fable Dart target. +// +// Mirrors fable-library-py/quotation.py and fable-library-ts/quotation.ts: +// the QuotationEmitter lowers a quoted body into calls to the mk* constructors +// below (the LibCall "quotation" module maps to this quotation.dart file). +// Dart is dynamically typed, so nodes are tagged classes and options follow +// Fable's convention (null = None, value/tuple = Some). +import 'List.dart' as list; +import 'Types.dart' as types; + +// =================================================================== +// Var: represents an F# quotation variable +// =================================================================== + +class Var { + final String name; + final String type; + final bool isMutable; + const Var(this.name, this.type, this.isMutable); +} + +Var mkQuotVar(String name, String type, [bool isMutable = false]) => + Var(name, type, isMutable); + +String varGetName(Var v) => v.name; +String varGetType(Var v) => v.type; +bool varGetIsMutable(Var v) => v.isMutable; + +// =================================================================== +// Expr nodes: tagged classes for each quotation expression kind +// =================================================================== + +abstract class Expr { + final String tag; + const Expr(this.tag); +} + +class ExprValue extends Expr { + final dynamic value; + final String type; + const ExprValue(this.value, this.type) : super('Value'); +} + +class ExprVarExpr extends Expr { + final Var variable; + const ExprVarExpr(this.variable) : super('Var'); +} + +class ExprLambda extends Expr { + final Var variable; + final Expr body; + const ExprLambda(this.variable, this.body) : super('Lambda'); +} + +class ExprApplication extends Expr { + final Expr func; + final Expr arg; + const ExprApplication(this.func, this.arg) : super('Application'); +} + +class ExprLet extends Expr { + final Var variable; + final Expr value; + final Expr body; + const ExprLet(this.variable, this.value, this.body) : super('Let'); +} + +class ExprIfThenElse extends Expr { + final Expr guard; + final Expr thenExpr; + final Expr elseExpr; + const ExprIfThenElse(this.guard, this.thenExpr, this.elseExpr) + : super('IfThenElse'); +} + +class ExprCall extends Expr { + final Expr? instance; + final String method; + final List args; + final String declaringType; + const ExprCall(this.instance, this.method, this.args, + [this.declaringType = '']) + : super('Call'); +} + +class ExprSequential extends Expr { + final Expr first; + final Expr second; + const ExprSequential(this.first, this.second) : super('Sequential'); +} + +class ExprNewTuple extends Expr { + final List elements; + const ExprNewTuple(this.elements) : super('NewTuple'); +} + +class ExprNewUnion extends Expr { + final String typeName; + final int unionTag; + final List fields; + const ExprNewUnion(this.typeName, this.unionTag, this.fields) + : super('NewUnion'); +} + +class ExprNewRecord extends Expr { + final List fieldNames; + final List values; + const ExprNewRecord(this.fieldNames, this.values) : super('NewRecord'); +} + +class ExprNewList extends Expr { + final Expr head; + final Expr tail; + const ExprNewList(this.head, this.tail) : super('NewList'); +} + +class ExprTupleGet extends Expr { + final Expr expr; + final int index; + const ExprTupleGet(this.expr, this.index) : super('TupleGet'); +} + +class ExprUnionTag extends Expr { + final Expr expr; + const ExprUnionTag(this.expr) : super('UnionTag'); +} + +class ExprUnionField extends Expr { + final Expr expr; + final int fieldIndex; + const ExprUnionField(this.expr, this.fieldIndex) : super('UnionField'); +} + +class ExprFieldGet extends Expr { + final Expr expr; + final String fieldName; + const ExprFieldGet(this.expr, this.fieldName) : super('FieldGet'); +} + +class ExprFieldSet extends Expr { + final Expr expr; + final String fieldName; + final Expr value; + const ExprFieldSet(this.expr, this.fieldName, this.value) : super('FieldSet'); +} + +class ExprVarSet extends Expr { + final Expr target; + final Expr value; + const ExprVarSet(this.target, this.value) : super('VarSet'); +} + +// =================================================================== +// Constructors (called by QuotationEmitter.fs) +// =================================================================== + +ExprValue mkValue(dynamic value, String type) => ExprValue(value, type); + +// A null-value node (no instance / null literal / empty option or list). +ExprValue mkNull(String type) => ExprValue(null, type); + +ExprVarExpr mkVar(Var v) => ExprVarExpr(v); +ExprLambda mkLambda(Var v, Expr body) => ExprLambda(v, body); +ExprApplication mkApplication(Expr func, Expr arg) => ExprApplication(func, arg); +ExprLet mkLet(Var v, Expr value, Expr body) => ExprLet(v, value, body); + +ExprIfThenElse mkIfThenElse(Expr guard, Expr thenExpr, Expr elseExpr) => + ExprIfThenElse(guard, thenExpr, elseExpr); + +ExprCall mkCall(Expr? instance, String method, List args, + [String declaringType = '']) => + ExprCall(instance, method, args, declaringType); + +ExprSequential mkSequential(Expr first, Expr second) => + ExprSequential(first, second); + +ExprNewTuple mkNewTuple(List elements) => ExprNewTuple(elements); + +ExprNewUnion mkNewUnion(String typeName, int tag, List fields) => + ExprNewUnion(typeName, tag, fields); + +ExprNewRecord mkNewRecord(List fieldNames, List values) => + ExprNewRecord(fieldNames, values); + +ExprNewList mkNewList(Expr head, Expr tail) => ExprNewList(head, tail); +ExprTupleGet mkTupleGet(Expr expr, int index) => ExprTupleGet(expr, index); +ExprUnionTag mkUnionTag(Expr expr) => ExprUnionTag(expr); + +ExprUnionField mkUnionField(Expr expr, int fieldIndex) => + ExprUnionField(expr, fieldIndex); + +ExprFieldGet mkFieldGet(Expr expr, String fieldName) => + ExprFieldGet(expr, fieldName); + +ExprFieldSet mkFieldSet(Expr expr, String fieldName, Expr value) => + ExprFieldSet(expr, fieldName, value); + +ExprVarSet mkVarSet(Expr target, Expr value) => ExprVarSet(target, value); + +// Correctly-typed empty argument array (used by the emitter for empty arg lists). +List emptyExprArray() => []; + +// =================================================================== +// Accessor +// =================================================================== + +String getType(Expr expr) { + if (expr is ExprValue) return expr.type; + if (expr is ExprLambda) return expr.variable.type; + return 'obj'; +} + +// =================================================================== +// Pattern match helpers +// Returns null (no match) or a Some-wrapped value/tuple (match). +// +// Fable's Dart backend wraps `'a option` as a reified `Some<'a>?` (None = null) +// and unwraps it with `Types.value`. The F# quotation types (FSharpExpr / +// FSharpVar) are mapped to `dynamic` by the Dart backend, so the wrappers here +// are built with `dynamic` type arguments to match the generated annotations +// (e.g. `Some>?`). `Value` keeps `Type` for its second +// element because F#'s `(|Value|_|)` returns `(obj * System.Type)`. +// =================================================================== + +types.Some>? isValue(Expr expr) => expr is ExprValue + ? types.Some>( + types.Tuple2(expr.value, expr.value.runtimeType)) + : null; + +types.Some? isVar(Expr expr) => + expr is ExprVarExpr ? types.Some(expr.variable) : null; + +types.Some>? isLambda(Expr expr) => + expr is ExprLambda + ? types.Some>( + types.Tuple2(expr.variable, expr.body)) + : null; + +types.Some>? isApplication(Expr expr) => + expr is ExprApplication + ? types.Some>( + types.Tuple2(expr.func, expr.arg)) + : null; + +types.Some>? isLet(Expr expr) => + expr is ExprLet + ? types.Some>( + types.Tuple3( + expr.variable, expr.value, expr.body)) + : null; + +types.Some>? isIfThenElse(Expr expr) => + expr is ExprIfThenElse + ? types.Some>( + types.Tuple3( + expr.guard, expr.thenExpr, expr.elseExpr)) + : null; + +types.Some>? isCall(Expr expr) { + if (expr is ExprCall) { + // A static/operator call carries the "novalue" no-instance sentinel node as + // its instance (see QuotationEmitter). "novalue" is distinct from a genuine + // quoted null value ("null"). Expose it as null so Patterns.Call matches F#. + final inst = expr.instance; + final normalized = + (inst is ExprValue && inst.type == 'novalue') ? null : inst; + return types.Some>( + types.Tuple3( + normalized, expr.method, list.ofArray(expr.args))); + } + return null; +} + +String callDeclaringType(Expr expr) => + expr is ExprCall ? expr.declaringType : ''; + +types.Some>? isSequential(Expr expr) => + expr is ExprSequential + ? types.Some>( + types.Tuple2(expr.first, expr.second)) + : null; + +types.Some>? isNewTuple(Expr expr) => + expr is ExprNewTuple + ? types.Some>( + list.ofArray(expr.elements)) + : null; + +types.Some>>? isNewUnionCase( + Expr expr) => + expr is ExprNewUnion + ? types.Some>>( + types.Tuple2>( + expr.typeName, list.ofArray(expr.fields))) + : null; + +types.Some>? isNewRecord(Expr expr) => + expr is ExprNewRecord + ? types.Some>( + types.Tuple2(list.ofArray(expr.fieldNames), + list.ofArray(expr.values))) + : null; + +types.Some>? isTupleGet(Expr expr) => + expr is ExprTupleGet + ? types.Some>( + types.Tuple2(expr.expr, expr.index)) + : null; + +// Patterns.PropertyGet is `PropertyGet of Expr option * PropertyInfo * Expr list`, +// so the three slots must line up with Fable's Dart encoding of those F# types: +// `Expr option` -> `Some?` (null = None), `PropertyInfo` -> dynamic (the +// runtime exposes it as a plain field-name string) and `Expr list` -> FSharpList. +// Dart generics are invariant, so this return type has to be spelled out exactly. +types.Some< + types.Tuple3?, dynamic, list.FSharpList>>? + isFieldGet(Expr expr) { + if (expr is ExprFieldGet) { + // A static property/field get carries the "novalue" no-instance sentinel + // node as its target (see QuotationEmitter). "novalue" is distinct from a + // genuine quoted null value ("null"). Expose it as None so + // Patterns.PropertyGet/FieldGet match F#. + final target = expr.expr; + final normalized = (target is ExprValue && target.type == 'novalue') + ? null + : types.Some(target); + return types.Some< + types.Tuple3?, dynamic, + list.FSharpList>>( + types.Tuple3?, dynamic, list.FSharpList>( + normalized, expr.fieldName, list.empty())); + } + return null; +} + +// =================================================================== +// Evaluation +// =================================================================== + +final Map _operators = { + 'op_Addition': (a, b) => a + b, + 'op_Subtraction': (a, b) => a - b, + 'op_Multiply': (a, b) => a * b, + 'op_Division': (a, b) => a is int && b is int ? a ~/ b : a / b, + 'op_Modulus': (a, b) => a % b, + 'op_Exponentiation': (a, b) => _pow(a, b), + 'op_UnaryNegation': (a) => -a, + 'op_UnaryPlus': (a) => a, + 'op_LogicalNot': (a) => !(a as bool), + 'op_BitwiseOr': (a, b) => a | b, + 'op_BitwiseAnd': (a, b) => a & b, + 'op_ExclusiveOr': (a, b) => a ^ b, + 'op_LeftShift': (a, b) => a << b, + 'op_RightShift': (a, b) => a >> b, + 'op_Equality': (a, b) => a == b, + 'op_Inequality': (a, b) => a != b, + 'op_LessThan': (a, b) => a < b, + 'op_LessThanOrEqual': (a, b) => a <= b, + 'op_GreaterThan': (a, b) => a > b, + 'op_GreaterThanOrEqual': (a, b) => a >= b, + 'op_BooleanAnd': (a, b) => (a as bool) && (b as bool), + 'op_BooleanOr': (a, b) => (a as bool) || (b as bool), +}; + +num _pow(num a, num b) { + num result = 1; + for (var i = 0; i < b; i++) { + result *= a; + } + return result; +} + +dynamic _evaluate(Expr expr, Map env) { + if (expr is ExprValue) return expr.value; + + if (expr is ExprVarExpr) { + if (env.containsKey(expr.variable.name)) return env[expr.variable.name]; + throw Exception('Unbound variable: ${expr.variable.name}'); + } + + if (expr is ExprLambda) { + final capturedEnv = Map.from(env); + return (dynamic arg) { + final newEnv = Map.from(capturedEnv); + newEnv[expr.variable.name] = arg; + return _evaluate(expr.body, newEnv); + }; + } + + if (expr is ExprApplication) { + final f = _evaluate(expr.func, env); + return f(_evaluate(expr.arg, env)); + } + + if (expr is ExprLet) { + final newEnv = Map.from(env); + newEnv[expr.variable.name] = _evaluate(expr.value, env); + return _evaluate(expr.body, newEnv); + } + + if (expr is ExprIfThenElse) { + return _evaluate(expr.guard, env) as bool + ? _evaluate(expr.thenExpr, env) + : _evaluate(expr.elseExpr, env); + } + + if (expr is ExprSequential) { + _evaluate(expr.first, env); + return _evaluate(expr.second, env); + } + + if (expr is ExprNewTuple) { + // Return the evaluated elements as a plain list. Dart reifies generics, so a + // typed tuple (Tuple2) can't be built from dynamic values; callers + // treat an evaluated tuple as an obj[] (mirrors the TS/JS runtime). + return expr.elements.map((e) => _evaluate(e, env)).toList(); + } + + if (expr is ExprCall) { + final evaluatedArgs = expr.args.map((a) => _evaluate(a, env)).toList(); + final op = _operators[expr.method]; + if (op != null) return Function.apply(op, evaluatedArgs); + throw Exception('Unknown method: ${expr.method}'); + } + + if (expr is ExprTupleGet) { + final t = _evaluate(expr.expr, env); + return t[expr.index]; + } + + if (expr is ExprNewUnion) { + return [expr.unionTag, ...expr.fields.map((f) => _evaluate(f, env))]; + } + + if (expr is ExprNewRecord) { + final result = {}; + for (var i = 0; i < expr.fieldNames.length; i++) { + result[expr.fieldNames[i] as String] = _evaluate(expr.values[i], env); + } + return result; + } + + if (expr is ExprNewList) { + return [_evaluate(expr.head, env), ..._evaluate(expr.tail, env)]; + } + + if (expr is ExprVarSet) { + final target = expr.target; + if (target is ExprVarExpr) { + env[target.variable.name] = _evaluate(expr.value, env); + return null; + } + throw Exception('VarSet target must be a variable'); + } + + if (expr is ExprFieldGet) { + final obj = _evaluate(expr.expr, env); + if (obj is Map) return obj[expr.fieldName]; + throw Exception('Cannot get field ${expr.fieldName}'); + } + + throw Exception('Cannot evaluate expression: ${expr.tag}'); +} + +dynamic evaluate(Expr expr) => _evaluate(expr, {}); + +// =================================================================== +// FSharpExpr instance methods +// =================================================================== + +const Map _opSymbols = { + 'op_Addition': '+', + 'op_Subtraction': '-', + 'op_Multiply': '*', + 'op_Division': '/', + 'op_Modulus': '%', + 'op_Exponentiation': '**', + 'op_Equality': '=', + 'op_Inequality': '<>', + 'op_LessThan': '<', + 'op_LessThanOrEqual': '<=', + 'op_GreaterThan': '>', + 'op_GreaterThanOrEqual': '>=', + 'op_BooleanAnd': '&&', + 'op_BooleanOr': '||', + 'op_UnaryNegation': '-', + 'op_LogicalNot': 'not', +}; + +String exprToString(Expr expr) { + if (expr is ExprValue) { + if (expr.type == 'string') return '"${expr.value}"'; + if (expr.type == 'unit') return '()'; + if (expr.type == 'bool') return expr.value == true ? 'true' : 'false'; + return '${expr.value}'; + } + if (expr is ExprVarExpr) return expr.variable.name; + if (expr is ExprLambda) { + return 'fun ${expr.variable.name} -> ${exprToString(expr.body)}'; + } + if (expr is ExprApplication) { + return '${exprToString(expr.func)} ${exprToString(expr.arg)}'; + } + if (expr is ExprLet) { + return 'let ${expr.variable.name} = ${exprToString(expr.value)} in ${exprToString(expr.body)}'; + } + if (expr is ExprIfThenElse) { + return 'if ${exprToString(expr.guard)} then ${exprToString(expr.thenExpr)} else ${exprToString(expr.elseExpr)}'; + } + if (expr is ExprCall) { + final sym = _opSymbols[expr.method]; + if (sym != null && expr.args.length == 2) { + return '(${exprToString(expr.args[0] as Expr)} $sym ${exprToString(expr.args[1] as Expr)})'; + } + if (sym != null && expr.args.length == 1) { + return '$sym${exprToString(expr.args[0] as Expr)}'; + } + final argStrs = + expr.args.map((a) => exprToString(a as Expr)).join(', '); + return '${expr.method}($argStrs)'; + } + if (expr is ExprSequential) { + return '${exprToString(expr.first)}; ${exprToString(expr.second)}'; + } + if (expr is ExprNewTuple) { + return '(${expr.elements.map((e) => exprToString(e as Expr)).join(', ')})'; + } + if (expr is ExprTupleGet) { + return 'Item${expr.index + 1}(${exprToString(expr.expr)})'; + } + if (expr is ExprFieldGet) { + return '${exprToString(expr.expr)}.${expr.fieldName}'; + } + return '<${expr.tag}>'; +} + +// Returns the free variables as a (Fable) array (seq) of Var. +List getFreeVars(Expr expr) { + final free = []; + final seen = {}; + + void walk(Expr e, Set bound) { + if (e is ExprVarExpr) { + if (!bound.contains(e.variable.name) && !seen.contains(e.variable.name)) { + free.add(e.variable); + seen.add(e.variable.name); + } + } else if (e is ExprLambda) { + walk(e.body, {...bound, e.variable.name}); + } else if (e is ExprLet) { + walk(e.value, bound); + walk(e.body, {...bound, e.variable.name}); + } else if (e is ExprApplication) { + walk(e.func, bound); + walk(e.arg, bound); + } else if (e is ExprIfThenElse) { + walk(e.guard, bound); + walk(e.thenExpr, bound); + walk(e.elseExpr, bound); + } else if (e is ExprCall) { + for (final a in e.args) { + walk(a as Expr, bound); + } + } else if (e is ExprSequential) { + walk(e.first, bound); + walk(e.second, bound); + } else if (e is ExprNewTuple) { + for (final el in e.elements) { + walk(el as Expr, bound); + } + } else if (e is ExprNewUnion) { + for (final f in e.fields) { + walk(f as Expr, bound); + } + } else if (e is ExprNewRecord) { + for (final v in e.values) { + walk(v as Expr, bound); + } + } else if (e is ExprNewList) { + walk(e.head, bound); + walk(e.tail, bound); + } else if (e is ExprTupleGet) { + walk(e.expr, bound); + } else if (e is ExprUnionTag) { + walk(e.expr, bound); + } else if (e is ExprUnionField) { + walk(e.expr, bound); + } else if (e is ExprFieldGet) { + walk(e.expr, bound); + } else if (e is ExprFieldSet) { + walk(e.expr, bound); + walk(e.value, bound); + } else if (e is ExprVarSet) { + walk(e.target, bound); + walk(e.value, bound); + } + } + + walk(expr, {}); + return free; +} + +// Substitute variables using fn: Var -> Expr option (null = keep). +Expr substitute(Expr expr, dynamic fn) { + Expr sub(Expr e) { + if (e is ExprVarExpr) { + // fn: Var -> Expr option; Fable wraps Some in a Some<...> (None = null). + final result = fn(e.variable); + if (result == null) return e; + if (result is types.Some) return result.value as Expr; + return result as Expr; + } + if (e is ExprLambda) return ExprLambda(e.variable, sub(e.body)); + if (e is ExprLet) return ExprLet(e.variable, sub(e.value), sub(e.body)); + if (e is ExprApplication) return ExprApplication(sub(e.func), sub(e.arg)); + if (e is ExprIfThenElse) { + return ExprIfThenElse(sub(e.guard), sub(e.thenExpr), sub(e.elseExpr)); + } + if (e is ExprCall) { + final newInst = e.instance != null ? sub(e.instance!) : e.instance; + return ExprCall(newInst, e.method, + e.args.map((a) => sub(a as Expr)).toList(), e.declaringType); + } + if (e is ExprSequential) return ExprSequential(sub(e.first), sub(e.second)); + if (e is ExprNewTuple) { + return ExprNewTuple(e.elements.map((a) => sub(a as Expr)).toList()); + } + if (e is ExprTupleGet) return ExprTupleGet(sub(e.expr), e.index); + if (e is ExprNewUnion) { + return ExprNewUnion( + e.typeName, e.unionTag, e.fields.map((a) => sub(a as Expr)).toList()); + } + if (e is ExprNewRecord) { + return ExprNewRecord( + e.fieldNames, e.values.map((a) => sub(a as Expr)).toList()); + } + if (e is ExprNewList) return ExprNewList(sub(e.head), sub(e.tail)); + if (e is ExprUnionTag) return ExprUnionTag(sub(e.expr)); + if (e is ExprUnionField) return ExprUnionField(sub(e.expr), e.fieldIndex); + if (e is ExprFieldGet) return ExprFieldGet(sub(e.expr), e.fieldName); + if (e is ExprFieldSet) { + return ExprFieldSet(sub(e.expr), e.fieldName, sub(e.value)); + } + if (e is ExprVarSet) return ExprVarSet(sub(e.target), sub(e.value)); + return e; + } + + return sub(expr); +} diff --git a/tests/Dart/main.dart b/tests/Dart/main.dart index 46faa232c2..a6b380a18a 100644 --- a/tests/Dart/main.dart +++ b/tests/Dart/main.dart @@ -14,6 +14,7 @@ import './src/MapTests.dart' as map; import './src/MiscTests.dart' as misc; // import './src/NullnessTests.dart' as nullness; import './src/OptionTests.dart' as option; +import './src/QuotationTests.dart' as quotation; import './src/RecordTests.dart' as record; import './src/RegexTests.dart' as regex; import './src/ResizeArrayTests.dart' as resize_array; @@ -46,6 +47,7 @@ void main() { misc.tests(); // nullness.tests(); option.tests(); + quotation.tests(); record.tests(); regex.tests(); resize_array.tests(); diff --git a/tests/Dart/src/Fable.Tests.Dart.fsproj b/tests/Dart/src/Fable.Tests.Dart.fsproj index 38de08823f..2fe141bc5a 100644 --- a/tests/Dart/src/Fable.Tests.Dart.fsproj +++ b/tests/Dart/src/Fable.Tests.Dart.fsproj @@ -24,6 +24,7 @@ + diff --git a/tests/Dart/src/QuotationTests.fs b/tests/Dart/src/QuotationTests.fs new file mode 100644 index 0000000000..97e5465c01 --- /dev/null +++ b/tests/Dart/src/QuotationTests.fs @@ -0,0 +1,187 @@ +module Fable.Tests.Dart.Quotation + +open Util +open Microsoft.FSharp.Quotations +open Microsoft.FSharp.Quotations.Patterns +open Microsoft.FSharp.Linq.RuntimeHelpers + +type C = + | A of int + | B + +type Cfg = + static member Version = 42 + +let tests() = + testCase "Simple integer value quotation" <| fun () -> + let q = <@ 42 @> + match q with + | Value(v, _t) -> equal 42 (v :?> int) + | _ -> failwith "Expected Value" + + testCase "Boolean value quotation" <| fun () -> + let q = <@ true @> + match q with + | Value(v, _t) -> equal true (v :?> bool) + | _ -> failwith "Expected Value" + + testCase "String value quotation" <| fun () -> + let q = <@ "hello" @> + match q with + | Value(v, _t) -> equal "hello" (v :?> string) + | _ -> failwith "Expected Value" + + testCase "Lambda quotation" <| fun () -> + let q = <@ fun x -> x + 1 @> + match q with + | Lambda(v, _body) -> equal "x" v.Name + | _ -> failwith "Expected Lambda" + + testCase "Let binding quotation" <| fun () -> + // NOTE: uses a unique binder name (`letv`) instead of the canonical `x`. + // All Dart tests share one `tests()` function, so reusing `x` across test + // bodies makes Fable rename later occurrences (e.g. `x` -> `x_1`), which the + // quotation faithfully reports. A unique name avoids the collision rename. + let q = <@ let letv = 5 in letv @> + match q with + | Let(v, Value(value, _), _) -> + equal "letv" v.Name + equal 5 (value :?> int) + | _ -> failwith "Expected Let" + + testCase "IfThenElse quotation" <| fun () -> + let q = <@ if true then 1 else 2 @> + match q with + | IfThenElse(_, _, _) -> () + | _ -> failwith "Expected IfThenElse" + + testCase "Application quotation" <| fun () -> + let q = <@ (fun x -> x) 42 @> + match q with + | Application(Lambda _, Value _) -> () + | _ -> failwith "Expected Application of Lambda" + + testCase "Evaluate simple value" <| fun () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ 42 @> + equal 42 (result :?> int) + + testCase "Evaluate boolean value" <| fun () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ true @> + equal true (result :?> bool) + + testCase "Evaluate string value" <| fun () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ "hello" @> + equal "hello" (result :?> string) + + testCase "Evaluate addition" <| fun () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ 1 + 2 @> + equal 3 (result :?> int) + + testCase "Evaluate let binding" <| fun () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ let x = 10 in x + 5 @> + equal 15 (result :?> int) + + testCase "Evaluate if then else true branch" <| fun () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ if true then 1 else 2 @> + equal 1 (result :?> int) + + testCase "Evaluate if then else false branch" <| fun () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ if false then 1 else 2 @> + equal 2 (result :?> int) + + testCase "Evaluate lambda application" <| fun () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ (fun x -> x + 1) 5 @> + equal 6 (result :?> int) + + testCase "NewTuple quotation" <| fun () -> + let q = <@ (1, 2, 3) @> + match q with + | NewTuple(exprs) -> equal 3 exprs.Length + | _ -> failwith "Expected NewTuple" + + testCase "Sequential quotation" <| fun () -> + let q = <@ (); 42 @> + match q with + | Sequential(_, Value(v, _)) -> equal 42 (v :?> int) + | _ -> failwith "Expected Sequential" + + testCase "Var quotation" <| fun () -> + let q = <@ fun x -> x @> + match q with + | Lambda(v, Var(v2)) -> + equal v.Name v2.Name + | _ -> failwith "Expected Lambda with Var body" + + testCase "Evaluate subtraction" <| fun () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ 10 - 3 @> + equal 7 (result :?> int) + + testCase "Evaluate multiplication" <| fun () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ 6 * 7 @> + equal 42 (result :?> int) + + testCase "Evaluate comparison" <| fun () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ 5 > 3 @> + equal true (result :?> bool) + + testCase "Evaluate nested let bindings" <| fun () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ let x = 3 in let y = 4 in x * y @> + equal 12 (result :?> int) + + testCase "Evaluate nested lambda" <| fun () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ (fun x -> (fun y -> x + y)) 3 4 @> + equal 7 (result :?> int) + + testCase "Evaluate tuple" <| fun () -> + // NOTE: the canonical suite casts the result to `(int * int)`, but Dart + // reifies generic type arguments, so `obj :?> (int * int)` fails for a + // tuple built from dynamic values. The runtime evaluates a tuple to an + // obj[] (mirroring the TS/JS runtime), so we inspect the elements. + let result = LeafExpressionConverter.EvaluateQuotation <@ (1, 2) @> + let arr = result :?> obj[] + equal 1 (arr.[0] :?> int) + equal 2 (arr.[1] :?> int) + + testCase "Expr.GetFreeVars returns empty for closed expr" <| fun () -> + let q = <@ fun x -> x + 1 @> + 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 "NewUnionCase quotation (single-field DU) exposes fields" <| fun () -> + let q = <@ A 7 @> + match q with + | NewUnionCase(_uci, args) -> equal 1 (List.length args) + | _ -> failwith "Expected NewUnionCase" + + testCase "NewUnionCase quotation (no-field DU) exposes empty fields" <| fun () -> + let q = <@ B @> + match q with + | NewUnionCase(_uci, args) -> equal 0 (List.length args) + | _ -> failwith "Expected NewUnionCase" + + // --- 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 "Static property access inside a quotation is a PropertyGet with no instance" <| fun () -> + let q = <@ Cfg.Version @> + match q with + | PropertyGet(None, _, []) -> () + | _ -> failwith "Expected PropertyGet with no instance" From 6f8a41bafe95a7621992a91544606e5c2f2ef6f5 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Fri, 17 Jul 2026 11:22:13 +0200 Subject: [PATCH 2/2] chore: fixes and more tests --- src/fable-library-dart/quotation.dart | 31 +++++++++++++++++--------- tests/Dart/src/QuotationTests.fs | 32 +++++++++++++++++++++++++++ 2 files changed, 52 insertions(+), 11 deletions(-) diff --git a/src/fable-library-dart/quotation.dart b/src/fable-library-dart/quotation.dart index 85f250e76c..9ad67ebd39 100644 --- a/src/fable-library-dart/quotation.dart +++ b/src/fable-library-dart/quotation.dart @@ -5,6 +5,8 @@ // below (the LibCall "quotation" module maps to this quotation.dart file). // Dart is dynamically typed, so nodes are tagged classes and options follow // Fable's convention (null = None, value/tuple = Some). +import 'dart:math' as math; + import 'List.dart' as list; import 'Types.dart' as types; @@ -294,11 +296,13 @@ types.Some>>? isNewUnionCase( expr.typeName, list.ofArray(expr.fields))) : null; -types.Some>? isNewRecord(Expr expr) => +// Patterns.NewRecord needs a real `System.Type` in slot 1 (Dart generics are invariant); +// no real type name reaches this target, so `runtimeType` is just a valid placeholder. +types.Some>>? isNewRecord(Expr expr) => expr is ExprNewRecord - ? types.Some>( - types.Tuple2(list.ofArray(expr.fieldNames), - list.ofArray(expr.values))) + ? types.Some>>( + types.Tuple2>( + expr.runtimeType, list.ofArray(expr.values))) : null; types.Some>? isTupleGet(Expr expr) => @@ -362,13 +366,9 @@ final Map _operators = { 'op_BooleanOr': (a, b) => (a as bool) || (b as bool), }; -num _pow(num a, num b) { - num result = 1; - for (var i = 0; i < b; i++) { - result *= a; - } - return result; -} +// F# `(**)` is float exponentiation, so delegate to dart:math instead of a counting +// loop (which broke on negative/fractional exponents). +num _pow(num a, num b) => math.pow(a, b); dynamic _evaluate(Expr expr, Map env) { if (expr is ExprValue) return expr.value; @@ -459,6 +459,15 @@ dynamic _evaluate(Expr expr, Map env) { throw Exception('Cannot get field ${expr.fieldName}'); } + if (expr is ExprFieldSet) { + final obj = _evaluate(expr.expr, env); + if (obj is Map) { + obj[expr.fieldName] = _evaluate(expr.value, env); + return null; + } + throw Exception('Cannot set field ${expr.fieldName}'); + } + throw Exception('Cannot evaluate expression: ${expr.tag}'); } diff --git a/tests/Dart/src/QuotationTests.fs b/tests/Dart/src/QuotationTests.fs index 97e5465c01..5553bd3bec 100644 --- a/tests/Dart/src/QuotationTests.fs +++ b/tests/Dart/src/QuotationTests.fs @@ -12,6 +12,8 @@ type C = type Cfg = static member Version = 42 +type MutableRec = { mutable Value: int } + let tests() = testCase "Simple integer value quotation" <| fun () -> let q = <@ 42 @> @@ -185,3 +187,33 @@ let tests() = match q with | PropertyGet(None, _, []) -> () | _ -> failwith "Expected PropertyGet with no instance" + + testCase "Evaluate exponentiation" <| fun () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ 2.0 ** 3.0 @> + equal 8.0 (result :?> float) + + testCase "Evaluate exponentiation with negative exponent" <| fun () -> + // Regression test: `_pow` used to loop `b` times, wrongly returning `1.0` here. + let result = LeafExpressionConverter.EvaluateQuotation <@ 2.0 ** -1.0 @> + equal 0.5 (result :?> float) + + testCase "Evaluate exponentiation with fractional exponent" <| fun () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ 4.0 ** 0.5 @> + equal 2.0 (result :?> float) + + testCase "NewRecord quotation exposes field values" <| fun () -> + let q = <@ { Value = 5 } : MutableRec @> + match q with + | NewRecord(_ty, values) -> equal 1 (List.length values) + | _ -> failwith "Expected NewRecord" + + testCase "Evaluate mutable variable set (VarSet)" <| fun () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ let mutable v = 1 in (v <- 2); v @> + equal 2 (result :?> int) + + testCase "Evaluate mutable record field set (FieldSet)" <| fun () -> + let result = + LeafExpressionConverter.EvaluateQuotation + <@ let r = { Value = 1 }: MutableRec in r.Value <- 5; r.Value @> + + equal 5 (result :?> int)