@@ -155,7 +155,7 @@ type DelayAndForwardErrorLogger(exiter: Exiter, errorLoggerProvider: ErrorLogger
155
155
delayed.Clear()
156
156
157
157
member x.ForwardDelayedErrorsAndWarnings ( tcConfigB : TcConfigBuilder ) =
158
- let errorLogger = errorLoggerProvider.CreateErrorLoggerThatQuitsAfterMaxErrors( tcConfigB, exiter)
158
+ let errorLogger = errorLoggerProvider.CreateErrorLoggerThatQuitsAfterMaxErrors( tcConfigB, exiter)
159
159
x.ForwardDelayedErrorsAndWarnings( errorLogger)
160
160
161
161
member x.FullErrorCount = errors
@@ -378,76 +378,77 @@ let GetTcImportsFromCommandLine
378
378
if not tcConfigB.continueAfterParseFailure then
379
379
AbortOnError( errorLogger, tcConfig, exiter)
380
380
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
382
412
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)
388
416
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 " )
413
419
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)
417
422
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
420
427
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
423
430
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)
428
433
429
- // register tcImports to be disposed in future
430
- disposables.Register tcImports
434
+ if tcConfig.importAllReferencesOnly then exiter.Exit 0
431
435
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)
440
439
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)
445
444
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"
449
448
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
451
452
452
453
// 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)
453
454
let ProcessCommandLineArgsAndImportAssemblies
@@ -641,14 +642,9 @@ module XmlDocWriter =
641
642
// cmd line - option state
642
643
//----------------------------------------------------------------------------
643
644
644
- #if SILVERLIGHT
645
- let defaultFSharpBinariesDir = " ."
646
- #else
647
645
let defaultFSharpBinariesDir =
648
646
let exeName = Path.Combine( AppDomain.CurrentDomain.BaseDirectory, AppDomain.CurrentDomain.FriendlyName)
649
647
Filename.directoryName exeName
650
- #endif
651
-
652
648
653
649
let outpath outfile extn =
654
650
String.concat " ." ([ " out" ; Filename.chopExtension ( Filename.fileNameOfPath outfile); extn])
@@ -1183,9 +1179,6 @@ module MainModuleBuilder =
1183
1179
error( Error( FSComp.SR.fscTwoResourceManifests(), rangeCmdArgs));
1184
1180
1185
1181
let win32Manifest =
1186
- #if SILVERLIGHT
1187
- " "
1188
- #else
1189
1182
// use custom manifest if provided
1190
1183
if not ( tcConfig.win32manifest = " " ) then
1191
1184
tcConfig.win32manifest
@@ -1195,10 +1188,9 @@ module MainModuleBuilder =
1195
1188
// otherwise, include the default manifest
1196
1189
else
1197
1190
System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory() + @" default.win32manifest"
1198
- #endif
1199
1191
1200
1192
let nativeResources =
1201
- #if SILVERLIGHT
1193
+ #if NO _ NATIVE _ RESOURCE _ WRITER
1202
1194
[]
1203
1195
#else
1204
1196
[ for av in assemblyVersionResources do
@@ -1338,17 +1330,6 @@ module StaticLinker =
1338
1330
ilxMainModule, rewriteExternalRefsToLocalRefs
1339
1331
1340
1332
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
-
1352
1333
// LEGACY: This is only used when compiling an FSharp.Core for .NET 2.0 (FSharp.Core 2.3.0.0). We no longer
1353
1334
// build new FSharp.Core for that configuration.
1354
1335
//
@@ -1719,7 +1700,7 @@ let GetSigner(signingInfo) =
1719
1700
error( Error( FSComp.SR.fscKeyFileCouldNotBeOpened( s), rangeCmdArgs))
1720
1701
1721
1702
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 ) =
1723
1704
try
1724
1705
if ! progress then dprintn " Writing assembly..." ;
1725
1706
try
@@ -1738,7 +1719,7 @@ module FileWriter =
1738
1719
error( Error( FSComp.SR.fscProblemWritingBinary( outfile, msg), rangeCmdArgs))
1739
1720
with e ->
1740
1721
errorRecoveryNoRange e
1741
- SqmLoggerWithConfig tcConfig _ errorLogger .ErrorNumbers _ errorLogger .WarningNumbers
1722
+ SqmLoggerWithConfig tcConfig errorLogger .ErrorNumbers errorLogger .WarningNumbers
1742
1723
exiter.Exit 1
1743
1724
1744
1725
@@ -1789,9 +1770,10 @@ let ValidateKeySigningAttributes (tcConfig : TcConfig, tcGlobals, topAttrs) =
1789
1770
1790
1771
/// Checks if specified file name is absolute path. If yes - returns the name as is, otherwise makes full path using tcConfig.implicitIncludeDir as base.
1791
1772
let expandFileNameIfNeeded ( tcConfig : TcConfig ) name =
1792
- if System.IO.Path.IsPathRooted name then name
1773
+ if FileSystem.IsPathRootedShim name then
1774
+ name
1793
1775
else
1794
- System.IO. Path.Combine( tcConfig.implicitIncludeDir, name)
1776
+ Path.Combine( tcConfig.implicitIncludeDir, name)
1795
1777
1796
1778
//----------------------------------------------------------------------------
1797
1779
// main - split up to make sure that we can GC the
@@ -1809,50 +1791,45 @@ let main0(argv,bannerAlreadyPrinted,openBinariesInMemory:bool,exiter:Exiter, err
1809
1791
#if LIMITED_ CONSOLE
1810
1792
None
1811
1793
#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" )
1816
1798
Some( 1033 )
1817
1799
else
1818
1800
None
1819
1801
#endif
1820
1802
1821
1803
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 ->
1828
1809
#if LIMITED_ CONSOLE
1829
- ()
1810
+ ()
1830
1811
#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 -> ()
1835
1816
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)
1840
1821
#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)
1852
1830
1853
1831
tcGlobals, tcImports, frameworkTcImports, generatedCcu, typedAssembly, topAttrs, tcConfig, outfile, pdbfile, assemblyName, errorLogger, exiter
1854
1832
1855
- // TcGlobals * TcImports * TcImports * CcuThunk * TypedAssembly * TopAttribs * TcConfig * string * string * string* ErrorLogger* Exiter
1856
1833
let main1 ( tcGlobals , tcImports : TcImports , frameworkTcImports , generatedCcu , typedAssembly , topAttrs , tcConfig : TcConfig , outfile , pdbfile , assemblyName , errorLogger , exiter : Exiter ) =
1857
1834
1858
1835
if tcConfig.typeCheckOnly then exiter.Exit 0
@@ -1972,7 +1949,7 @@ let main1OfAst (openBinariesInMemory, assemblyName, target, outfile, pdbFile, dl
1972
1949
Args( tcConfig, tcImports, frameworkTcImports, tcGlobals, errorLogger, generatedCcu, outfile, typedAssembly, topAttrs, pdbFile, assemblyName, assemVerFromAttrib, signingInfo, exiter)
1973
1950
1974
1951
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 )) =
1976
1953
1977
1954
ReportTime tcConfig ( " Encode Interface Data" );
1978
1955
let exportRemapping = MakeExportRemapping generatedCcu generatedCcu.Contents
@@ -1982,9 +1959,7 @@ let main2(Args(tcConfig, tcImports, frameworkTcImports: TcImports, tcGlobals, er
1982
1959
EncodeInterfaceData( tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile)
1983
1960
with e ->
1984
1961
errorRecoveryNoRange e
1985
- #if SQM_ SUPPORT
1986
- SqmLoggerWithConfig tcConfig _ errorLogger.ErrorOrWarningNumbers
1987
- #endif
1962
+ SqmLoggerWithConfig tcConfig errorLogger.ErrorNumbers errorLogger.WarningNumbers
1988
1963
exiter.Exit 1
1989
1964
1990
1965
if ! progress && tcConfig.optSettings.jitOptUser = Some false then
@@ -2104,16 +2079,12 @@ let main4 dynamicAssemblyCreator (Args(tcConfig, errorLogger:ErrorLogger, ilGlob
2104
2079
| None -> FileWriter.EmitIL ( tcConfig, ilGlobals, errorLogger, outfile, pdbfile, ilxMainModule, signingInfo, exiter)
2105
2080
| Some da -> da ( tcConfig, ilGlobals, errorLogger, outfile, pdbfile, ilxMainModule, signingInfo);
2106
2081
2107
- AbortOnError( errorLogger, tcConfig, exiter)
2108
- #if SILVERLIGHT
2109
- #else
2082
+ AbortOnError( errorLogger, tcConfig, exiter)
2110
2083
if tcConfig.showLoadedAssemblies then
2111
2084
for a in System.AppDomain.CurrentDomain.GetAssemblies() do
2112
2085
dprintfn " %s " a.FullName
2113
2086
2114
2087
SqmLoggerWithConfig tcConfig errorLogger.ErrorNumbers errorLogger.WarningNumbers
2115
- #endif
2116
- #endif
2117
2088
2118
2089
ReportTime tcConfig " Exiting"
2119
2090
@@ -2142,3 +2113,4 @@ let mainCompile (argv, bannerAlreadyPrinted, openBinariesInMemory, exiter:Exiter
2142
2113
//System.Runtime.GCSettings.LatencyMode <- System.Runtime.GCLatencyMode.Batch
2143
2114
typecheckAndCompile( argv, bannerAlreadyPrinted, openBinariesInMemory, exiter, errorLoggerProvider, tcImportsCapture, dynamicAssemblyCreator)
2144
2115
2116
+ #endif // NO_COMPILER_BACKEND
0 commit comments