Generate reflection-free ToString in the augmentation phase

The structural ToString for --reflectionfree records and unions was built in
IlxGen, after the optimizer, so its per-field 'string' operator calls were
never inlined: each value-type field was boxed and rendered through the
generic Operators.ToString, behind a null guard that is dead for a value type.

Move the generation into the type-augmentation phase (alongside
Equals/GetHashCode/CompareTo) so the body flows through the optimizer. The
'string' operator is now specialised - a value-type field renders via a direct,
allocation-free invariant-culture ToString with no boxing and no null guard
(reference fields keep the guard so null still renders as "null"). The shared
body builders live in AugmentTypeDefinitions; anonymous record types are
synthesized too late for augmentation, so they keep generating in IlxGen but
reuse the same builder.

Output is unchanged; the EmittedIL baselines are updated to the leaner IL.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>

Author: charlesroddie

src/Compiler/Checking/AugmentWithHashCompare.fs

@@ -81,6 +81,9 @@ let mkGetHashCodeSlotSig (g: TcGlobals) =
 let mkEqualsSlotSig (g: TcGlobals) =
     TSlotSig("Equals", g.obj_ty_noNulls, [], [], [ [ TSlotParam(Some("obj"), g.obj_ty_withNulls, false, false, false, []) ] ], Some g.bool_ty)
 
+let mkToStringSlotSig (g: TcGlobals) =
+    TSlotSig("ToString", g.obj_ty_noNulls, [], [], [ [] ], Some g.string_ty)
+
 //-------------------------------------------------------------------------
 // Helpers associated with code-generation of comparison/hash augmentations
 //-------------------------------------------------------------------------
@@ -112,6 +115,9 @@ let mkEqualsWithComparerTyExact g ty =
 let mkHashTy g ty =
     mkFunTy g (mkThisTy g ty) (mkFunTy g g.unit_ty g.int_ty)
 
+let mkToStringTy (g: TcGlobals, ty: TType) =
+    mkFunTy g (mkThisTy g ty) (mkFunTy g g.unit_ty g.string_ty)
+
 let mkHashWithComparerTy g ty =
     mkFunTy g (mkThisTy g ty) (mkFunTy g g.IEqualityComparer_ty g.int_ty)
 
@@ -1700,3 +1706,111 @@ let MakeBindingsForUnionAugmentation g (tycon: Tycon) (vals: ValRef list) =
         let isdata = mkUnionCaseTest g (thise, ucr, tinst, m)
         let expr = mkLambdas g m tps [ thisv; unitv ] (isdata, g.bool_ty)
         mkCompGenBind v.Deref expr)
