Merge pull request #442 from dsyme/fix-symbol-types

Prettify formatting of symbol types

src/fsharp/NicePrint.fs

@@ -1061,12 +1061,14 @@ module private PrintTypes =
         nameL ^^ wordL ":" ^^ tauL
 
 
-    let layoutPrettyType denv typ = 
+    let layoutPrettyTypeWithPrec prec denv typ = 
         let _,typ,cxs = PrettyTypes.PrettifyTypes1 denv.g typ
         let env = SimplifyTypes.CollectInfo true [typ] cxs
         let cxsL = layoutConstraintsWithInfo denv env env.postfixConstraints
-        layoutTypeWithInfoAndPrec denv env 2 typ  --- cxsL
+        layoutTypeWithInfoAndPrec denv env prec typ  --- cxsL
 
+    let layoutPrettyType denv typ = layoutPrettyTypeWithPrec 2 denv typ
+    let layoutPrettyTypeHighPrec denv typ = layoutPrettyTypeWithPrec 5 denv typ
 
 /// Printing TAST objects
 module private PrintTastMemberOrVals = 
@@ -1879,6 +1881,7 @@ let isGeneratedExceptionField pos f     = TastDefinitionPrinting.isGeneratedExce
 let stringOfTyparConstraint denv tpc  = stringOfTyparConstraints denv [tpc]
 let stringOfTy              denv x    = x |> PrintTypes.layoutType denv |> showL
 let prettyStringOfTy        denv x    = x |> PrintTypes.layoutPrettyType denv |> showL
+let prettyStringOfTyHighPrec denv x    = x |> PrintTypes.layoutPrettyTypeHighPrec denv |> showL
 let stringOfRecdField       denv x    = x |> TastDefinitionPrinting.layoutRecdField false denv |> showL
 let stringOfUnionCase       denv x    = x |> TastDefinitionPrinting.layoutUnionCase denv (wordL "|")  |> showL
 let stringOfExnDef          denv x    = x |> TastDefinitionPrinting.layoutExnDefn denv |> showL

src/fsharp/TastOps.fs

@@ -2282,8 +2282,9 @@ module PrettyTypes = begin
     let PrettifyTypes1   g x = PrettifyTypes g (fun f -> f) (fun f -> f) x
     let PrettifyTypes2   g x = PrettifyTypes g (fun f -> foldPair (f,f)) (fun f -> mapPair (f,f)) x
     let PrettifyTypesN   g x = PrettifyTypes g List.fold List.map   x
+    let PrettifyTypesNN   g x = PrettifyTypes g (fun f -> List.fold (List.fold f)) List.mapSquared   x
+    let PrettifyTypesNN1   g x = PrettifyTypes g (fun f -> foldPair (List.fold (List.fold f),f)) (fun f -> mapPair (List.mapSquared f,f)) x
     let PrettifyTypesN1  g (x:UncurriedArgInfos * TType) = PrettifyTypes g (fun f -> foldPair (List.fold (fold1Of2  f), f)) (fun f -> mapPair (List.map (map1Of2  f),f)) x
-    let PrettifyTypesNN1 g x = PrettifyTypes g (fun f -> foldTriple (List.fold f, List.fold (fold1Of2 f),f)) (fun f -> mapTriple (List.map f, List.map (map1Of2  f), f)) x
     let PrettifyTypesNM1 g (x:TType list * CurriedArgInfos * TType) = PrettifyTypes g (fun f -> foldTriple (List.fold f, List.fold (List.fold (fold1Of2 f)),f)) (fun f -> mapTriple (List.map f, List.mapSquared (map1Of2  f), f)) x
 
 end

src/fsharp/TastOps.fsi

@@ -581,6 +581,8 @@ module PrettyTypes =
     val PrettifyTypes1 : TcGlobals -> TType -> TyparInst * TType * TyparConstraintsWithTypars
     val PrettifyTypes2 : TcGlobals -> TType * TType -> TyparInst * (TType * TType) * TyparConstraintsWithTypars
     val PrettifyTypesN : TcGlobals -> TType list -> TyparInst * TType list * TyparConstraintsWithTypars
+    val PrettifyTypesNN : TcGlobals -> TType list list -> TyparInst * TType list list * TyparConstraintsWithTypars
+    val PrettifyTypesNN1 : TcGlobals -> TType list list * TType -> TyparInst * (TType list list * TType) * TyparConstraintsWithTypars
     val PrettifyTypesN1 : TcGlobals -> UncurriedArgInfos * TType -> TyparInst * (UncurriedArgInfos * TType) * TyparConstraintsWithTypars
     val PrettifyTypesNM1 : TcGlobals -> TType list * CurriedArgInfos * TType -> TyparInst * (TType list * CurriedArgInfos * TType) * TyparConstraintsWithTypars
 

