rework of overload failure message to prettify *ALL* types in a singl…

…e go, not only argument types, but return types and known generic argument types (this info was never displayed originally but is useful for scenario similar to FSharpPlus implementation)

added `PrettifyDiscriminantAndTypePairs` in TastOps, this allow to weave extra information with the complete list of types, to help reconstituting the several types from their origin (in the usage spot: argument types, return type, generic parameter types)

src/fsharp/CompileOps.fs

@@ -766,106 +766,84 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) (canSuggestNa
 
       | UnresolvedOverloading(denv, callerArgs, failure, m) ->
           let nl = System.Environment.NewLine
-          let argsMessage =
-              let prefix = nl + nl
-              let suffix = nl + nl
+          let cx =
+              match failure with
+              | NoOverloadsFound (cx=cx)
+              | PossibleCandidates (cx=cx) -> cx
+
+          let retTy =
+              cx 
+              |> Option.map (fun cx -> cx.ReturnType)
+              |> Option.flatten
+              |> Option.defaultValue (TType.TType_var (Typar.NewUnlinked()))
+
+          let genericParameters =
+              cx 
+              |> Option.map (fun cx -> cx.ArgTys)
+              |> Option.defaultValue List.empty
+
+          let argsMessage, returnType, genericParameters =
+              let argRepr = 
+                  callerArgs.ArgumentNamesAndTypes
+                  |> List.map (fun (name,tTy) -> tTy, {ArgReprInfo.Name = name |> Option.map (fun name -> Ident(name, range.Zero)); ArgReprInfo.Attribs = []})
+              let argsL,retTyL,genParamTysL = NicePrint.prettyLayoutsOfUnresolvedOverloading denv argRepr retTy genericParameters
               match callerArgs.ArgumentNamesAndTypes with
-              | [] -> nl + nl
-              | items -> 
-                  // more than one argument, need to lay them out in a single pass
-
-                  //let cxs = []
-                  let argsL = 
-                    NicePrint.prettyLayoutOfUnresolvedMethodCallArguments 
-                      denv 
-                      [] 
-                      (items |> List.map (fun (name,tTy) -> tTy, {ArgReprInfo.Name = name |> Option.map (fun name -> Ident(name, range.Zero)); Attribs = []}))
-                      //cxs
-                  let args = argsL |> List.map Layout.showL |> String.concat " "
-                  (*let args = 
-                      items 
-                      |> List.map displayArgType
-                      |> String.concat " * "
-                  *)
+              | [] -> None, Layout.showL retTyL, Layout.showL genParamTysL
+              | items ->
+                  let args = Layout.showL argsL  
                   let prefixMessage =
                       match items with
                       | [_] -> FSComp.SR.csNoOverloadsFoundArgumentsPrefixSingular
                       | _ -> FSComp.SR.csNoOverloadsFoundArgumentsPrefixPlural
-                  prefix + (prefixMessage args) + suffix
+                  Some (prefixMessage args)
+                  , Layout.showL retTyL
+                  , Layout.showL genParamTysL
 
-          let knownReturnType (cx: TraitConstraintInfo option) =
+          let knownReturnType =
               match cx with 
-              | None -> String.Empty
+              | None -> None
               | Some cx ->
-              let prefix = nl + nl
-              let suffix = nl + nl
               match cx.ReturnType with
-              | None -> String.Empty
-              | Some t ->
-                prefix + (NicePrint.prettyStringOfTy denv t |> FSComp.SR.csNoOverloadsFoundReturnType) + suffix
+              | None -> None
+              | Some _ -> Some (FSComp.SR.csNoOverloadsFoundReturnType returnType)
 
-          let genericParametersMessage (cx: TraitConstraintInfo option) =
+          let genericParametersMessage =
               match cx with 
-              | None -> String.Empty
+              | None -> None
               | Some cx ->
-              let prefix = nl + nl
-              let suffix = nl + nl
-
               match cx.ArgTys  with
-              | [] -> nl + nl
-              | [item] -> prefix + (item |> NicePrint.prettyStringOfTy denv |> FSComp.SR.csNoOverloadsFoundTypeParametersPrefixSingular) + suffix
-              | items ->
-                let args =
-                  items
-                  |> List.map (NicePrint.prettyStringOfTy denv)
-                  |> String.concat ", "
-                prefix + (FSComp.SR.csNoOverloadsFoundTypeParametersPrefixPlural args) + suffix
+              | [] -> None
+              | [_] -> Some (FSComp.SR.csNoOverloadsFoundTypeParametersPrefixSingular genericParameters)
+              | _ -> Some (FSComp.SR.csNoOverloadsFoundTypeParametersPrefixPlural genericParameters)
 
           let formatOverloads (overloads: OverloadInformation list) =
               overloads
               |> List.map (fun overload -> overload.OverloadMethodInfo denv m)
               |> List.sort
               |> List.map FSComp.SR.formatDashItem
               |> String.concat nl
-          let formatTraitInfo (cx: TraitConstraintInfo) =
-
-            let prettyArgTys =
-              cx.ArgTys 
-              |> List.map (NicePrint.prettyStringOfTy denv)
-              |> String.concat ", "
-
-            [ sprintf "cx.ArgTys      %s" prettyArgTys
-              sprintf "cx.MemberFlags %A" cx.MemberFlags
-              sprintf "cx.MemberName  %A" cx.MemberName
-              sprintf "cx.ReturnType  %A" (cx.ReturnType |> Option.map (NicePrint.prettyStringOfTy denv))
-              sprintf "cx.Solution    %A" cx.Solution
-              sprintf "cx._Tys        %A" (cx._Tys |> List.map (NicePrint.prettyStringOfTy denv))
-
-            ] |> String.concat nl
-          let cx, msg =
+
+          let msg =
+              let optionalParts =
+                [knownReturnType; genericParametersMessage; argsMessage]
+                |> List.choose id
+                |> String.concat (nl + nl)
+                |> function | "" -> String.Empty
+                            | result -> nl + nl + result + nl + nl
+
               match failure with
-              | NoOverloadsFound (methodName, overloads, cx) ->
-                cx
-                , FSComp.SR.csNoOverloadsFound methodName
-                  + (knownReturnType cx) 
-                  + (genericParametersMessage cx)
-                  + argsMessage
-                  + (FSComp.SR.csAvailableOverloads (formatOverloads overloads))
-              | PossibleCandidates (methodName, methodNames, cx) ->
-                  cx
-                  , (let msg = FSComp.SR.csMethodIsOverloaded methodName
-                     match methodNames with
-                     | [] -> msg
-                     | names -> 
-                         let overloads = FSComp.SR.csCandidates (formatOverloads names)
-                         msg 
-                         + (knownReturnType cx)
-                         + (genericParametersMessage cx)
-                         + argsMessage
-                         + overloads)
-
-          let traitInfo = cx |> Option.map (fun cx -> nl + nl + "TRAIIAT" + nl + formatTraitInfo cx + nl + nl) |> Option.defaultValue ""
-          os.Append (msg + traitInfo) |> ignore
+              | NoOverloadsFound (methodName, overloads, _) ->
+                  FSComp.SR.csNoOverloadsFound methodName
+                      + optionalParts                      
+                      + (FSComp.SR.csAvailableOverloads (formatOverloads overloads))
+              | PossibleCandidates (methodName, [], _) ->
+                  FSComp.SR.csMethodIsOverloaded methodName
+              | PossibleCandidates (methodName, overloads, _) ->
+                  FSComp.SR.csMethodIsOverloaded methodName
+                      + optionalParts
+                      + FSComp.SR.csCandidates (formatOverloads overloads)
+
+          os.Append msg |> ignore
 
       | UnresolvedConversionOperator(denv, fromTy, toTy, _) -> 
           let t1, t2, _tpcs = NicePrint.minimalStringsOfTwoTypes denv fromTy toTy

src/fsharp/NicePrint.fs

@@ -1019,10 +1019,26 @@ module private PrintTypes =
             |> List.map (sepListL (wordL (tagPunctuation "*")))
         allArgsL
 
+    let layoutReturnType denv env rty = layoutTypeWithInfoAndPrec denv env 4 rty
+
+    let layoutGenericParameterTypes denv env = 
+      function
+      | [] -> emptyL
+      | genParamTys ->
+        (wordL (tagPunctuation "<"))
+        ^^
+        (
+          genParamTys
+          |> List.map (layoutTypeWithInfoAndPrec denv env 4)
+          |> sepListL (wordL (tagPunctuation ","))
+        ) 
+        ^^
+        (wordL (tagPunctuation ">"))
+
     /// Layout a single type used as the type of a member or value 
     let layoutTopType denv env argInfos rty cxs =
         // Parenthesize the return type to match the topValInfo 
-        let rtyL = layoutTypeWithInfoAndPrec denv env 4 rty
+        let rtyL = layoutReturnType denv env rty
         let cxsL = layoutConstraintsWithInfo denv env cxs
         match argInfos with
         | [] -> rtyL --- cxsL
@@ -1118,23 +1134,43 @@ module private PrintTypes =
             nameL
         nameL ^^ wordL (tagPunctuation ":") ^^ tauL
 
-
-    let prettyLayoutOfUnresolvedMethodCallArguments denv typarInst argInfos =
-
+    /// layouts the elements of an unresolved overloaded method call:
+    /// argInfos: unammed and named arguments
+    /// retTy: return type
+    /// genParamTy: generic parameter types
+    let prettyLayoutsOfUnresolvedOverloading denv argInfos retTy genParamTys =
+        let _niceMethodTypars, typarInst =
+            let memberToParentInst = List.empty
+            let typars = argInfos |> List.choose (function (TType.TType_var typar,_) -> Some typar | _ -> None)
+            let methTyparNames = typars |> List.mapi (fun i tp -> if (PrettyTypes.NeedsPrettyTyparName tp) then sprintf "a%d" (List.length memberToParentInst + i) else tp.Name)
+            PrettyTypes.NewPrettyTypars memberToParentInst typars methTyparNames
+        let retTy = instType typarInst retTy
         let argInfos = prettyArgInfos denv typarInst argInfos
+        let argInfos,retTy,genParamTys, cxs =
+          let typesWithDiscrimants =
+            [
+              yield 0uy,retTy 
+              for ty,_ in argInfos do
+                yield 1uy, ty
+              for ty in genParamTys do
+                yield 2uy, ty
+            ]
+          let typesWithDiscrimants,typarsAndCxs = PrettyTypes.PrettifyDiscriminantAndTypePairs denv.g typesWithDiscrimants
+          let argInfos = 
+            typesWithDiscrimants 
+            |> List.choose (function (1uy,ty) -> Some ty | _ -> None)
+            |> List.zip argInfos 
+            |> List.map (fun ((_,argInfo),tTy) -> tTy, argInfo)
+          let genParamTys = 
+            typesWithDiscrimants
+            |> List.choose (function (2uy,ty) -> Some ty | _ -> None)
+          argInfos, retTy, genParamTys, typarsAndCxs
 
-        let ___cxs = 
-          argInfos
-          |> List.map (fun (tTy, _) -> 
-            let __tTy,constraints = (PrettyTypes.PrettifyType denv.g tTy)
-            constraints
-          )
-
-        // don't really know what to do to work with CollectInfo below with all the constraints...
-        let cxs = []
-
         let env = SimplifyTypes.CollectInfo true (List.collect (List.map fst) [argInfos]) cxs
-        layoutArgInfos denv env [argInfos]
+        let cxsL = layoutConstraintsWithInfo denv env env.postfixConstraints
+        List.foldBack (---) (layoutArgInfos denv env [argInfos]) cxsL
+        , layoutReturnType denv env retTy
+        , layoutGenericParameterTypes denv env genParamTys
 
     let prettyLayoutOfType denv ty = 
         let ty, cxs = PrettyTypes.PrettifyType denv.g ty
@@ -1275,7 +1311,7 @@ let layoutConst g ty c = PrintTypes.layoutConst g ty c
 
 let prettyLayoutOfMemberSig denv x = x |> PrintTypes.prettyLayoutOfMemberSig denv 
 let prettyLayoutOfUncurriedSig denv argInfos tau = PrintTypes.prettyLayoutOfUncurriedSig denv argInfos tau
-let prettyLayoutOfUnresolvedMethodCallArguments = PrintTypes.prettyLayoutOfUnresolvedMethodCallArguments
+let prettyLayoutsOfUnresolvedOverloading denv argInfos retTy genericParameters = PrintTypes.prettyLayoutsOfUnresolvedOverloading denv argInfos retTy genericParameters
 //-------------------------------------------------------------------------
 
 /// Printing info objects

src/fsharp/TastOps.fs

@@ -2509,6 +2509,10 @@ module PrettyTypes =
     let PrettifyType g x = PrettifyThings g id id x
     let PrettifyTypePair g x = PrettifyThings g (fun f -> foldPair (f, f)) (fun f -> mapPair (f, f)) x
     let PrettifyTypes g x = PrettifyThings g List.fold List.map x
+    let PrettifyDiscriminantAndTypePairs g x = 
+      let tys, cxs = (PrettifyThings g List.fold List.map (x |> List.map snd))
+      List.zip (List.map fst x) tys, cxs
+
     let PrettifyCurriedTypes g x = PrettifyThings g (fun f -> List.fold (List.fold f)) List.mapSquared x
     let PrettifyCurriedSigTypes g x = PrettifyThings g (fun f -> foldPair (List.fold (List.fold f), f)) (fun f -> mapPair (List.mapSquared f, f)) x
 

src/fsharp/TastOps.fsi

@@ -931,6 +931,8 @@ module PrettyTypes =
     val PrettifyTypePair : TcGlobals -> TType * TType -> (TType * TType) * TyparConstraintsWithTypars
 
     val PrettifyTypes : TcGlobals -> TTypes -> TTypes * TyparConstraintsWithTypars
+
+    val PrettifyDiscriminantAndTypePairs : TcGlobals -> ('Discriminant * TType) list -> ('Discriminant * TType) list * TyparConstraintsWithTypars
 
     val PrettifyInst : TcGlobals -> TyparInst -> TyparInst * TyparConstraintsWithTypars