Merge remote-tracking branch 'upstream/main' into otel

DEVGUIDE.md

@@ -121,6 +121,18 @@ You can find all test options as separate flags. For example `build -testAll`:
 
 Running any of the above will build the latest changes and run tests against them.
 
+## Using your custom compiler to build other projects
+
+Building the compiler using `build.cmd` or `build.sh` will output artifacts in `artifacts\bin`. 
+
+To use your custom build of `Fsc`, add the `DotnetFscCompilerPath` property to your project's `.fsproj` file, adjusted to point at your local build directory, build configuration, and target framework as appropriate:
+
+```xml
+<PropertyGroup>
+    <DotnetFscCompilerPath>D:\Git\fsharp\artifacts\bin\fsc\Debug\net7.0\fsc.dll</DotnetFscCompilerPath>
+</PropertyGroup>
+```
+
 ## Updating FSComp.fs, FSComp.resx and XLF
 
 If your changes involve modifying the list of language keywords in any way, (e.g. when implementing a new keyword), the XLF localization files need to be synced with the corresponding resx files. This can be done automatically by running

azure-pipelines.yml

@@ -445,9 +445,8 @@ stages:
 
         # MacOS
         - job: MacOS
-          condition: eq(1,2)
           pool:
-            vmImage: $(MacOSMachineQueueName)
+            vmImage: macos-11
           variables:
           - name: _SignType
             value: Test
@@ -576,9 +575,8 @@ stages:
 
         # Plain build Mac
         - job: Plain_Build_MacOS
-          condition: eq(1,2)
           pool:
-            vmImage: $(MacOSMachineQueueName)
+            vmImage: macos-11
           variables:
           - name: _BuildConfig
             value: Debug

eng/common/templates/job/source-index-stage1.yml

@@ -29,7 +29,7 @@ jobs:
     pool:
       ${{ if eq(variables['System.TeamProject'], 'public') }}:
         name: NetCore-Public
-        demands: ImageOverride -equals windows.vs2019.amd64.open
+        demands: ImageOverride -equals Build.Server.Amd64.VS2019.Open
       ${{ if eq(variables['System.TeamProject'], 'internal') }}:
         name: NetCore1ESPool-Internal
         demands: ImageOverride -equals windows.vs2019.amd64

src/Compiler/AbstractIL/ilwritepdb.fs

@@ -1037,6 +1037,6 @@ let rec pushShadowedLocals (stackGuard: StackGuard) (localsToPush: PdbLocalVar[]
 //     adding the text " (shadowed)" to the names of those with name conflicts.
 let unshadowScopes rootScope =
     // Avoid stack overflow when writing linearly nested scopes
-    let stackGuard = StackGuard(100)
+    let stackGuard = StackGuard(100, "ILPdbWriter.unshadowScopes")
     let result, _ = pushShadowedLocals stackGuard [||] rootScope
     result

src/Compiler/Checking/CheckBasics.fs

@@ -341,7 +341,7 @@ type TcFileState =
         { g = g
           amap = amap
           recUses = ValMultiMap<_>.Empty
-          stackGuard = StackGuard(TcStackGuardDepth)
+          stackGuard = StackGuard(TcStackGuardDepth, "TcFileState")
           createsGeneratedProvidedTypes = false
           thisCcu = thisCcu
           isScript = isScript

src/Compiler/Checking/CheckIncrementalClasses.fs

@@ -527,7 +527,7 @@ type IncrClassReprInfo =
                         PostTransform = (fun _ -> None)
                         PreInterceptBinding = None
                         RewriteQuotations = true
-                        StackGuard = StackGuard(TcClassRewriteStackGuardDepth) } expr 
+                        StackGuard = StackGuard(TcClassRewriteStackGuardDepth, "FixupIncrClassExprPhase2C") } expr 
 
 type IncrClassConstructionBindingsPhase2C =
     | Phase2CBindings of IncrClassBindingGroup list

src/Compiler/Checking/FindUnsolved.fs

