From 5fe06197bfb17d8667dd12cb2bfcc39ef2cda302 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 21 Jul 2016 00:13:21 +0100 Subject: [PATCH] fix closure computation --- src/fsharp/CompileOps.fs | 167 ++++++++++++++++++++------------------- 1 file changed, 87 insertions(+), 80 deletions(-) diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 31ca1a6f2f59..461a0393ec93 100755 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -2515,7 +2515,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = else // If the file doesn't exist, let reference resolution logic report the error later... defaultCoreLibraryReference, if r.Range =rangeStartup then Some(filename) else None - match data.referencedDLLs |> List.filter(fun assemblyReference -> assemblyReference.SimpleAssemblyNameIs libraryName) with + match data.referencedDLLs |> List.filter (fun assemblyReference -> assemblyReference.SimpleAssemblyNameIs libraryName) with | [r] -> nameOfDll r | [] -> defaultCoreLibraryReference, None @@ -2805,9 +2805,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = else Some(m,path) with e -> errorRecovery e m; None tcConfig.loadedSources - |> List.map resolveLoadedSource - |> List.filter Option.isSome - |> List.map Option.get + |> List.choose resolveLoadedSource |> List.distinct /// A closed set of assemblies where, for any subset S: @@ -3005,10 +3003,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = let resolvedAsFile = groupedReferences |>Array.map(fun (_filename,maxIndexOfReference,references)-> - let assemblyResolution = references - |> List.map tcConfig.TryResolveLibWithDirectories - |> List.filter Option.isSome - |> List.map Option.get + let assemblyResolution = references |> List.choose tcConfig.TryResolveLibWithDirectories (maxIndexOfReference, assemblyResolution)) |> Array.filter(fun (_,refs)->refs|>List.isEmpty|>not) @@ -4825,9 +4820,13 @@ type CodeContext = module private ScriptPreprocessClosure = open Internal.Utilities.Text.Lexing + type ClosureFile = ClosureFile of string * range * ParsedInput option * PhasedError list * PhasedError list * (string * range) list // filename, range, errors, warnings, nowarns + type ClosureDirective = - | SourceFile of string * range * string // filename, range, source text - | ClosedSourceFile of string * range * ParsedInput option * PhasedError list * PhasedError list * (string * range) list // filename, range, errors, warnings, nowarns + /// Represents a file that is processed as a script, i.e. its contents are transitively checked for #r/#load references + | ScriptSource of string * range * string // filename, range, source text + /// Represents a non-script file, i.e. its contents are ignored + | NonScriptSource of ClosureFile type Observed() = let seen = System.Collections.Generic.Dictionary<_,bool>() @@ -4892,7 +4891,7 @@ module private ScriptPreprocessClosure = | None -> new StreamReader(stream,true) | Some n -> new StreamReader(stream,Encoding.GetEncodingShim(n)) let source = reader.ReadToEnd() - [SourceFile(filename,m,source)] + [ScriptSource(filename,m,source)] with e -> errorRecovery e m [] @@ -4920,80 +4919,88 @@ module private ScriptPreprocessClosure = let tcConfig = ref tcConfig let observedSources = Observed() - let rec FindClosure (closureDirective:ClosureDirective) : ClosureDirective list = - match closureDirective with - | ClosedSourceFile _ as csf -> [csf] - | SourceFile(filename,m,source) -> - let errors = ref [] - let warnings = ref [] - let errorLogger = - { new ErrorLogger("FindClosure") with - member x.ErrorSinkImpl(e) = errors := e :: !errors - member x.WarnSinkImpl(e) = warnings := e :: !warnings - member x.ErrorCount = (!errors).Length } - - use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) - let pathOfMetaCommandSource = Path.GetDirectoryName(filename) - match ParseScriptText(filename,source,!tcConfig,codeContext,lexResourceManager,errorLogger) with - | Some(input) -> - let tcConfigResult, noWarns = ApplyMetaCommandsFromInputToTcConfigAndGatherNoWarn !tcConfig (input,pathOfMetaCommandSource) - tcConfig := tcConfigResult - - let AddFileIfNotSeen(m,filename) = - if observedSources.HaveSeen(filename) then [] - else - observedSources.SetSeen(filename) - if IsScript(filename) then SourceFileOfFilename(filename,m,tcConfigResult.inputCodePage) - else [ClosedSourceFile(filename,m,None,[],[],[])] // Don't traverse into .fs leafs. + let rec loop closureDirective = + [ match closureDirective with + | NonScriptSource csf -> yield csf + | ScriptSource(filename,m,source) -> + if not (observedSources.HaveSeen(filename)) then + observedSources.SetSeen(filename) + //printfn "visiting %s" filename + if IsScript(filename) then + let errors = ref [] + let warnings = ref [] + let errorLogger = + { new ErrorLogger("FindClosure") with + member x.ErrorSinkImpl(e) = errors := e :: !errors + member x.WarnSinkImpl(e) = warnings := e :: !warnings + member x.ErrorCount = (!errors).Length } + + use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) + let pathOfMetaCommandSource = Path.GetDirectoryName(filename) + match ParseScriptText(filename,source,!tcConfig,codeContext,lexResourceManager,errorLogger) with + | Some parsedScriptAst -> + let preSources = (!tcConfig).GetAvailableLoadedSources() + + let tcConfigResult, noWarns = ApplyMetaCommandsFromInputToTcConfigAndGatherNoWarn !tcConfig (parsedScriptAst,pathOfMetaCommandSource) + tcConfig := tcConfigResult // We accumulate the tcConfig in order to collect assembly references - let loadedSources = (!tcConfig).GetAvailableLoadedSources() |> List.map AddFileIfNotSeen |> List.concat - (loadedSources |> List.map FindClosure |> List.concat) - @ [ClosedSourceFile(filename,m,Some(input),!errors,!warnings,!noWarns)] - | None -> [ClosedSourceFile(filename,m,None,!errors,!warnings,[])] + let postSources = (!tcConfig).GetAvailableLoadedSources() + let sources = if preSources.Length < postSources.Length then postSources.[preSources.Length..] else [] + + //for (_,subFile) in sources do + // printfn "visiting %s - has subsource of %s " filename subFile + + for (m,subFile) in sources do + for sourceFile in SourceFileOfFilename(subFile,m,tcConfigResult.inputCodePage) do + yield! loop sourceFile + + //printfn "yielding source %s" filename + yield ClosureFile(filename, m, Some parsedScriptAst, !errors, !warnings, !noWarns) - closureDirectives |> List.map FindClosure |> List.concat, !tcConfig + | None -> + //printfn "yielding source %s (failed parse)" filename + yield ClosureFile(filename, m, None, !errors, !warnings, []) + else + // Don't traverse into .fs leafs. + //printfn "yielding non-script source %s" filename + yield ClosureFile(filename, m, None, [], [], []) ] + + closureDirectives |> List.map loop |> List.concat, !tcConfig /// Reduce the full directive closure into LoadClosure - let GetLoadClosure(rootFilename,closureDirectives,(tcConfig:TcConfig),codeContext) = + let GetLoadClosure(rootFilename,closureFiles,tcConfig:TcConfig,codeContext) = - // Mark the last file as isLastCompiland. closureDirectives is currently reversed. - let closureDirectives = - match closureDirectives with - | ClosedSourceFile(filename,m,Some(ParsedInput.ImplFile(ParsedImplFileInput(name,isScript,qualNameOfFile,scopedPragmas,hashDirectives,implFileFlags,_))),errs,warns,nowarns)::rest -> - ClosedSourceFile(filename,m,Some(ParsedInput.ImplFile(ParsedImplFileInput(name,isScript,qualNameOfFile,scopedPragmas,hashDirectives,implFileFlags,(true, tcConfig.target.IsExe)))),errs,warns,nowarns)::rest - | x -> x + // Mark the last file as isLastCompiland. + let closureFiles = + match List.frontAndBack closureFiles with + | rest, ClosureFile(filename,m,Some(ParsedInput.ImplFile(ParsedImplFileInput(name,isScript,qualNameOfFile,scopedPragmas,hashDirectives,implFileFlags,_))),errs,warns,nowarns) -> + rest @ [ClosureFile(filename,m,Some(ParsedInput.ImplFile(ParsedImplFileInput(name,isScript,qualNameOfFile,scopedPragmas,hashDirectives,implFileFlags,(true, tcConfig.target.IsExe)))),errs,warns,nowarns)] + | _ -> closureFiles // Get all source files. - let sourceFiles = ref [] - let sourceInputs = ref [] - let globalNoWarns = ref [] - for directive in List.rev closureDirectives do - match directive with - | ClosedSourceFile(filename,m,input,_,_,noWarns) -> - let filename = FileSystem.GetFullPathShim(filename) - sourceFiles := (filename,m) :: !sourceFiles - globalNoWarns := (!globalNoWarns @ noWarns) - sourceInputs := (filename,input) :: !sourceInputs - | _ -> failwith "Unexpected" - + let sourceFiles = [ for (ClosureFile(filename,m,_,_,_,_)) in closureFiles -> (filename,m) ] + let sourceInputs = [ for (ClosureFile(filename,_,input,_,_,_)) in closureFiles -> (filename,input) ] + let globalNoWarns = closureFiles |> List.collect (fun (ClosureFile(_,_,_,_,_,noWarns)) -> noWarns) + // Resolve all references. - let resolutionErrors = ref [] - let resolutionWarnings = ref [] - let errorLogger = - { new ErrorLogger("GetLoadClosure") with - member x.ErrorSinkImpl(e) = resolutionErrors := e :: !resolutionErrors - member x.WarnSinkImpl(e) = resolutionWarnings := e :: !resolutionWarnings - member x.ErrorCount = (!resolutionErrors).Length } + let references, unresolvedReferences, resolutionWarnings, resolutionErrors = + let resolutionErrors = ref [] + let resolutionWarnings = ref [] + let errorLogger = + { new ErrorLogger("GetLoadClosure") with + member x.ErrorSinkImpl(e) = resolutionErrors := e :: !resolutionErrors + member x.WarnSinkImpl(e) = resolutionWarnings := e :: !resolutionWarnings + member x.ErrorCount = (!resolutionErrors).Length } - let references,unresolvedReferences = use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) - GetAssemblyResolutionInformation(tcConfig) - let references = references |> List.map (fun ar -> ar.resolvedPath,ar) - - // Root errors and warnings + let references,unresolvedReferences = GetAssemblyResolutionInformation(tcConfig) + let references = references |> List.map (fun ar -> ar.resolvedPath,ar) + references, unresolvedReferences, resolutionWarnings, resolutionErrors + + // Root errors and warnings - look at the last item in the closureFiles list let rootErrors, rootWarnings = - match closureDirectives with - | ClosedSourceFile(_,_,_,errors,warnings,_) :: _ -> errors @ !resolutionErrors, warnings @ !resolutionWarnings + match List.rev closureFiles with + | ClosureFile(_,_,_,errors,warnings,_) :: _ -> errors @ !resolutionErrors, warnings @ !resolutionWarnings | _ -> [],[] // When no file existed. let isRootRange exn = @@ -5010,11 +5017,11 @@ module private ScriptPreprocessClosure = let rootWarnings = rootWarnings |> List.filter isRootRange let result : LoadClosure = - { SourceFiles = List.groupByFirst !sourceFiles + { SourceFiles = List.groupByFirst sourceFiles References = List.groupByFirst references UnresolvedReferences = unresolvedReferences - Inputs = !sourceInputs - NoWarns = List.groupByFirst !globalNoWarns + Inputs = sourceInputs + NoWarns = List.groupByFirst globalNoWarns RootErrors = rootErrors RootWarnings = rootWarnings} @@ -5034,15 +5041,15 @@ module private ScriptPreprocessClosure = let tcConfig = CreateScriptSourceTcConfig(filename,codeContext,useSimpleResolution,useFsiAuxLib,Some references0,applyCommmandLineArgs) - let protoClosure = [SourceFile(filename,range0,source)] + let protoClosure = [ScriptSource(filename,range0,source)] let finalClosure,tcConfig = FindClosureDirectives(protoClosure,tcConfig,codeContext,lexResourceManager) GetLoadClosure(filename,finalClosure,tcConfig,codeContext) /// Given source filename, find the full load closure /// Used from fsi.fs and fsc.fs, for #load and command line let GetFullClosureOfScriptFiles(tcConfig:TcConfig,files:(string*range) list,codeContext,_useDefaultScriptingReferences:bool,lexResourceManager:Lexhelp.LexResourceManager) = - let mainFile = fst (List.head files) - let protoClosure = files |> List.map (fun (filename,m)->SourceFileOfFilename(filename,m,tcConfig.inputCodePage)) |> List.concat |> List.rev // Reverse to put them in the order they will be extracted later + let mainFile = fst (List.last files) + let protoClosure = files |> List.map (fun (filename,m)->SourceFileOfFilename(filename,m,tcConfig.inputCodePage)) |> List.concat let finalClosure,tcConfig = FindClosureDirectives(protoClosure,tcConfig,codeContext,lexResourceManager) GetLoadClosure(mainFile,finalClosure,tcConfig,codeContext)