use graph of option objects - fix 2793

src/fsharp/vs/service.fs

@@ -1591,6 +1591,7 @@ type FSharpProjectOptions =
       UnresolvedReferences : UnresolvedReferencesSet option
       OriginalLoadReferences: (range * string) list
       ExtraProjectInfo : obj option
+      Stamp : int64 option
     }
     member x.ProjectOptions = x.OtherOptions
     /// Whether the two parse options refer to the same project.
@@ -1599,12 +1600,18 @@ type FSharpProjectOptions =
 
     /// Compare two options sets with respect to the parts of the options that are important to parsing.
     static member AreSameForParsing(options1,options2) =
+        match options1.Stamp, options2.Stamp with 
+        | Some x, Some y -> (x = y)
+        | _ -> 
         options1.ProjectFileName = options2.ProjectFileName &&
         options1.OtherOptions = options2.OtherOptions &&
         options1.UnresolvedReferences = options2.UnresolvedReferences
 
     /// Compare two options sets with respect to the parts of the options that are important to building.
     static member AreSameForChecking(options1,options2) =
+        match options1.Stamp, options2.Stamp with 
+        | Some x, Some y -> (x = y)
+        | _ -> 
         options1.ProjectFileName = options2.ProjectFileName &&
         options1.ProjectFileNames = options2.ProjectFileNames &&
         options1.OtherOptions = options2.OtherOptions &&
@@ -2532,7 +2539,7 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent
     member bc.ParseAndCheckProject(options) =
         reactor.EnqueueAndAwaitOpAsync("ParseAndCheckProject " + options.ProjectFileName, fun ctok -> bc.ParseAndCheckProjectImpl(options, ctok))
 
