Filter match clause completions

src/Compiler/Checking/InfoReader.fs

@@ -368,6 +368,13 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this =
                     if not fdef.IsCompilerGenerated then
                         yield MakeRecdFieldInfo g ty tcref fdef ]
 
+    /// Get the F#-declared union cases
+    let GetImmediateIntrinsicUnionCasesOfType _ad _m ty =
+        match tryTcrefOfAppTy g ty with 
+        | ValueNone -> []
+        | ValueSome tcref -> 
+            tcref.UnionCasesAsRefList
+            |> List.map (fun caseRef -> UnionCaseInfo (argsOfAppTy g ty, caseRef))
 
     /// The primitive reader for the method info sets up a hierarchy
     let GetIntrinsicMethodSetsUncached ((optFilter, ad, allowMultiIntfInst), m, ty) =
@@ -386,6 +393,9 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this =
     let GetIntrinsicRecdOrClassFieldInfosUncached ((optFilter, ad), m, ty) =
         FoldPrimaryHierarchyOfType (fun ty acc -> GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter, ad) m ty @ acc) g amap m AllowMultiIntfInstantiations.Yes ty []
 
+    let GetIntrinsicUnionCaseInfosUncached (ad, m, ty) =
+        FoldPrimaryHierarchyOfType (fun ty acc -> GetImmediateIntrinsicUnionCasesOfType ad m ty @ acc) g amap m AllowMultiIntfInstantiations.Yes ty []
+
     let GetEntireTypeHierarchyUncached (allowMultiIntfInst, m, ty) =
         FoldEntireHierarchyOfType (fun ty acc -> ty :: acc) g amap m allowMultiIntfInst ty  [] 
 
@@ -678,6 +688,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this =
     let eventInfoCache = MakeInfoCache GetIntrinsicEventInfosUncached hashFlags1
     let namedItemsCache = MakeInfoCache GetIntrinsicNamedItemsUncached hashFlags2
     let mostSpecificOverrideMethodInfoCache = MakeInfoCache GetIntrinsicMostSpecificOverrideMethodSetsUncached hashFlags0
+    let unionCaseInfoCache = MakeInfoCache GetIntrinsicUnionCaseInfosUncached hashFlags3
 
     let entireTypeHierarchyCache = MakeInfoCache GetEntireTypeHierarchyUncached HashIdentity.Structural
     let primaryTypeHierarchyCache = MakeInfoCache GetPrimaryTypeHierarchyUncached HashIdentity.Structural
@@ -711,6 +722,9 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this =
     member _.GetRecordOrClassFieldsOfType (optFilter, ad, m, ty) =
         recdOrClassFieldInfoCache.Apply(((optFilter, ad), m, ty))
 
+    member _.GetUnionCasesOfType (ad, m, ty) =
+        unionCaseInfoCache.Apply((ad, m, ty))
+
     /// Read the IL fields of a type, including inherited ones. Cache the result for monomorphic types.
     member _.GetILFieldInfosOfType (optFilter, ad, m, ty) =
         ilFieldInfoCache.Apply(((optFilter, ad), m, ty))

src/Compiler/Checking/InfoReader.fsi

@@ -124,6 +124,8 @@ type InfoReader =
     member GetRecordOrClassFieldsOfType:
         optFilter: string option * ad: AccessorDomain * m: range * ty: TType -> RecdFieldInfo list
 
+    member GetUnionCasesOfType: ad: AccessorDomain * m: range * ty: TType -> UnionCaseInfo list
+
     /// Check if the given language feature is supported by the runtime.
     member IsLanguageFeatureRuntimeSupported: langFeature: Features.LanguageFeature -> bool
 

src/Compiler/Checking/NameResolution.fs

@@ -3857,6 +3857,16 @@ let ResolveRecordOrClassFieldsOfType (ncenv: NameResolver) m ad ty statics =
     |> List.filter (fun rfref -> rfref.IsStatic = statics && IsFieldInfoAccessible ad rfref)
     |> List.map Item.RecdField
 
+/// Returns cases for the given union
+let ResolveUnionCasesOfType (ncenv: NameResolver) m ad ty tcRef =
+    if IsTyconReprAccessible ncenv.amap m ad tcRef then
+        let requiresQualifiedAccess = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tcRef.Attribs
+
+        ncenv.InfoReader.GetUnionCasesOfType (ad, m, ty)
+        |> List.map (fun caseInfo -> Item.UnionCase (caseInfo, requiresQualifiedAccess))
+    else
+        []
+
 [<RequireQualifiedAccess>]
 type ResolveCompletionTargets =
     | All of (MethInfo -> TType -> bool)