@@ -285,7 +285,7 @@ let UnsolvedTyparsOfModuleDef g amap denv mdef extraAttribs =
           amap=amap 
           denv=denv 
           unsolved = [] 
-          stackGuard = StackGuard(FindUnsolvedStackGuardDepth) }
+          stackGuard = StackGuard(FindUnsolvedStackGuardDepth, "UnsolvedTyparsOfModuleDef") }
     accModuleOrNamespaceDef cenv NoEnv mdef
     accAttribs cenv NoEnv extraAttribs
     List.rev cenv.unsolved

src/Compiler/Checking/PostInferenceChecks.fs

@@ -2615,7 +2615,7 @@ let CheckImplFile (g, amap, reportErrors, infoReader, internalsVisibleToPaths, v
           reportErrors = reportErrors 
           boundVals = Dictionary<_, _>(100, HashIdentity.Structural) 
           limitVals = Dictionary<_, _>(100, HashIdentity.Structural) 
-          stackGuard = StackGuard(PostInferenceChecksStackGuardDepth)
+          stackGuard = StackGuard(PostInferenceChecksStackGuardDepth, "CheckImplFile")
           potentialUnboundUsesOfVals = Map.empty 
           anonRecdTypes = StampMap.Empty
           usesQuotations = false 

src/Compiler/CodeGen/IlxGen.fs

@@ -6804,7 +6804,15 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) boxity eenvouter takenN
         NestedTypeRefForCompLoc eenvouter.cloc cloName
 
     // Collect the free variables of the closure
-    let cloFreeVarResults = freeInExpr (CollectTyparsAndLocalsWithStackGuard()) expr
+    let cloFreeVarResults =
+        let opts = CollectTyparsAndLocalsWithStackGuard()
+
+        let opts =
+            match eenvouter.tyenv.TemplateReplacement with
+            | None -> opts
+            | Some (tcref, _, typars, _) -> opts.WithTemplateReplacement(tyconRefEq g tcref, typars)
+
+        freeInExpr opts expr
 
     // Partition the free variables when some can be accessed from places besides the immediate environment
     // Also filter out the current value being bound, if any, as it is available from the "this"
@@ -11863,7 +11871,7 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: Constrai
             intraAssemblyInfo = intraAssemblyInfo
             optionsOpt = None
             optimizeDuringCodeGen = (fun _flag expr -> expr)
-            stackGuard = StackGuard(IlxGenStackGuardDepth)
+            stackGuard = StackGuard(IlxGenStackGuardDepth, "IlxAssemblyGenerator")
         }
 
     /// Register a set of referenced assemblies with the ILX code generator

src/Compiler/Driver/CompilerOptions.fs

@@ -261,31 +261,40 @@ let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: Compiler
 
     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.StartsWithOrdinal("--") then
-                opt <- opt[2..]
+    // returns a tuple - the option minus switchchars, the option tokenand  the option argument string
+    let parseOption (option: string) =
+
+        // Get option arguments, I.e everything following first:
+        let opts = option.Split([| ':' |])
+        let optArgs = String.Join(":", opts[1..])
+
+        let opt =
+            if option = "" then
+                ""
+            // if it doesn't start with a '-' or '/', reject outright
+            elif option[0] <> '-' && option[0] <> '/' then
+                ""
+            elif option <> "--" then
+                // is it an abbreviated or MSFT-style option?
+                // if so, strip the first character and move on with your life
+                // Wierdly a -- option can't have only a 1 character name
+                if option.Length = 2 || isSlashOpt option then
+                    option[1..]
+                elif option.Length >= 3 && option[2] = ':' then
+                    option[1..]
+                elif option.StartsWithOrdinal("--") then
+                    match option.Length with
+                    | l when l >= 4 && option[3] = ':' -> ""
+                    | l when l > 3 -> option[2..]
+                    | _ -> ""
+                else
+                    ""
             else
-                opt <- ""
+                option
 