-    member bc.GetProjectOptionsFromScript(filename, source, ?loadedTimeStamp, ?otherFlags, ?useFsiAuxLib, ?assumeDotNetFramework, ?extraProjectInfo: obj) = 
+    member bc.GetProjectOptionsFromScript(filename, source, ?loadedTimeStamp, ?otherFlags, ?useFsiAuxLib, ?assumeDotNetFramework, ?extraProjectInfo: obj, ?optionsStamp: int64) = 
         reactor.EnqueueAndAwaitOpAsync ("GetProjectOptionsFromScript " + filename, fun ctok -> 
           cancellable {
             use errors = new ErrorScope()
@@ -2570,6 +2577,7 @@ type BackgroundCompiler(referenceResolver, projectCacheSize, keepAssemblyContent
                     UnresolvedReferences = Some (UnresolvedReferencesSet(loadClosure.UnresolvedReferences))
                     OriginalLoadReferences = loadClosure.OriginalLoadReferences
                     ExtraProjectInfo=extraProjectInfo
+                    Stamp = optionsStamp
                 }
             scriptClosureCacheLock.AcquireLock (fun ltok -> scriptClosureCache.Set(ltok, options, loadClosure)) // Save the full load closure for later correlation.
             return options, errors.Diagnostics
@@ -2873,8 +2881,8 @@ type FSharpChecker(referenceResolver, projectCacheSize, keepAssemblyContents, ke
         backgroundCompiler.KeepProjectAlive(options)
 
     /// For a given script file, get the ProjectOptions implied by the #load closure
-    member ic.GetProjectOptionsFromScript(filename, source, ?loadedTimeStamp, ?otherFlags, ?useFsiAuxLib, ?assumeDotNetFramework, ?extraProjectInfo: obj) = 
-        backgroundCompiler.GetProjectOptionsFromScript(filename,source,?loadedTimeStamp=loadedTimeStamp, ?otherFlags=otherFlags, ?useFsiAuxLib=useFsiAuxLib, ?assumeDotNetFramework=assumeDotNetFramework, ?extraProjectInfo=extraProjectInfo)
+    member ic.GetProjectOptionsFromScript(filename, source, ?loadedTimeStamp, ?otherFlags, ?useFsiAuxLib, ?assumeDotNetFramework, ?extraProjectInfo: obj, ?optionsStamp: int64) = 
+        backgroundCompiler.GetProjectOptionsFromScript(filename,source,?loadedTimeStamp=loadedTimeStamp, ?otherFlags=otherFlags, ?useFsiAuxLib=useFsiAuxLib, ?assumeDotNetFramework=assumeDotNetFramework, ?extraProjectInfo=extraProjectInfo, ?optionsStamp=optionsStamp)
 
     member ic.GetProjectOptionsFromCommandLineArgs(projectFileName, argv, ?loadedTimeStamp, ?extraProjectInfo: obj) = 
         let loadedTimeStamp = defaultArg loadedTimeStamp DateTime.MaxValue // Not 'now', we don't want to force reloading
@@ -2887,7 +2895,8 @@ type FSharpChecker(referenceResolver, projectCacheSize, keepAssemblyContents, ke
           LoadTime = loadedTimeStamp
           UnresolvedReferences = None
           OriginalLoadReferences=[]
-          ExtraProjectInfo=extraProjectInfo }
+          ExtraProjectInfo=extraProjectInfo
+          Stamp = None }
 
     /// Begin background parsing the given project.
     member ic.StartBackgroundCompile(options) = backgroundCompiler.CheckProjectInBackground(options) 

src/fsharp/vs/service.fsi

@@ -324,6 +324,11 @@ type internal FSharpProjectOptions =
       OriginalLoadReferences: (range * string) list
       /// Extra information passed back on event trigger
       ExtraProjectInfo : obj option
+
+      /// An optional stamp to uniquely identify this set of options
+      /// If two sets of options both have stamps, then they are considered equal
+      /// if and only if the stamps are equal
+      Stamp: int64 option
     }
 
 /// The result of calling TypeCheckResult including the possibility of abort and background compiler not caught up.
@@ -473,7 +478,7 @@ type internal FSharpChecker =
     /// <param name="loadedTimeStamp">Indicates when the script was loaded into the editing environment,
     /// so that an 'unload' and 'reload' action will cause the script to be considered as a new project,
     /// so that references are re-resolved.</param>
-    member GetProjectOptionsFromScript : filename: string * source: string * ?loadedTimeStamp: DateTime * ?otherFlags: string[] * ?useFsiAuxLib: bool * ?assumeDotNetFramework: bool * ?extraProjectInfo: obj -> Async<FSharpProjectOptions * FSharpErrorInfo list>
+    member GetProjectOptionsFromScript : filename: string * source: string * ?loadedTimeStamp: DateTime * ?otherFlags: string[] * ?useFsiAuxLib: bool * ?assumeDotNetFramework: bool * ?extraProjectInfo: obj * ?optionsStamp: int64 -> Async<FSharpProjectOptions * FSharpErrorInfo list>
 
     /// <summary>
     /// <para>Get the FSharpProjectOptions implied by a set of command line arguments.</para>

tests/service/FileSystemTests.fs

@@ -103,7 +103,8 @@ let ``FileSystem compilation test``() =
           LoadTime = System.DateTime.Now // Not 'now', we don't want to force reloading
           UnresolvedReferences = None 
           OriginalLoadReferences = []
-          ExtraProjectInfo = None }
+          ExtraProjectInfo = None 
+          Stamp = None }
 
     let results = checker.ParseAndCheckProject(projectOptions) |> Async.RunSynchronously
 

vsintegration/Utils/LanguageServiceProfiling/Options.fs

@@ -283,7 +283,8 @@ let FCS (repositoryDir: string) : Options =
          LoadTime = DateTime.Now
          UnresolvedReferences = None;
          OriginalLoadReferences = []
-         ExtraProjectInfo = None }
+         ExtraProjectInfo = None 
+         Stamp = None }
       FilesToCheck = 
           files 
           |> Array.filter (fun s -> s.Contains "TypeChecker.fs" || 
@@ -403,7 +404,8 @@ let VFPT (repositoryDir: string) : Options =
          LoadTime = DateTime.Now
          UnresolvedReferences = None
          OriginalLoadReferences = []
-         ExtraProjectInfo = None }
+         ExtraProjectInfo = None 
+         Stamp = None }
       FilesToCheck = []
       FileToCheck = repositoryDir </> @"src\FSharp.Editing\CodeGeneration\RecordStubGenerator.fs"
       SymbolText = "option"

vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs

@@ -90,21 +90,24 @@ type internal ProjectInfoManager
         projectTable.TryRemove(projectId) |> ignore
 
     /// Get the exact options for a single-file script
