Reflection free code gen (#12960)

Added --reflectionfree compiler flag to avoid %A string formatting

Author: dsyme

src/Compiler/Checking/CheckFormatStrings.fs

@@ -444,6 +444,9 @@ let parseFormatStringInternal
                   parseLoop ((posi, NewInferenceType g) :: acc) (i, fragLine, startFragCol) fragments
 
               | 'A' ->
+                  if g.useReflectionFreeCodeGen then
+                      failwith (FSComp.SR.forPercentAInReflectionFreeCode())
+
                   match info.numPrefixIfPos with
                   | None     // %A has BindingFlags=Public, %+A has BindingFlags=Public | NonPublic
                   | Some '+' -> 

src/Compiler/CodeGen/IlxGen.fs

@@ -288,6 +288,9 @@ type IlxGenOptions =
         /// storage, even though 'it' is not logically mutable
         isInteractiveItExpr: bool
 
+        /// Suppress ToString emit
+        useReflectionFreeCodeGen: bool
+
         /// Whenever possible, use callvirt instead of call
         alwaysCallVirt: bool
     }
@@ -10449,64 +10452,65 @@ and GenPrintingMethod cenv eenv methName ilThisTy m =
     let g = cenv.g
 
     [
-        match (eenv.valsInScope.TryFind g.sprintf_vref.Deref, eenv.valsInScope.TryFind g.new_format_vref.Deref) with
-        | Some (Lazy (Method (_, _, sprintfMethSpec, _, _, _, _, _, _, _, _, _))),
-          Some (Lazy (Method (_, _, newFormatMethSpec, _, _, _, _, _, _, _, _, _))) ->
-            // The type returned by the 'sprintf' call
-            let funcTy = EraseClosures.mkILFuncTy cenv.ilxPubCloEnv ilThisTy g.ilg.typ_String
-
-            // Give the instantiation of the printf format object, i.e. a Format`5 object compatible with StringFormat<ilThisTy>
-            let newFormatMethSpec =
-                mkILMethSpec (
-                    newFormatMethSpec.MethodRef,
-                    AsObject,
-                    [ // 'T -> string'
-                        funcTy
-                        // rest follow from 'StringFormat<T>'
-                        GenUnitTy cenv eenv m
-                        g.ilg.typ_String
-                        g.ilg.typ_String
-                        ilThisTy
-                    ],
-                    []
-                )
-
-            // Instantiate with our own type
-            let sprintfMethSpec =
-                mkILMethSpec (sprintfMethSpec.MethodRef, AsObject, [], [ funcTy ])
+        if not g.useReflectionFreeCodeGen then
+            match (eenv.valsInScope.TryFind g.sprintf_vref.Deref, eenv.valsInScope.TryFind g.new_format_vref.Deref) with
+            | Some (Lazy (Method (_, _, sprintfMethSpec, _, _, _, _, _, _, _, _, _))),
+              Some (Lazy (Method (_, _, newFormatMethSpec, _, _, _, _, _, _, _, _, _))) ->
+                // The type returned by the 'sprintf' call
+                let funcTy = EraseClosures.mkILFuncTy cenv.ilxPubCloEnv ilThisTy g.ilg.typ_String
+
+                // Give the instantiation of the printf format object, i.e. a Format`5 object compatible with StringFormat<ilThisTy>
+                let newFormatMethSpec =
+                    mkILMethSpec (
+                        newFormatMethSpec.MethodRef,
+                        AsObject,
+                        [ // 'T -> string'
+                            funcTy
+                            // rest follow from 'StringFormat<T>'
+                            GenUnitTy cenv eenv m
+                            g.ilg.typ_String
+                            g.ilg.typ_String
+                            ilThisTy
+                        ],
+                        []
+                    )
 
-            // Here's the body of the method. Call printf, then invoke the function it returns
-            let callInstrs =
-                EraseClosures.mkCallFunc
-                    cenv.ilxPubCloEnv
-                    (fun _ -> 0us)
-                    eenv.tyenv.Count
-                    Normalcall
-                    (Apps_app(ilThisTy, Apps_done g.ilg.typ_String))
-
-            let ilInstrs =
-                [ // load the hardwired format string
-                    I_ldstr "%+A"
-                    // make the printf format object
-                    mkNormalNewobj newFormatMethSpec
-                    // call sprintf
-                    mkNormalCall sprintfMethSpec
-                    // call the function returned by sprintf
-                    mkLdarg0
-                    if ilThisTy.Boxity = ILBoxity.AsValue then
-                        mkNormalLdobj ilThisTy
-                    yield! callInstrs
-                ]
+                // Instantiate with our own type
+                let sprintfMethSpec =
+                    mkILMethSpec (sprintfMethSpec.MethodRef, AsObject, [], [ funcTy ])
+
+                // Here's the body of the method. Call printf, then invoke the function it returns
+                let callInstrs =
+                    EraseClosures.mkCallFunc
+                        cenv.ilxPubCloEnv
+                        (fun _ -> 0us)
+                        eenv.tyenv.Count
+                        Normalcall
+                        (Apps_app(ilThisTy, Apps_done g.ilg.typ_String))
+
+                let ilInstrs =
+                    [ // load the hardwired format string
+                        I_ldstr "%+A"
+                        // make the printf format object
+                        mkNormalNewobj newFormatMethSpec
+                        // call sprintf
+                        mkNormalCall sprintfMethSpec
+                        // call the function returned by sprintf
+                        mkLdarg0
+                        if ilThisTy.Boxity = ILBoxity.AsValue then
+                            mkNormalLdobj ilThisTy
+                        yield! callInstrs
+                    ]
 
-            let ilMethodBody =
-                mkMethodBody (true, [], 2, nonBranchingInstrsToCode ilInstrs, None, eenv.imports)
+                let ilMethodBody =
+                    mkMethodBody (true, [], 2, nonBranchingInstrsToCode ilInstrs, None, eenv.imports)
 
-            let mdef =
-                mkILNonGenericVirtualInstanceMethod (methName, ILMemberAccess.Public, [], mkILReturn g.ilg.typ_String, ilMethodBody)
+                let mdef =
+                    mkILNonGenericVirtualInstanceMethod (methName, ILMemberAccess.Public, [], mkILReturn g.ilg.typ_String, ilMethodBody)
 
-            let mdef = mdef.With(customAttrs = mkILCustomAttrs [ g.CompilerGeneratedAttribute ])
-            yield mdef
-        | _ -> ()
+                let mdef = mdef.With(customAttrs = mkILCustomAttrs [ g.CompilerGeneratedAttribute ])
+                yield mdef
+            | _ -> ()
     ]
 
 and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) =
