Merge main to release/dev17.8

eng/Version.Details.xml

@@ -29,9 +29,9 @@
     </Dependency>
   </ProductDependencies>
   <ToolsetDependencies>
-    <Dependency Name="Microsoft.DotNet.Arcade.Sdk" Version="8.0.0-beta.23369.2">
+    <Dependency Name="Microsoft.DotNet.Arcade.Sdk" Version="8.0.0-beta.23370.6">
       <Uri>https://github.com/dotnet/arcade</Uri>
-      <Sha>9fba71ca242ef84c4b7696c380cc00efe734adb3</Sha>
+      <Sha>a2d7c72df5b2e36b0f69bbe12ad4d7c52793c745</Sha>
       <SourceBuild RepoName="arcade" ManagedOnly="true" />
     </Dependency>
     <Dependency Name="Microsoft.SourceLink.GitHub" Version="8.0.0-beta.23361.2" CoherentParentDependency="Microsoft.DotNet.Arcade.Sdk">

eng/common/sdl/configure-sdl-tool.ps1

@@ -93,7 +93,9 @@ try {
       }
       'binskim' {
         if ($targetDirectory) {
-          $tool.Args += "`"Target < $TargetDirectory\**`""
+          # Binskim crashes due to specific PDBs. GitHub issue: https://github.com/microsoft/binskim/issues/924.
+          # We are excluding all `_.pdb` files from the scan.
+          $tool.Args += "`"Target < $TargetDirectory\**;-:file|$TargetDirectory\**\_.pdb`""
         }
         $tool.Args += $BinskimAdditionalRunConfigParams
       }

global.json

@@ -18,7 +18,7 @@
     "perl": "5.32.1.1"
   },
   "msbuild-sdks": {
-    "Microsoft.DotNet.Arcade.Sdk": "8.0.0-beta.23369.2",
+    "Microsoft.DotNet.Arcade.Sdk": "8.0.0-beta.23370.6",
     "Microsoft.DotNet.Helix.Sdk": "8.0.0-beta.23255.2"
   }
 }

src/Compiler/Checking/ConstraintSolver.fs

@@ -397,53 +397,22 @@ let rec isNativeIntegerTy g ty =
     typeEquivAux EraseMeasures g g.unativeint_ty ty ||
     (isEnumTy g ty && isNativeIntegerTy g (underlyingTypeOfEnumTy g ty))
 
-let isSignedIntegerTy g ty =
-    typeEquivAux EraseMeasures g g.sbyte_ty ty || 
-    typeEquivAux EraseMeasures g g.int16_ty ty || 
-    typeEquivAux EraseMeasures g g.int32_ty ty || 
-    typeEquivAux EraseMeasures g g.nativeint_ty ty || 
-    typeEquivAux EraseMeasures g g.int64_ty ty 
-
-let isUnsignedIntegerTy g ty =
-    typeEquivAux EraseMeasures g g.byte_ty ty || 
-    typeEquivAux EraseMeasures g g.uint16_ty ty || 
-    typeEquivAux EraseMeasures g g.uint32_ty ty || 
-    typeEquivAux EraseMeasures g g.unativeint_ty ty || 
-    typeEquivAux EraseMeasures g g.uint64_ty ty 
-
 let rec IsIntegerOrIntegerEnumTy g ty =
     isSignedIntegerTy g ty || 
     isUnsignedIntegerTy g ty || 
     (isEnumTy g ty && IsIntegerOrIntegerEnumTy g (underlyingTypeOfEnumTy g ty))
 
-let isIntegerTy g ty =
-    isSignedIntegerTy g ty || 
-    isUnsignedIntegerTy g ty 
-
 let isStringTy g ty = typeEquiv g g.string_ty ty 
 
 let isCharTy g ty = typeEquiv g g.char_ty ty 
 
 let isBoolTy g ty = typeEquiv g g.bool_ty ty 
 
-/// float or float32 or float<_> or float32<_> 
-let isFpTy g ty =
-    typeEquivAux EraseMeasures g g.float_ty ty || 
-    typeEquivAux EraseMeasures g g.float32_ty ty 
-
-/// decimal or decimal<_>
-let isDecimalTy g ty = 
-    typeEquivAux EraseMeasures g g.decimal_ty ty
-
 let IsNonDecimalNumericOrIntegralEnumType g ty = IsIntegerOrIntegerEnumTy g ty || isFpTy g ty
 
 let IsNumericOrIntegralEnumType g ty = IsNonDecimalNumericOrIntegralEnumType g ty || isDecimalTy g ty
 
-let IsNonDecimalNumericType g ty = isIntegerTy g ty || isFpTy g ty
-
-let IsNumericType g ty = IsNonDecimalNumericType g ty || isDecimalTy g ty
-
-let IsRelationalType g ty = IsNumericType g ty || isStringTy g ty || isCharTy g ty || isBoolTy g ty
+let IsRelationalType g ty = isNumericType g ty || isStringTy g ty || isCharTy g ty || isBoolTy g ty
 
 let IsCharOrStringType g ty = isCharTy g ty || isStringTy g ty
 
