Cleanup related to diagnostics, ParsedInput

src/fsharp/CheckDeclarations.fs

@@ -5026,7 +5026,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS
         | SynModuleSigDecl.Val (vspec, m) -> 
             let parentModule = 
                 match parent with 
-                | ParentNone -> error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(), vspec.RangeOfId)) 
+                | ParentNone -> error(Error(FSComp.SR.tcNamespaceCannotContainValues(), vspec.RangeOfId)) 
                 | Parent p -> p
             let containerInfo = ModuleOrNamespaceContainerInfo parentModule
             let idvs, _ = TcAndPublishValSpec (cenv, env, containerInfo, ModuleOrMemberBinding, None, emptyUnscopedTyparEnv, vspec)
@@ -5197,7 +5197,7 @@ and TcSignatureElementsMutRec cenv parent typeNames m mutRecNSInfo envInitial (d
                       decls, (false, false)
 
                 | SynModuleSigDecl.Val (vspec, _) -> 
-                    if isNamespace then error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(), vspec.RangeOfId)) 
+                    if isNamespace then error(Error(FSComp.SR.tcNamespaceCannotContainValues(), vspec.RangeOfId)) 
                     let decls = [ MutRecShape.Lets vspec ]
                     decls, (false, false)
 
@@ -5281,9 +5281,9 @@ let CheckLetOrDoInNamespace binds m =
     | [ SynBinding (None, (SynBindingKind.StandaloneExpression | SynBindingKind.Do), false, false, [], _, _, _, None, (SynExpr.Do (SynExpr.Const (SynConst.Unit, _), _) | SynExpr.Const (SynConst.Unit, _)), _, _) ] ->
         ()
     | [] -> 
-        error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(), m)) 
+        error(Error(FSComp.SR.tcNamespaceCannotContainValues(), m)) 
     | _ -> 
-        error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(), binds.Head.RangeOfHeadPattern)) 
+        error(Error(FSComp.SR.tcNamespaceCannotContainValues(), binds.Head.RangeOfHeadPattern)) 
 
 /// The non-mutually recursive case for a declaration
 let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem env synDecl = 

src/fsharp/CheckExpressions.fs

@@ -1200,7 +1200,7 @@ let PublishValueDefn cenv env declKind (vspec: Val) =
     if (declKind = ModuleOrMemberBinding) && 
        ((GetCurrAccumulatedModuleOrNamespaceType env).ModuleOrNamespaceKind = Namespace) && 
        (Option.isNone vspec.MemberInfo) then 
-           errorR(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(), vspec.Range))
+           errorR(Error(FSComp.SR.tcNamespaceCannotContainValues(), vspec.Range))
 
     if (declKind = ExtrinsicExtensionBinding) && 
        ((GetCurrAccumulatedModuleOrNamespaceType env).ModuleOrNamespaceKind = Namespace) then 

src/fsharp/CompilerDiagnostics.fs

@@ -128,7 +128,6 @@ let GetRangeOfDiagnostic(err: PhasedDiagnostic) =
       | LetRecEvaluatedOutOfOrder (_, _, _, m) 
       | Error (_, m)
       | ErrorWithSuggestions (_, m, _, _)
-      | NumberedError (_, m)
       | SyntaxError (_, m) 
       | InternalError (_, m)
       | InterfaceNotRevealed(_, _, m) 
@@ -346,7 +345,6 @@ let GetDiagnosticNumber(err: PhasedDiagnostic) =
       | Error ((n, _), _) -> n
       | ErrorWithSuggestions ((n, _), _, _, _) -> n
       | Failure _ -> 192
-      | NumberedError((n, _), _) -> n
       | IllegalFileNameChar(fileName, invalidChar) -> fst (FSComp.SR.buildUnexpectedFileNameCharacter(fileName, string invalidChar))
 #if !NO_EXTENSIONTYPING
       | :? TypeProviderError as e -> e.Number
@@ -362,9 +360,8 @@ let GetWarningLevel err =
     | LetRecEvaluatedOutOfOrder _
     | DefensiveCopyWarning _  -> 5
 
-    | NumberedError((n, _), _)
-    | ErrorWithSuggestions((n, _), _, _, _) 
-    | Error((n, _), _) -> 
+    | Error((n, _), _)
+    | ErrorWithSuggestions((n, _), _, _, _) -> 
         // 1178, tcNoComparisonNeeded1, "The struct, record or union type '%s' is not structurally comparable because the type parameter %s does not satisfy the 'comparison' constraint..."
         // 1178, tcNoComparisonNeeded2, "The struct, record or union type '%s' is not structurally comparable because the type '%s' does not satisfy the 'comparison' constraint...."
         // 1178, tcNoEqualityNeeded1, "The struct, record or union type '%s' does not support structural equality because the type parameter %s does not satisfy the 'equality' constraint..."
