From ca56a206d6d495b42875b88ab4c56566c14bdeb1 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Thu, 19 Oct 2017 00:12:23 +0300 Subject: [PATCH 01/16] use QuickParse to get proper full idents island in UnusedOpensDiagnosticAnalyzer --- Diagnostics/UnusedOpensDiagnosticAnalyzer.fs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs index 0dcb5c9da5d..1d0f33a32c6 100644 --- a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs +++ b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs @@ -74,11 +74,9 @@ module private UnusedOpens = | None -> [] let symbolIsFullyQualified (sourceText: SourceText) (sym: FSharpSymbolUse) (fullName: string) = - match RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, sym.RangeAlternate) with - | Some span // check that the symbol hasn't provided an invalid span - when sourceText.Length < span.Start - || sourceText.Length < span.End -> false - | Some span -> sourceText.ToString span = fullName + let lineStr = sourceText.Lines.[Line.toZ sym.RangeAlternate.StartLine].ToString() + match QuickParse.GetCompleteIdentifierIsland true lineStr sym.RangeAlternate.EndColumn with + | Some (island, _, _) -> island = fullName | None -> false let getUnusedOpens (sourceText: SourceText) (parsedInput: ParsedInput) (symbolUses: FSharpSymbolUse[]) = From b49207ec44aa8524b65388186cd82748407a6ad0 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Thu, 19 Oct 2017 17:16:31 +0300 Subject: [PATCH 02/16] module scope aware unused opens --- Diagnostics/UnusedOpensDiagnosticAnalyzer.fs | 86 ++++++++++++-------- 1 file changed, 54 insertions(+), 32 deletions(-) diff --git a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs index 1d0f33a32c6..d470eefed8e 100644 --- a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs +++ b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs @@ -17,28 +17,39 @@ open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.SourceCodeServices open Symbols - module private UnusedOpens = - - - let rec visitSynModuleOrNamespaceDecls (parent: Ast.LongIdent) decls : (Set * range) list = + /// Represents single open statement. + type OpenStatement = + { /// Open namespace or module effective names. + Names: Set + /// Range of open statement itself. + Range: range + /// Enclosing module or namespace range (that is, the scope on in which this open statement is visible). + ModuleRange: range } + + let rec visitSynModuleOrNamespaceDecls (parent: Ast.LongIdent) (decls: SynModuleDecls) (moduleRange: range) : OpenStatement list = [ for decl in decls do match decl with | SynModuleDecl.Open(LongIdentWithDots.LongIdentWithDots(id = longId), range) -> yield - set [ yield (longId |> List.map(fun l -> l.idText) |> String.concat ".") - // `open N.M` can open N.M module from parent module as well, if it's non empty - if not (List.isEmpty parent) then - yield (parent @ longId |> List.map(fun l -> l.idText) |> String.concat ".") ], range - | SynModuleDecl.NestedModule(SynComponentInfo.ComponentInfo(longId = longId),_, decls,_,_) -> - yield! visitSynModuleOrNamespaceDecls longId decls + { Names = + set [ yield (longId |> List.map(fun l -> l.idText) |> String.concat ".") + // `open N.M` can open N.M module from parent module as well, if it's non empty + if not (List.isEmpty parent) then + yield (parent @ longId |> List.map(fun l -> l.idText) |> String.concat ".") ] + Range = range + ModuleRange = moduleRange } + + | SynModuleDecl.NestedModule(SynComponentInfo.ComponentInfo(longId = longId),_, decls,_,moduleRange) -> + yield! visitSynModuleOrNamespaceDecls longId decls moduleRange | _ -> () ] - let getOpenStatements = function + let getOpenStatements (parsedInput: ParsedInput) : OpenStatement list = + match parsedInput with | ParsedInput.ImplFile (ParsedImplFileInput(modules = modules)) -> [ for md in modules do - let SynModuleOrNamespace(longId = longId; decls = decls) = md - yield! visitSynModuleOrNamespaceDecls longId decls ] + let SynModuleOrNamespace(longId = longId; decls = decls; range = moduleRange) = md + yield! visitSynModuleOrNamespaceDecls longId decls moduleRange ] | _ -> [] let getAutoOpenAccessPath (ent:FSharpEntity) = @@ -79,7 +90,11 @@ module private UnusedOpens = | Some (island, _, _) -> island = fullName | None -> false - let getUnusedOpens (sourceText: SourceText) (parsedInput: ParsedInput) (symbolUses: FSharpSymbolUse[]) = + type NamespaceUse = + { Ident: string + Location: range } + + let getUnusedOpens (sourceText: SourceText) (parsedInput: ParsedInput) (symbolUses: FSharpSymbolUse[]) : range list = let getPartNamespace (symbolUse: FSharpSymbolUse) (fullName: string) = // given a symbol range such as `Text.ISegment` and a full name of `MonoDevelop.Core.Text.ISegment`, return `MonoDevelop.Core` @@ -117,25 +132,32 @@ module private UnusedOpens = yield! entityNamespace declaringEntity ] } |> Option.toList |> List.concat |> List.choose id - let namespacesInUse = + let namespacesInUse : NamespaceUse list = symbolUses - |> Seq.filter (fun (s: FSharpSymbolUse) -> not s.IsFromDefinition) - |> Seq.collect getPossibleNamespaces - |> Set.ofSeq - - let filter list: (Set * range) list = - let rec filterInner acc list (seenNamespaces: Set) = - let notUsed ns = not (namespacesInUse.Contains ns) || seenNamespaces.Contains ns + |> Array.filter (fun (s: FSharpSymbolUse) -> not s.IsFromDefinition) + |> Array.toList + |> List.collect (fun x -> + getPossibleNamespaces x + |> List.distinct + |> List.map (fun ns -> { Ident = ns; Location = x.RangeAlternate })) + + let filter list: OpenStatement list = + let rec filterInner acc (list: OpenStatement list) (seenOpenStatements: OpenStatement list) = + + let notUsed (os: OpenStatement) = + not (namespacesInUse |> List.exists (fun nsu -> rangeContainsRange os.ModuleRange nsu.Location && os.Names |> Set.contains nsu.Ident)) + || seenOpenStatements |> List.contains os + match list with - | (ns, range) :: xs when ns |> Set.forall notUsed -> - filterInner ((ns, range) :: acc) xs (seenNamespaces |> Set.union ns) - | (ns, _) :: xs -> - filterInner acc xs (seenNamespaces |> Set.union ns) + | os :: xs when notUsed os -> + filterInner (os :: acc) xs (os :: seenOpenStatements) + | os :: xs -> + filterInner acc xs (os :: seenOpenStatements) | [] -> List.rev acc - filterInner [] list Set.empty + + filterInner [] list [] - let openStatements = getOpenStatements parsedInput - openStatements |> filter |> List.map snd + parsedInput |> getOpenStatements |> filter |> List.map (fun os -> os.Range) [] type internal UnusedOpensDiagnosticAnalyzer() = @@ -158,7 +180,7 @@ type internal UnusedOpensDiagnosticAnalyzer() = override __.SupportedDiagnostics = ImmutableArray.Create Descriptor override this.AnalyzeSyntaxAsync(_, _) = Task.FromResult ImmutableArray.Empty - static member GetUnusedOpenRanges(document: Document, options, checker: FSharpChecker) = + static member GetUnusedOpenRanges(document: Document, options, checker: FSharpChecker) : Async> = asyncMaybe { do! Option.guard Settings.CodeFixes.UnusedOpens let! sourceText = document.GetTextAsync() @@ -178,10 +200,10 @@ type internal UnusedOpensDiagnosticAnalyzer() = return unusedOpens - |> List.map (fun m -> + |> List.map (fun range -> Diagnostic.Create( Descriptor, - RoslynHelpers.RangeToLocation(m, sourceText, document.FilePath))) + RoslynHelpers.RangeToLocation(range, sourceText, document.FilePath))) |> Seq.toImmutableArray } |> Async.map (Option.defaultValue ImmutableArray.Empty) From 5a47fce4185e4c0d0d41909c835430c20158fffa Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Thu, 19 Oct 2017 20:47:07 +0300 Subject: [PATCH 03/16] fix notUsed logic --- Diagnostics/UnusedOpensDiagnosticAnalyzer.fs | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs index d470eefed8e..17ae3e3dbc1 100644 --- a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs +++ b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs @@ -145,8 +145,17 @@ module private UnusedOpens = let rec filterInner acc (list: OpenStatement list) (seenOpenStatements: OpenStatement list) = let notUsed (os: OpenStatement) = - not (namespacesInUse |> List.exists (fun nsu -> rangeContainsRange os.ModuleRange nsu.Location && os.Names |> Set.contains nsu.Ident)) - || seenOpenStatements |> List.contains os + let notUsedAnywhere = not (namespacesInUse |> List.exists (fun nsu -> rangeContainsRange os.ModuleRange nsu.Location && os.Names |> Set.contains nsu.Ident)) + if notUsedAnywhere then true + else + let alreadySeen = + seenOpenStatements + |> List.exists (fun seenNs -> + // if such open statement has already been marked as used in this or outer module, we skip it + // (that is, do not mark as used so far) + (seenNs.ModuleRange = os.ModuleRange || rangeContainsRange seenNs.ModuleRange os.ModuleRange) && + not (os.Names |> Set.intersect seenNs.Names |> Set.isEmpty)) + alreadySeen match list with | os :: xs when notUsed os -> From 3473f8a9f430440834643fb44106baf18c3591a2 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Thu, 19 Oct 2017 22:01:46 +0300 Subject: [PATCH 04/16] start adding UnusedOpensDiagnosticAnalyzer tests --- Diagnostics/UnusedOpensDiagnosticAnalyzer.fs | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs index 17ae3e3dbc1..9b2aff4d31d 100644 --- a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs +++ b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs @@ -17,9 +17,9 @@ open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.SourceCodeServices open Symbols -module private UnusedOpens = +module internal UnusedOpens = /// Represents single open statement. - type OpenStatement = + type private OpenStatement = { /// Open namespace or module effective names. Names: Set /// Range of open statement itself. @@ -27,7 +27,7 @@ module private UnusedOpens = /// Enclosing module or namespace range (that is, the scope on in which this open statement is visible). ModuleRange: range } - let rec visitSynModuleOrNamespaceDecls (parent: Ast.LongIdent) (decls: SynModuleDecls) (moduleRange: range) : OpenStatement list = + let rec private visitSynModuleOrNamespaceDecls (parent: Ast.LongIdent) (decls: SynModuleDecls) (moduleRange: range) : OpenStatement list = [ for decl in decls do match decl with | SynModuleDecl.Open(LongIdentWithDots.LongIdentWithDots(id = longId), range) -> @@ -44,7 +44,7 @@ module private UnusedOpens = yield! visitSynModuleOrNamespaceDecls longId decls moduleRange | _ -> () ] - let getOpenStatements (parsedInput: ParsedInput) : OpenStatement list = + let private getOpenStatements (parsedInput: ParsedInput) : OpenStatement list = match parsedInput with | ParsedInput.ImplFile (ParsedImplFileInput(modules = modules)) -> [ for md in modules do @@ -52,7 +52,7 @@ module private UnusedOpens = yield! visitSynModuleOrNamespaceDecls longId decls moduleRange ] | _ -> [] - let getAutoOpenAccessPath (ent:FSharpEntity) = + let private getAutoOpenAccessPath (ent:FSharpEntity) = // Some.Namespace+AutoOpenedModule+Entity // HACK: I can't see a way to get the EnclosingEntity of an Entity @@ -63,7 +63,7 @@ module private UnusedOpens = else None) - let entityNamespace (entOpt: FSharpEntity option) = + let private entityNamespace (entOpt: FSharpEntity option) = match entOpt with | Some ent -> if ent.IsFSharpModule then @@ -84,18 +84,17 @@ module private UnusedOpens = ] | None -> [] - let symbolIsFullyQualified (sourceText: SourceText) (sym: FSharpSymbolUse) (fullName: string) = + let private symbolIsFullyQualified (sourceText: SourceText) (sym: FSharpSymbolUse) (fullName: string) = let lineStr = sourceText.Lines.[Line.toZ sym.RangeAlternate.StartLine].ToString() match QuickParse.GetCompleteIdentifierIsland true lineStr sym.RangeAlternate.EndColumn with | Some (island, _, _) -> island = fullName | None -> false - type NamespaceUse = + type private NamespaceUse = { Ident: string Location: range } let getUnusedOpens (sourceText: SourceText) (parsedInput: ParsedInput) (symbolUses: FSharpSymbolUse[]) : range list = - let getPartNamespace (symbolUse: FSharpSymbolUse) (fullName: string) = // given a symbol range such as `Text.ISegment` and a full name of `MonoDevelop.Core.Text.ISegment`, return `MonoDevelop.Core` let length = symbolUse.RangeAlternate.EndColumn - symbolUse.RangeAlternate.StartColumn From 53c64993956cddfaca4f56da17a23df46a2e245d Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Fri, 20 Oct 2017 12:15:46 +0300 Subject: [PATCH 05/16] fix some test, ignore other --- Diagnostics/UnusedOpensDiagnosticAnalyzer.fs | 52 ++++++++++++++------ 1 file changed, 38 insertions(+), 14 deletions(-) diff --git a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs index 9b2aff4d31d..890b3bd75e2 100644 --- a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs +++ b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs @@ -20,8 +20,10 @@ open Symbols module internal UnusedOpens = /// Represents single open statement. type private OpenStatement = - { /// Open namespace or module effective names. - Names: Set + { /// Full namespace or module identifier as it's presented in source code. + LiteralIdent: string + /// All possible namespace or module identifiers, including the literal one. + AllPossibleIdents: Set /// Range of open statement itself. Range: range /// Enclosing module or namespace range (that is, the scope on in which this open statement is visible). @@ -31,9 +33,11 @@ module internal UnusedOpens = [ for decl in decls do match decl with | SynModuleDecl.Open(LongIdentWithDots.LongIdentWithDots(id = longId), range) -> + let literalIdent = longId |> List.map(fun l -> l.idText) |> String.concat "." yield - { Names = - set [ yield (longId |> List.map(fun l -> l.idText) |> String.concat ".") + { LiteralIdent = literalIdent + AllPossibleIdents = + set [ yield literalIdent // `open N.M` can open N.M module from parent module as well, if it's non empty if not (List.isEmpty parent) then yield (parent @ longId |> List.map(fun l -> l.idText) |> String.concat ".") ] @@ -127,24 +131,45 @@ module internal UnusedOpens = return [ for name in fullNames do - yield getPartNamespace symbolUse name + let partNamespace = getPartNamespace symbolUse name + yield partNamespace yield! entityNamespace declaringEntity ] } |> Option.toList |> List.concat |> List.choose id let namespacesInUse : NamespaceUse list = - symbolUses - |> Array.filter (fun (s: FSharpSymbolUse) -> not s.IsFromDefinition) + let importantSymbolUses = + symbolUses + |> Array.filter (fun (symbolUse: FSharpSymbolUse) -> + not symbolUse.IsFromDefinition && + match symbolUse.Symbol with + | :? FSharpEntity as e -> not e.IsNamespace + | _ -> true + ) + + importantSymbolUses |> Array.toList - |> List.collect (fun x -> - getPossibleNamespaces x - |> List.distinct - |> List.map (fun ns -> { Ident = ns; Location = x.RangeAlternate })) + |> List.collect (fun su -> + let lineStr = sourceText.Lines.[Line.toZ su.RangeAlternate.StartLine].ToString() + let partialName = QuickParse.GetPartialLongNameEx(lineStr, su.RangeAlternate.EndColumn - 1) + let qualifier = partialName.QualifyingIdents |> String.concat "." + getPossibleNamespaces su + |> List.distinct + |> List.choose (fun ns -> + if qualifier = "" then Some ns + elif ns = qualifier then None + elif ns.EndsWith qualifier then Some ns.[..(ns.Length - qualifier.Length) - 2] + else None) + |> List.map (fun ns -> + { Ident = ns + Location = su.RangeAlternate })) let filter list: OpenStatement list = let rec filterInner acc (list: OpenStatement list) (seenOpenStatements: OpenStatement list) = let notUsed (os: OpenStatement) = - let notUsedAnywhere = not (namespacesInUse |> List.exists (fun nsu -> rangeContainsRange os.ModuleRange nsu.Location && os.Names |> Set.contains nsu.Ident)) + let notUsedAnywhere = + not (namespacesInUse |> List.exists (fun nsu -> + rangeContainsRange os.ModuleRange nsu.Location && os.AllPossibleIdents |> Set.contains nsu.Ident)) if notUsedAnywhere then true else let alreadySeen = @@ -152,8 +177,7 @@ module internal UnusedOpens = |> List.exists (fun seenNs -> // if such open statement has already been marked as used in this or outer module, we skip it // (that is, do not mark as used so far) - (seenNs.ModuleRange = os.ModuleRange || rangeContainsRange seenNs.ModuleRange os.ModuleRange) && - not (os.Names |> Set.intersect seenNs.Names |> Set.isEmpty)) + rangeContainsRange seenNs.ModuleRange os.ModuleRange && os.LiteralIdent = seenNs.LiteralIdent) alreadySeen match list with From d4e310a0718a702198d345d04cd7197948e4cb9d Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Fri, 20 Oct 2017 14:04:09 +0300 Subject: [PATCH 06/16] fix and ignore tests --- Diagnostics/UnusedOpensDiagnosticAnalyzer.fs | 28 +++++++++++--------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs index 890b3bd75e2..7130c30cb4f 100644 --- a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs +++ b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs @@ -166,21 +166,23 @@ module internal UnusedOpens = let filter list: OpenStatement list = let rec filterInner acc (list: OpenStatement list) (seenOpenStatements: OpenStatement list) = - let notUsed (os: OpenStatement) = - let notUsedAnywhere = - not (namespacesInUse |> List.exists (fun nsu -> - rangeContainsRange os.ModuleRange nsu.Location && os.AllPossibleIdents |> Set.contains nsu.Ident)) - if notUsedAnywhere then true + let notUsed (os: OpenStatement) = + if os.LiteralIdent.StartsWith "`global`" then false else - let alreadySeen = - seenOpenStatements - |> List.exists (fun seenNs -> - // if such open statement has already been marked as used in this or outer module, we skip it - // (that is, do not mark as used so far) - rangeContainsRange seenNs.ModuleRange os.ModuleRange && os.LiteralIdent = seenNs.LiteralIdent) - alreadySeen + let notUsedAnywhere = + not (namespacesInUse |> List.exists (fun nsu -> + rangeContainsRange os.ModuleRange nsu.Location && os.AllPossibleIdents |> Set.contains nsu.Ident)) + if notUsedAnywhere then true + else + let alreadySeen = + seenOpenStatements + |> List.exists (fun seenNs -> + // if such open statement has already been marked as used in this or outer module, we skip it + // (that is, do not mark as used so far) + rangeContainsRange seenNs.ModuleRange os.ModuleRange && os.LiteralIdent = seenNs.LiteralIdent) + alreadySeen - match list with + match list with | os :: xs when notUsed os -> filterInner (os :: acc) xs (os :: seenOpenStatements) | os :: xs -> From 5b3443ffa331dee2e61881937188c0ff3ee46ecb Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Fri, 20 Oct 2017 16:26:48 +0300 Subject: [PATCH 07/16] move Unused Opens analyzer core logic to FCS --- Diagnostics/UnusedOpensDiagnosticAnalyzer.fs | 180 +--------------- LanguageService/Symbols.fs | 216 +------------------ 2 files changed, 3 insertions(+), 393 deletions(-) diff --git a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs index 7130c30cb4f..487e6520a9b 100644 --- a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs +++ b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs @@ -15,183 +15,7 @@ open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.SourceCodeServices -open Symbols - -module internal UnusedOpens = - /// Represents single open statement. - type private OpenStatement = - { /// Full namespace or module identifier as it's presented in source code. - LiteralIdent: string - /// All possible namespace or module identifiers, including the literal one. - AllPossibleIdents: Set - /// Range of open statement itself. - Range: range - /// Enclosing module or namespace range (that is, the scope on in which this open statement is visible). - ModuleRange: range } - - let rec private visitSynModuleOrNamespaceDecls (parent: Ast.LongIdent) (decls: SynModuleDecls) (moduleRange: range) : OpenStatement list = - [ for decl in decls do - match decl with - | SynModuleDecl.Open(LongIdentWithDots.LongIdentWithDots(id = longId), range) -> - let literalIdent = longId |> List.map(fun l -> l.idText) |> String.concat "." - yield - { LiteralIdent = literalIdent - AllPossibleIdents = - set [ yield literalIdent - // `open N.M` can open N.M module from parent module as well, if it's non empty - if not (List.isEmpty parent) then - yield (parent @ longId |> List.map(fun l -> l.idText) |> String.concat ".") ] - Range = range - ModuleRange = moduleRange } - - | SynModuleDecl.NestedModule(SynComponentInfo.ComponentInfo(longId = longId),_, decls,_,moduleRange) -> - yield! visitSynModuleOrNamespaceDecls longId decls moduleRange - | _ -> () ] - - let private getOpenStatements (parsedInput: ParsedInput) : OpenStatement list = - match parsedInput with - | ParsedInput.ImplFile (ParsedImplFileInput(modules = modules)) -> - [ for md in modules do - let SynModuleOrNamespace(longId = longId; decls = decls; range = moduleRange) = md - yield! visitSynModuleOrNamespaceDecls longId decls moduleRange ] - | _ -> [] - - let private getAutoOpenAccessPath (ent:FSharpEntity) = - // Some.Namespace+AutoOpenedModule+Entity - - // HACK: I can't see a way to get the EnclosingEntity of an Entity - // Some.Namespace + Some.Namespace.AutoOpenedModule are both valid - ent.TryFullName |> Option.bind(fun _ -> - if (not ent.IsNamespace) && ent.QualifiedName.Contains "+" then - Some ent.QualifiedName.[0..ent.QualifiedName.IndexOf "+" - 1] - else - None) - - let private entityNamespace (entOpt: FSharpEntity option) = - match entOpt with - | Some ent -> - if ent.IsFSharpModule then - [ yield Some ent.QualifiedName - yield Some ent.LogicalName - yield Some ent.AccessPath - yield Some ent.FullName - yield Some ent.DisplayName - yield ent.TryGetFullDisplayName() - if ent.HasFSharpModuleSuffix then - yield Some (ent.AccessPath + "." + ent.DisplayName)] - else - [ yield ent.Namespace - yield Some ent.AccessPath - yield getAutoOpenAccessPath ent - for path in ent.AllCompilationPaths do - yield Some path - ] - | None -> [] - - let private symbolIsFullyQualified (sourceText: SourceText) (sym: FSharpSymbolUse) (fullName: string) = - let lineStr = sourceText.Lines.[Line.toZ sym.RangeAlternate.StartLine].ToString() - match QuickParse.GetCompleteIdentifierIsland true lineStr sym.RangeAlternate.EndColumn with - | Some (island, _, _) -> island = fullName - | None -> false - - type private NamespaceUse = - { Ident: string - Location: range } - - let getUnusedOpens (sourceText: SourceText) (parsedInput: ParsedInput) (symbolUses: FSharpSymbolUse[]) : range list = - let getPartNamespace (symbolUse: FSharpSymbolUse) (fullName: string) = - // given a symbol range such as `Text.ISegment` and a full name of `MonoDevelop.Core.Text.ISegment`, return `MonoDevelop.Core` - let length = symbolUse.RangeAlternate.EndColumn - symbolUse.RangeAlternate.StartColumn - let lengthDiff = fullName.Length - length - 2 - if lengthDiff <= 0 || lengthDiff > fullName.Length - 1 then None - else Some fullName.[0..lengthDiff] - - let getPossibleNamespaces (symbolUse: FSharpSymbolUse) : string list = - let isQualified = symbolIsFullyQualified sourceText symbolUse - maybe { - let! fullNames, declaringEntity = - match symbolUse with - | SymbolUse.Entity (ent, cleanFullNames) when not (cleanFullNames |> List.exists isQualified) -> - Some (cleanFullNames, Some ent) - | SymbolUse.Field f when not (isQualified f.FullName) -> - Some ([f.FullName], Some f.DeclaringEntity) - | SymbolUse.MemberFunctionOrValue mfv when not (isQualified mfv.FullName) -> - Some ([mfv.FullName], mfv.EnclosingEntity) - | SymbolUse.Operator op when not (isQualified op.FullName) -> - Some ([op.FullName], op.EnclosingEntity) - | SymbolUse.ActivePattern ap when not (isQualified ap.FullName) -> - Some ([ap.FullName], ap.EnclosingEntity) - | SymbolUse.ActivePatternCase apc when not (isQualified apc.FullName) -> - Some ([apc.FullName], apc.Group.EnclosingEntity) - | SymbolUse.UnionCase uc when not (isQualified uc.FullName) -> - Some ([uc.FullName], Some uc.ReturnType.TypeDefinition) - | SymbolUse.Parameter p when not (isQualified p.FullName) && p.Type.HasTypeDefinition -> - Some ([p.FullName], Some p.Type.TypeDefinition) - | _ -> None - - return - [ for name in fullNames do - let partNamespace = getPartNamespace symbolUse name - yield partNamespace - yield! entityNamespace declaringEntity ] - } |> Option.toList |> List.concat |> List.choose id - - let namespacesInUse : NamespaceUse list = - let importantSymbolUses = - symbolUses - |> Array.filter (fun (symbolUse: FSharpSymbolUse) -> - not symbolUse.IsFromDefinition && - match symbolUse.Symbol with - | :? FSharpEntity as e -> not e.IsNamespace - | _ -> true - ) - - importantSymbolUses - |> Array.toList - |> List.collect (fun su -> - let lineStr = sourceText.Lines.[Line.toZ su.RangeAlternate.StartLine].ToString() - let partialName = QuickParse.GetPartialLongNameEx(lineStr, su.RangeAlternate.EndColumn - 1) - let qualifier = partialName.QualifyingIdents |> String.concat "." - getPossibleNamespaces su - |> List.distinct - |> List.choose (fun ns -> - if qualifier = "" then Some ns - elif ns = qualifier then None - elif ns.EndsWith qualifier then Some ns.[..(ns.Length - qualifier.Length) - 2] - else None) - |> List.map (fun ns -> - { Ident = ns - Location = su.RangeAlternate })) - - let filter list: OpenStatement list = - let rec filterInner acc (list: OpenStatement list) (seenOpenStatements: OpenStatement list) = - - let notUsed (os: OpenStatement) = - if os.LiteralIdent.StartsWith "`global`" then false - else - let notUsedAnywhere = - not (namespacesInUse |> List.exists (fun nsu -> - rangeContainsRange os.ModuleRange nsu.Location && os.AllPossibleIdents |> Set.contains nsu.Ident)) - if notUsedAnywhere then true - else - let alreadySeen = - seenOpenStatements - |> List.exists (fun seenNs -> - // if such open statement has already been marked as used in this or outer module, we skip it - // (that is, do not mark as used so far) - rangeContainsRange seenNs.ModuleRange os.ModuleRange && os.LiteralIdent = seenNs.LiteralIdent) - alreadySeen - - match list with - | os :: xs when notUsed os -> - filterInner (os :: acc) xs (os :: seenOpenStatements) - | os :: xs -> - filterInner acc xs (os :: seenOpenStatements) - | [] -> List.rev acc - - filterInner [] list [] - - parsedInput |> getOpenStatements |> filter |> List.map (fun os -> os.Range) +open Microsoft.VisualStudio.FSharp.Editor.Symbols [] type internal UnusedOpensDiagnosticAnalyzer() = @@ -220,7 +44,7 @@ type internal UnusedOpensDiagnosticAnalyzer() = let! sourceText = document.GetTextAsync() let! _, parsedInput, checkResults = checker.ParseAndCheckDocument(document, options, sourceText = sourceText, allowStaleResults = true, userOpName = userOpName) let! symbolUses = checkResults.GetAllUsesOfAllSymbolsInFile() |> liftAsync - return UnusedOpens.getUnusedOpens sourceText parsedInput symbolUses + return UnusedOpens.getUnusedOpens(symbolUses, parsedInput, fun lineNumber -> sourceText.Lines.[Line.toZ lineNumber].ToString()) } override this.AnalyzeSemanticsAsync(document: Document, cancellationToken: CancellationToken) = diff --git a/LanguageService/Symbols.fs b/LanguageService/Symbols.fs index 1ed87724e3f..13de16c081c 100644 --- a/LanguageService/Symbols.fs +++ b/LanguageService/Symbols.fs @@ -130,218 +130,4 @@ type FSharpEntity with | _ -> () | _ -> () ] - allBaseTypes x - - - - -/// Active patterns over `FSharpSymbolUse`. -module SymbolUse = - - let (|ActivePatternCase|_|) (symbol : FSharpSymbolUse) = - match symbol.Symbol with - | :? FSharpActivePatternCase as ap-> ActivePatternCase(ap) |> Some - | _ -> None - - let private attributeSuffixLength = "Attribute".Length - - let (|Entity|_|) (symbol : FSharpSymbolUse) : (FSharpEntity * (* cleanFullNames *) string list) option = - match symbol.Symbol with - | :? FSharpEntity as ent -> - // strip generic parameters count suffix (List`1 => List) - let cleanFullName = - // `TryFullName` for type aliases is always `None`, so we have to make one by our own - if ent.IsFSharpAbbreviation then - [ent.AccessPath + "." + ent.DisplayName] - else - ent.TryFullName - |> Option.toList - |> List.map (fun fullName -> - if ent.GenericParameters.Count > 0 && fullName.Length > 2 then - fullName.[0..fullName.Length - 3] - else fullName) - - let cleanFullNames = - cleanFullName - |> List.collect (fun cleanFullName -> - if ent.IsAttributeType then - [cleanFullName; cleanFullName.[0..cleanFullName.Length - attributeSuffixLength - 1]] - else [cleanFullName] - ) - Some (ent, cleanFullNames) - | _ -> None - - - let (|Field|_|) (symbol : FSharpSymbolUse) = - match symbol.Symbol with - | :? FSharpField as field-> Some field - | _ -> None - - let (|GenericParameter|_|) (symbol: FSharpSymbolUse) = - match symbol.Symbol with - | :? FSharpGenericParameter as gp -> Some gp - | _ -> None - - let (|MemberFunctionOrValue|_|) (symbol : FSharpSymbolUse) = - match symbol.Symbol with - | :? FSharpMemberOrFunctionOrValue as func -> Some func - | _ -> None - - let (|ActivePattern|_|) = function - | MemberFunctionOrValue m when m.IsActivePattern -> Some m | _ -> None - - let (|Parameter|_|) (symbol : FSharpSymbolUse) = - match symbol.Symbol with - | :? FSharpParameter as param -> Some param - | _ -> None - - let (|StaticParameter|_|) (symbol : FSharpSymbolUse) = - match symbol.Symbol with - | :? FSharpStaticParameter as sp -> Some sp - | _ -> None - - let (|UnionCase|_|) (symbol : FSharpSymbolUse) = - match symbol.Symbol with - | :? FSharpUnionCase as uc-> Some uc - | _ -> None - - //let (|Constructor|_|) = function - // | MemberFunctionOrValue func when func.IsConstructor || func.IsImplicitConstructor -> Some func - // | _ -> None - - let (|TypeAbbreviation|_|) = function - | Entity (entity, _) when entity.IsFSharpAbbreviation -> Some entity - | _ -> None - - let (|Class|_|) = function - | Entity (entity, _) when entity.IsClass -> Some entity - | Entity (entity, _) when entity.IsFSharp && - entity.IsOpaque && - not entity.IsFSharpModule && - not entity.IsNamespace && - not entity.IsDelegate && - not entity.IsFSharpUnion && - not entity.IsFSharpRecord && - not entity.IsInterface && - not entity.IsValueType -> Some entity - | _ -> None - - let (|Delegate|_|) = function - | Entity (entity, _) when entity.IsDelegate -> Some entity - | _ -> None - - let (|Event|_|) = function - | MemberFunctionOrValue symbol when symbol.IsEvent -> Some symbol - | _ -> None - - let (|Property|_|) = function - | MemberFunctionOrValue symbol when symbol.IsProperty || symbol.IsPropertyGetterMethod || symbol.IsPropertySetterMethod -> Some symbol - | _ -> None - - let inline private notCtorOrProp (symbol:FSharpMemberOrFunctionOrValue) = - not symbol.IsConstructor && not symbol.IsPropertyGetterMethod && not symbol.IsPropertySetterMethod - - let (|Method|_|) (symbolUse:FSharpSymbolUse) = - match symbolUse with - | MemberFunctionOrValue symbol when - symbol.IsModuleValueOrMember && - not symbolUse.IsFromPattern && - not symbol.IsOperatorOrActivePattern && - not symbol.IsPropertyGetterMethod && - not symbol.IsPropertySetterMethod -> Some symbol - | _ -> None - - let (|Function|_|) (symbolUse:FSharpSymbolUse) = - match symbolUse with - | MemberFunctionOrValue symbol when - notCtorOrProp symbol && - symbol.IsModuleValueOrMember && - not symbol.IsOperatorOrActivePattern && - not symbolUse.IsFromPattern -> - - match symbol.FullTypeSafe with - | Some fullType when fullType.IsFunctionType -> Some symbol - | _ -> None - | _ -> None - - let (|Operator|_|) (symbolUse:FSharpSymbolUse) = - match symbolUse with - | MemberFunctionOrValue symbol when - notCtorOrProp symbol && - not symbolUse.IsFromPattern && - not symbol.IsActivePattern && - symbol.IsOperatorOrActivePattern -> - - match symbol.FullTypeSafe with - | Some fullType when fullType.IsFunctionType -> Some symbol - | _ -> None - | _ -> None - - let (|Pattern|_|) (symbolUse:FSharpSymbolUse) = - match symbolUse with - | MemberFunctionOrValue symbol when - notCtorOrProp symbol && - not symbol.IsOperatorOrActivePattern && - symbolUse.IsFromPattern -> - - match symbol.FullTypeSafe with - | Some fullType when fullType.IsFunctionType ->Some symbol - | _ -> None - | _ -> None - - - let (|ClosureOrNestedFunction|_|) = function - | MemberFunctionOrValue symbol when - notCtorOrProp symbol && - not symbol.IsOperatorOrActivePattern && - not symbol.IsModuleValueOrMember -> - - match symbol.FullTypeSafe with - | Some fullType when fullType.IsFunctionType -> Some symbol - | _ -> None - | _ -> None - - - let (|Val|_|) = function - | MemberFunctionOrValue symbol when notCtorOrProp symbol && - not symbol.IsOperatorOrActivePattern -> - match symbol.FullTypeSafe with - | Some _fullType -> Some symbol - | _ -> None - | _ -> None - - let (|Enum|_|) = function - | Entity (entity, _) when entity.IsEnum -> Some entity - | _ -> None - - let (|Interface|_|) = function - | Entity (entity, _) when entity.IsInterface -> Some entity - | _ -> None - - let (|Module|_|) = function - | Entity (entity, _) when entity.IsFSharpModule -> Some entity - | _ -> None - - let (|Namespace|_|) = function - | Entity (entity, _) when entity.IsNamespace -> Some entity - | _ -> None - - let (|Record|_|) = function - | Entity (entity, _) when entity.IsFSharpRecord -> Some entity - | _ -> None - - let (|Union|_|) = function - | Entity (entity, _) when entity.IsFSharpUnion -> Some entity - | _ -> None - - let (|ValueType|_|) = function - | Entity (entity, _) when entity.IsValueType && not entity.IsEnum -> Some entity - | _ -> None - - let (|ComputationExpression|_|) (symbol:FSharpSymbolUse) = - if symbol.IsFromComputationExpression then Some symbol - else None - - let (|Attribute|_|) = function - | Entity (entity, _) when entity.IsAttributeType -> Some entity - | _ -> None \ No newline at end of file + allBaseTypes x \ No newline at end of file From b16f93c69ab51e253ae66b532c02157fe0767858 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Fri, 20 Oct 2017 22:17:04 +0300 Subject: [PATCH 08/16] collect open declarations EntityRefs during compilation --- Diagnostics/UnusedOpensDiagnosticAnalyzer.fs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs index 487e6520a9b..caff796df84 100644 --- a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs +++ b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs @@ -42,9 +42,14 @@ type internal UnusedOpensDiagnosticAnalyzer() = asyncMaybe { do! Option.guard Settings.CodeFixes.UnusedOpens let! sourceText = document.GetTextAsync() - let! _, parsedInput, checkResults = checker.ParseAndCheckDocument(document, options, sourceText = sourceText, allowStaleResults = true, userOpName = userOpName) + let! _, _, checkResults = checker.ParseAndCheckDocument(document, options, sourceText = sourceText, allowStaleResults = true, userOpName = userOpName) + + + Logging.Logging.logInfof "*** OpenDeclarations: %+A" checkResults.OpenDeclarations + + let! symbolUses = checkResults.GetAllUsesOfAllSymbolsInFile() |> liftAsync - return UnusedOpens.getUnusedOpens(symbolUses, parsedInput, fun lineNumber -> sourceText.Lines.[Line.toZ lineNumber].ToString()) + return UnusedOpens.getUnusedOpens(symbolUses, checkResults.OpenDeclarations, fun lineNumber -> sourceText.Lines.[Line.toZ lineNumber].ToString()) } override this.AnalyzeSemanticsAsync(document: Document, cancellationToken: CancellationToken) = From 86b52401ba559d7ec05dce2534cfaf775b060a3b Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Fri, 20 Oct 2017 22:28:22 +0300 Subject: [PATCH 09/16] fix --- Diagnostics/UnusedOpensDiagnosticAnalyzer.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs index caff796df84..7034b7c335b 100644 --- a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs +++ b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs @@ -43,13 +43,13 @@ type internal UnusedOpensDiagnosticAnalyzer() = do! Option.guard Settings.CodeFixes.UnusedOpens let! sourceText = document.GetTextAsync() let! _, _, checkResults = checker.ParseAndCheckDocument(document, options, sourceText = sourceText, allowStaleResults = true, userOpName = userOpName) - + let! openDeclarations = checkResults.OpenDeclarations - Logging.Logging.logInfof "*** OpenDeclarations: %+A" checkResults.OpenDeclarations + Logging.Logging.logInfof "*** OpenDeclarations: %+A" openDeclarations let! symbolUses = checkResults.GetAllUsesOfAllSymbolsInFile() |> liftAsync - return UnusedOpens.getUnusedOpens(symbolUses, checkResults.OpenDeclarations, fun lineNumber -> sourceText.Lines.[Line.toZ lineNumber].ToString()) + return UnusedOpens.getUnusedOpens(symbolUses, openDeclarations, fun lineNumber -> sourceText.Lines.[Line.toZ lineNumber].ToString()) } override this.AnalyzeSemanticsAsync(document: Document, cancellationToken: CancellationToken) = From 429459ca6a30bac71c0a68019d556c8ce2d7a721 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sat, 21 Oct 2017 11:42:07 +0300 Subject: [PATCH 10/16] refactoring, fix compilation --- Diagnostics/UnusedOpensDiagnosticAnalyzer.fs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs index 7034b7c335b..4430f355b30 100644 --- a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs +++ b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs @@ -43,13 +43,11 @@ type internal UnusedOpensDiagnosticAnalyzer() = do! Option.guard Settings.CodeFixes.UnusedOpens let! sourceText = document.GetTextAsync() let! _, _, checkResults = checker.ParseAndCheckDocument(document, options, sourceText = sourceText, allowStaleResults = true, userOpName = userOpName) - let! openDeclarations = checkResults.OpenDeclarations + let openDeclarations = checkResults.OpenDeclarations Logging.Logging.logInfof "*** OpenDeclarations: %+A" openDeclarations - - let! symbolUses = checkResults.GetAllUsesOfAllSymbolsInFile() |> liftAsync - return UnusedOpens.getUnusedOpens(symbolUses, openDeclarations, fun lineNumber -> sourceText.Lines.[Line.toZ lineNumber].ToString()) + return! UnusedOpens.getUnusedOpens(checkResults, fun lineNumber -> sourceText.Lines.[Line.toZ lineNumber].ToString()) |> liftAsync } override this.AnalyzeSemanticsAsync(document: Document, cancellationToken: CancellationToken) = From 1db5638c3c2703d04c95bbb4e22b017a28cf7ff9 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sat, 21 Oct 2017 15:21:33 +0300 Subject: [PATCH 11/16] exclude nested symbol uses from consideration --- FSharp.Editor.fsproj | 1 - LanguageService/FSharpCheckerExtensions.fs | 18 +- LanguageService/TypedAstUtils.fs | 209 --------------------- 3 files changed, 9 insertions(+), 219 deletions(-) delete mode 100644 LanguageService/TypedAstUtils.fs diff --git a/FSharp.Editor.fsproj b/FSharp.Editor.fsproj index 742d63b1f00..0f95003186a 100644 --- a/FSharp.Editor.fsproj +++ b/FSharp.Editor.fsproj @@ -52,7 +52,6 @@ - diff --git a/LanguageService/FSharpCheckerExtensions.fs b/LanguageService/FSharpCheckerExtensions.fs index 2d6b877fee9..d743ff49cdb 100644 --- a/LanguageService/FSharpCheckerExtensions.fs +++ b/LanguageService/FSharpCheckerExtensions.fs @@ -108,7 +108,7 @@ type FSharpChecker with match symbolUse.Symbol with // Make sure that unsafe manipulation isn't executed if unused opens are disabled | _ when not checkForUnusedOpens -> None - | TypedAstPatterns.MemberFunctionOrValue func when func.IsExtensionMember -> + | Symbol.MemberFunctionOrValue func when func.IsExtensionMember -> if func.IsProperty then let fullNames = [| if func.HasGetterMethod then @@ -125,9 +125,9 @@ type FSharpChecker with | [||] -> None | _ -> Some fullNames else - match func.EnclosingEntity.Value with + match func.EnclosingEntity with // C# extension method - | TypedAstPatterns.FSharpEntity TypedAstPatterns.Class -> + | Some (Symbol.FSharpEntity Symbol.Class) -> let fullName = symbolUse.Symbol.FullName.Split '.' if fullName.Length > 2 then (* For C# extension methods FCS returns full name including the class name, like: @@ -142,9 +142,9 @@ type FSharpChecker with else None | _ -> None // Operators - | TypedAstPatterns.MemberFunctionOrValue func -> + | Symbol.MemberFunctionOrValue func -> match func with - | TypedAstPatterns.Constructor _ -> + | Symbol.Constructor _ -> // full name of a constructor looks like "UnusedSymbolClassifierTests.PrivateClass.( .ctor )" // to make well formed full name parts we cut "( .ctor )" from the tail. let fullName = func.FullName @@ -160,16 +160,16 @@ type FSharpChecker with | Some idents -> yield String.concat "." idents | None -> () |] - | TypedAstPatterns.FSharpEntity e -> + | Symbol.FSharpEntity e -> match e with - | e, TypedAstPatterns.Attribute, _ -> + | e, Symbol.Attribute, _ -> e.TryGetFullName () |> Option.map (fun fullName -> [| fullName; fullName.Substring(0, fullName.Length - "Attribute".Length) |]) | e, _, _ -> e.TryGetFullName () |> Option.map (fun fullName -> [| fullName |]) - | TypedAstPatterns.RecordField _ - | TypedAstPatterns.UnionCase _ as symbol -> + | Symbol.RecordField _ + | Symbol.UnionCase _ as symbol -> Some [| let fullName = symbol.FullName yield fullName let idents = fullName.Split '.' diff --git a/LanguageService/TypedAstUtils.fs b/LanguageService/TypedAstUtils.fs deleted file mode 100644 index b857ac6c586..00000000000 --- a/LanguageService/TypedAstUtils.fs +++ /dev/null @@ -1,209 +0,0 @@ -module internal Microsoft.VisualStudio.FSharp.Editor.TypedAstUtils - -open System -open Microsoft.FSharp.Compiler.SourceCodeServices -open Microsoft.VisualStudio.FSharp.Editor - -open System.Text.RegularExpressions - -let isAttribute<'T> (attribute: FSharpAttribute) = - // CompiledName throws exception on DataContractAttribute generated by SQLProvider - match Option.attempt (fun _ -> attribute.AttributeType.CompiledName) with - | Some name when name = typeof<'T>.Name -> true - | _ -> false - -let tryGetAttribute<'T> (attributes: seq) = - attributes |> Seq.tryFind isAttribute<'T> - -let hasModuleSuffixAttribute (entity: FSharpEntity) = - entity.Attributes - |> tryGetAttribute - |> Option.bind (fun a -> - Option.attempt (fun _ -> a.ConstructorArguments) - |> Option.bind (fun args -> args |> Seq.tryPick (fun (_, arg) -> - let res = - match arg with - | :? int32 as arg when arg = int CompilationRepresentationFlags.ModuleSuffix -> - Some() - | :? CompilationRepresentationFlags as arg when arg = CompilationRepresentationFlags.ModuleSuffix -> - Some() - | _ -> - None - res))) - |> Option.isSome - -let isOperator (name: string) = - name.StartsWith "( " && name.EndsWith " )" && name.Length > 4 - && name.Substring (2, name.Length - 4) - |> String.forall (fun c -> c <> ' ' && not (Char.IsLetter c)) - -let private UnnamedUnionFieldRegex = Regex("^Item(\d+)?$", RegexOptions.Compiled) - -let isUnnamedUnionCaseField (field: FSharpField) = UnnamedUnionFieldRegex.IsMatch(field.Name) - -module TypedAstPatterns = - - let (|AbbreviatedType|_|) (entity: FSharpEntity) = - if entity.IsFSharpAbbreviation then Some entity.AbbreviatedType - else None - - let (|TypeWithDefinition|_|) (ty: FSharpType) = - if ty.HasTypeDefinition then Some ty.TypeDefinition - else None - - let rec getEntityAbbreviatedType (entity: FSharpEntity) = - if entity.IsFSharpAbbreviation then - match entity.AbbreviatedType with - | TypeWithDefinition def -> getEntityAbbreviatedType def - | abbreviatedType -> entity, Some abbreviatedType - else entity, None - - let rec getAbbreviatedType (fsharpType: FSharpType) = - if fsharpType.IsAbbreviation then - getAbbreviatedType fsharpType.AbbreviatedType - else fsharpType - - let (|Attribute|_|) (entity: FSharpEntity) = - let isAttribute (entity: FSharpEntity) = - let getBaseType (entity: FSharpEntity) = - try - match entity.BaseType with - | Some (TypeWithDefinition def) -> Some def - | _ -> None - with _ -> None - - let rec isAttributeType (ty: FSharpEntity option) = - match ty with - | None -> false - | Some ty -> - match ty.TryGetFullName() with - | None -> false - | Some fullName -> - fullName = "System.Attribute" || isAttributeType (getBaseType ty) - isAttributeType (Some entity) - if isAttribute entity then Some() else None - - let (|ValueType|_|) (e: FSharpEntity) = - if e.IsEnum || e.IsValueType || hasAttribute e.Attributes then Some() - else None - - let (|Class|_|) (original: FSharpEntity, abbreviated: FSharpEntity, _) = - if abbreviated.IsClass - && (not abbreviated.IsStaticInstantiation || original.IsFSharpAbbreviation) then Some() - else None - - let (|Record|_|) (e: FSharpEntity) = if e.IsFSharpRecord then Some() else None - let (|UnionType|_|) (e: FSharpEntity) = if e.IsFSharpUnion then Some() else None - let (|Delegate|_|) (e: FSharpEntity) = if e.IsDelegate then Some() else None - let (|FSharpException|_|) (e: FSharpEntity) = if e.IsFSharpExceptionDeclaration then Some() else None - let (|Interface|_|) (e: FSharpEntity) = if e.IsInterface then Some() else None - let (|AbstractClass|_|) (e: FSharpEntity) = - if hasAttribute e.Attributes then Some() else None - - let (|FSharpType|_|) (e: FSharpEntity) = - if e.IsDelegate || e.IsFSharpExceptionDeclaration || e.IsFSharpRecord || e.IsFSharpUnion - || e.IsInterface || e.IsMeasure - || (e.IsFSharp && e.IsOpaque && not e.IsFSharpModule && not e.IsNamespace) then Some() - else None - - let (|ProvidedType|_|) (e: FSharpEntity) = - if (e.IsProvided || e.IsProvidedAndErased || e.IsProvidedAndGenerated) && e.CompiledName = e.DisplayName then - Some() - else None - - let (|ByRef|_|) (e: FSharpEntity) = if e.IsByRef then Some() else None - let (|Array|_|) (e: FSharpEntity) = if e.IsArrayType then Some() else None - let (|FSharpModule|_|) (entity: FSharpEntity) = if entity.IsFSharpModule then Some() else None - - let (|Namespace|_|) (entity: FSharpEntity) = if entity.IsNamespace then Some() else None - let (|ProvidedAndErasedType|_|) (entity: FSharpEntity) = if entity.IsProvidedAndErased then Some() else None - let (|Enum|_|) (entity: FSharpEntity) = if entity.IsEnum then Some() else None - - let (|Tuple|_|) (ty: FSharpType option) = - ty |> Option.bind (fun ty -> if ty.IsTupleType then Some() else None) - - let (|RefCell|_|) (ty: FSharpType) = - match getAbbreviatedType ty with - | TypeWithDefinition def when - def.IsFSharpRecord && def.FullName = "Microsoft.FSharp.Core.FSharpRef`1" -> Some() - | _ -> None - - let (|FunctionType|_|) (ty: FSharpType) = - if ty.IsFunctionType then Some() - else None - - let (|Pattern|_|) (symbol: FSharpSymbol) = - match symbol with - | :? FSharpUnionCase - | :? FSharpActivePatternCase -> Some() - | _ -> None - - /// Field (field, fieldAbbreviatedType) - let (|Field|_|) (symbol: FSharpSymbol) = - match symbol with - | :? FSharpField as field -> Some (field, getAbbreviatedType field.FieldType) - | _ -> None - - let (|MutableVar|_|) (symbol: FSharpSymbol) = - let isMutable = - match symbol with - | :? FSharpField as field -> field.IsMutable && not field.IsLiteral - | :? FSharpMemberOrFunctionOrValue as func -> func.IsMutable - | _ -> false - if isMutable then Some() else None - - /// Entity (originalEntity, abbreviatedEntity, abbreviatedType) - let (|FSharpEntity|_|) (symbol: FSharpSymbol) = - match symbol with - | :? FSharpEntity as entity -> - let abbreviatedEntity, abbreviatedType = getEntityAbbreviatedType entity - Some (entity, abbreviatedEntity, abbreviatedType) - | _ -> None - - let (|Parameter|_|) (symbol: FSharpSymbol) = - match symbol with - | :? FSharpParameter -> Some() - | _ -> None - - let (|UnionCase|_|) (e: FSharpSymbol) = - match e with - | :? FSharpUnionCase as uc -> Some uc - | _ -> None - - let (|RecordField|_|) (e: FSharpSymbol) = - match e with - | :? FSharpField as field -> - if field.DeclaringEntity.IsFSharpRecord then Some field else None - | _ -> None - - let (|ActivePatternCase|_|) (symbol: FSharpSymbol) = - match symbol with - | :? FSharpActivePatternCase as case -> Some case - | _ -> None - - /// Func (memberFunctionOrValue, fullType) - let (|MemberFunctionOrValue|_|) (symbol: FSharpSymbol) = - match symbol with - | :? FSharpMemberOrFunctionOrValue as func -> Some func - | _ -> None - - /// Constructor (enclosingEntity) - let (|Constructor|_|) (func: FSharpMemberOrFunctionOrValue) = - match func.CompiledName with - | ".ctor" | ".cctor" -> Some func.EnclosingEntity - | _ -> None - - let (|Function|_|) excluded (func: FSharpMemberOrFunctionOrValue) = - match func.FullTypeSafe |> Option.map getAbbreviatedType with - | Some typ when typ.IsFunctionType - && not func.IsPropertyGetterMethod - && not func.IsPropertySetterMethod - && not excluded - && not (isOperator func.DisplayName) -> Some() - | _ -> None - - let (|ExtensionMember|_|) (func: FSharpMemberOrFunctionOrValue) = - if func.IsExtensionMember then Some() else None - - let (|Event|_|) (func: FSharpMemberOrFunctionOrValue) = - if func.IsEvent then Some () else None \ No newline at end of file From adca88cff923f1790f92a3a75346e769eccc9a1c Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sat, 21 Oct 2017 15:24:06 +0300 Subject: [PATCH 12/16] fix compilation --- LanguageService/FSharpCheckerExtensions.fs | 1 - 1 file changed, 1 deletion(-) diff --git a/LanguageService/FSharpCheckerExtensions.fs b/LanguageService/FSharpCheckerExtensions.fs index d743ff49cdb..14719b17d23 100644 --- a/LanguageService/FSharpCheckerExtensions.fs +++ b/LanguageService/FSharpCheckerExtensions.fs @@ -8,7 +8,6 @@ open Microsoft.CodeAnalysis.Text open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.SourceCodeServices -open TypedAstUtils type CheckResults = | Ready of (FSharpParseFileResults * FSharpCheckFileResults) option From e98d16d652e79867b350c92c2e5226efb777aea4 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Tue, 24 Oct 2017 11:20:06 +0300 Subject: [PATCH 13/16] properly handle own namespace opening --- Diagnostics/UnusedDeclarationsAnalyzer.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Diagnostics/UnusedDeclarationsAnalyzer.fs b/Diagnostics/UnusedDeclarationsAnalyzer.fs index cb541cac322..071f0aadbe1 100644 --- a/Diagnostics/UnusedDeclarationsAnalyzer.fs +++ b/Diagnostics/UnusedDeclarationsAnalyzer.fs @@ -35,7 +35,7 @@ type internal UnusedDeclarationsAnalyzer() = match symbol with // Determining that a record, DU or module is used anywhere requires inspecting all their enclosed entities (fields, cases and func / vals) // for usages, which is too expensive to do. Hence we never gray them out. - | :? FSharpEntity as e when e.IsFSharpRecord || e.IsFSharpUnion || e.IsInterface || e.IsFSharpModule || e.IsClass -> false + | :? FSharpEntity as e when e.IsFSharpRecord || e.IsFSharpUnion || e.IsInterface || e.IsFSharpModule || e.IsClass || e.IsNamespace -> false // FCS returns inconsistent results for override members; we're skipping these symbols. | :? FSharpMemberOrFunctionOrValue as f when f.IsOverrideOrExplicitInterfaceImplementation || From 63fcfbd085e3eea9038948c0bd0e12946613183b Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Tue, 24 Oct 2017 16:48:58 +0300 Subject: [PATCH 14/16] remove logging --- Diagnostics/UnusedOpensDiagnosticAnalyzer.fs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs index 4430f355b30..10b266d2735 100644 --- a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs +++ b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs @@ -43,10 +43,6 @@ type internal UnusedOpensDiagnosticAnalyzer() = do! Option.guard Settings.CodeFixes.UnusedOpens let! sourceText = document.GetTextAsync() let! _, _, checkResults = checker.ParseAndCheckDocument(document, options, sourceText = sourceText, allowStaleResults = true, userOpName = userOpName) - let openDeclarations = checkResults.OpenDeclarations - - Logging.Logging.logInfof "*** OpenDeclarations: %+A" openDeclarations - return! UnusedOpens.getUnusedOpens(checkResults, fun lineNumber -> sourceText.Lines.[Line.toZ lineNumber].ToString()) |> liftAsync } From e5e33e6cbb5eb0d583d61048899098c877619440 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Wed, 25 Oct 2017 16:39:54 +0300 Subject: [PATCH 15/16] do not use MembersFunctionsAndValues --- Diagnostics/UnusedOpensDiagnosticAnalyzer.fs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs index 10b266d2735..67d927e8442 100644 --- a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs +++ b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs @@ -43,7 +43,10 @@ type internal UnusedOpensDiagnosticAnalyzer() = do! Option.guard Settings.CodeFixes.UnusedOpens let! sourceText = document.GetTextAsync() let! _, _, checkResults = checker.ParseAndCheckDocument(document, options, sourceText = sourceText, allowStaleResults = true, userOpName = userOpName) - return! UnusedOpens.getUnusedOpens(checkResults, fun lineNumber -> sourceText.Lines.[Line.toZ lineNumber].ToString()) |> liftAsync + let sw = Stopwatch.StartNew() + let! unusedOpens = UnusedOpens.getUnusedOpens(checkResults, fun lineNumber -> sourceText.Lines.[Line.toZ lineNumber].ToString()) |> liftAsync + Logging.Logging.logInfof "*** Got %d unused opens in %O" unusedOpens.Length sw.Elapsed + return unusedOpens } override this.AnalyzeSemanticsAsync(document: Document, cancellationToken: CancellationToken) = From c33d21bd233186ca1ef67a31a7968a02ed3a1465 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Wed, 25 Oct 2017 20:44:08 +0300 Subject: [PATCH 16/16] use EnclosingEntity if available --- Diagnostics/UnusedOpensDiagnosticAnalyzer.fs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs index 67d927e8442..88568b4a2a2 100644 --- a/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs +++ b/Diagnostics/UnusedOpensDiagnosticAnalyzer.fs @@ -43,9 +43,13 @@ type internal UnusedOpensDiagnosticAnalyzer() = do! Option.guard Settings.CodeFixes.UnusedOpens let! sourceText = document.GetTextAsync() let! _, _, checkResults = checker.ParseAndCheckDocument(document, options, sourceText = sourceText, allowStaleResults = true, userOpName = userOpName) +#if DEBUG let sw = Stopwatch.StartNew() +#endif let! unusedOpens = UnusedOpens.getUnusedOpens(checkResults, fun lineNumber -> sourceText.Lines.[Line.toZ lineNumber].ToString()) |> liftAsync +#if DEBUG Logging.Logging.logInfof "*** Got %d unused opens in %O" unusedOpens.Length sw.Elapsed +#endif return unusedOpens }