Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

cherry pick fix for closure filenames from visualfsharp #611

Merged
merged 1 commit into from
Jul 21, 2016
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
179 changes: 92 additions & 87 deletions src/fsharp/CompileOps.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2556,7 +2556,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 @@ -2861,9 +2861,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 @@ -3061,10 +3059,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 @@ -4876,10 +4871,12 @@ type CodeContext =
module private ScriptPreprocessClosure =
open Internal.Utilities.Text.Lexing

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 an input to the closure finding process
type ClosureSource = ClosureSource of filename: string * referenceRange: range * sourceText: string * parseRequired: bool

/// Represents an output of the closure finding process
type ClosureFile = ClosureFile of string * range * ParsedInput option * PhasedError list * PhasedError list * (string * range) list // filename, range, errors, warnings, nowarns

type Observed() =
let seen = System.Collections.Generic.Dictionary<_,bool>()
member ob.SetSeen(check) =
Expand Down Expand Up @@ -4935,7 +4932,7 @@ module private ScriptPreprocessClosure =
tcConfigB.implicitlyResolveAssemblies <- false
TcConfig.Create(tcConfigB,validate=true)

let SourceFileOfFilename(filename,m,inputCodePage:int option) : ClosureDirective list =
let ClosureSourceOfFilename(filename,m,inputCodePage,parseRequired) =
try
let filename = FileSystem.GetFullPathShim(filename)
use stream = FileSystem.FileStreamReadShim filename
Expand All @@ -4944,7 +4941,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)]
[ClosureSource(filename,m,source,parseRequired)]
with e ->
errorRecovery e m
[]
Expand All @@ -4968,84 +4965,92 @@ module private ScriptPreprocessClosure =
let tcConfigB = tcConfig.CloneOfOriginalBuilder
TcConfig.Create(tcConfigB,validate=false),nowarns

let FindClosureDirectives(closureDirectives,tcConfig:TcConfig,codeContext,lexResourceManager:Lexhelp.LexResourceManager) =
let FindClosureFiles(closureSources,tcConfig:TcConfig,codeContext,lexResourceManager:Lexhelp.LexResourceManager) =
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 (ClosureSource(filename,m,source,parseRequired)) =
[ if not (observedSources.HaveSeen(filename)) then
observedSources.SetSeen(filename)
//printfn "visiting %s" filename
if IsScript(filename) || parseRequired 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
if IsScript(subFile) then
for subSource in ClosureSourceOfFilename(subFile,m,tcConfigResult.inputCodePage,false) do
yield! loop subSource
else
yield ClosureFile(subFile, m, None, [], [], [])

//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, [], [], []) ]

closureSources |> 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 @@ -5062,11 +5067,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 @@ -5086,17 +5091,17 @@ module private ScriptPreprocessClosure =

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

let protoClosure = [SourceFile(filename,range0,source)]
let finalClosure,tcConfig = FindClosureDirectives(protoClosure,tcConfig,codeContext,lexResourceManager)
GetLoadClosure(filename,finalClosure,tcConfig,codeContext)
let closureSources = [ClosureSource(filename,range0,source,true)]
let closureFiles,tcConfig = FindClosureFiles(closureSources,tcConfig,codeContext,lexResourceManager)
GetLoadClosure(filename,closureFiles,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 finalClosure,tcConfig = FindClosureDirectives(protoClosure,tcConfig,codeContext,lexResourceManager)
GetLoadClosure(mainFile,finalClosure,tcConfig,codeContext)
let mainFile = fst (List.last files)
let closureSources = files |> List.map (fun (filename,m) -> ClosureSourceOfFilename(filename,m,tcConfig.inputCodePage,true)) |> List.concat
let closureFiles,tcConfig = FindClosureFiles(closureSources,tcConfig,codeContext,lexResourceManager)
GetLoadClosure(mainFile,closureFiles,tcConfig,codeContext)

type LoadClosure with
// Used from service.fs, when editing a script file
Expand Down