@@ -1452,8 +1449,6 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) (canSuggestNa
           os.Append(DecompileOpName s) |> ignore
           suggestNames suggestionF idText
 
-      | NumberedError ((_, s), _) -> os.Append s |> ignore
-
       | InternalError (s, _) 
 
       | InvalidArgument s 
@@ -1712,11 +1707,11 @@ type DiagnosticDetailedInfo =
 
 [<RequireQualifiedAccess>]
 type Diagnostic = 
-    | Short of bool * string
-    | Long of bool * DiagnosticDetailedInfo
+    | Short of FSharpDiagnosticSeverity * string
+    | Long of FSharpDiagnosticSeverity * DiagnosticDetailedInfo
 
 /// returns sequence that contains Diagnostic for the given error + Diagnostic for all related errors
-let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, isError, err: PhasedDiagnostic, suggestNames: bool) =
+let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, severity: FSharpDiagnosticSeverity, err: PhasedDiagnostic, suggestNames: bool) =
     let outputWhere (showFullPaths, errorStyle) m: DiagnosticLocation =
         if Range.equals m rangeStartup || Range.equals m rangeCmdArgs then
             { Range = m; TextRepresentation = ""; IsEmpty = true; File = "" }
@@ -1777,11 +1772,17 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt
                 | None -> None
 
             let OutputCanonicalInformation(subcategory, errorNumber) : DiagnosticCanonicalInformation = 
+                let message = 
+                    match severity with
+                    | FSharpDiagnosticSeverity.Error -> "error"
+                    | FSharpDiagnosticSeverity.Warning -> "warning"
+                    | FSharpDiagnosticSeverity.Info
+                    | FSharpDiagnosticSeverity.Hidden -> "info"
                 let text = 
                     match errorStyle with
                     // Show the subcategory for --vserrors so that we can fish it out in Visual Studio and use it to determine error stickiness.
-                    | ErrorStyle.VSErrors -> sprintf "%s %s FS%04d: " subcategory (if isError then "error" else "warning") errorNumber
-                    | _ -> sprintf "%s FS%04d: " (if isError then "error" else "warning") errorNumber
+                    | ErrorStyle.VSErrors -> sprintf "%s %s FS%04d: " subcategory message errorNumber
+                    | _ -> sprintf "%s FS%04d: " message errorNumber
                 { ErrorNumber = errorNumber; Subcategory = subcategory; TextRepresentation = text}
 
             let mainError, relatedErrors = SplitRelatedDiagnostics err
@@ -1794,7 +1795,7 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt
 
             let entry: DiagnosticDetailedInfo = { Location = where; Canonical = canonical; Message = message }
 
-            errors.Add ( Diagnostic.Long(isError, entry ) )
+            errors.Add ( Diagnostic.Long(severity, entry ) )
 
             let OutputRelatedError(err: PhasedDiagnostic) =
                 match errorStyle with
@@ -1808,12 +1809,12 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt
                         os.ToString()
 
                     let entry: DiagnosticDetailedInfo = { Location = relWhere; Canonical = relCanonical; Message = relMessage}
-                    errors.Add( Diagnostic.Long (isError, entry) )
+                    errors.Add( Diagnostic.Long (severity, entry) )
 
                 | _ -> 
                     let os = System.Text.StringBuilder()
                     OutputPhasedDiagnostic os err flattenErrors suggestNames
-                    errors.Add( Diagnostic.Short(isError, os.ToString()) )
+                    errors.Add( Diagnostic.Short(severity, os.ToString()) )
 
             relatedErrors |> List.iter OutputRelatedError
 
@@ -1831,10 +1832,10 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt
 
 /// used by fsc.exe and fsi.exe, but not by VS
 /// prints error and related errors to the specified StringBuilder
-let rec OutputDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, isError) os (err: PhasedDiagnostic) = 
+let rec OutputDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, severity) os (err: PhasedDiagnostic) = 
 
     // 'true' for "canSuggestNames" is passed last here because we want to report suggestions in fsc.exe and fsi.exe, just not in regular IDE usage.
-    let errors = CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, isError, err, true)
+    let errors = CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, severity, err, true)
     for e in errors do
         Printf.bprintf os "\n"
         match e with
@@ -1886,9 +1887,9 @@ let ReportWarningAsError options err =
 type ErrorLoggerFilteringByScopedPragmas (checkFile, scopedPragmas, errorLogger: ErrorLogger) =
     inherit ErrorLogger("ErrorLoggerFilteringByScopedPragmas")
 
