Skip to content

Commit 2af6133

Browse files
ncavencave
committed
Added ParseAndCheckFileInProject
1 parent 2058835 commit 2af6133

File tree

3 files changed

+171
-131
lines changed

3 files changed

+171
-131
lines changed

‎fcs/fcs-fable/service_shim.fs‎

Lines changed: 128 additions & 89 deletions
Original file line numberDiff line numberDiff line change
@@ -58,10 +58,10 @@ type InteractiveChecker internal (tcConfig, tcGlobals, tcImports, tcInitialState
5858

5959
static member Create(references: string[], readAllBytes: string -> byte[], defines: string[], optimize: bool) =
6060

61-
let GetSignatureData ((filename:string), ilScopeRef, (ilModule:ILModuleDef option), (bytes:byte[])) =
62-
TastPickle.unpickleObjWithDanglingCcus filename ilScopeRef ilModule TastPickle.unpickleCcuInfo bytes
63-
let GetOptimizationData ((filename:string), ilScopeRef, (ilModule:ILModuleDef option), (bytes:byte[])) =
64-
TastPickle.unpickleObjWithDanglingCcus filename ilScopeRef ilModule Optimizer.u_CcuOptimizationInfo bytes
61+
let GetSignatureData ((fileName:string), ilScopeRef, (ilModule:ILModuleDef option), (bytes:byte[])) =
62+
TastPickle.unpickleObjWithDanglingCcus fileName ilScopeRef ilModule TastPickle.unpickleCcuInfo bytes
63+
let GetOptimizationData ((fileName:string), ilScopeRef, (ilModule:ILModuleDef option), (bytes:byte[])) =
64+
TastPickle.unpickleObjWithDanglingCcus fileName ilScopeRef ilModule Optimizer.u_CcuOptimizationInfo bytes
6565

6666
let tcConfig = TcConfig (optimize, defines = Array.toList defines)
6767
let tcImports = TcImports ()
@@ -233,9 +233,9 @@ type InteractiveChecker internal (tcConfig, tcGlobals, tcImports, tcInitialState
233233
let entityOpt = (Some ccu.Contents, nsname) ||> List.fold findEntity
234234
match entityOpt with
235235
| Some ns ->
236-
match Map.tryFind tname ns.ModuleOrNamespaceType.TypesByMangledName with
237-
| Some _ -> true
238-
| None -> false
236+
match Map.tryFind tname ns.ModuleOrNamespaceType.TypesByMangledName with
237+
| Some _ -> true
238+
| None -> false
239239
| None -> false
240240

241241
// Search for a type
@@ -281,8 +281,9 @@ type InteractiveChecker internal (tcConfig, tcGlobals, tcImports, tcInitialState
281281

282282
// dictionary for de-duplicating module names
283283
let moduleNamesDict = ConcurrentDictionary<string, Set<string>>()
284-
// parse and type check caches
285-
let parseCache = ConcurrentDictionary<string * int * FSharpParsingOptions, FSharpParseFileResults>(HashIdentity.Structural)
284+
// parse cache, keyed on file name and source hash
285+
let parseCache = ConcurrentDictionary<string * int, FSharpParseFileResults>(HashIdentity.Structural)
286+
// type check cache, keyed on file name
286287
let checkCache = ConcurrentDictionary<string, TcResult * TcState>(HashIdentity.Structural)
287288

288289
InteractiveChecker (tcConfig, tcGlobals, tcImports, tcInitialState, ctok, reactorOps, moduleNamesDict, parseCache, checkCache)
@@ -294,141 +295,179 @@ type InteractiveChecker internal (tcConfig, tcGlobals, tcImports, tcInitialState
294295
let access = tcState.TcEnvFromImpls.AccessRights
295296
let dependencyFiles = parseResults |> Seq.map (fun x -> x.DependencyFiles) |> Array.concat
296297
let details = (tcGlobals, tcImports, tcState.Ccu, tcState.CcuSig, symbolUses, topAttrsOpt, assemblyDataOpt, assemblyRef, access, tcImplFilesOpt, dependencyFiles)
297-
FSharpCheckProjectResults (projectFileName, Some tcConfig, true, errors, Some details)
298+
let keepAssemblyContents = true
299+
FSharpCheckProjectResults (projectFileName, Some tcConfig, keepAssemblyContents, errors, Some details)
298300

299301
member private x.ClearStaleCache (fileName: string, parsingOptions: FSharpParsingOptions) =
300302
let fileIndex = parsingOptions.SourceFiles |> Array.findIndex ((=) fileName)
301-
let _, staleCheckKeys = parsingOptions.SourceFiles |> Array.splitAt fileIndex
302-
let staleParseKeys = parseCache.Keys |> Seq.filter (fun (fname,_,_) -> fname = fileName) |> Seq.toArray
303+
let staleParseKeys = parseCache.Keys |> Seq.filter (fun (n,_) -> n = fileName) |> Seq.toArray
304+
let staleCheckKeys = parsingOptions.SourceFiles |> Array.skip fileIndex
303305
staleParseKeys |> Array.iter (fun key -> parseCache.Remove(key) |> ignore)
304306
staleCheckKeys |> Array.iter (fun key -> checkCache.Remove(key) |> ignore)
305307

306-
member private x.ParseScript (fileName: string, source: string, parsingOptions: FSharpParsingOptions) =
307-
let parseCacheKey = fileName, hash source, parsingOptions
308+
member private x.ParseFile (fileName: string, source: string, parsingOptions: FSharpParsingOptions) =
309+
let parseCacheKey = fileName, hash source
308310
parseCache.GetOrAdd(parseCacheKey, fun _ ->
309311
x.ClearStaleCache(fileName, parsingOptions)
310312
let parseErrors, parseTreeOpt, anyErrors = Parser.parseFile (source, fileName, parsingOptions, userOpName)
311313
let parseTreeOpt = parseTreeOpt |> Option.map (DeduplicateParsedInputModuleName moduleNamesDict)
312314
let dependencyFiles = [||] // interactions have no dependencies
313315
FSharpParseFileResults (parseErrors, parseTreeOpt, anyErrors, dependencyFiles) )
314316

317+
// member private x.CheckFile (source: string, projectFileName: string, parseResults: FSharpParseFileResults, tcState: TcState) =
318+
// let fileName = parseResults.FileName
319+
// let loadClosure = None
320+
// let backgroundErrors = [||]
321+
// let checkAlive () = true
322+
// let textSnapshotInfo = None
323+
// let tcResults = Parser.CheckOneFile(
324+
// parseResults, source, fileName, projectFileName, tcConfig, tcGlobals, tcImports, tcState,
325+
// loadClosure, backgroundErrors, reactorOps, checkAlive, textSnapshotInfo, userOpName)
326+
// match tcResults with
327+
// | tcErrors, Parser.TypeCheckAborted.No scope ->
328+
// let errors = Array.append parseResults.Errors tcErrors
329+
// let checkResults = FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, reactorOps, true)
330+
// FSharpCheckFileAnswer.Succeeded checkResults
331+
// | _ ->
332+
// FSharpCheckFileAnswer.Aborted
333+
334+
member private x.CheckFile (projectFileName: string, parseResults: FSharpParseFileResults, tcState: TcState) =
335+
match parseResults.ParseTree with
336+
| Some input ->
337+
let capturingErrorLogger = CompilationErrorLogger("TypeCheckFile", tcConfig.errorSeverityOptions)
338+
let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput(input), capturingErrorLogger)
339+
use _errorScope = new CompilationGlobalsScope (errorLogger, BuildPhase.TypeCheck)
340+
341+
let sink = TcResultsSinkImpl(tcGlobals)
342+
let tcSink = TcResultsSink.WithSink sink
343+
let checkForErrors () = parseResults.ParseHadErrors || errorLogger.ErrorCount > 0
344+
let prefixPathOpt = None
345+
let (tcEnvAtEnd, topAttrs, implFile, ccuSigForFile), tcState =
346+
TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input)
347+
|> Eventually.force ctok
348+
349+
let fileName = parseResults.FileName
350+
checkCache.[fileName] <- ((tcEnvAtEnd, topAttrs, implFile, ccuSigForFile), tcState)
351+
352+
let loadClosure = None
353+
let checkAlive () = true
354+
let textSnapshotInfo = None
355+
let keepAssemblyContents = true
356+
357+
let tcErrors = ErrorHelpers.CreateErrorInfos (tcConfig.errorSeverityOptions, false, fileName, (capturingErrorLogger.GetErrors()))
358+
let errors = Array.append parseResults.Errors tcErrors
359+
360+
let scope = TypeCheckInfo (tcConfig, tcGlobals, ccuSigForFile, tcState.Ccu, tcImports, tcEnvAtEnd.AccessRights,
361+
projectFileName, fileName, sink.GetResolutions(), sink.GetSymbolUses(), tcEnvAtEnd.NameEnv,
362+
loadClosure, reactorOps, checkAlive, textSnapshotInfo, implFile, sink.GetOpenDeclarations())
363+
FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, reactorOps, keepAssemblyContents)
364+
|> Some
365+
| None ->
366+
None
367+
315368
member private x.TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) =
316-
// tcEnvAtEndOfLastFile is the environment when incrementally adding definitions
317369
let fileNameOf = function
318370
| ParsedInput.SigFile (ParsedSigFileInput(fileName,_,_,_,_)) -> fileName
319371
| ParsedInput.ImplFile (ParsedImplFileInput(fileName,_,_,_,_,_,_)) -> fileName
320372
let cachedTypeCheck tcState (input: ParsedInput) =
321373
let checkCacheKey = fileNameOf input
322374
checkCache.GetOrAdd(checkCacheKey, fun _ ->
323375
TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState input)
324-
let results, tcState = (tcState, inputs) ||> List.mapFold cachedTypeCheck
325-
let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _), tcState = TypeCheckMultipleInputsFinish(results, tcState)
376+
let results, tcState = (tcState, inputs) ||> List.mapFold cachedTypeCheck
377+
let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _ccuSigsForFiles), tcState =
378+
TypeCheckMultipleInputsFinish(results, tcState)
326379
let tcState, declaredImpls = TypeCheckClosedInputSetFinish (implFiles, tcState)
327380
tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile
328381

