Skip to content

Commit

Permalink
Replace (nearly) all ref cells in the compiler with mutable values (#…
Browse files Browse the repository at this point in the history 
…8063)

* # This is a combination of 9 commits.
# This is the 1st commit message:

ref -> mutable in more places in the compiler

# The commit message #2 will be skipped:

# Update dependencies from https://github.com/dotnet/arcade build 20191229.1
#
# - Microsoft.DotNet.Arcade.Sdk - 5.0.0-beta.19629.1

# The commit message #3 will be skipped:

# Update dependencies from https://github.com/dotnet/arcade build 20191230.1
#
# - Microsoft.DotNet.Arcade.Sdk - 5.0.0-beta.19630.1

# The commit message #4 will be skipped:

# Update dependencies from https://github.com/dotnet/arcade build 20191231.1
#
# - Microsoft.DotNet.Arcade.Sdk - 5.0.0-beta.19631.1

# The commit message #5 will be skipped:

# Update dependencies from https://github.com/dotnet/arcade build 20200101.1
#
# - Microsoft.DotNet.Arcade.Sdk - 5.0.0-beta.20051.1

# The commit message #6 will be skipped:

# Update dependencies from https://github.com/dotnet/arcade build 20191216.5 (#8079)
#
# - Microsoft.DotNet.Arcade.Sdk - 1.0.0-beta.19616.5

# The commit message #7 will be skipped:

# dispose fsi at the end of a scripting session (#8084)
#

# The commit message #8 will be skipped:

# Added static link tests and extended CompilerAssert (#8101)
#
# * Changed CompilerAssert to static class. Added Compile/Execute methods that take a Compilation description. Added static link tests
# 
# * Hiding compilation description internals
# 
# * Added another test to check for sanity
# 
# * Making a few optional parameters
# 
# * Hiding internals of CompilationReference

# The commit message #9 will be skipped:

# Parameterize product version (#8031)
#
# * Parameterize Product details
# 
# * fcs
# 
# * Repack pkgdef

* no ilread
  • Loading branch information
@cartermp
cartermp committed Jan 7, 2020
1 parent 317700e commit f9ea582
Show file tree
Hide file tree
Showing 51 changed files with 618 additions and 608 deletions.
2 changes: 1 addition & 1 deletion src/absil/ilascii.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ open FSharp.Compiler.AbstractIL.IL

// set to the proper value at CompileOps.fs (BuildFrameworkTcImports)
// Only relevant when compiling FSharp.Core.dll
let parseILGlobals = ref EcmaMscorlibILGlobals
let mutable parseILGlobals = EcmaMscorlibILGlobals

/// Table of parsing and pretty printing data for instructions.
let noArgInstrs =
Expand Down
2 changes: 1 addition & 1 deletion src/absil/ilascii.fsi
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@ open FSharp.Compiler.AbstractIL.IL
// IL Parser state - must be initialized before parsing a module
// --------------------------------------------------------------------

val parseILGlobals: ILGlobals ref
val mutable parseILGlobals: ILGlobals

// --------------------------------------------------------------------
// IL Lexer and pretty-printer tables
Expand Down
14 changes: 7 additions & 7 deletions src/absil/ildiag.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,18 +5,18 @@
module internal FSharp.Compiler.AbstractIL.Diagnostics


let diagnosticsLog = ref (Some stdout)
let mutable diagnosticsLog = Some stdout

let setDiagnosticsChannel s = diagnosticsLog := s
let setDiagnosticsChannel s = diagnosticsLog <- s

let dflushn () = match !diagnosticsLog with None -> () | Some d -> d.WriteLine(); d.Flush()
let dflush () = match !diagnosticsLog with None -> () | Some d -> d.Flush()
let dflushn () = match diagnosticsLog with None -> () | Some d -> d.WriteLine(); d.Flush()
let dflush () = match diagnosticsLog with None -> () | Some d -> d.Flush()
let dprintn (s:string) =
match !diagnosticsLog with None -> () | Some d -> d.Write s; d.Write "\n"; dflush()
match diagnosticsLog with None -> () | Some d -> d.Write s; d.Write "\n"; dflush()

let dprintf (fmt: Format<_,_,_,_>) =
Printf.kfprintf dflush (match !diagnosticsLog with None -> System.IO.TextWriter.Null | Some d -> d) fmt
Printf.kfprintf dflush (match diagnosticsLog with None -> System.IO.TextWriter.Null | Some d -> d) fmt

let dprintfn (fmt: Format<_,_,_,_>) =
Printf.kfprintf dflushn (match !diagnosticsLog with None -> System.IO.TextWriter.Null | Some d -> d) fmt
Printf.kfprintf dflushn (match diagnosticsLog with None -> System.IO.TextWriter.Null | Some d -> d) fmt