-        // get the argument string
-        let optArgs = if opts.Length > 1 then String.Join(":", opts[1..]) else ""
-        opt, optArgs
+        // grab the option token
+        let token = opt.Split([| ':' |])[0]
+        opt, token, optArgs
 
     let getOptionArg compilerOption (argString: string) =
         if argString = "" then
@@ -352,7 +361,7 @@ let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: Compiler
 
             processArg (responseFileOptions @ t)
         | opt :: t ->
-            let optToken, argString = parseOption opt
+            let option, optToken, argString = parseOption opt
 
             let reportDeprecatedOption errOpt =
                 match errOpt with
@@ -361,7 +370,7 @@ let ParseCompilerOptions (collectOtherArgument: string -> unit, blocks: Compiler
 
             let rec attempt l =
                 match l with
-                | CompilerOption (s, _, OptionConsoleOnly f, d, _) :: _ when optToken = s && argString = "" ->
+                | CompilerOption (s, _, OptionConsoleOnly f, d, _) :: _ when option = s ->
                     reportDeprecatedOption d
                     f blocks
                     t
@@ -710,7 +719,7 @@ let tagAlgorithm = "{SHA1|SHA256}"
 let tagInt = "<n>"
 let tagPathMap = "<path=sourcePath;...>"
 let tagNone = ""
-let tagLangVersionValues = "{?|version|latest|preview}"
+let tagLangVersionValues = "{version|latest|preview}"
 
 // PrintOptionInfo
 //----------------
@@ -1104,23 +1113,16 @@ let mlCompatibilityFlag (tcConfigB: TcConfigBuilder) =
         Some(FSComp.SR.optsMlcompatibility ())
     )
 
-/// LanguageVersion management
-let setLanguageVersion specifiedVersion =
-
-    let dumpAllowedValues () =
-        printfn "%s" (FSComp.SR.optsSupportedLangVersions ())
-
-        for v in LanguageVersion.ValidOptions do
-            printfn "%s" v
-
-        for v in LanguageVersion.ValidVersions do
-            printfn "%s" v
-
-        exit 0
+let GetLanguageVersions () =
+    seq {
+        FSComp.SR.optsSupportedLangVersions ()
+        yield! LanguageVersion.ValidOptions
+        yield! LanguageVersion.ValidVersions
+    }
+    |> String.concat Environment.NewLine
 
-    if specifiedVersion = "?" then
-        dumpAllowedValues ()
-    elif specifiedVersion.ToUpperInvariant() = "PREVIEW" then
+let setLanguageVersion (specifiedVersion: string) =
+    if specifiedVersion.ToUpperInvariant() = "PREVIEW" then
         ()
     elif not (LanguageVersion.ContainsVersion specifiedVersion) then
         error (Error(FSComp.SR.optsUnrecognizedLanguageVersion specifiedVersion, rangeCmdArgs))
