Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 5 additions & 2 deletions src/fsharp/NicePrint.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion src/fsharp/TastOps.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 2 additions & 0 deletions src/fsharp/TastOps.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
90 changes: 68 additions & 22 deletions src/fsharp/vs/Symbols.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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 ->
Expand All @@ -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)


Expand Down Expand Up @@ -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) =

Expand Down Expand Up @@ -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
Expand Down
25 changes: 25 additions & 0 deletions src/fsharp/vs/Symbols.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down
82 changes: 81 additions & 1 deletion tests/service/ProjectAnalysisTests.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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"))]