18 changes: 9 additions & 9 deletions src/absil/illib.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -47,15 +47,15 @@ let LOH_SIZE_THRESHOLD_BYTES = 80_000
// Library: ReportTime
//---------------------------------------------------------------------
let reportTime =
let tFirst = ref None
let tPrev = ref None
let mutable tFirst =None
let mutable tPrev = None
fun showTimes descr ->
if showTimes then
let t = Process.GetCurrentProcess().UserProcessorTime.TotalSeconds
let prev = match !tPrev with None -> 0.0 | Some t -> t
let first = match !tFirst with None -> (tFirst := Some t; t) | Some t -> t
let prev = match tPrev with None -> 0.0 | Some t -> t
let first = match tFirst with None -> (tFirst <- Some t; t) | Some t -> t
printf "ilwrite: TIME %10.3f (total) %10.3f (delta) - %s\n" (t - first) (t - prev) descr
tPrev := Some t
tPrev <- Some t

//-------------------------------------------------------------------------
// Library: projections
Expand Down Expand Up @@ -573,10 +573,10 @@ module String =
let getLines (str: string) =
use reader = new StringReader(str)
[|
let line = ref (reader.ReadLine())
while not (isNull !line) do
yield !line
line := reader.ReadLine()
let mutable line = reader.ReadLine()
while not (isNull line) do
yield line
line <- reader.ReadLine()
if str.EndsWithOrdinal("\n") then
// last trailing space not returned
// http://stackoverflow.com/questions/19365404/stringreader-omits-trailing-linebreak
Expand Down
44 changes: 22 additions & 22 deletions src/absil/ilpars.fsy
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,7 @@ let resolveCurrentMethodSpecScope obj =


let findSystemRuntimeAssemblyRef() =
match (!parseILGlobals).primaryAssemblyScopeRef with
match parseILGlobals.primaryAssemblyScopeRef with
| ILScopeRef.Assembly aref -> aref
| _ -> pfailwith "systemRuntimeScopeRef not set to valid assembly reference in parseILGlobals"

Expand Down Expand Up @@ -235,9 +235,9 @@ callKind:
*---------------------------------------------*/

typ: STRING
{ noMethodSpecScope (!parseILGlobals).typ_String }
{ noMethodSpecScope parseILGlobals.typ_String }
| OBJECT
{ noMethodSpecScope (!parseILGlobals).typ_Object }
{ noMethodSpecScope parseILGlobals.typ_Object }
| CLASS typeNameInst
{ resolveMethodSpecScopeThen $2 (fun tspec ->
noMethodSpecScope (mkILBoxedType tspec)) }
Expand All @@ -256,45 +256,45 @@ typ: STRING
| typ STAR
{ resolveMethodSpecScopeThen $1 (fun ty -> noMethodSpecScope (ILType.Ptr ty)) }
| CHAR
{ noMethodSpecScope (!parseILGlobals).typ_Char }
{ noMethodSpecScope parseILGlobals.typ_Char }
| VOID
{ noMethodSpecScope ILType.Void }
| BOOL
{ noMethodSpecScope (!parseILGlobals).typ_Bool }
{ noMethodSpecScope parseILGlobals.typ_Bool }
| INT8
{ noMethodSpecScope (!parseILGlobals).typ_SByte }
{ noMethodSpecScope parseILGlobals.typ_SByte }
| INT16
{ noMethodSpecScope (!parseILGlobals).typ_Int16 }
{ noMethodSpecScope parseILGlobals.typ_Int16 }
| INT32
{ noMethodSpecScope (!parseILGlobals).typ_Int32 }
{ noMethodSpecScope parseILGlobals.typ_Int32 }
| INT64
{ noMethodSpecScope (!parseILGlobals).typ_Int64 }
{ noMethodSpecScope parseILGlobals.typ_Int64 }
| FLOAT32
{ noMethodSpecScope (!parseILGlobals).typ_Single }
{ noMethodSpecScope parseILGlobals.typ_Single }
| FLOAT64
{ noMethodSpecScope (!parseILGlobals).typ_Double }
{ noMethodSpecScope parseILGlobals.typ_Double }
| UNSIGNED INT8
{ noMethodSpecScope (!parseILGlobals).typ_Byte }
{ noMethodSpecScope parseILGlobals.typ_Byte }
| UNSIGNED INT16
{ noMethodSpecScope (!parseILGlobals).typ_UInt16 }
{ noMethodSpecScope parseILGlobals.typ_UInt16 }
| UNSIGNED INT32
{ noMethodSpecScope (!parseILGlobals).typ_UInt32 }
{ noMethodSpecScope parseILGlobals.typ_UInt32 }
| UNSIGNED INT64
{ noMethodSpecScope (!parseILGlobals).typ_UInt64 }
{ noMethodSpecScope parseILGlobals.typ_UInt64 }
| UINT8
{ noMethodSpecScope (!parseILGlobals).typ_Byte }
{ noMethodSpecScope parseILGlobals.typ_Byte }
| UINT16
{ noMethodSpecScope (!parseILGlobals).typ_UInt16 }
{ noMethodSpecScope parseILGlobals.typ_UInt16 }
| UINT32
{ noMethodSpecScope (!parseILGlobals).typ_UInt32 }
{ noMethodSpecScope parseILGlobals.typ_UInt32 }
| UINT64
{ noMethodSpecScope (!parseILGlobals).typ_UInt64 }
{ noMethodSpecScope parseILGlobals.typ_UInt64 }
| NATIVE INT
{ noMethodSpecScope (!parseILGlobals).typ_IntPtr }
{ noMethodSpecScope parseILGlobals.typ_IntPtr }
| NATIVE UNSIGNED INT
{ noMethodSpecScope (!parseILGlobals).typ_UIntPtr }
{ noMethodSpecScope parseILGlobals.typ_UIntPtr }
| NATIVE UINT
{ noMethodSpecScope (!parseILGlobals).typ_UIntPtr }
{ noMethodSpecScope parseILGlobals.typ_UIntPtr }

| BANG int32
{ noMethodSpecScope (ILType.TypeVar (uint16 ( $2))) }
Expand Down
56 changes: 28 additions & 28 deletions src/fsharp/CompileOps.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2479,7 +2479,7 @@ type AssemblyResolution =
resolvedPath: string
prepareToolTip: unit -> string
sysdir: bool
ilAssemblyRef: ILAssemblyRef option ref
mutable ilAssemblyRef: ILAssemblyRef option
}
override this.ToString() = sprintf "%s%s" (if this.sysdir then "[sys]" else "") this.resolvedPath