+
+//-------------------------------------------------------------------------
+// Build reflection-free ToString functions for union and record types.
+//
+// Under --reflectionfree the reflective 'sprintf "%+A"' ToString is unavailable, so we build a structural
+// one here (during type augmentation, so the 'string' operator calls flow through the optimizer and get
+// specialised - e.g. an int field renders via a direct, allocation-free ToString rather than a boxed call).
+//-------------------------------------------------------------------------
+
+// Render one field value as a string the way option/list do (LanguagePrimitives.anyToStringShowingNull):
+// a null reference renders as "null", everything else via the 'string' operator. A value-type field can
+// never be null, so it skips the box+null-guard and renders directly.
+let mkFieldToString (g: TcGlobals, m: Text.range, fe: Expr) =
+    let fieldTy = tyOfExpr g fe
+
+    if isStructTy g fieldTy then
+        mkCallStringOperator g m fieldTy fe
+    else
+        let v, ve = mkCompGenLocal m "field" fieldTy
+        mkCompGenLet m v fe (mkNonNullCond g m g.string_ty (mkCallBox g m fieldTy ve) (mkCallStringOperator g m fieldTy ve) (mkString g m "null"))
+
+// A record's ToString as a single line "{ F1 = v1; F2 = v2 }" (no line breaks, unlike "%+A").
+// openBrace/closeBrace are "{ "/" }" for records and "{| "/" |}" for anonymous records.
+let mkRecdToString (g: TcGlobals, tcref: TyconRef, tycon: Tycon, openBrace: string, closeBrace: string) =
+    let m = tycon.Range
+    let tinst, ty = mkMinimalTy g tcref
+    let thisv, thise = mkThisVar g m ty
+
+    let fieldParts =
+        tcref.AllInstanceFieldsAsList
+        |> List.mapi (fun i fspec ->
+            let fref = tcref.MakeNestedRecdFieldRef fspec
+            let value = mkFieldToString (g, m, mkRecdFieldGetViaExprAddr (thise, fref, tinst, m))
+            let nameEq = mkString g m (fspec.DisplayName + " = ")
+            if i = 0 then [ nameEq; value ] else [ mkString g m "; "; nameEq; value ])
+        |> List.concat
+
+    let parts = mkString g m openBrace :: fieldParts @ [ mkString g m closeBrace ]
+    thisv, mkStringConcat (g, m, parts)
+
+// A union's ToString as a match over the cases building "CaseName(f0, f1, ...)" (or just "CaseName" for a
+// nullary case).
+let mkUnionToString (g: TcGlobals, tcref: TyconRef, tycon: Tycon) =
+    let m = tycon.Range
+    let tinst, ty = mkMinimalTy g tcref
+    let thisv, thise = mkThisVar g m ty
+    let mbuilder = MatchBuilder(DebugPointAtBinding.NoneAtInvisible, m)
+
+    let mkResult (ucase: UnionCase) =
+        let cref = tcref.MakeNestedUnionCaseRef ucase
+        let rfields = ucase.RecdFields
+
+        if isNil rfields then
+            mkString g m ucase.DisplayName
+        else
+            // provene is an expression proven to be of this case (the value itself for struct unions,
+            // otherwise a 'UnionCaseProof'), from which fields can be read.
+            let mkBody (provene: Expr) =
+                let fieldStrs =
+                    rfields
+                    |> List.mapi (fun j _ -> mkFieldToString (g, m, mkUnionCaseFieldGetProvenViaExprAddr (provene, cref, tinst, j, m)))
+
+                let sep = mkString g m ", "
+
+                let fieldsWithSeps =
+                    fieldStrs |> List.mapi (fun i fe -> if i = 0 then [ fe ] else [ sep; fe ]) |> List.concat
+
+                let parts = mkString g m (ucase.DisplayName + "(") :: fieldsWithSeps @ [ mkString g m ")" ]
+                mkStringConcat (g, m, parts)
+
+            if cref.Tycon.IsStructOrEnumTycon then
+                mkBody thise
+            else
+                let ucv, ucve = mkCompGenLocal m "thisCast" (mkProvenUnionCaseTy cref tinst)
+                mkCompGenLet m ucv (mkUnionCaseProof (thise, cref, tinst, m)) (mkBody ucve)
+
+    let cases =
+        tcref.UnionCasesAsList
+        |> List.map (fun ucase ->
+            let cref = tcref.MakeNestedUnionCaseRef ucase
+            mkCase (DecisionTreeTest.UnionCase(cref, tinst), mbuilder.AddResultTarget(mkResult ucase)))
+
+    let dtree = TDSwitch(thise, cases, None, m)
+    thisv, mbuilder.Close(dtree, m, g.string_ty)
+
+let TyconIsCandidateForAugmentationWithToString (g: TcGlobals, tycon: Tycon) =
+    g.useReflectionFreeCodeGen && (tycon.IsUnionTycon || tycon.IsRecordTycon)
+
+let MakeValsForToStringAugmentation (g: TcGlobals, tcref: TyconRef) =
+    let _, ty = mkMinimalTy g tcref
+    let vis = tcref.Accessibility
+    let tps = tcref.Typars tcref.Range
+    mkValSpec g tcref ty vis (Some(mkToStringSlotSig g)) "ToString" (tps +-> (mkToStringTy (g, ty))) unitArg false
+
+let MakeBindingsForToStringAugmentation (g: TcGlobals, tycon: Tycon, toStringVal: Val) =
+    let tcref = mkLocalTyconRef tycon
+    let m = tycon.Range
+    let tps = tycon.Typars m
+
+    let thisv, body =
+        if tycon.IsUnionTycon then
+            mkUnionToString (g, tcref, tycon)
+        else
+            mkRecdToString (g, tcref, tycon, "{ ", " }")
+
+    let unitv, _ = mkCompGenLocal m "unitArg" g.unit_ty
+    let expr = mkLambdas g m tps [ thisv; unitv ] (body, g.string_ty)
+    [ mkCompGenBind toStringVal expr ]

