open Internal.Utilities

open System

open System.Collections.Generic

open Microsoft.FSharp.Compiler

open Microsoft.FSharp.Compiler.AbstractIL

open Microsoft.FSharp.Compiler.AbstractIL.IL

open Microsoft.FSharp.Compiler.AbstractIL.Internal

open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library

open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX

open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics

open Microsoft.FSharp.Compiler.CompileOps

open Microsoft.FSharp.Compiler.TcGlobals

open Microsoft.FSharp.Compiler.TypeChecker

open Microsoft.FSharp.Compiler.Tast

open Microsoft.FSharp.Compiler.Tastops

open Microsoft.FSharp.Compiler.Tastops.DebugPrint

open Microsoft.FSharp.Compiler.Ast

open Microsoft.FSharp.Compiler.ErrorLogger

open Microsoft.FSharp.Compiler.AbstractIL.IL

open Microsoft.FSharp.Compiler.Lib

open Microsoft.FSharp.Compiler.Range

open Microsoft.FSharp.Compiler.Lexhelp

open Microsoft.FSharp.Compiler.IlxGen

#if FX_RESHAPED_REFLECTION

open Microsoft.FSharp.Core.ReflectionAdapters

module Attributes =

open System.Runtime.CompilerServices

//[<assembly: System.Security.SecurityTransparent>]

#if !FX_NO_DEFAULT_DEPENDENCY_TYPE

[<Dependency("FSharp.Core",LoadHint.Always)>]

do()

type OptionSwitch =

| On

| Off

type OptionSpec =

| OptionClear of bool ref

| OptionFloat of (float -> unit)

| OptionInt of (int -> unit)

| OptionSwitch of (OptionSwitch -> unit)

| OptionIntList of (int -> unit)

| OptionIntListSwitch of (int -> OptionSwitch -> unit)

| OptionRest of (string -> unit)

| OptionSet of bool ref

| OptionString of (string -> unit)

| OptionStringList of (string -> unit)

| OptionStringListSwitch of (string -> OptionSwitch -> unit)

| OptionUnit of (unit -> unit)

| OptionHelp of (CompilerOptionBlock list -> unit) // like OptionUnit, but given the "options"

| OptionGeneral of (string list -> bool) * (string list -> string list) // Applies? * (ApplyReturningResidualArgs)

and CompilerOption = CompilerOption of string * string * OptionSpec * Option<exn> * string option

and CompilerOptionBlock = PublicOptions of string * CompilerOption list | PrivateOptions of CompilerOption list

let GetOptionsOfBlock block =

match block with

| PublicOptions (_,opts) -> opts

| PrivateOptions opts -> opts

let FilterCompilerOptionBlock pred block =

match block with

| PublicOptions(heading,opts) -> PublicOptions(heading,List.filter pred opts)

| PrivateOptions(opts) -> PrivateOptions(List.filter pred opts)

let compilerOptionUsage (CompilerOption(s,tag,spec,_,_)) =

let s = if s="--" then "" else s (* s="flag" for "--flag" options. s="--" for "--" option. Adjust printing here for "--" case. *)

match spec with

| (OptionUnit _ | OptionSet _ | OptionClear _ | OptionHelp _) -> sprintf "--%s" s

| OptionStringList _ -> sprintf "--%s:%s" s tag

| OptionIntList _ -> sprintf "--%s:%s" s tag

| OptionSwitch _ -> sprintf "--%s[+|-]" s

| OptionStringListSwitch _ -> sprintf "--%s[+|-]:%s" s tag

| OptionIntListSwitch _ -> sprintf "--%s[+|-]:%s" s tag

| OptionString _ -> sprintf "--%s:%s" s tag

| OptionInt _ -> sprintf "--%s:%s" s tag

| OptionFloat _ -> sprintf "--%s:%s" s tag

| OptionRest _ -> sprintf "--%s ..." s

| OptionGeneral _ -> if tag="" then sprintf "%s" s else sprintf "%s:%s" s tag (* still being decided *)

let PrintCompilerOption (CompilerOption(_s,_tag,_spec,_,help) as compilerOption) =

let flagWidth = 30 // fixed width for printing of flags, e.g. --warnaserror:<warn...>

let defaultLineWidth = 80 // the fallback width

let lineWidth =

try

System.Console.BufferWidth

with e -> defaultLineWidth

let lineWidth = if lineWidth=0 then defaultLineWidth else lineWidth (* Have seen BufferWidth=0 on Linux/Mono *)

// Lines have this form: <flagWidth><space><description>

// flagWidth chars - for flags description or padding on continuation lines.

// single space - space.

// description - words upto but excluding the final character of the line.

assert(flagWidth = 30)

printf "%-40s" (compilerOptionUsage compilerOption)

let printWord column (word:string) =

// Have printed upto column.

// Now print the next word including any preceeding whitespace.

// Returns the column printed to (suited to folding).

if column + 1 (*space*) + word.Length >= lineWidth then // NOTE: "equality" ensures final character of the line is never printed

printfn "" (* newline *)

assert(flagWidth = 30)

printf "%-40s %s" ""(*<--flags*) word

flagWidth + 1 + word.Length

else

printf " %s" word

column + 1 + word.Length

let words = match help with None -> [| |] | Some s -> s.Split [| ' ' |]

let _finalColumn = Array.fold printWord flagWidth words