329382
member x.ClearCache () =
330383
parseCache.Clear()
331384
checkCache.Clear()
332385

333-
member x.ParseAndCheckScript (projectFileName, filename: string, source: string) =
334-
let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, [| filename |], true)
335-
let parseResults = x.ParseScript (filename, source, parsingOptions)
386+
member x.ParseAndCheckScript (projectFileName: string, fileName: string, source: string) =
387+
let fileNames = [| fileName |]
388+
let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, fileNames, false)
389+
let parseResults = x.ParseFile (fileName, source, parsingOptions)
336390
let loadClosure = None
337391
let backgroundErrors = [||]
338-
let checkAlive = fun () -> true
392+
let checkAlive () = true
339393
let textSnapshotInfo = None
340394
let tcState = tcInitialState
341395
let tcResults = Parser.CheckOneFile(
342-
parseResults, source, filename, projectFileName, tcConfig, tcGlobals, tcImports, tcState,
396+
parseResults, source, fileName, projectFileName, tcConfig, tcGlobals, tcImports, tcState,
343397
loadClosure, backgroundErrors, reactorOps, checkAlive, textSnapshotInfo, userOpName)
344398
match tcResults with
345399
| tcErrors, Parser.TypeCheckAborted.No scope ->
346400
let errors = Array.append parseResults.Errors tcErrors
347401
let tcImplFilesOpt = match scope.ImplementationFile with Some x -> Some [x] | None -> None
348-
let typeCheckResults = FSharpCheckFileResults (filename, errors, Some scope, parseResults.DependencyFiles, None, reactorOps, true)
402+
let typeCheckResults = FSharpCheckFileResults (fileName, errors, Some scope, parseResults.DependencyFiles, None, reactorOps, true)
349403
let symbolUses = [scope.ScopeSymbolUses]
350404
let projectResults = x.MakeProjectResults (projectFileName, [|parseResults|], tcState, errors, symbolUses, None, tcImplFilesOpt)
351405
parseResults, typeCheckResults, projectResults
352406
| _ ->
353407
failwith "unexpected aborted"
354408