@@ -1130,6 +1132,16 @@ let setLanguageVersion specifiedVersion =
 let languageFlags tcConfigB =
     [
         // -langversion:?                Display the allowed values for language version
+        CompilerOption(
+            "langversion:?",
+            tagNone,
+            OptionConsoleOnly(fun _ ->
+                Console.Write(GetLanguageVersions())
+                exit 0),
+            None,
+            Some(FSComp.SR.optsGetLangVersions ())
+        )
+
         // -langversion:<string>         Specify language version such as
         //                               'default' (latest major version), or
         //                               'latest' (latest version, including minor versions),
@@ -1140,7 +1152,7 @@ let languageFlags tcConfigB =
             tagLangVersionValues,
             OptionString(fun switch -> tcConfigB.langVersion <- setLanguageVersion (switch)),
             None,
-            Some(FSComp.SR.optsLangVersion ())
+            Some(FSComp.SR.optsSetLangVersion ())
         )
 
         CompilerOption(

src/Compiler/Driver/CompilerOptions.fsi

@@ -58,6 +58,8 @@ val GetHelpFsc: tcConfigB: TcConfigBuilder -> blocks: CompilerOptionBlock list -
 
 val GetVersion: tcConfigB: TcConfigBuilder -> string
 
+val GetLanguageVersions: unit -> string
+
 val GetCoreFscCompilerOptions: TcConfigBuilder -> CompilerOptionBlock list
 
 val GetCoreFsiCompilerOptions: TcConfigBuilder -> CompilerOptionBlock list

src/Compiler/FSComp.txt

@@ -1523,7 +1523,8 @@ notAFunctionButMaybeDeclaration,"This value is not a function and cannot be appl
 3353,chkFeatureNotSupportedInLibrary,"Feature '%s' requires the F# library for language version %s or greater."
 3360,parsEqualsMissingInTypeDefinition,"Unexpected token in type definition. Expected '=' after the type '%s'."
 useSdkRefs,"Use reference assemblies for .NET framework references when available (Enabled by default)."
-optsLangVersion,"Display the allowed values for language version, specify language version such as 'latest' or 'preview'"
+optsGetLangVersions,"Display the allowed values for language version."
+optsSetLangVersion,"Specify language version such as 'latest' or 'preview'."
 optsSupportedLangVersions,"Supported language versions:"
 nativeResourceFormatError,"Stream does not begin with a null resource and is not in '.RES' format."
 nativeResourceHeaderMalformed,"Resource header beginning at offset %s is malformed."

src/Compiler/Facilities/DiagnosticsLogger.fs

@@ -813,7 +813,7 @@ let internal languageFeatureNotSupportedInLibraryError (langFeature: LanguageFea
     error (Error(FSComp.SR.chkFeatureNotSupportedInLibrary (featureStr, suggestedVersionStr), m))
 
 /// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached
-type StackGuard(maxDepth: int) =
+type StackGuard(maxDepth: int, name: string) =
 
     let mutable depth = 1
 
@@ -828,7 +828,7 @@ type StackGuard(maxDepth: int) =
 
                 async {
                     do! Async.SwitchToNewThread()
-                    Thread.CurrentThread.Name <- "F# Extra Compilation Thread"
+                    Thread.CurrentThread.Name <- $"F# Extra Compilation Thread for {name} (depth {depth})"
                     use _scope = new CompilationGlobalsScope(diagnosticsLogger, buildPhase)
                     return f ()
                 }

src/Compiler/Facilities/DiagnosticsLogger.fsi

@@ -389,7 +389,7 @@ val tryLanguageFeatureErrorOption:
 val languageFeatureNotSupportedInLibraryError: langFeature: LanguageFeature -> m: range -> 'T
 
 type StackGuard =
-    new: maxDepth: int -> StackGuard
+    new: maxDepth: int * name: string -> StackGuard
 
     /// Execute the new function, on a new thread if necessary
     member Guard: f: (unit -> 'T) -> 'T

src/Compiler/Optimize/DetupleArgs.fs

@@ -864,7 +864,7 @@ let passImplFile penv assembly =
           PreInterceptBinding = None
           PostTransform = postTransformExpr penv
           RewriteQuotations = false
-          StackGuard = StackGuard(DetupleRewriteStackGuardDepth) } 
+          StackGuard = StackGuard(DetupleRewriteStackGuardDepth, "RewriteImplFile") } 
     assembly |> RewriteImplFile rwenv
 
 //-------------------------------------------------------------------------

src/Compiler/Optimize/InnerLambdasToTopLevelFuncs.fs

@@ -1366,7 +1366,7 @@ let MakeTopLevelRepresentationDecisions ccu g expr =
                 recShortCallS = recShortCallS
                 envPackM = envPackM
                 fHatM = fHatM
-                stackGuard = StackGuard(InnerLambdasToTopLevelFunctionsStackGuardDepth) }
+                stackGuard = StackGuard(InnerLambdasToTopLevelFunctionsStackGuardDepth, "InnerLambdasToTopLevelFunctionsStackGuardDepth") }
           let z = Pass4_RewriteAssembly.rewriteState0
           Pass4_RewriteAssembly.TransImplFile penv z expr
 