printfn "" (* newline *)

let PrintPublicOptions (heading,opts) =

if not (isNil opts) then

printfn ""

printfn ""

printfn "\t\t%s" heading

List.iter PrintCompilerOption opts

let PrintCompilerOptionBlocks blocks =

let equals x y = x=y

let publicBlocks = List.choose (function PrivateOptions _ -> None | PublicOptions (heading,opts) -> Some (heading,opts)) blocks

let consider doneHeadings (heading, _opts) =

if Set.contains heading doneHeadings then

doneHeadings

else

let headingOptions = List.filter (fst >> equals heading) publicBlocks |> List.collect snd

PrintPublicOptions (heading,headingOptions)

Set.add heading doneHeadings

List.fold consider Set.empty publicBlocks |> ignore<Set<string>>

let dumpCompilerOption prefix (CompilerOption(str, _, spec, _, _)) =

printf "section='%-25s' ! option=%-30s kind=" prefix str

match spec with

| OptionUnit _ -> printf "OptionUnit"

| OptionSet _ -> printf "OptionSet"

| OptionClear _ -> printf "OptionClear"

| OptionHelp _ -> printf "OptionHelp"

| OptionStringList _ -> printf "OptionStringList"

| OptionIntList _ -> printf "OptionIntList"

| OptionSwitch _ -> printf "OptionSwitch"

| OptionStringListSwitch _ -> printf "OptionStringListSwitch"

| OptionIntListSwitch _ -> printf "OptionIntListSwitch"

| OptionString _ -> printf "OptionString"

| OptionInt _ -> printf "OptionInt"

| OptionFloat _ -> printf "OptionFloat"

| OptionRest _ -> printf "OptionRest"

| OptionGeneral _ -> printf "OptionGeneral"

printf "\n"

let dumpCompilerOptionBlock = function

| PublicOptions (heading,opts) -> List.iter (dumpCompilerOption heading) opts

| PrivateOptions opts -> List.iter (dumpCompilerOption "NoSection") opts

let DumpCompilerOptionBlocks blocks = List.iter dumpCompilerOptionBlock blocks

let isSlashOpt (opt:string) =

opt.[0] = '/' && (opt.Length = 1 || not (opt.[1..].Contains "/"))

type ResponseFileData = ResponseFileLine list

and ResponseFileLine =

| CompilerOptionSpec of string

| Comment of string

let parseFile path : Choice<ResponseFileData,Exception> =

let parseLine (l: string) =

match l with

| s when String.IsNullOrWhiteSpace(s) -> None

| s when l.StartsWith("#") -> Some (ResponseFileLine.Comment (s.TrimStart('#')))

| s -> Some (ResponseFileLine.CompilerOptionSpec (s.Trim()))

try

use stream = FileSystem.FileStreamReadShim path

use reader = new System.IO.StreamReader(stream, true)

let data =

seq { while not reader.EndOfStream do yield reader.ReadLine () }

|> Seq.choose parseLine

|> List.ofSeq

Choice1Of2 data

with e ->

Choice2Of2 e

let ParseCompilerOptions (collectOtherArgument : string -> unit, blocks: CompilerOptionBlock list, args) =

use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter

let specs = List.collect GetOptionsOfBlock blocks

// returns a tuple - the option token, the option argument string

let parseOption (s : string) =

// grab the option token

let opts = s.Split([|':'|])

let mutable opt = opts.[0]

if opt = "" then

()

// if it doesn't start with a '-' or '/', reject outright

elif opt.[0] <> '-' && opt.[0] <> '/' then

opt <- ""

elif opt <> "--" then

// is it an abbreviated or MSFT-style option?

// if so, strip the first character and move on with your life

if opt.Length = 2 || isSlashOpt opt then

opt <- opt.[1 ..]

// else, it should be a non-abbreviated option starting with "--"

elif opt.Length > 3 && opt.StartsWith("--") then

opt <- opt.[2 ..]

else

opt <- ""

// get the argument string

let optArgs = if opts.Length > 1 then String.Join(":",opts.[1 ..]) else ""

opt, optArgs

let getOptionArg compilerOption (argString : string) =

if argString = "" then

errorR(Error(FSComp.SR.buildOptionRequiresParameter(compilerOptionUsage compilerOption),rangeCmdArgs))

argString

let getOptionArgList compilerOption (argString : string) =

if argString = "" then

errorR(Error(FSComp.SR.buildOptionRequiresParameter(compilerOptionUsage compilerOption),rangeCmdArgs))

[]

else

argString.Split([|',';';'|]) |> List.ofArray

let getSwitchOpt (opt : string) =

// if opt is a switch, strip the '+' or '-'

if opt <> "--" && opt.Length > 1 && (opt.EndsWith("+",StringComparison.Ordinal) || opt.EndsWith("-",StringComparison.Ordinal)) then

opt.[0 .. opt.Length - 2]

else

opt

let getSwitch (s: string) =

let s = (s.Split([|':'|])).[0]

if s <> "--" && s.EndsWith("-",StringComparison.Ordinal) then OptionSwitch.Off else OptionSwitch.On

let rec processArg args =

match args with

| [] -> ()

| ((rsp: string) :: t) when rsp.StartsWith("@") ->

let responseFileOptions =

let fullpath =

try

Some (rsp.TrimStart('@') |> FileSystem.GetFullPathShim)