@@ -4321,6 +4331,27 @@ let TryToResolveLongIdentAsType (ncenv: NameResolver) (nenv: NameResolutionEnv)
                 FreshenTycon ncenv m tcref)
     | _ -> None
 
+let GetVisibleNamespacesAndModulesAtPoint (ncenv: NameResolver) (nenv: NameResolutionEnv) fullyQualified m ad =
+    protectAssemblyExploration [] (fun () ->
+        let items =
+            nenv.ModulesAndNamespaces fullyQualified
+            |> NameMultiMap.range
+
+        if isNil items then
+            []
+        else
+            let ilTyconNames = getFakeContainerModulesFromTyconRefs (nenv.TyconsByAccessNames(fullyQualified).Values)
+
+            items
+            |> List.filter (fun x ->
+                 let demangledName = x.DemangledModuleOrNamespaceName
+
+                 IsInterestingModuleName demangledName &&
+                 notFakeContainerModule ilTyconNames demangledName &&
+                 EntityRefContainsSomethingAccessible ncenv m ad x &&
+                 not (IsTyconUnseen ad ncenv.g ncenv.amap m x))
+    )
+
 /// allowObsolete - specifies whether we should return obsolete types & modules
 ///   as (no other obsolete items are returned)
 let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionEnv) isApplicableMeth fullyQualified m ad plid allowObsolete: Item list =
@@ -4356,20 +4387,7 @@ let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionE
                |> List.filter (function Item.ActivePatternCase _v -> true | _ -> false)
 
        let moduleAndNamespaceItems =
-           let moduleOrNamespaceRefs =
-               nenv.ModulesAndNamespaces fullyQualified
-               |> NameMultiMap.range
-
-           if isNil moduleOrNamespaceRefs then [] else
-           let ilTyconNames = getFakeContainerModulesFromTyconRefs (nenv.TyconsByAccessNames(fullyQualified).Values)
-
-           moduleOrNamespaceRefs
-           |> List.filter (fun modref ->
-               let demangledName = modref.DemangledModuleOrNamespaceName
-               IsInterestingModuleName demangledName && notFakeContainerModule ilTyconNames demangledName &&
-               EntityRefContainsSomethingAccessible ncenv m ad modref &&
-               not (IsTyconUnseen ad g ncenv.amap m modref))
-           |> List.map ItemForModuleOrNamespaceRef
+           GetVisibleNamespacesAndModulesAtPoint ncenv nenv fullyQualified m ad |> List.map ItemForModuleOrNamespaceRef
 
        let tycons =
            nenv.TyconsByDemangledNameAndArity(fullyQualified).Values
@@ -4534,21 +4552,7 @@ and ResolvePartialLongIdentToClassOrRecdFieldsImpl (ncenv: NameResolver) (nenv:
        if fieldsOnly then getRecordFieldsInScope nenv else
 
        let mods =
-           let moduleOrNamespaceRefs =
-               nenv.ModulesAndNamespaces fullyQualified
-               |> NameMultiMap.range
-
-           if isNil moduleOrNamespaceRefs then [] else
-
-           let ilTyconNames = getFakeContainerModulesFromTyconRefs (nenv.TyconsByAccessNames(fullyQualified).Values)
-
-           moduleOrNamespaceRefs
-           |> List.filter (fun modref ->
-               let demangledName = modref.DemangledModuleOrNamespaceName
-               IsInterestingModuleName demangledName && notFakeContainerModule ilTyconNames demangledName &&
-               EntityRefContainsSomethingAccessible ncenv m ad modref &&
-               not (IsTyconUnseen ad g ncenv.amap m modref))
-           |> List.map ItemForModuleOrNamespaceRef
+           GetVisibleNamespacesAndModulesAtPoint ncenv nenv fullyQualified m ad |> List.map ItemForModuleOrNamespaceRef
 
        let recdTyCons =
            nenv.TyconsByDemangledNameAndArity(fullyQualified).Values
@@ -4957,19 +4961,7 @@ let rec GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolutionEnv) m a
 
            match item with
            | Item.ModuleOrNamespaces _ ->
-               let moduleOrNamespaceRefs =
-                   nenv.ModulesAndNamespaces OpenQualified
-                   |> NameMultiMap.range
-
-               if not (isNil moduleOrNamespaceRefs) then
-                   let ilTyconNames = getFakeContainerModulesFromTyconRefs (nenv.TyconsByAccessNames(OpenQualified).Values)
-
-                   for ns in moduleOrNamespaceRefs do
-                       let demangledName = ns.DemangledModuleOrNamespaceName
-                       if IsInterestingModuleName demangledName && notFakeContainerModule ilTyconNames demangledName
-                          && EntityRefContainsSomethingAccessible ncenv m ad ns
-                          && not (IsTyconUnseen ad g ncenv.amap m ns)
-                       then yield ItemForModuleOrNamespaceRef ns
+               yield! GetVisibleNamespacesAndModulesAtPoint ncenv nenv OpenQualified m ad |> List.map ItemForModuleOrNamespaceRef
 
            | Item.Types _ ->
                for tcref in nenv.TyconsByDemangledNameAndArity(OpenQualified).Values do
