Implement ToString on unions (RFC FS-1022)

src/fsharp/IlxGen.fs

@@ -6432,7 +6432,47 @@ 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 -> ()
+                  | _ -> ()
               | _ -> () ]
 
         let ilMethods = methodDefs @ augmentOverrideMethodDefs @ abstractMethodDefs

src/fsharp/TastOps.fs

@@ -7686,10 +7686,22 @@ type Entity with
                                          argInfos.Length = 1 && 
                                          List.lengthsEqAndForall2 (typeEquiv g) (List.map fst (List.head argInfos)) argtys  &&  
                                          membInfo.MemberFlags.IsOverrideOrExplicitImpl) 
+
+    member tycon.HasMember g nm argtys = 
+        tycon.TypeContents.tcaug_adhoc 
+        |> NameMultiMap.find nm
+        |> List.exists (fun vref -> 
+                          match vref.MemberInfo with 
+                          | None -> false 
+                          | _ -> let argInfos = ArgInfosOfMember g vref 
+                                 argInfos.Length = 1 && 
+                                 List.lengthsEqAndForall2 (typeEquiv g) (List.map fst (List.head argInfos)) argtys) 
+
 
 type EntityRef with 
     member tcref.HasInterface g ty = tcref.Deref.HasInterface g ty
     member tcref.HasOverride g nm argtys = tcref.Deref.HasOverride g nm argtys
+    member tcref.HasMember g nm argtys = tcref.Deref.HasMember g nm argtys
 
 let mkFastForLoop g (spLet,m,idv:Val,start,dir,finish,body) =
     let dir = if dir then FSharpForLoopUp else FSharpForLoopDown 

src/fsharp/TastOps.fsi

@@ -1400,10 +1400,12 @@ val IsGenericValWithGenericContraints: TcGlobals -> Val -> bool
 type Entity with 
     member HasInterface : TcGlobals -> TType -> bool
     member HasOverride : TcGlobals -> string -> TType list -> bool
+    member HasMember : TcGlobals -> string -> TType list -> bool
 
 type EntityRef with 
     member HasInterface : TcGlobals -> TType -> bool
     member HasOverride : TcGlobals -> string -> TType list -> bool
+    member HasMember : TcGlobals -> string -> TType list -> bool
 
 val (|AttribBitwiseOrExpr|_|) : TcGlobals -> Expr -> (Expr * Expr) option
 val (|EnumExpr|_|) : TcGlobals -> Expr -> Expr option

tests/fsharp/core/libtest/test.fsx

@@ -5217,8 +5217,8 @@ module Repro_3947 = begin
   do  check "Bug3947.Internal%+A" (sprintf "%+A (%+A)" ITA (ITB 2)) "ITA (ITB 2)"
 
   // The follow are not very useful outputs, but adding regression tests to pick up any changes...
-  do  check "Bug3947.Internal%A.ITA" true (let str = sprintf "%A" ITA     in str.EndsWith("InternalType+_ITA"))
-  do  check "Bug3947.Internal%A.ITB" true (let str = sprintf "%A" (ITB 2) in str.EndsWith("InternalType+ITB"))
+  do  check "Bug3947.Internal%A.ITA" (sprintf "%A" ITA) "ITA"
+  do  check "Bug3947.Internal%A.ITB" (sprintf "%A" (ITB 2)) "ITB 2"
 end
 
 

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

@@ -1104,6 +1104,28 @@ module OverrideIComparableOnUnionTest = begin
   do testc s4 s2 
 end
 
+module ToStringOnUnionTest = begin
+
+  type MyUnion = A of string | B
+
+  let a1 = A "FOO"
+  do test "union-tostring-def" (a1.ToString() = "A \"FOO\"")
+  do test "union-sprintfO-def" ((sprintf "%O" a1) = "A \"FOO\"")
+
+end
+
+module ToStringOnUnionTestOverride = begin
+
+  type MyUnion = A of string | B
+    with
+      override x.ToString() = "MyUnion"
+
+  let a1 = A "FOO"
+  do test "union-tostring-with-override" (a1.ToString() = "MyUnion")
+  do test "union-sprintfO-with-override" ((sprintf "%O" a1) = "MyUnion")
+
+end
+
 module OverrideIStructuralComparableOnUnionTest = begin
 
   [<CustomEquality; CustomComparison>]

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

@@ -129,3 +129,13 @@ module UnionTypeTest: begin
     end
 
 end
+
+module ToStringOnUnionTest: begin
+   type MyUnion = A of string | B
+
+end
+
+module ToStringOnUnionTestOverride: begin
+   type MyUnion = A of string | B
+
+end

tests/fsharpqa/Source/CodeGen/EmittedIL/CCtorDUWithMember/CCtorDUWithMember01.il.bsl

@@ -235,6 +235,20 @@
       IL_0015:  ret
     } // end of method C::__DebugDisplay
 
