Compiled ToStrings under -reflectionfree for DUs and Records

docs/reflectionfree-printing.md

@@ -0,0 +1,73 @@
+# Simple vs Reflection-based DU and Record printing
+
+This document describes two modes for printing Discriminated Unions (DUs) and Records in F#: a **simple** reflection-free mode that delegates to a `string`-like operator for printing field values, and a `sprintf` mode (`sprintf "%A"`), which uses **reflection** to create output looking like F# code. In this document, the terms *simple* and *reflection* are used to distinguish the two modes.
+
+Without the `--reflectionfree` flag, the compiler generates a `ToString` for DUs and Records that calls `sprintf "%A"`. With the flag, the compiler generates a `ToString` that uses the simple mode.
+
+Users can choose between the two modes by 1. use of `--reflectionfree`, and by 2. calling with a `sprintf`-type caller or a `string`-type caller (e.g. the `string` operator, `ToString`, or interpolated strings).
+
+If `x` is a DU or Record, then output will be simple or reflection-based as follows:
+| | `--reflectionfree` | no `--reflectionfree` |
+|---|---|---|
+| `string x` | simple | reflection |
+| `x.ToString()` | simple | reflection |
+| `$"{x}"` | simple | reflection |
+| `sprintf "%A" x` | disallowed (would be reflection) | reflection |
+
+As such, the current default reflection `ToString` generation forces reflection formatting on all callers. On the other hand, generating simple `ToString` output means that the records and DUs are printed with simple or reflection formatting depending on whether the caller is of simple or reflection affinity. The `--reflectionfree` flag combines this property with a ban on `sprintf` to prevent the reflection mode from being used.
+
+In addition to user-defined types, the FSharp.Core `option` type uses simple printing, while other types either have no `ToString` or use some other format.
+
+## Behaviour: definitions
+
+In simple printing, field values are printed with `string`-type formatting, more precisely `anyToStringShowingNull`. No line breaks are inserted.
+
+- **Record**: `{ Name1 = value1; Name2 = value2 }`.
+- **Anonymous record**: the same, but with `{| ` and ` |}`.
+- **Union**: A case with no fields renders as just its name. A case with fields renders as `CaseName(value1, value2)`.
+
+`[<Struct>]` records and unions, and struct anonymous records, render identically to their reference-type forms.
+
+A type that supplies its own `ToString` override keeps it, with no `ToString` generated for it (either simple or reflection).
+
+Reflection-mode printing is described in [plain text formatting](https://learn.microsoft.com/en-us/dotnet/fsharp/language-reference/plaintext-formatting).
+
+## Behavioural differences
+
+### Differences in field rendering
+
+The following differences between `string` and `sprintf "%A"` carry over directly into differences in field rendering between simple and reflection printing:
+
+| F# value | simple (`anyToStringShowingNull`) | reflection (`sprintf "%A"`) |
+|---|---|---|
+| string field `"hi"` | `hi` | `"hi"` |
+| char field `'a'` | `a` | `'a'` |
+| float `5.0` | `5` | `5.0` |
+| `250uy` / `42n` / `1.5M` | `250` / `42` / `1.5` | `250uy` / `42n` / `1.5M` |
+| option field `None` | `null` | `None` |
+| array field `[\|1;2;3\|]` | `System.Int32[]` | `[\|1; 2; 3\|]` |
+| unit field `()` | `null` | `()` |
+
+The overall differences here are:
+- Simple printing converts to strings, while reflection printing is more bi-directional, often generating compilable F# code.
+- F# types that have null representation (`unit`, `option`, and in general types with `AllowNullLiteral` or `UseNullAsTrueValue`) are printed as `null` in simple printing, while reflection printing uses a more F#-like representation.
+
+### Other differences
+
+These differences are in the printing of the record or DU itself rather than of its fields:
+
+| F# value | simple (`string`) | reflection (`sprintf "%A"`) |
+|---|---|---|
+| `B 5` (single field) | `B(5)` | `B 5` |
+| `C (3, 4)` (two fields) | `C(3, 4)` | `C (3, 4)` |
+| record `{ X = 1; Y = 2 }` | `{ X = 1; Y = 2 }` | `{ X = 1`⏎`  Y = 2 }` |
+| `[<StructuredFormatDisplay("Custom<{X}>")>]` | `{ X = 5 }` | `Custom<5>` |
+
+The overall differences here are:
+- Simple printing always brackets a case's fields and never pads, while reflection printing omits brackets for a single non-tuple field and inserts a space before them otherwise.
+- Simple printing uses a single line (unless a field's own rendering contains breaks), while reflection printing breaks records and nested values across lines with indentation.
+- `StructuredFormatDisplay` is ignored in simple printing and honoured in reflection printing.
+
+## Recursion and depth
+
+Rendering recurses into nested records and unions. Deep nesting is guarded by `RuntimeHelpers.EnsureSufficientExecutionStack`, raising a catchable `InsufficientExecutionStackException` rather than `StackOverflowException`; cycles (which require mutation to construct) still overflow, as `option` and `list` do.

docs/release-notes/.FSharp.Compiler.Service/11.0.100.md

@@ -137,6 +137,7 @@
 * Debug: rework for expressions stepping ([PR #19894](https://github.com/dotnet/fsharp/pull/19894))
 * Debug: rework conditional erasure, fix stepping over literals ([PR #19897](https://github.com/dotnet/fsharp/pull/19897))
 * Debug: fix if and match condition sequence points ([PR #19932](https://github.com/dotnet/fsharp/pull/19932))
+* Under `--reflectionfree`, discriminated unions, records and anonymous records now get a [generated `ToString`](../../reflectionfree-printing.md) (rendering each field like `Option` does) instead of falling back to the namespace-qualified type name. ([PR #19976](https://github.com/dotnet/fsharp/pull/19976))
 * Checker: recover on checking language version ([PR ##19970](https://github.com/dotnet/fsharp/pull/19970))
 * Implied argument names for function-to-delegate coercions now fall back to the delegate's `Invoke` parameter names when the function has no recoverable names (e.g. a partial application like `System.Func<int, int>((+) 1)`), instead of synthetic `delegateArg0`, `delegateArg1`, … names. ([PR #20001](https://github.com/dotnet/fsharp/pull/20001))
 * Add internal `ResetCompilerGeneratedNameState` to `CompilerGlobalState` name generators so warm-checker re-compilation can produce fresh-process-identical generated names. ([PR #20017](https://github.com/dotnet/fsharp/pull/20017))

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)
 
@@ -1697,3 +1703,140 @@ 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).
+//-------------------------------------------------------------------------
+
+// Guard deep recursion with a catchable exception, as C# records' PrintMembers do, when the runtime provides
+// it. A type whose fields are all primitive cannot nest, so it skips the guard.
+let mkToStringRecursionGuard (g: TcGlobals, m: Text.range, fieldTys: TType list, body: Expr) =
+    let isPrimitive (ty: TType) =
+        isIntegerTy g ty
+        || isFpTy g ty
+        || isDecimalTy g ty
+        || isStringTy g ty
+        || typeEquiv g g.char_ty ty
+        || isBoolTy g ty
+        || isUnitTy g ty
+        || isEnumTy g ty
+
+    if fieldTys |> List.forall isPrimitive then
+        body
+    else
+        match g.TryFindSysILTypeRef "System.Runtime.CompilerServices.RuntimeHelpers" with
+        | Some tref ->
+            let mspec =
+                mkILNonGenericStaticMethSpecInTy (mkILNonGenericBoxedTy tref, "EnsureSufficientExecutionStack", [], ILType.Void)
+
+            mkSequential m (mkAsmExpr ([ mkNormalCall mspec ], [], [], [], m)) body
+        | None -> body
+
+// 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.DisplayNameCore + " = ")
+            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 ]
+    let fieldTys = tcref.AllInstanceFieldsAsList |> List.map (fun fspec -> fspec.FormalType)
+    thisv, mkToStringRecursionGuard (g, m, fieldTys, 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.DisplayNameCore
+        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.DisplayNameCore + "(") :: 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 fieldTys =
+        tcref.UnionCasesAsList |> List.collect (fun uc -> uc.RecdFields) |> List.map (fun rf -> rf.FormalType)
+
+    thisv, mkToStringRecursionGuard (g, m, fieldTys, 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
+    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
+
+    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, recursion guard included; 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

@@ -916,6 +916,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) &&
@@ -4771,8 +4783,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 =
@@ -4782,7 +4795,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