Implement ToString on Records (RFC FS-1022)

src/fsharp/IlxGen.fs

@@ -6062,6 +6062,46 @@ and GenAbstractBinding cenv eenv tref (vref:ValRef) =
         [],[],[]
 
 and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) =
+    let genToString ilThisTy = 
+        [
+        match (eenv.valsInScope.TryFind cenv.g.sprintf_vref.Deref,
+               eenv.valsInScope.TryFind cenv.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.g.ilxPubCloEnv ilThisTy cenv.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  
+                                               cenv.g.ilg.typ_String 
+                                               cenv.g.ilg.typ_String 
+                                               ilThisTy],[])
+               // 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.g.ilxPubCloEnv (fun _ -> 0us) eenv.tyenv.Count Normalcall (Apps_app(ilThisTy, Apps_done cenv.g.ilg.typ_String))
+               let ilMethodDef = mkILNonGenericVirtualMethod ("ToString",ILMemberAccess.Public,[],
+                                           mkILReturn cenv.g.ilg.typ_String,
+                                           mkMethodBody (true,[],2,nonBranchingInstrsToCode 
+                                                   ([ // load the hardwired format string
+                                                       yield I_ldstr "%+A"  
+                                                       // make the printf format object
+                                                       yield mkNormalNewobj newFormatMethSpec
+                                                       // call sprintf
+                                                       yield mkNormalCall sprintfMethSpec 
+                                                       // call the function returned by sprintf
+                                                       yield mkLdarg0 
+                                                       if ilThisTy.Boxity = ILBoxity.AsValue then
+                                                           yield mkNormalLdobj ilThisTy  ] @
+                                                       callInstrs),
+                                                   None))
+               let mdef = { ilMethodDef with CustomAttrs = mkILCustomAttrs [ cenv.g.CompilerGeneratedAttribute ] }
+               yield mdef
+        | None,_ -> ()
+        | _,None -> ()
+        | _ -> ()]
     let tcref = mkLocalTyconRef tycon
     if tycon.IsTypeAbbrev then () else
     match tycon.TypeReprInfo with 
@@ -6418,7 +6458,9 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) =
                  // Records that are value types do not create a default constructor with CLIMutable or ComVisible
                  if not isStructRecord && (isCLIMutable || (TryFindFSharpBoolAttribute cenv.g cenv.g.attrib_ComVisibleAttribute tycon.Attribs = Some true)) then
                      yield mkILSimpleStorageCtor(None, Some cenv.g.ilg.typ_Object.TypeSpec, ilThisTy, [], reprAccess) 
-
+
+                 if not (tycon.HasMember cenv.g "ToString" []) then
+                    yield! genToString ilThisTy
               | TFSharpObjectRepr r when tycon.IsFSharpDelegateTycon ->
 
                  // Build all the methods that go with a delegate type 
@@ -6437,47 +6479,8 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) =
                         yield { ilMethodDef with Access=reprAccess }
                  | _ -> 
                      ()
