Faster finding references

src/Compiler/Checking/CheckDeclarations.fs

@@ -5309,17 +5309,17 @@ let CheckOneImplFile
         synImplFile,
         diagnosticOptions) =
 
-    let (ParsedImplFileInput (fileName, isScript, qualNameOfFile, scopedPragmas, _, implFileFrags, isLastCompiland, _)) = synImplFile
+    let (ParsedImplFileInput (fileName, isScript, qualNameOfFile, scopedPragmas, _, implFileFrags, isLastCompiland, _, _)) = synImplFile
     let infoReader = InfoReader(g, amap)
 
     cancellable {
-        use _ = 
-            Activity.start "CheckDeclarations.CheckOneImplFile" 
+        use _ =
+            Activity.start "CheckDeclarations.CheckOneImplFile"
                 [|
                     "fileName", fileName
                     "qualifiedNameOfFile", qualNameOfFile.Text
                 |]
-        let cenv = 
+        let cenv =
             cenv.Create (g, isScript, amap, thisCcu, false, Option.isSome rootSigOpt,
                 conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g), isInternalTestSpanStackReferring,
                 diagnosticOptions,
@@ -5445,15 +5445,15 @@ let CheckOneImplFile
 
 
 /// Check an entire signature file
-let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring, diagnosticOptions) tcEnv (sigFile: ParsedSigFileInput) = 
+let CheckOneSigFile (g, amap, thisCcu, checkForErrors, conditionalDefines, tcSink, isInternalTestSpanStackReferring, diagnosticOptions) tcEnv (sigFile: ParsedSigFileInput) =
  cancellable {     
     use _ =
         Activity.start "CheckDeclarations.CheckOneSigFile"
             [|
                 "fileName", sigFile.FileName
                 "qualifiedNameOfFile", sigFile.QualifiedName.Text
             |]
-    let cenv = 
+    let cenv =
         cenv.Create 
             (g, false, amap, thisCcu, true, false, conditionalDefines, tcSink,
              (LightweightTcValForUsingInBuildMethodCall g), isInternalTestSpanStackReferring,

src/Compiler/Driver/ParseAndCheckInputs.fs

@@ -93,13 +93,13 @@ let PrependPathToSpec x (SynModuleOrNamespaceSig (longId, isRecursive, kind, dec
 
 let PrependPathToInput x inp =
     match inp with
-    | ParsedInput.ImplFile (ParsedImplFileInput (b, c, q, d, hd, impls, e, trivia)) ->
+    | ParsedInput.ImplFile (ParsedImplFileInput (b, c, q, d, hd, impls, e, trivia, i)) ->
         ParsedInput.ImplFile(
-            ParsedImplFileInput(b, c, PrependPathToQualFileName x q, d, hd, List.map (PrependPathToImpl x) impls, e, trivia)
+            ParsedImplFileInput(b, c, PrependPathToQualFileName x q, d, hd, List.map (PrependPathToImpl x) impls, e, trivia, i)
         )
 
-    | ParsedInput.SigFile (ParsedSigFileInput (b, q, d, hd, specs, trivia)) ->
-        ParsedInput.SigFile(ParsedSigFileInput(b, PrependPathToQualFileName x q, d, hd, List.map (PrependPathToSpec x) specs, trivia))
+    | ParsedInput.SigFile (ParsedSigFileInput (b, q, d, hd, specs, trivia, i)) ->
+        ParsedInput.SigFile(ParsedSigFileInput(b, PrependPathToQualFileName x q, d, hd, List.map (PrependPathToSpec x) specs, trivia, i))
 
 let IsValidAnonModuleName (modname: string) =
     modname |> String.forall (fun c -> Char.IsLetterOrDigit c || c = '_')
@@ -244,7 +244,8 @@ let PostParseModuleImpls
         isLastCompiland,
         ParsedImplFile (hashDirectives, impls),
         lexbuf: UnicodeLexing.Lexbuf,
-        tripleSlashComments: range list
+        tripleSlashComments: range list,
+        identifiers: Set<string>
     ) =
     let othersWithSameName =
         impls
@@ -284,7 +285,9 @@ let PostParseModuleImpls
             CodeComments = codeComments
         }
 
-    ParsedInput.ImplFile(ParsedImplFileInput(fileName, isScript, qualName, scopedPragmas, hashDirectives, impls, isLastCompiland, trivia))
+    ParsedInput.ImplFile(
+        ParsedImplFileInput(fileName, isScript, qualName, scopedPragmas, hashDirectives, impls, isLastCompiland, trivia, identifiers)
+    )
 
 let PostParseModuleSpecs
     (
@@ -293,7 +296,8 @@ let PostParseModuleSpecs
         isLastCompiland,
         ParsedSigFile (hashDirectives, specs),
         lexbuf: UnicodeLexing.Lexbuf,
-        tripleSlashComments: range list
+        tripleSlashComments: range list,
+        identifiers: Set<string>
     ) =
     let othersWithSameName =
         specs
@@ -332,7 +336,7 @@ let PostParseModuleSpecs
             CodeComments = codeComments
         }
 
-    ParsedInput.SigFile(ParsedSigFileInput(fileName, qualName, scopedPragmas, hashDirectives, specs, trivia))
+    ParsedInput.SigFile(ParsedSigFileInput(fileName, qualName, scopedPragmas, hashDirectives, specs, trivia, identifiers))
 
 type ModuleNamesDict = Map<string, Map<string, QualifiedNameOfFile>>
 
@@ -377,26 +381,26 @@ let DeduplicateModuleName (moduleNamesDict: ModuleNamesDict) fileName (qualNameO
 let DeduplicateParsedInputModuleName (moduleNamesDict: ModuleNamesDict) input =
     match input with
     | ParsedInput.ImplFile implFile ->
-        let (ParsedImplFileInput (fileName, isScript, qualNameOfFile, scopedPragmas, hashDirectives, modules, flags, trivia)) =
+        let (ParsedImplFileInput (fileName, isScript, qualNameOfFile, scopedPragmas, hashDirectives, modules, flags, trivia, identifiers)) =
             implFile
 
         let qualNameOfFileR, moduleNamesDictR =
             DeduplicateModuleName moduleNamesDict fileName qualNameOfFile
 
         let implFileR =
-            ParsedImplFileInput(fileName, isScript, qualNameOfFileR, scopedPragmas, hashDirectives, modules, flags, trivia)
+            ParsedImplFileInput(fileName, isScript, qualNameOfFileR, scopedPragmas, hashDirectives, modules, flags, trivia, identifiers)
 
         let inputR = ParsedInput.ImplFile implFileR
         inputR, moduleNamesDictR
     | ParsedInput.SigFile sigFile ->
-        let (ParsedSigFileInput (fileName, qualNameOfFile, scopedPragmas, hashDirectives, modules, trivia)) =
+        let (ParsedSigFileInput (fileName, qualNameOfFile, scopedPragmas, hashDirectives, modules, trivia, identifiers)) =
             sigFile
 
         let qualNameOfFileR, moduleNamesDictR =
             DeduplicateModuleName moduleNamesDict fileName qualNameOfFile
 
         let sigFileR =
-            ParsedSigFileInput(fileName, qualNameOfFileR, scopedPragmas, hashDirectives, modules, trivia)
+            ParsedSigFileInput(fileName, qualNameOfFileR, scopedPragmas, hashDirectives, modules, trivia, identifiers)
 
         let inputT = ParsedInput.SigFile sigFileR
         inputT, moduleNamesDictR
@@ -427,6 +431,28 @@ let ParseInput
 
     try
         let input =
+            let identStore = HashSet<string>()
+
+            let identCaptureLexer x =
+                let token = lexer x
+
+                match token with
+                | Parser.token.PERCENT_OP ident
+                | Parser.token.FUNKY_OPERATOR_NAME ident
+                | Parser.token.ADJACENT_PREFIX_OP ident
+                | Parser.token.PLUS_MINUS_OP ident
+                | Parser.token.INFIX_AMP_OP ident
+                | Parser.token.INFIX_STAR_DIV_MOD_OP ident
+                | Parser.token.PREFIX_OP ident
+                | Parser.token.INFIX_BAR_OP ident
+                | Parser.token.INFIX_AT_HAT_OP ident
+                | Parser.token.INFIX_COMPARE_OP ident
+                | Parser.token.INFIX_STAR_STAR_OP ident
+                | Parser.token.IDENT ident -> identStore.Add ident |> ignore
+                | _ -> ()
+
+                token
+
             if FSharpMLCompatFileSuffixes |> List.exists (FileSystemUtils.checkSuffix fileName) then
                 if lexbuf.SupportsFeature LanguageFeature.MLCompatRevisions then
                     errorR (Error(FSComp.SR.buildInvalidSourceFileExtensionML fileName, rangeStartup))
@@ -435,19 +461,19 @@ let ParseInput
 
             // Call the appropriate parser - for signature files or implementation files
             if FSharpImplFileSuffixes |> List.exists (FileSystemUtils.checkSuffix fileName) then
-                let impl = Parser.implementationFile lexer lexbuf
+                let impl = Parser.implementationFile identCaptureLexer lexbuf
 
                 let tripleSlashComments =
                     LexbufLocalXmlDocStore.ReportInvalidXmlDocPositions(lexbuf)
 
-                PostParseModuleImpls(defaultNamespace, fileName, isLastCompiland, impl, lexbuf, tripleSlashComments)
+                PostParseModuleImpls(defaultNamespace, fileName, isLastCompiland, impl, lexbuf, tripleSlashComments, Set identStore)
             elif FSharpSigFileSuffixes |> List.exists (FileSystemUtils.checkSuffix fileName) then
-                let intfs = Parser.signatureFile lexer lexbuf
+                let intfs = Parser.signatureFile identCaptureLexer lexbuf
 
                 let tripleSlashComments =
                     LexbufLocalXmlDocStore.ReportInvalidXmlDocPositions(lexbuf)
 
-                PostParseModuleSpecs(defaultNamespace, fileName, isLastCompiland, intfs, lexbuf, tripleSlashComments)
+                PostParseModuleSpecs(defaultNamespace, fileName, isLastCompiland, intfs, lexbuf, tripleSlashComments, Set identStore)
             else if lexbuf.SupportsFeature LanguageFeature.MLCompatRevisions then
                 error (Error(FSComp.SR.buildInvalidSourceFileExtensionUpdated fileName, rangeStartup))
             else
@@ -519,7 +545,8 @@ let EmptyParsedInput (fileName, isLastCompiland) =
                 {
                     ConditionalDirectives = []
                     CodeComments = []
-                }
+                },
+                Set.empty
             )
         )
     else
