Skip to content

Commit 59893f8

Browse files
committed
Merge pull request #400 from dsyme/vf-align-1
More alignments with Microsoft/visualfsharp
2 parents cea594e + c7b6051 commit 59893f8

File tree

2 files changed

+98
-125
lines changed

2 files changed

+98
-125
lines changed

src/fsharp/FSharp.Compiler.Service.Browser/FSharp.Compiler.Service.Browser.fsproj

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,7 @@
4646
<DefineConstants>$(DefineConstants);FX_ATLEAST_SILVERLIGHT_50</DefineConstants>
4747
<DefineConstants>$(DefineConstants);NO_PDB_READER</DefineConstants>
4848
<DefineConstants>$(DefineConstants);NO_PDB_WRITER</DefineConstants>
49+
<DefineConstants>$(DefineConstants);NO_NATIVE_RESOURCE_WRITER</DefineConstants>
4950
<DefineConstants>$(DefineConstants);NO_INLINE_IL_PARSER</DefineConstants>
5051
<DefineConstants>$(DefineConstants);NO_STRONG_NAMES</DefineConstants>
5152
<DefineConstants>$(DefineConstants);FX_REFLECTION_EMITS_CUSTOM_ATTRIBUTES_USING_BUILDER</DefineConstants>

src/fsharp/fsc.fs

Lines changed: 97 additions & 125 deletions
Original file line numberDiff line numberDiff line change
@@ -155,7 +155,7 @@ type DelayAndForwardErrorLogger(exiter: Exiter, errorLoggerProvider: ErrorLogger
155155
delayed.Clear()
156156

157157
member x.ForwardDelayedErrorsAndWarnings(tcConfigB:TcConfigBuilder) =
158-
let errorLogger = errorLoggerProvider.CreateErrorLoggerThatQuitsAfterMaxErrors(tcConfigB, exiter)
158+
let errorLogger = errorLoggerProvider.CreateErrorLoggerThatQuitsAfterMaxErrors(tcConfigB, exiter)
159159
x.ForwardDelayedErrorsAndWarnings(errorLogger)
160160

161161
member x.FullErrorCount = errors
@@ -378,76 +378,77 @@ let GetTcImportsFromCommandLine
378378
if not tcConfigB.continueAfterParseFailure then
379379
AbortOnError(errorLogger, tcConfig, exiter)
380380

381-
ReportTime tcConfig "Import mscorlib"
381+
begin
382+
ReportTime tcConfig "Import mscorlib"
383+
384+
begin
385+
ReportTime tcConfig "Import mscorlib and FSharp.Core.dll"
386+
let foundationalTcConfigP = TcConfigProvider.Constant(tcConfig)
387+
let sysRes,otherRes,knownUnresolved = TcAssemblyResolutions.SplitNonFoundationalResolutions(tcConfig)
388+
let tcGlobals,frameworkTcImports = TcImports.BuildFrameworkTcImports (foundationalTcConfigP, sysRes, otherRes)
389+
390+
// register framework tcImports to be disposed in future
391+
disposables.Register frameworkTcImports
392+
393+
// step - parse sourceFiles
394+
ReportTime tcConfig "Parse inputs"
395+
use unwindParsePhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parse)
396+
let inputs =
397+
try
398+
sourceFiles
399+
|> tcConfig.ComputeCanContainEntryPoint
400+
|> List.zip sourceFiles
401+
// PERF: consider making this parallel, once uses of global state relevant to parsing are cleaned up
402+
|> List.choose (fun (filename:string,isLastCompiland:bool) ->
403+
let pathOfMetaCommandSource = Path.GetDirectoryName(filename)
404+
match ParseOneInputFile(tcConfig,lexResourceManager,["COMPILED"],filename,isLastCompiland,errorLogger,(*retryLocked*)false) with
405+
| Some(input)->Some(input,pathOfMetaCommandSource)
406+
| None -> None
407+
)
408+
with e ->
409+
errorRecoveryNoRange e
410+
SqmLoggerWithConfig tcConfig errorLogger.ErrorNumbers errorLogger.WarningNumbers
411+
exiter.Exit 1
382412

383-
ReportTime tcConfig "Import mscorlib and FSharp.Core.dll"
384-
ReportTime tcConfig "Import system references"
385-
let foundationalTcConfigP = TcConfigProvider.Constant(tcConfig)
386-
let sysRes,otherRes,knownUnresolved = TcAssemblyResolutions.SplitNonFoundationalResolutions(tcConfig)
387-
let tcGlobals,frameworkTcImports = TcImports.BuildFrameworkTcImports (foundationalTcConfigP, sysRes, otherRes)
413+
if tcConfig.parseOnly then exiter.Exit 0
414+
if not tcConfig.continueAfterParseFailure then
415+
AbortOnError(errorLogger, tcConfig, exiter)
388416

