Skip to content

Commit db10235

Browse files
dsymedsyme
committed
fix closure computation
1 parent 09e26b0 commit db10235

File tree

1 file changed

+92
-87
lines changed

1 file changed

+92
-87
lines changed

‎src/fsharp/CompileOps.fs‎

Lines changed: 92 additions & 87 deletions
Original file line numberDiff line numberDiff line change
@@ -2556,7 +2556,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) =
25562556
else
25572557
// If the file doesn't exist, let reference resolution logic report the error later...
25582558
defaultCoreLibraryReference, if r.Range =rangeStartup then Some(filename) else None
2559-
match data.referencedDLLs |> List.filter(fun assemblyReference -> assemblyReference.SimpleAssemblyNameIs libraryName) with
2559+
match data.referencedDLLs |> List.filter (fun assemblyReference -> assemblyReference.SimpleAssemblyNameIs libraryName) with
25602560
| [r] -> nameOfDll r
25612561
| [] ->
25622562
defaultCoreLibraryReference, None
@@ -2861,9 +2861,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) =
28612861
else Some(m,path)
28622862
with e -> errorRecovery e m; None
28632863
tcConfig.loadedSources
2864-
|> List.map resolveLoadedSource
2865-
|> List.filter Option.isSome
2866-
|> List.map Option.get
2864+
|> List.choose resolveLoadedSource
28672865
|> List.distinct
28682866

28692867
/// A closed set of assemblies where, for any subset S:
@@ -3061,10 +3059,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) =
30613059
let resolvedAsFile =
30623060
groupedReferences
30633061
|>Array.map(fun (_filename,maxIndexOfReference,references)->
3064-
let assemblyResolution = references
3065-
|> List.map tcConfig.TryResolveLibWithDirectories
3066-
|> List.filter Option.isSome
3067-
|> List.map Option.get
3062+
let assemblyResolution = references |> List.choose tcConfig.TryResolveLibWithDirectories
30683063
(maxIndexOfReference, assemblyResolution))
30693064
|> Array.filter(fun (_,refs)->refs|>List.isEmpty|>not)
30703065

@@ -4876,10 +4871,12 @@ type CodeContext =
48764871
module private ScriptPreprocessClosure =
48774872
open Internal.Utilities.Text.Lexing
48784873

4879-
type ClosureDirective =
4880-
| SourceFile of string * range * string // filename, range, source text
4881-
| ClosedSourceFile of string * range * ParsedInput option * PhasedError list * PhasedError list * (string * range) list // filename, range, errors, warnings, nowarns
4874+
/// Represents an input to the closure finding process
4875+
type ClosureSource = ClosureSource of filename: string * referenceRange: range * sourceText: string * parseRequired: bool
48824876

4877+
/// Represents an output of the closure finding process
4878+
type ClosureFile = ClosureFile of string * range * ParsedInput option * PhasedError list * PhasedError list * (string * range) list // filename, range, errors, warnings, nowarns
4879+
48834880
type Observed() =
48844881
let seen = System.Collections.Generic.Dictionary<_,bool>()
48854882
member ob.SetSeen(check) =
@@ -4935,7 +4932,7 @@ module private ScriptPreprocessClosure =
49354932
tcConfigB.implicitlyResolveAssemblies <- false
49364933
TcConfig.Create(tcConfigB,validate=true)
49374934

4938-
let SourceFileOfFilename(filename,m,inputCodePage:int option) : ClosureDirective list =
4935+
let ClosureSourceOfFilename(filename,m,inputCodePage,parseRequired) =
49394936
try
49404937
let filename = FileSystem.GetFullPathShim(filename)
49414938
use stream = FileSystem.FileStreamReadShim filename
@@ -4944,7 +4941,7 @@ module private ScriptPreprocessClosure =
49444941
| None -> new StreamReader(stream,true)
49454942
| Some n -> new StreamReader(stream,Encoding.GetEncodingShim(n))
49464943
let source = reader.ReadToEnd()
4947-
[SourceFile(filename,m,source)]
4944+
[ClosureSource(filename,m,source,parseRequired)]
49484945
with e ->
49494946
errorRecovery e m
49504947
[]
@@ -4968,84 +4965,92 @@ module private ScriptPreprocessClosure =
49684965
let tcConfigB = tcConfig.CloneOfOriginalBuilder
49694966
TcConfig.Create(tcConfigB,validate=false),nowarns
49704967