@@ -535,7 +562,8 @@ let EmptyParsedInput (fileName, isLastCompiland) =
                 {
                     ConditionalDirectives = []
                     CodeComments = []
-                }
+                },
+                Set.empty
             )
         )
 

src/Compiler/Driver/ScriptClosure.fs

@@ -515,13 +515,23 @@ module ScriptPreprocessClosure =
         match lastParsedInput with
         | Some (ParsedInput.ImplFile lastParsedImplFile) ->
 
-            let (ParsedImplFileInput (name, isScript, qualNameOfFile, scopedPragmas, hashDirectives, implFileFlags, _, trivia)) =
+            let (ParsedImplFileInput (name, isScript, qualNameOfFile, scopedPragmas, hashDirectives, implFileFlags, _, trivia, identifiers)) =
                 lastParsedImplFile
 
             let isLastCompiland = (true, tcConfig.target.IsExe)
 
             let lastParsedImplFileR =
-                ParsedImplFileInput(name, isScript, qualNameOfFile, scopedPragmas, hashDirectives, implFileFlags, isLastCompiland, trivia)
+                ParsedImplFileInput(
+                    name,
+                    isScript,
+                    qualNameOfFile,
+                    scopedPragmas,
+                    hashDirectives,
+                    implFileFlags,
+                    isLastCompiland,
+                    trivia,
+                    identifiers
+                )
 
             let lastClosureFileR =
                 ClosureFile(fileName, m, Some(ParsedInput.ImplFile lastParsedImplFileR), parseDiagnostics, metaDiagnostics, nowarns)