src/Compiler/Checking/AugmentWithHashCompare.fsi

@@ -51,3 +51,15 @@ val TypeDefinitelyHasEquality: TcGlobals -> TType -> bool
 val MakeValsForUnionAugmentation: TcGlobals -> TyconRef -> Val list
 
 val MakeBindingsForUnionAugmentation: TcGlobals -> Tycon -> ValRef list -> Binding list
+
+/// Build a record's single-line reflection-free ToString body; returns the 'this' value and the body expression.
+val mkRecdToString: g: TcGlobals * tcref: TyconRef * tycon: Tycon * openBrace: string * closeBrace: string -> Val * Expr
+
+/// Whether a reflection-free structural ToString should be generated for this type.
+val TyconIsCandidateForAugmentationWithToString: g: TcGlobals * tycon: Tycon -> bool
+
+/// Make the ToString override slot for a reflection-free record or union.
+val MakeValsForToStringAugmentation: g: TcGlobals * tcref: TyconRef -> Val
+
+/// Build the body binding for a reflection-free record or union ToString override.
+val MakeBindingsForToStringAugmentation: g: TcGlobals * tycon: Tycon * toStringVal: Val -> Binding list

src/Compiler/Checking/CheckDeclarations.fs

@@ -910,6 +910,18 @@ module AddAugmentationDeclarations =
             else []
         else []
 
+    // Under --reflectionfree the structural ToString is generated here (rather than in IlxGen) so the 'string'
+    // operator calls in its body flow through the optimizer and get specialised. Like the Equals override, this
+    // runs late so tycon.HasMember gives correct results for a user-written ToString.
+    let AddReflectionFreeToStringBindings (cenv: cenv, env: TcEnv, tycon: Tycon) =
+        let g = cenv.g
+        if AugmentTypeDefinitions.TyconIsCandidateForAugmentationWithToString(g, tycon) && not (tycon.HasMember g "ToString" []) then
+            let tcref = mkLocalTyconRef tycon
+            let toStringVal = AugmentTypeDefinitions.MakeValsForToStringAugmentation(g, tcref)
+            PublishValueDefn cenv env ModuleOrMemberBinding toStringVal
+            AugmentTypeDefinitions.MakeBindingsForToStringAugmentation(g, tycon, toStringVal)
+        else []
+
     let ShouldAugmentUnion (g: TcGlobals) (tycon: Tycon) =
         g.langVersion.SupportsFeature LanguageFeature.UnionIsPropertiesVisible &&
         HasDefaultAugmentationAttribute g (mkLocalTyconRef tycon) &&
@@ -4728,8 +4740,9 @@ module TcDeclarations =
                     // We put the hash/compare bindings before the type definitions and the
                     // equality bindings after because tha is the order they've always been generated
                     // in, and there are code generation tests to check that.
-                    let binds = AddAugmentationDeclarations.AddGenericHashAndComparisonBindings cenv tycon 
+                    let binds = AddAugmentationDeclarations.AddGenericHashAndComparisonBindings cenv tycon
                     let binds3 = AddAugmentationDeclarations.AddGenericEqualityBindings cenv envForDecls tycon
+                    let binds5 = AddAugmentationDeclarations.AddReflectionFreeToStringBindings(cenv, envForDecls, tycon)
                     let binds4 =
                         if tycon.IsUnionTycon && AddAugmentationDeclarations.ShouldAugmentUnion g tycon then
                             let unionVals =
@@ -4739,7 +4752,7 @@ module TcDeclarations =
                             AugmentTypeDefinitions.MakeBindingsForUnionAugmentation g tycon (List.map mkLocalValRef unionVals)
                         else
                             []
-                    binds@binds4, binds3)
+                    binds@binds4, binds3@binds5)
 
         // Check for cyclic structs and inheritance all over again, since we may have added some fields to the struct when generating the implicit construction syntax 
         EstablishTypeDefinitionCores.TcTyconDefnCore_CheckForCyclicStructsAndInheritance cenv tycons

src/Compiler/CodeGen/IlxGen.fs

@@ -11279,17 +11279,6 @@ and GenSprintfPrintingMethod cenv eenv methName ilThisTy m =
             | _ -> ()
     ]
 