389-
// register framework tcImports to be disposed in future
390-
disposables.Register frameworkTcImports
391-
392-
// step - parse sourceFiles
393-
ReportTime tcConfig "Parse inputs"
394-
use unwindParsePhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parse)
395-
let inputs =
396-
try
397-
sourceFiles
398-
|> tcConfig.ComputeCanContainEntryPoint
399-
|> List.zip sourceFiles
400-
// PERF: consider making this parallel, once uses of global state relevant to parsing are cleaned up
401-
|> List.choose (fun (filename:string,isLastCompiland:bool) ->
402-
let pathOfMetaCommandSource = Path.GetDirectoryName(filename)
403-
match ParseOneInputFile(tcConfig,lexResourceManager,["COMPILED"],filename,isLastCompiland,errorLogger,(*retryLocked*)false) with
404-
| Some(input)->Some(input,pathOfMetaCommandSource)
405-
| None -> None
406-
)
407-
with e ->
408-
errorRecoveryNoRange e
409-
#if SQM_SUPPORT
410-
SqmLoggerWithConfig tcConfig errorLogger.ErrorOrWarningNumbers
411-
#endif
412-
exiter.Exit 1
417+
if tcConfig.printAst then
418+
inputs |> List.iter (fun (input,_filename) -> printf "AST:\n"; printfn "%+A" input; printf "\n")
413419

414-
if tcConfig.parseOnly then exiter.Exit 0
415-
if not tcConfig.continueAfterParseFailure then
416-
AbortOnError(errorLogger, tcConfig, exiter)
420+
let tcConfig = (tcConfig,inputs) ||> List.fold ApplyMetaCommandsFromInputToTcConfig
421+
let tcConfigP = TcConfigProvider.Constant(tcConfig)
417422

418-
if tcConfig.printAst then
419-
inputs |> List.iter (fun (input,_filename) -> printf "AST:\n"; printfn "%+A" input; printf "\n")
423+
ReportTime tcConfig "Import non-system references"
424+
let tcGlobals,tcImports =
425+
let tcImports = TcImports.BuildNonFrameworkTcImports(displayPSTypeProviderSecurityDialogBlockingUI,tcConfigP,tcGlobals,frameworkTcImports,otherRes,knownUnresolved)
426+
tcGlobals,tcImports
420427

421-
let tcConfig = (tcConfig,inputs) ||> List.fold ApplyMetaCommandsFromInputToTcConfig
422-
let tcConfigP = TcConfigProvider.Constant(tcConfig)
428+
// register tcImports to be disposed in future
429+
disposables.Register tcImports
423430

424-
ReportTime tcConfig "Import non-system references"
425-
let tcGlobals,tcImports =
426-
let tcImports = TcImports.BuildNonFrameworkTcImports(displayPSTypeProviderSecurityDialogBlockingUI,tcConfigP,tcGlobals,frameworkTcImports,otherRes,knownUnresolved)
427-
tcGlobals,tcImports
431+
if not tcConfig.continueAfterParseFailure then
432+
AbortOnError(errorLogger, tcConfig, exiter)
428433

429-
// register tcImports to be disposed in future
430-
disposables.Register tcImports
434+
if tcConfig.importAllReferencesOnly then exiter.Exit 0
431435

432-
if not tcConfig.continueAfterParseFailure then
433-
AbortOnError(errorLogger, tcConfig, exiter)
434-
435-
if tcConfig.importAllReferencesOnly then exiter.Exit 0
436-
437-
ReportTime tcConfig "Typecheck"
438-
use unwindParsePhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.TypeCheck)
439-
let tcEnv0 = GetInitialTcEnv (Some assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals)
436+
ReportTime tcConfig "Typecheck"
437+
use unwindParsePhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.TypeCheck)
438+
let tcEnv0 = GetInitialTcEnv (Some assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals)
440439