4971-
let FindClosureDirectives(closureDirectives,tcConfig:TcConfig,codeContext,lexResourceManager:Lexhelp.LexResourceManager) =
4968+
let FindClosureFiles(closureSources,tcConfig:TcConfig,codeContext,lexResourceManager:Lexhelp.LexResourceManager) =
49724969
let tcConfig = ref tcConfig
49734970

49744971
let observedSources = Observed()
4975-
let rec FindClosure (closureDirective:ClosureDirective) : ClosureDirective list =
4976-
match closureDirective with
4977-
| ClosedSourceFile _ as csf -> [csf]
4978-
| SourceFile(filename,m,source) ->
4979-
let errors = ref []
4980-
let warnings = ref []
4981-
let errorLogger =
4982-
{ new ErrorLogger("FindClosure") with
4983-
member x.ErrorSinkImpl(e) = errors := e :: !errors
4984-
member x.WarnSinkImpl(e) = warnings := e :: !warnings
4985-
member x.ErrorCount = (!errors).Length }
4986-
4987-
use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger)
4988-
let pathOfMetaCommandSource = Path.GetDirectoryName(filename)
4989-
match ParseScriptText(filename,source,!tcConfig,codeContext,lexResourceManager,errorLogger) with
4990-
| Some(input) ->
4991-
let tcConfigResult, noWarns = ApplyMetaCommandsFromInputToTcConfigAndGatherNoWarn !tcConfig (input,pathOfMetaCommandSource)
4992-
tcConfig := tcConfigResult
4993-
4994-
let AddFileIfNotSeen(m,filename) =
4995-
if observedSources.HaveSeen(filename) then []
4996-
else
4997-
observedSources.SetSeen(filename)
4998-
if IsScript(filename) then SourceFileOfFilename(filename,m,tcConfigResult.inputCodePage)
4999-
else [ClosedSourceFile(filename,m,None,[],[],[])] // Don't traverse into .fs leafs.
4972+
let rec loop (ClosureSource(filename,m,source,parseRequired)) =
4973+
[ if not (observedSources.HaveSeen(filename)) then
4974+
observedSources.SetSeen(filename)
4975+
//printfn "visiting %s" filename
4976+
if IsScript(filename) || parseRequired then
4977+
let errors = ref []
4978+
let warnings = ref []
4979+
let errorLogger =
4980+
{ new ErrorLogger("FindClosure") with
4981+
member x.ErrorSinkImpl(e) = errors := e :: !errors
4982+
member x.WarnSinkImpl(e) = warnings := e :: !warnings
4983+
member x.ErrorCount = (!errors).Length }
4984+
4985+
use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger)
4986+
let pathOfMetaCommandSource = Path.GetDirectoryName(filename)
4987+
match ParseScriptText(filename,source,!tcConfig,codeContext,lexResourceManager,errorLogger) with
4988+
| Some parsedScriptAst ->
4989+
let preSources = (!tcConfig).GetAvailableLoadedSources()
4990+
4991+
let tcConfigResult, noWarns = ApplyMetaCommandsFromInputToTcConfigAndGatherNoWarn !tcConfig (parsedScriptAst,pathOfMetaCommandSource)
4992+
tcConfig := tcConfigResult // We accumulate the tcConfig in order to collect assembly references
50004993

5001-
let loadedSources = (!tcConfig).GetAvailableLoadedSources() |> List.map AddFileIfNotSeen |> List.concat
5002-
(loadedSources |> List.map FindClosure |> List.concat)
5003-
@ [ClosedSourceFile(filename,m,Some(input),!errors,!warnings,!noWarns)]
5004-
| None -> [ClosedSourceFile(filename,m,None,!errors,!warnings,[])]
4994+
let postSources = (!tcConfig).GetAvailableLoadedSources()
4995+
let sources = if preSources.Length < postSources.Length then postSources.[preSources.Length..] else []
4996+
4997+
//for (_,subFile) in sources do
4998+
// printfn "visiting %s - has subsource of %s " filename subFile
4999+
5000+
for (m,subFile) in sources do
5001+
if IsScript(subFile) then
5002+
for subSource in ClosureSourceOfFilename(subFile,m,tcConfigResult.inputCodePage,false) do
5003+
yield! loop subSource
5004+
else
5005+
yield ClosureFile(subFile, m, None, [], [], [])
5006+
5007+
//printfn "yielding source %s" filename
5008+
yield ClosureFile(filename, m, Some parsedScriptAst, !errors, !warnings, !noWarns)
50055009