-/// Generate the 'ToString' method for a union type. Normally this calls 'sprintf "%+A"' (see
-/// GenSprintfPrintingMethod). Under reflection-free code generation 'sprintf' is unavailable, so instead emit a
-/// match over the cases that builds "CaseName(f0, f1, ...)" using the 'string' operator on each field.
-/// Format one field value the same way option/list do (LanguagePrimitives.anyToStringShowingNull):
-/// render null as "null", otherwise via the 'string' operator.
-and GenFieldToString (cenv: cenv, m: range, fe: Expr) =
-    let g = cenv.g
-    let fieldTy = tyOfExpr g fe
-    let v, ve = mkCompGenLocal m "field" fieldTy
-    mkCompGenLet m v fe (mkNonNullCond g m g.string_ty (mkCallBox g m fieldTy ve) (mkCallStringOperator g m fieldTy ve) (mkString g m "null"))
-
 /// Emit a [<CompilerGenerated>] virtual ToString override whose body is the given string-typed expression.
 /// 'thisv' is the 'this' value (stored at arg 0) referenced by bodyExpr.
 and EmitToStringMethodDef (cenv: cenv, mgbuf: AssemblyBuilder, eenv: IlxGenEnv, thisv: Val, bodyExpr: Expr) =
@@ -11308,84 +11297,18 @@ and EmitToStringMethodDef (cenv: cenv, mgbuf: AssemblyBuilder, eenv: IlxGenEnv,
 
     [ mdef.With(customAttrs = mkILCustomAttrs [ g.CompilerGeneratedAttribute ]) ]
 
-/// Build the 'this' local for a generated ToString (a byref for struct types) and the type instantiation.
-and GenToStringThis (cenv: cenv, tcref: TyconRef, m: range) =
-    let g = cenv.g
-    let tinst, ty = generalizeTyconRef g tcref
-    let thisv, thise = mkCompGenLocal m "this" (if isStructTy g ty then mkByrefTy g ty else ty)
-    tinst, thisv, thise
-
-and GenUnionToStringMethod (cenv: cenv, mgbuf: AssemblyBuilder, eenv: IlxGenEnv, ilThisTy: ILType, tcref: TyconRef, m: range) =
-    let g = cenv.g
-
-    if not g.useReflectionFreeCodeGen then
-        GenSprintfPrintingMethod cenv eenv "ToString" ilThisTy m
-    else
-        let tinst, thisv, thise = GenToStringThis (cenv, tcref, m)
-
-        let mbuilder = MatchBuilder(DebugPointAtBinding.NoneAtInvisible, m)
-
-        let mkResult (ucase: UnionCase) =
-            let cref = tcref.MakeNestedUnionCaseRef ucase
-            let rfields = ucase.RecdFields
-
-            if isNil rfields then
-                mkString g m ucase.DisplayName
-            else
-                // provene is an expression proven to be of this case (the value itself for struct unions,
-                // otherwise a 'UnionCaseProof'), from which fields can be read.
-                let mkBody (provene: Expr) =
-                    let fieldStrs =
-                        rfields
-                        |> List.mapi (fun j _ -> GenFieldToString (cenv, m, mkUnionCaseFieldGetProvenViaExprAddr (provene, cref, tinst, j, m)))
-
-                    let sep = mkString g m ", "
-
-                    let fieldsWithSeps =
-                        fieldStrs |> List.mapi (fun i fe -> if i = 0 then [ fe ] else [ sep; fe ]) |> List.concat
-
-                    let parts = mkString g m (ucase.DisplayName + "(") :: fieldsWithSeps @ [ mkString g m ")" ]
-                    mkStringConcat (g, m, parts)
-
-                if cref.Tycon.IsStructOrEnumTycon then
-                    mkBody thise
-                else
-                    let ucv, ucve = mkCompGenLocal m "thisCast" (mkProvenUnionCaseTy cref tinst)
-                    mkCompGenLet m ucv (mkUnionCaseProof (thise, cref, tinst, m)) (mkBody ucve)
-
-        let cases =
-            tcref.UnionCasesAsList
-            |> List.map (fun ucase ->
-                let cref = tcref.MakeNestedUnionCaseRef ucase
-                mkCase (DecisionTreeTest.UnionCase(cref, tinst), mbuilder.AddResultTarget(mkResult ucase)))
-
-        let dtree = TDSwitch(thise, cases, None, m)
-        let matchExpr = mbuilder.Close(dtree, m, g.string_ty)
-
-        EmitToStringMethodDef (cenv, mgbuf, eenv, thisv, matchExpr)
-
-/// Generate a record's ToString as a single line "{ F1 = v1; F2 = v2 }" (no line breaks, unlike "%+A"),
-/// fields formatted like union fields. openBrace/closeBrace are "{ "/" }" for records and "{| "/" |}" for
-/// anonymous records. Under non-reflection-free codegen, falls back to sprintf "%+A".
+/// Generate an anonymous record's ToString as a single line "{| F1 = v1; F2 = v2 |}". Nominal records and
+/// unions get their reflection-free ToString from the type-augmentation phase instead (so the 'string'
+/// operator calls are optimized), but anonymous record types are synthesized too late for that, so they are
+/// generated here. Under non-reflection-free codegen, falls back to sprintf "%+A".
 and GenRecordToStringMethod (cenv: cenv, mgbuf: AssemblyBuilder, eenv: IlxGenEnv, ilThisTy: ILType, tcref: TyconRef, m: range, openBrace: string, closeBrace: string) =
     let g = cenv.g
 
     if not g.useReflectionFreeCodeGen then
         GenSprintfPrintingMethod cenv eenv "ToString" ilThisTy m
     else
-        let tinst, thisv, thise = GenToStringThis (cenv, tcref, m)
-
-        let fieldParts =
-            tcref.AllInstanceFieldsAsList
-            |> List.mapi (fun i fspec ->
-                let fref = tcref.MakeNestedRecdFieldRef fspec
-                let value = GenFieldToString (cenv, m, mkRecdFieldGetViaExprAddr (thise, fref, tinst, m))
-                let nameEq = mkString g m (fspec.DisplayName + " = ")
-                if i = 0 then [ nameEq; value ] else [ mkString g m "; "; nameEq; value ])
-            |> List.concat
-
-        let parts = mkString g m openBrace :: fieldParts @ [ mkString g m closeBrace ]
-        EmitToStringMethodDef (cenv, mgbuf, eenv, thisv, mkStringConcat (g, m, parts))
+        let thisv, body = AugmentTypeDefinitions.mkRecdToString (g, tcref, tcref.Deref, openBrace, closeBrace)
+        EmitToStringMethodDef (cenv, mgbuf, eenv, thisv, body)
 
 and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option =
     let g = cenv.g
@@ -11970,8 +11893,10 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option
                         then
                             yield mkILSimpleStorageCtor (Some g.ilg.typ_Object.TypeSpec, ilThisTy, [], [], reprAccess, None, eenv.imports)
 
-                        if not (tycon.HasMember g "ToString" []) then
-                            yield! GenRecordToStringMethod(cenv, mgbuf, eenvinner, ilThisTy, tcref, m, "{ ", " }")
+                        // Reflection-free nominal records get their ToString from the type-augmentation phase; here we
+                        // only emit the sprintf "%+A" ToString for the non-reflection-free case.
+                        if not g.useReflectionFreeCodeGen && not (tycon.HasMember g "ToString" []) then
+                            yield! GenSprintfPrintingMethod cenv eenvinner "ToString" ilThisTy m
 
                     | TFSharpTyconRepr r when tycon.IsFSharpDelegateTycon ->
 
@@ -11994,8 +11919,10 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option
                             yield! mkILDelegateMethods reprAccess g.ilg (g.iltyp_AsyncCallback, g.iltyp_IAsyncResult) (parameters, ret)
                         | _ -> ()
 
-                    | TFSharpTyconRepr { fsobjmodel_kind = TFSharpUnion } when not (tycon.HasMember g "ToString" []) ->
-                        yield! GenUnionToStringMethod(cenv, mgbuf, eenvinner, ilThisTy, tcref, m)
+                    // Reflection-free nominal unions get their ToString from the type-augmentation phase; here we
+                    // only emit the sprintf "%+A" ToString for the non-reflection-free case.
+                    | TFSharpTyconRepr { fsobjmodel_kind = TFSharpUnion } when not g.useReflectionFreeCodeGen && not (tycon.HasMember g "ToString" []) ->
+                        yield! GenSprintfPrintingMethod cenv eenvinner "ToString" ilThisTy m
                     | _ -> ()
                 ]