441-
// typecheck
442-
let inputs = inputs |> List.map fst
443-
let tcState,topAttrs,typedAssembly,_tcEnvAtEnd =
444-
TypeCheck(tcConfig,tcImports,tcGlobals,errorLogger,assemblyName,NiceNameGenerator(),tcEnv0,inputs,exiter)
440+
// typecheck
441+
let inputs = inputs |> List.map fst
442+
let tcState,topAttrs,typedAssembly,_tcEnvAtEnd =
443+
TypeCheck(tcConfig,tcImports,tcGlobals,errorLogger,assemblyName,NiceNameGenerator(),tcEnv0,inputs,exiter)
445444

446-
let generatedCcu = tcState.Ccu
447-
AbortOnError(errorLogger, tcConfig, exiter)
448-
ReportTime tcConfig "Typechecked"
445+
let generatedCcu = tcState.Ccu
446+
AbortOnError(errorLogger, tcConfig, exiter)
447+
ReportTime tcConfig "Typechecked"
449448

450-
tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig,outfile,pdbfile,assemblyName,errorLogger
449+
tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig,outfile,pdbfile,assemblyName,errorLogger
450+
end
451+
end
451452

452453
// only called from the project system, as a way to run the front end of the compiler far enough to determine if we need to pop up the dialog (and do so if necessary)
453454
let ProcessCommandLineArgsAndImportAssemblies
@@ -641,14 +642,9 @@ module XmlDocWriter =
641642
// cmd line - option state
642643
//----------------------------------------------------------------------------
643644

644-
#if SILVERLIGHT
645-
let defaultFSharpBinariesDir = "."
646-
#else
647645
let defaultFSharpBinariesDir =
648646
let exeName = Path.Combine(AppDomain.CurrentDomain.BaseDirectory, AppDomain.CurrentDomain.FriendlyName)
649647
Filename.directoryName exeName
650-
#endif
651-
652648

653649
let outpath outfile extn =
654650
String.concat "." (["out"; Filename.chopExtension (Filename.fileNameOfPath outfile); extn])
@@ -1183,9 +1179,6 @@ module MainModuleBuilder =
11831179
error(Error(FSComp.SR.fscTwoResourceManifests(),rangeCmdArgs));
11841180

11851181
let win32Manifest =
1186-
#if SILVERLIGHT
1187-
""
1188-
#else
11891182
// use custom manifest if provided
11901183
if not(tcConfig.win32manifest = "") then
11911184
tcConfig.win32manifest
@@ -1195,10 +1188,9 @@ module MainModuleBuilder =
11951188
// otherwise, include the default manifest
11961189
else
11971190
System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory() + @"default.win32manifest"
1198-
#endif
11991191