@@ -1517,12 +1486,12 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
       // We pretend for uniformity that the numeric types have a static property called Zero and One 
       // As with constants, only zero is polymorphic in its units
       | [], [ty], false, "get_Zero", [] 
-          when IsNumericType g ty || isCharTy g ty -> 
+          when isNumericType g ty || isCharTy g ty -> 
           do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy ty
           return TTraitBuiltIn
 
       | [], [ty], false, "get_One", [] 
-          when IsNumericType g ty || isCharTy g ty -> 
+          when isNumericType g ty || isCharTy g ty -> 
           do! SolveDimensionlessNumericType csenv ndeep m2 trace ty 
           do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy ty
           return TTraitBuiltIn

src/Compiler/FSComp.txt

@@ -962,6 +962,7 @@ typeInfoFromFirst,"from %s"
 typeInfoFromNext,"also from %s"
 typeInfoGeneratedProperty,"generated property"
 typeInfoGeneratedType,"generated type"
+suggestedName,"(Suggested name)"
 1089,recursiveClassHierarchy,"Recursive class hierarchy in type '%s'"
 1090,InvalidRecursiveReferenceToAbstractSlot,"Invalid recursive reference to an abstract slot"
 1091,eventHasNonStandardType,"The event '%s' has a non-standard type. If this event is declared in another CLI language, you may need to access this event using the explicit %s and %s methods for the event. If this event is declared in F#, make the type of the event an instantiation of either 'IDelegateEvent<_>' or 'IEvent<_,_>'."

src/Compiler/Service/FSharpCheckerResults.fs

@@ -49,11 +49,6 @@ open FSharp.Compiler.Text.Range
 open FSharp.Compiler.TypedTree
 open FSharp.Compiler.TypedTreeBasics
 open FSharp.Compiler.TypedTreeOps
-open FSharp.Compiler.AbstractIL
-open System.Reflection.PortableExecutable
-open FSharp.Compiler.CreateILModule
-open FSharp.Compiler.IlxGen
-open FSharp.Compiler.BuildGraph
 
 open Internal.Utilities
 open Internal.Utilities.Collections
@@ -934,6 +929,85 @@ type internal TypeCheckInfo
 
     let DefaultCompletionItem item = CompletionItem ValueNone ValueNone item
 
+    let CompletionItemSuggestedName displayName =
+        {
+            ItemWithInst = ItemWithNoInst(Item.NewDef(Ident(displayName, range0)))
+            MinorPriority = 0
+            Type = None
+            Kind = CompletionItemKind.SuggestedName
+            IsOwnMember = false
+            Unresolved = None
+        }
+
+    /// Checks whether the suggested name is unused.
+    /// In the future we could use an increasing numeric suffix for conflict resolution
+    let CreateCompletionItemForSuggestedPatternName (pos: pos) name =
+        if String.IsNullOrWhiteSpace name then
+            None
+        else
+            let name = String.lowerCaseFirstChar name
+
+            let unused =
+                sResolutions.CapturedNameResolutions
+                |> ResizeArray.forall (fun r ->
+                    match r.Item with
+                    | Item.Value vref when r.Pos.Line = pos.Line -> vref.DisplayName <> name
+                    | _ -> true)
+
+            if unused then
+                Some(CompletionItemSuggestedName name)
+            else
+                None
+
+    /// Suggest name based on type
+    let SuggestNameBasedOnType g pos ty =
+        if isNumericType g ty then
+            CreateCompletionItemForSuggestedPatternName pos "num"
+        else
+            match tryTcrefOfAppTy g ty with
+            | ValueSome tcref when not (tyconRefEq g g.system_Object_tcref tcref) ->
+                CreateCompletionItemForSuggestedPatternName pos tcref.DisplayName
+            | _ -> None
+
+    /// Suggest names based on field name and type, add them to the list
+    let SuggestNameForUnionCaseFieldPattern g caseIdPos fieldPatternPos (uci: UnionCaseInfo) indexOrName completions =
+        let field =
+            match indexOrName with
+            | Choice1Of2 index ->
+                // Index is None when parentheses were not used, i.e. "| Some v ->" - suggest a name only when the case has a single field
+                match uci.UnionCase.RecdFieldsArray, index with
+                | [| field |], None -> Some field
+                | [| _ |], Some _
+                | _, None -> None
+                | arr, Some index -> arr |> Array.tryItem index
+            | Choice2Of2 name -> uci.UnionCase.RecdFieldsArray |> Array.tryFind (fun x -> x.DisplayName = name)
+
+        field
+        |> Option.map (fun field ->
+            let ty =
+                // If the field type is generic, suggest a name based on the solution
+                if isTyparTy g field.FormalType then
+                    sResolutions.CapturedNameResolutions
+                    |> ResizeArray.tryPick (fun r ->
+                        match r.Item with
+                        | Item.Value vref when r.Pos = fieldPatternPos -> Some(stripTyparEqns vref.Type)
+                        | _ -> None)
+                    |> Option.defaultValue field.FormalType
+                else
+                    field.FormalType
+
+            let fieldName =
+                // If the field has not been given an explicit name, do not suggest the generated one
+                if field.rfield_name_generated then
+                    ""
+                else
+                    field.DisplayName
+
+            completions
+            |> List.prependIfSome (SuggestNameBasedOnType g caseIdPos ty)
+            |> List.prependIfSome (CreateCompletionItemForSuggestedPatternName caseIdPos fieldName))
+        |> Option.defaultValue completions
+
     let getItem (x: ItemWithInst) = x.Item
 
     let GetDeclaredItems
