Moved type erase to the end

fable-compiler · Mar 6, 2021 · dcbdd1b · dcbdd1b
1 parent 3ed9e4f
commit dcbdd1b
Show file tree

Hide file tree

Showing 13 changed files with 288 additions and 288 deletions.
diff --git a/.vscode/launch.json b/.vscode/launch.json
@@ -56,7 +56,13 @@
         {
             "type": "node",
             "request": "launch",
-            "name": "Run bench-compiler tests",
+            "name": "Run bench-compiler JS test",
+            "program": "${workspaceFolder}/src/fable-standalone/test/bench-compiler/out-test/src/test.js"
+        },
+        {
+            "type": "node",
+            "request": "launch",
+            "name": "Run bench-compiler JS tests",
             "program": "${workspaceFolder}/node_modules/mocha/bin/_mocha",
             "args": ["out-tests", "-r", "esm"],
             "cwd": "${workspaceRoot}/src/fable-standalone/test/bench-compiler"
@@ -67,7 +73,7 @@
             "name": "Run bench-compiler (Node)",
             "program": "${workspaceRoot}/src/fable-standalone/test/bench-compiler/out-node/app.js",
             // "args": ["${workspaceRoot}/tests/Main/Fable.Tests.fsproj", "out-tests"],
-            "args": ["${workspaceRoot}/../fable-test/fable-test.fsproj", "out-test", "--typescript"],
+            "args": ["${workspaceRoot}/../fable-test/fable-test.fsproj", "out-test", "--eraseTypes"],
             "cwd": "${workspaceRoot}/src/fable-standalone/test/bench-compiler"
         },
         {
@@ -89,11 +95,5 @@
             "args": ["${workspaceRoot}/tests/Main/Fable.Tests.fsproj", "build/tests-js"],
             "stopOnEntry": true
         },
-        {
-            "type": "node",
-            "request": "launch",
-            "name": "Run standalone test",
-            "program": "${workspaceFolder}/src/fable-standalone/test/bench-compiler/out-test/src/test.js"
-        },
     ]
 }
diff --git a/src/Fable.AST/Fable.fs b/src/Fable.AST/Fable.fs
@@ -33,6 +33,7 @@ type Field =
 
 type UnionCase =
     abstract Name: string
+    abstract FullName: string
     abstract CompiledName: string option
     abstract UnionCaseFields: Field list
 
@@ -266,7 +267,7 @@ type KeyKind =
 type GetKind =
     | ByKey of KeyKind
     | TupleIndex of int
-    | FieldIndex of string * int
+    | FieldGet of Field * index: int
     | UnionField of index: int * fieldType: Type
     | UnionTag
     | ListHead
@@ -275,7 +276,7 @@ type GetKind =
 
 type SetKind =
     | ByKeySet of KeyKind
-    | FieldIndexSet of string * int
+    | FieldSet of Field * index: int
     | ValueSet
 
 type TestKind =

diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs
@@ -48,8 +48,15 @@ type FsUnionCase(uci: FSharpUnionCase) =
         |> Helpers.tryFindAtt Atts.compiledName
         |> Option.map (fun (att: FSharpAttribute) -> att.ConstructorArguments.[0] |> snd |> string)
 
+    static member FullName (uci: FSharpUnionCase) =
+        // proper full compiled name (instead of uci.FullName)
+        uci.XmlDocSig
+        |> Naming.replacePrefix "T:Microsoft.FSharp." "FSharp."
+        |> Naming.replacePrefix "T:" ""
+
     interface Fable.UnionCase with
         member _.Name = uci.Name
+        member _.FullName = FsUnionCase.FullName uci
         member _.CompiledName = FsUnionCase.CompiledName uci
         member _.UnionCaseFields = uci.UnionCaseFields |> Seq.mapToList (fun x -> upcast FsField(x))
 
@@ -437,8 +444,8 @@ module Helpers =
         Some (makeRange fsExpr.Range)
 
     let isErasedTypeDef (com: Compiler) (tdef: FSharpEntity) =
-        com.Options.EraseTypes
-        && (tdef.IsFSharpUnion || tdef.IsFSharpRecord) // || tdef.IsValueType)
+        com.Options.EraseTypes && tdef.IsFSharp
+        && (tdef.IsFSharpUnion || tdef.IsFSharpRecord || tdef.IsValueType || tdef.IsByRef)
         && not (tdef.TryFullName = Some Types.reference) // no F# refs
         && not (hasAttribute Atts.customEquality tdef.Attributes)
         && not (hasAttribute Atts.customComparison tdef.Attributes)
@@ -691,52 +698,33 @@ module Patterns =
             | _ -> None
         else None
 