with _ ->

None

match fullpath with

| None ->

errorR(Error(FSComp.SR.optsResponseFileNameInvalid(rsp),rangeCmdArgs))

[]

| Some(path) when not (FileSystem.SafeExists path) ->

errorR(Error(FSComp.SR.optsResponseFileNotFound(rsp, path),rangeCmdArgs))

[]

| Some path ->

match ResponseFile.parseFile path with

| Choice2Of2 _ ->

errorR(Error(FSComp.SR.optsInvalidResponseFile(rsp, path),rangeCmdArgs))

[]

| Choice1Of2 rspData ->

let onlyOptions l =

match l with

| ResponseFile.ResponseFileLine.Comment _ -> None

| ResponseFile.ResponseFileLine.CompilerOptionSpec opt -> Some opt

rspData |> List.choose onlyOptions

processArg (responseFileOptions @ t)

| opt :: t ->

let optToken, argString = parseOption opt

let reportDeprecatedOption errOpt =

match errOpt with

| Some(e) -> warning(e)

| None -> ()

let rec attempt l =

match l with

| (CompilerOption(s, _, OptionHelp f, d, _) :: _) when optToken = s && argString = "" ->

reportDeprecatedOption d

f blocks; t

| (CompilerOption(s, _, OptionUnit f, d, _) :: _) when optToken = s && argString = "" ->

reportDeprecatedOption d

f (); t

| (CompilerOption(s, _, OptionSwitch f, d, _) :: _) when getSwitchOpt(optToken) = s && argString = "" ->

reportDeprecatedOption d

f (getSwitch opt); t

| (CompilerOption(s, _, OptionSet f, d, _) :: _) when optToken = s && argString = "" ->

reportDeprecatedOption d

f := true; t

| (CompilerOption(s, _, OptionClear f, d, _) :: _) when optToken = s && argString = "" ->

reportDeprecatedOption d

f := false; t

| (CompilerOption(s, _, OptionString f, d, _) as compilerOption :: _) when optToken = s ->

reportDeprecatedOption d

let oa = getOptionArg compilerOption argString

if oa <> "" then

f (getOptionArg compilerOption oa)

t

| (CompilerOption(s, _, OptionInt f, d, _) as compilerOption :: _) when optToken = s ->

reportDeprecatedOption d

let oa = getOptionArg compilerOption argString

if oa <> "" then

f (try int32 (oa) with _ ->

errorR(Error(FSComp.SR.buildArgInvalidInt(getOptionArg compilerOption argString),rangeCmdArgs)); 0)

t

| (CompilerOption(s, _, OptionFloat f, d, _) as compilerOption :: _) when optToken = s ->

reportDeprecatedOption d

let oa = getOptionArg compilerOption argString

if oa <> "" then

f (try float (oa) with _ ->

errorR(Error(FSComp.SR.buildArgInvalidFloat(getOptionArg compilerOption argString), rangeCmdArgs)); 0.0)

t

| (CompilerOption(s, _, OptionRest f, d, _) :: _) when optToken = s ->

reportDeprecatedOption d

List.iter f t; []

| (CompilerOption(s, _, OptionIntList f, d, _) as compilerOption :: _) when optToken = s ->

reportDeprecatedOption d

let al = getOptionArgList compilerOption argString

if al <> [] then

List.iter (fun i -> f (try int32 i with _ -> errorR(Error(FSComp.SR.buildArgInvalidInt(i),rangeCmdArgs)); 0)) al ;

t

| (CompilerOption(s, _, OptionIntListSwitch f, d, _) as compilerOption :: _) when getSwitchOpt(optToken) = s ->

reportDeprecatedOption d

let al = getOptionArgList compilerOption argString

if al <> [] then

let switch = getSwitch(opt)

List.iter (fun i -> f (try int32 i with _ -> errorR(Error(FSComp.SR.buildArgInvalidInt(i),rangeCmdArgs)); 0) switch) al

t

// here

| (CompilerOption(s, _, OptionStringList f, d, _) as compilerOption :: _) when optToken = s ->

reportDeprecatedOption d

let al = getOptionArgList compilerOption argString

if al <> [] then

List.iter f (getOptionArgList compilerOption argString)

t

| (CompilerOption(s, _, OptionStringListSwitch f, d, _) as compilerOption :: _) when getSwitchOpt(optToken) = s ->

reportDeprecatedOption d

let al = getOptionArgList compilerOption argString

if al <> [] then

let switch = getSwitch(opt)

List.iter (fun s -> f s switch) (getOptionArgList compilerOption argString)

t

| (CompilerOption(_, _, OptionGeneral (pred,exec), d, _) :: _) when pred args ->

reportDeprecatedOption d

let rest = exec args in rest // arguments taken, rest remaining

| (_ :: more) -> attempt more

| [] ->

if opt.Length = 0 || opt.[0] = '-' || isSlashOpt opt

then

// want the whole opt token - delimiter and all

let unrecOpt = (opt.Split([|':'|]).[0])

errorR(Error(FSComp.SR.buildUnrecognizedOption(unrecOpt),rangeCmdArgs))

t

else

(collectOtherArgument opt; t)

let rest = attempt specs

processArg rest

let result = processArg args

result

let lexFilterVerbose = false

let mutable enableConsoleColoring = true // global state

let setFlag r n =