-              | TUnionRepr _ when (not <| tycon.HasMember cenv.g "ToString" []) -> 
-                  match (eenv.valsInScope.TryFind cenv.g.sprintf_vref.Deref,
-                         eenv.valsInScope.TryFind cenv.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.g.ilxPubCloEnv ilThisTy cenv.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  
-                                                       cenv.g.ilg.typ_String 
-                                                       cenv.g.ilg.typ_String 
-                                                       ilThisTy],[])
-                      // 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.g.ilxPubCloEnv (fun _ -> 0us) eenv.tyenv.Count Normalcall (Apps_app(ilThisTy, Apps_done cenv.g.ilg.typ_String))
-                      let ilMethodDef = mkILNonGenericVirtualMethod ("ToString",ILMemberAccess.Public,[],
-                                                   mkILReturn cenv.g.ilg.typ_String,
-                                                   mkMethodBody 
-                                                         (true,[],2,
-                                                          nonBranchingInstrsToCode 
-                                                            ([ // load the hardwired format string
-                                                               yield I_ldstr "%+A"  
-                                                               // make the printf format object
-                                                               yield mkNormalNewobj newFormatMethSpec
-                                                               // call sprintf
-                                                               yield mkNormalCall sprintfMethSpec 
-                                                               // call the function returned by sprintf
-                                                               yield mkLdarg0 
-                                                               if ilThisTy.Boxity = ILBoxity.AsValue then
-                                                                  yield mkNormalLdobj ilThisTy  ] @
-                                                             callInstrs),
-                                                          None))
-                      let mdef = { ilMethodDef with CustomAttrs = mkILCustomAttrs [ cenv.g.CompilerGeneratedAttribute ] }
-                      yield mdef
-                  | None,_ -> ()
-                  | _,None -> ()
-                  | _ -> ()
+              | TUnionRepr _ when not (tycon.HasMember cenv.g "ToString" []) -> 
+                  yield! genToString ilThisTy
               | _ -> () ]
 
         let ilMethods = methodDefs @ augmentOverrideMethodDefs @ abstractMethodDefs

tests/fsharp/core/members/basics/test.fs

@@ -1108,21 +1108,86 @@ module ToStringOnUnionTest = begin
 
   type MyUnion = A of string | B
 
+  [<Struct>]
+  type MyStructUnion = C of string | D
+
   let a1 = A "FOO"
-  do test "union-tostring-def" (a1.ToString() = "A \"FOO\"")
-  do test "union-sprintfO-def" ((sprintf "%O" a1) = "A \"FOO\"")
+  let c1 = C "FOO"
+
+  let expected1 = "A \"FOO\""
+  let expected2 = "C \"FOO\""
+
+  do test "union-tostring-def" (a1.ToString() = expected1)
+  do test "union-sprintfO-def" ((sprintf "%O" a1) = expected1)
+  do test "struct-union-tostring-def" (c1.ToString() = expected2)
+  do test "struct-union-sprintfO-def" ((sprintf "%O" c1) = expected2)
 
 end
 
 module ToStringOnUnionTestOverride = begin
+  let expected1 = "MyUnion"
 
   type MyUnion = A of string | B
     with
-      override x.ToString() = "MyUnion"
+      override x.ToString() = expected1
+
+  let expected2 = "MyStructUnion"
+
+  type MyStructUnion = C of string | D
+    with
+      override x.ToString() = expected2
 
   let a1 = A "FOO"
-  do test "union-tostring-with-override" (a1.ToString() = "MyUnion")
-  do test "union-sprintfO-with-override" ((sprintf "%O" a1) = "MyUnion")
+  let c1 = C "FOO"
+
+  do test "union-tostring-with-override" (a1.ToString() = expected1)
+  do test "union-sprintfO-with-override" ((sprintf "%O" a1) = expected1)
+  do test "struct-union-tostring-with-override" (c1.ToString() = expected2)
+  do test "struct-union-sprintfO-with-override" ((sprintf "%O" c1) = expected2)
+
+end
+
+module ToStringOnRecordTest = begin
+
+  type MyRecord = { A: string; B: int }
+
+  [<Struct>]
+  type MyStructRecord = { C: string; D: int }
+
+  let a1 = {A = "201"; B = 7}
+  let c1 = {C = "20"; D = 17}
+  let expected1 = "{A = \"201\";\n B = 7;}"
+  let expected2 = "{C = \"20\";\n D = 17;}"
+
+  do test "record-tostring-def" (a1.ToString() = expected1)
+  do test "record-sprintfO-def" ((sprintf "%O" a1) = expected1)
+  do test "struct-record-tostring-def" (c1.ToString() = expected2)
+  do test "struct-record-sprintfO-def" ((sprintf "%O" c1) = expected2)
+
+end
+
+module ToStringOnRecordTestOverride = begin
+
+  let expected1 = "MyRecord"
+
+  type MyRecord = { A: string; B: int }
+    with
+      override x.ToString() = expected1
+
+  let expected2 = "MyStructRecord"
+
+  [<Struct>]
+  type MyStructRecord = { C: string; D: int }
+    with
+      override x.ToString() = expected2
+
+  let a1 = {A = "201"; B = 7}
+  let c1 = {C = "20"; D = 17}
+
+  do test "record-tostring-with-override" (a1.ToString() = expected1)
+  do test "record-sprintfO-with-override" ((sprintf "%O" a1) = expected1)
+  do test "struct-record-tostring-with-override" (c1.ToString() = expected2)
+  do test "struct-record-sprintfO-with-override" ((sprintf "%O" c1) = expected2)
 
 end
 

tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction17.il.netfx4.bsl

@@ -100,7 +100,20 @@
       IL_000f:  stfld      int32 TestFunction17/R::y@
       IL_0014:  ret
     } // end of method R::.ctor
-
+
+	.method public strict virtual instance string 
+            ToString() cil managed
+    {
+      .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) 
+      .maxstack  8
+      IL_0000:  ldstr      "%+A"
+      IL_0005:  newobj     instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class TestFunction17/R,string>,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class TestFunction17/R>::.ctor(string)
+      IL_000a:  call       !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class TestFunction17/R,string>>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4<!!0,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string>)
+      IL_000f:  ldarg.0
+      IL_0010:  callvirt   instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class TestFunction17/R,string>::Invoke(!0)
+      IL_0015:  ret
+    } // end of method R::ToString
+
     .method public hidebysig virtual final 
             instance int32  CompareTo(class TestFunction17/R obj) cil managed
     {

tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction24.il.netfx4.bsl

@@ -122,7 +122,20 @@
       IL_000f:  stfld      int32 TestFunction24/Point::y@
       IL_0014:  ret
     } // end of method Point::.ctor
-
+
+    .method public strict virtual instance string 
+            ToString() cil managed
+    {
+      .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) 
+      .maxstack  8
+      IL_0000:  ldstr      "%+A"
+      IL_0005:  newobj     instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class TestFunction24/Point,string>,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class TestFunction24/Point>::.ctor(string)
+      IL_000a:  call       !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class TestFunction24/Point,string>>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4<!!0,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string>)
+      IL_000f:  ldarg.0
+      IL_0010:  callvirt   instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class TestFunction24/Point,string>::Invoke(!0)
+      IL_0015:  ret
+    } // end of method Point::ToString
+
     .method public hidebysig virtual final 
             instance int32  CompareTo(class TestFunction24/Point obj) cil managed
     {

tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/Testfunction17.il.bsl

@@ -100,7 +100,20 @@
       IL_000f:  stfld      int32 TestFunction17/R::y@
       IL_0014:  ret
     } // end of method R::.ctor
-
+
+	.method public strict virtual instance string 
+            ToString() cil managed
+    {
+      .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) 
+      .maxstack  8
+      IL_0000:  ldstr      "%+A"
+      IL_0005:  newobj     instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class TestFunction17/R,string>,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class TestFunction17/R>::.ctor(string)
+      IL_000a:  call       !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class TestFunction17/R,string>>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4<!!0,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string>)
+      IL_000f:  ldarg.0
+      IL_0010:  callvirt   instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class TestFunction17/R,string>::Invoke(!0)
+      IL_0015:  ret
+    } // end of method R::ToString
+
     .method public hidebysig virtual final 
             instance int32  CompareTo(class TestFunction17/R obj) cil managed
     {

tests/fsharpqa/Source/Optimizations/GenericComparison/Compare06.il.netfx4.bsl

@@ -104,7 +104,20 @@
         IL_000f:  stfld      int32 Compare06/CompareMicroPerfAndCodeGenerationTests/KeyR::key2@
         IL_0014:  ret
       } // end of method KeyR::.ctor
