diff --git a/src/Fable.Core/Fable.Core.Types.fs b/src/Fable.Core/Fable.Core.Types.fs index 76513ceaf9..ee88daa511 100644 --- a/src/Fable.Core/Fable.Core.Types.fs +++ b/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. +[] +type NoReflectionAttribute() = + inherit Attribute() + /// Used for "tagged" union types, which is commonly used in TypeScript. type TypeScriptTaggedUnionAttribute(tagName: string, caseRules: CaseRules) = inherit Attribute() diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index 0fd6abddb7..beacafa7c0 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/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 diff --git a/src/Fable.Transforms/Fable2Babel.fs b/src/Fable.Transforms/Fable2Babel.fs index c81b1d3708..4b8757e8a0 100644 --- a/src/Fable.Transforms/Fable2Babel.fs +++ b/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 diff --git a/src/Fable.Transforms/Transforms.Util.fs b/src/Fable.Transforms/Transforms.Util.fs index 9deb258aca..e02cc845fb 100644 --- a/src/Fable.Transforms/Transforms.Util.fs +++ b/src/Fable.Transforms/Transforms.Util.fs @@ -29,6 +29,7 @@ module Atts = let [] paramObject = "Fable.Core.ParamObjectAttribute"// typeof.FullName let [] decorator = "Fable.Core.JS.DecoratorAttribute" // typeof.FullName let [] reflectedDecorator = "Fable.Core.JS.ReflectedDecoratorAttribute" // typeof.FullName + let [] noReflection = "Fable.Core.NoReflectionAttribute" [] module Types = diff --git a/src/fable-library/Types.ts b/src/fable-library/Types.ts index 033de2765f..dbc9d153d0 100644 --- a/src/fable-library/Types.ts +++ b/src/fable-library/Types.ts @@ -54,6 +54,49 @@ export function unionToString(name: string, fields: any[]) { } } +export class CommonUnion implements IEquatable, IComparable { + 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, IComparable { public tag!: number; public fields!: any[];