diff --git a/src/absil/ilascii.fs b/src/absil/ilascii.fs index 4bd48cb59b3..e5b7782ba7e 100644 --- a/src/absil/ilascii.fs +++ b/src/absil/ilascii.fs @@ -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 = diff --git a/src/absil/ilascii.fsi b/src/absil/ilascii.fsi index 3a8543e4e1c..67a5c9eb4b1 100644 --- a/src/absil/ilascii.fsi +++ b/src/absil/ilascii.fsi @@ -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 diff --git a/src/absil/ildiag.fs b/src/absil/ildiag.fs index 1cd20ad8750..d43bdf8dca4 100644 --- a/src/absil/ildiag.fs +++ b/src/absil/ildiag.fs @@ -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 diff --git a/src/absil/illib.fs b/src/absil/illib.fs index 9a84e94e34a..33e0566a6c2 100644 --- a/src/absil/illib.fs +++ b/src/absil/illib.fs @@ -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 @@ -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 diff --git a/src/absil/ilpars.fsy b/src/absil/ilpars.fsy index 849c5f9fd13..e831677e50a 100644 --- a/src/absil/ilpars.fsy +++ b/src/absil/ilpars.fsy @@ -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" @@ -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)) } @@ -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))) } diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 45d93c5cec3..067d3353a64 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -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 @@ -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 = @@ -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 } @@ -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 @@ -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 @@ -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 @@ -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 -> @@ -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, []) @@ -4207,9 +4207,9 @@ and [] 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 @@ -4676,7 +4676,7 @@ and [] 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 @@ -4691,11 +4691,11 @@ and [] 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 @@ -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 @@ -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)) = @@ -5067,7 +5067,7 @@ 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 @@ -5075,12 +5075,12 @@ module private ScriptPreprocessClosure = 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 @@ -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 @@ -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) = diff --git a/src/fsharp/CompileOps.fsi b/src/fsharp/CompileOps.fsi index 230bd508de5..a0b031092ac 100644 --- a/src/fsharp/CompileOps.fsi +++ b/src/fsharp/CompileOps.fsi @@ -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 diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index 29e854a83f1..441df5f3468 100644 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -1015,7 +1015,7 @@ let testFlag tcConfigB = match s with | "StackSpan" -> tcConfigB.internalTestSpanStackReferring <- true | "ErrorRanges" -> tcConfigB.errorStyle <- ErrorStyle.TestErrors - | "Tracking" -> Lib.tracking := true (* general purpose on/off diagnostics flag *) + | "Tracking" -> Lib.tracking <- true (* general purpose on/off diagnostics flag *) | "NoNeedToTailcall" -> tcConfigB.optSettings <- { tcConfigB.optSettings with reportNoNeedToTailcall = true } | "FunctionSizes" -> tcConfigB.optSettings <- { tcConfigB.optSettings with reportFunctionSizes = true } | "TotalSizes" -> tcConfigB.optSettings <- { tcConfigB.optSettings with reportTotalSizes = true } @@ -1242,7 +1242,7 @@ let compilingFsLibFlag (tcConfigB: TcConfigBuilder) = tcConfigB.compilingFslib <- true tcConfigB.TurnWarningOff(rangeStartup, "42") ErrorLogger.reportLibraryOnlyFeatures <- false - IlxSettings.ilxCompilingFSharpCoreLib := true), + IlxSettings.ilxCompilingFSharpCoreLib <- true), Some(InternalCommandLineOption("--compiling-fslib", rangeCmdArgs)), None) let compilingFsLib20Flag = @@ -1312,7 +1312,7 @@ let deprecatedFlagsFsc tcConfigB = CompilerOption ("progress", tagNone, - OptionUnit (fun () -> progress := true), + OptionUnit (fun () -> progress <- true), Some(DeprecatedCommandLineOptionNoDescription("--progress", rangeCmdArgs)), None) compilingFsLibFlag tcConfigB @@ -1588,14 +1588,13 @@ let ApplyCommandLineArgs(tcConfigB: TcConfigBuilder, sourceFiles: string list, c // PrintWholeAssemblyImplementation //---------------------------------------------------------------------------- -let showTermFileCount = ref 0 +let mutable showTermFileCount = 0 let PrintWholeAssemblyImplementation g (tcConfig:TcConfig) outfile header expr = if tcConfig.showTerms then if tcConfig.writeTermsToFiles then let filename = outfile + ".terms" - let n = !showTermFileCount - showTermFileCount := n+1 - use f = System.IO.File.CreateText (filename + "-" + string n + "-" + header) + use f = System.IO.File.CreateText (filename + "-" + string showTermFileCount + "-" + header) + showTermFileCount <- showTermFileCount + 1 Layout.outL f (Layout.squashTo 192 (DebugPrint.implFilesL g expr)) else dprintf "\n------------------\nshowTerm: %s:\n" header @@ -1606,11 +1605,11 @@ let PrintWholeAssemblyImplementation g (tcConfig:TcConfig) outfile header expr = // ReportTime //---------------------------------------------------------------------------- -let tPrev = ref None -let nPrev = ref None +let mutable tPrev = None +let mutable nPrev = None let ReportTime (tcConfig:TcConfig) descr = - match !nPrev with + match nPrev with | None -> () | Some prevDescr -> if tcConfig.pause then @@ -1651,7 +1650,7 @@ let ReportTime (tcConfig:TcConfig) descr = let ptime = System.Diagnostics.Process.GetCurrentProcess() let wsNow = ptime.WorkingSet64/1000000L - match !tPrev, !nPrev with + match tPrev, nPrev with | Some (timePrev, gcPrev:int []), Some prevDescr -> let spanGC = [| for i in 0 .. maxGen -> System.GC.CollectionCount i - gcPrev.[i] |] dprintf "TIME: %4.1f Delta: %4.1f Mem: %3d" @@ -1662,9 +1661,9 @@ let ReportTime (tcConfig:TcConfig) descr = prevDescr | _ -> () - tPrev := Some (timeNow, gcNow) + tPrev <- Some (timeNow, gcNow) - nPrev := Some descr + nPrev <- Some descr //---------------------------------------------------------------------------- // OPTIMIZATION - support - addDllToOptEnv diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index f5aade84008..e22437de141 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -1710,9 +1710,9 @@ and AddConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace tp newConstraint // This works because the types on the r.h.s. of subtype // constraints are head-types and so any further inferences are equational. let collect ty = - let res = ref [] - IterateEntireHierarchyOfType (fun x -> res := x :: !res) g amap m AllowMultiIntfInstantiations.No ty - List.rev !res + let mutable res = [] + IterateEntireHierarchyOfType (fun x -> res <- x :: res) g amap m AllowMultiIntfInstantiations.No ty + List.rev res let parents1 = collect ty1 let parents2 = collect ty2 trackErrors { diff --git a/src/fsharp/ErrorLogger.fs b/src/fsharp/ErrorLogger.fs index c37a3395121..2f515d566a8 100755 --- a/src/fsharp/ErrorLogger.fs +++ b/src/fsharp/ErrorLogger.fs @@ -441,8 +441,8 @@ let PushThreadBuildPhaseUntilUnwind (phase:BuildPhase) = let PushErrorLoggerPhaseUntilUnwind(errorLoggerTransformer : ErrorLogger -> #ErrorLogger) = let oldErrorLogger = CompileThreadStatic.ErrorLogger let newErrorLogger = errorLoggerTransformer oldErrorLogger - let newInstalled = ref true - let newIsInstalled() = if !newInstalled then () else (assert false; (); (*failwith "error logger used after unwind"*)) // REVIEW: ok to throw? + let mutable newInstalled = true + let newIsInstalled() = if newInstalled then () else (assert false; (); (*failwith "error logger used after unwind"*)) // REVIEW: ok to throw? let chkErrorLogger = { new ErrorLogger("PushErrorLoggerPhaseUntilUnwind") with member __.DiagnosticSink(phasedError, isError) = newIsInstalled(); newErrorLogger.DiagnosticSink(phasedError, isError) member __.ErrorCount = newIsInstalled(); newErrorLogger.ErrorCount } @@ -452,7 +452,7 @@ let PushErrorLoggerPhaseUntilUnwind(errorLoggerTransformer : ErrorLogger -> #Err { new System.IDisposable with member __.Dispose() = CompileThreadStatic.ErrorLogger <- oldErrorLogger - newInstalled := false } + newInstalled <- false } let SetThreadBuildPhaseNoUnwind(phase:BuildPhase) = CompileThreadStatic.BuildPhase <- phase let SetThreadErrorLoggerNoUnwind errorLogger = CompileThreadStatic.ErrorLogger <- errorLogger diff --git a/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs b/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs index 63c9bf12457..3428d60ad8f 100644 --- a/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs +++ b/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs @@ -394,18 +394,18 @@ open Printf stringInfos |> Seq.iter (fun (lineNum, (optErrNum,ident), str, holes, netFormatString) -> let formalArgs = new System.Text.StringBuilder() let actualArgs = new System.Text.StringBuilder() - let firstTime = ref true - let n = ref 0 + let mutable firstTime = true + let mutable n = 0 formalArgs.Append "(" |> ignore for hole in holes do - if !firstTime then - firstTime := false + if firstTime then + firstTime <- false else formalArgs.Append ", " |> ignore actualArgs.Append " " |> ignore - formalArgs.Append(sprintf "a%d : %s" !n hole) |> ignore - actualArgs.Append(sprintf "a%d" !n) |> ignore - n := !n + 1 + formalArgs.Append(sprintf "a%d : %s" n hole) |> ignore + actualArgs.Append(sprintf "a%d" n) |> ignore + n <- n + 1 formalArgs.Append ")" |> ignore fprintfn out " /// %s" str fprintfn out " /// (Originally from %s:%d)" filename (lineNum+1) diff --git a/src/fsharp/FSharp.Core/async.fs b/src/fsharp/FSharp.Core/async.fs index b6ab88a16f6..4655b0d73f3 100644 --- a/src/fsharp/FSharp.Core/async.fs +++ b/src/fsharp/FSharp.Core/async.fs @@ -1647,19 +1647,19 @@ namespace Microsoft.FSharp.Control let resultCell = new ResultCell<_>() let! cancellationToken = cancellationTokenAsync let innerCTS = new CancellationTokenSource() // innerCTS does not require disposal - let ctsRef = ref innerCTS + let mutable ctsRef = innerCTS let reg = cancellationToken.Register( (fun _ -> - match !ctsRef with + match ctsRef with | null -> () | otherwise -> otherwise.Cancel()), null) do QueueAsync innerCTS.Token // since innerCTS is not ever Disposed, can call reg.Dispose() without a safety Latch - (fun res -> ctsRef := null; reg.Dispose(); resultCell.RegisterResult (Ok res, reuseThread=true)) - (fun edi -> ctsRef := null; reg.Dispose(); resultCell.RegisterResult (Error edi, reuseThread=true)) - (fun err -> ctsRef := null; reg.Dispose(); resultCell.RegisterResult (Canceled err, reuseThread=true)) + (fun res -> ctsRef <- null; reg.Dispose(); resultCell.RegisterResult (Ok res, reuseThread=true)) + (fun edi -> ctsRef <- null; reg.Dispose(); resultCell.RegisterResult (Error edi, reuseThread=true)) + (fun err -> ctsRef <- null; reg.Dispose(); resultCell.RegisterResult (Canceled err, reuseThread=true)) computation |> unfake @@ -1713,10 +1713,10 @@ namespace Microsoft.FSharp.Control [] // give the extension member a 'nice', unmangled compiled name, unique within this module member stream.AsyncRead count = async { let buffer = Array.zeroCreate count - let i = ref 0 - while !i < count do - let! n = stream.AsyncRead(buffer, !i, count - !i) - i := !i + n + let mutable i = 0 + while i < count do + let! n = stream.AsyncRead(buffer, i, count - i) + i <- i + n if n = 0 then raise(System.IO.EndOfStreamException(SR.GetString(SR.failedReadEnoughBytes))) return buffer } @@ -1746,16 +1746,16 @@ namespace Microsoft.FSharp.Control [] // give the extension member a 'nice', unmangled compiled name, unique within this module member req.AsyncGetResponse() : Async= - let canceled = ref false // WebException with Status = WebExceptionStatus.RequestCanceled can be raised in other situations except cancellation, use flag to filter out false positives + let mutable canceled = false // WebException with Status = WebExceptionStatus.RequestCanceled can be raised in other situations except cancellation, use flag to filter out false positives // Use CreateTryWithFilterAsync to allow propagation of exception without losing stack Async.FromBeginEnd(beginAction=req.BeginGetResponse, endAction = req.EndGetResponse, - cancelAction = fun() -> canceled := true; req.Abort()) + cancelAction = fun() -> canceled <- true; req.Abort()) |> CreateTryWithFilterAsync (fun exn -> match exn with | :? System.Net.WebException as webExn - when webExn.Status = System.Net.WebExceptionStatus.RequestCanceled && !canceled -> + when webExn.Status = System.Net.WebExceptionStatus.RequestCanceled && canceled -> Some (Async.BindResult(AsyncResult.Canceled (OperationCanceledException webExn.Message))) | _ -> diff --git a/src/fsharp/FSharp.Core/eventmodule.fs b/src/fsharp/FSharp.Core/eventmodule.fs index 1d615a307c3..fe907373f59 100644 --- a/src/fsharp/FSharp.Core/eventmodule.fs +++ b/src/fsharp/FSharp.Core/eventmodule.fs @@ -40,12 +40,12 @@ namespace Microsoft.FSharp.Control [] let scan collector state (sourceEvent: IEvent<'Delegate,'T>) = - let state = ref state + let mutable state = state let ev = new Event<_>() sourceEvent.Add(fun msg -> - let z = !state + let z = state let z = collector z msg - state := z; + state <- z; ev.Trigger(z)) ev.Publish @@ -55,12 +55,12 @@ namespace Microsoft.FSharp.Control [] let pairwise (sourceEvent : IEvent<'Delegate,'T>) : IEvent<'T * 'T> = let ev = new Event<'T * 'T>() - let lastArgs = ref None + let mutable lastArgs = None sourceEvent.Add(fun args2 -> - (match !lastArgs with + (match lastArgs with | None -> () | Some args1 -> ev.Trigger(args1,args2)) - lastArgs := Some args2) + lastArgs <- Some args2) ev.Publish diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index 0e97166352d..89db09ecdaa 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -1185,13 +1185,13 @@ module internal Array = let count = min count len let res = zeroCreateUnchecked count : 'T[][] let minChunkSize = len / count - let startIndex = ref 0 + let mutable startIndex = 0 for i = 0 to len % count - 1 do - res.[i] <- subUnchecked !startIndex (minChunkSize + 1) array - startIndex := !startIndex + minChunkSize + 1 + res.[i] <- subUnchecked startIndex (minChunkSize + 1) array + startIndex <- startIndex + minChunkSize + 1 for i = len % count to count - 1 do - res.[i] <- subUnchecked !startIndex minChunkSize array - startIndex := !startIndex + minChunkSize + res.[i] <- subUnchecked startIndex minChunkSize array + startIndex <- startIndex + minChunkSize res module internal Seq = diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index d0fccda1fdb..0c7554586f9 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -374,8 +374,8 @@ module MapTree = mkFromEnumerator comparer empty ie let copyToArray m (arr: _[]) i = - let j = ref i - m |> iter (fun x y -> arr.[!j] <- KeyValuePair(x, y); j := !j + 1) + let mutable j = i + m |> iter (fun x y -> arr.[j] <- KeyValuePair(x, y); j <- j + 1) /// Imperative left-to-right iterators. [] diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 554c19113ee..40a9e9571ae 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -4681,14 +4681,14 @@ namespace Microsoft.FSharp.Core else // a constrained, common simple iterator that is fast. let singleStepRangeEnumerator () = - let value : Ref<'T> = ref (n - LanguagePrimitives.GenericOne) + let mutable value = n - LanguagePrimitives.GenericOne let inline current () = // according to IEnumerator.Current documentation, the result of of Current // is undefined prior to the first call of MoveNext and post called to MoveNext // that return false (see https://msdn.microsoft.com/en-us/library/58e146b7%28v=vs.110%29.aspx) // so we should be able to just return value here, which would be faster - let derefValue = !value + let derefValue = value if derefValue < n then notStarted () elif derefValue > m then @@ -4704,14 +4704,14 @@ namespace Microsoft.FSharp.Core interface IEnumerator with member __.Current = box (current ()) - member __.Reset () = value := n - LanguagePrimitives.GenericOne + member __.Reset () = value <- n - LanguagePrimitives.GenericOne member __.MoveNext () = - let derefValue = !value + let derefValue = value if derefValue < m then - value := derefValue + LanguagePrimitives.GenericOne + value <- derefValue + LanguagePrimitives.GenericOne true elif derefValue = m then - value := derefValue + LanguagePrimitives.GenericOne + value <- derefValue + LanguagePrimitives.GenericOne false else false } diff --git a/src/fsharp/FSharp.Core/reflect.fs b/src/fsharp/FSharp.Core/reflect.fs index 0dd38fe2257..828fddac3d3 100644 --- a/src/fsharp/FSharp.Core/reflect.fs +++ b/src/fsharp/FSharp.Core/reflect.fs @@ -391,12 +391,12 @@ module internal Impl = | false, _ -> // the Dictionary<>s here could be ConcurrentDictionary<>'s, but then // that would lock while initializing the Type array (maybe not an issue) - let a = ref (Array.init 8 (fun i -> makeIt (i + 1))) + let mutable a = Array.init 8 (fun i -> makeIt (i + 1)) lock dictionaryLock (fun () -> match tables.TryGetValue asm with - | true, t -> a := t - | false, _ -> tables.Add(asm, !a)) - !a + | true, t -> a <- t + | false, _ -> tables.Add(asm, a)) + a | true, t -> t match tys.Length with diff --git a/src/fsharp/FSharp.Core/seq.fs b/src/fsharp/FSharp.Core/seq.fs index 0b6e7ed2e5d..71f16b6fa2e 100644 --- a/src/fsharp/FSharp.Core/seq.fs +++ b/src/fsharp/FSharp.Core/seq.fs @@ -84,13 +84,13 @@ namespace Microsoft.FSharp.Collections let mapi f (e : IEnumerator<_>) : IEnumerator<_> = let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(f) - let i = ref (-1) + let mutable i = -1 upcast { new MapEnumerator<_>() with member __.DoMoveNext curr = - i := !i + 1 + i <- i + 1 if e.MoveNext() then - curr <- f.Invoke(!i, e.Current) + curr <- f.Invoke(i, e.Current) true else false @@ -118,13 +118,13 @@ namespace Microsoft.FSharp.Collections let mapi2 f (e1 : IEnumerator<_>) (e2 : IEnumerator<_>) : IEnumerator<_> = let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(f) - let i = ref (-1) + let mutable i = -1 upcast { new MapEnumerator<_>() with member __.DoMoveNext curr = - i := !i + 1 + i <- i + 1 if (e1.MoveNext() && e2.MoveNext()) then - curr <- f.Invoke(!i, e1.Current, e2.Current) + curr <- f.Invoke(i, e1.Current, e2.Current) true else false @@ -160,11 +160,11 @@ namespace Microsoft.FSharp.Collections } let choose f (e : IEnumerator<'T>) = - let started = ref false - let curr = ref None + let mutable started = false + let mutable curr = None let get() = - check !started - match !curr with + check started + match curr with | None -> alreadyFinished() | Some x -> x @@ -173,25 +173,25 @@ namespace Microsoft.FSharp.Collections interface IEnumerator with member __.Current = box (get()) member __.MoveNext() = - if not !started then started := true - curr := None - while ((!curr).IsNone && e.MoveNext()) do - curr := f e.Current - Option.isSome !curr + if not started then started <- true + curr <- None + while (curr.IsNone && e.MoveNext()) do + curr <- f e.Current + Option.isSome curr member __.Reset() = noReset() interface System.IDisposable with member __.Dispose() = e.Dispose() } let filter f (e : IEnumerator<'T>) = - let started = ref false + let mutable started = false let this = { new IEnumerator<'T> with - member __.Current = check !started; e.Current + member __.Current = check started; e.Current interface IEnumerator with - member __.Current = check !started; box e.Current + member __.Current = check started; box e.Current member __.MoveNext() = let rec next() = - if not !started then started := true + if not started then started <- true e.MoveNext() && (f e.Current || next()) next() member __.Reset() = noReset() @@ -200,15 +200,15 @@ namespace Microsoft.FSharp.Collections this let unfold f x : IEnumerator<_> = - let state = ref x + let mutable state = x upcast { new MapEnumerator<_>() with member __.DoMoveNext curr = - match f !state with + match f state with | None -> false | Some (r,s) -> curr <- r - state := s + state <- s true member __.Dispose() = () } @@ -229,34 +229,36 @@ namespace Microsoft.FSharp.Collections // The lazy creation of the cache nodes means enumerations that skip many Current values are not delayed by GC. // For example, the full enumeration of Seq.initInfinite in the tests. // state - let index = ref unstarted + let mutable index = unstarted // a Lazy node to cache the result/exception - let current = ref (Unchecked.defaultof<_>) - let setIndex i = index := i; current := (Unchecked.defaultof<_>) // cache node unprimed, initialised on demand. + let mutable current = Unchecked.defaultof<_> + let setIndex i = + index <- i + current <- (Unchecked.defaultof<_>) // cache node unprimed, initialised on demand. let getCurrent() = - if !index = unstarted then notStarted() - if !index = completed then alreadyFinished() - match box !current with - | null -> current := Lazy<_>.Create(fun () -> f !index) + if index = unstarted then notStarted() + if index = completed then alreadyFinished() + match box current with + | null -> current <- Lazy<_>.Create(fun () -> f index) | _ -> () // forced or re-forced immediately. - (!current).Force() + current.Force() { new IEnumerator<'U> with member __.Current = getCurrent() interface IEnumerator with member __.Current = box (getCurrent()) member __.MoveNext() = - if !index = completed then + if index = completed then false - elif !index = unstarted then + elif index = unstarted then setIndex 0 true else - if !index = System.Int32.MaxValue then raise <| System.InvalidOperationException (SR.GetString(SR.enumerationPastIntMaxValue)) - if !index = finalIndex then + if index = System.Int32.MaxValue then raise <| System.InvalidOperationException (SR.GetString(SR.enumerationPastIntMaxValue)) + if index = finalIndex then false else - setIndex (!index + 1) + setIndex (index + 1) true member __.Reset() = noReset() @@ -858,10 +860,10 @@ namespace Microsoft.FSharp.Collections let truncate count (source: seq<'T>) = checkNonNull "source" source if count <= 0 then empty else - seq { let i = ref 0 + seq { let mutable i = 0 use ie = source.GetEnumerator() - while !i < count && ie.MoveNext() do - i := !i + 1 + while i < count && ie.MoveNext() do + i <- i + 1 yield ie.Current } [] @@ -869,22 +871,22 @@ namespace Microsoft.FSharp.Collections checkNonNull "source" source seq { use ie = source.GetEnumerator() if ie.MoveNext() then - let iref = ref ie.Current + let mutable iref = ie.Current while ie.MoveNext() do let j = ie.Current - yield (!iref, j) - iref := j } + yield (iref, j) + iref <- j } [] let scan<'T,'State> folder (state:'State) (source : seq<'T>) = checkNonNull "source" source let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt folder - seq { let zref = ref state - yield !zref + seq { let mutable zref = state + yield zref use ie = source.GetEnumerator() while ie.MoveNext() do - zref := f.Invoke(!zref, ie.Current) - yield !zref } + zref <- f.Invoke(zref, ie.Current) + yield zref } [] let tryFindBack predicate (source : seq<'T>) = @@ -948,21 +950,21 @@ namespace Microsoft.FSharp.Collections [|SR.GetString SR.inputMustBePositive; windowSize|] seq { let arr = Array.zeroCreateUnchecked windowSize - let r = ref (windowSize - 1) - let i = ref 0 + let mutable r =windowSize - 1 + let mutable i = 0 use e = source.GetEnumerator() while e.MoveNext() do - arr.[!i] <- e.Current - i := (!i + 1) % windowSize - if !r = 0 then + arr.[i] <- e.Current + i <- (i + 1) % windowSize + if r = 0 then if windowSize < 32 then - yield Array.init windowSize (fun j -> arr.[(!i+j) % windowSize]) + yield Array.init windowSize (fun j -> arr.[(i+j) % windowSize]) else let result = Array.zeroCreateUnchecked windowSize - Array.Copy(arr, !i, result, 0, windowSize - !i) - Array.Copy(arr, 0, result, windowSize - !i, !i) + Array.Copy(arr, i, result, 0, windowSize - i) + Array.Copy(arr, 0, result, windowSize - i, i) yield result - else r := (!r - 1) + else r <- (r - 1) } [] @@ -978,7 +980,7 @@ namespace Microsoft.FSharp.Collections // * the prefix followed by elts from the enumerator are the initial sequence. // * the prefix contains only as many elements as the longest enumeration so far. let prefix = ResizeArray<_>() - let enumeratorR = ref None : IEnumerator<'T> option option ref // nested options rather than new type... + let enumeratorR = ref None // None = Unstarted. // Some(Some e) = Started. // Some None = Finished. @@ -1014,10 +1016,9 @@ namespace Microsoft.FSharp.Collections let cleanup() = lock enumeratorR (fun () -> prefix.Clear() - begin match !enumeratorR with + match !enumeratorR with | Some (Some e) -> IEnumerator.dispose e | _ -> () - end enumeratorR := None) (new CachedSeq<_>(cleanup, result) :> seq<_>) @@ -1305,9 +1306,9 @@ namespace Microsoft.FSharp.Collections let takeWhile predicate (source: seq<_>) = checkNonNull "source" source seq { use e = source.GetEnumerator() - let latest = ref Unchecked.defaultof<_> - while e.MoveNext() && (latest := e.Current; predicate !latest) do - yield !latest } + let mutable latest = Unchecked.defaultof<_> + while e.MoveNext() && (latest <- e.Current; predicate latest) do + yield latest } [] let skip count (source: seq<_>) = @@ -1324,12 +1325,12 @@ namespace Microsoft.FSharp.Collections let skipWhile predicate (source: seq<_>) = checkNonNull "source" source seq { use e = source.GetEnumerator() - let latest = ref (Unchecked.defaultof<_>) - let ok = ref false + let mutable latest = Unchecked.defaultof<_> + let mutable ok = false while e.MoveNext() do - if (latest := e.Current; (!ok || not (predicate !latest))) then - ok := true - yield !latest } + if (latest <- e.Current; (ok || not (predicate latest))) then + ok <- true + yield latest } [] let forall2 predicate (source1: seq<_>) (source2: seq<_>) = @@ -1469,14 +1470,14 @@ namespace Microsoft.FSharp.Collections let nextChunk() = let res = Array.zeroCreateUnchecked chunkSize res.[0] <- e.Current - let i = ref 1 - while !i < chunkSize && e.MoveNext() do - res.[!i] <- e.Current - i := !i + 1 - if !i = chunkSize then + let mutable i = 1 + while i < chunkSize && e.MoveNext() do + res.[i] <- e.Current + i <- i + 1 + if i = chunkSize then res else - res |> Array.subUnchecked 0 !i + res |> Array.subUnchecked 0 i while e.MoveNext() do yield nextChunk() } diff --git a/src/fsharp/FSharp.Core/seqcore.fs b/src/fsharp/FSharp.Core/seqcore.fs index 05bde3b90d6..bc54d01e670 100644 --- a/src/fsharp/FSharp.Core/seqcore.fs +++ b/src/fsharp/FSharp.Core/seqcore.fs @@ -68,16 +68,16 @@ namespace Microsoft.FSharp.Collections lock r (fun () -> match !r with None -> None | Some _ as res -> r := None; res) let generateWhileSome openf compute closef : IEnumerator<'U> = - let started = ref false - let curr = ref None + let mutable started = false + let mutable curr = None let state = ref (Some(openf())) let getCurr() = - check !started - match !curr with None -> alreadyFinished() | Some x -> x - let start() = if not !started then (started := true) + check started + match curr with None -> alreadyFinished() | Some x -> x + let start() = if not started then (started <- true) let dispose() = readAndClear state |> Option.iter closef - let finish() = try dispose() finally curr := None + let finish() = try dispose() finally curr <- None { new IEnumerator<'U> with member __.Current = getCurr() interface IEnumerator with @@ -89,7 +89,7 @@ namespace Microsoft.FSharp.Collections | Some s -> match (try compute s with e -> finish(); reraise()) with | None -> finish(); false - | Some _ as x -> curr := x; true + | Some _ as x -> curr <- x; true member __.Reset() = noReset() interface System.IDisposable with @@ -306,14 +306,14 @@ namespace Microsoft.FSharp.Core.CompilerServices mkSeq (fun () -> new ConcatEnumerator<_,_>(sources) :> IEnumerator<'T>) let EnumerateWhile (guard: unit -> bool) (source: seq<'T>) : seq<'T> = - let started = ref false - let curr = ref None + let mutable started = false + let mutable curr = None let getCurr() = - IEnumerator.check !started - match !curr with None -> IEnumerator.alreadyFinished() | Some x -> x - let start() = if not !started then (started := true) + IEnumerator.check started + match curr with None -> IEnumerator.alreadyFinished() | Some x -> x + let start() = if not started then (started <- true) - let finish() = (curr := None) + let finish() = (curr <- None) mkConcatSeq (mkSeq (fun () -> { new IEnumerator<_> with @@ -324,7 +324,7 @@ namespace Microsoft.FSharp.Core.CompilerServices start() let keepGoing = (try guard() with e -> finish (); reraise ()) in if keepGoing then - curr := Some(source); true + curr <- Some(source); true else finish(); false member x.Reset() = IEnumerator.noReset() diff --git a/src/fsharp/FSharp.Core/set.fs b/src/fsharp/FSharp.Core/set.fs index 5da5152f296..bd6bb970002 100644 --- a/src/fsharp/FSharp.Core/set.fs +++ b/src/fsharp/FSharp.Core/set.fs @@ -429,13 +429,13 @@ module internal SetTree = not i.stack.IsEmpty let mkIEnumerator s = - let i = ref (mkIterator s) + let mutable i = mkIterator s { new IEnumerator<_> with - member __.Current = current !i + member __.Current = current i interface IEnumerator with - member __.Current = box (current !i) - member __.MoveNext() = moveNext !i - member __.Reset() = i := mkIterator s + member __.Current = box (current i) + member __.MoveNext() = moveNext i + member __.Reset() = i <- mkIterator s interface System.IDisposable with member __.Dispose() = () } @@ -486,8 +486,8 @@ module internal SetTree = loop s [] let copyToArray s (arr: _[]) i = - let j = ref i - iter (fun x -> arr.[!j] <- x; j := !j + 1) s + let mutable j = i + iter (fun x -> arr.[j] <- x; j <- j + 1) s let toArray s = let n = (count s) diff --git a/src/fsharp/LegacyHostedCompilerForTesting.fs b/src/fsharp/LegacyHostedCompilerForTesting.fs index b793915b5c8..821882d84d5 100644 --- a/src/fsharp/LegacyHostedCompilerForTesting.fs +++ b/src/fsharp/LegacyHostedCompilerForTesting.fs @@ -61,20 +61,20 @@ type internal InProcCompiler(legacyReferenceResolver) = let ctok = AssumeCompilationThreadWithoutEvidence () let loggerProvider = InProcErrorLoggerProvider() - let exitCode = ref 0 + let mutable exitCode = 0 let exiter = { new Exiter with - member this.Exit n = exitCode := n; raise StopProcessing } + member this.Exit n = exitCode <- n; raise StopProcessing } try typecheckAndCompile(ctok, argv, legacyReferenceResolver, false, ReduceMemoryFlag.Yes, CopyFSharpCoreFlag.Yes, exiter, loggerProvider.Provider, None, None) with | StopProcessing -> () | ReportedError _ | WrappedError(ReportedError _,_) -> - exitCode := 1 + exitCode <- 1 () let output : CompilationOutput = { Warnings = loggerProvider.CapturedWarnings; Errors = loggerProvider.CapturedErrors } - !exitCode = 0, output + exitCode = 0, output /// in-proc version of fsc.exe type internal FscCompiler(legacyReferenceResolver) = diff --git a/src/fsharp/LegacyMSBuildReferenceResolver.fs b/src/fsharp/LegacyMSBuildReferenceResolver.fs index 8425f6197ba..a07941509ff 100644 --- a/src/fsharp/LegacyMSBuildReferenceResolver.fs +++ b/src/fsharp/LegacyMSBuildReferenceResolver.fs @@ -255,12 +255,12 @@ module LegacyMSBuildReferenceResolver "Software\Microsoft\.NetFramework", "AssemblyFoldersEx" , "" if Array.isEmpty references then [| |] else - let backgroundException = ref false + let mutable backgroundException = false let protect f = - if not !backgroundException then + if not backgroundException then try f() - with _ -> backgroundException := true + with _ -> backgroundException <- true let engine = { new IBuildEngine with diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs index e2d316bd29a..e7630a84ff4 100755 --- a/src/fsharp/LexFilter.fs +++ b/src/fsharp/LexFilter.fs @@ -907,11 +907,11 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, | INFIX_COMPARE_OP " let tokenEndPos = tokenTup.LexbufState.EndPos if isAdjacent tokenTup lookaheadTokenTup then - let stack = ref [] + let mutable stack = [] let rec scanAhead nParen = let lookaheadTokenTup = popNextTokenTup() let lookaheadToken = lookaheadTokenTup.Token - stack := (lookaheadTokenTup, true) :: !stack + stack <- (lookaheadTokenTup, true) :: stack let lookaheadTokenStartPos = startPosOfTokenTup lookaheadTokenTup match lookaheadToken with | Parser.EOF _ | SEMICOLON_SEMICOLON -> false @@ -927,7 +927,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, let hasAfterOp = (match lookaheadToken with GREATER _ -> false | _ -> true) if nParen > 0 then // Don't smash the token if there is an after op and we're in a nested paren - stack := (lookaheadTokenTup, not hasAfterOp) :: (!stack).Tail + stack <- (lookaheadTokenTup, not hasAfterOp) :: stack.Tail scanAhead nParen else // On successful parse of a set of type parameters, look for an adjacent (, e.g. @@ -935,13 +935,13 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // and insert a HIGH_PRECEDENCE_PAREN_APP if not hasAfterOp && (match nextTokenIsAdjacentLParenOrLBrack lookaheadTokenTup with Some LPAREN -> true | _ -> false) then let dotTokenTup = peekNextTokenTup() - stack := (pool.UseLocation(dotTokenTup, HIGH_PRECEDENCE_PAREN_APP), false) :: !stack + stack <- (pool.UseLocation(dotTokenTup, HIGH_PRECEDENCE_PAREN_APP), false) :: stack true | INFIX_COMPARE_OP (TyparsCloseOp(greaters, afterOp)) -> let nParen = nParen - greaters.Length if nParen > 0 then // Don't smash the token if there is an after op and we're in a nested paren - stack := (lookaheadTokenTup, not afterOp.IsSome) :: (!stack).Tail + stack <- (lookaheadTokenTup, not afterOp.IsSome) :: stack.Tail scanAhead nParen else // On successful parse of a set of type parameters, look for an adjacent (, e.g. @@ -949,7 +949,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, // and insert a HIGH_PRECEDENCE_PAREN_APP if afterOp.IsNone && (match nextTokenIsAdjacentLParenOrLBrack lookaheadTokenTup with Some LPAREN -> true | _ -> false) then let dotTokenTup = peekNextTokenTup() - stack := (pool.UseLocation(dotTokenTup, HIGH_PRECEDENCE_PAREN_APP), false) :: !stack + stack <- (pool.UseLocation(dotTokenTup, HIGH_PRECEDENCE_PAREN_APP), false) :: stack true | (LPAREN | LESS _ | LBRACK | LBRACK_LESS | INFIX_COMPARE_OP " scanAhead (nParen+1) @@ -1000,7 +1000,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, let res = scanAhead 0 // Put the tokens back on and smash them up if needed - !stack |> List.iter (fun (tokenTup, smash) -> + stack |> List.iter (fun (tokenTup, smash) -> if smash then match tokenTup.Token with | INFIX_COMPARE_OP " diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 389c6e16b04..30f456fd86c 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -2528,7 +2528,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified ResolveExprLongIdentPrim sink ncenv false FullyQualified m ad nenv typeNameResInfo id2 rest2 isOpenDecl else if isNil rest && fullyQualified <> FullyQualified then - let typeError = ref None + let mutable typeError = None // Single identifier. Lookup the unqualified names in the environment let envSearch = match nenv.eUnqualifiedItems.TryGetValue id.idText with @@ -2549,7 +2549,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified let resInfo, item, rest = ForceRaise res ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) Some(item, rest) - | Exception e -> typeError := Some e; None + | Exception e -> typeError <- Some e; None | true, res -> let fresh = FreshenUnqualifiedItem ncenv m res @@ -2587,7 +2587,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified | Result _ as res -> ForceRaise res | _ -> let failingCase = - match !typeError with + match typeError with | Some e -> raze e | _ -> let suggestNamesAndTypes (addToBuffer: string -> unit) = diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 5a8eaa6534c..6c5cc67e5ac 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -103,16 +103,16 @@ let BindSubExprOfInput g amap gtps (PBind(v, tyscheme)) m (SubExpr(accessf, (ve2 accessf [] ve2 else let tyargs = - let someSolved = ref false + let mutable someSolved = false let freezeVar gtp = if isBeingGeneralized gtp tyscheme then mkTyparTy gtp else - someSolved := true + someSolved <- true TypeRelations.ChooseTyparSolution g amap gtp let solutions = List.map freezeVar gtps - if !someSolved then + if someSolved then TypeRelations.IterativelySubstituteTyparSolutions g gtps solutions else solutions @@ -1268,10 +1268,10 @@ let CompilePatternBasic BindProjectionPatterns newActives s | TPat_range (c1, c2, m) -> - let res = ref [] + let mutable res = [] for i = int c1 to int c2 do - res := BindProjectionPattern (Active(path, subExpr, TPat_const(Const.Char(char i), m))) s @ !res - !res + res <- BindProjectionPattern (Active(path, subExpr, TPat_const(Const.Char(char i), m))) s @ res + res // Assign an identifier to each TPat_query based on our knowledge of the 'identity' of the active pattern, if any | TPat_query ((_, _, apatVrefOpt, _, _), _, _) -> let uniqId = diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 94d0bcffaef..fe30b314d15 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -3348,7 +3348,7 @@ module DebugPrint = | TType_measure unt -> #if DEBUG leftL (tagText "{") ^^ - (match !global_g with + (match global_g with | None -> wordL (tagText "") | Some g -> let sortVars (vs:(Typar * Rational) list) = vs |> List.sortBy (fun (v, _) -> v.DisplayName) @@ -3407,7 +3407,7 @@ module DebugPrint = and auxTraitL env (ttrait: TraitConstraintInfo) = #if DEBUG let (TTrait(tys, nm, memFlags, argtys, rty, _)) = ttrait - match !global_g with + match global_g with | None -> wordL (tagText "") | Some g -> let rty = GetFSharpViewOfReturnType g rty @@ -3527,7 +3527,7 @@ module DebugPrint = let slotSigL (slotsig: SlotSig) = #if DEBUG let (TSlotSig(nm, ty, tps1, tps2, pms, rty)) = slotsig - match !global_g with + match global_g with | None -> wordL(tagText "") | Some g -> let rty = GetFSharpViewOfReturnType g rty @@ -6494,10 +6494,10 @@ let FoldImplFile folders state implFile = ExprFolders(folders).FoldImplFile stat //------------------------------------------------------------------------- let ExprStats x = - let count = ref 0 - let folders = {ExprFolder0 with exprIntercept = (fun _ noInterceptF z x -> (count := !count + 1; noInterceptF z x))} + let mutable count = 0 + let folders = {ExprFolder0 with exprIntercept = (fun _ noInterceptF z x -> (count <- count + 1; noInterceptF z x))} let () = FoldExpr folders () x - string !count + " TExpr nodes" + string count + " TExpr nodes" #endif //------------------------------------------------------------------------- diff --git a/src/fsharp/TastPickle.fs b/src/fsharp/TastPickle.fs index 5098b16ecd0..5b0acbc5174 100644 --- a/src/fsharp/TastPickle.fs +++ b/src/fsharp/TastPickle.fs @@ -554,12 +554,12 @@ let p_maybe_lazy p (x: MaybeLazy<_>) st = p_lazy_impl p x.Value st let p_hole () = - let h = ref (None : ('T -> WriterState -> unit) option) - (fun f -> h := Some f), (fun x st -> match !h with Some f -> f x st | None -> pfailwith st "p_hole: unfilled hole") + let mutable h = None + (fun f -> h <- Some f), (fun x st -> match h with Some f -> f x st | None -> pfailwith st "p_hole: unfilled hole") let p_hole2 () = - let h = ref (None : ('Arg -> 'T -> WriterState -> unit) option) - (fun f -> h := Some f), (fun arg x st -> match !h with Some f -> f arg x st | None -> pfailwith st "p_hole2: unfilled hole") + let mutable h = None + (fun f -> h <- Some f), (fun arg x st -> match h with Some f -> f arg x st | None -> pfailwith st "p_hole2: unfilled hole") let u_array_core f n st = let res = Array.zeroCreate n @@ -675,8 +675,8 @@ let u_lazy u st = let u_hole () = - let h = ref (None : 'T unpickler option) - (fun f -> h := Some f), (fun st -> match !h with Some f -> f st | None -> ufailwith st "u_hole: unfilled hole") + let mutable h = None + (fun f -> h <- Some f), (fun st -> match h with Some f -> f st | None -> ufailwith st "u_hole: unfilled hole") //--------------------------------------------------------------------------- // Pickle/unpickle F# interface data diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs index 339e8b4b7fe..c70a378f6f2 100755 --- a/src/fsharp/TcGlobals.fs +++ b/src/fsharp/TcGlobals.fs @@ -1491,5 +1491,5 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d #if DEBUG // This global is only used during debug output -let global_g = ref (None : TcGlobals option) +let mutable global_g = None : TcGlobals option #endif diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 5c5dae51b8d..76efb55e44e 100644 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -3783,11 +3783,11 @@ let EliminateInitializationGraphs hash // The output of the analysis - let outOfOrder = ref false - let runtimeChecks = ref false - let directRecursiveData = ref false - let reportedEager = ref false - let definiteDependencies = ref [] + let mutable outOfOrder = false + let mutable runtimeChecks = false + let mutable directRecursiveData = false + let mutable reportedEager = false + let mutable definiteDependencies = [] let rec stripChooseAndExpr e = match stripExpr e with @@ -3883,21 +3883,21 @@ let EliminateInitializationGraphs | MaybeLazy -> if recursiveVals.TryFind v.Deref |> Option.isSome then warning (RecursiveUseCheckedAtRuntime (denv, v, m)) - if not !reportedEager then - (warning (LetRecCheckedAtRuntime m); reportedEager := true) - runtimeChecks := true + if not reportedEager then + (warning (LetRecCheckedAtRuntime m); reportedEager <- true) + runtimeChecks <- true | Top | DefinitelyStrict -> if recursiveVals.TryFind v.Deref |> Option.isSome then if availIfInOrder.TryFind v.Deref |> Option.isNone then warning (LetRecEvaluatedOutOfOrder (denv, boundv, v, m)) - outOfOrder := true - if not !reportedEager then - (warning (LetRecCheckedAtRuntime m); reportedEager := true) - definiteDependencies := (boundv, v) :: !definiteDependencies + outOfOrder <- true + if not reportedEager then + (warning (LetRecCheckedAtRuntime m); reportedEager <- true) + definiteDependencies <- (boundv, v) :: definiteDependencies | InnerTop -> if recursiveVals.TryFind v.Deref |> Option.isSome then - directRecursiveData := true + directRecursiveData <- true | DefinitelyLazy -> () and checkDelayed st b = match st with @@ -3919,11 +3919,11 @@ let EliminateInitializationGraphs // ddg = definiteDependencyGraph let ddgNodes = recursiveVals.Values |> Seq.toList |> List.map mkLocalValRef - let ddg = Graph((fun v -> v.Stamp), ddgNodes, !definiteDependencies ) + let ddg = Graph((fun v -> v.Stamp), ddgNodes, definiteDependencies ) ddg.IterateCycles (fun path -> error (LetRecUnsound (denv, path, path.Head.Range))) - let requiresLazyBindings = !runtimeChecks || !outOfOrder - if !directRecursiveData && requiresLazyBindings then + let requiresLazyBindings = runtimeChecks || outOfOrder + if directRecursiveData && requiresLazyBindings then error(Error(FSComp.SR.tcInvalidMixtureOfRecursiveForms(), bindsm)) if requiresLazyBindings then @@ -5176,9 +5176,9 @@ and ValidateOptArgOrder (spats: SynSimplePats) = let pats, m = getPats spats - let hitOptArg = ref false + let mutable hitOptArg = false - List.iter (fun pat -> if isOptArg pat then hitOptArg := true elif !hitOptArg then error(Error(FSComp.SR.tcOptionalArgsMustComeAfterNonOptionalArgs(), m))) pats + List.iter (fun pat -> if isOptArg pat then hitOptArg <- true elif hitOptArg then error(Error(FSComp.SR.tcOptionalArgsMustComeAfterNonOptionalArgs(), m))) pats /// Bind the patterns used in argument position for a function, method or lambda. @@ -5948,10 +5948,10 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) = // Always allow subsumption if a nominal type is known prior to type checking any arguments let flex = not (isTyparTy cenv.g argty) - let first = ref true + let mutable first = true let getInitEnv m = - if !first then - first := false + if first then + first <- false env else { env with eContextInfo = ContextInfo.CollectionElement (isArray, m) } @@ -10524,8 +10524,8 @@ and TcMatchPattern cenv inputTy env tpenv (pat: SynPat, optWhenExpr) = patf' (TcPatPhase2Input (values, true)), optWhenExpr', NameMap.range vspecMap, envinner, tpenv and TcMatchClauses cenv inputTy resultTy env tpenv clauses = - let first = ref true - let isFirst() = if !first then first := false; true else false + let mutable first = true + let isFirst() = if first then first <- false; true else false List.mapFold (fun clause -> TcMatchClause cenv inputTy resultTy env (isFirst()) clause) tpenv clauses and TcMatchClause cenv inputTy resultTy env isFirst tpenv (Clause(pat, optWhenExpr, e, patm, spTgt)) = @@ -14456,7 +14456,7 @@ module TyconConstraintInference = // Repeatedly eliminate structural type definitions whose structural component types no longer support // comparison. On the way record type variables which are support the comparison relation. let rec loop (assumedTycons: Set) (assumedTypars: Set) = - let assumedTyparsAcc = ref assumedTypars + let mutable assumedTyparsAcc = assumedTypars // Checks if a field type supports the 'comparison' constraint based on the assumptions about the type constructors // and type parameters. @@ -14472,7 +14472,7 @@ module TyconConstraintInference = // Within structural types, type parameters can be optimistically assumed to have comparison // We record the ones for which we have made this assumption. elif tycon.TyparsNoRange |> List.exists (fun tp2 -> typarRefEq tp tp2) then - assumedTyparsAcc := (!assumedTyparsAcc).Add(tp.Stamp) + assumedTyparsAcc <- assumedTyparsAcc.Add(tp.Stamp) true else @@ -14552,10 +14552,10 @@ module TyconConstraintInference = res) - if newSet = assumedTycons && assumedTypars = !assumedTyparsAcc then - newSet, !assumedTyparsAcc + if newSet = assumedTycons && assumedTypars = assumedTyparsAcc then + newSet, assumedTyparsAcc else - loop newSet !assumedTyparsAcc + loop newSet assumedTyparsAcc let uneliminatedTycons, assumedTyparsActual = loop initialAssumedTycons initialAssumedTypars @@ -14587,7 +14587,7 @@ module TyconConstraintInference = // Repeatedly eliminate structural type definitions whose structural component types no longer support // equality. On the way add type variables which are support the equality relation let rec loop (assumedTycons: Set) (assumedTypars: Set) = - let assumedTyparsAcc = ref assumedTypars + let mutable assumedTyparsAcc = assumedTypars // Checks if a field type supports the 'equality' constraint based on the assumptions about the type constructors // and type parameters. @@ -14601,7 +14601,7 @@ module TyconConstraintInference = // Within structural types, type parameters can be optimistically assumed to have equality // We record the ones for which we have made this assumption. elif tycon.Typars(tycon.Range) |> List.exists (fun tp2 -> typarRefEq tp tp2) then - assumedTyparsAcc := (!assumedTyparsAcc).Add(tp.Stamp) + assumedTyparsAcc <- assumedTyparsAcc.Add(tp.Stamp) true else false @@ -14681,10 +14681,10 @@ module TyconConstraintInference = res) - if newSet = assumedTycons && assumedTypars = !assumedTyparsAcc then - newSet, !assumedTyparsAcc + if newSet = assumedTycons && assumedTypars = assumedTyparsAcc then + newSet, assumedTyparsAcc else - loop newSet !assumedTyparsAcc + loop newSet assumedTyparsAcc let uneliminatedTycons, assumedTyparsActual = loop initialAssumedTycons initialAssumedTypars @@ -17157,7 +17157,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem | SynModuleDecl.NamespaceFragment(SynModuleOrNamespace(longId, isRec, kind, defs, xml, attribs, vis, m)) -> - if !progress then dprintn ("Typecheck implementation " + textOfLid longId) + if progress then dprintn ("Typecheck implementation " + textOfLid longId) let endm = m.EndRange do for id in longId do diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index f5a8382505a..fa01b51673f 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -2229,7 +2229,7 @@ let noInferredTypars = SynValTyparDecls([], false, []) type LexerIfdefStackEntry = IfDefIf | IfDefElse type LexerIfdefStackEntries = (LexerIfdefStackEntry * range) list -type LexerIfdefStack = LexerIfdefStackEntries ref +type LexerIfdefStack = LexerIfdefStackEntries /// Specifies how the 'endline' function in the lexer should continue after /// it reaches end of line or eof. The options are to continue with 'token' function diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index ba9e1bcd8d2..17c8a219314 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -209,13 +209,13 @@ let AdjustForScriptCompile(ctok, tcConfigB: TcConfigBuilder, commandLineSourceFi commandLineSourceFiles |> List.map combineFilePath - let allSources = ref [] + let mutable allSources = [] let tcConfig = TcConfig.Create(tcConfigB, validate=false) let AddIfNotPresent(filename: string) = - if not(!allSources |> List.contains filename) then - allSources := filename :: !allSources + if not(allSources |> List.contains filename) then + allSources <- filename :: allSources let AppendClosureInformation filename = if IsScript filename then @@ -240,16 +240,16 @@ let AdjustForScriptCompile(ctok, tcConfigB: TcConfigBuilder, commandLineSourceFi // Find closure of .fsx files. commandLineSourceFiles |> List.iter AppendClosureInformation - List.rev !allSources + List.rev allSources let ProcessCommandLineFlags (tcConfigB: TcConfigBuilder, setProcessThreadLocals, lcidFromCodePage, argv) = - let inputFilesRef = ref ([] : string list) + let mutable inputFilesRef = [] let collect name = let lower = String.lowercase name if List.exists (Filename.checkSuffix lower) [".resx"] then error(Error(FSComp.SR.fscResxSourceFileDeprecated name, rangeStartup)) else - inputFilesRef := name :: !inputFilesRef + inputFilesRef <- name :: inputFilesRef let abbrevArgs = GetAbbrevFlagSet tcConfigB true // This is where flags are interpreted by the command line fsc.exe. @@ -268,7 +268,7 @@ let ProcessCommandLineFlags (tcConfigB: TcConfigBuilder, setProcessThreadLocals, if tcConfigB.pathMap <> PathMap.empty then error(Error(FSComp.SR.fscPathMapDebugRequiresPortablePdb(), rangeCmdArgs)) - let inputFiles = List.rev !inputFilesRef + let inputFiles = List.rev inputFilesRef // Check if we have a codepage from the console match tcConfigB.lcid with @@ -381,11 +381,11 @@ module XmlDocWriter = if not (Filename.hasSuffixCaseInsensitive "xml" xmlfile ) then error(Error(FSComp.SR.docfileNoXmlSuffix(), Range.rangeStartup)) (* the xmlDocSigOf* functions encode type into string to be used in "id" *) - let members = ref [] + let mutable members = [] let addMember id xmlDoc = if hasDoc xmlDoc then let doc = getDoc xmlDoc - members := (id, doc) :: !members + members <- (id, doc) :: members let doVal (v: Val) = addMember v.XmlDocSig v.XmlDoc let doUnionCase (uc: UnionCase) = addMember uc.XmlDocSig uc.XmlDoc let doField (rf: RecdField) = addMember rf.XmlDocSig rf.XmlDoc @@ -422,7 +422,7 @@ module XmlDocWriter = fprintfn os ("") fprintfn os ("%s") assemblyName fprintfn os ("") - !members |> List.iter (fun (id, doc) -> + members |> List.iter (fun (id, doc) -> fprintfn os "" id fprintfn os "%s" doc fprintfn os "") @@ -1298,10 +1298,10 @@ module StaticLinker = let assumedIndependentSet = set [ "mscorlib"; "System"; "System.Core"; "System.Xml"; "Microsoft.Build.Framework"; "Microsoft.Build.Utilities" ] begin - let remaining = ref (computeILRefs ilxMainModule).AssemblyReferences - while not (isNil !remaining) do - let ilAssemRef = List.head !remaining - remaining := List.tail !remaining + let mutable remaining = (computeILRefs ilxMainModule).AssemblyReferences + while not (isNil remaining) do + let ilAssemRef = List.head remaining + remaining <- List.tail remaining if assumedIndependentSet.Contains ilAssemRef.Name || (ilAssemRef.PublicKey = Some ecmaPublicKey) then depModuleTable.[ilAssemRef.Name] <- dummyEntry ilAssemRef.Name else @@ -1358,7 +1358,7 @@ module StaticLinker = visited = false } // Push the new work items - remaining := refs.AssemblyReferences @ !remaining + remaining <- refs.AssemblyReferences @ remaining | None -> warning(Error(FSComp.SR.fscAssumeStaticLinkContainsNoDependencies(ilAssemRef.Name), rangeStartup)) @@ -1384,14 +1384,14 @@ module StaticLinker = | None -> error(Error(FSComp.SR.fscAssemblyNotFoundInDependencySet n, rangeStartup)) ] - let remaining = ref roots - [ while not (isNil !remaining) do - let n = List.head !remaining - remaining := List.tail !remaining + let mutable remaining = roots + [ while not (isNil remaining) do + let n = List.head remaining + remaining <- List.tail remaining if not n.visited then if verbose then dprintn ("Module "+n.name+" depends on "+GetFSharpCoreLibraryName()) n.visited <- true - remaining := n.edges @ !remaining + remaining <- n.edges @ remaining yield (n.ccu, n.data) ] // Add all provider-generated assemblies into the static linking set diff --git a/src/fsharp/fsi/console.fs b/src/fsharp/fsi/console.fs index 04147be7696..0ffab65b355 100644 --- a/src/fsharp/fsi/console.fs +++ b/src/fsharp/fsi/console.fs @@ -215,13 +215,13 @@ type internal ReadLineConsole() = checkLeftEdge true /// Cursor anchor - position of !anchor when the routine was called - let anchor = ref (Anchor.Current x.Inset) + let mutable anchor = Anchor.Current x.Inset /// Length of the output currently rendered on screen. - let rendered = ref 0 + let mutable rendered = 0 /// Input has changed, therefore options cache is invalidated. - let changed = ref false + let mutable changed = false /// Cache of optionsCache - let optionsCache = ref (new Options()) + let mutable optionsCache = Options() let writeBlank() = Console.Write(' ') @@ -229,26 +229,26 @@ type internal ReadLineConsole() = let writeChar(c) = if Console.CursorTop = Console.BufferHeight - 1 && Console.CursorLeft = Console.BufferWidth - 1 then //printf "bottom right!\n" - anchor := { !anchor with top = (!anchor).top - 1 } + anchor <- { anchor with top = (anchor).top - 1 } checkLeftEdge true if (Char.IsControl(c)) then let s = x.MapCharacter(c) Console.Write(s) - rendered := !rendered + s.Length + rendered <- rendered + s.Length else Console.Write(c) - rendered := !rendered + 1 + rendered <- rendered + 1 checkLeftEdge true /// The console input buffer. let input = new StringBuilder() /// Current position - index into the input buffer - let current = ref 0 + let mutable current = 0 let render() = //printf "render\n" - let curr = !current - (!anchor).PlaceAt(x.Inset,0) + let curr = current + anchor.PlaceAt(x.Inset,0) let output = new StringBuilder() let mutable position = -1 for i = 0 to input.Length - 1 do @@ -264,59 +264,59 @@ type internal ReadLineConsole() = position <- output.Length // render the current text, computing a new value for "rendered" - let old_rendered = !rendered - rendered := 0 + let old_rendered = rendered + rendered <- 0 for i = 0 to input.Length - 1 do writeChar(input.Chars(i)) // blank out any dangling old text - for i = !rendered to old_rendered - 1 do + for i = rendered to old_rendered - 1 do writeBlank() - (!anchor).PlaceAt(x.Inset,position) + anchor.PlaceAt(x.Inset,position) render() let insertChar(c:char) = - if (!current = input.Length) then - current := !current + 1 + if (current = input.Length) then + current <- current + 1 input.Append(c) |> ignore writeChar(c) else - input.Insert(!current, c) |> ignore - current := !current + 1 + input.Insert(current, c) |> ignore + current <- current + 1 render() let insertTab() = - for i = ReadLineConsole.TabSize - (!current % ReadLineConsole.TabSize) downto 1 do + for i = ReadLineConsole.TabSize - (current % ReadLineConsole.TabSize) downto 1 do insertChar(' ') let moveLeft() = - if (!current > 0 && (!current - 1 < input.Length)) then - current := !current - 1 - let c = input.Chars(!current) + if (current > 0 && (current - 1 < input.Length)) then + current <- current - 1 + let c = input.Chars(current) Cursor.Move(x.Inset, - x.GetCharacterSize(c)) let moveRight() = - if (!current < input.Length) then - let c = input.Chars(!current) - current := !current + 1 + if (current < input.Length) then + let c = input.Chars(current) + current <- current + 1 Cursor.Move(x.Inset, x.GetCharacterSize(c)) let setInput(line:string) = input.Length <- 0 input.Append(line) |> ignore - current := input.Length + current <- input.Length render() let tabPress(shift) = let opts,prefix = - if !changed then - changed := false + if changed then + changed <- false x.GetOptions(input.ToString()) else - !optionsCache,false - optionsCache := opts + optionsCache,false + optionsCache <- opts if (opts.Count > 0) then let part = @@ -331,13 +331,13 @@ type internal ReadLineConsole() = insertTab() let delete() = - if (input.Length > 0 && !current < input.Length) then - input.Remove(!current, 1) |> ignore + if (input.Length > 0 && current < input.Length) then + input.Remove(current, 1) |> ignore render() let deleteToEndOfLine() = - if (!current < input.Length) then - input.Remove (!current, input.Length - !current) |> ignore + if (current < input.Length) then + input.Remove (current, input.Length - current) |> ignore render() let insert(key: ConsoleKeyInfo) = @@ -349,9 +349,9 @@ type internal ReadLineConsole() = insertChar(c) let backspace() = - if (input.Length > 0 && !current > 0) then - input.Remove(!current - 1, 1) |> ignore - current := !current - 1 + if (input.Length > 0 && current > 0) then + input.Remove(current - 1, 1) |> ignore + current <- current - 1 render() let enter() = @@ -394,24 +394,24 @@ type internal ReadLineConsole() = setInput String.Empty change() | ConsoleKey.Home -> - current := 0 - (!anchor).PlaceAt(x.Inset,0) + current <- 0 + anchor.PlaceAt(x.Inset,0) change() | ConsoleKey.End -> - current := input.Length - (!anchor).PlaceAt(x.Inset,!rendered) + current <- input.Length + anchor.PlaceAt(x.Inset,rendered) change() | _ -> match (key.Modifiers, key.KeyChar) with // Control-A | (ConsoleModifiers.Control, '\001') -> - current := 0 - (!anchor).PlaceAt(x.Inset,0) + current <- 0 + anchor.PlaceAt(x.Inset,0) change () // Control-E | (ConsoleModifiers.Control, '\005') -> - current := input.Length - (!anchor).PlaceAt(x.Inset,!rendered) + current <-input.Length + anchor.PlaceAt(x.Inset,rendered) change () // Control-B | (ConsoleModifiers.Control, '\002') -> @@ -452,6 +452,6 @@ type internal ReadLineConsole() = read() and change() = - changed := true + changed <- true read() read() diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 60f53b3964f..f4443411602 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -788,7 +788,7 @@ let internal SetCurrentUICultureForThread (lcid : int option) = //---------------------------------------------------------------------------- let internal InstallErrorLoggingOnThisThread errorLogger = - if !progress then dprintfn "Installing logger on id=%d name=%s" Thread.CurrentThread.ManagedThreadId Thread.CurrentThread.Name + if progress then dprintfn "Installing logger on id=%d name=%s" Thread.CurrentThread.ManagedThreadId Thread.CurrentThread.Name SetThreadErrorLoggerNoUnwind(errorLogger) SetThreadBuildPhaseNoUnwind(BuildPhase.Interactive) @@ -798,7 +798,7 @@ let internal SetServerCodePages(fsiOptions: FsiCommandLineOptions) = match fsiOptions.FsiServerInputCodePage, fsiOptions.FsiServerOutputCodePage with | None,None -> () | inputCodePageOpt,outputCodePageOpt -> - let successful = ref false + let mutable successful = false Async.Start (async { do match inputCodePageOpt with | None -> () | Some(n:int) -> @@ -813,9 +813,9 @@ let internal SetServerCodePages(fsiOptions: FsiCommandLineOptions) = // Note this modifies the real honest-to-goodness settings for the current shell. // and the modifications hang around even after the process has exited. Console.OutputEncoding <- encoding - do successful := true }); + do successful <- true }); for pause in [10;50;100;1000;2000;10000] do - if not !successful then + if not successful then Thread.Sleep(pause); #if LOGGING_GUI if not !successful then @@ -871,17 +871,17 @@ type internal FsiConsoleInput(fsi: FsiEvaluationSessionHostConfig, fsiOptions: F match consoleOpt with | Some console when fsiOptions.EnableConsoleKeyProcessing && not fsiOptions.IsInteractiveServer -> if List.isEmpty fsiOptions.SourceFiles then - if !progress then fprintfn outWriter "first-line-reader-thread reading first line..."; + if progress then fprintfn outWriter "first-line-reader-thread reading first line..."; firstLine <- Some(console()); - if !progress then fprintfn outWriter "first-line-reader-thread got first line = %A..." firstLine; + if progress then fprintfn outWriter "first-line-reader-thread got first line = %A..." firstLine; consoleReaderStartupDone.Set() |> ignore - if !progress then fprintfn outWriter "first-line-reader-thread has set signal and exited." ; + if progress then fprintfn outWriter "first-line-reader-thread has set signal and exited." ; | _ -> ignore(inReader.Peek()); consoleReaderStartupDone.Set() |> ignore )).Start() else - if !progress then fprintfn outWriter "first-line-reader-thread not in use." + if progress then fprintfn outWriter "first-line-reader-thread not in use." consoleReaderStartupDone.Set() |> ignore /// Try to get the first line, if we snarfed it while probing. @@ -969,7 +969,7 @@ type internal FsiDynamicCompiler /// Add attributes let CreateModuleFragment (tcConfigB: TcConfigBuilder, assemblyName, codegenResults) = - if !progress then fprintfn fsiConsoleOutput.Out "Creating main module..."; + if progress then fprintfn fsiConsoleOutput.Out "Creating main module..."; let mainModule = mkILSimpleModule assemblyName (GetGeneratedILModuleName tcConfigB.target assemblyName) (tcConfigB.target = CompilerTarget.Dll) tcConfigB.subsystemVersion tcConfigB.useHighEntropyVA (mkILTypeDefs codegenResults.ilTypeDefs) None None 0x0 (mkILExportedTypes []) "" { mainModule with Manifest = @@ -1413,7 +1413,7 @@ type internal FsiInterruptController(fsiOptions: FsiCommandLineOptions, fsiConso // Also sleep to give computations a bit of time to terminate Thread.Sleep(pauseMilliseconds) if (killThreadRequest = ThreadAbortRequest) then - if !progress then fsiConsoleOutput.uprintnfn "%s" (FSIstrings.SR.fsiAbortingMainThread()) + if progress then fsiConsoleOutput.uprintnfn "%s" (FSIstrings.SR.fsiAbortingMainThread()) killThreadRequest <- NoRequest threadToKill.Abort() ()),Name="ControlCAbortThread") @@ -1504,7 +1504,7 @@ module internal MagicAssemblyResolution = // Grab the name of the assembly let tcConfig = TcConfig.Create(tcConfigB,validate=false) let simpleAssemName = fullAssemName.Split([| ',' |]).[0] - if !progress then fsiConsoleOutput.uprintfn "ATTEMPT MAGIC LOAD ON ASSEMBLY, simpleAssemName = %s" simpleAssemName // "Attempting to load a dynamically required assembly in response to an AssemblyResolve event by using known static assembly references..." + if progress then fsiConsoleOutput.uprintfn "ATTEMPT MAGIC LOAD ON ASSEMBLY, simpleAssemName = %s" simpleAssemName // "Attempting to load a dynamically required assembly in response to an AssemblyResolve event by using known static assembly references..." // Special case: Mono Windows Forms attempts to load an assembly called something like "Windows.Forms.resources" // We can't resolve this, so don't try. @@ -1545,12 +1545,12 @@ module internal MagicAssemblyResolution = | OkResult (warns, [r]) -> OkResult (warns, Choice1Of2 r.resolvedPath) | _ -> - if !progress then fsiConsoleOutput.uprintfn "ATTEMPT LOAD, assemblyReferenceTextDll = %s" assemblyReferenceTextDll + if progress then fsiConsoleOutput.uprintfn "ATTEMPT LOAD, assemblyReferenceTextDll = %s" assemblyReferenceTextDll /// Take a look through the files quoted, perhaps with explicit paths let searchResult = (tcConfig.referencedDLLs |> List.tryPick (fun assemblyReference -> - if !progress then fsiConsoleOutput.uprintfn "ATTEMPT MAGIC LOAD ON FILE, referencedDLL = %s" assemblyReference.Text + if progress then fsiConsoleOutput.uprintfn "ATTEMPT MAGIC LOAD ON FILE, referencedDLL = %s" assemblyReference.Text if System.String.Compare(Filename.fileNameOfPath assemblyReference.Text, assemblyReferenceTextDll,StringComparison.OrdinalIgnoreCase) = 0 || System.String.Compare(Filename.fileNameOfPath assemblyReference.Text, assemblyReferenceTextExe,StringComparison.OrdinalIgnoreCase) = 0 then Some(tcImports.TryResolveAssemblyReference (ctok, assemblyReference, ResolveAssemblyReferenceMode.Speculative)) @@ -1628,7 +1628,7 @@ type internal FsiStdinLexerProvider inputOption |> Option.iter (fun t -> fsiStdinSyphon.Add (t + "\n")) match inputOption with | Some(null) | None -> - if !progress then fprintfn fsiConsoleOutput.Out "End of file from TextReader.ReadLine" + if progress then fprintfn fsiConsoleOutput.Out "End of file from TextReader.ReadLine" 0 | Some (input:string) -> let input = input + "\n" @@ -1655,7 +1655,7 @@ type internal FsiStdinLexerProvider Lexhelp.resetLexbufPos sourceFileName lexbuf let skip = true // don't report whitespace from lexer let defines = "INTERACTIVE"::tcConfigB.conditionalCompilationDefines - let lexargs = mkLexargs (sourceFileName,defines, interactiveInputLightSyntaxStatus, lexResourceManager, ref [], errorLogger, PathMap.empty) + let lexargs = mkLexargs (sourceFileName,defines, interactiveInputLightSyntaxStatus, lexResourceManager, [], errorLogger, PathMap.empty) let tokenizer = LexFilter.LexFilter(interactiveInputLightSyntaxStatus, tcConfigB.compilingFslib, Lexer.token lexargs skip, lexbuf) tokenizer @@ -1756,15 +1756,15 @@ type internal FsiInteractionProcessor /// Parse one interaction. Called on the parser thread. let ParseInteraction (tokenizer:LexFilter.LexFilter) = - let lastToken = ref Parser.ELSE // Any token besides SEMICOLON_SEMICOLON will do for initial value + let mutable lastToken = Parser.ELSE // Any token besides SEMICOLON_SEMICOLON will do for initial value try - if !progress then fprintfn fsiConsoleOutput.Out "In ParseInteraction..." + if progress then fprintfn fsiConsoleOutput.Out "In ParseInteraction..." let input = Lexhelp.reusingLexbufForParsing tokenizer.LexBuffer (fun () -> let lexerWhichSavesLastToken lexbuf = let tok = tokenizer.Lexer lexbuf - lastToken := tok + lastToken <- tok tok Parser.interaction lexerWhichSavesLastToken tokenizer.LexBuffer) Some input @@ -1772,7 +1772,7 @@ type internal FsiInteractionProcessor // On error, consume tokens until to ;; or EOF. // Caveat: Unless the error parse ended on ;; - so check the lastToken returned by the lexer function. // Caveat: What if this was a look-ahead? That's fine! Since we need to skip to the ;; anyway. - if (match !lastToken with Parser.SEMICOLON_SEMICOLON -> false | _ -> true) then + if (match lastToken with Parser.SEMICOLON_SEMICOLON -> false | _ -> true) then let mutable tok = Parser.ELSE (* <-- any token <> SEMICOLON_SEMICOLON will do *) while (match tok with Parser.SEMICOLON_SEMICOLON -> false | _ -> true) && not tokenizer.LexBuffer.IsPastEndOfStream do @@ -1942,7 +1942,7 @@ type internal FsiInteractionProcessor let mainThreadProcessAction ctok action istate = try let tcConfig = TcConfig.Create(tcConfigB,validate=false) - if !progress then fprintfn fsiConsoleOutput.Out "In mainThreadProcessAction..."; + if progress then fprintfn fsiConsoleOutput.Out "In mainThreadProcessAction..."; fsiInterruptController.InterruptAllowed <- InterruptCanRaiseException; let res = action ctok tcConfig istate fsiInterruptController.ClearInterruptRequest() @@ -2010,19 +2010,19 @@ type internal FsiInteractionProcessor fsiConsolePrompt.Print(); istate |> InteractiveCatch errorLogger (fun istate -> - if !progress then fprintfn fsiConsoleOutput.Out "entering ParseInteraction..."; + if progress then fprintfn fsiConsoleOutput.Out "entering ParseInteraction..."; // Parse the interaction. When FSI.EXE is waiting for input from the console the // parser thread is blocked somewhere deep this call. let action = ParseInteraction tokenizer - if !progress then fprintfn fsiConsoleOutput.Out "returned from ParseInteraction...calling runCodeOnMainThread..."; + if progress then fprintfn fsiConsoleOutput.Out "returned from ParseInteraction...calling runCodeOnMainThread..."; // After we've unblocked and got something to run we switch // over to the run-thread (e.g. the GUI thread) let res = istate |> runCodeOnMainThread (fun ctok istate -> mainThreadProcessParsedInteractions ctok errorLogger (action, istate) cancellationToken) - if !progress then fprintfn fsiConsoleOutput.Out "Just called runCodeOnMainThread, res = %O..." res; + if progress then fprintfn fsiConsoleOutput.Out "Just called runCodeOnMainThread, res = %O..." res; res) member __.CurrentState = currState @@ -2137,7 +2137,7 @@ type internal FsiInteractionProcessor // member processor.StartStdinReadAndProcessThread (errorLogger) = - if !progress then fprintfn fsiConsoleOutput.Out "creating stdinReaderThread"; + if progress then fprintfn fsiConsoleOutput.Out "creating stdinReaderThread"; let stdinReaderThread = new Thread(new ThreadStart(fun () -> @@ -2146,12 +2146,12 @@ type internal FsiInteractionProcessor try try let initialTokenizer = fsiStdinLexerProvider.CreateStdinLexer(errorLogger) - if !progress then fprintfn fsiConsoleOutput.Out "READER: stdin thread started..."; + if progress then fprintfn fsiConsoleOutput.Out "READER: stdin thread started..."; // Delay until we've peeked the input or read the entire first line fsiStdinLexerProvider.ConsoleInput.WaitForInitialConsoleInput() - if !progress then fprintfn fsiConsoleOutput.Out "READER: stdin thread got first line..."; + if progress then fprintfn fsiConsoleOutput.Out "READER: stdin thread got first line..."; let runCodeOnMainThread = runCodeOnEventLoop errorLogger @@ -2172,12 +2172,12 @@ type internal FsiInteractionProcessor loop initialTokenizer - if !progress then fprintfn fsiConsoleOutput.Out "- READER: Exiting stdinReaderThread"; + if progress then fprintfn fsiConsoleOutput.Out "- READER: Exiting stdinReaderThread"; with e -> stopProcessingRecovery e range0; finally - if !progress then fprintfn fsiConsoleOutput.Out "- READER: Exiting process because of failure/exit on stdinReaderThread"; + if progress then fprintfn fsiConsoleOutput.Out "- READER: Exiting process because of failure/exit on stdinReaderThread"; // REVIEW: On some flavors of Mono, calling exit may freeze the process if we're using the WinForms event handler // Basically, on Mono 2.6.3, the GUI thread may be left dangling on exit. At that point: // -- System.Environment.Exit will cause the process to stop responding @@ -2200,7 +2200,7 @@ type internal FsiInteractionProcessor ),Name="StdinReaderThread") - if !progress then fprintfn fsiConsoleOutput.Out "MAIN: starting stdin thread..." + if progress then fprintfn fsiConsoleOutput.Out "MAIN: starting stdin thread..." stdinReaderThread.Start() member __.CompletionsForPartialLID (istate, prefix:string) = @@ -2256,11 +2256,11 @@ let internal SpawnInteractiveServer /// This gives us a last chance to catch an abort on the main execution thread. let internal DriveFsiEventLoop (fsi: FsiEvaluationSessionHostConfig, fsiConsoleOutput: FsiConsoleOutput) = let rec runLoop() = - if !progress then fprintfn fsiConsoleOutput.Out "GUI thread runLoop"; + if progress then fprintfn fsiConsoleOutput.Out "GUI thread runLoop"; let restart = try // BLOCKING POINT: The GUI Thread spends most (all) of its time this event loop - if !progress then fprintfn fsiConsoleOutput.Out "MAIN: entering event loop..."; + if progress then fprintfn fsiConsoleOutput.Out "MAIN: entering event loop..."; fsi.EventLoopRun() with | :? ThreadAbortException -> @@ -2274,7 +2274,7 @@ let internal DriveFsiEventLoop (fsi: FsiEvaluationSessionHostConfig, fsiConsoleO stopProcessingRecovery e range0; true // Try again, just case we can restart - if !progress then fprintfn fsiConsoleOutput.Out "MAIN: exited event loop..."; + if progress then fprintfn fsiConsoleOutput.Out "MAIN: exited event loop..."; if restart then runLoop() runLoop(); @@ -2656,7 +2656,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i [] member x.Run() = - progress := condition "FSHARP_INTERACTIVE_PROGRESS" + progress <- condition "FSHARP_INTERACTIVE_PROGRESS" // Explanation: When Run is called we do a bunch of processing. For fsi.exe // and fsiAnyCpu.exe there are no other active threads at this point, so we can assume this is the @@ -2674,7 +2674,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i if fsiOptions.Interact then // page in the type check env fsiInteractionProcessor.LoadDummyInteraction(ctokStartup, errorLogger) - if !progress then fprintfn fsiConsoleOutput.Out "MAIN: InstallKillThread!"; + if progress then fprintfn fsiConsoleOutput.Out "MAIN: InstallKillThread!"; // Compute how long to pause before a ThreadAbort is actually executed. // A somewhat arbitrary choice. @@ -2682,7 +2682,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i // Request that ThreadAbort interrupts be performed on this (current) thread fsiInterruptController.InstallKillThread(Thread.CurrentThread, pauseMilliseconds) - if !progress then fprintfn fsiConsoleOutput.Out "MAIN: got initial state, creating form"; + if progress then fprintfn fsiConsoleOutput.Out "MAIN: got initial state, creating form"; #if !FX_NO_APP_DOMAINS // Route background exceptions to the exception handlers @@ -2699,10 +2699,10 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i DriveFsiEventLoop (fsi, fsiConsoleOutput ) else // not interact - if !progress then fprintfn fsiConsoleOutput.Out "Run: not interact, loading initial files..." + if progress then fprintfn fsiConsoleOutput.Out "Run: not interact, loading initial files..." fsiInteractionProcessor.LoadInitialFiles(ctokRun, errorLogger) - if !progress then fprintfn fsiConsoleOutput.Out "Run: done..." + if progress then fprintfn fsiConsoleOutput.Out "Run: done..." exit (min errorLogger.ErrorCount 1) // The Ctrl-C exception handler that we've passed to native code has diff --git a/src/fsharp/fsi/fsimain.fs b/src/fsharp/fsi/fsimain.fs index 653485ac18b..3fdf044f782 100644 --- a/src/fsharp/fsi/fsimain.fs +++ b/src/fsharp/fsi/fsimain.fs @@ -65,13 +65,13 @@ type WinFormsEventLoop() = do mainForm.DoCreateHandle() let mutable lcid = None // Set the default thread exception handler - let restart = ref false + let mutable restart = false member __.LCID with get () = lcid and set v = lcid <- v interface IEventLoop with member x.Run() = - restart := false + restart <- false Application.Run() - !restart + restart member x.Invoke (f: unit -> 'T) : 'T = if not mainForm.InvokeRequired then f() @@ -79,7 +79,7 @@ type WinFormsEventLoop() = // Workaround: Mono's Control.Invoke returns a null result. Hence avoid the problem by // transferring the resulting state using a mutable location. - let mainFormInvokeResultHolder = ref None + let mutable mainFormInvokeResultHolder = None // Actually, Mono's Control.Invoke isn't even blocking (or wasn't on 1.1.15)! So use a signal to indicate completion. // Indeed, we should probably do this anyway with a timeout so we can report progress from @@ -94,7 +94,7 @@ type WinFormsEventLoop() = // When we get called back, someone may jack our culture // So we must reset our UI culture every time use _scope = SetCurrentUICultureForThread lcid - mainFormInvokeResultHolder := Some(f ()) + mainFormInvokeResultHolder <- Some(f ()) finally doneSignal.Set() |> ignore)) |> ignore @@ -103,9 +103,9 @@ type WinFormsEventLoop() = () // if !progress then fprintf outWriter "." outWriter.Flush() //if !progress then fprintfn outWriter "RunCodeOnWinFormsMainThread: Got completion signal, res = %b" (Option.isSome !mainFormInvokeResultHolder) - !mainFormInvokeResultHolder |> Option.get + mainFormInvokeResultHolder |> Option.get - member x.ScheduleRestart() = restart := true; Application.Exit() + member x.ScheduleRestart() = restart <- true; Application.Exit() /// Try to set the unhandled exception mode of System.Windows.Forms let internal TrySetUnhandledExceptionMode() = diff --git a/src/fsharp/lex.fsl b/src/fsharp/lex.fsl index a3a0003f57e..397e1487694 100644 --- a/src/fsharp/lex.fsl +++ b/src/fsharp/lex.fsl @@ -412,67 +412,67 @@ rule token args skip = parse | SingleChar(c) -> CHAR (char c) | _ -> fail args lexbuf (FSComp.SR.lexThisUnicodeOnlyInStringLiterals()) (CHAR (char 0)) } | "(*IF-FSHARP" - { if not skip then (COMMENT (LexCont.Token !args.ifdefStack)) else token args skip lexbuf } + { if not skip then (COMMENT (LexCont.Token args.ifdefStack)) else token args skip lexbuf } | "(*F#" - { if not skip then (COMMENT (LexCont.Token !args.ifdefStack)) else token args skip lexbuf } + { if not skip then (COMMENT (LexCont.Token args.ifdefStack)) else token args skip lexbuf } | "ENDIF-FSHARP*)" - { if not skip then (COMMENT (LexCont.Token !args.ifdefStack)) else token args skip lexbuf } + { if not skip then (COMMENT (LexCont.Token args.ifdefStack)) else token args skip lexbuf } | "F#*)" - { if not skip then (COMMENT (LexCont.Token !args.ifdefStack)) else token args skip lexbuf } + { if not skip then (COMMENT (LexCont.Token args.ifdefStack)) else token args skip lexbuf } | "(*)" { LPAREN_STAR_RPAREN } | "(*" { let m = lexbuf.LexemeRange - if not skip then (COMMENT (LexCont.Comment(!args.ifdefStack,1,m))) else comment (1,m,args) skip lexbuf } + if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,1,m))) else comment (1,m,args) skip lexbuf } | "(*IF-CAML*)" | "(*IF-OCAML*)" { let m = lexbuf.LexemeRange - if not skip then (COMMENT (LexCont.MLOnly(!args.ifdefStack,m))) else mlOnly m args skip lexbuf } + if not skip then (COMMENT (LexCont.MLOnly(args.ifdefStack,m))) else mlOnly m args skip lexbuf } | '"' { let buf,fin,m = startString args lexbuf - if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string (buf,fin,m,args) skip lexbuf } + if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string (buf,fin,m,args) skip lexbuf } | '"' '"' '"' { let buf,fin,m = startString args lexbuf - if not skip then (STRING_TEXT (LexCont.TripleQuoteString(!args.ifdefStack,m))) else tripleQuoteString (buf,fin,m,args) skip lexbuf } + if not skip then (STRING_TEXT (LexCont.TripleQuoteString(args.ifdefStack,m))) else tripleQuoteString (buf,fin,m,args) skip lexbuf } | '$' '"' - { fail args lexbuf (FSComp.SR.lexTokenReserved()) (WHITESPACE (LexCont.Token !args.ifdefStack)) } + { fail args lexbuf (FSComp.SR.lexTokenReserved()) (WHITESPACE (LexCont.Token args.ifdefStack)) } | '@' '"' { let buf,fin,m = startString args lexbuf - if not skip then (STRING_TEXT (LexCont.VerbatimString(!args.ifdefStack,m))) else verbatimString (buf,fin,m,args) skip lexbuf } + if not skip then (STRING_TEXT (LexCont.VerbatimString(args.ifdefStack,m))) else verbatimString (buf,fin,m,args) skip lexbuf } | truewhite+ { if skip then token args skip lexbuf - else WHITESPACE (LexCont.Token !args.ifdefStack) } + else WHITESPACE (LexCont.Token args.ifdefStack) } | offwhite+ { if args.lightSyntaxStatus.Status then errorR(Error(FSComp.SR.lexTabsNotAllowed(),lexbuf.LexemeRange)) - if not skip then (WHITESPACE (LexCont.Token !args.ifdefStack)) else token args skip lexbuf } + if not skip then (WHITESPACE (LexCont.Token args.ifdefStack)) else token args skip lexbuf } | "////" op_char* { // 4+ slash are 1-line comments, online 3 slash are XmlDoc let m = lexbuf.LexemeRange - if not skip then (LINE_COMMENT (LexCont.SingleLineComment(!args.ifdefStack,1,m))) else singleLineComment (None,1,m,args) skip lexbuf } + if not skip then (LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack,1,m))) else singleLineComment (None,1,m,args) skip lexbuf } | "///" op_char* { // Match exactly 3 slash, 4+ slash caught by preceding rule let m = lexbuf.LexemeRange let doc = lexemeTrimLeft lexbuf 3 let sb = (new StringBuilder(100)).Append(doc) - if not skip then (LINE_COMMENT (LexCont.SingleLineComment(!args.ifdefStack,1,m))) else singleLineComment (Some sb,1,m,args) skip lexbuf } + if not skip then (LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack,1,m))) else singleLineComment (Some sb,1,m,args) skip lexbuf } | "//" op_char* { // Need to read all operator symbols too, otherwise it might be parsed by a rule below let m = lexbuf.LexemeRange - if not skip then (LINE_COMMENT (LexCont.SingleLineComment(!args.ifdefStack,1,m))) else singleLineComment (None,1,m,args) skip lexbuf } + if not skip then (LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack,1,m))) else singleLineComment (None,1,m,args) skip lexbuf } | newline - { newline lexbuf; if not skip then (WHITESPACE (LexCont.Token !args.ifdefStack)) else token args skip lexbuf } + { newline lexbuf; if not skip then (WHITESPACE (LexCont.Token args.ifdefStack)) else token args skip lexbuf } | '`' '`' ([^'`' '\n' '\r' '\t'] | '`' [^'`''\n' '\r' '\t']) + '`' '`' { Keywords.IdentifierToken args lexbuf (lexemeTrimBoth lexbuf 2 2) } @@ -524,7 +524,7 @@ rule token args skip = parse else // add a newline when we don't apply a directive since we consumed a newline getting here newline lexbuf - (HASH_LINE (LexCont.Token !args.ifdefStack)) } + (HASH_LINE (LexCont.Token args.ifdefStack)) } | "<@" { checkExprOp lexbuf; LQUOTE ("<@ @>", false) } | "<@@" { checkExprOp lexbuf; LQUOTE ("<@@ @@>", true) } @@ -589,7 +589,7 @@ rule token args skip = parse | "#!" op_char* { // Treat shebangs like regular comments, but they are only allowed at the start of a file let m = lexbuf.LexemeRange - let tok = shouldStartFile args lexbuf m (0,FSComp.SR.lexHashBangMustBeFirstInFile()) (LINE_COMMENT (LexCont.SingleLineComment(!args.ifdefStack,1,m))) + let tok = shouldStartFile args lexbuf m (0,FSComp.SR.lexHashBangMustBeFirstInFile()) (LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack,1,m))) if not skip then tok else singleLineComment (None,1,m,args) skip lexbuf } | "#light" anywhite* @@ -598,59 +598,59 @@ rule token args skip = parse warning(Error((0,"#light should only occur as the first non-comment text in an F# source file"),lexbuf.LexemeRange)) // TODO unreachable error above, I think? - brianmcn args.lightSyntaxStatus.Status <- true - if not skip then (HASH_LIGHT (LexCont.Token !args.ifdefStack)) else token args skip lexbuf } + if not skip then (HASH_LIGHT (LexCont.Token args.ifdefStack)) else token args skip lexbuf } | ("#indent" | "#light") anywhite+ "\"off\"" { args.lightSyntaxStatus.Status <- false mlCompatWarning (FSComp.SR.lexIndentOffForML()) lexbuf.LexemeRange - if not skip then (HASH_LIGHT (LexCont.Token !args.ifdefStack)) else token args skip lexbuf } + if not skip then (HASH_LIGHT (LexCont.Token args.ifdefStack)) else token args skip lexbuf } | anywhite* "#if" anywhite+ anystring { let m = lexbuf.LexemeRange let lookup id = List.contains id args.defines let lexed = lexeme lexbuf let isTrue = evalIfDefExpression lexbuf.StartPos lexbuf.SupportsFeature args lookup lexed - args.ifdefStack := (IfDefIf,m) :: !(args.ifdefStack) + args.ifdefStack <- (IfDefIf,m) :: args.ifdefStack // Get the token; make sure it starts at zero position & return let cont, f = - ( if isTrue then (LexCont.EndLine(LexerEndlineContinuation.Token(!args.ifdefStack)), endline (LexerEndlineContinuation.Token !args.ifdefStack) args skip) - else (LexCont.EndLine(LexerEndlineContinuation.Skip(!args.ifdefStack,0,m)), endline (LexerEndlineContinuation.Skip(!args.ifdefStack,0,m)) args skip) ) + ( if isTrue then (LexCont.EndLine(LexerEndlineContinuation.Token(args.ifdefStack)), endline (LexerEndlineContinuation.Token args.ifdefStack) args skip) + else (LexCont.EndLine(LexerEndlineContinuation.Skip(args.ifdefStack,0,m)), endline (LexerEndlineContinuation.Skip(args.ifdefStack,0,m)) args skip) ) let tok = shouldStartLine args lexbuf m (FSComp.SR.lexHashIfMustBeFirst()) (HASH_IF(m,lexed,cont)) if not skip then tok else f lexbuf } | anywhite* "#else" anywhite* ("//" [^'\n''\r']*)? { let lexed = (lexeme lexbuf) - match !(args.ifdefStack) with + match args.ifdefStack with | [] -> LEX_FAILURE (FSComp.SR.lexHashElseNoMatchingIf()) | (IfDefElse,_) :: _rest -> LEX_FAILURE (FSComp.SR.lexHashEndifRequiredForElse()) | (IfDefIf,_) :: rest -> let m = lexbuf.LexemeRange - args.ifdefStack := (IfDefElse,m) :: rest - let tok = HASH_ELSE(m,lexed, LexCont.EndLine(LexerEndlineContinuation.Skip(!args.ifdefStack,0,m))) + args.ifdefStack <- (IfDefElse,m) :: rest + let tok = HASH_ELSE(m,lexed, LexCont.EndLine(LexerEndlineContinuation.Skip(args.ifdefStack,0,m))) let tok = shouldStartLine args lexbuf m (FSComp.SR.lexHashElseMustBeFirst()) tok - if not skip then tok else endline (LexerEndlineContinuation.Skip(!args.ifdefStack,0,m)) args skip lexbuf } + if not skip then tok else endline (LexerEndlineContinuation.Skip(args.ifdefStack,0,m)) args skip lexbuf } | anywhite* "#endif" anywhite* ("//" [^'\n''\r']*)? { let lexed = (lexeme lexbuf) let m = lexbuf.LexemeRange - match !(args.ifdefStack) with + match args.ifdefStack with | []-> LEX_FAILURE (FSComp.SR.lexHashEndingNoMatchingIf()) | _ :: rest -> - args.ifdefStack := rest - let tok = HASH_ENDIF(m,lexed,LexCont.EndLine(LexerEndlineContinuation.Token(!args.ifdefStack))) + args.ifdefStack <- rest + let tok = HASH_ENDIF(m,lexed,LexCont.EndLine(LexerEndlineContinuation.Token(args.ifdefStack))) let tok = shouldStartLine args lexbuf m (FSComp.SR.lexHashEndifMustBeFirst()) tok - if not skip then tok else endline (LexerEndlineContinuation.Token(!args.ifdefStack)) args skip lexbuf } + if not skip then tok else endline (LexerEndlineContinuation.Token(args.ifdefStack)) args skip lexbuf } | "#if" - { let tok = fail args lexbuf (FSComp.SR.lexHashIfMustHaveIdent()) (WHITESPACE (LexCont.Token !args.ifdefStack)) + { let tok = fail args lexbuf (FSComp.SR.lexHashIfMustHaveIdent()) (WHITESPACE (LexCont.Token args.ifdefStack)) if not skip then tok else token args skip lexbuf } | surrogateChar surrogateChar | _ { unexpectedChar lexbuf } | eof - { EOF (LexCont.Token !args.ifdefStack) } + { EOF (LexCont.Token args.ifdefStack) } // Skips INACTIVE code until if finds #else / #endif matching with the #if or #else @@ -660,10 +660,10 @@ and ifdefSkip n m args skip = parse // If #if is the first thing on the line then increase depth, otherwise skip, because it is invalid (e.g. "(**) #if ...") if (m.StartColumn <> 0) then - if not skip then (INACTIVECODE (LexCont.IfDefSkip(!args.ifdefStack,n,m))) else ifdefSkip n m args skip lexbuf + if not skip then (INACTIVECODE (LexCont.IfDefSkip(args.ifdefStack,n,m))) else ifdefSkip n m args skip lexbuf else - let tok = INACTIVECODE(LexCont.EndLine(LexerEndlineContinuation.Skip(!args.ifdefStack,n+1,m))) - if not skip then tok else endline (LexerEndlineContinuation.Skip(!args.ifdefStack,n+1,m)) args skip lexbuf } + let tok = INACTIVECODE(LexCont.EndLine(LexerEndlineContinuation.Skip(args.ifdefStack,n+1,m))) + if not skip then tok else endline (LexerEndlineContinuation.Skip(args.ifdefStack,n+1,m)) args skip lexbuf } | anywhite* "#else" anywhite* ("//" [^'\n''\r']*)? { let lexed = (lexeme lexbuf) @@ -671,17 +671,17 @@ and ifdefSkip n m args skip = parse // If #else is the first thing on the line then process it, otherwise ignore, because it is invalid (e.g. "(**) #else ...") if (m.StartColumn <> 0) then - if not skip then (INACTIVECODE (LexCont.IfDefSkip(!args.ifdefStack,n,m))) else ifdefSkip n m args skip lexbuf + if not skip then (INACTIVECODE (LexCont.IfDefSkip(args.ifdefStack,n,m))) else ifdefSkip n m args skip lexbuf elif n = 0 then - match !(args.ifdefStack) with + match args.ifdefStack with | []-> LEX_FAILURE (FSComp.SR.lexHashElseNoMatchingIf()) | (IfDefElse,_) :: _rest -> LEX_FAILURE (FSComp.SR.lexHashEndifRequiredForElse()) | (IfDefIf,_) :: rest -> let m = lexbuf.LexemeRange - args.ifdefStack := (IfDefElse,m) :: rest - if not skip then (HASH_ELSE(m,lexed,LexCont.EndLine(LexerEndlineContinuation.Token(!args.ifdefStack)))) else endline (LexerEndlineContinuation.Token(!args.ifdefStack)) args skip lexbuf + args.ifdefStack <- (IfDefElse,m) :: rest + if not skip then (HASH_ELSE(m,lexed,LexCont.EndLine(LexerEndlineContinuation.Token(args.ifdefStack)))) else endline (LexerEndlineContinuation.Token(args.ifdefStack)) args skip lexbuf else - if not skip then (INACTIVECODE(LexCont.EndLine(LexerEndlineContinuation.Skip(!args.ifdefStack,n,m)))) else endline (LexerEndlineContinuation.Skip(!args.ifdefStack,n,m)) args skip lexbuf } + if not skip then (INACTIVECODE(LexCont.EndLine(LexerEndlineContinuation.Skip(args.ifdefStack,n,m)))) else endline (LexerEndlineContinuation.Skip(args.ifdefStack,n,m)) args skip lexbuf } | anywhite* "#endif" anywhite* ("//" [^'\n''\r']*)? { let lexed = lexeme lexbuf @@ -689,17 +689,17 @@ and ifdefSkip n m args skip = parse // If #endif is the first thing on the line then process it, otherwise ignore, because it is invalid (e.g. "(**) #endif ...") if (m.StartColumn <> 0) then - if not skip then (INACTIVECODE (LexCont.IfDefSkip(!args.ifdefStack,n,m))) else ifdefSkip n m args skip lexbuf + if not skip then (INACTIVECODE (LexCont.IfDefSkip(args.ifdefStack,n,m))) else ifdefSkip n m args skip lexbuf elif n = 0 then - match !(args.ifdefStack) with + match args.ifdefStack with | [] -> LEX_FAILURE (FSComp.SR.lexHashEndingNoMatchingIf()) | _ :: rest -> - args.ifdefStack := rest - if not skip then (HASH_ENDIF(m,lexed,LexCont.EndLine(LexerEndlineContinuation.Token(!args.ifdefStack)))) else endline (LexerEndlineContinuation.Token(!args.ifdefStack)) args skip lexbuf + args.ifdefStack <- rest + if not skip then (HASH_ENDIF(m,lexed,LexCont.EndLine(LexerEndlineContinuation.Token(args.ifdefStack)))) else endline (LexerEndlineContinuation.Token(args.ifdefStack)) args skip lexbuf else - let tok = INACTIVECODE(LexCont.EndLine(LexerEndlineContinuation.Skip(!args.ifdefStack,n-1,m))) + let tok = INACTIVECODE(LexCont.EndLine(LexerEndlineContinuation.Skip(args.ifdefStack,n-1,m))) let tok = shouldStartLine args lexbuf m (FSComp.SR.lexWrongNestedHashEndif()) tok - if not skip then tok else endline (LexerEndlineContinuation.Skip(!args.ifdefStack,(n-1),m)) args skip lexbuf } + if not skip then tok else endline (LexerEndlineContinuation.Skip(args.ifdefStack,(n-1),m)) args skip lexbuf } | newline { newline lexbuf; ifdefSkip n m args skip lexbuf } @@ -709,9 +709,9 @@ and ifdefSkip n m args skip = parse | surrogateChar surrogateChar | _ { // This tries to be nice and get tokens as 'words' because VS uses this when selecting stuff - if not skip then (INACTIVECODE (LexCont.IfDefSkip(!args.ifdefStack,n,m))) else ifdefSkip n m args skip lexbuf } + if not skip then (INACTIVECODE (LexCont.IfDefSkip(args.ifdefStack,n,m))) else ifdefSkip n m args skip lexbuf } | eof - { EOF (LexCont.IfDefSkip(!args.ifdefStack,n,m)) } + { EOF (LexCont.IfDefSkip(args.ifdefStack,n,m)) } // Called after lexing #if IDENT/#else/#endif - this checks whether there is nothing except end of line // or end of file and then calls the lexing function specified by 'cont' - either token or ifdefSkip @@ -729,40 +729,40 @@ and endline cont args skip = parse } | [^'\r' '\n']+ | _ - { let tok = fail args lexbuf (FSComp.SR.pplexExpectedSingleLineComment()) (WHITESPACE (LexCont.Token !args.ifdefStack)) + { let tok = fail args lexbuf (FSComp.SR.pplexExpectedSingleLineComment()) (WHITESPACE (LexCont.Token args.ifdefStack)) if not skip then tok else token args skip lexbuf } and string sargs skip = parse | '\\' newline anywhite* { let (_buf,_fin,m,args) = sargs newline lexbuf - if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf } | escape_char { let (buf,_fin,m,args) = sargs addByteChar buf (escape (lexeme lexbuf).[1]) - if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf } | trigraph { let (buf,_fin,m,args) = sargs let s = lexeme lexbuf addByteChar buf (trigraph s.[1] s.[2] s.[3]) - if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf } | hexGraphShort { let (buf,_fin,m,args) = sargs addUnicodeChar buf (int (hexGraphShort (lexemeTrimLeft lexbuf 2))) - if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf } | unicodeGraphShort { let (buf,_fin,m,args) = sargs addUnicodeChar buf (int (unicodeGraphShort (lexemeTrimLeft lexbuf 2))) - if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf } | unicodeGraphLong { let (buf,_fin,m,args) = sargs let hexChars = lexemeTrimLeft lexbuf 2 - let result () = if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf + let result () = if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf match unicodeGraphLong hexChars with | Invalid -> fail args lexbuf (FSComp.SR.lexInvalidUnicodeLiteral hexChars) (result ()) @@ -788,38 +788,38 @@ and string sargs skip = parse { let (buf,_fin,m,args) = sargs newline lexbuf addUnicodeString buf (lexeme lexbuf) - if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf } | ident { let (buf,_fin,m,args) = sargs addUnicodeString buf (lexeme lexbuf) - if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf } | integer | xinteger { let (buf,_fin,m,args) = sargs addUnicodeString buf (lexeme lexbuf) - if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf } | anywhite + { let (buf,_fin,m,args) = sargs addUnicodeString buf (lexeme lexbuf) - if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf } | eof { let (_buf,_fin,m,args) = sargs - EOF (LexCont.String(!args.ifdefStack,m)) } + EOF (LexCont.String(args.ifdefStack,m)) } | surrogateChar surrogateChar // surrogate code points always come in pairs | _ { let (buf,_fin,m,args) = sargs addUnicodeString buf (lexeme lexbuf) - if not skip then (STRING_TEXT (LexCont.String(!args.ifdefStack,m))) else string sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf } and verbatimString sargs skip = parse | '"' '"' { let (buf,_fin,m,args) = sargs addByteChar buf '\"' - if not skip then (STRING_TEXT (LexCont.VerbatimString(!args.ifdefStack,m))) else verbatimString sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.VerbatimString(args.ifdefStack,m))) else verbatimString sargs skip lexbuf } | '"' { let (buf,fin,_m,_args) = sargs @@ -835,32 +835,32 @@ and verbatimString sargs skip = parse { let (buf,_fin,m,args) = sargs newline lexbuf addUnicodeString buf (lexeme lexbuf) - if not skip then (STRING_TEXT (LexCont.VerbatimString(!args.ifdefStack,m))) else verbatimString sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.VerbatimString(args.ifdefStack,m))) else verbatimString sargs skip lexbuf } | ident { let (buf,_fin,m,args) = sargs addUnicodeString buf (lexeme lexbuf) - if not skip then (STRING_TEXT (LexCont.VerbatimString(!args.ifdefStack,m))) else verbatimString sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.VerbatimString(args.ifdefStack,m))) else verbatimString sargs skip lexbuf } | integer | xinteger { let (buf,_fin,m,args) = sargs addUnicodeString buf (lexeme lexbuf) - if not skip then (STRING_TEXT (LexCont.VerbatimString(!args.ifdefStack,m))) else verbatimString sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.VerbatimString(args.ifdefStack,m))) else verbatimString sargs skip lexbuf } | anywhite + { let (buf,_fin,m,args) = sargs addUnicodeString buf (lexeme lexbuf) - if not skip then (STRING_TEXT (LexCont.VerbatimString(!args.ifdefStack,m))) else verbatimString sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.VerbatimString(args.ifdefStack,m))) else verbatimString sargs skip lexbuf } | eof { let (_buf,_fin,m,args) = sargs - EOF (LexCont.VerbatimString(!args.ifdefStack,m)) } + EOF (LexCont.VerbatimString(args.ifdefStack,m)) } | surrogateChar surrogateChar // surrogate code points always come in pairs | _ { let (buf,_fin,m,args) = sargs addUnicodeString buf (lexeme lexbuf) - if not skip then (STRING_TEXT (LexCont.VerbatimString(!args.ifdefStack,m))) else verbatimString sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.VerbatimString(args.ifdefStack,m))) else verbatimString sargs skip lexbuf } and tripleQuoteString sargs skip = parse | '"' '"' '"' @@ -872,33 +872,33 @@ and tripleQuoteString sargs skip = parse { let (buf,_fin,m,args) = sargs newline lexbuf addUnicodeString buf (lexeme lexbuf) - if not skip then (STRING_TEXT (LexCont.TripleQuoteString(!args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.TripleQuoteString(args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf } // The rest is to break into pieces to allow double-click-on-word and other such things | ident { let (buf,_fin,m,args) = sargs addUnicodeString buf (lexeme lexbuf) - if not skip then (STRING_TEXT (LexCont.TripleQuoteString(!args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.TripleQuoteString(args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf } | integer | xinteger { let (buf,_fin,m,args) = sargs addUnicodeString buf (lexeme lexbuf) - if not skip then (STRING_TEXT (LexCont.TripleQuoteString(!args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.TripleQuoteString(args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf } | anywhite + { let (buf,_fin,m,args) = sargs addUnicodeString buf (lexeme lexbuf) - if not skip then (STRING_TEXT (LexCont.TripleQuoteString(!args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.TripleQuoteString(args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf } | eof { let (_buf,_fin,m,args) = sargs - EOF (LexCont.TripleQuoteString(!args.ifdefStack,m)) } + EOF (LexCont.TripleQuoteString(args.ifdefStack,m)) } | surrogateChar surrogateChar // surrogate code points always come in pairs | _ { let (buf,_fin,m,args) = sargs addUnicodeString buf (lexeme lexbuf) - if not skip then (STRING_TEXT (LexCont.TripleQuoteString(!args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf } + if not skip then (STRING_TEXT (LexCont.TripleQuoteString(args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf } // Parsing single-line comment - we need to split it into words for Visual Studio IDE and singleLineComment cargs skip = parse @@ -907,78 +907,78 @@ and singleLineComment cargs skip = parse trySaveXmlDoc lexbuf buff newline lexbuf // Saves the documentation (if we're collecting any) into a buffer-local variable. - if not skip then (LINE_COMMENT (LexCont.Token !args.ifdefStack)) else token args skip lexbuf } + if not skip then (LINE_COMMENT (LexCont.Token args.ifdefStack)) else token args skip lexbuf } | eof { let _, _n,_m,args = cargs // NOTE: it is legal to end a file with this comment, so we'll return EOF as a token - EOF (LexCont.Token !args.ifdefStack) } + EOF (LexCont.Token args.ifdefStack) } | [^ ' ' '\n' '\r' ]+ | anywhite+ { let buff,n,m,args = cargs // Append the current token to the XML documentation if we're collecting it tryAppendXmlDoc buff (lexeme lexbuf) - if not skip then (LINE_COMMENT (LexCont.SingleLineComment(!args.ifdefStack,n,m))) else singleLineComment (buff,n,m,args) skip lexbuf } + if not skip then (LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack,n,m))) else singleLineComment (buff,n,m,args) skip lexbuf } | surrogateChar surrogateChar | _ { let _, _n,_m,args = cargs - if not skip then (LINE_COMMENT (LexCont.Token !args.ifdefStack)) else token args skip lexbuf } + if not skip then (LINE_COMMENT (LexCont.Token args.ifdefStack)) else token args skip lexbuf } and comment cargs skip = parse | char { let n,m,args = cargs - if not skip then (COMMENT (LexCont.Comment(!args.ifdefStack,n,m))) else comment (n,m,args) skip lexbuf } + if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n,m))) else comment (n,m,args) skip lexbuf } | '"' { let n,m,args = cargs - if not skip then (COMMENT (LexCont.StringInComment(!args.ifdefStack,n,m))) else stringInComment n m args skip lexbuf } + if not skip then (COMMENT (LexCont.StringInComment(args.ifdefStack,n,m))) else stringInComment n m args skip lexbuf } | '"' '"' '"' { let n,m,args = cargs - if not skip then (COMMENT (LexCont.TripleQuoteStringInComment(!args.ifdefStack,n,m))) else tripleQuoteStringInComment n m args skip lexbuf } + if not skip then (COMMENT (LexCont.TripleQuoteStringInComment(args.ifdefStack,n,m))) else tripleQuoteStringInComment n m args skip lexbuf } | '@' '"' { let n,m,args = cargs - if not skip then (COMMENT (LexCont.VerbatimStringInComment(!args.ifdefStack,n,m))) else verbatimStringInComment n m args skip lexbuf } + if not skip then (COMMENT (LexCont.VerbatimStringInComment(args.ifdefStack,n,m))) else verbatimStringInComment n m args skip lexbuf } | "(*)" { let n,m,args = cargs - if not skip then (COMMENT (LexCont.Comment(!args.ifdefStack,n,m))) else comment cargs skip lexbuf } + if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n,m))) else comment cargs skip lexbuf } | '(' '*' { let n,m,args = cargs - if not skip then (COMMENT (LexCont.Comment(!args.ifdefStack,n+1,m))) else comment (n+1,m,args) skip lexbuf } + if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n+1,m))) else comment (n+1,m,args) skip lexbuf } | newline { let n,m,args = cargs newline lexbuf - if not skip then (COMMENT (LexCont.Comment(!args.ifdefStack,n,m))) else comment cargs skip lexbuf } + if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n,m))) else comment cargs skip lexbuf } | "*)" { let n,m,args = cargs - if n > 1 then if not skip then (COMMENT (LexCont.Comment(!args.ifdefStack,n-1,m))) else comment (n-1,m,args) skip lexbuf - else if not skip then (COMMENT (LexCont.Token !args.ifdefStack)) else token args skip lexbuf } + if n > 1 then if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n-1,m))) else comment (n-1,m,args) skip lexbuf + else if not skip then (COMMENT (LexCont.Token args.ifdefStack)) else token args skip lexbuf } | anywhite+ | [^ '\'' '(' '*' '\n' '\r' '"' ')' '@' ' ' '\t' ]+ { let n,m,args = cargs - if not skip then (COMMENT (LexCont.Comment(!args.ifdefStack,n,m))) else comment cargs skip lexbuf } + if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n,m))) else comment cargs skip lexbuf } | eof { let n,m,args = cargs - EOF (LexCont.Comment(!args.ifdefStack,n,m)) } + EOF (LexCont.Comment(args.ifdefStack,n,m)) } | surrogateChar surrogateChar | _ { let n,m,args = cargs - if not skip then (COMMENT (LexCont.Comment(!args.ifdefStack,n,m))) else comment (n,m,args) skip lexbuf } + if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n,m))) else comment (n,m,args) skip lexbuf } and stringInComment n m args skip = parse // Follow string lexing, skipping tokens until it finishes | '\\' newline anywhite* { newline lexbuf - if not skip then (COMMENT (LexCont.StringInComment(!args.ifdefStack,n,m))) else stringInComment n m args skip lexbuf } + if not skip then (COMMENT (LexCont.StringInComment(args.ifdefStack,n,m))) else stringInComment n m args skip lexbuf } | escape_char | trigraph @@ -989,69 +989,69 @@ and stringInComment n m args skip = parse | integer | xinteger | anywhite + - { if not skip then (COMMENT (LexCont.StringInComment(!args.ifdefStack,n,m))) else stringInComment n m args skip lexbuf } + { if not skip then (COMMENT (LexCont.StringInComment(args.ifdefStack,n,m))) else stringInComment n m args skip lexbuf } | '"' - { if not skip then (COMMENT (LexCont.Comment(!args.ifdefStack,n,m))) else comment (n,m,args) skip lexbuf } + { if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n,m))) else comment (n,m,args) skip lexbuf } | newline { newline lexbuf - if not skip then (COMMENT (LexCont.StringInComment(!args.ifdefStack,n,m))) else stringInComment n m args skip lexbuf } + if not skip then (COMMENT (LexCont.StringInComment(args.ifdefStack,n,m))) else stringInComment n m args skip lexbuf } | eof - { EOF (LexCont.StringInComment(!args.ifdefStack,n,m)) } + { EOF (LexCont.StringInComment(args.ifdefStack,n,m)) } | surrogateChar surrogateChar | _ - { if not skip then (COMMENT (LexCont.StringInComment(!args.ifdefStack,n,m))) else stringInComment n m args skip lexbuf } + { if not skip then (COMMENT (LexCont.StringInComment(args.ifdefStack,n,m))) else stringInComment n m args skip lexbuf } and verbatimStringInComment n m args skip = parse // Follow verbatimString lexing, in short, skip double-quotes and other chars until we hit a single quote | '"' '"' - { if not skip then (COMMENT (LexCont.VerbatimStringInComment(!args.ifdefStack,n,m))) else verbatimStringInComment n m args skip lexbuf } + { if not skip then (COMMENT (LexCont.VerbatimStringInComment(args.ifdefStack,n,m))) else verbatimStringInComment n m args skip lexbuf } | '"' - { if not skip then (COMMENT (LexCont.Comment(!args.ifdefStack,n,m))) else comment (n,m,args) skip lexbuf } + { if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n,m))) else comment (n,m,args) skip lexbuf } | ident | integer | xinteger | anywhite + - { if not skip then (COMMENT (LexCont.VerbatimStringInComment(!args.ifdefStack,n,m))) else verbatimStringInComment n m args skip lexbuf } + { if not skip then (COMMENT (LexCont.VerbatimStringInComment(args.ifdefStack,n,m))) else verbatimStringInComment n m args skip lexbuf } | newline { newline lexbuf - if not skip then (COMMENT (LexCont.VerbatimStringInComment(!args.ifdefStack,n,m))) else verbatimStringInComment n m args skip lexbuf } + if not skip then (COMMENT (LexCont.VerbatimStringInComment(args.ifdefStack,n,m))) else verbatimStringInComment n m args skip lexbuf } | eof - { EOF (LexCont.VerbatimStringInComment(!args.ifdefStack,n,m)) } + { EOF (LexCont.VerbatimStringInComment(args.ifdefStack,n,m)) } | surrogateChar surrogateChar | _ - { if not skip then (COMMENT (LexCont.VerbatimStringInComment(!args.ifdefStack,n,m))) else verbatimStringInComment n m args skip lexbuf } + { if not skip then (COMMENT (LexCont.VerbatimStringInComment(args.ifdefStack,n,m))) else verbatimStringInComment n m args skip lexbuf } and tripleQuoteStringInComment n m args skip = parse // Follow tripleQuoteString lexing | '"' '"' '"' - { if not skip then (COMMENT (LexCont.Comment(!args.ifdefStack,n,m))) else comment (n,m,args) skip lexbuf } + { if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n,m))) else comment (n,m,args) skip lexbuf } | ident | integer | xinteger | anywhite + - { if not skip then (COMMENT (LexCont.TripleQuoteStringInComment(!args.ifdefStack,n,m))) else tripleQuoteStringInComment n m args skip lexbuf } + { if not skip then (COMMENT (LexCont.TripleQuoteStringInComment(args.ifdefStack,n,m))) else tripleQuoteStringInComment n m args skip lexbuf } | newline { newline lexbuf - if not skip then (COMMENT (LexCont.TripleQuoteStringInComment(!args.ifdefStack,n,m))) else tripleQuoteStringInComment n m args skip lexbuf } + if not skip then (COMMENT (LexCont.TripleQuoteStringInComment(args.ifdefStack,n,m))) else tripleQuoteStringInComment n m args skip lexbuf } | eof - { EOF (LexCont.TripleQuoteStringInComment(!args.ifdefStack,n,m)) } + { EOF (LexCont.TripleQuoteStringInComment(args.ifdefStack,n,m)) } | surrogateChar surrogateChar | _ - { if not skip then (COMMENT (LexCont.TripleQuoteStringInComment(!args.ifdefStack,n,m))) else tripleQuoteStringInComment n m args skip lexbuf } + { if not skip then (COMMENT (LexCont.TripleQuoteStringInComment(args.ifdefStack,n,m))) else tripleQuoteStringInComment n m args skip lexbuf } and mlOnly m args skip = parse @@ -1059,17 +1059,17 @@ and mlOnly m args skip = parse { let buf = ByteBuffer.Create 100 let m2 = lexbuf.LexemeRange let _ = string (buf,defaultStringFinisher,m2,args) skip lexbuf - if not skip then (COMMENT (LexCont.MLOnly(!args.ifdefStack,m))) else mlOnly m args skip lexbuf } + if not skip then (COMMENT (LexCont.MLOnly(args.ifdefStack,m))) else mlOnly m args skip lexbuf } | newline - { newline lexbuf; if not skip then (COMMENT (LexCont.MLOnly(!args.ifdefStack,m))) else mlOnly m args skip lexbuf } + { newline lexbuf; if not skip then (COMMENT (LexCont.MLOnly(args.ifdefStack,m))) else mlOnly m args skip lexbuf } | "(*ENDIF-CAML*)" - { if not skip then (COMMENT (LexCont.Token !args.ifdefStack)) else token args skip lexbuf } + { if not skip then (COMMENT (LexCont.Token args.ifdefStack)) else token args skip lexbuf } | "(*ENDIF-OCAML*)" - { if not skip then (COMMENT (LexCont.Token !args.ifdefStack)) else token args skip lexbuf } + { if not skip then (COMMENT (LexCont.Token args.ifdefStack)) else token args skip lexbuf } | [^ '(' '"' '\n' '\r' ]+ - { if not skip then (COMMENT (LexCont.MLOnly(!args.ifdefStack,m))) else mlOnly m args skip lexbuf } + { if not skip then (COMMENT (LexCont.MLOnly(args.ifdefStack,m))) else mlOnly m args skip lexbuf } | eof - { EOF (LexCont.MLOnly(!args.ifdefStack,m)) } + { EOF (LexCont.MLOnly(args.ifdefStack,m)) } | surrogateChar surrogateChar | _ - { if not skip then (COMMENT (LexCont.MLOnly(!args.ifdefStack,m))) else mlOnly m args skip lexbuf } + { if not skip then (COMMENT (LexCont.MLOnly(args.ifdefStack,m))) else mlOnly m args skip lexbuf } diff --git a/src/fsharp/lexhelp.fs b/src/fsharp/lexhelp.fs index b25627e9a45..6201ec8a41e 100644 --- a/src/fsharp/lexhelp.fs +++ b/src/fsharp/lexhelp.fs @@ -49,7 +49,7 @@ type LexResourceManager() = /// Lexer parameters type lexargs = { defines: string list - ifdefStack: LexerIfdefStack + mutable ifdefStack: LexerIfdefStack resourceManager: LexResourceManager lightSyntaxStatus : LightSyntaxStatus errorLogger: ErrorLogger diff --git a/src/fsharp/lexhelp.fsi b/src/fsharp/lexhelp.fsi index f75ecd392d9..bcc1bc3dc8a 100644 --- a/src/fsharp/lexhelp.fsi +++ b/src/fsharp/lexhelp.fsi @@ -29,7 +29,7 @@ type LexResourceManager = type lexargs = { defines: string list - ifdefStack: LexerIfdefStack + mutable ifdefStack: LexerIfdefStack resourceManager: LexResourceManager lightSyntaxStatus : LightSyntaxStatus errorLogger: ErrorLogger diff --git a/src/fsharp/lib.fs b/src/fsharp/lib.fs index fba1c975e8d..b9653f35c7d 100755 --- a/src/fsharp/lib.fs +++ b/src/fsharp/lib.fs @@ -13,8 +13,8 @@ open FSharp.Compiler.AbstractIL.Internal.Library /// is this the developer-debug build? let debug = false let verbose = false -let progress = ref false -let tracking = ref false // intended to be a general hook to control diagnostic output when tracking down bugs +let mutable progress = false +let mutable tracking = false // intended to be a general hook to control diagnostic output when tracking down bugs let condition s = try (System.Environment.GetEnvironmentVariable(s) <> null) with _ -> false @@ -387,8 +387,19 @@ let inline cached cache resF = | _ -> cache.cacheVal +let inline cacheOptByref (cache: byref<'T option>) f = + match cache with + | Some v -> v + | None -> + let res = f() + cache <- Some res + res + +// REVIEW: this is only used because we want to mutate a record field, +// and because you cannot take a byref<_> of such a thing directly, +// we cannot use 'cacheOptByref'. If that is changed, this can be removed. let inline cacheOptRef cache f = - match !cache with + match !cache with | Some v -> v | None -> let res = f() diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index cd9b187d3ad..76585ba9d58 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -193,7 +193,7 @@ type internal TypeCheckInfo // We guarantee to only refine to a more nested environment. It may not be strictly // the right environment, but will always be at least as rich - let bestAlmostIncludedSoFar = ref None + let mutable bestAlmostIncludedSoFar = None sResolutions.CapturedEnvs |> ResizeArray.iter (fun (possm,env,ad) -> // take only ranges that strictly do not include cursorPos (all ranges that touch cursorPos were processed during 'Strict Inclusion' part) @@ -204,15 +204,15 @@ type internal TypeCheckInfo | None -> true if contained then - match !bestAlmostIncludedSoFar with + match bestAlmostIncludedSoFar with | Some (rightm:range,_,_) -> if posGt possm.End rightm.End || (posEq possm.End rightm.End && posGt possm.Start rightm.Start) then - bestAlmostIncludedSoFar := Some (possm,env,ad) - | _ -> bestAlmostIncludedSoFar := Some (possm,env,ad)) + bestAlmostIncludedSoFar <- Some (possm,env,ad) + | _ -> bestAlmostIncludedSoFar <- Some (possm,env,ad)) let resEnv = - match !bestAlmostIncludedSoFar, mostDeeplyNestedEnclosingScope with + match bestAlmostIncludedSoFar, mostDeeplyNestedEnclosingScope with | Some (_,env,ad), None -> env, ad | Some (_,almostIncludedEnv,ad), Some (_,mostDeeplyNestedEnv,_) when almostIncludedEnv.eFieldLabels.Count >= mostDeeplyNestedEnv.eFieldLabels.Count -> @@ -1525,7 +1525,7 @@ module internal ParseAndCheckFile = // When analyzing files using ParseOneFile, i.e. for the use of editing clients, we do not apply line directives. // TODO(pathmap): expose PathMap on the service API, and thread it through here - let lexargs = mkLexargs(fileName, defines, lightSyntaxStatus, lexResourceManager, ref [], errHandler.ErrorLogger, PathMap.empty) + let lexargs = mkLexargs(fileName, defines, lightSyntaxStatus, lexResourceManager, [], errHandler.ErrorLogger, PathMap.empty) let lexargs = { lexargs with applyLineDirectives = false } let tokenizer = LexFilter.LexFilter(lightSyntaxStatus, options.CompilingFsLib, Lexer.token lexargs true, lexbuf) diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 365570b5d62..de773fd3aa3 100755 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -125,10 +125,10 @@ module internal IncrementalBuild = | VectorBuildRule ve -> ve.Name // Ids of exprs - let nextid = ref 999 // Number ids starting with 1000 to discern them + let mutable nextid = 999 // Number ids starting with 1000 to discern them let NextId() = - nextid:=!nextid+1 - Id(!nextid) + nextid <- nextid + 1 + Id(nextid) type INode = abstract Name: string diff --git a/src/fsharp/service/ServiceAssemblyContent.fs b/src/fsharp/service/ServiceAssemblyContent.fs index a86b26db8a5..f3c27337ab2 100644 --- a/src/fsharp/service/ServiceAssemblyContent.fs +++ b/src/fsharp/service/ServiceAssemblyContent.fs @@ -860,8 +860,8 @@ module ParsedInput = // Based on an initial review, no diagnostics should be generated. However the code should be checked more closely. use _ignoreAllDiagnostics = new ErrorScope() - let result: (Scope * pos * (* finished *) bool) option ref = ref None - let ns: string[] option ref = ref None + let mutable result = None + let mutable ns = None let modules = ResizeArray() let inline longIdentToIdents ident = ident |> Seq.map (fun x -> string x) |> Seq.toArray @@ -873,17 +873,17 @@ module ParsedInput = let doRange kind (scope: LongIdent) line col = if line <= currentLine then - match !result, insertionPoint with + match result, insertionPoint with | None, _ -> - result := Some ({ Idents = longIdentToIdents scope; Kind = kind }, mkPos line col, false) + result <- Some ({ Idents = longIdentToIdents scope; Kind = kind }, mkPos line col, false) | Some (_, _, true), _ -> () | Some (oldScope, oldPos, false), OpenStatementInsertionPoint.TopLevel when kind <> OpenDeclaration -> - result := Some (oldScope, oldPos, true) + result <- Some (oldScope, oldPos, true) | Some (oldScope, oldPos, _), _ -> match kind, oldScope.Kind with | (Namespace | NestedModule | TopModule), OpenDeclaration | _ when oldPos.Line <= line -> - result := + result <- Some ({ Idents = match scope with | [] -> oldScope.Idents @@ -916,11 +916,11 @@ module ParsedInput = if range.EndLine >= currentLine then let isModule = kind.IsModule match isModule, parent, ident with - | false, _, _ -> ns := Some (longIdentToIdents ident) + | false, _, _ -> ns <- Some (longIdentToIdents ident) // top level module with "inlined" namespace like Ns1.Ns2.TopModule | true, [], _f :: _s :: _ -> let ident = longIdentToIdents ident - ns := Some (ident.[0..ident.Length - 2]) + ns <- Some (ident.[0..ident.Length - 2]) | _ -> () let fullIdent = parent @ ident @@ -958,9 +958,9 @@ module ParsedInput = | ParsedInput.ImplFile input -> walkImplFileInput input let res = - !result + result |> Option.map (fun (scope, pos, _) -> - let ns = !ns |> Option.map longIdentToIdents + let ns = ns |> Option.map longIdentToIdents scope, ns, mkPos (pos.Line + 1) pos.Column) let modules = diff --git a/src/fsharp/service/ServiceLexing.fs b/src/fsharp/service/ServiceLexing.fs index c37ea56d903..a984a5ce1e1 100644 --- a/src/fsharp/service/ServiceLexing.fs +++ b/src/fsharp/service/ServiceLexing.fs @@ -475,10 +475,10 @@ module internal LexerStateEncoding = let callLexCont lexcont args skip lexbuf = let argsWithIfDefs ifd = - if !args.ifdefStack = ifd then + if args.ifdefStack = ifd then args else - {args with ifdefStack = ref ifd} + {args with ifdefStack = ifd} match lexcont with | LexCont.EndLine cont -> Lexer.endline cont args skip lexbuf | LexCont.Token ifd -> Lexer.token (argsWithIfDefs ifd) skip lexbuf @@ -775,8 +775,8 @@ type FSharpSourceTokenizer(defineConstants: string list, filename: string option let lexResourceManager = new Lexhelp.LexResourceManager() - let lexArgsLightOn = mkLexargs(filename, defineConstants, LightSyntaxStatus(true, false), lexResourceManager, ref [], DiscardErrorsLogger, PathMap.empty) - let lexArgsLightOff = mkLexargs(filename, defineConstants, LightSyntaxStatus(false, false), lexResourceManager, ref [], DiscardErrorsLogger, PathMap.empty) + let lexArgsLightOn = mkLexargs(filename, defineConstants, LightSyntaxStatus(true, false), lexResourceManager, [], DiscardErrorsLogger, PathMap.empty) + let lexArgsLightOff = mkLexargs(filename, defineConstants, LightSyntaxStatus(false, false), lexResourceManager, [], DiscardErrorsLogger, PathMap.empty) member this.CreateLineTokenizer(lineText: string) = let lexbuf = UnicodeLexing.StringAsLexbuf(isFeatureSupported, lineText) diff --git a/src/fsharp/service/ServiceNavigation.fs b/src/fsharp/service/ServiceNavigation.fs index 3578543b65b..dbecc3b101b 100755 --- a/src/fsharp/service/ServiceNavigation.fs +++ b/src/fsharp/service/ServiceNavigation.fs @@ -97,15 +97,15 @@ module NavigationImpl = /// Get information for implementation file let getNavigationFromImplFile (modules: SynModuleOrNamespace list) = // Map for dealing with name conflicts - let nameMap = ref Map.empty + let mutable nameMap = Map.empty let addItemName name = - let count = defaultArg (!nameMap |> Map.tryFind name) 0 - nameMap := (Map.add name (count + 1) (!nameMap)) + let count = defaultArg (nameMap |> Map.tryFind name) 0 + nameMap <- (Map.add name (count + 1) (nameMap)) (count + 1) let uniqueName name idx = - let total = Map.find name (!nameMap) + let total = Map.find name nameMap sprintf "%s_%d_of_%d" name idx total // Create declaration (for the left dropdown) @@ -305,13 +305,13 @@ module NavigationImpl = /// Get information for signature file let getNavigationFromSigFile (modules: SynModuleOrNamespaceSig list) = // Map for dealing with name conflicts - let nameMap = ref Map.empty + let mutable nameMap = Map.empty let addItemName name = - let count = defaultArg (!nameMap |> Map.tryFind name) 0 - nameMap := (Map.add name (count + 1) (!nameMap)) + let count = defaultArg (nameMap |> Map.tryFind name) 0 + nameMap <- (Map.add name (count + 1) (nameMap)) (count + 1) let uniqueName name idx = - let total = Map.find name (!nameMap) + let total = Map.find name nameMap sprintf "%s_%d_of_%d" name idx total // Create declaration (for the left dropdown) diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index a98cb2966b9..fdaacbb3764 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -1013,7 +1013,7 @@ type FSharpChecker(legacyReferenceResolver, CompileHelpers.setOutputStreams execute // References used to capture the results of compilation - let tcImportsRef = ref (None: TcImports option) + let tcImportsRef = ref None let assemblyBuilderRef = ref None let tcImportsCapture = Some (fun tcImports -> tcImportsRef := Some tcImports) diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index 98ededce05b..7dc9e0a11d4 100644 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -1830,21 +1830,21 @@ and [] // We do not need to lock this mutable state this it is only ever accessed from the compiler thread. let activePatternElemRefCache: NameMap option ref = ref None - let modulesByDemangledNameCache: NameMap option ref = ref None + let mutable modulesByDemangledNameCache: NameMap option = None - let exconsByDemangledNameCache: NameMap option ref = ref None + let mutable exconsByDemangledNameCache: NameMap option = None - let tyconsByDemangledNameAndArityCache: LayeredMap option ref = ref None + let mutable tyconsByDemangledNameAndArityCache: LayeredMap option = None - let tyconsByAccessNamesCache: LayeredMultiMap option ref = ref None + let mutable tyconsByAccessNamesCache: LayeredMultiMap option = None - let tyconsByMangledNameCache: NameMap option ref = ref None + let mutable tyconsByMangledNameCache: NameMap option = None - let allEntitiesByMangledNameCache: NameMap option ref = ref None + let mutable allEntitiesByMangledNameCache: NameMap option = None - let allValsAndMembersByPartialLinkageKeyCache: MultiMap option ref = ref None + let mutable allValsAndMembersByPartialLinkageKeyCache: MultiMap option = None - let allValsByLogicalNameCache: NameMap option ref = ref None + let mutable allValsByLogicalNameCache: NameMap option = None /// Namespace or module-compiled-as-type? member mtyp.ModuleOrNamespaceKind = kind @@ -1861,17 +1861,17 @@ and [] /// Mutation used during compilation of FSharp.Core.dll member mtyp.AddModuleOrNamespaceByMutation(modul: ModuleOrNamespace) = entities <- QueueList.appendOne entities modul - modulesByDemangledNameCache := None - allEntitiesByMangledNameCache := None + modulesByDemangledNameCache <- None + allEntitiesByMangledNameCache <- None #if !NO_EXTENSIONTYPING /// Mutation used in hosting scenarios to hold the hosted types in this module or namespace member mtyp.AddProvidedTypeEntity(entity: Entity) = entities <- QueueList.appendOne entities entity - tyconsByMangledNameCache := None - tyconsByDemangledNameAndArityCache := None - tyconsByAccessNamesCache := None - allEntitiesByMangledNameCache := None + tyconsByMangledNameCache <- None + tyconsByDemangledNameAndArityCache <- None + tyconsByAccessNamesCache <- None + allEntitiesByMangledNameCache <- None #endif /// Return a new module or namespace type with an entity added. @@ -1901,19 +1901,19 @@ and [] /// table is indexed by both name and generic arity. This means that for generic /// types "List`1", the entry (List, 1) will be present. member mtyp.TypesByDemangledNameAndArity m = - cacheOptRef tyconsByDemangledNameAndArityCache (fun () -> + cacheOptByref &tyconsByDemangledNameAndArityCache (fun () -> LayeredMap.Empty.AddAndMarkAsCollapsible( mtyp.TypeAndExceptionDefinitions |> List.map (fun (tc: Tycon) -> KeyTyconByDemangledNameAndArity tc.LogicalName (tc.Typars m) tc) |> List.toArray)) /// Get a table of types defined within this module, namespace or type. The /// table is indexed by both name and, for generic types, also by mangled name. member mtyp.TypesByAccessNames = - cacheOptRef tyconsByAccessNamesCache (fun () -> + cacheOptByref &tyconsByAccessNamesCache (fun () -> LayeredMultiMap.Empty.AddAndMarkAsCollapsible (mtyp.TypeAndExceptionDefinitions |> List.toArray |> Array.collect (fun (tc: Tycon) -> KeyTyconByAccessNames tc.LogicalName tc))) // REVIEW: we can remove this lookup and use AllEntitiesByMangledName instead? member mtyp.TypesByMangledName = let addTyconByMangledName (x: Tycon) tab = NameMap.add x.LogicalName x tab - cacheOptRef tyconsByMangledNameCache (fun () -> + cacheOptByref &tyconsByMangledNameCache (fun () -> List.foldBack addTyconByMangledName mtyp.TypeAndExceptionDefinitions Map.empty) /// Get a table of entities indexed by both logical and compiled names @@ -1925,7 +1925,7 @@ and [] if name1 = name2 then tab else NameMap.add name2 x tab - cacheOptRef allEntitiesByMangledNameCache (fun () -> + cacheOptByref &allEntitiesByMangledNameCache (fun () -> QueueList.foldBack addEntityByMangledName entities Map.empty) /// Get a table of entities indexed by both logical name @@ -1942,7 +1942,7 @@ and [] MultiMap.add key x tab else tab - cacheOptRef allValsAndMembersByPartialLinkageKeyCache (fun () -> + cacheOptByref &allValsAndMembersByPartialLinkageKeyCache (fun () -> QueueList.foldBack addValByMangledName vals MultiMap.empty) /// Try to find the member with the given linkage key in the given module. @@ -1963,7 +1963,7 @@ and [] NameMap.add x.LogicalName x tab else tab - cacheOptRef allValsByLogicalNameCache (fun () -> + cacheOptByref &allValsByLogicalNameCache (fun () -> QueueList.foldBack addValByName vals Map.empty) /// Compute a table of values and members indexed by logical name. @@ -1978,7 +1978,7 @@ and [] /// Get a table of F# exception definitions indexed by demangled name, so 'FailureException' is indexed by 'Failure' member mtyp.ExceptionDefinitionsByDemangledName = let add (tycon: Tycon) acc = NameMap.add tycon.LogicalName tycon acc - cacheOptRef exconsByDemangledNameCache (fun () -> + cacheOptByref &exconsByDemangledNameCache (fun () -> List.foldBack add mtyp.ExceptionDefinitions Map.empty) /// Get a table of nested module and namespace fragments indexed by demangled name (so 'ListModule' becomes 'List') @@ -1987,7 +1987,7 @@ and [] if entity.IsModuleOrNamespace then NameMap.add entity.DemangledModuleOrNamespaceName entity acc else acc - cacheOptRef modulesByDemangledNameCache (fun () -> + cacheOptByref &modulesByDemangledNameCache (fun () -> QueueList.foldBack add entities Map.empty) [] diff --git a/src/ilx/ilxsettings.fs b/src/ilx/ilxsettings.fs index 64ea572e02f..2355a6b1b6e 100644 --- a/src/ilx/ilxsettings.fs +++ b/src/ilx/ilxsettings.fs @@ -10,18 +10,18 @@ type IlxCallImplementation = | VirtEntriesVirtCode //++GLOBAL MUTABLE STATE (concurrency-safe because assigned only during F# library compilation) -let ilxCompilingFSharpCoreLib = ref false +let mutable ilxCompilingFSharpCoreLib = false //++GLOBAL MUTABLE STATE (concurrency-safe because assigned only during F# library compilation) -let ilxFsharpCoreLibAssemRef = ref (None : ILAssemblyRef option) +let mutable ilxFsharpCoreLibAssemRef = None : ILAssemblyRef option /// Scope references for FSharp.Core.dll let ilxFsharpCoreLibScopeRef () = - if !ilxCompilingFSharpCoreLib then + if ilxCompilingFSharpCoreLib then ILScopeRef.Local else let assemblyRef = - match !ilxFsharpCoreLibAssemRef with + match ilxFsharpCoreLibAssemRef with | Some o -> o | None -> // The exact public key token and version used here don't actually matter, or shouldn't. diff --git a/src/utils/TaggedCollections.fs b/src/utils/TaggedCollections.fs index 54f7e07fc5f..479b8def82b 100644 --- a/src/utils/TaggedCollections.fs +++ b/src/utils/TaggedCollections.fs @@ -478,15 +478,15 @@ namespace Internal.Utilities.Collections.Tagged not stack.IsEmpty let toSeq s = - let i = ref (SetIterator s) + let mutable i = SetIterator s { new IEnumerator<_> with - member __.Current = (!i).Current + member _.Current = i.Current interface System.Collections.IEnumerator with - member __.Current = box (!i).Current - member __.MoveNext() = (!i).MoveNext() - member __.Reset() = i := SetIterator s + member _.Current = box i.Current + member _.MoveNext() = i.MoveNext() + member _.Reset() = i <- SetIterator s interface System.IDisposable with - member __.Dispose() = () } + member _.Dispose() = () } //-------------------------------------------------------------------------- // Set comparison. This can be expensive. @@ -545,8 +545,8 @@ namespace Internal.Utilities.Collections.Tagged loop s [] let copyToArray s (arr: _[]) i = - let j = ref i - iter (fun x -> arr.[!j] <- x; j := !j + 1) s + let mutable j = i + iter (fun x -> arr.[j] <- x; j <- j + 1) s let toArray s = let n = (count s) @@ -1019,8 +1019,8 @@ namespace Internal.Utilities.Collections.Tagged mkFromEnumerator comparer empty ie let copyToArray s (arr: _[]) i = - let j = ref i - s |> iter (fun x y -> arr.[!j] <- KeyValuePair(x,y); j := !j + 1) + let mutable j = i + s |> iter (fun x y -> arr.[j] <- KeyValuePair(x,y); j <- j + 1) /// Imperative left-to-right iterators. @@ -1078,13 +1078,13 @@ namespace Internal.Utilities.Collections.Tagged not stack.IsEmpty let toSeq s = - let i = ref (MapIterator(s)) + let mutable i = MapIterator(s) { new IEnumerator<_> with - member self.Current = (!i).Current + member self.Current = i.Current interface System.Collections.IEnumerator with - member self.Current = box (!i).Current - member self.MoveNext() = (!i).MoveNext() - member self.Reset() = i := MapIterator(s) + member self.Current = box i.Current + member self.MoveNext() = i.MoveNext() + member self.Reset() = i <- MapIterator(s) interface System.IDisposable with member self.Dispose() = ()} diff --git a/src/utils/sformat.fs b/src/utils/sformat.fs index 21b84f5bef7..013e55626e5 100644 --- a/src/utils/sformat.fs +++ b/src/utils/sformat.fs @@ -822,9 +822,9 @@ namespace Microsoft.FSharp.Text.StructuredPrintfImpl let path = Dictionary(10,HashIdentity.Reference) // Roughly count the "nodes" printed, e.g. leaf items and inner nodes, but not every bracket and comma. - let size = ref opts.PrintSize - let exceededPrintSize() = !size<=0 - let countNodes n = if !size > 0 then size := !size - n else () // no need to keep decrementing (and avoid wrap around) + let mutable size = opts.PrintSize + let exceededPrintSize() = size<=0 + let countNodes n = if size > 0 then size <- size - n else () // no need to keep decrementing (and avoid wrap around) let stopShort _ = exceededPrintSize() // for unfoldL // Recursive descent diff --git a/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs b/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs index 21667c727d5..3f91e0f1591 100644 --- a/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs +++ b/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs @@ -59,12 +59,11 @@ type HashIfExpression() = member x.ErrorCount = errors.Count } - let stack : LexerIfdefStack = ref [] let lightSyntax = LightSyntaxStatus(true, false) let resourceManager = LexResourceManager () let defines = [] let startPos = Position.Empty - let args = mkLexargs ("dummy", defines, lightSyntax, resourceManager, stack, errorLogger, PathMap.empty) + let args = mkLexargs ("dummy", defines, lightSyntax, resourceManager, [], errorLogger, PathMap.empty) CompileThreadStatic.ErrorLogger <- errorLogger diff --git a/vsintegration/src/FSharp.Editor/LanguageService/Tokenizer.fs b/vsintegration/src/FSharp.Editor/LanguageService/Tokenizer.fs index e45e28a19d0..10dd261e8f5 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/Tokenizer.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/Tokenizer.fs @@ -458,7 +458,7 @@ module internal Tokenizer = let lineTokenizer = sourceTokenizer.CreateLineTokenizer(lineContents) let tokens = ResizeArray() let mutable tokenInfoOption = None - let previousLexState = ref lexState + let mutable previousLexState = lexState let processToken() = let classificationType = compilerTokenToRoslynToken(tokenInfoOption.Value.ColorClass) @@ -471,9 +471,9 @@ module internal Tokenizer = tokens.Add savedToken let scanAndColorNextToken() = - let info, nextLexState = lineTokenizer.ScanToken(!previousLexState) + let info, nextLexState = lineTokenizer.ScanToken(previousLexState) tokenInfoOption <- info - previousLexState := nextLexState + previousLexState <- nextLexState // Apply some hacks to clean up the token stream (we apply more later) match info with @@ -519,7 +519,7 @@ module internal Tokenizer = classifiedSpans.Add(new ClassifiedSpan(classificationType, textSpan)) startPosition <- endPosition - SourceLineData(textLine.Start, lexState, previousLexState.Value, lineContents.GetHashCode(), classifiedSpans.ToArray(), tokens.ToArray()) + SourceLineData(textLine.Start, lexState, previousLexState, lineContents.GetHashCode(), classifiedSpans.ToArray(), tokens.ToArray()) // We keep incremental data per-document. When text changes we correlate text line-by-line (by hash codes of lines) diff --git a/vsintegration/src/FSharp.VS.FSI/sessions.fs b/vsintegration/src/FSharp.VS.FSI/sessions.fs index 5e07e4672ea..b1b5a85616d 100644 --- a/vsintegration/src/FSharp.VS.FSI/sessions.fs +++ b/vsintegration/src/FSharp.VS.FSI/sessions.fs @@ -42,9 +42,9 @@ type internal EventWrapper() = /// Exceptions raised by f x are caught and reported in DEBUG mode. let timeoutApp descr timeoutMS (f : 'a -> 'b) (arg:'a) = use ev = new EventWrapper() - let r : 'b option ref = ref None + let mutable r = None System.Threading.ThreadPool.QueueUserWorkItem(fun _ -> - r := + r <- try f arg |> Some with @@ -63,7 +63,7 @@ let timeoutApp descr timeoutMS (f : 'a -> 'b) (arg:'a) = ev.Set() ) |> ignore ev.WaitOne(timeoutMS) |> ignore - !r + r module SessionsProperties = let mutable useAnyCpuVersion = true // 64-bit by default