Add NoReflectionAttribute

src/Fable.Core/Fable.Core.Types.fs

@@ -30,6 +30,13 @@ type EraseAttribute() =
     inherit Attribute()
     new (caseRules: CaseRules) = EraseAttribute()
 
+/// Used on unions or records to disable emitting code required to support reflection.
+/// Reflection of unions or records that reference a type with this attribute may cause runtime errors.
+/// Unions also reuse the same base class instead of having a specialized class for each.
+[<AttributeUsage(AttributeTargets.Class)>]
+type NoReflectionAttribute() =
+    inherit Attribute()
+
 /// Used for "tagged" union types, which is commonly used in TypeScript.
 type TypeScriptTaggedUnionAttribute(tagName: string, caseRules: CaseRules) =
     inherit Attribute()

src/Fable.Transforms/FSharp2Fable.Util.fs

@@ -1528,6 +1528,9 @@ module Util =
             | Atts.erase | Atts.stringEnum | Atts.tsTaggedUnion -> true
             | _ -> false)
 
+    let isNoReflectionEntity (ent: Fable.Entity) =
+        ent.Attributes |> Seq.exists (fun att -> att.Entity.FullName = Atts.noReflection)
+
     let isGlobalOrImportedEntity (ent: Fable.Entity) =
         ent.Attributes |> Seq.exists (fun att ->
             match att.Entity.FullName with

src/Fable.Transforms/Fable2Babel.fs

@@ -249,6 +249,11 @@ module Reflection =
                 elif ent.IsMeasure then
                     [| Expression.stringLiteral(ent.FullName) |]
                     |> libReflectionCall com ctx None "measure"
+                elif FSharp2Fable.Util.isNoReflectionEntity ent then
+                    $"{ent.FullName} is annotated with NoReflectionAttribute, but is being used in types which support reflection. This may lead to runtime errors."
+                    |> addWarning com [] r
+
+                    Expression.nullLiteral()
                 else
                     let reflectionMethodExpr = FSharp2Fable.Util.entityRefWithSuffix com ent Naming.reflectionSuffix
                     let callee = com.TransformAsExpr(ctx, reflectionMethodExpr)
@@ -1025,14 +1030,18 @@ module Util =
         | Fable.NewUnion(values, tag, ent, genArgs) ->
             let ent = com.GetEntity(ent)
             let values = List.map (fun x -> com.TransformAsExpr(ctx, x)) values
-            let consRef = ent |> jsConstructor com ctx
-            let typeParamInst =
-                if com.Options.Language = TypeScript
-                then makeGenTypeParamInst com ctx genArgs
-                else None
             // let caseName = ent.UnionCases |> List.item tag |> getUnionCaseName |> ofString
             let values = (ofInt tag)::values |> List.toArray
-            Expression.newExpression(consRef, values, ?typeArguments=typeParamInst, ?loc=r)
+
+            if FSharp2Fable.Util.isNoReflectionEntity ent then
+                libConsCall com ctx r "Types" "CommonUnion" values
+            else
+                let consRef = ent |> jsConstructor com ctx
+                let typeParamInst =
+                    if com.Options.Language = TypeScript
+                    then makeGenTypeParamInst com ctx genArgs
+                    else None
+                Expression.newExpression(consRef, values, ?typeArguments=typeParamInst, ?loc=r)
 
     let enumerator2iterator com ctx =
         let enumerator = Expression.callExpression(get None (Expression.identifier("this")) "GetEnumerator", [||])
@@ -1984,7 +1993,7 @@ module Util =
 
     let declareType (com: IBabelCompiler) ctx (ent: Fable.Entity) entName (consArgs: Pattern[]) (consBody: BlockStatement) baseExpr classMembers: ModuleDeclaration list =
         let typeDeclaration = declareClassType com ctx ent entName consArgs consBody baseExpr classMembers
-        if com.Options.NoReflection then
+        if com.Options.NoReflection || FSharp2Fable.Util.isNoReflectionEntity ent then
             [typeDeclaration]
         else
             let reflectionDeclaration =
@@ -2046,36 +2055,40 @@ module Util =
         |]
 
     let transformUnion (com: IBabelCompiler) ctx (ent: Fable.Entity) (entName: string) classMembers =