12001192
let nativeResources =
1201-
#if SILVERLIGHT
1193+
#if NO_NATIVE_RESOURCE_WRITER
12021194
[]
12031195
#else
12041196
[ for av in assemblyVersionResources do
@@ -1338,17 +1330,6 @@ module StaticLinker =
13381330
ilxMainModule, rewriteExternalRefsToLocalRefs
13391331

13401332

1341-
#if DEBUG
1342-
let PrintModule outfile x =
1343-
#if SILVERLIGHT
1344-
()
1345-
#else
1346-
use os = File.CreateText(outfile) :> TextWriter
1347-
ILAsciiWriter.output_module os x
1348-
#endif
1349-
#endif
1350-
1351-
13521333
// LEGACY: This is only used when compiling an FSharp.Core for .NET 2.0 (FSharp.Core 2.3.0.0). We no longer
13531334
// build new FSharp.Core for that configuration.
13541335
//
@@ -1719,7 +1700,7 @@ let GetSigner(signingInfo) =
17191700
error(Error(FSComp.SR.fscKeyFileCouldNotBeOpened(s),rangeCmdArgs))
17201701

17211702
module FileWriter =
1722-
let EmitIL (tcConfig:TcConfig, ilGlobals, _errorLogger:ErrorLogger, outfile, pdbfile, ilxMainModule, signingInfo:SigningInfo, exiter:Exiter) =
1703+
let EmitIL (tcConfig:TcConfig, ilGlobals, errorLogger:ErrorLogger, outfile, pdbfile, ilxMainModule, signingInfo:SigningInfo, exiter:Exiter) =
17231704
try
17241705
if !progress then dprintn "Writing assembly...";
17251706
try
@@ -1738,7 +1719,7 @@ module FileWriter =
17381719
error(Error(FSComp.SR.fscProblemWritingBinary(outfile,msg), rangeCmdArgs))
17391720
with e ->
17401721
errorRecoveryNoRange e
1741-
SqmLoggerWithConfig tcConfig _errorLogger.ErrorNumbers _errorLogger.WarningNumbers
1722+
SqmLoggerWithConfig tcConfig errorLogger.ErrorNumbers errorLogger.WarningNumbers
17421723
exiter.Exit 1
17431724

17441725

@@ -1789,9 +1770,10 @@ let ValidateKeySigningAttributes (tcConfig : TcConfig, tcGlobals, topAttrs) =
17891770

17901771
/// Checks if specified file name is absolute path. If yes - returns the name as is, otherwise makes full path using tcConfig.implicitIncludeDir as base.
17911772
let expandFileNameIfNeeded (tcConfig : TcConfig) name =
1792-
if System.IO.Path.IsPathRooted name then name
1773+
if FileSystem.IsPathRootedShim name then
1774+
name
17931775
else
1794-
System.IO.Path.Combine(tcConfig.implicitIncludeDir, name)
1776+
Path.Combine(tcConfig.implicitIncludeDir, name)
17951777

17961778
//----------------------------------------------------------------------------
17971779
// main - split up to make sure that we can GC the
@@ -1809,50 +1791,45 @@ let main0(argv,bannerAlreadyPrinted,openBinariesInMemory:bool,exiter:Exiter, err
18091791
#if LIMITED_CONSOLE
18101792
None
18111793
#else
1812-
if (System.Console.OutputEncoding.CodePage <> 65001) &&
1813-
(System.Console.OutputEncoding.CodePage <> System.Threading.Thread.CurrentThread.CurrentUICulture.TextInfo.OEMCodePage) &&
1814-
(System.Console.OutputEncoding.CodePage <> System.Threading.Thread.CurrentThread.CurrentUICulture.TextInfo.ANSICodePage) then
1815-
System.Threading.Thread.CurrentThread.CurrentUICulture <- new System.Globalization.CultureInfo("en-US")
1794+
if (Console.OutputEncoding.CodePage <> 65001) &&
1795+
(Console.OutputEncoding.CodePage <> Thread.CurrentThread.CurrentUICulture.TextInfo.OEMCodePage) &&
1796+
(Console.OutputEncoding.CodePage <> Thread.CurrentThread.CurrentUICulture.TextInfo.ANSICodePage) then
1797+
Thread.CurrentThread.CurrentUICulture <- new CultureInfo("en-US")
18161798
Some(1033)
18171799
else
18181800
None
18191801
#endif
18201802

18211803
let tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig,outfile,pdbfile,assemblyName,errorLogger =
1822-
#if SILVERLIGHT
1823-
let curDir = "."
1824-
#else
1825-
let curDir = Directory.GetCurrentDirectory()
1826-
#endif
1827-
GetTcImportsFromCommandLine(None, argv, defaultFSharpBinariesDir, curDir, lcidFromCodePage, (fun tcConfigB ->
1804+
GetTcImportsFromCommandLine
1805+
(None, argv, defaultFSharpBinariesDir, Directory.GetCurrentDirectory(),
1806+
lcidFromCodePage,
1807+
// setProcessThreadLocals
1808+
(fun tcConfigB ->
18281809
#if LIMITED_CONSOLE
1829-
()
1810+
()
18301811
#else
1831-
tcConfigB.openBinariesInMemory <- openBinariesInMemory
1832-
match tcConfigB.lcid with
1833-
| Some(n) -> System.Threading.Thread.CurrentThread.CurrentUICulture <- new System.Globalization.CultureInfo(n)
1834-
| None -> ()
1812+
tcConfigB.openBinariesInMemory <- openBinariesInMemory
1813+
match tcConfigB.lcid with
1814+
| Some(n) -> Thread.CurrentThread.CurrentUICulture <- new CultureInfo(n)
1815+
| None -> ()
18351816

1836-
if tcConfigB.utf8output then
1837-
let prev = System.Console.OutputEncoding
1838-
System.Console.OutputEncoding <- Encoding.UTF8
1839-
System.AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> System.Console.OutputEncoding <- prev)
1817+
if tcConfigB.utf8output then
1818+
let prev = Console.OutputEncoding
1819+
Console.OutputEncoding <- Encoding.UTF8
1820+
System.AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> Console.OutputEncoding <- prev)
18401821
#endif
1841-
), (fun tcConfigB ->
1842-
// display the banner text, if necessary
1843-
if not bannerAlreadyPrinted then
1844-
DisplayBannerText tcConfigB
1845-
),
1846-
false, // optimizeForMemory - fsc.exe can use as much memory as it likes to try to compile as fast as possible
1847-
exiter,
1848-
errorLoggerProvider,
1849-
disposables
1850-
1851-
)
1822+
), (fun tcConfigB ->
1823+
// display the banner text, if necessary
1824+
if not bannerAlreadyPrinted then
1825+
DisplayBannerText tcConfigB),
1826+
false, // optimizeForMemory - fsc.exe can use as much memory as it likes to try to compile as fast as possible
1827+
exiter,
1828+
errorLoggerProvider,
1829+
disposables)
18521830

