Skip to content

Commit bf56100

Browse files
committed
Merge pull request #442 from dsyme/fix-symbol-types
Prettify formatting of symbol types
2 parents fba477a + d7393af commit bf56100

File tree

6 files changed

+183
-26
lines changed

6 files changed

+183
-26
lines changed

src/fsharp/NicePrint.fs

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1061,12 +1061,14 @@ module private PrintTypes =
10611061
nameL ^^ wordL ":" ^^ tauL
10621062

10631063

1064-
let layoutPrettyType denv typ =
1064+
let layoutPrettyTypeWithPrec prec denv typ =
10651065
let _,typ,cxs = PrettyTypes.PrettifyTypes1 denv.g typ
10661066
let env = SimplifyTypes.CollectInfo true [typ] cxs
10671067
let cxsL = layoutConstraintsWithInfo denv env env.postfixConstraints
1068-
layoutTypeWithInfoAndPrec denv env 2 typ --- cxsL
1068+
layoutTypeWithInfoAndPrec denv env prec typ --- cxsL
10691069

1070+
let layoutPrettyType denv typ = layoutPrettyTypeWithPrec 2 denv typ
1071+
let layoutPrettyTypeHighPrec denv typ = layoutPrettyTypeWithPrec 5 denv typ
10701072

10711073
/// Printing TAST objects
10721074
module private PrintTastMemberOrVals =
@@ -1879,6 +1881,7 @@ let isGeneratedExceptionField pos f = TastDefinitionPrinting.isGeneratedExce
18791881
let stringOfTyparConstraint denv tpc = stringOfTyparConstraints denv [tpc]
18801882
let stringOfTy denv x = x |> PrintTypes.layoutType denv |> showL
18811883
let prettyStringOfTy denv x = x |> PrintTypes.layoutPrettyType denv |> showL
1884+
let prettyStringOfTyHighPrec denv x = x |> PrintTypes.layoutPrettyTypeHighPrec denv |> showL
18821885
let stringOfRecdField denv x = x |> TastDefinitionPrinting.layoutRecdField false denv |> showL
18831886
let stringOfUnionCase denv x = x |> TastDefinitionPrinting.layoutUnionCase denv (wordL "|") |> showL
18841887
let stringOfExnDef denv x = x |> TastDefinitionPrinting.layoutExnDefn denv |> showL

src/fsharp/TastOps.fs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2282,8 +2282,9 @@ module PrettyTypes = begin
22822282
let PrettifyTypes1 g x = PrettifyTypes g (fun f -> f) (fun f -> f) x
22832283
let PrettifyTypes2 g x = PrettifyTypes g (fun f -> foldPair (f,f)) (fun f -> mapPair (f,f)) x
22842284
let PrettifyTypesN g x = PrettifyTypes g List.fold List.map x
2285+
let PrettifyTypesNN g x = PrettifyTypes g (fun f -> List.fold (List.fold f)) List.mapSquared x
2286+
let PrettifyTypesNN1 g x = PrettifyTypes g (fun f -> foldPair (List.fold (List.fold f),f)) (fun f -> mapPair (List.mapSquared f,f)) x
22852287
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
2286-
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
22872288
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
22882289

22892290
end

src/fsharp/TastOps.fsi

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -581,6 +581,8 @@ module PrettyTypes =
581581
val PrettifyTypes1 : TcGlobals -> TType -> TyparInst * TType * TyparConstraintsWithTypars
582582
val PrettifyTypes2 : TcGlobals -> TType * TType -> TyparInst * (TType * TType) * TyparConstraintsWithTypars
583583
val PrettifyTypesN : TcGlobals -> TType list -> TyparInst * TType list * TyparConstraintsWithTypars
584+
val PrettifyTypesNN : TcGlobals -> TType list list -> TyparInst * TType list list * TyparConstraintsWithTypars
585+
val PrettifyTypesNN1 : TcGlobals -> TType list list * TType -> TyparInst * (TType list list * TType) * TyparConstraintsWithTypars
584586
val PrettifyTypesN1 : TcGlobals -> UncurriedArgInfos * TType -> TyparInst * (UncurriedArgInfos * TType) * TyparConstraintsWithTypars
585587
val PrettifyTypesNM1 : TcGlobals -> TType list * CurriedArgInfos * TType -> TyparInst * (TType list * CurriedArgInfos * TType) * TyparConstraintsWithTypars
586588

src/fsharp/vs/Symbols.fs