src/Compiler/Interactive/fsi.fs

@@ -1850,7 +1850,7 @@ type internal FsiDynamicCompiler(
         let impl = SynModuleOrNamespace(prefix,false, SynModuleOrNamespaceKind.NamedModule,defs,PreXmlDoc.Empty,[],None,m, { LeadingKeyword = SynModuleOrNamespaceLeadingKeyword.None })
         let isLastCompiland = true
         let isExe = false
-        let input = ParsedInput.ImplFile (ParsedImplFileInput (fileName,true, ComputeQualifiedNameOfFileFromUniquePath (m,prefixPath),[],[],[impl],(isLastCompiland, isExe), { ConditionalDirectives = []; CodeComments = [] }))
+        let input = ParsedInput.ImplFile (ParsedImplFileInput (fileName,true, ComputeQualifiedNameOfFileFromUniquePath (m,prefixPath),[],[],[impl],(isLastCompiland, isExe), { ConditionalDirectives = []; CodeComments = [] }, Set.empty))
         let isIncrementalFragment = true
         let istate,tcEnvAtEndOfLastInput,declaredImpls = ProcessInputs (ctok, diagnosticsLogger, istate, [input], showTypes, isIncrementalFragment, isInteractiveItExpr, prefix, m)
         let tcState = istate.tcState

src/Compiler/Service/IncrementalBuild.fs

@@ -142,7 +142,8 @@ module IncrementalBuildSyntaxTree =
                                 [],
                                 [],
                                 isLastCompiland,
-                                { ConditionalDirectives = []; CodeComments = [] }
+                                { ConditionalDirectives = []; CodeComments = [] },
+                                Set.empty
                             )
                         )
                     else