-    member this.ComputeSingleFileOptions (fileName, loadTime, fileContents, workspace: Workspace) = async {
+    member this.ComputeSingleFileOptions (tryGetOrCreateProjectId, fileName, loadTime, fileContents, workspace: Workspace) = async {
         let extraProjectInfo = Some(box workspace)
+        let tryGetOptionsForReferencedProject f = f |> tryGetOrCreateProjectId |> Option.bind this.TryGetOptionsForProject
         if SourceFile.MustBeSingleFileProject(fileName) then 
-            let! options, _diagnostics = checkerProvider.Checker.GetProjectOptionsFromScript(fileName, fileContents, loadTime, [| |], ?extraProjectInfo=extraProjectInfo) 
+            let optionsStamp = None // TODO: can we use a unique stamp?
+            let! options, _diagnostics = checkerProvider.Checker.GetProjectOptionsFromScript(fileName, fileContents, loadTime, [| |], ?extraProjectInfo=extraProjectInfo, ?optionsStamp=optionsStamp) 
             let site = ProjectSitesAndFiles.CreateProjectSiteForScript(fileName, options)
-            return ProjectSitesAndFiles.GetProjectOptionsForProjectSite(site,fileName,options.ExtraProjectInfo,serviceProvider)
+            return ProjectSitesAndFiles.GetProjectOptionsForProjectSite(tryGetOptionsForReferencedProject,site,fileName,options.ExtraProjectInfo,serviceProvider, true)
         else
             let site = ProjectSitesAndFiles.ProjectSiteOfSingleFile(fileName)
-            return ProjectSitesAndFiles.GetProjectOptionsForProjectSite(site,fileName,extraProjectInfo,serviceProvider)
+            return ProjectSitesAndFiles.GetProjectOptionsForProjectSite(tryGetOptionsForReferencedProject,site,fileName,extraProjectInfo,serviceProvider, true)
       }
 
     /// Update the info for a project in the project table
-    member this.UpdateProjectInfo(projectId: ProjectId, site: IProjectSite, workspace: Workspace) =
+    member this.UpdateProjectInfo(tryGetOrCreateProjectId, projectId: ProjectId, site: IProjectSite, workspace: Workspace) =
         let extraProjectInfo = Some(box workspace)
-        let options = ProjectSitesAndFiles.GetProjectOptionsForProjectSite(site, site.ProjectFileName(), extraProjectInfo, serviceProvider)
+        let tryGetOptionsForReferencedProject f = f |> tryGetOrCreateProjectId |> Option.bind this.TryGetOptionsForProject
+        let options = ProjectSitesAndFiles.GetProjectOptionsForProjectSite(tryGetOptionsForReferencedProject, site, site.ProjectFileName(), extraProjectInfo, serviceProvider, true)
         checkerProvider.Checker.InvalidateConfiguration(options)
         projectTable.[projectId] <- options
 
@@ -138,7 +141,7 @@ type internal ProjectInfoManager
             let fileName = document.FilePath
             let! cancellationToken = Async.CancellationToken
             let! sourceText = document.GetTextAsync(cancellationToken)
-            let! options = this.ComputeSingleFileOptions (fileName, loadTime, sourceText.ToString(), document.Project.Solution.Workspace)
+            let! options = this.ComputeSingleFileOptions ((fun _ -> None), fileName, loadTime, sourceText.ToString(), document.Project.Solution.Workspace)
             singleFileProjectTable.[projectId] <- (loadTime, options)
             return Some options
           with ex -> 
@@ -300,7 +303,7 @@ and
         theme.SetColors()
 
     /// Sync the information for the project 
-    member this.SyncProject(project: AbstractProject, projectContext: IWorkspaceProjectContext, site: IProjectSite, forceUpdate) =
+    member this.SyncProject(project: AbstractProject, projectContext: IWorkspaceProjectContext, site: IProjectSite, workspace, forceUpdate) =
         let hashSetIgnoreCase x = new HashSet<string>(x, StringComparer.OrdinalIgnoreCase)
         let updatedFiles = site.SourceFilesOnDisk() |> hashSetIgnoreCase
         let workspaceFiles = project.GetCurrentDocuments() |> Seq.map(fun file -> file.FilePath) |> hashSetIgnoreCase
@@ -328,7 +331,7 @@ and
 
         // update the cached options
         if updated then
-            projectInfoManager.UpdateProjectInfo(project.Id, site, project.Workspace)
+            projectInfoManager.UpdateProjectInfo(this.GetProjectIdForReferencedProject workspace, project.Id, site, project.Workspace)
 
     member this.SetupProjectFile(siteProvider: IProvideProjectSite, workspace: VisualStudioWorkspaceImpl) =
         let  rec setup (site: IProjectSite) =
@@ -338,7 +341,7 @@ and
             let projectId = workspace.ProjectTracker.GetOrCreateProjectIdForPath(projectFileName, projectDisplayName)
 
             if isNull (workspace.ProjectTracker.GetProject projectId) then
-                projectInfoManager.UpdateProjectInfo(projectId, site, workspace)
+                projectInfoManager.UpdateProjectInfo(this.GetProjectIdForReferencedProject workspace, projectId, site, workspace)
                 let projectContextFactory = package.ComponentModel.GetService<IWorkspaceProjectContextFactory>();
                 let errorReporter = ProjectExternalErrorReporter(projectId, "FS", this.SystemServiceProvider)
 
@@ -358,9 +361,9 @@ and
 
                 let project = projectContext :?> AbstractProject
 
-                this.SyncProject(project, projectContext, site, forceUpdate=false)
+                this.SyncProject(project, projectContext, site, workspace, forceUpdate=false)
                 site.AdviseProjectSiteChanges(FSharpConstants.FSharpLanguageServiceCallbackName, 
-                                              AdviseProjectSiteChanges(fun () -> this.SyncProject(project, projectContext, site, forceUpdate=true)))
+                                              AdviseProjectSiteChanges(fun () -> this.SyncProject(project, projectContext, site, workspace, forceUpdate=true)))
                 site.AdviseProjectSiteClosed(FSharpConstants.FSharpLanguageServiceCallbackName, 
                                              AdviseProjectSiteChanges(fun () -> 
                                                 projectInfoManager.ClearProjectInfo(project.Id)
@@ -371,10 +374,14 @@ and
             projectId
         setup (siteProvider.GetProjectSite()) |> ignore
 
+    member this.GetProjectIdForReferencedProject (workspace: VisualStudioWorkspaceImpl) (projectFileName: string) =
+        let projectDisplayName = projectDisplayNameOf projectFileName
+        Some (workspace.ProjectTracker.GetOrCreateProjectIdForPath(projectFileName, projectDisplayName))
+
     member this.SetupStandAloneFile(fileName: string, fileContents: string, workspace: VisualStudioWorkspaceImpl, hier: IVsHierarchy) =
 
         let loadTime = DateTime.Now
-        let options = projectInfoManager.ComputeSingleFileOptions (fileName, loadTime, fileContents, workspace) |> Async.RunSynchronously
+        let options = projectInfoManager.ComputeSingleFileOptions (this.GetProjectIdForReferencedProject workspace, fileName, loadTime, fileContents, workspace) |> Async.RunSynchronously
 
         let projectFileName = fileName
         let projectDisplayName = projectDisplayNameOf projectFileName

vsintegration/src/FSharp.LanguageService/BackgroundRequests.fs

@@ -82,7 +82,7 @@ type internal FSharpLanguageServiceBackgroundRequests
                     // This portion is executed on the UI thread.
                     let rdt = getServiceProvider().RunningDocumentTable
                     let projectSite = getProjectSitesAndFiles().FindOwningProject(rdt,fileName)
-                    let checkOptions = ProjectSitesAndFiles.GetProjectOptionsForProjectSite(projectSite, fileName, None, getServiceProvider())                            
+                    let checkOptions = ProjectSitesAndFiles.GetProjectOptionsForProjectSite((fun _ -> None), projectSite, fileName, None, getServiceProvider(), false)                            
                     let projectFileName = projectSite.ProjectFileName()
                     let data = 
                         {   ProjectSite = projectSite

vsintegration/src/FSharp.LanguageService/FSharpSource.fs

@@ -330,7 +330,8 @@ type internal FSharpSource(service:LanguageService, textLines, colorizer, vsFile
                   LoadTime = new System.DateTime(2000,1,1)   // dummy data, just enough to get a parse
                   UnresolvedReferences = None
                   OriginalLoadReferences = []
-                  ExtraProjectInfo=None }
+                  ExtraProjectInfo=None 
+                  Stamp = None }
 
             ic.ParseFileInProject(fileName, source.GetText(), co) |> Async.RunSynchronously