src/Compiler/Optimize/LowerCalls.fs

@@ -49,5 +49,5 @@ let LowerImplFile g assembly =
           PreInterceptBinding=None
           PostTransform= (fun _ -> None)
           RewriteQuotations=false
-          StackGuard = StackGuard(LowerCallsRewriteStackGuardDepth) }
+          StackGuard = StackGuard(LowerCallsRewriteStackGuardDepth, "LowerCallsRewriteStackGuardDepth") }
     assembly |> RewriteImplFile rwenv

src/Compiler/Optimize/LowerLocalMutables.fs

@@ -196,6 +196,6 @@ let TransformImplFile g amap implFile =
                 PreInterceptBinding = Some(TransformBinding g heapValMap)
                 PostTransform = (fun _ -> None)
                 RewriteQuotations = true
-                StackGuard = StackGuard(AutoboxRewriteStackGuardDepth) } 
+                StackGuard = StackGuard(AutoboxRewriteStackGuardDepth, "AutoboxRewriteStackGuardDepth") } 
 
 

src/Compiler/Optimize/LowerStateMachines.fs

@@ -358,7 +358,7 @@ type LowerStateMachine(g: TcGlobals) =
           PostTransform = (fun _ -> None)
           PreInterceptBinding = None
           RewriteQuotations=true 
-          StackGuard = StackGuard(LowerStateMachineStackGuardDepth) }
+          StackGuard = StackGuard(LowerStateMachineStackGuardDepth, "LowerStateMachineStackGuardDepth") }
 
     let ConvertStateMachineLeafExpression (env: env) expr = 
         if sm_verbose then printfn "ConvertStateMachineLeafExpression for %A..." expr

src/Compiler/Optimize/Optimizer.fs

@@ -4325,7 +4325,7 @@ let OptimizeImplFile (settings, ccu, tcGlobals, tcVal, importMap, optEnv, isIncr
           localInternalVals=Dictionary<Stamp, ValInfo>(10000)
           emitTailcalls=emitTailcalls
           casApplied=Dictionary<Stamp, bool>() 
-          stackGuard = StackGuard(OptimizerStackGuardDepth) 
+          stackGuard = StackGuard(OptimizerStackGuardDepth, "OptimizerStackGuardDepth") 
         }
 
     let env, _, _, _ as results = OptimizeImplFileInternal cenv optEnv isIncrementalFragment fsiMultiAssemblyEmit hidden mimpls  

src/Compiler/SyntaxTree/ParseHelpers.fs

@@ -847,7 +847,7 @@ let adjustHatPrefixToTyparLookup mFull rightExpr =
     take rightExpr
 
 // The last element of elementTypes does not have a star or slash
-let mkSynTypeTuple (isStruct: bool) (elementTypes: SynTupleTypeSegment list) : SynType =
+let mkSynTypeTuple (elementTypes: SynTupleTypeSegment list) : SynType =
     let range =
         match elementTypes with
         | [] -> Range.Zero
@@ -856,4 +856,4 @@ let mkSynTypeTuple (isStruct: bool) (elementTypes: SynTupleTypeSegment list) : S
             (head.Range, tail)
             ||> List.fold (fun acc segment -> unionRanges acc segment.Range)
 
-    SynType.Tuple(isStruct, elementTypes, range)
+    SynType.Tuple(false, elementTypes, range)

src/Compiler/SyntaxTree/ParseHelpers.fsi

@@ -179,4 +179,4 @@ val mkSynMemberDefnGetSet:
 /// Incorporate a '^' for an qualified access to a generic type parameter
 val adjustHatPrefixToTyparLookup: mFull: range -> rightExpr: SynExpr -> SynExpr
 
-val mkSynTypeTuple: isStruct: bool -> elementTypes: SynTupleTypeSegment list -> SynType
+val mkSynTypeTuple: elementTypes: SynTupleTypeSegment list -> SynType