@@ -292,7 +293,8 @@ type BoundModel private (tcConfig: TcConfig,
                 GraphNode(node {
                     match! this.TypeCheck(false) with
                     | FullState(tcInfo, tcInfoExtras) -> return tcInfo, tcInfoExtras
-                    | PartialState(tcInfo) -> return tcInfo, emptyTcInfoExtras
+                    | PartialState(tcInfo) -> 
+                        return tcInfo, emptyTcInfoExtras
                 })
 
             let partialGraphNode =              

src/Compiler/Service/SemanticClassificationKey.fs

@@ -56,8 +56,13 @@ type SemanticClassificationKeyStoreBuilder() =
     let b = BlobBuilder()
 
     member _.WriteAll(semanticClassification: SemanticClassificationItem[]) =
-        use ptr = fixed semanticClassification
-        b.WriteBytes(NativePtr.ofNativeInt (NativePtr.toNativeInt ptr), semanticClassification.Length * sizeof<SemanticClassificationItem>)
+        if semanticClassification.Length > 0 then
+            use ptr = fixed semanticClassification
+
+            b.WriteBytes(
+                NativePtr.ofNativeInt (NativePtr.toNativeInt ptr),
+                semanticClassification.Length * sizeof<SemanticClassificationItem>
+            )
 
     member _.TryBuildAndReset() =
         if b.Count > 0 then

src/Compiler/Service/service.fs

@@ -81,6 +81,18 @@ module Helpers =
     let AreSubsumable3 ((fileName1: string, _, o1: FSharpProjectOptions), (fileName2: string, _, o2: FSharpProjectOptions)) =
         (fileName1 = fileName2) && FSharpProjectOptions.UseSameProject(o1, o2)
 
+    /// If a symbol is an attribute check if given set of names contains its name without the Attribute suffix
+    let rec NamesContainAttribute (symbol: FSharpSymbol) names =
+        match symbol with
+        | :? FSharpMemberOrFunctionOrValue as mofov ->
+            mofov.DeclaringEntity
+            |> Option.map (fun entity -> NamesContainAttribute entity names)
+            |> Option.defaultValue false
+        | :? FSharpEntity as entity when entity.IsAttributeType && symbol.DisplayNameCore.EndsWithOrdinal "Attribute" ->
+            let nameWithoutAttribute = String.dropSuffix symbol.DisplayNameCore "Attribute"
+            names |> Set.contains nameWithoutAttribute
+        | _ -> false
+
 module CompileHelpers =
     let mkCompilationDiagnosticsHandlers () =
         let diagnostics = ResizeArray<_>()
@@ -1445,12 +1457,26 @@ type FSharpChecker
             options: FSharpProjectOptions,
             symbol: FSharpSymbol,
             ?canInvalidateProject: bool,
+            ?fastCheck: bool,
             ?userOpName: string
         ) =
         let canInvalidateProject = defaultArg canInvalidateProject true
         let userOpName = defaultArg userOpName "Unknown"
 
-        backgroundCompiler.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName)
+        node {
+            if fastCheck <> Some true then
+                return! backgroundCompiler.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName)
+            else
+                let! parseResults = backgroundCompiler.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName)
+
+                if
+                    parseResults.ParseTree.Identifiers |> Set.contains symbol.DisplayNameCore
+                    || parseResults.ParseTree.Identifiers |> NamesContainAttribute symbol
+                then
+                    return! backgroundCompiler.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName)
+                else
+                    return Seq.empty
+        }
         |> Async.AwaitNodeCode
 
     member _.GetBackgroundSemanticClassificationForFile(fileName: string, options: FSharpProjectOptions, ?userOpName) =