match n with

| 0 -> r false

| 1 -> r true

| _ -> raise (Failure "expected 0/1")

let SetOptimizeOff(tcConfigB : TcConfigBuilder) =

tcConfigB.optSettings <- { tcConfigB.optSettings with jitOptUser = Some false }

tcConfigB.optSettings <- { tcConfigB.optSettings with localOptUser = Some false }

tcConfigB.optSettings <- { tcConfigB.optSettings with crossModuleOptUser = Some false }

tcConfigB.optSettings <- { tcConfigB.optSettings with lambdaInlineThreshold = 0 }

tcConfigB.doDetuple <- false;

tcConfigB.doTLR <- false;

tcConfigB.doFinalSimplify <- false;

let SetOptimizeOn(tcConfigB : TcConfigBuilder) =

tcConfigB.optSettings <- { tcConfigB.optSettings with jitOptUser = Some true }

tcConfigB.optSettings <- { tcConfigB.optSettings with localOptUser = Some true }

tcConfigB.optSettings <- { tcConfigB.optSettings with crossModuleOptUser = Some true }

tcConfigB.optSettings <- { tcConfigB.optSettings with lambdaInlineThreshold = 6 }

tcConfigB.doDetuple <- true;

tcConfigB.doTLR <- true;

tcConfigB.doFinalSimplify <- true;

let SetOptimizeSwitch (tcConfigB : TcConfigBuilder) switch =

if (switch = OptionSwitch.On) then SetOptimizeOn(tcConfigB) else SetOptimizeOff(tcConfigB)

let SetTailcallSwitch (tcConfigB : TcConfigBuilder) switch =

tcConfigB.emitTailcalls <- (switch = OptionSwitch.On)

let jitoptimizeSwitch (tcConfigB : TcConfigBuilder) switch =

tcConfigB.optSettings <- { tcConfigB.optSettings with jitOptUser = Some (switch = OptionSwitch.On) }

let localoptimizeSwitch (tcConfigB : TcConfigBuilder) switch =

tcConfigB.optSettings <- { tcConfigB.optSettings with localOptUser = Some (switch = OptionSwitch.On) }

let crossOptimizeSwitch (tcConfigB : TcConfigBuilder) switch =

tcConfigB.optSettings <- { tcConfigB.optSettings with crossModuleOptUser = Some (switch = OptionSwitch.On) }

let splittingSwitch (tcConfigB : TcConfigBuilder) switch =

tcConfigB.optSettings <- { tcConfigB.optSettings with abstractBigTargets = switch = OptionSwitch.On }

let callVirtSwitch (tcConfigB : TcConfigBuilder) switch =

tcConfigB.alwaysCallVirt <- switch = OptionSwitch.On

let useHighEntropyVASwitch (tcConfigB : TcConfigBuilder) switch =

tcConfigB.useHighEntropyVA <- switch = OptionSwitch.On

let subSystemVersionSwitch (tcConfigB : TcConfigBuilder) (text : string) =

let fail() = error(Error(FSComp.SR.optsInvalidSubSystemVersion(text), rangeCmdArgs))

// per spec for 357994: Validate input string, should be two positive integers x.y when x>=4 and y>=0 and both <= 65535

if System.String.IsNullOrEmpty(text) then fail()

else

match text.Split('.') with

| [| majorStr; minorStr|] ->

match (Int32.TryParse majorStr), (Int32.TryParse minorStr) with

| (true, major), (true, minor) when major >= 4 && major <=65535 && minor >=0 && minor <= 65535 -> tcConfigB.subsystemVersion <- (major, minor)

| _ -> fail()

| _ -> fail()

let (++) x s = x @ [s]

let SetTarget (tcConfigB : TcConfigBuilder)(s : string) =

match s.ToLowerInvariant() with

| "exe" -> tcConfigB.target <- ConsoleExe

| "winexe" -> tcConfigB.target <- WinExe

| "library" -> tcConfigB.target <- Dll

| "module" -> tcConfigB.target <- Module

| _ -> error(Error(FSComp.SR.optsUnrecognizedTarget(s),rangeCmdArgs))

let SetDebugSwitch (tcConfigB : TcConfigBuilder) (dtype : string option) (s : OptionSwitch) =

match dtype with

| Some(s) ->

match s with

| "portable" -> tcConfigB.portablePDB <- true ; tcConfigB.embeddedPDB <- false; tcConfigB.jitTracking <- true; tcConfigB.ignoreSymbolStoreSequencePoints <- true

| "pdbonly" -> tcConfigB.portablePDB <- false; tcConfigB.embeddedPDB <- false; tcConfigB.jitTracking <- false

| "embedded" -> tcConfigB.portablePDB <- true; tcConfigB.embeddedPDB <- true; tcConfigB.jitTracking <- true; tcConfigB.ignoreSymbolStoreSequencePoints <- true

| "full" -> tcConfigB.portablePDB <- false; tcConfigB.embeddedPDB <- false; tcConfigB.jitTracking <- true

| _ -> error(Error(FSComp.SR.optsUnrecognizedDebugType(s), rangeCmdArgs))

| None -> tcConfigB.portablePDB <- false; tcConfigB.embeddedPDB <- false; tcConfigB.jitTracking <- s = OptionSwitch.On;

tcConfigB.debuginfo <- s = OptionSwitch.On