+    .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 CCtorDUWithMember01a/C,string>,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class CCtorDUWithMember01a/C>::.ctor(string)
+      IL_000a:  call       !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class CCtorDUWithMember01a/C,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 CCtorDUWithMember01a/C,string>::Invoke(!0)
+      IL_0015:  ret
+    } // end of method C::ToString
+
     .method public hidebysig virtual final 
             instance int32  CompareTo(class CCtorDUWithMember01a/C obj) cil managed
     {

tests/fsharpqa/Source/CodeGen/EmittedIL/CCtorDUWithMember/cctorduwithmember01.il.netfx4.bsl

@@ -238,6 +238,20 @@
       IL_0015:  ret
     } // end of method C::__DebugDisplay
 
+    .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 CCtorDUWithMember01a/C,string>,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class CCtorDUWithMember01a/C>::.ctor(string)
+      IL_000a:  call       !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class CCtorDUWithMember01a/C,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 CCtorDUWithMember01a/C,string>::Invoke(!0)
+      IL_0015:  ret
+    } // end of method C::ToString
+
     .method public hidebysig virtual final 
             instance int32  CompareTo(class CCtorDUWithMember01a/C obj) cil managed
     {

tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/EqualsOnUnions01.il.bsl

@@ -321,6 +321,20 @@
       IL_0015:  ret
     } // end of method U::__DebugDisplay
 
+    .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 EqualsOnUnions01/U,string>,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string)
+      IL_000a:  call       !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class EqualsOnUnions01/U,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 EqualsOnUnions01/U,string>::Invoke(!0)
+      IL_0015:  ret
+    } // end of method U::ToString
+
     .method public hidebysig virtual final 
             instance int32  CompareTo(class EqualsOnUnions01/U obj) cil managed
     {

tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/EqualsOnUnions01.il.netfx4.bsl

@@ -321,6 +321,20 @@
       IL_0015:  ret
     } // end of method U::__DebugDisplay
 
+    .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 EqualsOnUnions01/U,string>,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class EqualsOnUnions01/U>::.ctor(string)
+      IL_000a:  call       !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class EqualsOnUnions01/U,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 EqualsOnUnions01/U,string>::Invoke(!0)
+      IL_0015:  ret
+    } // end of method U::ToString
+
     .method public hidebysig virtual final 
             instance int32  CompareTo(class EqualsOnUnions01/U obj) cil managed
     {

tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/GeneralizationOnUnions01.il.bsl

@@ -127,6 +127,20 @@
       IL_0015:  ret
     } // end of method Weirdo::__DebugDisplay
 
+    .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 GeneralizationOnUnions01/Weirdo,string>,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class GeneralizationOnUnions01/Weirdo>::.ctor(string)
+      IL_000a:  call       !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class GeneralizationOnUnions01/Weirdo,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 GeneralizationOnUnions01/Weirdo,string>::Invoke(!0)
+      IL_0015:  ret
+    } // end of method Weirdo::ToString
+
     .method public hidebysig virtual final 
             instance int32  CompareTo(class GeneralizationOnUnions01/Weirdo obj) cil managed
     {

tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl

@@ -133,6 +133,20 @@
       IL_0015:  ret
     } // end of method Expr::__DebugDisplay
 
+    .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 ABC/Expr,string>,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class ABC/Expr>::.ctor(string)
+      IL_000a:  call       !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class ABC/Expr,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 ABC/Expr,string>::Invoke(!0)
+      IL_0015:  ret
+    } // end of method Expr::ToString
+
     .method public hidebysig virtual final 
             instance int32  CompareTo(class ABC/Expr obj) cil managed
     {
@@ -932,6 +946,20 @@
         IL_0015:  ret
       } // end of method Expr::__DebugDisplay
 
+      .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 ABC/ABC/Expr,string>,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,class ABC/ABC/Expr>::.ctor(string)
+        IL_000a:  call       !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class ABC/ABC/Expr,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 ABC/ABC/Expr,string>::Invoke(!0)
+        IL_0015:  ret
+      } // end of method Expr::ToString
+
       .method public hidebysig virtual final 
               instance int32  CompareTo(class ABC/ABC/Expr obj) cil managed
       {

tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModuleP.il.bsl

@@ -133,6 +133,19 @@
       IL_0015:  ret
     } // end of method Expr::__DebugDisplay
 
+    .method public strict virtual instance string 
+            ToString() cil managed
+    {
+      // 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 ABC/Expr,string>,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string)
+      IL_000a:  call       !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class ABC/Expr,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 ABC/Expr,string>::Invoke(!0)
+      IL_0015:  ret
+    } // end of method Expr::ToString
+
     .method public hidebysig virtual final 
             instance int32  CompareTo(class ABC/Expr obj) cil managed
     {
@@ -918,6 +931,19 @@
         IL_0015:  ret
       } // end of method Expr::__DebugDisplay
 
+      .method public strict virtual instance string 
+              ToString() cil managed
+      {
+        // 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 ABC/ABC/Expr,string>,class [FSharp.Core]Microsoft.FSharp.Core.Unit,string,string,string>::.ctor(string)
+        IL_000a:  call       !!0 [FSharp.Core]Microsoft.FSharp.Core.ExtraTopLevelOperators::PrintFormatToString<class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2<class ABC/ABC/Expr,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 ABC/ABC/Expr,string>::Invoke(!0)
+        IL_0015:  ret
+      } // end of method Expr::ToString
+
       .method public hidebysig virtual final 
               instance int32  CompareTo(class ABC/ABC/Expr obj) cil managed
       {