5006-
closureDirectives |> List.map FindClosure |> List.concat, !tcConfig
5010+
| None ->
5011+
//printfn "yielding source %s (failed parse)" filename
5012+
yield ClosureFile(filename, m, None, !errors, !warnings, [])
5013+
else
5014+
// Don't traverse into .fs leafs.
5015+
//printfn "yielding non-script source %s" filename
5016+
yield ClosureFile(filename, m, None, [], [], []) ]
5017+
5018+
closureSources |> List.map loop |> List.concat, !tcConfig
50075019

50085020
/// Reduce the full directive closure into LoadClosure
5009-
let GetLoadClosure(rootFilename,closureDirectives,(tcConfig:TcConfig),codeContext) =
5021+
let GetLoadClosure(rootFilename,closureFiles,tcConfig:TcConfig,codeContext) =
50105022

5011-
// Mark the last file as isLastCompiland. closureDirectives is currently reversed.
5012-
let closureDirectives =
5013-
match closureDirectives with
5014-
| ClosedSourceFile(filename,m,Some(ParsedInput.ImplFile(ParsedImplFileInput(name,isScript,qualNameOfFile,scopedPragmas,hashDirectives,implFileFlags,_))),errs,warns,nowarns)::rest ->
5015-
ClosedSourceFile(filename,m,Some(ParsedInput.ImplFile(ParsedImplFileInput(name,isScript,qualNameOfFile,scopedPragmas,hashDirectives,implFileFlags,(true, tcConfig.target.IsExe)))),errs,warns,nowarns)::rest
5016-
| x -> x
5023+
// Mark the last file as isLastCompiland.
5024+
let closureFiles =
5025+
match List.frontAndBack closureFiles with
5026+
| rest, ClosureFile(filename,m,Some(ParsedInput.ImplFile(ParsedImplFileInput(name,isScript,qualNameOfFile,scopedPragmas,hashDirectives,implFileFlags,_))),errs,warns,nowarns) ->
5027+
rest @ [ClosureFile(filename,m,Some(ParsedInput.ImplFile(ParsedImplFileInput(name,isScript,qualNameOfFile,scopedPragmas,hashDirectives,implFileFlags,(true, tcConfig.target.IsExe)))),errs,warns,nowarns)]
5028+
| _ -> closureFiles
50175029

50185030
// Get all source files.
5019-
let sourceFiles = ref []
5020-
let sourceInputs = ref []
5021-
let globalNoWarns = ref []
5022-
for directive in List.rev closureDirectives do
5023-
match directive with
5024-
| ClosedSourceFile(filename,m,input,_,_,noWarns) ->
5025-
let filename = FileSystem.GetFullPathShim(filename)
5026-
sourceFiles := (filename,m) :: !sourceFiles
5027-
globalNoWarns := (!globalNoWarns @ noWarns)
5028-
sourceInputs := (filename,input) :: !sourceInputs
5029-
| _ -> failwith "Unexpected"
5030-
5031+
let sourceFiles = [ for (ClosureFile(filename,m,_,_,_,_)) in closureFiles -> (filename,m) ]
5032+
let sourceInputs = [ for (ClosureFile(filename,_,input,_,_,_)) in closureFiles -> (filename,input) ]
5033+
let globalNoWarns = closureFiles |> List.collect (fun (ClosureFile(_,_,_,_,_,noWarns)) -> noWarns)
5034+
50315035
// Resolve all references.
5032-
let resolutionErrors = ref []
5033-
let resolutionWarnings = ref []
5034-
let errorLogger =
5035-
{ new ErrorLogger("GetLoadClosure") with
5036-
member x.ErrorSinkImpl(e) = resolutionErrors := e :: !resolutionErrors
5037-
member x.WarnSinkImpl(e) = resolutionWarnings := e :: !resolutionWarnings
5038-
member x.ErrorCount = (!resolutionErrors).Length }
5036+
let references, unresolvedReferences, resolutionWarnings, resolutionErrors =
5037+
let resolutionErrors = ref []
5038+
let resolutionWarnings = ref []
5039+
let errorLogger =
5040+
{ new ErrorLogger("GetLoadClosure") with
5041+
member x.ErrorSinkImpl(e) = resolutionErrors := e :: !resolutionErrors
5042+
member x.WarnSinkImpl(e) = resolutionWarnings := e :: !resolutionWarnings
5043+
member x.ErrorCount = (!resolutionErrors).Length }
50395044