let SetEmbedAllSourceSwitch (tcConfigB : TcConfigBuilder) switch =

if (switch = OptionSwitch.On) then tcConfigB.embedAllSource <- true else tcConfigB.embedAllSource <- false

let setOutFileName tcConfigB s =

tcConfigB.outputFile <- Some s

let setSignatureFile tcConfigB s =

tcConfigB.printSignature <- true

tcConfigB.printSignatureFile <- s

let tagString = "<string>"

let tagExe = "exe"

let tagWinExe = "winexe"

let tagLibrary = "library"

let tagModule = "module"

let tagFile = "<file>"

let tagFileList = "<file;...>"

let tagDirList = "<dir;...>"

let tagPathList = "<path;...>"

let tagResInfo = "<resinfo>"

let tagFullPDBOnlyPortable = "{full|pdbonly|portable|embedded}"

let tagWarnList = "<warn;...>"

let tagSymbolList = "<symbol;...>"

let tagAddress = "<address>"

let tagInt = "<n>"

let tagNone = ""

let PrintOptionInfo (tcConfigB:TcConfigBuilder) =

printfn " jitOptUser . . . . . . : %+A" tcConfigB.optSettings.jitOptUser

printfn " localOptUser . . . . . : %+A" tcConfigB.optSettings.localOptUser

printfn " crossModuleOptUser . . : %+A" tcConfigB.optSettings.crossModuleOptUser

printfn " lambdaInlineThreshold : %+A" tcConfigB.optSettings.lambdaInlineThreshold

printfn " ignoreSymStoreSeqPts . : %+A" tcConfigB.ignoreSymbolStoreSequencePoints

printfn " doDetuple . . . . . . : %+A" tcConfigB.doDetuple

printfn " doTLR . . . . . . . . : %+A" tcConfigB.doTLR

printfn " doFinalSimplify. . . . : %+A" tcConfigB.doFinalSimplify

printfn " jitTracking . . . . . : %+A" tcConfigB.jitTracking

printfn " portablePDB. . . . . . : %+A" tcConfigB.portablePDB

printfn " embeddedPDB. . . . . . : %+A" tcConfigB.embeddedPDB

printfn " embedAllSource . . . . : %+A" tcConfigB.embedAllSource

printfn " embedSourceList. . . . : %+A" tcConfigB.embedSourceList

printfn " sourceLink . . . . . . : %+A" tcConfigB.sourceLink

printfn " debuginfo . . . . . . : %+A" tcConfigB.debuginfo

printfn " resolutionEnvironment : %+A" tcConfigB.resolutionEnvironment

printfn " product . . . . . . . : %+A" tcConfigB.productNameForBannerText

printfn " copyFSharpCore . . . . : %+A" tcConfigB.copyFSharpCore

tcConfigB.includes |> List.sort

|> List.iter (printfn " include . . . . . . . : %A")

let inputFileFlagsBoth (tcConfigB : TcConfigBuilder) =

[ CompilerOption("reference", tagFile, OptionString (fun s -> tcConfigB.AddReferencedAssemblyByPath (rangeStartup,s)), None,

Some (FSComp.SR.optsReference()) );

]

let referenceFlagAbbrev (tcConfigB : TcConfigBuilder) =

CompilerOption("r", tagFile, OptionString (fun s -> tcConfigB.AddReferencedAssemblyByPath (rangeStartup,s)), None,

Some(FSComp.SR.optsShortFormOf("--reference")) )

let inputFileFlagsFsi tcConfigB = inputFileFlagsBoth tcConfigB

let inputFileFlagsFsc tcConfigB = inputFileFlagsBoth tcConfigB

let errorsAndWarningsFlags (tcConfigB : TcConfigBuilder) =

[

CompilerOption("warnaserror", tagNone, OptionSwitch(fun switch -> tcConfigB.globalWarnAsError <- switch <> OptionSwitch.Off), None,

Some (FSComp.SR.optsWarnaserrorPM()));

CompilerOption("warnaserror", tagWarnList, OptionIntListSwitch (fun n switch ->

if switch = OptionSwitch.Off then

tcConfigB.specificWarnAsError <- ListSet.remove (=) n tcConfigB.specificWarnAsError ;

tcConfigB.specificWarnAsWarn <- ListSet.insert (=) n tcConfigB.specificWarnAsWarn

else

tcConfigB.specificWarnAsWarn <- ListSet.remove (=) n tcConfigB.specificWarnAsWarn ;

tcConfigB.specificWarnAsError <- ListSet.insert (=) n tcConfigB.specificWarnAsError), None,

Some (FSComp.SR.optsWarnaserror()));

CompilerOption("warn", tagInt, OptionInt (fun n ->

tcConfigB.globalWarnLevel <-

if (n >= 0 && n <= 5) then n

else error(Error(FSComp.SR.optsInvalidWarningLevel(n),rangeCmdArgs))), None,

Some (FSComp.SR.optsWarn()));

CompilerOption("nowarn", tagWarnList, OptionStringList (fun n -> tcConfigB.TurnWarningOff(rangeCmdArgs, n)), None,

Some (FSComp.SR.optsNowarn()));

CompilerOption("warnon", tagWarnList, OptionStringList (fun n -> tcConfigB.TurnWarningOn(rangeCmdArgs,n)), None,

Some(FSComp.SR.optsWarnOn()));

CompilerOption("consolecolors", tagNone, OptionSwitch (fun switch -> enableConsoleColoring <- switch = OptionSwitch.On), None,

Some (FSComp.SR.optsConsoleColors()))

]