Expand All @@ -2494,7 +2494,7 @@ type AssemblyResolution =
//
member this.GetILAssemblyRef(ctok, reduceMemoryUsage, tryGetMetadataSnapshot) =
cancellable {
match !this.ilAssemblyRef with
match this.ilAssemblyRef with
| Some assemblyRef -> return assemblyRef
| None ->
let! assemblyRefOpt =
Expand Down Expand Up @@ -2522,7 +2522,7 @@ type AssemblyResolution =
tryGetMetadataSnapshot = tryGetMetadataSnapshot }
use reader = OpenILModuleReader this.resolvedPath readerSettings
mkRefToILAssembly reader.ILModuleDef.ManifestOfAssembly
this.ilAssemblyRef := Some assemblyRef
this.ilAssemblyRef <- Some assemblyRef
return assemblyRef
}

Expand Down Expand Up @@ -2892,7 +2892,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
resolvedPath = resolved
prepareToolTip = (fun () -> resolved)
sysdir = sysdir
ilAssemblyRef = ref None }
ilAssemblyRef = None }
| None ->

if String.Compare(ext, ".dll", StringComparison.OrdinalIgnoreCase)=0
Expand Down Expand Up @@ -2927,7 +2927,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
let line(append: string) = append.Trim([|' '|])+"\n"
line resolved + line fusionName)
sysdir = sysdir
ilAssemblyRef = ref None }
ilAssemblyRef = None }
| None -> None
else None

Expand Down Expand Up @@ -3057,7 +3057,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
resolvedPath=canonicalItemSpec
prepareToolTip = (fun () -> resolvedFile.prepareToolTip (originalReference.Text, canonicalItemSpec))
sysdir= tcConfig.IsSystemAssembly canonicalItemSpec
ilAssemblyRef = ref None })
ilAssemblyRef = None })
(maxIndexOfReference, assemblyResolutions))