-
+
+      .method public strict virtual instance string 
+              ToString() cil managed
+      {
+        .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) 
+        .maxstack  8
+        IL_0000:  ldstr      "%+A"
+        IL_0005:  newobj     instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class Compare06/CompareMicroPerfAndCodeGenerationTests/KeyR,string>,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class Compare06/CompareMicroPerfAndCodeGenerationTests/KeyR>::.ctor(string)
+        IL_000a:  call       !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class Compare06/CompareMicroPerfAndCodeGenerationTests/KeyR,string>>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4<!!0,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string>)
+        IL_000f:  ldarg.0
+        IL_0010:  callvirt   instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class Compare06/CompareMicroPerfAndCodeGenerationTests/KeyR,string>::Invoke(!0)
+        IL_0015:  ret
+      } // end of method KeyR::ToString
+
       .method public hidebysig virtual final 
               instance int32  CompareTo(class Compare06/CompareMicroPerfAndCodeGenerationTests/KeyR obj) cil managed
       {

tests/fsharpqa/Source/Optimizations/GenericComparison/Equals05.il.netfx4.bsl

@@ -104,7 +104,21 @@
         IL_000f:  stfld      int32 Equals05/EqualsMicroPerfAndCodeGenerationTests/KeyR::key2@
         IL_0014:  ret
       } // end of method KeyR::.ctor
-
+
+      .method public strict virtual instance string 
+              ToString() cil managed
+      {
+        .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) 
+        // Code size       22 (0x16)
+        .maxstack  8
+        IL_0000:  ldstr      "%+A"
+        IL_0005:  newobj     instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class Equals05/EqualsMicroPerfAndCodeGenerationTests/KeyR,string>,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class Equals05/EqualsMicroPerfAndCodeGenerationTests/KeyR>::.ctor(string)
+        IL_000a:  call       !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class Equals05/EqualsMicroPerfAndCodeGenerationTests/KeyR,string>>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4<!!0,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string>)
+        IL_000f:  ldarg.0
+        IL_0010:  callvirt   instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class Equals05/EqualsMicroPerfAndCodeGenerationTests/KeyR,string>::Invoke(!0)
+        IL_0015:  ret
+      } // end of method KeyR::ToString
+
       .method public hidebysig virtual final 
               instance int32  CompareTo(class Equals05/EqualsMicroPerfAndCodeGenerationTests/KeyR obj) cil managed
       {

tests/fsharpqa/Source/Optimizations/GenericComparison/Hash08.il.netfx4.bsl

@@ -104,7 +104,21 @@
         IL_000f:  stfld      int32 Hash08/HashMicroPerfAndCodeGenerationTests/KeyR::key2@
         IL_0014:  ret
       } // end of method KeyR::.ctor
-
+
+      .method public strict virtual instance string 
+              ToString() cil managed
+      {
+        .custom instance void [mscorlib]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) 
+        // Code size       22 (0x16)
+        .maxstack  8
+        IL_0000:  ldstr      "%+A"
+        IL_0005:  newobj     instance void class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`5<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class Hash08/HashMicroPerfAndCodeGenerationTests/KeyR,string>,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class Hash08/HashMicroPerfAndCodeGenerationTests/KeyR>::.ctor(string)
+        IL_000a:  call       !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class Hash08/HashMicroPerfAndCodeGenerationTests/KeyR,string>>(class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4<!!0,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string>)
+        IL_000f:  ldarg.0
+        IL_0010:  callvirt   instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class Hash08/HashMicroPerfAndCodeGenerationTests/KeyR,string>::Invoke(!0)
+        IL_0015:  ret
+      } // end of method KeyR::ToString
+
       .method public hidebysig virtual final 
               instance int32  CompareTo(class Hash08/HashMicroPerfAndCodeGenerationTests/KeyR obj) cil managed
       {