let outputFileFlagsFsi (_tcConfigB : TcConfigBuilder) = []

let outputFileFlagsFsc (tcConfigB : TcConfigBuilder) =

[

CompilerOption("out", tagFile, OptionString (setOutFileName tcConfigB), None,

Some (FSComp.SR.optsNameOfOutputFile()) );

CompilerOption("target", tagExe, OptionString (SetTarget tcConfigB), None,

Some (FSComp.SR.optsBuildConsole()))

CompilerOption("target", tagWinExe, OptionString (SetTarget tcConfigB), None,

Some (FSComp.SR.optsBuildWindows()))

CompilerOption("target", tagLibrary, OptionString (SetTarget tcConfigB), None,

Some (FSComp.SR.optsBuildLibrary()))

CompilerOption("target", tagModule, OptionString (SetTarget tcConfigB), None,

Some (FSComp.SR.optsBuildModule()))

CompilerOption("delaysign", tagNone, OptionSwitch (fun s -> tcConfigB.delaysign <- (s = OptionSwitch.On)), None,

Some (FSComp.SR.optsDelaySign()))

CompilerOption("publicsign", tagNone, OptionSwitch (fun s -> tcConfigB.publicsign <- (s = OptionSwitch.On)), None,

Some (FSComp.SR.optsPublicSign()))

CompilerOption("doc", tagFile, OptionString (fun s -> tcConfigB.xmlDocOutputFile <- Some s), None,

Some (FSComp.SR.optsWriteXml()))

CompilerOption("keyfile", tagFile, OptionString (fun s -> tcConfigB.signer <- Some(s)), None,

Some (FSComp.SR.optsStrongKeyFile()))

CompilerOption("keycontainer", tagString, OptionString(fun s -> tcConfigB.container <- Some(s)),None,

Some(FSComp.SR.optsStrongKeyContainer()))

CompilerOption("platform", tagString, OptionString (fun s -> tcConfigB.platform <- match s with | "x86" -> Some X86 | "x64" -> Some AMD64 | "Itanium" -> Some IA64 | "anycpu32bitpreferred" -> (tcConfigB.prefer32Bit <- true; None) | "anycpu" -> None | _ -> error(Error(FSComp.SR.optsUnknownPlatform(s),rangeCmdArgs))), None,

Some(FSComp.SR.optsPlatform()))

CompilerOption("nooptimizationdata", tagNone, OptionUnit (fun () -> tcConfigB.onlyEssentialOptimizationData <- true), None,

Some (FSComp.SR.optsNoOpt()))

CompilerOption("nointerfacedata", tagNone, OptionUnit (fun () -> tcConfigB.noSignatureData <- true), None,

Some (FSComp.SR.optsNoInterface()))

CompilerOption("sig", tagFile, OptionString (setSignatureFile tcConfigB), None,

Some (FSComp.SR.optsSig()))

CompilerOption("nocopyfsharpcore", tagNone, OptionUnit (fun () -> tcConfigB.copyFSharpCore <- false), None, Some (FSComp.SR.optsNoCopyFsharpCore()))

]

let resourcesFlagsFsi (_tcConfigB : TcConfigBuilder) = []

let resourcesFlagsFsc (tcConfigB : TcConfigBuilder) =

[

CompilerOption("win32res", tagFile, OptionString (fun s -> tcConfigB.win32res <- s), None,

Some (FSComp.SR.optsWin32res()))

CompilerOption("win32manifest", tagFile, OptionString (fun s -> tcConfigB.win32manifest <- s), None,

Some (FSComp.SR.optsWin32manifest()))

CompilerOption("nowin32manifest", tagNone, OptionUnit (fun () -> tcConfigB.includewin32manifest <- false), None,

Some (FSComp.SR.optsNowin32manifest()))

CompilerOption("resource", tagResInfo, OptionString (fun s -> tcConfigB.AddEmbeddedResource s), None,

Some (FSComp.SR.optsResource()))

CompilerOption("linkresource", tagResInfo, OptionString (fun s -> tcConfigB.linkResources <- tcConfigB.linkResources ++ s), None,

Some (FSComp.SR.optsLinkresource()))

]

let codeGenerationFlags isFsi (tcConfigB : TcConfigBuilder) =

let debug =

[CompilerOption("debug", tagNone, OptionSwitch (SetDebugSwitch tcConfigB None), None,

Some (FSComp.SR.optsDebugPM()))

CompilerOption("debug", tagFullPDBOnlyPortable, OptionString (fun s -> SetDebugSwitch tcConfigB (Some(s)) OptionSwitch.On), None,

Some (FSComp.SR.optsDebug(if isFsi then "pdbonly" else "full")))

]

let embed =

[CompilerOption("embed", tagNone, OptionSwitch (SetEmbedAllSourceSwitch tcConfigB) , None,

Some (FSComp.SR.optsEmbedAllSource()))

CompilerOption("embed", tagFileList, OptionStringList (fun f -> tcConfigB.AddEmbeddedSourceFile f), None,

Some ( FSComp.SR.optsEmbedSource()));

CompilerOption("sourcelink", tagFile, OptionString (fun f -> tcConfigB.sourceLink <- f), None,

Some ( FSComp.SR.optsSourceLink()));

]