5040-
let references,unresolvedReferences =
50415045
use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger)
5042-
GetAssemblyResolutionInformation(tcConfig)
5043-
let references = references |> List.map (fun ar -> ar.resolvedPath,ar)
5044-
5045-
// Root errors and warnings
5046+
let references,unresolvedReferences = GetAssemblyResolutionInformation(tcConfig)
5047+
let references = references |> List.map (fun ar -> ar.resolvedPath,ar)
5048+
references, unresolvedReferences, resolutionWarnings, resolutionErrors
5049+
5050+
// Root errors and warnings - look at the last item in the closureFiles list
50465051
let rootErrors, rootWarnings =
5047-
match closureDirectives with
5048-
| ClosedSourceFile(_,_,_,errors,warnings,_) :: _ -> errors @ !resolutionErrors, warnings @ !resolutionWarnings
5052+
match List.rev closureFiles with
5053+
| ClosureFile(_,_,_,errors,warnings,_) :: _ -> errors @ !resolutionErrors, warnings @ !resolutionWarnings
50495054
| _ -> [],[] // When no file existed.
50505055

50515056
let isRootRange exn =
@@ -5062,11 +5067,11 @@ module private ScriptPreprocessClosure =
50625067
let rootWarnings = rootWarnings |> List.filter isRootRange
50635068

50645069
let result : LoadClosure =
5065-
{ SourceFiles = List.groupByFirst !sourceFiles
5070+
{ SourceFiles = List.groupByFirst sourceFiles
50665071
References = List.groupByFirst references
50675072
UnresolvedReferences = unresolvedReferences
5068-
Inputs = !sourceInputs
5069-
NoWarns = List.groupByFirst !globalNoWarns
5073+
Inputs = sourceInputs
5074+
NoWarns = List.groupByFirst globalNoWarns
50705075
RootErrors = rootErrors
50715076
RootWarnings = rootWarnings}
50725077

@@ -5086,17 +5091,17 @@ module private ScriptPreprocessClosure =
50865091

50875092
let tcConfig = CreateScriptSourceTcConfig(filename,codeContext,useSimpleResolution,useFsiAuxLib,Some references0,applyCommmandLineArgs)
50885093

5089-
let protoClosure = [SourceFile(filename,range0,source)]
5090-
let finalClosure,tcConfig = FindClosureDirectives(protoClosure,tcConfig,codeContext,lexResourceManager)
5091-
GetLoadClosure(filename,finalClosure,tcConfig,codeContext)
5094+
let closureSources = [ClosureSource(filename,range0,source,true)]
5095+
let closureFiles,tcConfig = FindClosureFiles(closureSources,tcConfig,codeContext,lexResourceManager)
5096+
GetLoadClosure(filename,closureFiles,tcConfig,codeContext)
50925097

50935098
/// Given source filename, find the full load closure
50945099
/// Used from fsi.fs and fsc.fs, for #load and command line
50955100
let GetFullClosureOfScriptFiles(tcConfig:TcConfig,files:(string*range) list,codeContext,_useDefaultScriptingReferences:bool,lexResourceManager:Lexhelp.LexResourceManager) =
5096-
let mainFile = fst (List.head files)
5097-
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
5098-
let finalClosure,tcConfig = FindClosureDirectives(protoClosure,tcConfig,codeContext,lexResourceManager)
5099-
GetLoadClosure(mainFile,finalClosure,tcConfig,codeContext)
5101+
let mainFile = fst (List.last files)
5102+
let closureSources = files |> List.map (fun (filename,m) -> ClosureSourceOfFilename(filename,m,tcConfig.inputCodePage,true)) |> List.concat
5103+
let closureFiles,tcConfig = FindClosureFiles(closureSources,tcConfig,codeContext,lexResourceManager)
5104+
GetLoadClosure(mainFile,closureFiles,tcConfig,codeContext)
51005105

51015106
type LoadClosure with
51025107
// Used from service.fs, when editing a script file

0 commit comments

Comments
 (0)