-        let fieldIds = getUnionFieldsAsIdents com ctx ent
-        let args =
-            [| typedIdent com ctx fieldIds.[0] |> Pattern.Identifier
-               typedIdent com ctx fieldIds.[1] |> Pattern.Identifier |> restElement |]
-        let body =
-            BlockStatement([|
-                yield callSuperAsStatement []
-                yield! fieldIds |> Array.map (fun id ->
-                    let left = get None thisExpr id.Name
-                    let right =
-                        match id.Type with
-                        | Fable.Number _ ->
-                            Expression.binaryExpression(BinaryOrBitwise, identAsExpr id, Expression.numericLiteral(0.))
-                        | _ -> identAsExpr id
-                    assign None left right |> ExpressionStatement)
-            |])
-        let cases =
+        // NoReflection unions do not get their own classes but share CommonUnion
+        if FSharp2Fable.Util.isNoReflectionEntity ent then
+            []
+        else
+            let fieldIds = getUnionFieldsAsIdents com ctx ent
+            let args =
+                [| typedIdent com ctx fieldIds.[0] |> Pattern.Identifier
+                   typedIdent com ctx fieldIds.[1] |> Pattern.Identifier |> restElement |]
             let body =
-                ent.UnionCases
-                |> Seq.map (getUnionCaseName >> makeStrConst)
-                |> Seq.toList
-                |> makeArray com ctx
-                |>  Statement.returnStatement
-                |> Array.singleton
-                |> BlockStatement
-            ClassMember.classMethod(ClassFunction, Expression.identifier("cases"), [||], body)
-
-        let baseExpr = libValue com ctx "Types" "Union" |> Some
-        let classMembers = Array.append [|cases|] classMembers
-        declareType com ctx ent entName args body baseExpr classMembers
+                BlockStatement([|
+                    yield callSuperAsStatement []
+                    yield! fieldIds |> Array.map (fun id ->
+                        let left = get None thisExpr id.Name
+                        let right =
+                            match id.Type with
+                            | Fable.Number _ ->
+                                Expression.binaryExpression(BinaryOrBitwise, identAsExpr id, Expression.numericLiteral(0.))
+                            | _ -> identAsExpr id
+                        assign None left right |> ExpressionStatement)
+                |])
+            let cases =
+                let body =
+                    ent.UnionCases
+                    |> Seq.map (getUnionCaseName >> makeStrConst)
+                    |> Seq.toList
+                    |> makeArray com ctx
+                    |>  Statement.returnStatement
+                    |> Array.singleton
+                    |> BlockStatement
+                ClassMember.classMethod(ClassFunction, Expression.identifier("cases"), [||], body)
+
+            let baseExpr = libValue com ctx "Types" "Union" |> Some
+            let classMembers = Array.append [|cases|] classMembers
+            declareType com ctx ent entName args body baseExpr classMembers
 
     let transformClassWithCompilerGeneratedConstructor (com: IBabelCompiler) ctx (ent: Fable.Entity) (entName: string) classMembers =
         let fieldIds = getEntityFieldsAsIdents com ent

src/Fable.Transforms/Transforms.Util.fs

@@ -29,6 +29,7 @@ module Atts =
     let [<Literal>] paramObject = "Fable.Core.ParamObjectAttribute"// typeof<Fable.Core.ParamObjectAttribute>.FullName
     let [<Literal>] decorator = "Fable.Core.JS.DecoratorAttribute" // typeof<Fable.Core.JS.DecoratorAttribute>.FullName
     let [<Literal>] reflectedDecorator = "Fable.Core.JS.ReflectedDecoratorAttribute" // typeof<Fable.Core.JS.ReflectedDecoratorAttribute>.FullName
+    let [<Literal>] noReflection = "Fable.Core.NoReflectionAttribute"
 
 [<RequireQualifiedAccess>]
 module Types =

src/fable-library/Types.ts

@@ -54,6 +54,49 @@ export function unionToString(name: string, fields: any[]) {
   }
 }
 
+export class CommonUnion implements IEquatable<CommonUnion>, IComparable<CommonUnion> {
+  public tag!: number;
+  public fields!: any[];
+
+  public toJSON() {
+    return this.fields.length === 0 ? String(this.tag) : [String(this.tag)].concat(this.fields);
+  }
+
+  public toString() {
+    return unionToString(String(this.tag), this.fields);
+  }
+
+  public GetHashCode() {
+    const hashes = this.fields.map((x: any) => structuralHash(x));
+    hashes.splice(0, 0, numberHash(this.tag));
+    return combineHashCodes(hashes);
+  }
+
+  public Equals(other: CommonUnion) {
+    if (this === other) {
+      return true;
+    } else if (!sameConstructor(this, other)) {
+      return false;
+    } else if (this.tag === other.tag) {
+      return equalArrays(this.fields, other.fields);
+    } else {
+      return false;
+    }
+  }
+
+  public CompareTo(other: CommonUnion) {
+    if (this === other) {
+      return 0;
+    } else if (!sameConstructor(this, other)) {
+      return -1;
+    } else if (this.tag === other.tag) {
+      return compareArrays(this.fields, other.fields);
+    } else {
+      return this.tag < other.tag ? -1 : 1;
+    }
+  }
+}
+
 export abstract class Union implements IEquatable<Union>, IComparable<Union> {
   public tag!: number;
   public fields!: any[];