let codegen =

[CompilerOption("optimize", tagNone, OptionSwitch (SetOptimizeSwitch tcConfigB) , None,

Some (FSComp.SR.optsOptimize()))

CompilerOption("tailcalls", tagNone, OptionSwitch (SetTailcallSwitch tcConfigB), None,

Some (FSComp.SR.optsTailcalls()))

CompilerOption("crossoptimize", tagNone, OptionSwitch (crossOptimizeSwitch tcConfigB), None,

Some (FSComp.SR.optsCrossoptimize()))

]

if isFsi then debug @ codegen

else debug @ embed @ codegen

let defineSymbol tcConfigB s = tcConfigB.conditionalCompilationDefines <- s :: tcConfigB.conditionalCompilationDefines

let mlCompatibilityFlag (tcConfigB : TcConfigBuilder) =

CompilerOption("mlcompatibility", tagNone, OptionUnit (fun () -> tcConfigB.mlCompatibility<-true; tcConfigB.TurnWarningOff(rangeCmdArgs,"62")), None,

Some (FSComp.SR.optsMlcompatibility()))

let languageFlags tcConfigB =

[

CompilerOption("checked", tagNone, OptionSwitch (fun switch -> tcConfigB.checkOverflow <- (switch = OptionSwitch.On)), None,

Some (FSComp.SR.optsChecked()))

CompilerOption("define", tagString, OptionString (defineSymbol tcConfigB), None,

Some (FSComp.SR.optsDefine()))

mlCompatibilityFlag tcConfigB

]

let libFlag (tcConfigB : TcConfigBuilder) =

CompilerOption("lib", tagDirList, OptionStringList (fun s -> tcConfigB.AddIncludePath (rangeStartup,s,tcConfigB.implicitIncludeDir)), None,

Some (FSComp.SR.optsLib()))

let libFlagAbbrev (tcConfigB : TcConfigBuilder) =

CompilerOption("I", tagDirList, OptionStringList (fun s -> tcConfigB.AddIncludePath (rangeStartup,s,tcConfigB.implicitIncludeDir)), None,

Some (FSComp.SR.optsShortFormOf("--lib")))

let codePageFlag (tcConfigB : TcConfigBuilder) =

CompilerOption("codepage", tagInt, OptionInt (fun n ->

try

System.Text.Encoding.GetEncodingShim(n) |> ignore

with :? System.ArgumentException as err ->

error(Error(FSComp.SR.optsProblemWithCodepage(n,err.Message),rangeCmdArgs))

tcConfigB.inputCodePage <- Some(n)), None,

Some (FSComp.SR.optsCodepage()))

#if PREFERRED_UI_LANG

let preferredUiLang (tcConfigB: TcConfigBuilder) =

CompilerOption("preferreduilang", tagString, OptionString (fun s -> tcConfigB.preferredUiLang <- Some(s)), None, Some(FSComp.SR.optsStrongKeyContainer()))

let utf8OutputFlag (tcConfigB: TcConfigBuilder) =

CompilerOption("utf8output", tagNone, OptionUnit (fun () -> tcConfigB.utf8output <- true), None,

Some (FSComp.SR.optsUtf8output()))

let fullPathsFlag (tcConfigB : TcConfigBuilder) =

CompilerOption("fullpaths", tagNone, OptionUnit (fun () -> tcConfigB.showFullPaths <- true), None,

Some (FSComp.SR.optsFullpaths()))

let cliRootFlag (_tcConfigB : TcConfigBuilder) =

CompilerOption("cliroot", tagString, OptionString (fun _ -> ()), Some(DeprecatedCommandLineOptionFull(FSComp.SR.optsClirootDeprecatedMsg(), rangeCmdArgs)),

Some(FSComp.SR.optsClirootDescription()))

let SetTargetProfile tcConfigB v =

tcConfigB.primaryAssembly <-

match v with

| "mscorlib" -> PrimaryAssembly.Mscorlib

| "netcore" -> PrimaryAssembly.DotNetCore

| _ -> error(Error(FSComp.SR.optsInvalidTargetProfile(v), rangeCmdArgs))

let advancedFlagsBoth tcConfigB =

[

yield codePageFlag tcConfigB

yield utf8OutputFlag tcConfigB

#if PREFERRED_UI_LANG

yield preferredUiLang tcConfigB

yield fullPathsFlag tcConfigB

yield libFlag tcConfigB

yield CompilerOption("simpleresolution",

tagNone,

OptionUnit (fun () -> tcConfigB.useSimpleResolution<-true),

None,

Some (FSComp.SR.optsSimpleresolution()))

yield CompilerOption("targetprofile", tagString, OptionString (SetTargetProfile tcConfigB), None, Some(FSComp.SR.optsTargetProfile()))

]

let noFrameworkFlag isFsc tcConfigB =

CompilerOption("noframework", tagNone, OptionUnit (fun () ->

tcConfigB.framework <- false

if isFsc then

tcConfigB.implicitlyResolveAssemblies <- false), None,

Some (FSComp.SR.optsNoframework()))

let advancedFlagsFsi tcConfigB =

advancedFlagsBoth tcConfigB @

[

yield noFrameworkFlag false tcConfigB

]

let advancedFlagsFsc tcConfigB =