355-
member x.ParseAndCheckProject (projectFileName, fileNames: string[], sources: string[]) =
356-
use errorScope = new ErrorScope()
357-
409+
member x.ParseAndCheckProject (projectFileName: string, fileNames: string[], sources: string[]) =
358410
// parse files
359-
let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, fileNames, true)
360-
let parseScript (filename, source) = x.ParseScript(filename, source, parsingOptions)
361-
let parseResults = Array.zip fileNames sources |> Array.map parseScript
411+
let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, fileNames, false)
412+
let parseFile (fileName, source) = x.ParseFile(fileName, source, parsingOptions)
413+
let parseResults = Array.zip fileNames sources |> Array.map parseFile
362414
let parseHadErrors = parseResults |> Array.exists (fun p -> p.ParseHadErrors)
363-
let inputs = parseResults |> Array.choose (fun p -> p.ParseTree) |> Array.toList
415+
let parsedInputs = parseResults |> Array.choose (fun p -> p.ParseTree) |> Array.toList
364416

365417
// type check files
366-
let checkForErrors() = parseHadErrors
418+
use errorScope = new ErrorScope()
419+
let hasTypedErrors () = errorScope.Diagnostics |> List.exists (fun e -> e.Severity = FSharpErrorSeverity.Error)
420+
let checkForErrors () = parseHadErrors || hasTypedErrors ()
367421
let prefixPathOpt = None
368422
let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd =
369-
x.TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcInitialState, inputs)
423+
x.TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcInitialState, parsedInputs)
370424