@@ -5023,21 +5015,3 @@ let IsItemResolvable (ncenv: NameResolver) (nenv: NameResolutionEnv) m ad plid (
         GetCompletionForItem ncenv nenv m ad plid item
         |> Seq.exists (ItemsAreEffectivelyEqual ncenv.g item)
     )
-
-let GetVisibleNamespacesAndModulesAtPoint (ncenv: NameResolver) (nenv: NameResolutionEnv) m ad =
-    protectAssemblyExploration [] (fun () ->
-        let items =
-            nenv.ModulesAndNamespaces FullyQualifiedFlag.OpenQualified
-            |> NameMultiMap.range
-
-        if isNil items then [] else
-
-        let ilTyconNames = getFakeContainerModulesFromTyconRefs (nenv.TyconsByAccessNames(FullyQualifiedFlag.OpenQualified).Values)
-
-        items
-        |> List.filter (fun x ->
-             let demangledName = x.DemangledModuleOrNamespaceName
-             IsInterestingModuleName demangledName && notFakeContainerModule ilTyconNames demangledName
-             && EntityRefContainsSomethingAccessible ncenv m ad  x
-             && not (IsTyconUnseen ad ncenv.g ncenv.amap m x))
-    )

src/Compiler/Checking/NameResolution.fsi

@@ -712,6 +712,9 @@ val internal ResolvePartialLongIdentToClassOrRecdFields:
 /// Return the fields for the given class or record
 val internal ResolveRecordOrClassFieldsOfType: NameResolver -> range -> AccessorDomain -> TType -> bool -> Item list
 
+/// Return the cases for the given union
+val internal ResolveUnionCasesOfType: NameResolver -> range -> AccessorDomain -> TType -> TyconRef -> Item list
+
 /// Specifies extra work to do after overload resolution
 [<RequireQualifiedAccess>]
 type AfterResolution =
@@ -792,7 +795,7 @@ val ResolveCompletionsInType:
         Item list
 
 val GetVisibleNamespacesAndModulesAtPoint:
-    NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> ModuleOrNamespaceRef list
+    NameResolver -> NameResolutionEnv -> FullyQualifiedFlag -> range -> AccessorDomain -> ModuleOrNamespaceRef list
 
 val IsItemResolvable: NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> string list -> Item -> bool
 

src/Compiler/Checking/TypeRelations.fs

@@ -286,5 +286,21 @@ let IteratedAdjustArityOfLambda g amap topValInfo e =
 let FindUniqueFeasibleSupertype g amap m ty1 ty2 =  
     let supertypes = Option.toList (GetSuperTypeOfType g amap m ty2) @ (GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes g amap m ty2)
     supertypes |> List.tryFind (TypeFeasiblySubsumesType 0 g amap m ty1 NoCoerce) 
-
+
+/// Returns true if ty is feasibly accepted as one of the parameters of activePatternTy
+let rec ActivePatternFeasiblyAcceptsTypeAsInput g amap m ty activePatternTy =
+    match stripTyEqns g activePatternTy with
+    | TType_forall (_, bodyTy) ->
+        ActivePatternFeasiblyAcceptsTypeAsInput g amap m ty bodyTy
+    | TType_var (typar, _) ->
+        match typar.Solution with
+        | Some paramType ->
+            ActivePatternFeasiblyAcceptsTypeAsInput g amap m ty paramType
+        | _ -> false
+    | TType_fun (domainType, rangeType, _) ->
+        if TypeFeasiblySubsumesType 0 g amap m domainType CanCoerce ty then
+            true
+        else
+            ActivePatternFeasiblyAcceptsTypeAsInput g amap m ty rangeType
+    | _ -> false
 

src/Compiler/Checking/TypeRelations.fsi

@@ -80,3 +80,12 @@ val IteratedAdjustArityOfLambda:
 /// "Single Feasible Type" inference
 /// Look for the unique supertype of ty2 for which ty2 :> ty1 might feasibly hold
 val FindUniqueFeasibleSupertype: g: TcGlobals -> amap: ImportMap -> m: range -> ty1: TType -> ty2: TType -> TType option
+
+/// Returns true if ty is feasibly accepted as one of the parameters of activePatternTy
+val ActivePatternFeasiblyAcceptsTypeAsInput:
+    g: TcGlobals ->
+    amap: ImportMap ->
+    m: range ->
+    ty: TType ->
+    activePatternTy: TType ->
+        bool