advancedFlagsBoth tcConfigB @

[

yield CompilerOption("baseaddress", tagAddress, OptionString (fun s -> tcConfigB.baseAddress <- Some(int32 s)), None, Some (FSComp.SR.optsBaseaddress()))

yield noFrameworkFlag true tcConfigB

yield CompilerOption("standalone", tagNone, OptionUnit (fun _ ->

tcConfigB.openDebugInformationForLaterStaticLinking <- true

tcConfigB.standalone <- true

tcConfigB.implicitlyResolveAssemblies <- true), None,

Some (FSComp.SR.optsStandalone()))

yield CompilerOption("staticlink", tagFile, OptionString (fun s -> tcConfigB.extraStaticLinkRoots <- tcConfigB.extraStaticLinkRoots @ [s]), None,

Some (FSComp.SR.optsStaticlink()))

#if ENABLE_MONO_SUPPORT

if runningOnMono then

yield CompilerOption("resident", tagFile, OptionUnit (fun () -> ()), None,

Some (FSComp.SR.optsResident()))

yield CompilerOption("pdb", tagString, OptionString (fun s -> tcConfigB.debugSymbolFile <- Some s), None,

Some (FSComp.SR.optsPdb()))

yield CompilerOption("highentropyva", tagNone, OptionSwitch (useHighEntropyVASwitch tcConfigB), None, Some (FSComp.SR.optsUseHighEntropyVA()))

yield CompilerOption("subsystemversion", tagString, OptionString (subSystemVersionSwitch tcConfigB), None, Some (FSComp.SR.optsSubSystemVersion()))

yield CompilerOption("quotations-debug", tagNone, OptionSwitch(fun switch -> tcConfigB.emitDebugInfoInQuotations <- switch = OptionSwitch.On), None, Some(FSComp.SR.optsEmitDebugInfoInQuotations()))

]

let testFlag tcConfigB =

CompilerOption("test", tagString, OptionString (fun s ->

match s with

| "ErrorRanges" -> tcConfigB.errorStyle <- ErrorStyle.TestErrors

| "MemberBodyRanges" -> PostTypeCheckSemanticChecks.testFlagMemberBody := true

| "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 }

| "HasEffect" -> tcConfigB.optSettings <- { tcConfigB.optSettings with reportHasEffect = true }

| "NoErrorText" -> FSComp.SR.SwallowResourceText <- true

| "EmitFeeFeeAs100001" -> tcConfigB.testFlagEmitFeeFeeAs100001 <- true

| "DumpDebugInfo" -> tcConfigB.dumpDebugInfo <- true

| "ShowLoadedAssemblies" -> tcConfigB.showLoadedAssemblies <- true

| "ContinueAfterParseFailure" -> tcConfigB.continueAfterParseFailure <- true

| str -> warning(Error(FSComp.SR.optsUnknownArgumentToTheTestSwitch(str),rangeCmdArgs))), None,

None)

let vsSpecificFlags (tcConfigB: TcConfigBuilder) =

[ CompilerOption("vserrors", tagNone, OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.VSErrors), None, None)

CompilerOption("validate-type-providers", tagNone, OptionUnit (id), None, None) // preserved for compatibility's sake, no longer has any effect

#if PREFERRED_UI_LANG

CompilerOption("LCID", tagInt, OptionInt (fun _n -> ()), None, None)

CompilerOption("LCID", tagInt, OptionInt (fun n -> tcConfigB.lcid <- Some(n)), None, None)

CompilerOption("flaterrors", tagNone, OptionUnit (fun () -> tcConfigB.flatErrors <- true), None, None)

CompilerOption("sqmsessionguid", tagNone, OptionString (fun s -> tcConfigB.sqmSessionGuid <- try System.Guid(s) |> Some with e -> None), None, None)

CompilerOption("gccerrors", tagNone, OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.GccErrors), None, None)

CompilerOption("exename", tagNone, OptionString (fun s -> tcConfigB.exename <- Some(s)), None, None)

CompilerOption("maxerrors", tagInt, OptionInt (fun n -> tcConfigB.maxErrors <- n), None, None) ]

let internalFlags (tcConfigB:TcConfigBuilder) =

[

CompilerOption("stamps", tagNone, OptionUnit (fun () -> ()), Some(InternalCommandLineOption("--stamps", rangeCmdArgs)), None)

CompilerOption("ranges", tagNone, OptionSet Tastops.DebugPrint.layoutRanges, Some(InternalCommandLineOption("--ranges", rangeCmdArgs)), None)

CompilerOption("terms" , tagNone, OptionUnit (fun () -> tcConfigB.showTerms <- true), Some(InternalCommandLineOption("--terms", rangeCmdArgs)), None)

CompilerOption("termsfile" , tagNone, OptionUnit (fun () -> tcConfigB.writeTermsToFiles <- true), Some(InternalCommandLineOption("--termsfile", rangeCmdArgs)), None)

#if DEBUG

CompilerOption("debug-parse", tagNone, OptionUnit (fun () -> Internal.Utilities.Text.Parsing.Flags.debug <- true), Some(InternalCommandLineOption("--debug-parse", rangeCmdArgs)), None)

CompilerOption("pause", tagNone, OptionUnit (fun () -> tcConfigB.pause <- true), Some(InternalCommandLineOption("--pause", rangeCmdArgs)), None)