// When calculating the resulting resolutions, we're going to use the index of the reference
Expand Down Expand Up @@ -3395,7 +3395,7 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, conditionalComp
try
let skip = true in (* don't report whitespace from lexer *)
let lightSyntaxStatus = LightSyntaxStatus (tcConfig.ComputeLightSyntaxInitialStatus filename, true)
let lexargs = mkLexargs (filename, conditionalCompilationDefines@tcConfig.conditionalCompilationDefines, lightSyntaxStatus, lexResourceManager, ref [], errorLogger, tcConfig.pathMap)
let lexargs = mkLexargs (filename, conditionalCompilationDefines@tcConfig.conditionalCompilationDefines, lightSyntaxStatus, lexResourceManager, [], errorLogger, tcConfig.pathMap)
let shortFilename = SanitizeFileName filename tcConfig.implicitIncludeDir
let input =
Lexhelp.usingLexbufForParsing (lexbuf, filename) (fun lexbuf ->
Expand Down Expand Up @@ -3525,24 +3525,24 @@ type TcAssemblyResolutions(tcConfig: TcConfig, results: AssemblyResolution list,
let frameworkDLLs, nonFrameworkReferences = resolutions.GetAssemblyResolutions() |> List.partition (fun r -> r.sysdir)
let unresolved = resolutions.GetUnresolvedReferences()
#if DEBUG
let itFailed = ref false
let mutable itFailed = false
let addedText = "\nIf you want to debug this right now, attach a debugger, and put a breakpoint in 'CompileOps.fs' near the text '!itFailed', and you can re-step through the assembly resolution logic."
unresolved
|> List.iter (fun (UnresolvedAssemblyReference(referenceText, _ranges)) ->
if referenceText.Contains("mscorlib") then
System.Diagnostics.Debug.Assert(false, sprintf "whoops, did not resolve mscorlib: '%s'%s" referenceText addedText)
itFailed := true)
itFailed <- true)
frameworkDLLs
|> List.iter (fun x ->
if not(FileSystem.IsPathRootedShim(x.resolvedPath)) then
System.Diagnostics.Debug.Assert(false, sprintf "frameworkDLL should be absolute path: '%s'%s" x.resolvedPath addedText)
itFailed := true)
itFailed <- true)
nonFrameworkReferences
|> List.iter (fun x ->
if not(FileSystem.IsPathRootedShim(x.resolvedPath)) then
System.Diagnostics.Debug.Assert(false, sprintf "nonFrameworkReference should be absolute path: '%s'%s" x.resolvedPath addedText)
itFailed := true)
if !itFailed then
itFailed <- true)
if itFailed then
// idea is, put a breakpoint here and then step through
let assemblyList = TcAssemblyResolutions.GetAllDllReferences tcConfig
let resolutions = TcAssemblyResolutions.ResolveAssemblyReferences (ctok, tcConfig, assemblyList, [])
Expand Down Expand Up @@ -4207,9 +4207,9 @@ and [<Sealed>] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse
let systemRuntimeContainsType =
// NOTE: do not touch this, edit: but we did, we had no choice - TPs cannot hold a strong reference on TcImports "ever".
let tcImports = tcImportsWeak
let systemRuntimeContainsTypeRef = ref (fun typeName -> tcImports.SystemRuntimeContainsType typeName)
tcImportsStrong.AttachDisposeTypeProviderAction(fun () -> systemRuntimeContainsTypeRef := (fun _ -> raise (System.ObjectDisposedException("The type provider has been disposed"))))
fun arg -> systemRuntimeContainsTypeRef.Value arg
let mutable systemRuntimeContainsTypeRef = fun typeName -> tcImports.SystemRuntimeContainsType typeName
tcImportsStrong.AttachDisposeTypeProviderAction(fun () -> systemRuntimeContainsTypeRef <- fun _ -> raise (System.ObjectDisposedException("The type provider has been disposed")))
fun arg -> systemRuntimeContainsTypeRef arg