-    override x.DiagnosticSink (phasedError, isError) = 
-        if isError then 
-            errorLogger.DiagnosticSink (phasedError, isError)
+    override x.DiagnosticSink (phasedError, severity) = 
+        if severity = FSharpDiagnosticSeverity.Error then 
+            errorLogger.DiagnosticSink (phasedError, severity)
         else 
           let report = 
             let warningNum = GetDiagnosticNumber phasedError
@@ -1901,7 +1902,7 @@ type ErrorLoggerFilteringByScopedPragmas (checkFile, scopedPragmas, errorLogger:
                         (not checkFile || m.FileIndex = pragmaRange.FileIndex) &&
                         Position.posGeq m.Start pragmaRange.Start))  
             | None -> true
-          if report then errorLogger.DiagnosticSink(phasedError, false)
+          if report then errorLogger.DiagnosticSink(phasedError, severity)
 
     override x.ErrorCount = errorLogger.ErrorCount
 

src/fsharp/CompilerDiagnostics.fsi

@@ -60,7 +60,7 @@ val SplitRelatedDiagnostics: PhasedDiagnostic -> PhasedDiagnostic * PhasedDiagno
 val OutputPhasedDiagnostic: StringBuilder -> PhasedDiagnostic -> flattenErrors: bool -> suggestNames: bool -> unit
 
 /// Output an error or warning to a buffer
-val OutputDiagnostic: implicitIncludeDir:string * showFullPaths: bool * flattenErrors: bool * errorStyle: ErrorStyle *  isError:bool -> StringBuilder -> PhasedDiagnostic -> unit
+val OutputDiagnostic: implicitIncludeDir:string * showFullPaths: bool * flattenErrors: bool * errorStyle: ErrorStyle * severity: FSharpDiagnosticSeverity -> StringBuilder -> PhasedDiagnostic -> unit
 
 /// Output extra context information for an error or warning to a buffer
 val OutputDiagnosticContext: prefix:string -> fileLineFunction:(string -> int -> string) -> StringBuilder -> PhasedDiagnostic -> unit
@@ -90,11 +90,11 @@ type DiagnosticDetailedInfo =
 /// Part of LegacyHostedCompilerForTesting
 [<RequireQualifiedAccess>]
 type Diagnostic = 
-    | Short of bool * string
-    | Long of bool * DiagnosticDetailedInfo
+    | Short of FSharpDiagnosticSeverity * string
+    | Long of FSharpDiagnosticSeverity * DiagnosticDetailedInfo
 
 /// Part of LegacyHostedCompilerForTesting
-val CollectDiagnostic: implicitIncludeDir:string * showFullPaths: bool * flattenErrors: bool * errorStyle: ErrorStyle *  isError:bool * PhasedDiagnostic * suggestNames: bool -> seq<Diagnostic>
+val CollectDiagnostic: implicitIncludeDir:string * showFullPaths: bool * flattenErrors: bool * errorStyle: ErrorStyle * severity: FSharpDiagnosticSeverity * PhasedDiagnostic * suggestNames: bool -> seq<Diagnostic>
 
 /// Get an error logger that filters the reporting of warnings based on scoped pragma information
 val GetErrorLoggerFilteringByScopedPragmas: checkFile:bool * ScopedPragma list * ErrorLogger  -> ErrorLogger

src/fsharp/CompilerImports.fs

@@ -130,8 +130,46 @@ let WriteOptimizationData (tcGlobals, filename, inMem, ccu: CcuThunk, modulInfo)
     let rName = if ccu.AssemblyName = getFSharpCoreLibraryName then FSharpOptimizationDataResourceName2 else FSharpOptimizationDataResourceName 
     PickleToResource inMem filename tcGlobals ccu (rName+ccu.AssemblyName) Optimizer.p_CcuOptimizationInfo modulInfo
 