@@ -10646,6 +10650,8 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) =
 
             let tyconRepr = tycon.TypeReprInfo
 
+            let reprAccess = ComputeMemberAccess hiddenRepr
+
             // DebugDisplayAttribute gets copied to the subtypes generated as part of DU compilation
             let debugDisplayAttrs, normalAttrs =
                 tycon.Attribs
@@ -10656,7 +10662,10 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) =
                 |> List.partition (fun a -> IsSecurityAttribute g cenv.amap cenv.casApplied a m)
 
             let generateDebugDisplayAttribute =
-                not g.compilingFSharpCore && tycon.IsUnionTycon && isNil debugDisplayAttrs
+                not g.useReflectionFreeCodeGen
+                && not g.compilingFSharpCore
+                && tycon.IsUnionTycon
+                && isNil debugDisplayAttrs
 
             let generateDebugProxies =
                 not (tyconRefEq g tcref g.unit_tcr_canon)
@@ -10687,8 +10696,6 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) =
                     yield! ilDebugDisplayAttributes
                 ]
 
-            let reprAccess = ComputeMemberAccess hiddenRepr
-
             let ilTypeDefKind =
                 match tyconRepr with
                 | TFSharpObjectRepr o ->

src/Compiler/CodeGen/IlxGen.fsi

@@ -54,6 +54,9 @@ type internal IlxGenOptions =
         /// storage, even though 'it' is not logically mutable
         isInteractiveItExpr: bool
 
+        /// Suppress ToString emit
+        useReflectionFreeCodeGen: bool
+
         /// Indicates that, whenever possible, use callvirt instead of call
         alwaysCallVirt: bool
     }

src/Compiler/Driver/CompilerConfig.fs

@@ -527,6 +527,9 @@ type TcConfigBuilder =
         /// If true, strip away data that would not be of use to end users, but is useful to us for debugging
         mutable noDebugAttributes: bool
 
+        /// If true, do not emit ToString implementations for unions, records, structs, exceptions
+        mutable useReflectionFreeCodeGen: bool
+
         /// If true, indicates all type checking and code generation is in the context of fsi.exe
         isInteractive: bool
 
@@ -730,6 +733,7 @@ type TcConfigBuilder =
             pause = false
             alwaysCallVirt = true
             noDebugAttributes = false
+            useReflectionFreeCodeGen = false
             emitDebugInfoInQuotations = false
             exename = None
             shadowCopyReferences = false
@@ -1279,6 +1283,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
     member _.pause = data.pause
     member _.alwaysCallVirt = data.alwaysCallVirt
     member _.noDebugAttributes = data.noDebugAttributes
+    member _.useReflectionFreeCodeGen = data.useReflectionFreeCodeGen
     member _.isInteractive = data.isInteractive
     member _.isInvalidationSupported = data.isInvalidationSupported
     member _.emitDebugInfoInQuotations = data.emitDebugInfoInQuotations