-    [<RequireQualifiedAccess>]
-    type EraseKind =
-        | AsValue
-        | AsTuple
-        | AsNamedTuple
-        | AsStringEnum of CaseRules
-
-    let (|OptionUnion|ListUnion|ErasedUnion|DiscriminatedUnion|)
-            (com: Compiler, NonAbbreviatedType typ: FSharpType, unionCase: FSharpUnionCase) =
-
+    let (|OptionUnion|ListUnion|ErasedUnion|ErasedUnionCase|StringEnum|DiscriminatedUnion|)
+                            (NonAbbreviatedType typ: FSharpType, unionCase: FSharpUnionCase) =
         let getCaseRule (att: FSharpAttribute) =
             match Seq.tryHead att.ConstructorArguments with
             | Some(_, (:? int as rule)) -> enum<CaseRules>(rule)
             | _ -> CaseRules.LowerFirst
 
-        let getEraseKind (tdef: FSharpEntity) (att: FSharpAttribute) =
-            match unionCase.UnionCaseFields.Count with
-            | 0 -> EraseKind.AsStringEnum(getCaseRule att)
-            | 1 -> EraseKind.AsValue
-            | _ -> EraseKind.AsTuple
-
-        match tryDefinition typ with
-        | None -> failwith "Union without definition"
-        | Some(tdef, fullName) ->
-            match defaultArg fullName tdef.CompiledName with
-            | Types.valueOption
-            | Types.option -> OptionUnion(typ.GenericArguments.[0])
-            | Types.list -> ListUnion(typ.GenericArguments.[0])
-            | _ ->
-                unionCase.Attributes |> Seq.tryPick (fun att ->
-                    match att.AttributeType.TryFullName with
-                    | Some Atts.erase ->
-                        Some (ErasedUnion(EraseKind.AsTuple, tdef, typ.GenericArguments))
-                    | _ -> None)
-                |> Option.orElseWith (fun () ->
+        unionCase.Attributes |> Seq.tryPick (fun att ->
+            match att.AttributeType.TryFullName with
+            | Some Atts.erase -> Some ErasedUnionCase
+            | _ -> None)
+        |> Option.defaultWith (fun () ->
+            match tryDefinition typ with
+            | None -> failwith "Union without definition"
+            | Some(tdef, fullName) ->
+                match defaultArg fullName tdef.CompiledName with
+                | Types.valueOption
+                | Types.option -> OptionUnion typ.GenericArguments.[0]
+                | Types.list -> ListUnion typ.GenericArguments.[0]
+                | _ ->
                     tdef.Attributes |> Seq.tryPick (fun att ->
                         match att.AttributeType.TryFullName with
-                        | Some Atts.erase
-                        | Some Atts.stringEnum ->
-                            let kind = getEraseKind tdef att
-                            Some (ErasedUnion(kind, tdef, typ.GenericArguments))
-                        | _ -> None))
-                |> Option.defaultWith (fun () ->
-                    if isErasedType com typ
-                    then ErasedUnion(EraseKind.AsNamedTuple, tdef, typ.GenericArguments)
-                    else DiscriminatedUnion(tdef, typ.GenericArguments))
+                        | Some Atts.erase -> Some (ErasedUnion(tdef, typ.GenericArguments, getCaseRule att))
+                        | Some Atts.stringEnum -> Some (StringEnum(tdef, getCaseRule att))
+                        | _ -> None)
+                    |> Option.defaultValue (DiscriminatedUnion(tdef, typ.GenericArguments))
+        )
 
     let (|ContainsAtt|_|) (fullName: string) (ent: FSharpEntity) =
         tryFindAtt fullName ent.Attributes
@@ -868,7 +856,8 @@ module TypeHelpers =
             Fable.LambdaType(argType, returnType)
         elif t.IsAnonRecordType then
             let genArgs = makeGenArgs ctxTypeArgs t.GenericArguments
-            Fable.AnonymousRecordType(t.AnonRecordTypeDetails.SortedFieldNames, genArgs)
+            let fields = t.AnonRecordTypeDetails.SortedFieldNames
+            Fable.AnonymousRecordType(fields, genArgs)
         elif t.HasTypeDefinition then
 // No support for provided types when compiling FCS+Fable to JS
 #if !FABLE_COMPILER
@@ -1068,7 +1057,6 @@ module Util =
             | None -> None
         Fable.TryCatch(body, catchClause, finalizer, r)
 
-
     let matchGenericParamsFrom (memb: FSharpMemberOrFunctionOrValue) (genArgs: Fable.Type seq) =
         let matchGenericParams (genArgs: Fable.Type seq) (genParams: FSharpGenericParameter seq) =
             Seq.zip (genParams |> Seq.map genParamName) genArgs
@@ -1177,7 +1165,8 @@ module Util =
 
     let isErasedEntity (com: Compiler) (ent: Fable.Entity) =
         match ent with
-        | :? FsEnt as fsEnt -> Helpers.isErasedTypeDef com fsEnt.FSharpEntity
+        | :? FsEnt as fsEnt ->
+            Helpers.isErasedTypeDef com fsEnt.FSharpEntity
         | _ -> false
 
     let isErasedOrStringEnumEntity (ent: Fable.Entity) =