src/fsharp/vs/Symbols.fs

@@ -1533,15 +1533,14 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) =
                 // INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for
                 // either .NET or F# parameters
                 let argInfo : ArgReprInfo = { Name=nmOpt; Attribs= [] }
-                yield FSharpParameter(cenv,  pty, argInfo, x.DeclarationLocationOpt, isParamArrayArg, isOutArg, optArgInfo.IsOptional) ] 
+                yield FSharpParameter(cenv, pty, argInfo, x.DeclarationLocationOpt, isParamArrayArg, isOutArg, optArgInfo.IsOptional) ] 
                |> makeReadOnlyCollection  ]
            |> makeReadOnlyCollection
 
         | E _ ->  []  |> makeReadOnlyCollection
         | M m -> 
-
             [ for argtys in m.GetParamDatas(cenv.amap,range0,m.FormalMethodInst) do 
-                 yield 
+                 yield
                    [ for (ParamData(isParamArrayArg,isOutArg,optArgInfo,nmOpt,_reflArgInfo,pty)) in argtys do 
                 // INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for
                 // either .NET or F# parameters
@@ -1555,8 +1554,8 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) =
         | None ->
             let _, tau = v.TypeScheme
             if isFunTy cenv.g tau then
-                let typeArguments, _typ = stripFunTy cenv.g tau
-                [ for typ in typeArguments do
+                let argtysl, _typ = stripFunTy cenv.g tau
+                [ for typ in argtysl do
                     let allArguments =
                         if isTupleTy cenv.g typ
                         then tryDestTupleTy cenv.g typ
@@ -1571,7 +1570,6 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) =
             let tau = v.TauType
             let argtysl,_ = GetTopTauTypeInFSharpForm cenv.g curriedArgInfos tau range0
             let argtysl = if v.IsInstanceMember then argtysl.Tail else argtysl
-
             [ for argtys in argtysl do 
                  yield 
                    [ for argty, argInfo in argtys do 
@@ -1594,7 +1592,6 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) =
                     // For non-standard events, just use the delegate type as the ReturnParameter type
                     e.GetDelegateType(cenv.amap,range0)
 
-            let _, rty, _cxs = PrettyTypes.PrettifyTypes1 cenv.g rty
             FSharpParameter(cenv,  rty, retInfo, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) 
 
         | P p -> 
@@ -1611,16 +1608,12 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) =
         match v.ValReprInfo with 
         | None ->
             let _, tau = v.TypeScheme
-            if isFunTy cenv.g tau then
-                let _typeArguments, rty = stripFunTy cenv.g tau
-                FSharpParameter(cenv,  rty, { Name=None; Attribs= [] }, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false)
-            else
-                failwith "not a module let binding or member" 
+            let _argtysl, rty = stripFunTy cenv.g tau
+            let empty : ArgReprInfo  = { Name=None; Attribs= [] }
+            FSharpParameter(cenv,  rty, empty, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false)
         | Some (ValReprInfo(_typars,argInfos,retInfo)) -> 
-
             let tau = v.TauType
-            let _,rty = GetTopTauTypeInFSharpForm cenv.g argInfos tau range0
-
+            let _c,rty = GetTopTauTypeInFSharpForm cenv.g argInfos tau range0
             FSharpParameter(cenv,  rty, retInfo, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) 
 
 
@@ -1835,27 +1828,77 @@ and FSharpType(cenv, typ:TType) =
         GetSuperTypeOfType cenv.g cenv.amap range0 typ
         |> Option.map (fun ty -> FSharpType(cenv, ty)) 
 
-    member x.Instantiate(tys:(FSharpGenericParameter * FSharpType) list) = 
-        let typI = instType (tys |> List.map (fun (tyv,typ) -> tyv.V, typ.Typ)) typ
+    member x.Instantiate(instantiation:(FSharpGenericParameter * FSharpType) list) = 
+        let typI = instType (instantiation |> List.map (fun (tyv,typ) -> tyv.V, typ.V)) typ
         FSharpType(cenv, typI)
 
-    member private x.Typ = typ
+    member private x.V = typ
+    member private x.cenv = cenv
+
+    member private typ.AdjustType(t) = 
+        FSharpType(typ.cenv, t)
 
     override x.Equals(other : obj) =
         box x === other ||
         match other with
-        |   :? FSharpType as t -> typeEquiv cenv.g typ t.Typ
+        |   :? FSharpType as t -> typeEquiv cenv.g typ t.V
         |   _ -> false
 
     override x.GetHashCode() = hash x
 
     member x.Format(denv: FSharpDisplayContext) = 
        protect <| fun () -> 
-        NicePrint.stringOfTy (denv.Contents cenv.g) typ 
+        NicePrint.prettyStringOfTyHighPrec (denv.Contents cenv.g) typ 
 
     override x.ToString() = 
        protect <| fun () -> 
-        "type " + NicePrint.stringOfTy (DisplayEnv.Empty(cenv.g)) typ 
+        "type " + NicePrint.prettyStringOfTyHighPrec (DisplayEnv.Empty(cenv.g)) typ 
+
+    static member Prettify(typ: FSharpType) = 
+        let t = PrettyTypes.PrettifyTypes1 typ.cenv.g typ.V  |> p23
+        typ.AdjustType t
+
+    static member Prettify(typs: IList<FSharpType>) = 
+        let xs = typs |> List.ofSeq
+        match xs with 
+        | [] -> []
+        | h :: _ -> 
+            let cenv = h.cenv
+            let prettyTyps = PrettyTypes.PrettifyTypesN cenv.g [ for t in xs -> t.V ] |> p23
+            (xs, prettyTyps) ||> List.map2 (fun p pty -> p.AdjustType(pty))
+        |> makeReadOnlyCollection
+
+    static member Prettify(parameter: FSharpParameter) = 
+        let prettyTyp = parameter.V |> PrettyTypes.PrettifyTypes1 parameter.cenv.g |> p23
+        parameter.AdjustType(prettyTyp)
+
+    static member Prettify(parameters: IList<FSharpParameter>) = 
+        let parameters = parameters |> List.ofSeq
+        match parameters with 
+        | [] -> []
+        | h :: _ -> 
+            let cenv = h.cenv
+            let prettyTyps = parameters |> List.map (fun p -> p.V) |> PrettyTypes.PrettifyTypesN cenv.g |> p23
+            (parameters, prettyTyps) ||> List.map2 (fun p pty -> p.AdjustType(pty))
+        |> makeReadOnlyCollection
+
+    static member Prettify(parameters: IList<IList<FSharpParameter>>) = 
+        let xs = parameters |> List.ofSeq |> List.map List.ofSeq
+        let hOpt = xs |> List.tryPick (function h :: _ -> Some h | _ -> None) 
+        match hOpt with 
+        | None -> xs
+        | Some h -> 
+            let cenv = h.cenv
+            let prettyTyps = xs |> List.mapSquared (fun p -> p.V) |> PrettyTypes.PrettifyTypesNN cenv.g |> p23
+            (xs, prettyTyps) ||> List.map2 (List.map2 (fun p pty -> p.AdjustType(pty)))
+        |> List.map makeReadOnlyCollection |> makeReadOnlyCollection
+
+    static member Prettify(parameters: IList<IList<FSharpParameter>>, returnParameter: FSharpParameter) = 
+        let xs = parameters |> List.ofSeq |> List.map List.ofSeq
+        let cenv = returnParameter.cenv
+        let prettyTyps, prettyRetTy = xs |> List.mapSquared (fun p -> p.V) |> (fun tys -> PrettyTypes.PrettifyTypesNN1 cenv.g (tys,returnParameter.V) )|> p23
+        let ps = (xs, prettyTyps) ||> List.map2 (List.map2 (fun p pty -> p.AdjustType(pty))) |> List.map makeReadOnlyCollection |> makeReadOnlyCollection
+        ps, returnParameter.AdjustType(prettyRetTy)
 
 and FSharpAttribute(cenv: cenv, attrib: AttribInfo) = 
 
@@ -1941,7 +1984,10 @@ and FSharpParameter(cenv, typ:TType, topArgInfo:ArgReprInfo, mOpt, isParamArrayA
     let idOpt = topArgInfo.Name
     let m = match mOpt with Some m  -> m | None -> range0
     member __.Name = match idOpt with None -> None | Some v -> Some v.idText
-    member __.Type = FSharpType(cenv,  typ)
+    member __.cenv : cenv = cenv
+    member __.AdjustType(t) = FSharpParameter(cenv, t, topArgInfo, mOpt, isParamArrayArg, isOutArg, isOptionalArg)
+    member __.Type : FSharpType = FSharpType(cenv,  typ)
+    member __.V = typ
     member __.DeclarationLocation = match idOpt with None -> m | Some v -> v.idRange
     member __.Attributes = 
         attribs |> List.map (fun a -> FSharpAttribute(cenv,  AttribInfo.FSAttribInfo(cenv.g, a))) |> makeReadOnlyCollection

src/fsharp/vs/Symbols.fsi

@@ -810,6 +810,7 @@ and [<Class>] FSharpParameter =
     /// Indicate this is an optional argument
     member IsOptionalArg: bool
 
+
 /// A subtype of FSharpSymbol that represents a single case within an active pattern
 and [<Class>] FSharpActivePatternCase =
     inherit FSharpSymbol
@@ -892,6 +893,30 @@ and [<Class>] FSharpType =
     /// if it is an instantiation of a generic type.
     member BaseType : FSharpType option
 
+    /// Adjust the type by removing any occurrences of type inference variables, replacing them
+    /// systematically with lower-case type inference variables such as <c>'a</c>.
+    static member Prettify : typ:FSharpType -> FSharpType
+
+    /// Adjust a group of types by removing any occurrences of type inference variables, replacing them
+    /// systematically with lower-case type inference variables such as <c>'a</c>.
+    static member Prettify : types: IList<FSharpType> -> IList<FSharpType>
+
+    /// Adjust the type in a single parameter by removing any occurrences of type inference variables, replacing them
+    /// systematically with lower-case type inference variables such as <c>'a</c>.
+    static member Prettify : parameter: FSharpParameter -> FSharpParameter 
+
+    /// Adjust the types in a group of parameters by removing any occurrences of type inference variables, replacing them
+    /// systematically with lower-case type inference variables such as <c>'a</c>.
+    static member Prettify : parameters: IList<FSharpParameter> -> IList<FSharpParameter>
+
+    /// Adjust the types in a group of curried parameters by removing any occurrences of type inference variables, replacing them
+    /// systematically with lower-case type inference variables such as <c>'a</c>.
+    static member Prettify : parameters: IList<IList<FSharpParameter>> -> IList<IList<FSharpParameter>>
+
+    /// Adjust the types in a group of curried parameters and return type by removing any occurrences of type inference variables, replacing them
+    /// systematically with lower-case type inference variables such as <c>'a</c>.
+    static member Prettify : parameters: IList<IList<FSharpParameter>> * returnParameter: FSharpParameter -> IList<IList<FSharpParameter>> * FSharpParameter
+
     [<System.Obsolete("Renamed to HasTypeDefinition")>]
     member IsNamedType : bool
 

tests/service/ProjectAnalysisTests.fs

@@ -202,7 +202,7 @@ let ``Test project1 whole project errors`` () =
     wholeProjectResults.Errors.[0].EndColumn |> shouldEqual 44
 
 [<Test>]
-let ``Test project1 should have protected FullName and TryFullName return same results`` () =
+let ``Test project39 should have protected FullName and TryFullName return same results`` () =
     let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunSynchronously
     let rec getFullNameComparisons (entity: FSharpEntity) = 
         seq { if not entity.IsProvided && entity.Accessibility.IsPublic then
@@ -4690,3 +4690,83 @@ let ``Test project38 abstract slot information`` () =
             "get_Property", ["type OverrideTests.B<'YY> original generics: <'Y> with member get_Property : () -> Microsoft.FSharp.Core.int"]
             "get_Event", ["type OverrideTests.B<'YY> with member get_Event : () -> Microsoft.FSharp.Core.unit"]
         |]
+
+
+module Project39 = 
+    open System.IO
+
+    let fileName1 = Path.ChangeExtension(Path.GetTempFileName(), ".fs")
+    let base2 = Path.GetTempFileName()
+    let dllName = Path.ChangeExtension(base2, ".dll")
+    let projFileName = Path.ChangeExtension(base2, ".fsproj")
+    let fileSource1 = """
+module M
+
+let functionWithIncompleteSignature x = System.ThisDoesntExist.SomeMethod(x)
+let curriedFunctionWithIncompleteSignature (x1:'a) x2 (x3:'a,x4) = 
+    (x2 = x4) |> ignore
+    System.ThisDoesntExist.SomeMethod(x1,x2,x3,x4)
+
+type C() = 
+    member x.MemberWithIncompleteSignature x = System.ThisDoesntExist.SomeMethod(x)
+    member x.CurriedMemberWithIncompleteSignature (x1:'a) x2 (x3:'a,x4) = 
+        (x2 = x4) |> ignore
+        System.ThisDoesntExist.SomeMethod(x1,x2,x3,x4)
+
+let uses () = 
+   functionWithIncompleteSignature (failwith "something")
+   curriedFunctionWithIncompleteSignature (failwith "x1") (failwith "x2") (failwith "x3", failwith "x4")
+   C().MemberWithIncompleteSignature (failwith "something")
+   C().CurriedMemberWithIncompleteSignature (failwith "x1") (failwith "x2") (failwith "x3", failwith "x4")
+    """
+    File.WriteAllText(fileName1, fileSource1)
+    let fileNames = [fileName1]
+    let args = mkProjectCommandLineArgs (dllName, fileNames)
+    let options =  checker.GetProjectOptionsFromCommandLineArgs (projFileName, args)
+    let cleanFileName a = if a = fileName1 then "file1" else "??"
+
+[<Test>]
+let ``Test project39 all symbols`` () = 
+
+    let wholeProjectResults = checker.ParseAndCheckProject(Project39.options) |> Async.RunSynchronously
+    let allSymbolUses = wholeProjectResults.GetAllUsesOfAllSymbols() |> Async.RunSynchronously
+    let typeTextOfAllSymbolUses = 
+        [ for s in allSymbolUses do
+            match s.Symbol with 
+            | :? FSharpMemberOrFunctionOrValue as mem -> 
+              if s.Symbol.DisplayName.Contains "Incomplete" then
+                yield s.Symbol.DisplayName, tups s.RangeAlternate, 
+                      ("full", mem.FullType |> FSharpType.Prettify |> fun p -> p.Format(s.DisplayContext)),
+                      ("params", mem.CurriedParameterGroups |> FSharpType.Prettify |> Seq.toList |> List.map (Seq.toList >> List.map (fun p -> p.Type.Format(s.DisplayContext)))),
+                      ("return", mem.ReturnParameter |> FSharpType.Prettify |> fun p -> p.Type.Format(s.DisplayContext)) 
+            | _ -> () ]
+    typeTextOfAllSymbolUses |> shouldEqual
+              [("functionWithIncompleteSignature", ((4, 4), (4, 35)),
+                ("full", "'a -> 'b"), ("params", [["'a"]]), ("return", "'b"));
+               ("curriedFunctionWithIncompleteSignature", ((5, 4), (5, 42)),
+                ("full", "'a -> 'a0 -> 'a * 'a0 -> 'b when 'a0 : equality"),
+                ("params",
+                 [["'a"]; ["'a0 when 'a0 : equality"]; ["'a"; "'a0 when 'a0 : equality"]]),
+                ("return", "'b"));
+               ("MemberWithIncompleteSignature", ((10, 13), (10, 42)),
+                ("full", "C -> 'c -> 'd"), ("params", [["'c"]]), ("return", "'d"));
+               ("CurriedMemberWithIncompleteSignature", ((11, 13), (11, 49)),
+                ("full", "C -> 'a -> 'a0 -> 'a * 'a0 -> 'b when 'a0 : equality"),
+                ("params",
+                 [["'a"]; ["'a0 when 'a0 : equality"]; ["'a"; "'a0 when 'a0 : equality"]]),
+                ("return", "'b"));
+               ("functionWithIncompleteSignature", ((16, 3), (16, 34)),
+                ("full", "'a -> 'b"), ("params", [["'a"]]), ("return", "'b"));
+               ("curriedFunctionWithIncompleteSignature", ((17, 3), (17, 41)),
+                ("full", "'a -> 'a0 -> 'a * 'a0 -> 'b when 'a0 : equality"),
+                ("params",
+                 [["'a"]; ["'a0 when 'a0 : equality"]; ["'a"; "'a0 when 'a0 : equality"]]),
+                ("return", "'b"));
+               ("MemberWithIncompleteSignature", ((18, 3), (18, 36)),
+                ("full", "'c -> 'd"), ("params", [["'c"]]), ("return", "'d"));
+               ("CurriedMemberWithIncompleteSignature", ((19, 3), (19, 43)),
+                ("full", "'a -> 'a0 -> 'a * 'a0 -> 'b when 'a0 : equality"),
+                ("params",
+                 [["'a"]; ["'a0 when 'a0 : equality"]; ["'a"; "'a0 when 'a0 : equality"]]),
+                ("return", "'b"))]
+