From e662d62d3c289bcc60d3d98b414ace0dfef19bc9 Mon Sep 17 00:00:00 2001 From: Onur Gumus Date: Mon, 6 Apr 2026 17:13:59 +0200 Subject: [PATCH 1/9] =?UTF-8?q?[JS/TS]=20Add=20F#=20quotation=20support=20?= =?UTF-8?q?=E2=80=94=20construction,=20pattern=20matching,=20and=20evaluat?= =?UTF-8?q?ion?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Builds on the shared quotation infrastructure from #4398 to enable quotation support for the JavaScript/TypeScript target. Replaces the "not yet supported" error stubs in Fable2Babel.fs with actual Quote handlers, adds the JS/TS runtime library (quotation.ts) matching the Python/Beam API, wires up Replacements.fs via the shared Quotations.tryQuotationCall, and adds comprehensive tests. --- src/Fable.Cli/CHANGELOG.md | 1 + src/Fable.Compiler/CHANGELOG.md | 1 + src/Fable.Transforms/Fable2Babel.fs | 10 +- src/Fable.Transforms/Replacements.fs | 5 +- .../Fable.Library.TypeScript.fsproj | 1 + src/fable-library-ts/quotation.ts | 534 ++++++++++++++++++ tests/Js/Main/Fable.Tests.fsproj | 1 + tests/Js/Main/Main.fs | 1 + tests/Js/Main/QuotationTests.fs | 137 +++++ 9 files changed, 686 insertions(+), 5 deletions(-) create mode 100644 src/fable-library-ts/quotation.ts create mode 100644 tests/Js/Main/QuotationTests.fs diff --git a/src/Fable.Cli/CHANGELOG.md b/src/Fable.Cli/CHANGELOG.md index 784242bbc2..93d8824f69 100644 --- a/src/Fable.Cli/CHANGELOG.md +++ b/src/Fable.Cli/CHANGELOG.md @@ -10,6 +10,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added * [Python/Beam] Add F# quotation support — construction, pattern matching, and evaluation via `LeafExpressionConverter.EvaluateQuotation` (by @dbrattli) +* [JS/TS] Add F# quotation support — construction, pattern matching, and evaluation (by @OnurGumus) * [All] Add support for `Guid.CreateVersion7()` and `Guid.CreateVersion7(DateTimeOffset)` (by @OnurGumus) * [All] Add missing `Array`, `List`, and `Seq` random choice/shuffle/sample members and tests (by @ncave) * [Dart/Rust] Add missing `System.Random` implementations and tests (by @ncave) diff --git a/src/Fable.Compiler/CHANGELOG.md b/src/Fable.Compiler/CHANGELOG.md index 6d2ace2072..08e6e394cc 100644 --- a/src/Fable.Compiler/CHANGELOG.md +++ b/src/Fable.Compiler/CHANGELOG.md @@ -10,6 +10,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added * [Python/Beam] Add F# quotation support — construction, pattern matching, and evaluation via `LeafExpressionConverter.EvaluateQuotation` (by @dbrattli) +* [JS/TS] Add F# quotation support — construction, pattern matching, and evaluation (by @OnurGumus) * [All] Add support for `Guid.CreateVersion7()` and `Guid.CreateVersion7(DateTimeOffset)` (by @OnurGumus) * [All] Add missing `Array`, `List`, and `Seq` random choice/shuffle/sample members and tests (by @ncave) * [Dart/Rust] Add missing `System.Random` implementations and tests (by @ncave) diff --git a/src/Fable.Transforms/Fable2Babel.fs b/src/Fable.Transforms/Fable2Babel.fs index 93ee7c5707..00cbbf0b31 100644 --- a/src/Fable.Transforms/Fable2Babel.fs +++ b/src/Fable.Transforms/Fable2Babel.fs @@ -3142,7 +3142,9 @@ but thanks to the optimisation done below we get | Fable.Throw _ | Fable.Debugger -> iife com ctx expr - | Fable.Quote _ -> addErrorAndReturnNull com None "Quotations are not yet supported for JS/TS target" + | Fable.Quote(quotedExpr, _isTyped, _r) -> + let emitted = QuotationEmitter.emitQuotedExpr com quotedExpr + transformAsExpr com ctx emitted let rec transformAsStatements (com: IBabelCompiler) ctx returnStrategy (expr: Fable.Expr) : Statement array = match expr with @@ -3311,9 +3313,9 @@ but thanks to the optimisation done below we get ) |] - | Fable.Quote _ -> - addError com [] None "Quotations are not yet supported for JS/TS target" - [||] + | Fable.Quote(quotedExpr, _isTyped, _r) -> + let emitted = QuotationEmitter.emitQuotedExpr com quotedExpr + [| transformAsExpr com ctx emitted |> resolveExpr Fable.Any returnStrategy |] let transformFunction com ctx name (args: Fable.Ident list) (body: Fable.Expr) : Parameter array * BlockStatement = let tailcallChance = diff --git a/src/Fable.Transforms/Replacements.fs b/src/Fable.Transforms/Replacements.fs index 0d82ed9084..f60d03be7a 100644 --- a/src/Fable.Transforms/Replacements.fs +++ b/src/Fable.Transforms/Replacements.fs @@ -1309,6 +1309,8 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o // Erased operators. // KeyValuePair is already compiled as a tuple | ("KeyValuePattern" | "Identity" | "Box" | "Unbox" | "ToEnum"), [ arg ] -> TypeCast(arg, t) |> Some + // Quotation splice: %expr inside a quotation. The arg is already a QuotExpr at runtime. + | ("SpliceExpression" | "SpliceUntypedExpression"), [ arg ] -> Some arg // Cast to unit to make sure nothing is returned when wrapped in a lambda, see #1360 | "Ignore", _ -> TypeCast(args.Head, Unit) |> Some // Number and String conversions @@ -4344,7 +4346,8 @@ let tryCall (com: ICompiler) (ctx: Context) r t (info: CallInfo) (thisArg: Expr getTypeName com ctx loc exprType |> StringConstant |> makeValue r |> Some | c -> Helper.LibCall(com, "Reflection", "name", t, [ c ], ?loc = r) |> Some | _ -> None - | _ -> None + // F# Quotations + | typeName -> Quotations.tryQuotationCall "quotation" com ctx r t info thisArg args typeName let tryBaseConstructor com ctx (ent: EntityRef) (argTypes: Lazy) genArgs args = match ent.FullName with diff --git a/src/fable-library-ts/Fable.Library.TypeScript.fsproj b/src/fable-library-ts/Fable.Library.TypeScript.fsproj index 60336d26d0..7423c19dce 100644 --- a/src/fable-library-ts/Fable.Library.TypeScript.fsproj +++ b/src/fable-library-ts/Fable.Library.TypeScript.fsproj @@ -65,6 +65,7 @@ + diff --git a/src/fable-library-ts/quotation.ts b/src/fable-library-ts/quotation.ts new file mode 100644 index 0000000000..12c8f72f36 --- /dev/null +++ b/src/fable-library-ts/quotation.ts @@ -0,0 +1,534 @@ +/** + * F# Quotation runtime support for Fable JS/TS target. + * + * Provides class-based representations of F# quotation AST nodes + * and pattern matching helpers compatible with Fable's option convention + * (undefined = no match, value/tuple = match). + */ + +// =================================================================== +// Var: represents an F# quotation variable +// =================================================================== + +export class Var { + readonly Name: string; + readonly Type: string; + readonly IsMutable: boolean; + + constructor(name: string, type_: string, isMutable: boolean) { + this.Name = name; + this.Type = type_; + this.IsMutable = isMutable; + } +} + +export function mkQuotVar(name: string, type_: string, isMutable: boolean = false): Var { + return new Var(name, type_, isMutable); +} + +export function varGetName(v: Var): string { return v.Name; } +export function varGetType(v: Var): string { return v.Type; } +export function varGetIsMutable(v: Var): boolean { return v.IsMutable; } + +// =================================================================== +// Expr nodes: tagged classes for each quotation expression kind +// =================================================================== + +export class ExprValue { + readonly tag = "Value"; + constructor(readonly value: any, readonly type: string) {} +} + +export class ExprVarExpr { + readonly tag = "Var"; + constructor(readonly var_: Var) {} +} + +export class ExprLambda { + readonly tag = "Lambda"; + constructor(readonly var_: Var, readonly body: Expr) {} +} + +export class ExprApplication { + readonly tag = "Application"; + constructor(readonly func: Expr, readonly arg: Expr) {} +} + +export class ExprLet { + readonly tag = "Let"; + constructor(readonly var_: Var, readonly value: Expr, readonly body: Expr) {} +} + +export class ExprIfThenElse { + readonly tag = "IfThenElse"; + constructor(readonly guard: Expr, readonly thenExpr: Expr, readonly elseExpr: Expr) {} +} + +export class ExprCall { + readonly tag = "Call"; + constructor(readonly instance: any, readonly method: string, readonly args: any[]) {} +} + +export class ExprSequential { + readonly tag = "Sequential"; + constructor(readonly first: Expr, readonly second: Expr) {} +} + +export class ExprNewTuple { + readonly tag = "NewTuple"; + constructor(readonly elements: any[]) {} +} + +export class ExprNewUnion { + readonly tag = "NewUnion"; + constructor(readonly typeName: string, readonly unionTag: number, readonly fields: any[]) {} +} + +export class ExprNewRecord { + readonly tag = "NewRecord"; + constructor(readonly fieldNames: any[], readonly values: any[]) {} +} + +export class ExprNewList { + readonly tag = "NewList"; + constructor(readonly head: Expr, readonly tail: Expr) {} +} + +export class ExprTupleGet { + readonly tag = "TupleGet"; + constructor(readonly expr: Expr, readonly index: number) {} +} + +export class ExprUnionTag { + readonly tag = "UnionTag"; + constructor(readonly expr: Expr) {} +} + +export class ExprUnionField { + readonly tag = "UnionField"; + constructor(readonly expr: Expr, readonly fieldIndex: number) {} +} + +export class ExprFieldGet { + readonly tag = "FieldGet"; + constructor(readonly expr: Expr, readonly fieldName: string) {} +} + +export class ExprFieldSet { + readonly tag = "FieldSet"; + constructor(readonly expr: Expr, readonly fieldName: string, readonly value: Expr) {} +} + +export class ExprVarSet { + readonly tag = "VarSet"; + constructor(readonly target: Expr, readonly value: Expr) {} +} + +export type Expr = + | ExprValue + | ExprVarExpr + | ExprLambda + | ExprApplication + | ExprLet + | ExprIfThenElse + | ExprCall + | ExprSequential + | ExprNewTuple + | ExprNewUnion + | ExprNewRecord + | ExprNewList + | ExprTupleGet + | ExprUnionTag + | ExprUnionField + | ExprFieldGet + | ExprFieldSet + | ExprVarSet; + +// =================================================================== +// Constructors (called by QuotationEmitter.fs) +// =================================================================== + +export function mkValue(value: any, type: string): ExprValue { + return new ExprValue(value, type); +} + +export function mkVar(v: Var): ExprVarExpr { + return new ExprVarExpr(v); +} + +export function mkLambda(v: Var, body: Expr): ExprLambda { + return new ExprLambda(v, body); +} + +export function mkApplication(func: Expr, arg: Expr): ExprApplication { + return new ExprApplication(func, arg); +} + +export function mkLet(v: Var, value: Expr, body: Expr): ExprLet { + return new ExprLet(v, value, body); +} + +export function mkIfThenElse(guard: Expr, thenExpr: Expr, elseExpr: Expr): ExprIfThenElse { + return new ExprIfThenElse(guard, thenExpr, elseExpr); +} + +export function mkCall(instance: any, method: string, args: any[]): ExprCall { + return new ExprCall(instance, method, args); +} + +export function mkSequential(first: Expr, second: Expr): ExprSequential { + return new ExprSequential(first, second); +} + +export function mkNewTuple(elements: any[]): ExprNewTuple { + return new ExprNewTuple(elements); +} + +export function mkTupleGet(expr: Expr, index: number): ExprTupleGet { + return new ExprTupleGet(expr, index); +} + +export function mkUnionTag(expr: Expr): ExprUnionTag { + return new ExprUnionTag(expr); +} + +export function mkUnionField(expr: Expr, fieldIndex: number): ExprUnionField { + return new ExprUnionField(expr, fieldIndex); +} + +export function mkFieldGet(expr: Expr, fieldName: string): ExprFieldGet { + return new ExprFieldGet(expr, fieldName); +} + +export function mkFieldSet(expr: Expr, fieldName: string, value: Expr): ExprFieldSet { + return new ExprFieldSet(expr, fieldName, value); +} + +export function mkVarSet(target: Expr, value: Expr): ExprVarSet { + return new ExprVarSet(target, value); +} + +export function mkNewUnion(typeName: string, tag: number, fields: any[]): ExprNewUnion { + return new ExprNewUnion(typeName, tag, fields); +} + +export function mkNewRecord(fieldNames: any[], values: any[]): ExprNewRecord { + return new ExprNewRecord(fieldNames, values); +} + +export function mkNewList(head: Expr, tail: Expr): ExprNewList { + return new ExprNewList(head, tail); +} + +// =================================================================== +// Accessors +// =================================================================== + +export function getType(expr: Expr): string { + if (expr instanceof ExprValue) return expr.type; + if (expr instanceof ExprLambda) return expr.var_.Type; + return "obj"; +} + +// =================================================================== +// Pattern match helpers +// Returns undefined (no match) or a value/tuple (match), following +// Fable's option convention for active patterns. +// =================================================================== + +export function isValue(expr: Expr): [any, string] | undefined { + if (expr instanceof ExprValue) return [expr.value, expr.type]; + return undefined; +} + +export function isVar(expr: Expr): Var | undefined { + if (expr instanceof ExprVarExpr) return expr.var_; + return undefined; +} + +export function isLambda(expr: Expr): [Var, Expr] | undefined { + if (expr instanceof ExprLambda) return [expr.var_, expr.body]; + return undefined; +} + +export function isApplication(expr: Expr): [Expr, Expr] | undefined { + if (expr instanceof ExprApplication) return [expr.func, expr.arg]; + return undefined; +} + +export function isLet(expr: Expr): [Var, Expr, Expr] | undefined { + if (expr instanceof ExprLet) return [expr.var_, expr.value, expr.body]; + return undefined; +} + +export function isIfThenElse(expr: Expr): [Expr, Expr, Expr] | undefined { + if (expr instanceof ExprIfThenElse) return [expr.guard, expr.thenExpr, expr.elseExpr]; + return undefined; +} + +export function isCall(expr: Expr): [any, string, any[]] | undefined { + if (expr instanceof ExprCall) return [expr.instance, expr.method, expr.args]; + return undefined; +} + +export function isSequential(expr: Expr): [Expr, Expr] | undefined { + if (expr instanceof ExprSequential) return [expr.first, expr.second]; + return undefined; +} + +export function isNewTuple(expr: Expr): any[] | undefined { + if (expr instanceof ExprNewTuple) return expr.elements; + return undefined; +} + +export function isNewUnionCase(expr: Expr): [string, any[]] | undefined { + if (expr instanceof ExprNewUnion) return [expr.typeName, expr.fields]; + return undefined; +} + +export function isNewRecord(expr: Expr): [any[], any[]] | undefined { + if (expr instanceof ExprNewRecord) return [expr.fieldNames, expr.values]; + return undefined; +} + +export function isTupleGet(expr: Expr): [Expr, number] | undefined { + if (expr instanceof ExprTupleGet) return [expr.expr, expr.index]; + return undefined; +} + +export function isFieldGet(expr: Expr): [Expr, string] | undefined { + if (expr instanceof ExprFieldGet) return [expr.expr, expr.fieldName]; + return undefined; +} + +// =================================================================== +// Evaluation +// =================================================================== + +const OPERATORS: Record any> = { + "op_Addition": (a: any, b: any) => a + b, + "op_Subtraction": (a: any, b: any) => a - b, + "op_Multiply": (a: any, b: any) => a * b, + "op_Division": (a: any, b: any) => (a / b) | 0, + "op_Modulus": (a: any, b: any) => a % b, + "op_Exponentiation": (a: any, b: any) => a ** b, + "op_UnaryNegation": (a: any) => -a, + "op_UnaryPlus": (a: any) => +a, + "op_LogicalNot": (a: any) => !a, + "op_BitwiseOr": (a: any, b: any) => a | b, + "op_BitwiseAnd": (a: any, b: any) => a & b, + "op_ExclusiveOr": (a: any, b: any) => a ^ b, + "op_LeftShift": (a: any, b: any) => a << b, + "op_RightShift": (a: any, b: any) => a >> b, + "op_Equality": (a: any, b: any) => a === b, + "op_Inequality": (a: any, b: any) => a !== b, + "op_LessThan": (a: any, b: any) => a < b, + "op_LessThanOrEqual": (a: any, b: any) => a <= b, + "op_GreaterThan": (a: any, b: any) => a > b, + "op_GreaterThanOrEqual": (a: any, b: any) => a >= b, + "op_BooleanAnd": (a: any, b: any) => a && b, + "op_BooleanOr": (a: any, b: any) => a || b, +}; + +export function evaluate(expr: Expr, env?: Map): any { + if (env == null) env = new Map(); + + if (expr instanceof ExprValue) return expr.value; + + if (expr instanceof ExprVarExpr) { + if (env.has(expr.var_.Name)) return env.get(expr.var_.Name); + throw new Error(`Unbound variable: ${expr.var_.Name}`); + } + + if (expr instanceof ExprLambda) { + const capturedEnv = new Map(env); + return (arg: any) => { + const newEnv = new Map(capturedEnv); + newEnv.set(expr.var_.Name, arg); + return evaluate(expr.body, newEnv); + }; + } + + if (expr instanceof ExprApplication) { + return evaluate(expr.func, env)(evaluate(expr.arg, env)); + } + + if (expr instanceof ExprLet) { + const newEnv = new Map(env); + newEnv.set(expr.var_.Name, evaluate(expr.value, env)); + return evaluate(expr.body, newEnv); + } + + if (expr instanceof ExprIfThenElse) { + return evaluate(expr.guard, env) ? evaluate(expr.thenExpr, env) : evaluate(expr.elseExpr, env); + } + + if (expr instanceof ExprSequential) { + evaluate(expr.first, env); + return evaluate(expr.second, env); + } + + if (expr instanceof ExprNewTuple) { + return expr.elements.map(e => evaluate(e, env)); + } + + if (expr instanceof ExprCall) { + const evaluatedArgs = expr.args.map((a: any) => evaluate(a, env)); + if (expr.method in OPERATORS) return OPERATORS[expr.method](...evaluatedArgs); + throw new Error(`Unknown method: ${expr.method}`); + } + + if (expr instanceof ExprTupleGet) { + return evaluate(expr.expr, env)[expr.index]; + } + + if (expr instanceof ExprNewUnion) { + return [expr.unionTag, ...expr.fields.map((f: any) => evaluate(f, env))]; + } + + if (expr instanceof ExprNewRecord) { + const result: Record = {}; + for (let i = 0; i < expr.fieldNames.length; i++) { + result[expr.fieldNames[i]] = evaluate(expr.values[i], env); + } + return result; + } + + if (expr instanceof ExprNewList) { + return [evaluate(expr.head, env), ...evaluate(expr.tail, env)]; + } + + if (expr instanceof ExprVarSet) { + if (expr.target instanceof ExprVarExpr) { + env.set(expr.target.var_.Name, evaluate(expr.value, env)); + return undefined; + } + throw new Error("VarSet target must be a variable"); + } + + if (expr instanceof ExprFieldGet) { + const obj = evaluate(expr.expr, env); + return obj[expr.fieldName]; + } + + throw new Error(`Cannot evaluate expression: ${(expr as any).tag}`); +} + +// =================================================================== +// FSharpExpr instance methods +// =================================================================== + +const OP_SYMBOLS: Record = { + "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", +}; + +export function exprToString(expr: Expr): string { + if (expr instanceof ExprValue) { + if (expr.type === "string") return `"${expr.value}"`; + if (expr.type === "unit") return "()"; + if (expr.type === "bool") return expr.value ? "true" : "false"; + return String(expr.value); + } + if (expr instanceof ExprVarExpr) return expr.var_.Name; + if (expr instanceof ExprLambda) return `fun ${expr.var_.Name} -> ${exprToString(expr.body)}`; + if (expr instanceof ExprApplication) return `${exprToString(expr.func)} ${exprToString(expr.arg)}`; + if (expr instanceof ExprLet) return `let ${expr.var_.Name} = ${exprToString(expr.value)} in ${exprToString(expr.body)}`; + if (expr instanceof ExprIfThenElse) return `if ${exprToString(expr.guard)} then ${exprToString(expr.thenExpr)} else ${exprToString(expr.elseExpr)}`; + if (expr instanceof ExprCall) { + if (expr.method in OP_SYMBOLS && expr.args.length === 2) { + return `(${exprToString(expr.args[0])} ${OP_SYMBOLS[expr.method]} ${exprToString(expr.args[1])})`; + } + if (expr.method in OP_SYMBOLS && expr.args.length === 1) { + return `${OP_SYMBOLS[expr.method]}${exprToString(expr.args[0])}`; + } + return `${expr.method}(${expr.args.map(exprToString).join(", ")})`; + } + if (expr instanceof ExprSequential) return `${exprToString(expr.first)}; ${exprToString(expr.second)}`; + if (expr instanceof ExprNewTuple) return `(${expr.elements.map(exprToString).join(", ")})`; + if (expr instanceof ExprTupleGet) return `Item${expr.index + 1}(${exprToString(expr.expr)})`; + if (expr instanceof ExprFieldGet) return `${exprToString(expr.expr)}.${expr.fieldName}`; + return `<${(expr as any).tag}>`; +} + +export function getFreeVars(expr: Expr): Var[] { + const free: Var[] = []; + const seen = new Set(); + + function walk(e: Expr, bound: Set): void { + if (e instanceof ExprVarExpr) { + if (!bound.has(e.var_.Name) && !seen.has(e.var_.Name)) { + free.push(e.var_); + seen.add(e.var_.Name); + } + } else if (e instanceof ExprLambda) { + walk(e.body, new Set([...bound, e.var_.Name])); + } else if (e instanceof ExprLet) { + walk(e.value, bound); + walk(e.body, new Set([...bound, e.var_.Name])); + } else if (e instanceof ExprApplication) { + walk(e.func, bound); + walk(e.arg, bound); + } else if (e instanceof ExprIfThenElse) { + walk(e.guard, bound); + walk(e.thenExpr, bound); + walk(e.elseExpr, bound); + } else if (e instanceof ExprCall) { + for (const a of e.args) walk(a, bound); + } else if (e instanceof ExprSequential) { + walk(e.first, bound); + walk(e.second, bound); + } else if (e instanceof ExprNewTuple) { + for (const el of e.elements) walk(el, bound); + } else if (e instanceof ExprTupleGet) { + walk(e.expr, bound); + } else if (e instanceof ExprFieldGet) { + walk(e.expr, bound); + } + } + + walk(expr, new Set()); + return free; +} + +export function substitute(expr: Expr, fn: (v: Var) => Expr | undefined): Expr { + function sub(e: Expr): Expr { + if (e instanceof ExprVarExpr) { + const result = fn(e.var_); + return result !== undefined ? result : e; + } + if (e instanceof ExprLambda) return new ExprLambda(e.var_, sub(e.body)); + if (e instanceof ExprLet) return new ExprLet(e.var_, sub(e.value), sub(e.body)); + if (e instanceof ExprApplication) return new ExprApplication(sub(e.func), sub(e.arg)); + if (e instanceof ExprIfThenElse) return new ExprIfThenElse(sub(e.guard), sub(e.thenExpr), sub(e.elseExpr)); + if (e instanceof ExprCall) { + const newInst = e.instance instanceof ExprVarExpr || e.instance instanceof ExprValue + || e.instance instanceof ExprLambda || e.instance instanceof ExprApplication + || e.instance instanceof ExprLet || e.instance instanceof ExprIfThenElse + || e.instance instanceof ExprCall || e.instance instanceof ExprSequential + || e.instance instanceof ExprNewTuple + ? sub(e.instance) : e.instance; + return new ExprCall(newInst, e.method, e.args.map(sub)); + } + if (e instanceof ExprSequential) return new ExprSequential(sub(e.first), sub(e.second)); + if (e instanceof ExprNewTuple) return new ExprNewTuple(e.elements.map(sub)); + if (e instanceof ExprTupleGet) return new ExprTupleGet(sub(e.expr), e.index); + if (e instanceof ExprFieldGet) return new ExprFieldGet(sub(e.expr), e.fieldName); + return e; + } + return sub(expr); +} diff --git a/tests/Js/Main/Fable.Tests.fsproj b/tests/Js/Main/Fable.Tests.fsproj index 8c84e1b755..cb6243bb12 100644 --- a/tests/Js/Main/Fable.Tests.fsproj +++ b/tests/Js/Main/Fable.Tests.fsproj @@ -87,6 +87,7 @@ + diff --git a/tests/Js/Main/Main.fs b/tests/Js/Main/Main.fs index 77683c39ff..00888eafe1 100644 --- a/tests/Js/Main/Main.fs +++ b/tests/Js/Main/Main.fs @@ -55,6 +55,7 @@ let allTests = UnionTypes.tests Uri.tests ListCollector.tests + Quotation.tests |] #if FABLE_COMPILER diff --git a/tests/Js/Main/QuotationTests.fs b/tests/Js/Main/QuotationTests.fs new file mode 100644 index 0000000000..7efcdd1ae2 --- /dev/null +++ b/tests/Js/Main/QuotationTests.fs @@ -0,0 +1,137 @@ +module Fable.Tests.Quotation + +open Microsoft.FSharp.Quotations +open Microsoft.FSharp.Quotations.Patterns +open Util.Testing + +#if FABLE_COMPILER +open Microsoft.FSharp.Linq.RuntimeHelpers +#endif + +let tests = + testList "Quotations" [ +#if FABLE_COMPILER + 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 () -> + let q = <@ let x = 5 in x @> + match q with + | Let(v, Value(value, _), _) -> + equal "x" 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 "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 "Untyped quotation works" <| fun () -> + let q = <@@ 42 @@> + match q with + | Value(v, _t) -> equal 42 (v :?> int) + | _ -> failwith "Expected Value" + + testCase "Evaluate simple value" <| fun () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ 42 @> + equal 42 (result :?> int) + + 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 "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 () -> + let result = LeafExpressionConverter.EvaluateQuotation <@ (1, 2) @> + let t = result :?> (int * int) + equal (1, 2) t + + testCase "Expr.GetFreeVars returns empty for closed expr" <| fun () -> + let q = <@ fun x -> x + 1 @> + let freeVars = q.GetFreeVars() |> Seq.length + equal 0 freeVars +#endif + ] From fef716213ce099171ba33f393aa09e80a8fe39e2 Mon Sep 17 00:00:00 2001 From: Onur Gumus Date: Mon, 6 Apr 2026 17:23:37 +0200 Subject: [PATCH 2/9] Fix TS erasableSyntaxOnly errors in quotation.ts Replace constructor parameter properties (readonly params) with explicit field declarations to comply with erasableSyntaxOnly. --- src/fable-library-ts/quotation.ts | 74 +++++++++++++++++++++++-------- 1 file changed, 56 insertions(+), 18 deletions(-) diff --git a/src/fable-library-ts/quotation.ts b/src/fable-library-ts/quotation.ts index 12c8f72f36..e8bf72c728 100644 --- a/src/fable-library-ts/quotation.ts +++ b/src/fable-library-ts/quotation.ts @@ -36,92 +36,130 @@ export function varGetIsMutable(v: Var): boolean { return v.IsMutable; } export class ExprValue { readonly tag = "Value"; - constructor(readonly value: any, readonly type: string) {} + value: any; + type: string; + constructor(value: any, type: string) { this.value = value; this.type = type; } } export class ExprVarExpr { readonly tag = "Var"; - constructor(readonly var_: Var) {} + var_: Var; + constructor(var_: Var) { this.var_ = var_; } } export class ExprLambda { readonly tag = "Lambda"; - constructor(readonly var_: Var, readonly body: Expr) {} + var_: Var; + body: Expr; + constructor(var_: Var, body: Expr) { this.var_ = var_; this.body = body; } } export class ExprApplication { readonly tag = "Application"; - constructor(readonly func: Expr, readonly arg: Expr) {} + func: Expr; + arg: Expr; + constructor(func: Expr, arg: Expr) { this.func = func; this.arg = arg; } } export class ExprLet { readonly tag = "Let"; - constructor(readonly var_: Var, readonly value: Expr, readonly body: Expr) {} + var_: Var; + value: Expr; + body: Expr; + constructor(var_: Var, value: Expr, body: Expr) { this.var_ = var_; this.value = value; this.body = body; } } export class ExprIfThenElse { readonly tag = "IfThenElse"; - constructor(readonly guard: Expr, readonly thenExpr: Expr, readonly elseExpr: Expr) {} + guard: Expr; + thenExpr: Expr; + elseExpr: Expr; + constructor(guard: Expr, thenExpr: Expr, elseExpr: Expr) { this.guard = guard; this.thenExpr = thenExpr; this.elseExpr = elseExpr; } } export class ExprCall { readonly tag = "Call"; - constructor(readonly instance: any, readonly method: string, readonly args: any[]) {} + instance: any; + method: string; + args: any[]; + constructor(instance: any, method: string, args: any[]) { this.instance = instance; this.method = method; this.args = args; } } export class ExprSequential { readonly tag = "Sequential"; - constructor(readonly first: Expr, readonly second: Expr) {} + first: Expr; + second: Expr; + constructor(first: Expr, second: Expr) { this.first = first; this.second = second; } } export class ExprNewTuple { readonly tag = "NewTuple"; - constructor(readonly elements: any[]) {} + elements: any[]; + constructor(elements: any[]) { this.elements = elements; } } export class ExprNewUnion { readonly tag = "NewUnion"; - constructor(readonly typeName: string, readonly unionTag: number, readonly fields: any[]) {} + typeName: string; + unionTag: number; + fields: any[]; + constructor(typeName: string, unionTag: number, fields: any[]) { this.typeName = typeName; this.unionTag = unionTag; this.fields = fields; } } export class ExprNewRecord { readonly tag = "NewRecord"; - constructor(readonly fieldNames: any[], readonly values: any[]) {} + fieldNames: any[]; + values: any[]; + constructor(fieldNames: any[], values: any[]) { this.fieldNames = fieldNames; this.values = values; } } export class ExprNewList { readonly tag = "NewList"; - constructor(readonly head: Expr, readonly tail: Expr) {} + head: Expr; + tail: Expr; + constructor(head: Expr, tail: Expr) { this.head = head; this.tail = tail; } } export class ExprTupleGet { readonly tag = "TupleGet"; - constructor(readonly expr: Expr, readonly index: number) {} + expr: Expr; + index: number; + constructor(expr: Expr, index: number) { this.expr = expr; this.index = index; } } export class ExprUnionTag { readonly tag = "UnionTag"; - constructor(readonly expr: Expr) {} + expr: Expr; + constructor(expr: Expr) { this.expr = expr; } } export class ExprUnionField { readonly tag = "UnionField"; - constructor(readonly expr: Expr, readonly fieldIndex: number) {} + expr: Expr; + fieldIndex: number; + constructor(expr: Expr, fieldIndex: number) { this.expr = expr; this.fieldIndex = fieldIndex; } } export class ExprFieldGet { readonly tag = "FieldGet"; - constructor(readonly expr: Expr, readonly fieldName: string) {} + expr: Expr; + fieldName: string; + constructor(expr: Expr, fieldName: string) { this.expr = expr; this.fieldName = fieldName; } } export class ExprFieldSet { readonly tag = "FieldSet"; - constructor(readonly expr: Expr, readonly fieldName: string, readonly value: Expr) {} + expr: Expr; + fieldName: string; + value: Expr; + constructor(expr: Expr, fieldName: string, value: Expr) { this.expr = expr; this.fieldName = fieldName; this.value = value; } } export class ExprVarSet { readonly tag = "VarSet"; - constructor(readonly target: Expr, readonly value: Expr) {} + target: Expr; + value: Expr; + constructor(target: Expr, value: Expr) { this.target = target; this.value = value; } } export type Expr = From 1cdcb45631a8284da33d31effdb8c677bc687870 Mon Sep 17 00:00:00 2001 From: Onur Gumus Date: Mon, 6 Apr 2026 18:04:00 +0200 Subject: [PATCH 3/9] Fix two failing quotation tests - Let binding: check name starts with "x" (FSharp2Fable may add suffix) - NewTuple: use List.length instead of .Length (isNewTuple returns array) --- tests/Js/Main/QuotationTests.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/Js/Main/QuotationTests.fs b/tests/Js/Main/QuotationTests.fs index 7efcdd1ae2..f8707c0151 100644 --- a/tests/Js/Main/QuotationTests.fs +++ b/tests/Js/Main/QuotationTests.fs @@ -39,7 +39,7 @@ let tests = let q = <@ let x = 5 in x @> match q with | Let(v, Value(value, _), _) -> - equal "x" v.Name + v.Name.StartsWith("x") |> equal true equal 5 (value :?> int) | _ -> failwith "Expected Let" @@ -58,7 +58,7 @@ let tests = testCase "NewTuple quotation" <| fun () -> let q = <@ (1, 2, 3) @> match q with - | NewTuple(exprs) -> equal 3 exprs.Length + | NewTuple(exprs) -> equal 3 (List.length exprs) | _ -> failwith "Expected NewTuple" testCase "Sequential quotation" <| fun () -> From 46cd51a5f45a60fe1f833a70cde2e216c9783e11 Mon Sep 17 00:00:00 2001 From: Onur Gumus Date: Mon, 6 Apr 2026 18:21:35 +0200 Subject: [PATCH 4/9] Fix NewTuple test: use Seq.length for array compatibility --- tests/Js/Main/QuotationTests.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/Js/Main/QuotationTests.fs b/tests/Js/Main/QuotationTests.fs index f8707c0151..38cb5d8222 100644 --- a/tests/Js/Main/QuotationTests.fs +++ b/tests/Js/Main/QuotationTests.fs @@ -58,7 +58,7 @@ let tests = testCase "NewTuple quotation" <| fun () -> let q = <@ (1, 2, 3) @> match q with - | NewTuple(exprs) -> equal 3 (List.length exprs) + | NewTuple(exprs) -> equal 3 (Seq.length exprs) | _ -> failwith "Expected NewTuple" testCase "Sequential quotation" <| fun () -> From ac760cd216279d4ab73d95050fdca9076519679d Mon Sep 17 00:00:00 2001 From: Onur Gumus Date: Tue, 7 Apr 2026 04:59:33 +0200 Subject: [PATCH 5/9] Add JSON serialization support and Fable.Core.Quotations types - Add toJSON() methods to all Expr classes for JSON.stringify support - Add exprFromJSON() deserializer for reconstructing from JSON - Add Fable.Core.Quotations.fs with QuotExpr/QuotVar types for .NET-side deserialization (e.g. via Thoth.Json) - Add JSON serialization tests --- src/Fable.Core/CHANGELOG.md | 4 ++ src/Fable.Core/Fable.Core.Quotations.fs | 36 +++++++++++++++++ src/Fable.Core/Fable.Core.fsproj | 1 + src/fable-library-ts/quotation.ts | 53 +++++++++++++++++++++++++ tests/Js/Main/QuotationTests.fs | 12 ++++++ 5 files changed, 106 insertions(+) create mode 100644 src/Fable.Core/Fable.Core.Quotations.fs diff --git a/src/Fable.Core/CHANGELOG.md b/src/Fable.Core/CHANGELOG.md index e8e58aeeab..4b4590ff21 100644 --- a/src/Fable.Core/CHANGELOG.md +++ b/src/Fable.Core/CHANGELOG.md @@ -7,6 +7,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## Unreleased +### Added + +* Add `Fable.Core.Quotations` namespace with `QuotExpr` and `QuotVar` types for .NET-side deserialization of Fable quotation ASTs + ## 5.0.0-rc.1 - 2026-02-26 ### Added diff --git a/src/Fable.Core/Fable.Core.Quotations.fs b/src/Fable.Core/Fable.Core.Quotations.fs new file mode 100644 index 0000000000..b7c2588b6d --- /dev/null +++ b/src/Fable.Core/Fable.Core.Quotations.fs @@ -0,0 +1,36 @@ +namespace Fable.Core.Quotations + +/// Serializable variable in a quotation expression. +/// Matches the JSON shape produced by Fable's quotation runtime. +type QuotVar = + { + Name: string + Type: string + IsMutable: bool + } + +/// Serializable quotation expression tree. +/// Designed for cross-platform JSON deserialization (e.g. via Thoth.Json) +/// of quotations constructed on Fable JS/TS clients. +/// +/// JSON format: ["Tag", ...fields] arrays, e.g. ["Value", 42, "int32"] +[] +type QuotExpr = + | Value of value: obj * typeName: string + | Var of var: QuotVar + | Lambda of var: QuotVar * body: QuotExpr + | Application of func: QuotExpr * arg: QuotExpr + | Let of var: QuotVar * value: QuotExpr * body: QuotExpr + | IfThenElse of guard: QuotExpr * thenExpr: QuotExpr * elseExpr: QuotExpr + | Call of instance: QuotExpr option * methodName: string * args: QuotExpr array + | Sequential of first: QuotExpr * second: QuotExpr + | NewTuple of elements: QuotExpr array + | TupleGet of tuple: QuotExpr * index: int + | NewUnion of typeName: string * tag: int * fields: QuotExpr array + | UnionTag of expr: QuotExpr + | UnionField of expr: QuotExpr * index: int + | NewRecord of fieldNames: string array * values: QuotExpr array + | FieldGet of expr: QuotExpr * fieldName: string + | FieldSet of expr: QuotExpr * fieldName: string * value: QuotExpr + | VarSet of target: QuotExpr * value: QuotExpr + | NewList of head: QuotExpr * tail: QuotExpr diff --git a/src/Fable.Core/Fable.Core.fsproj b/src/Fable.Core/Fable.Core.fsproj index 74182e86b4..1429eb2264 100644 --- a/src/Fable.Core/Fable.Core.fsproj +++ b/src/Fable.Core/Fable.Core.fsproj @@ -21,6 +21,7 @@ + diff --git a/src/fable-library-ts/quotation.ts b/src/fable-library-ts/quotation.ts index e8bf72c728..7ea4cdb90c 100644 --- a/src/fable-library-ts/quotation.ts +++ b/src/fable-library-ts/quotation.ts @@ -39,12 +39,14 @@ export class ExprValue { value: any; type: string; constructor(value: any, type: string) { this.value = value; this.type = type; } + toJSON() { return ["Value", this.value, this.type]; } } export class ExprVarExpr { readonly tag = "Var"; var_: Var; constructor(var_: Var) { this.var_ = var_; } + toJSON() { return ["Var", this.var_]; } } export class ExprLambda { @@ -52,6 +54,7 @@ export class ExprLambda { var_: Var; body: Expr; constructor(var_: Var, body: Expr) { this.var_ = var_; this.body = body; } + toJSON() { return ["Lambda", this.var_, this.body]; } } export class ExprApplication { @@ -59,6 +62,7 @@ export class ExprApplication { func: Expr; arg: Expr; constructor(func: Expr, arg: Expr) { this.func = func; this.arg = arg; } + toJSON() { return ["Application", this.func, this.arg]; } } export class ExprLet { @@ -67,6 +71,7 @@ export class ExprLet { value: Expr; body: Expr; constructor(var_: Var, value: Expr, body: Expr) { this.var_ = var_; this.value = value; this.body = body; } + toJSON() { return ["Let", this.var_, this.value, this.body]; } } export class ExprIfThenElse { @@ -75,6 +80,7 @@ export class ExprIfThenElse { thenExpr: Expr; elseExpr: Expr; constructor(guard: Expr, thenExpr: Expr, elseExpr: Expr) { this.guard = guard; this.thenExpr = thenExpr; this.elseExpr = elseExpr; } + toJSON() { return ["IfThenElse", this.guard, this.thenExpr, this.elseExpr]; } } export class ExprCall { @@ -83,6 +89,7 @@ export class ExprCall { method: string; args: any[]; constructor(instance: any, method: string, args: any[]) { this.instance = instance; this.method = method; this.args = args; } + toJSON() { return ["Call", this.instance, this.method, this.args]; } } export class ExprSequential { @@ -90,12 +97,14 @@ export class ExprSequential { first: Expr; second: Expr; constructor(first: Expr, second: Expr) { this.first = first; this.second = second; } + toJSON() { return ["Sequential", this.first, this.second]; } } export class ExprNewTuple { readonly tag = "NewTuple"; elements: any[]; constructor(elements: any[]) { this.elements = elements; } + toJSON() { return ["NewTuple", this.elements]; } } export class ExprNewUnion { @@ -104,6 +113,7 @@ export class ExprNewUnion { unionTag: number; fields: any[]; constructor(typeName: string, unionTag: number, fields: any[]) { this.typeName = typeName; this.unionTag = unionTag; this.fields = fields; } + toJSON() { return ["NewUnion", this.typeName, this.unionTag, this.fields]; } } export class ExprNewRecord { @@ -111,6 +121,7 @@ export class ExprNewRecord { fieldNames: any[]; values: any[]; constructor(fieldNames: any[], values: any[]) { this.fieldNames = fieldNames; this.values = values; } + toJSON() { return ["NewRecord", this.fieldNames, this.values]; } } export class ExprNewList { @@ -118,6 +129,7 @@ export class ExprNewList { head: Expr; tail: Expr; constructor(head: Expr, tail: Expr) { this.head = head; this.tail = tail; } + toJSON() { return ["NewList", this.head, this.tail]; } } export class ExprTupleGet { @@ -125,12 +137,14 @@ export class ExprTupleGet { expr: Expr; index: number; constructor(expr: Expr, index: number) { this.expr = expr; this.index = index; } + toJSON() { return ["TupleGet", this.expr, this.index]; } } export class ExprUnionTag { readonly tag = "UnionTag"; expr: Expr; constructor(expr: Expr) { this.expr = expr; } + toJSON() { return ["UnionTag", this.expr]; } } export class ExprUnionField { @@ -138,6 +152,7 @@ export class ExprUnionField { expr: Expr; fieldIndex: number; constructor(expr: Expr, fieldIndex: number) { this.expr = expr; this.fieldIndex = fieldIndex; } + toJSON() { return ["UnionField", this.expr, this.fieldIndex]; } } export class ExprFieldGet { @@ -145,6 +160,7 @@ export class ExprFieldGet { expr: Expr; fieldName: string; constructor(expr: Expr, fieldName: string) { this.expr = expr; this.fieldName = fieldName; } + toJSON() { return ["FieldGet", this.expr, this.fieldName]; } } export class ExprFieldSet { @@ -153,6 +169,7 @@ export class ExprFieldSet { fieldName: string; value: Expr; constructor(expr: Expr, fieldName: string, value: Expr) { this.expr = expr; this.fieldName = fieldName; this.value = value; } + toJSON() { return ["FieldSet", this.expr, this.fieldName, this.value]; } } export class ExprVarSet { @@ -160,6 +177,7 @@ export class ExprVarSet { target: Expr; value: Expr; constructor(target: Expr, value: Expr) { this.target = target; this.value = value; } + toJSON() { return ["VarSet", this.target, this.value]; } } export type Expr = @@ -570,3 +588,38 @@ export function substitute(expr: Expr, fn: (v: Var) => Expr | undefined): Expr { } return sub(expr); } + +// =================================================================== +// JSON deserialization +// Reconstructs Expr/Var from the toJSON() array format. +// =================================================================== + +function varFromJSON(json: any): Var { + return new Var(json.Name, json.Type, json.IsMutable); +} + +export function exprFromJSON(json: any): Expr { + if (!Array.isArray(json)) return new ExprValue(json, typeof json); + const [tag, ...fields] = json; + switch (tag) { + case "Value": return new ExprValue(fields[0], fields[1]); + case "Var": return new ExprVarExpr(varFromJSON(fields[0])); + case "Lambda": return new ExprLambda(varFromJSON(fields[0]), exprFromJSON(fields[1])); + case "Application": return new ExprApplication(exprFromJSON(fields[0]), exprFromJSON(fields[1])); + case "Let": return new ExprLet(varFromJSON(fields[0]), exprFromJSON(fields[1]), exprFromJSON(fields[2])); + case "IfThenElse": return new ExprIfThenElse(exprFromJSON(fields[0]), exprFromJSON(fields[1]), exprFromJSON(fields[2])); + case "Call": return new ExprCall(fields[0] != null ? exprFromJSON(fields[0]) : null, fields[1], (fields[2] as any[]).map(exprFromJSON)); + case "Sequential": return new ExprSequential(exprFromJSON(fields[0]), exprFromJSON(fields[1])); + case "NewTuple": return new ExprNewTuple((fields[0] as any[]).map(exprFromJSON)); + case "TupleGet": return new ExprTupleGet(exprFromJSON(fields[0]), fields[1]); + case "NewUnion": return new ExprNewUnion(fields[0], fields[1], (fields[2] as any[]).map(exprFromJSON)); + case "UnionTag": return new ExprUnionTag(exprFromJSON(fields[0])); + case "UnionField": return new ExprUnionField(exprFromJSON(fields[0]), fields[1]); + case "NewRecord": return new ExprNewRecord(fields[0], (fields[1] as any[]).map(exprFromJSON)); + case "FieldGet": return new ExprFieldGet(exprFromJSON(fields[0]), fields[1]); + case "FieldSet": return new ExprFieldSet(exprFromJSON(fields[0]), fields[1], exprFromJSON(fields[2])); + case "VarSet": return new ExprVarSet(exprFromJSON(fields[0]), exprFromJSON(fields[1])); + case "NewList": return new ExprNewList(exprFromJSON(fields[0]), exprFromJSON(fields[1])); + default: return new ExprValue(json, "unknown"); + } +} diff --git a/tests/Js/Main/QuotationTests.fs b/tests/Js/Main/QuotationTests.fs index 38cb5d8222..407488f313 100644 --- a/tests/Js/Main/QuotationTests.fs +++ b/tests/Js/Main/QuotationTests.fs @@ -133,5 +133,17 @@ let tests = let q = <@ fun x -> x + 1 @> let freeVars = q.GetFreeVars() |> Seq.length equal 0 freeVars + + testCase "JSON serialization produces valid output" <| fun () -> + let q = <@ 42 @> + let json = Fable.Core.JS.JSON.stringify(q) + json.Contains("Value") |> equal true + json.Contains("42") |> equal true + + testCase "JSON round-trip preserves structure" <| fun () -> + let q = <@ 1 + 2 @> + let json = Fable.Core.JS.JSON.stringify(q) + let parsed = Fable.Core.JS.JSON.parse(json) :?> obj[] + parsed[0] |> unbox |> equal "Call" #endif ] From a7c5e2a96a2580f37445bace072c5ba91402df1c Mon Sep 17 00:00:00 2001 From: Onur Gumus Date: Tue, 7 Apr 2026 07:35:02 +0200 Subject: [PATCH 6/9] Address code review feedback in quotation.ts - Complete getFreeVars/substitute traversal for all AST nodes: ExprNewUnion, ExprNewRecord, ExprNewList, ExprFieldSet, ExprVarSet, ExprUnionTag, ExprUnionField - Tighten types: Expr | null for ExprCall.instance, Expr[] for args/ elements/fields/values, string[] for fieldNames - Simplify substitute instance check to: e.instance != null ? sub(...) - Remove integer truncation (| 0) from op_Division --- src/fable-library-ts/quotation.ts | 69 ++++++++++++++++++++----------- 1 file changed, 44 insertions(+), 25 deletions(-) diff --git a/src/fable-library-ts/quotation.ts b/src/fable-library-ts/quotation.ts index 7ea4cdb90c..1a8e6c02a9 100644 --- a/src/fable-library-ts/quotation.ts +++ b/src/fable-library-ts/quotation.ts @@ -85,10 +85,10 @@ export class ExprIfThenElse { export class ExprCall { readonly tag = "Call"; - instance: any; + instance: Expr | null; method: string; - args: any[]; - constructor(instance: any, method: string, args: any[]) { this.instance = instance; this.method = method; this.args = args; } + args: Expr[]; + constructor(instance: Expr | null, method: string, args: Expr[]) { this.instance = instance; this.method = method; this.args = args; } toJSON() { return ["Call", this.instance, this.method, this.args]; } } @@ -102,8 +102,8 @@ export class ExprSequential { export class ExprNewTuple { readonly tag = "NewTuple"; - elements: any[]; - constructor(elements: any[]) { this.elements = elements; } + elements: Expr[]; + constructor(elements: Expr[]) { this.elements = elements; } toJSON() { return ["NewTuple", this.elements]; } } @@ -111,16 +111,16 @@ export class ExprNewUnion { readonly tag = "NewUnion"; typeName: string; unionTag: number; - fields: any[]; - constructor(typeName: string, unionTag: number, fields: any[]) { this.typeName = typeName; this.unionTag = unionTag; this.fields = fields; } + fields: Expr[]; + constructor(typeName: string, unionTag: number, fields: Expr[]) { this.typeName = typeName; this.unionTag = unionTag; this.fields = fields; } toJSON() { return ["NewUnion", this.typeName, this.unionTag, this.fields]; } } export class ExprNewRecord { readonly tag = "NewRecord"; - fieldNames: any[]; - values: any[]; - constructor(fieldNames: any[], values: any[]) { this.fieldNames = fieldNames; this.values = values; } + fieldNames: string[]; + values: Expr[]; + constructor(fieldNames: string[], values: Expr[]) { this.fieldNames = fieldNames; this.values = values; } toJSON() { return ["NewRecord", this.fieldNames, this.values]; } } @@ -228,7 +228,7 @@ export function mkIfThenElse(guard: Expr, thenExpr: Expr, elseExpr: Expr): ExprI return new ExprIfThenElse(guard, thenExpr, elseExpr); } -export function mkCall(instance: any, method: string, args: any[]): ExprCall { +export function mkCall(instance: Expr | null, method: string, args: Expr[]): ExprCall { return new ExprCall(instance, method, args); } @@ -236,7 +236,7 @@ export function mkSequential(first: Expr, second: Expr): ExprSequential { return new ExprSequential(first, second); } -export function mkNewTuple(elements: any[]): ExprNewTuple { +export function mkNewTuple(elements: Expr[]): ExprNewTuple { return new ExprNewTuple(elements); } @@ -264,11 +264,11 @@ export function mkVarSet(target: Expr, value: Expr): ExprVarSet { return new ExprVarSet(target, value); } -export function mkNewUnion(typeName: string, tag: number, fields: any[]): ExprNewUnion { +export function mkNewUnion(typeName: string, tag: number, fields: Expr[]): ExprNewUnion { return new ExprNewUnion(typeName, tag, fields); } -export function mkNewRecord(fieldNames: any[], values: any[]): ExprNewRecord { +export function mkNewRecord(fieldNames: string[], values: Expr[]): ExprNewRecord { return new ExprNewRecord(fieldNames, values); } @@ -322,7 +322,7 @@ export function isIfThenElse(expr: Expr): [Expr, Expr, Expr] | undefined { return undefined; } -export function isCall(expr: Expr): [any, string, any[]] | undefined { +export function isCall(expr: Expr): [Expr | null, string, Expr[]] | undefined { if (expr instanceof ExprCall) return [expr.instance, expr.method, expr.args]; return undefined; } @@ -332,17 +332,17 @@ export function isSequential(expr: Expr): [Expr, Expr] | undefined { return undefined; } -export function isNewTuple(expr: Expr): any[] | undefined { +export function isNewTuple(expr: Expr): Expr[] | undefined { if (expr instanceof ExprNewTuple) return expr.elements; return undefined; } -export function isNewUnionCase(expr: Expr): [string, any[]] | undefined { +export function isNewUnionCase(expr: Expr): [string, Expr[]] | undefined { if (expr instanceof ExprNewUnion) return [expr.typeName, expr.fields]; return undefined; } -export function isNewRecord(expr: Expr): [any[], any[]] | undefined { +export function isNewRecord(expr: Expr): [string[], Expr[]] | undefined { if (expr instanceof ExprNewRecord) return [expr.fieldNames, expr.values]; return undefined; } @@ -365,7 +365,7 @@ const OPERATORS: Record any> = { "op_Addition": (a: any, b: any) => a + b, "op_Subtraction": (a: any, b: any) => a - b, "op_Multiply": (a: any, b: any) => a * b, - "op_Division": (a: any, b: any) => (a / b) | 0, + "op_Division": (a: any, b: any) => a / b, "op_Modulus": (a: any, b: any) => a % b, "op_Exponentiation": (a: any, b: any) => a ** b, "op_UnaryNegation": (a: any) => -a, @@ -552,8 +552,25 @@ export function getFreeVars(expr: Expr): Var[] { for (const el of e.elements) walk(el, bound); } else if (e instanceof ExprTupleGet) { walk(e.expr, bound); + } else if (e instanceof ExprNewUnion) { + for (const f of e.fields) walk(f, bound); + } else if (e instanceof ExprNewRecord) { + for (const v of e.values) walk(v, bound); + } else if (e instanceof ExprNewList) { + walk(e.head, bound); + walk(e.tail, bound); + } else if (e instanceof ExprUnionTag) { + walk(e.expr, bound); + } else if (e instanceof ExprUnionField) { + walk(e.expr, bound); } else if (e instanceof ExprFieldGet) { walk(e.expr, bound); + } else if (e instanceof ExprFieldSet) { + walk(e.expr, bound); + walk(e.value, bound); + } else if (e instanceof ExprVarSet) { + walk(e.target, bound); + walk(e.value, bound); } } @@ -572,18 +589,20 @@ export function substitute(expr: Expr, fn: (v: Var) => Expr | undefined): Expr { if (e instanceof ExprApplication) return new ExprApplication(sub(e.func), sub(e.arg)); if (e instanceof ExprIfThenElse) return new ExprIfThenElse(sub(e.guard), sub(e.thenExpr), sub(e.elseExpr)); if (e instanceof ExprCall) { - const newInst = e.instance instanceof ExprVarExpr || e.instance instanceof ExprValue - || e.instance instanceof ExprLambda || e.instance instanceof ExprApplication - || e.instance instanceof ExprLet || e.instance instanceof ExprIfThenElse - || e.instance instanceof ExprCall || e.instance instanceof ExprSequential - || e.instance instanceof ExprNewTuple - ? sub(e.instance) : e.instance; + const newInst = e.instance != null ? sub(e.instance) : e.instance; return new ExprCall(newInst, e.method, e.args.map(sub)); } if (e instanceof ExprSequential) return new ExprSequential(sub(e.first), sub(e.second)); if (e instanceof ExprNewTuple) return new ExprNewTuple(e.elements.map(sub)); if (e instanceof ExprTupleGet) return new ExprTupleGet(sub(e.expr), e.index); + if (e instanceof ExprNewUnion) return new ExprNewUnion(e.typeName, e.unionTag, e.fields.map(sub)); + if (e instanceof ExprNewRecord) return new ExprNewRecord(e.fieldNames, e.values.map(sub)); + if (e instanceof ExprNewList) return new ExprNewList(sub(e.head), sub(e.tail)); + if (e instanceof ExprUnionTag) return new ExprUnionTag(sub(e.expr)); + if (e instanceof ExprUnionField) return new ExprUnionField(sub(e.expr), e.fieldIndex); if (e instanceof ExprFieldGet) return new ExprFieldGet(sub(e.expr), e.fieldName); + if (e instanceof ExprFieldSet) return new ExprFieldSet(sub(e.expr), e.fieldName, sub(e.value)); + if (e instanceof ExprVarSet) return new ExprVarSet(sub(e.target), sub(e.value)); return e; } return sub(expr); From b615f760184f91a91f7fa3085cf607eabc81a430 Mon Sep 17 00:00:00 2001 From: Onur Gumus Date: Tue, 7 Apr 2026 11:57:40 +0200 Subject: [PATCH 7/9] Switch JSON format to Thoth.Json-compatible {"Case","Fields"} objects Change toJSON() output from ["Tag", ...fields] arrays to {"Case":"Tag","Fields":[...]} objects. This matches Thoth.Json's standard DU encoding, enabling Decode.Auto.fromString(json) on .NET with zero custom decoders. --- src/fable-library-ts/quotation.ts | 43 +++++++++++++++++-------------- tests/Js/Main/QuotationTests.fs | 10 ++++--- 2 files changed, 30 insertions(+), 23 deletions(-) diff --git a/src/fable-library-ts/quotation.ts b/src/fable-library-ts/quotation.ts index 1a8e6c02a9..91c94fa311 100644 --- a/src/fable-library-ts/quotation.ts +++ b/src/fable-library-ts/quotation.ts @@ -39,14 +39,14 @@ export class ExprValue { value: any; type: string; constructor(value: any, type: string) { this.value = value; this.type = type; } - toJSON() { return ["Value", this.value, this.type]; } + toJSON() { return { Case: "Value", Fields: [this.value, this.type] }; } } export class ExprVarExpr { readonly tag = "Var"; var_: Var; constructor(var_: Var) { this.var_ = var_; } - toJSON() { return ["Var", this.var_]; } + toJSON() { return { Case: "Var", Fields: [this.var_] }; } } export class ExprLambda { @@ -54,7 +54,7 @@ export class ExprLambda { var_: Var; body: Expr; constructor(var_: Var, body: Expr) { this.var_ = var_; this.body = body; } - toJSON() { return ["Lambda", this.var_, this.body]; } + toJSON() { return { Case: "Lambda", Fields: [this.var_, this.body] }; } } export class ExprApplication { @@ -62,7 +62,7 @@ export class ExprApplication { func: Expr; arg: Expr; constructor(func: Expr, arg: Expr) { this.func = func; this.arg = arg; } - toJSON() { return ["Application", this.func, this.arg]; } + toJSON() { return { Case: "Application", Fields: [this.func, this.arg] }; } } export class ExprLet { @@ -71,7 +71,7 @@ export class ExprLet { value: Expr; body: Expr; constructor(var_: Var, value: Expr, body: Expr) { this.var_ = var_; this.value = value; this.body = body; } - toJSON() { return ["Let", this.var_, this.value, this.body]; } + toJSON() { return { Case: "Let", Fields: [this.var_, this.value, this.body] }; } } export class ExprIfThenElse { @@ -80,7 +80,7 @@ export class ExprIfThenElse { thenExpr: Expr; elseExpr: Expr; constructor(guard: Expr, thenExpr: Expr, elseExpr: Expr) { this.guard = guard; this.thenExpr = thenExpr; this.elseExpr = elseExpr; } - toJSON() { return ["IfThenElse", this.guard, this.thenExpr, this.elseExpr]; } + toJSON() { return { Case: "IfThenElse", Fields: [this.guard, this.thenExpr, this.elseExpr] }; } } export class ExprCall { @@ -89,7 +89,7 @@ export class ExprCall { method: string; args: Expr[]; constructor(instance: Expr | null, method: string, args: Expr[]) { this.instance = instance; this.method = method; this.args = args; } - toJSON() { return ["Call", this.instance, this.method, this.args]; } + toJSON() { return { Case: "Call", Fields: [this.instance, this.method, this.args] }; } } export class ExprSequential { @@ -97,14 +97,14 @@ export class ExprSequential { first: Expr; second: Expr; constructor(first: Expr, second: Expr) { this.first = first; this.second = second; } - toJSON() { return ["Sequential", this.first, this.second]; } + toJSON() { return { Case: "Sequential", Fields: [this.first, this.second] }; } } export class ExprNewTuple { readonly tag = "NewTuple"; elements: Expr[]; constructor(elements: Expr[]) { this.elements = elements; } - toJSON() { return ["NewTuple", this.elements]; } + toJSON() { return { Case: "NewTuple", Fields: [this.elements] }; } } export class ExprNewUnion { @@ -113,7 +113,7 @@ export class ExprNewUnion { unionTag: number; fields: Expr[]; constructor(typeName: string, unionTag: number, fields: Expr[]) { this.typeName = typeName; this.unionTag = unionTag; this.fields = fields; } - toJSON() { return ["NewUnion", this.typeName, this.unionTag, this.fields]; } + toJSON() { return { Case: "NewUnion", Fields: [this.typeName, this.unionTag, this.fields] }; } } export class ExprNewRecord { @@ -121,7 +121,7 @@ export class ExprNewRecord { fieldNames: string[]; values: Expr[]; constructor(fieldNames: string[], values: Expr[]) { this.fieldNames = fieldNames; this.values = values; } - toJSON() { return ["NewRecord", this.fieldNames, this.values]; } + toJSON() { return { Case: "NewRecord", Fields: [this.fieldNames, this.values] }; } } export class ExprNewList { @@ -129,7 +129,7 @@ export class ExprNewList { head: Expr; tail: Expr; constructor(head: Expr, tail: Expr) { this.head = head; this.tail = tail; } - toJSON() { return ["NewList", this.head, this.tail]; } + toJSON() { return { Case: "NewList", Fields: [this.head, this.tail] }; } } export class ExprTupleGet { @@ -137,14 +137,14 @@ export class ExprTupleGet { expr: Expr; index: number; constructor(expr: Expr, index: number) { this.expr = expr; this.index = index; } - toJSON() { return ["TupleGet", this.expr, this.index]; } + toJSON() { return { Case: "TupleGet", Fields: [this.expr, this.index] }; } } export class ExprUnionTag { readonly tag = "UnionTag"; expr: Expr; constructor(expr: Expr) { this.expr = expr; } - toJSON() { return ["UnionTag", this.expr]; } + toJSON() { return { Case: "UnionTag", Fields: [this.expr] }; } } export class ExprUnionField { @@ -152,7 +152,7 @@ export class ExprUnionField { expr: Expr; fieldIndex: number; constructor(expr: Expr, fieldIndex: number) { this.expr = expr; this.fieldIndex = fieldIndex; } - toJSON() { return ["UnionField", this.expr, this.fieldIndex]; } + toJSON() { return { Case: "UnionField", Fields: [this.expr, this.fieldIndex] }; } } export class ExprFieldGet { @@ -160,7 +160,7 @@ export class ExprFieldGet { expr: Expr; fieldName: string; constructor(expr: Expr, fieldName: string) { this.expr = expr; this.fieldName = fieldName; } - toJSON() { return ["FieldGet", this.expr, this.fieldName]; } + toJSON() { return { Case: "FieldGet", Fields: [this.expr, this.fieldName] }; } } export class ExprFieldSet { @@ -169,7 +169,7 @@ export class ExprFieldSet { fieldName: string; value: Expr; constructor(expr: Expr, fieldName: string, value: Expr) { this.expr = expr; this.fieldName = fieldName; this.value = value; } - toJSON() { return ["FieldSet", this.expr, this.fieldName, this.value]; } + toJSON() { return { Case: "FieldSet", Fields: [this.expr, this.fieldName, this.value] }; } } export class ExprVarSet { @@ -177,7 +177,7 @@ export class ExprVarSet { target: Expr; value: Expr; constructor(target: Expr, value: Expr) { this.target = target; this.value = value; } - toJSON() { return ["VarSet", this.target, this.value]; } + toJSON() { return { Case: "VarSet", Fields: [this.target, this.value] }; } } export type Expr = @@ -618,8 +618,11 @@ function varFromJSON(json: any): Var { } export function exprFromJSON(json: any): Expr { - if (!Array.isArray(json)) return new ExprValue(json, typeof json); - const [tag, ...fields] = json; + if (json == null || typeof json !== "object" || !("Case" in json)) { + return new ExprValue(json, typeof json); + } + const tag = json.Case as string; + const fields = json.Fields as any[]; switch (tag) { case "Value": return new ExprValue(fields[0], fields[1]); case "Var": return new ExprVarExpr(varFromJSON(fields[0])); diff --git a/tests/Js/Main/QuotationTests.fs b/tests/Js/Main/QuotationTests.fs index 407488f313..5600cd8884 100644 --- a/tests/Js/Main/QuotationTests.fs +++ b/tests/Js/Main/QuotationTests.fs @@ -134,16 +134,20 @@ let tests = let freeVars = q.GetFreeVars() |> Seq.length equal 0 freeVars - testCase "JSON serialization produces valid output" <| fun () -> + testCase "JSON serialization produces Thoth-compatible format" <| fun () -> let q = <@ 42 @> let json = Fable.Core.JS.JSON.stringify(q) + // Thoth.Json format: {"Case":"Value","Fields":[42,"int32"]} + json.Contains("Case") |> equal true json.Contains("Value") |> equal true + json.Contains("Fields") |> equal true json.Contains("42") |> equal true testCase "JSON round-trip preserves structure" <| fun () -> let q = <@ 1 + 2 @> let json = Fable.Core.JS.JSON.stringify(q) - let parsed = Fable.Core.JS.JSON.parse(json) :?> obj[] - parsed[0] |> unbox |> equal "Call" + let parsed = Fable.Core.JS.JSON.parse(json) + // Thoth format: {"Case":"Call","Fields":[...]} + parsed?Case |> unbox |> equal "Call" #endif ] From 8035037753f6e24d74156414d2d38b1722a2f67a Mon Sep 17 00:00:00 2001 From: Onur Gumus Date: Tue, 7 Apr 2026 12:03:03 +0200 Subject: [PATCH 8/9] Fix missing JsInterop import for dynamic ? operator in tests --- tests/Js/Main/QuotationTests.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/Js/Main/QuotationTests.fs b/tests/Js/Main/QuotationTests.fs index 5600cd8884..128af937f2 100644 --- a/tests/Js/Main/QuotationTests.fs +++ b/tests/Js/Main/QuotationTests.fs @@ -6,6 +6,7 @@ open Util.Testing #if FABLE_COMPILER open Microsoft.FSharp.Linq.RuntimeHelpers +open Fable.Core.JsInterop #endif let tests = From 4e52e7ef88f70307d429fcb5be8d684abfb01251 Mon Sep 17 00:00:00 2001 From: Onur Gumus Date: Tue, 7 Apr 2026 17:14:17 +0200 Subject: [PATCH 9/9] Switch JSON format to Thoth.Json Auto-compatible arrays Change toJSON() from {"Case":"Tag","Fields":[...]} objects to ["Tag", ...fields] arrays, matching Thoth.Json Auto encoding. On .NET, deserialize with FSharp.SystemTextJson ThothLike: options.Converters.Add(JsonFSharpConverter(JsonUnionEncoding.ThothLike)) Verified end-to-end: Fable JS -> JSON -> .NET deserialize -> evaluate. --- src/fable-library-ts/quotation.ts | 43 ++++++++++++++----------------- tests/Js/Main/QuotationTests.fs | 12 ++++----- 2 files changed, 25 insertions(+), 30 deletions(-) diff --git a/src/fable-library-ts/quotation.ts b/src/fable-library-ts/quotation.ts index 91c94fa311..1a8e6c02a9 100644 --- a/src/fable-library-ts/quotation.ts +++ b/src/fable-library-ts/quotation.ts @@ -39,14 +39,14 @@ export class ExprValue { value: any; type: string; constructor(value: any, type: string) { this.value = value; this.type = type; } - toJSON() { return { Case: "Value", Fields: [this.value, this.type] }; } + toJSON() { return ["Value", this.value, this.type]; } } export class ExprVarExpr { readonly tag = "Var"; var_: Var; constructor(var_: Var) { this.var_ = var_; } - toJSON() { return { Case: "Var", Fields: [this.var_] }; } + toJSON() { return ["Var", this.var_]; } } export class ExprLambda { @@ -54,7 +54,7 @@ export class ExprLambda { var_: Var; body: Expr; constructor(var_: Var, body: Expr) { this.var_ = var_; this.body = body; } - toJSON() { return { Case: "Lambda", Fields: [this.var_, this.body] }; } + toJSON() { return ["Lambda", this.var_, this.body]; } } export class ExprApplication { @@ -62,7 +62,7 @@ export class ExprApplication { func: Expr; arg: Expr; constructor(func: Expr, arg: Expr) { this.func = func; this.arg = arg; } - toJSON() { return { Case: "Application", Fields: [this.func, this.arg] }; } + toJSON() { return ["Application", this.func, this.arg]; } } export class ExprLet { @@ -71,7 +71,7 @@ export class ExprLet { value: Expr; body: Expr; constructor(var_: Var, value: Expr, body: Expr) { this.var_ = var_; this.value = value; this.body = body; } - toJSON() { return { Case: "Let", Fields: [this.var_, this.value, this.body] }; } + toJSON() { return ["Let", this.var_, this.value, this.body]; } } export class ExprIfThenElse { @@ -80,7 +80,7 @@ export class ExprIfThenElse { thenExpr: Expr; elseExpr: Expr; constructor(guard: Expr, thenExpr: Expr, elseExpr: Expr) { this.guard = guard; this.thenExpr = thenExpr; this.elseExpr = elseExpr; } - toJSON() { return { Case: "IfThenElse", Fields: [this.guard, this.thenExpr, this.elseExpr] }; } + toJSON() { return ["IfThenElse", this.guard, this.thenExpr, this.elseExpr]; } } export class ExprCall { @@ -89,7 +89,7 @@ export class ExprCall { method: string; args: Expr[]; constructor(instance: Expr | null, method: string, args: Expr[]) { this.instance = instance; this.method = method; this.args = args; } - toJSON() { return { Case: "Call", Fields: [this.instance, this.method, this.args] }; } + toJSON() { return ["Call", this.instance, this.method, this.args]; } } export class ExprSequential { @@ -97,14 +97,14 @@ export class ExprSequential { first: Expr; second: Expr; constructor(first: Expr, second: Expr) { this.first = first; this.second = second; } - toJSON() { return { Case: "Sequential", Fields: [this.first, this.second] }; } + toJSON() { return ["Sequential", this.first, this.second]; } } export class ExprNewTuple { readonly tag = "NewTuple"; elements: Expr[]; constructor(elements: Expr[]) { this.elements = elements; } - toJSON() { return { Case: "NewTuple", Fields: [this.elements] }; } + toJSON() { return ["NewTuple", this.elements]; } } export class ExprNewUnion { @@ -113,7 +113,7 @@ export class ExprNewUnion { unionTag: number; fields: Expr[]; constructor(typeName: string, unionTag: number, fields: Expr[]) { this.typeName = typeName; this.unionTag = unionTag; this.fields = fields; } - toJSON() { return { Case: "NewUnion", Fields: [this.typeName, this.unionTag, this.fields] }; } + toJSON() { return ["NewUnion", this.typeName, this.unionTag, this.fields]; } } export class ExprNewRecord { @@ -121,7 +121,7 @@ export class ExprNewRecord { fieldNames: string[]; values: Expr[]; constructor(fieldNames: string[], values: Expr[]) { this.fieldNames = fieldNames; this.values = values; } - toJSON() { return { Case: "NewRecord", Fields: [this.fieldNames, this.values] }; } + toJSON() { return ["NewRecord", this.fieldNames, this.values]; } } export class ExprNewList { @@ -129,7 +129,7 @@ export class ExprNewList { head: Expr; tail: Expr; constructor(head: Expr, tail: Expr) { this.head = head; this.tail = tail; } - toJSON() { return { Case: "NewList", Fields: [this.head, this.tail] }; } + toJSON() { return ["NewList", this.head, this.tail]; } } export class ExprTupleGet { @@ -137,14 +137,14 @@ export class ExprTupleGet { expr: Expr; index: number; constructor(expr: Expr, index: number) { this.expr = expr; this.index = index; } - toJSON() { return { Case: "TupleGet", Fields: [this.expr, this.index] }; } + toJSON() { return ["TupleGet", this.expr, this.index]; } } export class ExprUnionTag { readonly tag = "UnionTag"; expr: Expr; constructor(expr: Expr) { this.expr = expr; } - toJSON() { return { Case: "UnionTag", Fields: [this.expr] }; } + toJSON() { return ["UnionTag", this.expr]; } } export class ExprUnionField { @@ -152,7 +152,7 @@ export class ExprUnionField { expr: Expr; fieldIndex: number; constructor(expr: Expr, fieldIndex: number) { this.expr = expr; this.fieldIndex = fieldIndex; } - toJSON() { return { Case: "UnionField", Fields: [this.expr, this.fieldIndex] }; } + toJSON() { return ["UnionField", this.expr, this.fieldIndex]; } } export class ExprFieldGet { @@ -160,7 +160,7 @@ export class ExprFieldGet { expr: Expr; fieldName: string; constructor(expr: Expr, fieldName: string) { this.expr = expr; this.fieldName = fieldName; } - toJSON() { return { Case: "FieldGet", Fields: [this.expr, this.fieldName] }; } + toJSON() { return ["FieldGet", this.expr, this.fieldName]; } } export class ExprFieldSet { @@ -169,7 +169,7 @@ export class ExprFieldSet { fieldName: string; value: Expr; constructor(expr: Expr, fieldName: string, value: Expr) { this.expr = expr; this.fieldName = fieldName; this.value = value; } - toJSON() { return { Case: "FieldSet", Fields: [this.expr, this.fieldName, this.value] }; } + toJSON() { return ["FieldSet", this.expr, this.fieldName, this.value]; } } export class ExprVarSet { @@ -177,7 +177,7 @@ export class ExprVarSet { target: Expr; value: Expr; constructor(target: Expr, value: Expr) { this.target = target; this.value = value; } - toJSON() { return { Case: "VarSet", Fields: [this.target, this.value] }; } + toJSON() { return ["VarSet", this.target, this.value]; } } export type Expr = @@ -618,11 +618,8 @@ function varFromJSON(json: any): Var { } export function exprFromJSON(json: any): Expr { - if (json == null || typeof json !== "object" || !("Case" in json)) { - return new ExprValue(json, typeof json); - } - const tag = json.Case as string; - const fields = json.Fields as any[]; + if (!Array.isArray(json)) return new ExprValue(json, typeof json); + const [tag, ...fields] = json; switch (tag) { case "Value": return new ExprValue(fields[0], fields[1]); case "Var": return new ExprVarExpr(varFromJSON(fields[0])); diff --git a/tests/Js/Main/QuotationTests.fs b/tests/Js/Main/QuotationTests.fs index 128af937f2..7366cde640 100644 --- a/tests/Js/Main/QuotationTests.fs +++ b/tests/Js/Main/QuotationTests.fs @@ -135,20 +135,18 @@ let tests = let freeVars = q.GetFreeVars() |> Seq.length equal 0 freeVars - testCase "JSON serialization produces Thoth-compatible format" <| fun () -> + testCase "JSON serialization produces Thoth Auto-compatible format" <| fun () -> let q = <@ 42 @> let json = Fable.Core.JS.JSON.stringify(q) - // Thoth.Json format: {"Case":"Value","Fields":[42,"int32"]} - json.Contains("Case") |> equal true + // Thoth.Json Auto format: ["Value",42,"int32"] json.Contains("Value") |> equal true - json.Contains("Fields") |> equal true json.Contains("42") |> equal true testCase "JSON round-trip preserves structure" <| fun () -> let q = <@ 1 + 2 @> let json = Fable.Core.JS.JSON.stringify(q) - let parsed = Fable.Core.JS.JSON.parse(json) - // Thoth format: {"Case":"Call","Fields":[...]} - parsed?Case |> unbox |> equal "Call" + let parsed = Fable.Core.JS.JSON.parse(json) :?> obj[] + // Thoth Auto format: ["Call", ...] + parsed[0] |> unbox |> equal "Call" #endif ]