src/Compiler/Service/service.fsi

@@ -300,12 +300,14 @@ type public FSharpChecker =
     /// <param name="options">The options for the project or script, used to determine active --define conditionals and other options relevant to parsing.</param>
     /// <param name="symbol">The symbol to find all uses in the file.</param>
     /// <param name="canInvalidateProject">Default: true. If true, this call can invalidate the current state of project if the options have changed. If false, the current state of the project will be used.</param>
+    /// <param name="fastCheck">Default: false. Experimental feature that makes the operation faster.</param>
     /// <param name="userOpName">An optional string used for tracing compiler operations associated with this request.</param>
     member FindBackgroundReferencesInFile:
         fileName: string *
         options: FSharpProjectOptions *
         symbol: FSharpSymbol *
         ?canInvalidateProject: bool *
+        ?fastCheck: bool *
         ?userOpName: string ->
             Async<range seq>
 

src/Compiler/SyntaxTree/SyntaxTree.fs

@@ -1680,7 +1680,8 @@ type ParsedImplFileInput =
         hashDirectives: ParsedHashDirective list *
         contents: SynModuleOrNamespace list *
         flags: (bool * bool) *
-        trivia: ParsedImplFileInputTrivia
+        trivia: ParsedImplFileInputTrivia *
+        identifiers: Set<string>
 
     member x.QualifiedName =
         (let (ParsedImplFileInput (qualifiedNameOfFile = qualNameOfFile)) = x in qualNameOfFile)
@@ -1712,7 +1713,8 @@ type ParsedSigFileInput =
         scopedPragmas: ScopedPragma list *
         hashDirectives: ParsedHashDirective list *
         contents: SynModuleOrNamespaceSig list *
-        trivia: ParsedSigFileInputTrivia
+        trivia: ParsedSigFileInputTrivia *
+        identifiers: Set<string>
 
     member x.QualifiedName =
         (let (ParsedSigFileInput (qualifiedNameOfFile = qualNameOfFile)) = x in qualNameOfFile)
@@ -1755,3 +1757,9 @@ type ParsedInput =
         | ParsedInput.ImplFile (ParsedImplFileInput(contents = SynModuleOrNamespace (range = m) :: _))
         | ParsedInput.SigFile (ParsedSigFileInput(contents = SynModuleOrNamespaceSig (range = m) :: _)) -> m
         | _ -> rangeN inp.FileName 0
+
+    [<Experimental("This FCS API is experimental and subject to change.")>]
+    member inp.Identifiers =
+        match inp with
+        | ParsedInput.ImplFile (ParsedImplFileInput (identifiers = identifiers))
+        | ParsedInput.SigFile (ParsedSigFileInput (identifiers = identifiers)) -> identifiers

src/Compiler/SyntaxTree/SyntaxTree.fsi

@@ -1889,7 +1889,8 @@ type ParsedImplFileInput =
         hashDirectives: ParsedHashDirective list *
         contents: SynModuleOrNamespace list *
         flags: (bool * bool) *
-        trivia: ParsedImplFileInputTrivia
+        trivia: ParsedImplFileInputTrivia *
+        identifiers: Set<string>
 
     member FileName: string
 
@@ -1918,7 +1919,8 @@ type ParsedSigFileInput =
         scopedPragmas: ScopedPragma list *
         hashDirectives: ParsedHashDirective list *
         contents: SynModuleOrNamespaceSig list *
-        trivia: ParsedSigFileInputTrivia
+        trivia: ParsedSigFileInputTrivia *
+        identifiers: Set<string>
 
     member FileName: string
 
@@ -1952,3 +1954,6 @@ type ParsedInput =
 
     /// Gets the #nowarn and other scoped pragmas
     member ScopedPragmas: ScopedPragma list
+
+    /// Gets a set of all identifiers used in this parsed input
+    member Identifiers: Set<string>

tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj

@@ -202,6 +202,7 @@
     <Compile Include="Globalization\GlobalizationTestCases.fs" />
     <Compile Include="OCamlCompat\OCamlCompat.fs" />
     <Compile Include="Miscellaneous\ListLiterals.fs" />
+    <Compile Include="Miscellaneous\SemanticClassificationKeyBuilder.fs" />
     <Compile Include="Miscellaneous\XmlDoc.fs" />
     <Compile Include="Signatures\TestHelpers.fs" />
     <Compile Include="Signatures\ModuleOrNamespaceTests.fs" />