+let EncodeSignatureData(tcConfig: TcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, isIncrementalBuild) = 
+    if tcConfig.GenerateSignatureData then 
+        let resource = WriteSignatureData (tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, isIncrementalBuild)
+        // The resource gets written to a file for FSharp.Core
+        let useDataFiles = (tcConfig.useOptimizationDataFile || tcGlobals.compilingFslib) && not isIncrementalBuild
+        if useDataFiles then 
+            let sigDataFileName = (Filename.chopExtension outfile)+".sigdata"
+            let bytes = resource.GetBytes()
+            use fileStream = File.Create(sigDataFileName, bytes.Length)
+            bytes.CopyTo fileStream
+        let resources = 
+            [ resource ]
+        let sigAttr = mkSignatureDataVersionAttr tcGlobals (parseILVersion Internal.Utilities.FSharpEnvironment.FSharpBinaryMetadataFormatRevision) 
+        [sigAttr], resources
+      else 
+        [], []
+
+let EncodeOptimizationData(tcGlobals, tcConfig: TcConfig, outfile, exportRemapping, data, isIncrementalBuild) = 
+    if tcConfig.GenerateOptimizationData then 
+        let data = map2Of2 (Optimizer.RemapOptimizationInfo tcGlobals exportRemapping) data
+        // As with the sigdata file, the optdata gets written to a file for FSharp.Core
+        let useDataFiles = (tcConfig.useOptimizationDataFile || tcGlobals.compilingFslib) && not isIncrementalBuild
+        if useDataFiles then 
+            let ccu, modulInfo = data
+            let bytes = TypedTreePickle.pickleObjWithDanglingCcus isIncrementalBuild outfile tcGlobals ccu Optimizer.p_CcuOptimizationInfo modulInfo
+            let optDataFileName = (Filename.chopExtension outfile)+".optdata"
+            File.WriteAllBytes(optDataFileName, bytes)
+        let (ccu, optData) = 
+            if tcConfig.onlyEssentialOptimizationData then 
+                map2Of2 Optimizer.AbstractOptimizationInfoToEssentials data 
+            else 
+                data
+        [ WriteOptimizationData (tcGlobals, outfile, isIncrementalBuild, ccu, optData) ]
+    else
+        [ ]
+
 exception AssemblyNotResolved of (*originalName*) string * range
+
 exception MSBuildReferenceResolutionWarning of (*MSBuild warning code*)string * (*Message*)string * range
+
 exception MSBuildReferenceResolutionError of (*MSBuild warning code*)string * (*Message*)string * range
 
 let OpenILBinary(filename, reduceMemoryUsage, pdbDirPath, shadowCopyReferences, tryGetMetadataSnapshot) =

src/fsharp/CompilerImports.fsi

@@ -12,6 +12,7 @@ open FSharp.Compiler.CheckExpressions
 open FSharp.Compiler.CompilerConfig
 open FSharp.Compiler.DependencyManager
 open FSharp.Compiler.ErrorLogger
+open FSharp.Compiler.Optimizer
 open FSharp.Compiler.TypedTree
 open FSharp.Compiler.TypedTreeOps
 open FSharp.Compiler.TcGlobals
@@ -42,11 +43,24 @@ val IsReflectedDefinitionsResource: ILResource -> bool
 
 val GetSignatureDataResourceName: ILResource -> string
 
-/// Write F# signature data as an IL resource
-val WriteSignatureData: TcConfig * TcGlobals * Remap * CcuThunk * filename: string * inMem: bool -> ILResource
-
-/// Write F# optimization data as an IL resource
-val WriteOptimizationData: TcGlobals * filename: string * inMem: bool * CcuThunk * Optimizer.LazyModuleInfo -> ILResource
+/// Encode the F# interface data into a set of IL attributes and resources
+val EncodeSignatureData:
+    tcConfig:TcConfig *
+    tcGlobals:TcGlobals *
+    exportRemapping:Remap *
+    generatedCcu: CcuThunk *
+    outfile: string *
+    isIncrementalBuild: bool
+      -> ILAttribute list * ILResource list
+
+val EncodeOptimizationData: 
+    tcGlobals:TcGlobals *
+    tcConfig:TcConfig *
+    outfile: string *
+    exportRemapping:Remap *
+    (CcuThunk * #CcuOptimizationInfo) *
+    isIncrementalBuild: bool
+      -> ILResource list
 
 [<RequireQualifiedAccess>]
 type ResolveAssemblyReferenceMode =

src/fsharp/CompilerOptions.fs

@@ -1717,11 +1717,16 @@ let DoWithColor newColor f =
         finally
             ignoreFailureOnMono1_1_16 (fun () -> Console.ForegroundColor <- c)
 
-let DoWithErrorColor isError f =
+let DoWithDiagnosticColor severity f =
     match foreBackColor() with
     | None -> f()
     | Some (_, backColor) ->
+        let infoColor = if backColor = ConsoleColor.White then ConsoleColor.Blue else ConsoleColor.Green
         let warnColor = if backColor = ConsoleColor.White then ConsoleColor.DarkBlue else ConsoleColor.Cyan
         let errorColor = ConsoleColor.Red
-        let color = if isError then errorColor else warnColor 
+        let color = 
+            match severity with 
+            | FSharpDiagnosticSeverity.Error -> errorColor
+            | FSharpDiagnosticSeverity.Warning -> warnColor
+            | _ -> infoColor
         DoWithColor color f