371425
// make project results
372426
let parseErrors = parseResults |> Array.collect (fun p -> p.Errors)
373-
let tcErrors = errorScope.Diagnostics |> List.toArray
374-
let errors = Array.append parseErrors tcErrors
427+
let typedErrors = errorScope.Diagnostics |> List.toArray
428+
let errors = Array.append parseErrors typedErrors
375429
let symbolUses = [] //TODO:
376430
let projectResults = x.MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles)
377431

378432
projectResults
379433

380-
// // TODO:
381-
// member __.GetParseResults (fileName) =
382-
// parseResults, typeCheckResults
383-
384-
// // this version is too memory-inefficient
385-
// member x.ParseAndCheckProjectFiles (projectFileName, fileNames: string[], sources: string[]) =
386-
// use errorScope = new ErrorScope()
387-
// let sink = TcResultsSinkImpl(tcGlobals)
388-
389-
// let typeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcSink tcState input =
390-
// //// 'use' ensures that the warning handler is restored at the end
391-
// //use unwindEL = PushErrorLoggerPhaseUntilUnwind(fun oldLogger ->
392-
// // GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput(input), oldLogger) )
393-
// //use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck
394-
// TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input)
395-
// |> Eventually.force ctok
396-
397-
// let makeTcResult (tcState: TcState) (parseRes: FSharpParseFileResults, (tcEnvAtEnd: TcEnv, _topAttrs, implFile, ccuSigForFile)) =
398-
// let filename = parseRes.FileName
399-
// let loadClosure = None
400-
// let checkAlive = fun () -> true
401-
// let textSnapshotInfo = None
402-
// let tcErrors = errorScope.Diagnostics |> List.filter (fun e -> e.FileName = filename) |> List.toArray
403-
// let errors = Array.append parseRes.Errors tcErrors
404-
// let scope = TypeCheckInfo(tcConfig, tcGlobals, ccuSigForFile, tcState.Ccu, tcImports, tcEnvAtEnd.AccessRights,
405-
// projectFileName, filename, sink.GetResolutions(), sink.GetSymbolUses(), tcEnvAtEnd.NameEnv,
406-
// loadClosure, reactorOps, checkAlive, textSnapshotInfo, implFile, sink.GetOpenDeclarations())
407-
// FSharpCheckFileResults (filename, errors, Some scope, parseRes.DependencyFiles, None, reactorOps, true)
408-
409-
// // parse files
410-
// let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, fileNames, true)
411-
// let parseScript (filename, source) = x.ParseScript(filename, source, parsingOptions)
412-
// let parseResults = Array.zip fileNames sources |> Array.map parseScript
413-
// let parseHadErrors = parseResults |> Array.exists (fun p -> p.ParseHadErrors)
414-
// let inputs = parseResults |> Array.choose (fun p -> p.ParseTree) |> Array.toList
415-
416-
// // type check files
417-
// let checkForErrors() = parseHadErrors
418-
// let prefixPathOpt = None
419-
// let tcSink = TcResultsSink.WithSink sink
420-
// let tcOneInput = typeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcSink
421-
// let tcResults, tcState = (tcInitialState, inputs) ||> List.mapFold tcOneInput
422-
// let (_tcEnvAtEnd, topAttrs, implFiles, _ccuSigsForFiles), tcState = TypeCheckMultipleInputsFinish(tcResults, tcState)
423-
// let tcState, tcImplFiles = TypeCheckClosedInputSetFinish (implFiles, tcState)
424-
425-
// let typeCheckResults = tcResults |> List.toArray |> Array.zip parseResults |> Array.map (makeTcResult tcState)
426-
427-
// // make project results
428-
// let parseErrors = parseResults |> Array.collect (fun p -> p.Errors)
429-
// let tcErrors = errorScope.Diagnostics |> List.toArray
430-
// let errors = Array.append parseErrors tcErrors
431-
// let symbolUses = [sink.GetSymbolUses()]
432-
// let projectResults = x.MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles)
433-
434-
// parseResults, typeCheckResults, projectResults
434+
member x.ParseAndCheckFileInProject (fileName: string, projectFileName: string, fileNames: string[], sources: string[]) =
435+
// get files before file
436+
let fileIndex = fileNames |> Array.findIndex ((=) fileName)
437+
let fileNamesBeforeFile = fileNames |> Array.take fileIndex
438+
let sourcesBeforeFile = sources |> Array.take fileIndex
439+
440+
// parse files before file
441+
let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, fileNames, false)
442+
let parseFile (fileName, source) = x.ParseFile(fileName, source, parsingOptions)
443+
let parseResults = Array.zip fileNamesBeforeFile sourcesBeforeFile |> Array.map parseFile
444+
let parseHadErrors = parseResults |> Array.exists (fun p -> p.ParseHadErrors)
445+
let parsedInputs = parseResults |> Array.choose (fun p -> p.ParseTree) |> Array.toList
446+
447+
// type check files before file
448+
use errorScope = new ErrorScope()
449+
let hasTypedErrors () = errorScope.Diagnostics |> List.exists (fun e -> e.Severity = FSharpErrorSeverity.Error)
450+
let checkForErrors () = parseHadErrors || hasTypedErrors ()
451+
let prefixPathOpt = None
452+
let tcState, topAttrs, tcImplFiles, _tcEnvAtEnd =
453+
x.TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcInitialState, parsedInputs)
454+
455+
// parse and type check file
456+
let parseFileResults = parseFile (fileName, sources.[fileIndex])
457+
let checkFileResults = x.CheckFile (projectFileName, parseFileResults, tcState)
458+
let (_tcEnvAtEndFile, topAttrsFile, implFile, _ccuSigForFile), tcState = checkCache.[fileName]
459+
460+
// collect errors
461+
let parseErrorsBefore = parseResults |> Array.collect (fun p -> p.Errors)
462+
let typedErrorsBefore = errorScope.Diagnostics |> List.toArray
463+
let newErrors = match checkFileResults with | Some res -> res.Errors | None -> [||]
464+
let errors = [| yield! parseErrorsBefore; yield! typedErrorsBefore; yield! newErrors |]
465+
466+
// make partial project results
467+
let parseResults = Array.append parseResults [| parseFileResults |]
468+
let tcImplFiles = List.append tcImplFiles (Option.toList implFile)
469+
let topAttrs = CombineTopAttrs topAttrsFile topAttrs
470+
let symbolUses = [] //TODO:
471+
let projectResults = x.MakeProjectResults (projectFileName, parseResults, tcState, errors, symbolUses, Some topAttrs, Some tcImplFiles)
472+
473+
parseFileResults, checkFileResults, projectResults

0 commit comments

Comments
 (0)