From c1aae9e3f8724cd6ee3640060550033e85c1c516 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Mon, 6 Jul 2026 21:34:47 +0200 Subject: [PATCH 1/2] fix(js/ts): represent union cases with no fields as singletons Fix #3867 --- src/Fable.Transforms/Babel/Fable2Babel.fs | 172 ++++++++++++++++------ tests/Js/Main/UnionTypeTests.fs | 7 + 2 files changed, 136 insertions(+), 43 deletions(-) diff --git a/src/Fable.Transforms/Babel/Fable2Babel.fs b/src/Fable.Transforms/Babel/Fable2Babel.fs index 6d3cb64921..e9312c0808 100644 --- a/src/Fable.Transforms/Babel/Fable2Babel.fs +++ b/src/Fable.Transforms/Babel/Fable2Babel.fs @@ -1605,47 +1605,56 @@ module Util = let transformNewUnion (com: IBabelCompiler) (ctx: Context) r (ent: Fable.Entity) genArgs (tag: int) values = let values = values |> List.mapToArray (transformAsExpr com ctx) - if List.isSingle ent.UnionCases then - let typeParamInst = makeTypeParamInstantiationIfTypeScript com ctx genArgs - - Expression.newExpression (jsConstructor com ctx ent, values, ?typeArguments = typeParamInst, ?loc = r) - else - let callConstructor (case: Fable.UnionCase option) = - let tagExpr = - match case with - | Some case -> CommentedExpression(case.Name, ofInt tag) - | None -> ofInt tag - - let consRef = jsConstructor com ctx ent - - let typeParamInst = - makeTypeParamInstantiationIfTypeScript com ctx genArgs - |> Option.map (fun typeParams -> - Array.append typeParams [| LiteralTypeAnnotation(Literal.numericLiteral (tag)) |] - ) + // A case with no fields is exposed as a static singleton (see makeUnionCaseSingletonMember), + // so use that instead of allocating a new instance on every reference. + let singletonCase = + List.tryItem tag ent.UnionCases + |> Option.filter (fun case -> List.isEmpty case.UnionCaseFields) + + match singletonCase with + | Some case -> get r (jsConstructor com ctx ent) (sanitizeName case.Name) + | None -> + if List.isSingle ent.UnionCases then + let typeParamInst = makeTypeParamInstantiationIfTypeScript com ctx genArgs - Expression.newExpression ( - consRef, - [| tagExpr; Expression.arrayExpression values |], - ?typeArguments = typeParamInst, - ?loc = r - ) + Expression.newExpression (jsConstructor com ctx ent, values, ?typeArguments = typeParamInst, ?loc = r) + else + let callConstructor (case: Fable.UnionCase option) = + let tagExpr = + match case with + | Some case -> CommentedExpression(case.Name, ofInt tag) + | None -> ofInt tag + + let consRef = jsConstructor com ctx ent + + let typeParamInst = + makeTypeParamInstantiationIfTypeScript com ctx genArgs + |> Option.map (fun typeParams -> + Array.append typeParams [| LiteralTypeAnnotation(Literal.numericLiteral (tag)) |] + ) - if com.IsTypeScript then - match List.tryItem tag ent.UnionCases with - | Some case -> - match tryJsConstructorWithSuffix com ctx ent ("_" + sanitizeName case.Name) with - | Some helperRef -> - let typeParams = makeTypeParamInstantiation com ctx genArgs + Expression.newExpression ( + consRef, + [| tagExpr; Expression.arrayExpression values |], + ?typeArguments = typeParamInst, + ?loc = r + ) - Expression.callExpression (helperRef, values, typeArguments = typeParams) - | None -> callConstructor (Some case) - | None -> - $"Unmatched union case tag: %d{tag} for %s{ent.FullName}" |> addWarning com [] r + if com.IsTypeScript then + match List.tryItem tag ent.UnionCases with + | Some case -> + match tryJsConstructorWithSuffix com ctx ent ("_" + sanitizeName case.Name) with + | Some helperRef -> + let typeParams = makeTypeParamInstantiation com ctx genArgs + + Expression.callExpression (helperRef, values, typeArguments = typeParams) + | None -> callConstructor (Some case) + | None -> + $"Unmatched union case tag: %d{tag} for %s{ent.FullName}" |> addWarning com [] r - callConstructor None - else - callConstructor None + callConstructor None + else + callConstructor (List.tryItem tag ent.UnionCases) let transformValue (com: IBabelCompiler) (ctx: Context) r value : Expression = match value with @@ -3861,6 +3870,54 @@ but thanks to the optimisation done below we get yield makeMethod "Symbol.iterator" [||] (enumerableThisToIterator com ctx) returnType None |] + /// fsc represents a union case with no fields as a single shared instance, so e.g. + /// `LanguagePrimitives.PhysicalEquality X.A X.A` is true. Mirror that by exposing the + /// case as a static, precomputed instance instead of constructing a new one on every access. + let makeUnionCaseSingletonMember + (com: IBabelCompiler) + (entName: string) + genArgsCount + (tag: int option) + (case: Fable.UnionCase) + : ClassMember + = + let typeArguments = + if com.IsTypeScript then + let anyArgs = Array.create genArgsCount AnyTypeAnnotation + + match tag with + | Some tag -> + Array.append anyArgs [| LiteralTypeAnnotation(Literal.numericLiteral (tag)) |] + |> Some + | None when Array.isEmpty anyArgs -> None + | None -> Some anyArgs + else + None + + let consArgs = + match tag with + | Some tag -> [| ofInt tag; Expression.arrayExpression [||] |] + | None -> [||] + + let value = + Expression.newExpression (Expression.identifier entName, consArgs, ?typeArguments = typeArguments) + + ClassMember.classProperty ( + Expression.identifier (sanitizeName case.Name), + value = value, + isStatic = true, + ?typeAnnotation = + (if com.IsTypeScript then + Some AnyTypeAnnotation + else + None), + ?accessModifier = + (if com.IsTypeScript then + Some Readonly + else + None) + ) + let transformUnion (com: IBabelCompiler) ctx @@ -3974,6 +4031,8 @@ but thanks to the optimisation done below we get accessModifier = Readonly ) cases + if List.isEmpty singleCase.UnionCaseFields then + makeUnionCaseSingletonMember com entName entParamsDecl.Length None singleCase yield! classMembers |] @@ -4042,6 +4101,16 @@ but thanks to the optimisation done below we get accessModifier = Readonly ) cases + yield! + ent.UnionCases + |> List.mapi (fun i case -> i, case) + |> List.choose (fun (i, case) -> + if List.isEmpty case.UnionCaseFields then + makeUnionCaseSingletonMember com entName entParamsDecl.Length (Some i) case + |> Some + else + None + ) yield! classMembers |] @@ -4076,11 +4145,14 @@ but thanks to the optimisation done below we get let body = BlockStatement [| - Expression.newExpression ( - Expression.Identifier union_cons, - [| Expression.Literal tag; passedArgs |], - typeArguments = consTypeArgs - ) + (if List.isEmpty case.UnionCaseFields then + get None (Expression.Identifier union_cons) (sanitizeName case.Name) + else + Expression.newExpression ( + Expression.Identifier union_cons, + [| Expression.Literal tag; passedArgs |], + typeArguments = consTypeArgs + )) |> Statement.returnStatement |] @@ -4135,7 +4207,21 @@ but thanks to the optimisation done below we get ) |] - let classMembers = Array.append [| cases |] classMembers + let singletonMembers = + ent.UnionCases + |> List.mapi (fun i case -> i, case) + |> List.choose (fun (i, case) -> + if List.isEmpty case.UnionCaseFields then + makeUnionCaseSingletonMember com entName entParamsDecl.Length (Some i) case + |> Some + else + None + ) + |> List.toArray + + let classMembers = + Array.append [| cases |] (Array.append singletonMembers classMembers) + declareType com ctx ent entName doc args body baseExpr classMembers let transformClassWithCompilerGeneratedConstructor diff --git a/tests/Js/Main/UnionTypeTests.fs b/tests/Js/Main/UnionTypeTests.fs index 81ff2bb435..3d714753b4 100644 --- a/tests/Js/Main/UnionTypeTests.fs +++ b/tests/Js/Main/UnionTypeTests.fs @@ -278,4 +278,11 @@ let tests = testCase "sprintf formats strings cases correctly" <| fun () -> let s = sprintf "%A" (S "1") equal s "S \"1\"" + + testCase "Union cases with no fields are physically equal" <| fun () -> + obj.ReferenceEquals(Gender.Male, Gender.Male) |> equal true + obj.ReferenceEquals(Gender.Male, Gender.Female) |> equal false + obj.ReferenceEquals(TestUnion.Case0, TestUnion.Case0) |> equal true + obj.ReferenceEquals(TestUnion.Case1 "a", TestUnion.Case1 "a") |> equal false + obj.ReferenceEquals(T1, T1) |> equal true ] From 53537783b545a190c52b2a1e0da1c2a6d2383168 Mon Sep 17 00:00:00 2001 From: Mangel Maxime Date: Mon, 6 Jul 2026 22:47:25 +0200 Subject: [PATCH 2/2] fix(python): represent union cases with no fields as singletons --- .../Python/Fable2Python.Transforms.fs | 69 ++++++++++++++++--- tests/Beam/UnionTypeTests.fs | 17 +++++ tests/Python/TestUnionType.fs | 10 +++ 3 files changed, 85 insertions(+), 11 deletions(-) diff --git a/src/Fable.Transforms/Python/Fable2Python.Transforms.fs b/src/Fable.Transforms/Python/Fable2Python.Transforms.fs index 321046c41a..d5d76ec003 100644 --- a/src/Fable.Transforms/Python/Fable2Python.Transforms.fs +++ b/src/Fable.Transforms/Python/Fable2Python.Transforms.fs @@ -116,6 +116,10 @@ let getUnionCaseName (uci: Fable.UnionCase) = | Some cname -> cname | None -> uci.Name +/// Attribute holding the precomputed singleton instance of a zero-field union case (see transformUnion). +let unionCaseSingletonAttrName = "singleton" +let unionCaseSingletonAttr = Identifier unionCaseSingletonAttrName + /// Gets the unique case class name by prefixing with the union type name. /// This prevents collisions when different union types have cases with the same name. /// Library types (Result, Choice) use simple case names without prefix. @@ -555,7 +559,13 @@ let transformValue (com: IPythonCompiler) (ctx: Context) r value : Expression * // Local - just get identifier com.GetIdentifierAsExpr(ctx, caseClassName) - Expression.call (caseRef, values, ?loc = r), stmts + // fsc represents a union case with no fields as a single shared instance, so e.g. + // `LanguagePrimitives.PhysicalEquality X.A X.A` is true. Mirror that by reusing the + // precomputed singleton instead of constructing a new instance. + if not (isLibraryUnionType entRef.FullName) && List.isEmpty uci.UnionCaseFields then + Expression.attribute (caseRef, unionCaseSingletonAttr), stmts + else + Expression.call (caseRef, values, ?loc = r), stmts | _ -> failwith $"transformValue: value %A{value} not supported!" let extractBaseExprFromBaseCall (com: IPythonCompiler) (ctx: Context) (baseType: Fable.DeclaredType option) baseCall = @@ -4069,7 +4079,8 @@ let transformUnion (com: IPythonCompiler) ctx (ent: Fable.Entity) (entName: stri // Generate case classes with @tagged_union decorator let caseClasses = ent.UnionCases - |> List.mapi (fun tag uci -> + |> List.indexed + |> List.collect (fun (tag, uci) -> // Use full case class name (UnionName_CaseName) to avoid collisions // Pass the entity name to ensure consistent scoping with base class let caseClassName = getUnionCaseClassName com ent uci (Some entName) @@ -4109,10 +4120,28 @@ let transformUnion (com: IPythonCompiler) ctx (ent: Fable.Entity) (entName: stri Statement.annAssign (target, annotation = ta, simple = true) ) + // Declare the singleton as a ClassVar (assigned below, once the class exists) so + // Pyright recognizes the attribute; ClassVar is excluded from dataclass fields. + // The type is a quoted forward reference since the class isn't defined yet here. + let singletonAnnotation = + if List.isEmpty uci.UnionCaseFields then + let classVar = com.GetImportExpr(ctx, "typing", "ClassVar") + let selfType = Expression.stringConstant caseClassName + let classVarAnnotation = Expression.subscript (classVar, selfType) + + [ + Statement.annAssign ( + Expression.name unionCaseSingletonAttrName, + annotation = classVarAnnotation + ) + ] + else + [] + let caseClassBody = - match fieldAnnotations with + match fieldAnnotations @ singletonAnnotation with | [] -> [ Statement.ellipsis ] - | _ -> fieldAnnotations + | body -> body // The case class inherits from the parameterized base union class // e.g., class Either_Left[TL, TR](_Either_2[TL, TR]): ... @@ -4120,13 +4149,31 @@ let transformUnion (com: IPythonCompiler) ctx (ent: Fable.Entity) (entName: stri Expression.name ("_" + entName) |> Annotation.makeGenericParamSubscript genParamNames - Statement.classDef ( - caseClassIdent, - bases = [ baseClassExpr ], - body = caseClassBody, - decoratorList = [ taggedUnionDecorator ], - typeParams = typeParams - ) + let caseClassDef = + Statement.classDef ( + caseClassIdent, + bases = [ baseClassExpr ], + body = caseClassBody, + decoratorList = [ taggedUnionDecorator ], + typeParams = typeParams + ) + + // fsc represents a union case with no fields as a single shared instance, so e.g. + // `LanguagePrimitives.PhysicalEquality X.A X.A` is true. Mirror that by precomputing + // one instance and reusing it (see the NewUnion case above) instead of constructing + // a new one on every access. + let singletonDecl = + if List.isEmpty uci.UnionCaseFields then + let target = + Expression.attribute (Expression.name caseClassIdent, unionCaseSingletonAttr, Store) + + [ + Statement.assign ([ target ], Expression.call (Expression.name caseClassIdent, [])) + ] + else + [] + + caseClassDef :: singletonDecl ) // Generate type alias: type MyUnion[T] = MyUnion_CaseA[T] | MyUnion_CaseB[T] | ... diff --git a/tests/Beam/UnionTypeTests.fs b/tests/Beam/UnionTypeTests.fs index bfcdb153dc..c0d71a8dc5 100644 --- a/tests/Beam/UnionTypeTests.fs +++ b/tests/Beam/UnionTypeTests.fs @@ -37,6 +37,8 @@ type StructPoint2D = type WrappedUnion = | AString of string +type T1 = T1 + type DeepRecord = { Value: string } type DeepWrappedUnion = @@ -339,3 +341,18 @@ let ``test Match with condition works`` () = let b2 = DeepWrappedB "not" b1 |> matchStringWhenNotHello |> equal "hello" b2 |> matchStringWhenNotHello |> equal "not hello" + +[] +let ``test Union cases with no fields are physically equal`` () = + // Nullary cases compile to plain atoms, which the BEAM VM interns, so this matches fsc. + obj.ReferenceEquals(Male, Male) |> equal true + obj.ReferenceEquals(Male, Female) |> equal false + obj.ReferenceEquals(Case0, Case0) |> equal true + obj.ReferenceEquals(T1, T1) |> equal true +#if FABLE_COMPILER + // Unlike fsc, Erlang has no reference identity for compound terms (only atoms are + // interned), so `=:=` here is structural equality, unlike .NET reference equality. + obj.ReferenceEquals(Case1 "a", Case1 "a") |> equal true +#else + obj.ReferenceEquals(Case1 "a", Case1 "a") |> equal false +#endif diff --git a/tests/Python/TestUnionType.fs b/tests/Python/TestUnionType.fs index ec6ab1c3f0..2336d44c52 100644 --- a/tests/Python/TestUnionType.fs +++ b/tests/Python/TestUnionType.fs @@ -4,6 +4,8 @@ open Util.Testing type Gender = Male | Female +type T1 = T1 + type Either<'TL,'TR> = | Left of 'TL | Right of 'TR @@ -225,3 +227,11 @@ let ``test Named union case fields work when a field is called name`` () = | NamedCase(name, optional) -> name |> equal "v1" optional |> equal "v2" + +[] +let ``test Union cases with no fields are physically equal`` () = + obj.ReferenceEquals(Gender.Male, Gender.Male) |> equal true + obj.ReferenceEquals(Gender.Male, Gender.Female) |> equal false + obj.ReferenceEquals(MyUnion.Case0, MyUnion.Case0) |> equal true + obj.ReferenceEquals(MyUnion.Case1 "a", MyUnion.Case1 "a") |> equal false + obj.ReferenceEquals(T1, T1) |> equal true