18531831
tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig,outfile,pdbfile,assemblyName,errorLogger, exiter
18541832

1855-
// TcGlobals * TcImports * TcImports * CcuThunk * TypedAssembly * TopAttribs * TcConfig * string * string * string* ErrorLogger* Exiter
18561833
let main1(tcGlobals,tcImports : TcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig : TcConfig, outfile,pdbfile,assemblyName,errorLogger, exiter : Exiter) =
18571834

18581835
if tcConfig.typeCheckOnly then exiter.Exit 0
@@ -1972,7 +1949,7 @@ let main1OfAst (openBinariesInMemory, assemblyName, target, outfile, pdbFile, dl
19721949
Args(tcConfig,tcImports,frameworkTcImports,tcGlobals,errorLogger,generatedCcu,outfile,typedAssembly,topAttrs,pdbFile,assemblyName,assemVerFromAttrib,signingInfo,exiter)
19731950

19741951

1975-
let main2(Args(tcConfig, tcImports, frameworkTcImports: TcImports, tcGlobals, errorLogger, generatedCcu: CcuThunk, outfile, typedAssembly, topAttrs, pdbfile, assemblyName, assemVerFromAttrib, signingInfo, exiter: Exiter)) =
1952+
let main2(Args(tcConfig, tcImports, frameworkTcImports: TcImports, tcGlobals, errorLogger: ErrorLogger, generatedCcu: CcuThunk, outfile, typedAssembly, topAttrs, pdbfile, assemblyName, assemVerFromAttrib, signingInfo, exiter: Exiter)) =
19761953

19771954
ReportTime tcConfig ("Encode Interface Data");
19781955
let exportRemapping = MakeExportRemapping generatedCcu generatedCcu.Contents
@@ -1982,9 +1959,7 @@ let main2(Args(tcConfig, tcImports, frameworkTcImports: TcImports, tcGlobals, er
19821959
EncodeInterfaceData(tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile)
19831960
with e ->
19841961
errorRecoveryNoRange e
1985-
#if SQM_SUPPORT
1986-
SqmLoggerWithConfig tcConfig _errorLogger.ErrorOrWarningNumbers
1987-
#endif
1962+
SqmLoggerWithConfig tcConfig errorLogger.ErrorNumbers errorLogger.WarningNumbers
19881963
exiter.Exit 1
19891964

19901965
if !progress && tcConfig.optSettings.jitOptUser = Some false then
@@ -2104,16 +2079,12 @@ let main4 dynamicAssemblyCreator (Args(tcConfig, errorLogger:ErrorLogger, ilGlob
21042079
| None -> FileWriter.EmitIL (tcConfig,ilGlobals,errorLogger,outfile,pdbfile,ilxMainModule,signingInfo,exiter)
21052080
| Some da -> da (tcConfig,ilGlobals,errorLogger,outfile,pdbfile,ilxMainModule,signingInfo);
21062081

2107-
AbortOnError(errorLogger,tcConfig,exiter)
2108-
#if SILVERLIGHT
2109-
#else
2082+
AbortOnError(errorLogger, tcConfig, exiter)
21102083
if tcConfig.showLoadedAssemblies then
21112084
for a in System.AppDomain.CurrentDomain.GetAssemblies() do
21122085
dprintfn "%s" a.FullName
21132086

21142087
SqmLoggerWithConfig tcConfig errorLogger.ErrorNumbers errorLogger.WarningNumbers
2115-
#endif
2116-
#endif
21172088

21182089
ReportTime tcConfig "Exiting"
21192090

@@ -2142,3 +2113,4 @@ let mainCompile (argv, bannerAlreadyPrinted, openBinariesInMemory, exiter:Exiter
21422113
//System.Runtime.GCSettings.LatencyMode <- System.Runtime.GCLatencyMode.Batch
21432114
typecheckAndCompile(argv, bannerAlreadyPrinted, openBinariesInMemory, exiter, errorLoggerProvider, tcImportsCapture, dynamicAssemblyCreator)
21442115

2116+
#endif // NO_COMPILER_BACKEND

0 commit comments

Comments
 (0)