Lines changed: 68 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -1533,15 +1533,14 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) =
15331533
// INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for
15341534
// either .NET or F# parameters
15351535
let argInfo : ArgReprInfo = { Name=nmOpt; Attribs= [] }
1536-
yield FSharpParameter(cenv, pty, argInfo, x.DeclarationLocationOpt, isParamArrayArg, isOutArg, optArgInfo.IsOptional) ]
1536+
yield FSharpParameter(cenv, pty, argInfo, x.DeclarationLocationOpt, isParamArrayArg, isOutArg, optArgInfo.IsOptional) ]
15371537
|> makeReadOnlyCollection ]
15381538
|> makeReadOnlyCollection
15391539

15401540
| E _ -> [] |> makeReadOnlyCollection
15411541
| M m ->
1542-
15431542
[ for argtys in m.GetParamDatas(cenv.amap,range0,m.FormalMethodInst) do
1544-
yield
1543+
yield
15451544
[ for (ParamData(isParamArrayArg,isOutArg,optArgInfo,nmOpt,_reflArgInfo,pty)) in argtys do
15461545
// INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for
15471546
// either .NET or F# parameters
@@ -1555,8 +1554,8 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) =
15551554
| None ->
15561555
let _, tau = v.TypeScheme
15571556
if isFunTy cenv.g tau then
1558-
let typeArguments, _typ = stripFunTy cenv.g tau
1559-
[ for typ in typeArguments do
1557+
let argtysl, _typ = stripFunTy cenv.g tau
1558+
[ for typ in argtysl do
15601559
let allArguments =
15611560
if isTupleTy cenv.g typ
15621561
then tryDestTupleTy cenv.g typ
@@ -1571,7 +1570,6 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) =
15711570
let tau = v.TauType
15721571
let argtysl,_ = GetTopTauTypeInFSharpForm cenv.g curriedArgInfos tau range0
15731572
let argtysl = if v.IsInstanceMember then argtysl.Tail else argtysl
1574-
15751573
[ for argtys in argtysl do
15761574
yield
15771575
[ for argty, argInfo in argtys do
@@ -1594,7 +1592,6 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) =
15941592
// For non-standard events, just use the delegate type as the ReturnParameter type
15951593
e.GetDelegateType(cenv.amap,range0)
15961594

1597-
let _, rty, _cxs = PrettyTypes.PrettifyTypes1 cenv.g rty
15981595
FSharpParameter(cenv, rty, retInfo, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false)
15991596

16001597
| P p ->
@@ -1611,16 +1608,12 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) =
16111608
match v.ValReprInfo with
16121609
| None ->
16131610
let _, tau = v.TypeScheme
1614-
if isFunTy cenv.g tau then
1615-
let _typeArguments, rty = stripFunTy cenv.g tau
1616-
FSharpParameter(cenv, rty, { Name=None; Attribs= [] }, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false)
1617-
else
1618-
failwith "not a module let binding or member"
1611+
let _argtysl, rty = stripFunTy cenv.g tau
1612+
let empty : ArgReprInfo = { Name=None; Attribs= [] }
1613+
FSharpParameter(cenv, rty, empty, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false)
16191614
| Some (ValReprInfo(_typars,argInfos,retInfo)) ->
1620-
16211615
let tau = v.TauType
1622-
let _,rty = GetTopTauTypeInFSharpForm cenv.g argInfos tau range0
1623-
1616+
let _c,rty = GetTopTauTypeInFSharpForm cenv.g argInfos tau range0
16241617
FSharpParameter(cenv, rty, retInfo, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false)
16251618

16261619

@@ -1835,27 +1828,77 @@ and FSharpType(cenv, typ:TType) =
18351828
GetSuperTypeOfType cenv.g cenv.amap range0 typ
18361829
|> Option.map (fun ty -> FSharpType(cenv, ty))
18371830

1838-
member x.Instantiate(tys:(FSharpGenericParameter * FSharpType) list) =
1839-
let typI = instType (tys |> List.map (fun (tyv,typ) -> tyv.V, typ.Typ)) typ
1831+
member x.Instantiate(instantiation:(FSharpGenericParameter * FSharpType) list) =
1832+
let typI = instType (instantiation |> List.map (fun (tyv,typ) -> tyv.V, typ.V)) typ
18401833
FSharpType(cenv, typI)
18411834

1842-
member private x.Typ = typ
1835+
member private x.V = typ
1836+
member private x.cenv = cenv
1837+
1838+
member private typ.AdjustType(t) =
1839+
FSharpType(typ.cenv, t)
18431840

18441841
override x.Equals(other : obj) =
18451842
box x === other ||
18461843
match other with
1847-
| :? FSharpType as t -> typeEquiv cenv.g typ t.Typ
1844+
| :? FSharpType as t -> typeEquiv cenv.g typ t.V
18481845
| _ -> false
18491846

18501847
override x.GetHashCode() = hash x
18511848

18521849
member x.Format(denv: FSharpDisplayContext) =
18531850
protect <| fun () ->
1854-
NicePrint.stringOfTy (denv.Contents cenv.g) typ
1851+
NicePrint.prettyStringOfTyHighPrec (denv.Contents cenv.g) typ
18551852

18561853
override x.ToString() =
18571854
protect <| fun () ->
1858-
"type " + NicePrint.stringOfTy (DisplayEnv.Empty(cenv.g)) typ
1855+
"type " + NicePrint.prettyStringOfTyHighPrec (DisplayEnv.Empty(cenv.g)) typ
1856+
1857+
static member Prettify(typ: FSharpType) =
1858+
let t = PrettyTypes.PrettifyTypes1 typ.cenv.g typ.V |> p23
1859+
typ.AdjustType t
1860+
1861+
static member Prettify(typs: IList<FSharpType>) =
1862+
let xs = typs |> List.ofSeq
1863+
match xs with
1864+
| [] -> []
1865+
| h :: _ ->
1866+
let cenv = h.cenv
1867+
let prettyTyps = PrettyTypes.PrettifyTypesN cenv.g [ for t in xs -> t.V ] |> p23
1868+
(xs, prettyTyps) ||> List.map2 (fun p pty -> p.AdjustType(pty))
1869+
|> makeReadOnlyCollection
1870+
1871+
static member Prettify(parameter: FSharpParameter) =
1872+
let prettyTyp = parameter.V |> PrettyTypes.PrettifyTypes1 parameter.cenv.g |> p23
1873+
parameter.AdjustType(prettyTyp)
1874+
1875+
static member Prettify(parameters: IList<FSharpParameter>) =
1876+
let parameters = parameters |> List.ofSeq
1877+
match parameters with
1878+
| [] -> []
1879+
| h :: _ ->
1880+
let cenv = h.cenv
1881+
let prettyTyps = parameters |> List.map (fun p -> p.V) |> PrettyTypes.PrettifyTypesN cenv.g |> p23
1882+
(parameters, prettyTyps) ||> List.map2 (fun p pty -> p.AdjustType(pty))
1883+
|> makeReadOnlyCollection
1884+
1885+
static member Prettify(parameters: IList<IList<FSharpParameter>>) =
1886+
let xs = parameters |> List.ofSeq |> List.map List.ofSeq
1887+
let hOpt = xs |> List.tryPick (function h :: _ -> Some h | _ -> None)
1888+
match hOpt with
1889+
| None -> xs
1890+
| Some h ->
1891+
let cenv = h.cenv
1892+
let prettyTyps = xs |> List.mapSquared (fun p -> p.V) |> PrettyTypes.PrettifyTypesNN cenv.g |> p23
1893+
(xs, prettyTyps) ||> List.map2 (List.map2 (fun p pty -> p.AdjustType(pty)))
1894+
|> List.map makeReadOnlyCollection |> makeReadOnlyCollection
1895+
1896+
static member Prettify(parameters: IList<IList<FSharpParameter>>, returnParameter: FSharpParameter) =
1897+
let xs = parameters |> List.ofSeq |> List.map List.ofSeq
1898+
let cenv = returnParameter.cenv
1899+
let prettyTyps, prettyRetTy = xs |> List.mapSquared (fun p -> p.V) |> (fun tys -> PrettyTypes.PrettifyTypesNN1 cenv.g (tys,returnParameter.V) )|> p23
1900+
let ps = (xs, prettyTyps) ||> List.map2 (List.map2 (fun p pty -> p.AdjustType(pty))) |> List.map makeReadOnlyCollection |> makeReadOnlyCollection
1901+
ps, returnParameter.AdjustType(prettyRetTy)
18591902

18601903
and FSharpAttribute(cenv: cenv, attrib: AttribInfo) =
18611904

@@ -1941,7 +1984,10 @@ and FSharpParameter(cenv, typ:TType, topArgInfo:ArgReprInfo, mOpt, isParamArrayA
19411984
let idOpt = topArgInfo.Name
19421985
let m = match mOpt with Some m -> m | None -> range0
19431986
member __.Name = match idOpt with None -> None | Some v -> Some v.idText
1944-
member __.Type = FSharpType(cenv, typ)
1987+
member __.cenv : cenv = cenv
1988+
member __.AdjustType(t) = FSharpParameter(cenv, t, topArgInfo, mOpt, isParamArrayArg, isOutArg, isOptionalArg)
1989+
member __.Type : FSharpType = FSharpType(cenv, typ)
1990+
member __.V = typ
19451991
member __.DeclarationLocation = match idOpt with None -> m | Some v -> v.idRange
19461992
member __.Attributes =
19471993
attribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) |> makeReadOnlyCollection

src/fsharp/vs/Symbols.fsi

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -810,6 +810,7 @@ and [<Class>] FSharpParameter =
810810
/// Indicate this is an optional argument
811811
member IsOptionalArg: bool
812812

813+
813814
/// A subtype of FSharpSymbol that represents a single case within an active pattern
814815
and [<Class>] FSharpActivePatternCase =
815816
inherit FSharpSymbol
@@ -892,6 +893,30 @@ and [<Class>] FSharpType =
892893
/// if it is an instantiation of a generic type.
893894
member BaseType : FSharpType option
894895

896+
/// Adjust the type by removing any occurrences of type inference variables, replacing them
897+
/// systematically with lower-case type inference variables such as <c>'a</c>.
898+
static member Prettify : typ:FSharpType -> FSharpType
899+
900+
/// Adjust a group of types by removing any occurrences of type inference variables, replacing them
901+
/// systematically with lower-case type inference variables such as <c>'a</c>.
902+
static member Prettify : types: IList<FSharpType> -> IList<FSharpType>
903+
904+
/// Adjust the type in a single parameter by removing any occurrences of type inference variables, replacing them
905+
/// systematically with lower-case type inference variables such as <c>'a</c>.
906+
static member Prettify : parameter: FSharpParameter -> FSharpParameter
907+
908+
/// Adjust the types in a group of parameters by removing any occurrences of type inference variables, replacing them
909+
/// systematically with lower-case type inference variables such as <c>'a</c>.
910+
static member Prettify : parameters: IList<FSharpParameter> -> IList<FSharpParameter>
911+
912+
/// Adjust the types in a group of curried parameters by removing any occurrences of type inference variables, replacing them
913+
/// systematically with lower-case type inference variables such as <c>'a</c>.
914+
static member Prettify : parameters: IList<IList<FSharpParameter>> -> IList<IList<FSharpParameter>>
915+
916+
/// Adjust the types in a group of curried parameters and return type by removing any occurrences of type inference variables, replacing them
917+
/// systematically with lower-case type inference variables such as <c>'a</c>.
918+
static member Prettify : parameters: IList<IList<FSharpParameter>> * returnParameter: FSharpParameter -> IList<IList<FSharpParameter>> * FSharpParameter
919+
895920
[<System.Obsolete("Renamed to HasTypeDefinition")>]
896921
member IsNamedType : bool
897922

tests/service/ProjectAnalysisTests.fs

Lines changed: 81 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -202,7 +202,7 @@ let ``Test project1 whole project errors`` () =
202202
wholeProjectResults.Errors.[0].EndColumn |> shouldEqual 44
203203

204204
[<Test>]
205-
let ``Test project1 should have protected FullName and TryFullName return same results`` () =
205+
let ``Test project39 should have protected FullName and TryFullName return same results`` () =
206206
let wholeProjectResults = checker.ParseAndCheckProject(Project1.options) |> Async.RunSynchronously
207207
let rec getFullNameComparisons (entity: FSharpEntity) =
208208
seq { if not entity.IsProvided && entity.Accessibility.IsPublic then
@@ -4690,3 +4690,83 @@ let ``Test project38 abstract slot information`` () =
46904690
"get_Property", ["type OverrideTests.B<'YY> original generics: <'Y> with member get_Property : () -> Microsoft.FSharp.Core.int"]
46914691
"get_Event", ["type OverrideTests.B<'YY> with member get_Event : () -> Microsoft.FSharp.Core.unit"]
46924692
|]
4693+
4694+
4695+
module Project39 =
4696+
open System.IO
4697+
4698+
let fileName1 = Path.ChangeExtension(Path.GetTempFileName(), ".fs")
4699+
let base2 = Path.GetTempFileName()
4700+
let dllName = Path.ChangeExtension(base2, ".dll")
4701+
let projFileName = Path.ChangeExtension(base2, ".fsproj")
4702+
let fileSource1 = """
4703+
module M
4704+
4705+
let functionWithIncompleteSignature x = System.ThisDoesntExist.SomeMethod(x)
4706+
let curriedFunctionWithIncompleteSignature (x1:'a) x2 (x3:'a,x4) =
4707+
(x2 = x4) |> ignore
4708+
System.ThisDoesntExist.SomeMethod(x1,x2,x3,x4)
4709+
4710+
type C() =
4711+
member x.MemberWithIncompleteSignature x = System.ThisDoesntExist.SomeMethod(x)
4712+
member x.CurriedMemberWithIncompleteSignature (x1:'a) x2 (x3:'a,x4) =
4713+
(x2 = x4) |> ignore
4714+
System.ThisDoesntExist.SomeMethod(x1,x2,x3,x4)
4715+
4716+
let uses () =
4717+
functionWithIncompleteSignature (failwith "something")
4718+
curriedFunctionWithIncompleteSignature (failwith "x1") (failwith "x2") (failwith "x3", failwith "x4")
4719+
C().MemberWithIncompleteSignature (failwith "something")
4720+
C().CurriedMemberWithIncompleteSignature (failwith "x1") (failwith "x2") (failwith "x3", failwith "x4")
4721+
"""
4722+
File.WriteAllText(fileName1, fileSource1)
4723+
let fileNames = [fileName1]
4724+
let args = mkProjectCommandLineArgs (dllName, fileNames)
4725+
let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args)
4726+
let cleanFileName a = if a = fileName1 then "file1" else "??"
4727+
4728+
[<Test>]
4729+
let ``Test project39 all symbols`` () =
4730+
4731+
let wholeProjectResults = checker.ParseAndCheckProject(Project39.options) |> Async.RunSynchronously
4732+
let allSymbolUses = wholeProjectResults.GetAllUsesOfAllSymbols() |> Async.RunSynchronously
4733+
let typeTextOfAllSymbolUses =
4734+
[ for s in allSymbolUses do
4735+
match s.Symbol with
4736+
| :? FSharpMemberOrFunctionOrValue as mem ->
4737+
if s.Symbol.DisplayName.Contains "Incomplete" then
4738+
yield s.Symbol.DisplayName, tups s.RangeAlternate,
4739+
("full", mem.FullType |> FSharpType.Prettify |> fun p -> p.Format(s.DisplayContext)),
4740+
("params", mem.CurriedParameterGroups |> FSharpType.Prettify |> Seq.toList |> List.map (Seq.toList >> List.map (fun p -> p.Type.Format(s.DisplayContext)))),
4741+
("return", mem.ReturnParameter |> FSharpType.Prettify |> fun p -> p.Type.Format(s.DisplayContext))
4742+
| _ -> () ]
4743+
typeTextOfAllSymbolUses |> shouldEqual
4744+
[("functionWithIncompleteSignature", ((4, 4), (4, 35)),
4745+
("full", "'a -> 'b"), ("params", [["'a"]]), ("return", "'b"));
4746+
("curriedFunctionWithIncompleteSignature", ((5, 4), (5, 42)),
4747+
("full", "'a -> 'a0 -> 'a * 'a0 -> 'b when 'a0 : equality"),
4748+
("params",
4749+
[["'a"]; ["'a0 when 'a0 : equality"]; ["'a"; "'a0 when 'a0 : equality"]]),
4750+
("return", "'b"));
4751+
("MemberWithIncompleteSignature", ((10, 13), (10, 42)),
4752+
("full", "C -> 'c -> 'd"), ("params", [["'c"]]), ("return", "'d"));
4753+
("CurriedMemberWithIncompleteSignature", ((11, 13), (11, 49)),
4754+
("full", "C -> 'a -> 'a0 -> 'a * 'a0 -> 'b when 'a0 : equality"),
4755+
("params",
4756+
[["'a"]; ["'a0 when 'a0 : equality"]; ["'a"; "'a0 when 'a0 : equality"]]),
4757+
("return", "'b"));
4758+
("functionWithIncompleteSignature", ((16, 3), (16, 34)),
4759+
("full", "'a -> 'b"), ("params", [["'a"]]), ("return", "'b"));
4760+
("curriedFunctionWithIncompleteSignature", ((17, 3), (17, 41)),
4761+
("full", "'a -> 'a0 -> 'a * 'a0 -> 'b when 'a0 : equality"),
4762+
("params",
4763+
[["'a"]; ["'a0 when 'a0 : equality"]; ["'a"; "'a0 when 'a0 : equality"]]),
4764+
("return", "'b"));
4765+
("MemberWithIncompleteSignature", ((18, 3), (18, 36)),
4766+
("full", "'c -> 'd"), ("params", [["'c"]]), ("return", "'d"));
4767+
("CurriedMemberWithIncompleteSignature", ((19, 3), (19, 43)),
4768+
("full", "'a -> 'a0 -> 'a * 'a0 -> 'b when 'a0 : equality"),
4769+
("params",
4770+
[["'a"]; ["'a0 when 'a0 : equality"]; ["'a"; "'a0 when 'a0 : equality"]]),
4771+
("return", "'b"))]
4772+

0 commit comments

Comments
 (0)