@@ -1182,10 +1256,10 @@ type internal TypeCheckInfo
             | atStart when atStart = 0 -> 0
             | otherwise -> otherwise - 1
 
+        let pos = mkPos line colAtEndOfNamesAndResidue
+
         // Look for a "special" completion context
         let completionContext =
-            let pos = mkPos line colAtEndOfNamesAndResidue
-
             // If the completion context we have computed higher up the stack is for the same position,
             // reuse it, otherwise recompute
             match completionContextAtPos with
@@ -1400,7 +1474,7 @@ type internal TypeCheckInfo
                     m)
 
             // Completion at '(x: ...)"
-            | Some CompletionContext.PatternType
+            | Some CompletionContext.Type
             // Completion at  '| Case1 of ...'
             | Some CompletionContext.UnionCaseFieldsDeclaration
             // Completion at 'type Long = int6...' or 'type SomeUnion = Abc...'
@@ -1434,6 +1508,51 @@ type internal TypeCheckInfo
                     denv,
                     m)
 
+            | Some (CompletionContext.Pattern patternContext) ->
+                let declaredItems =
+                    GetDeclaredItems(
+                        parseResultsOpt,
+                        lineStr,
+                        origLongIdentOpt,
+                        colAtEndOfNamesAndResidue,
+                        residueOpt,
+                        lastDotPos,
+                        line,
+                        loc,
+                        filterCtors,
+                        resolveOverloads,
+                        false,
+                        getAllSymbols
+                    )
+                    |> Option.map (fun (items, denv, range) ->
+                        let filtered =
+                            items
+                            |> List.filter (fun item ->
+                                match item.Item with
+                                | Item.Value v -> v.LiteralValue.IsSome
+                                | _ -> true)
+
+                        filtered, denv, range)
+
+                let indexOrName, caseIdRange =
+                    match patternContext with
+                    | PatternContext.PositionalUnionCaseField (index, m) -> Choice1Of2 index, m
+                    | PatternContext.NamedUnionCaseField (name, m) -> Choice2Of2 name, m
+                    | PatternContext.Other -> Choice1Of2 None, range0
+
+                // No special handling for PatternContext.Other other than filtering out non-literal values
+                if equals caseIdRange range0 then
+                    declaredItems
+                else
+                    GetCapturedNameResolutions caseIdRange.End ResolveOverloads.Yes
+                    |> ResizeArray.tryPick (fun r ->
+                        match r.Item with
+                        | Item.UnionCase (uci, _) ->
+                            let list = declaredItems |> Option.map p13 |> Option.defaultValue []
+                            Some(SuggestNameForUnionCaseFieldPattern g caseIdRange.End pos uci indexOrName list, r.DisplayEnv, r.Range)
+                        | _ -> None)
+                    |> Option.orElse declaredItems
+
             // Other completions
             | cc ->
                 match residueOpt |> Option.bind Seq.tryHead with

src/Compiler/Service/ServiceDeclarationLists.fs

@@ -66,6 +66,7 @@ type ToolTipText =
 
 [<RequireQualifiedAccess>]
 type CompletionItemKind =
+    | SuggestedName
     | Field
     | Property
     | Method of isExtension : bool
@@ -1035,10 +1036,12 @@ type DeclarationListItem(textInDeclList: string, textInCode: string, fullName: s
     member _.NameInCode = textInCode
 
     member _.Description = 
-        match info with
-        | Choice1Of2 (items: CompletionItem list, infoReader, ad, m, denv) -> 
+        match kind, info with
+        | CompletionItemKind.SuggestedName, _ ->
+            ToolTipText [ ToolTipElement.Single ([| tagText (FSComp.SR.suggestedName()) |], FSharpXmlDoc.None) ]
+        | _, Choice1Of2 (items: CompletionItem list, infoReader, ad, m, denv) -> 
             ToolTipText(items |> List.map (fun x -> FormatStructuredDescriptionOfItem true infoReader ad m denv x.ItemWithInst None None))
-        | Choice2Of2 result -> 
+        | _, Choice2Of2 result -> 
             result
 
     member _.Glyph = glyph 

src/Compiler/Service/ServiceDeclarationLists.fsi

@@ -60,6 +60,7 @@ type public ToolTipText =
 
 [<RequireQualifiedAccess>]
 type public CompletionItemKind =
+    | SuggestedName
     | Field
     | Property
     | Method of isExtension: bool