let providers =
[ for designTimeAssemblyName in designTimeAssemblyNames do
Expand Down Expand Up @@ -4676,7 +4676,7 @@ and [<Sealed>] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse
error(InternalError("BuildFrameworkTcImports: no successful import of "+coreLibraryResolution.resolvedPath, coreLibraryResolution.originalReference.Range))
| None ->
error(InternalError(sprintf "BuildFrameworkTcImports: no resolution of '%s'" coreLibraryReference.Text, rangeStartup))
IlxSettings.ilxFsharpCoreLibAssemRef :=
IlxSettings.ilxFsharpCoreLibAssemRef <-
(let scoref = fslibCcuInfo.ILScopeRef
match scoref with
| ILScopeRef.Assembly aref -> Some aref
Expand All @@ -4691,11 +4691,11 @@ and [<Sealed>] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse

#if DEBUG
// the global_g reference cell is used only for debug printing
global_g := Some tcGlobals
global_g <- Some tcGlobals
#endif
// do this prior to parsing, since parsing IL assembly code may refer to mscorlib
#if !NO_INLINE_IL_PARSER
FSharp.Compiler.AbstractIL.Internal.AsciiConstants.parseILGlobals := tcGlobals.ilg
FSharp.Compiler.AbstractIL.Internal.AsciiConstants.parseILGlobals <- tcGlobals.ilg
#endif
frameworkTcImports.SetTcGlobals tcGlobals
return tcGlobals, frameworkTcImports
Expand Down Expand Up @@ -5035,8 +5035,8 @@ module private ScriptPreprocessClosure =
(tcConfig: TcConfig, inp: ParsedInput, pathOfMetaCommandSource) =

let tcConfigB = tcConfig.CloneOfOriginalBuilder
let nowarns = ref []
let getWarningNumber = fun () (m, s) -> nowarns := (s, m) :: !nowarns
let mutable nowarns = []
let getWarningNumber = fun () (m, s) -> nowarns <- (s, m) :: nowarns
let addReferencedAssemblyByPath = fun () (m, s) -> tcConfigB.AddReferencedAssemblyByPath(m, s)
let addLoadedSource = fun () (m, s) -> tcConfigB.AddLoadedSource(m, s, pathOfMetaCommandSource)
try
Expand All @@ -5056,7 +5056,7 @@ module private ScriptPreprocessClosure =
(closureSources, tcConfig: TcConfig, codeContext,
lexResourceManager: Lexhelp.LexResourceManager) =

let tcConfig = ref tcConfig
let mutable tcConfig = tcConfig

let observedSources = Observed()
let rec loop (ClosureSource(filename, m, sourceText, parseRequired)) =
Expand All @@ -5067,20 +5067,20 @@ module private ScriptPreprocessClosure =
let parseResult, parseDiagnostics =
let errorLogger = CapturingErrorLogger("FindClosureParse")
use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger)
let result = ParseScriptText (filename, sourceText, !tcConfig, codeContext, lexResourceManager, errorLogger)
let result = ParseScriptText (filename, sourceText, tcConfig, codeContext, lexResourceManager, errorLogger)
result, errorLogger.Diagnostics

match parseResult with
| Some parsedScriptAst ->
let errorLogger = CapturingErrorLogger("FindClosureMetaCommands")
use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger)
let pathOfMetaCommandSource = Path.GetDirectoryName filename
let preSources = (!tcConfig).GetAvailableLoadedSources()
let preSources = tcConfig.GetAvailableLoadedSources()

let tcConfigResult, noWarns = ApplyMetaCommandsFromInputToTcConfigAndGatherNoWarn (!tcConfig, parsedScriptAst, pathOfMetaCommandSource)
tcConfig := tcConfigResult // We accumulate the tcConfig in order to collect assembly references
let tcConfigResult, noWarns = ApplyMetaCommandsFromInputToTcConfigAndGatherNoWarn (tcConfig, parsedScriptAst, pathOfMetaCommandSource)
tcConfig <- tcConfigResult // We accumulate the tcConfig in order to collect assembly references

let postSources = (!tcConfig).GetAvailableLoadedSources()
let postSources = tcConfig.GetAvailableLoadedSources()
let sources = if preSources.Length < postSources.Length then postSources.[preSources.Length..] else []

//for (_, subFile) in sources do
Expand All @@ -5094,7 +5094,7 @@ module private ScriptPreprocessClosure =
yield ClosureFile(subFile, m, None, [], [], [])

//printfn "yielding source %s" filename
yield ClosureFile(filename, m, Some parsedScriptAst, parseDiagnostics, errorLogger.Diagnostics, !noWarns)
yield ClosureFile(filename, m, Some parsedScriptAst, parseDiagnostics, errorLogger.Diagnostics, noWarns)

| None ->
//printfn "yielding source %s (failed parse)" filename
Expand All @@ -5104,7 +5104,7 @@ module private ScriptPreprocessClosure =
//printfn "yielding non-script source %s" filename
yield ClosureFile(filename, m, None, [], [], []) ]

closureSources |> List.collect loop, !tcConfig
closureSources |> List.collect loop, tcConfig

/// Reduce the full directive closure into LoadClosure
let GetLoadClosure(ctok, rootFilename, closureFiles, tcConfig: TcConfig, codeContext) =
Expand Down
2 changes: 1 addition & 1 deletion src/fsharp/CompileOps.fsi
View file
Original file line number Diff line number Diff line change
Expand Up @@ -204,7 +204,7 @@ type AssemblyResolution =
/// Whether or not this is an installed system assembly (for example, System.dll)
sysdir: bool
// Lazily populated ilAssemblyRef for this reference.
ilAssemblyRef: ILAssemblyRef option ref }
mutable ilAssemblyRef: ILAssemblyRef option }

type UnresolvedAssemblyReference = UnresolvedAssemblyReference of string * AssemblyReference list

Expand Down
Loading

0 comments on commit f9ea582

Please sign in to comment.