Skip to content

Commit

Permalink
fix closure computation
Browse files Browse the repository at this point in the history
  • Loading branch information
@dsyme
dsyme committed Jul 20, 2016
1 parent 0d92803 commit 5fe0619
Showing 1 changed file with 87 additions and 80 deletions.
167 changes: 87 additions & 80 deletions src/fsharp/CompileOps.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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:
Expand Down Expand Up @@ -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)

Expand Down Expand Up @@ -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>()
Expand Down Expand Up @@ -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
[]
Expand Down Expand Up @@ -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 =
Expand All @@ -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}

Expand All @@ -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)

Expand Down

0 comments on commit 5fe0619

Please sign in to comment.