src/Compiler/Driver/CompilerConfig.fsi

@@ -431,6 +431,8 @@ type TcConfigBuilder =
 
         mutable noDebugAttributes: bool
 
+        mutable useReflectionFreeCodeGen: bool
+
         /// If true, indicates all type checking and code generation is in the context of fsi.exe
         isInteractive: bool
 
@@ -740,6 +742,7 @@ type TcConfig =
     member alwaysCallVirt: bool
 
     member noDebugAttributes: bool
+    member useReflectionFreeCodeGen: bool
 
     /// If true, indicates all type checking and code generation is in the context of fsi.exe
     member isInteractive: bool

src/Compiler/Driver/CompilerImports.fs

@@ -2410,6 +2410,7 @@ and [<Sealed>] TcImports
                     tcConfig.implicitIncludeDir,
                     tcConfig.mlCompatibility,
                     tcConfig.isInteractive,
+                    tcConfig.useReflectionFreeCodeGen,
                     tryFindSysTypeCcu,
                     tcConfig.emitDebugInfoInQuotations,
                     tcConfig.noDebugAttributes,

src/Compiler/Driver/CompilerOptions.fs

@@ -1054,6 +1054,13 @@ let codeGenerationFlags isFsi (tcConfigB: TcConfigBuilder) =
                 Some(FSComp.SR.optsCrossoptimize ())
             )
 
+            CompilerOption(
+                "reflectionfree",
+                tagNone,
+                OptionUnit(fun () -> tcConfigB.useReflectionFreeCodeGen <- true),
+                None,
+                Some(FSComp.SR.optsReflectionFree ())
+            )
         ]
 
     if isFsi then debug @ codegen else debug @ embed @ codegen

src/Compiler/Driver/OptimizeInputs.fs

@@ -251,6 +251,7 @@ let GenerateIlxCode
             mainMethodInfo = mainMethodInfo
             ilxBackend = ilxBackend
             fsiMultiAssemblyEmit = tcConfig.fsiMultiAssemblyEmit
+            useReflectionFreeCodeGen = tcConfig.useReflectionFreeCodeGen
             isInteractive = tcConfig.isInteractive
             isInteractiveItExpr = isInteractiveItExpr
             alwaysCallVirt = tcConfig.alwaysCallVirt

src/Compiler/FSComp.txt

@@ -235,6 +235,7 @@ forLIsUnnecessary,"The 'l' or 'L' in this format specifier is unnecessary. In F#
 forHIsUnnecessary,"The 'h' or 'H' in this format specifier is unnecessary. You can use %%d, %%x, %%o or %%u instead, which are overloaded to work with all basic integer types."
 forDoesNotSupportPrefixFlag,"'%s' does not support prefix '%s' flag"
 forBadFormatSpecifierGeneral,"Bad format specifier: '%s'"
+forPercentAInReflectionFreeCode,"The '%%A' format specifier may not be used in an assembly being compiled with option '--reflectionfree'. This construct implicitly uses reflection."
 elSysEnvExitDidntExit,"System.Environment.Exit did not exit"
 elDeprecatedOperator,"The treatment of this operator is now handled directly by the F# compiler and its meaning cannot be redefined"
 405,chkProtectedOrBaseCalled,"A protected member is called or 'base' is being used. This is only allowed in the direct implementation of members since they could escape their object scope."
@@ -873,6 +874,7 @@ optsRefOnly,"Produce a reference assembly, instead of a full assembly, as the pr
 optsRefOut,"Produce a reference assembly with the specified file path."
 optsPathMap,"Maps physical paths to source path names output by the compiler"
 optsCrossoptimize,"Enable or disable cross-module optimizations"
+optsReflectionFree,"Disable implicit generation of constructs using reflection"
 optsWarnaserrorPM,"Report all warnings as errors"
 optsWarnaserror,"Report specific warnings as errors"
 optsWarn,"Set a warning level (0-5)"

src/Compiler/TypedTree/TcGlobals.fs

@@ -191,6 +191,7 @@ type TcGlobals(
     directoryToResolveRelativePaths,
     mlCompatibility: bool,
     isInteractive: bool,
+    useReflectionFreeCodeGen: bool,
     // The helper to find system types amongst referenced DLLs
     tryFindSysTypeCcu,
     emitDebugInfoInQuotations: bool,
@@ -1004,6 +1005,8 @@ type TcGlobals(
 
   member _.compilingFSharpCore = compilingFSharpCore
 
+  member _.useReflectionFreeCodeGen = useReflectionFreeCodeGen
+
   member _.mlCompatibility = mlCompatibility
 
   member _.emitDebugInfoInQuotations = emitDebugInfoInQuotations