diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index 75a4e9aa897..6e9e0990253 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/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)) diff --git a/src/Compiler/Checking/InfoReader.fsi b/src/Compiler/Checking/InfoReader.fsi index 5941702256a..827a146b83a 100644 --- a/src/Compiler/Checking/InfoReader.fsi +++ b/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 diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index d4825fb9e9a..188f05bcce5 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/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 + [] + [] 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)) - ) diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index 969e22c0207..b45c22b13c9 100644 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/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 [] 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 diff --git a/src/Compiler/Checking/TypeRelations.fs b/src/Compiler/Checking/TypeRelations.fs index 6cbb7547f30..fbf9af191ef 100644 --- a/src/Compiler/Checking/TypeRelations.fs +++ b/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 diff --git a/src/Compiler/Checking/TypeRelations.fsi b/src/Compiler/Checking/TypeRelations.fsi index a33eb284c35..86cd4647cc7 100644 --- a/src/Compiler/Checking/TypeRelations.fsi +++ b/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 diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 2213ebbe331..5cddba4da8c 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -15,7 +15,6 @@ open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Core.Printf open FSharp.Compiler -open FSharp.Compiler.Syntax open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.CheckExpressions @@ -47,11 +46,6 @@ open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree 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 @@ -646,6 +640,40 @@ type internal TypeCheckInfo let items = items |> RemoveExplicitlySuppressed g items, nenv.DisplayEnv, m + /// Find union cases and compatible active patterns when the item under the cursor position is an identifier with the type of a DU. + let _GetUnionCasesAndActivePatternsEnvironmentLookupResolutionsAtPosition cursorPos = + let resolutions = GetCapturedNameResolutions cursorPos ResolveOverloads.Yes + + if resolutions.Count = 1 then + let res = resolutions[0] + + match res.Item with + | Item.Value vref -> + let ty = vref.Type + let nenv = res.NameResolutionEnv + let m = res.Range + + match tryTcrefOfAppTy nenv.DisplayEnv.g ty with + | ValueSome tcRef when tcRef.IsUnionTycon -> + let isUnionInScopeAsUnqualified = nenv.eTyconsByAccessNames.ContainsKey tcRef.DisplayName + let cases = ResolveUnionCasesOfType ncenv m res.AccessorDomain ty tcRef + let modulesAndNamespaces = + GetVisibleNamespacesAndModulesAtPoint ncenv nenv OpenQualified m res.AccessorDomain + |> List.map (fun x -> Item.ModuleOrNamespaces [ x ]) + let activePatterns = [ + for kvp in nenv.ePatItems do + match kvp.Value with + | Item.ActivePatternCase item when TypeRelations.ActivePatternFeasiblyAcceptsTypeAsInput ncenv.g ncenv.amap m ty item.ActivePatternVal.Type -> + kvp.Value + | _ -> () + ] + + Some (isUnionInScopeAsUnqualified, cases @ activePatterns @ modulesAndNamespaces, nenv.DisplayEnv, m) + | _ -> None + | _ -> None + else + None + /// Resolve a location and/or text to items. // Three techniques are used // - look for an exact known name resolution from type checking @@ -736,6 +764,7 @@ type internal TypeCheckInfo | _ -> CompletionItemKind.Other { ItemWithInst = item + MajorPriority = None MinorPriority = 0 Kind = kind IsOwnMember = false @@ -909,6 +938,120 @@ type internal TypeCheckInfo | ValueNone, ValueSome y -> Some y | ValueNone, ValueNone -> None + /// Get completions on an identifier in a match clause + let GetMatchCompletionsAtPosition (identifierRange: range, parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, + residueOpt, lastDotPos, line, loc, filterCtors, resolveOverloads) = + + let identifierTy = + GetCapturedNameResolutions identifierRange.End ResolveOverloads.Yes + |> Seq.tryHead + |> Option.bind (fun res -> + match res.Item with + | Item.Value vref -> Some vref.Type + | _ -> None) + + let identifierTypeNoneOrSubsumedByType identifierTy ty = + match identifierTy with + | Some identifierTy -> TypeRelations.TypeFeasiblySubsumesType 0 g amap identifierRange identifierTy TypeRelations.CanCoerce ty + | _ -> true + + GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, filterCtors, resolveOverloads, false, fun () -> []) + |> Option.map (fun (items, denv, m) -> + let identifierTyNoneOrException = identifierTypeNoneOrSubsumedByType identifierTy g.exn_ty + + let items = [ + for cItem in items do + match cItem.Item with + | Item.UnionCase (uci, _) -> + if identifierTypeNoneOrSubsumedByType identifierTy uci.UnionCase.ReturnType then + // Compatible union cases - top of the list + { cItem with MajorPriority = Some 0 } + else + // Incompatible union cases bottom of the list + cItem + | Item.ExnCase _ -> + if identifierTyNoneOrException then + // Exception names when the target type is an exception - top of the list + { cItem with MajorPriority = Some 0 } + else + // Otherwise - bottom of the list + cItem + | Item.ActivePatternCase activePattern -> + if identifierTy.IsNone || TypeRelations.ActivePatternFeasiblyAcceptsTypeAsInput g amap m identifierTy.Value activePattern.ActivePatternVal.Type then + // Compatible active patterns cases - top of the list below union cases + { cItem with MajorPriority = Some 1 } + else + // Incompatible active patterns bottom of the list + cItem + | Item.Value vref -> + if vref.LiteralValue.IsSome && identifierTypeNoneOrSubsumedByType identifierTy vref.Type then + // Compatible literals - top of the list below active patterns + { cItem with MajorPriority = Some 2 } + elif vref.LiteralValue.IsSome then + // Incompatible literals bottom of the list + cItem + | Item.ModuleOrNamespaces [ moduleOrNamespace ] -> + // Namespaces - removed from the list + if moduleOrNamespace.IsModule then + // Modules - top of the list below literals + { cItem with MajorPriority = Some 3 } + | Item.Types (_, tys) -> + if tys |> List.exists (fun ty -> isUnionTy g ty || isEnumTy g ty) then + // Non-enum/union types - removed from the list + if tys |> List.exists (fun ty -> identifierTypeNoneOrSubsumedByType identifierTy ty) then + // Compatible union, enum types - top of the list below modules + { cItem with MajorPriority = Some 4 } + else + // Incompatible union, enum types - bottom of the list + cItem + | _ -> + () + ] + + items, denv, m) + + //let patternItems = GetUnionCasesAndActivePatternsEnvironmentLookupResolutionsAtPosition identifierRange.End + + //match patternItems with + //| Some (isUnionInScopeAsUnqualified, items, denv, range) -> + // let items = + // items + // |> List.map (fun item -> + // let unresolved = + // match item with + // | Item.UnionCase (uci, requiresQualifiedAccess) when not isUnionInScopeAsUnqualified -> + // Some { + // FullName = uci.Tycon.CompiledRepresentationForNamedType.FullName + // Namespace = trimPathByDisplayEnvList denv uci.Tycon.CompilationPath.DemangledPath |> List.toArray + // DisplayName = if requiresQualifiedAccess then $"{uci.Tycon.DisplayName}.{uci.DisplayName}" else uci.DisplayName + // } + // | _ -> None + + // { + // ItemWithInst = ItemWithNoInst item + // MinorPriority = 0 + // Kind = CompletionItemKind.Other + // IsOwnMember = false + // Type = None + // Unresolved = unresolved + // }) + + // Some (items, denv, range) + //| _ -> + // // We're not matching against a DU of a determined type, but at least filter out things that may not appear in a match pattern clause + // GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, filterCtors, resolveOverloads, false, fun () -> []) + // |> Option.map (fun (items, denv, m) -> + // items + // |> List.filter (fun cItem -> + // match cItem.Item with + // | Item.Value vref -> vref.LiteralValue.IsSome + // | Item.Types (_, tys) -> + // tys |> List.exists (fun ty -> isUnionTy g ty || isEnumTy g ty) + // | Item.ModuleOrNamespaces _ + // | Item.ActivePatternCase _ + // | Item.UnionCase _ + // | Item.ExnCase _ -> true + // | _ -> false), denv, m) let toCompletionItems (items: ItemWithInst list, denv: DisplayEnv, m: range ) = items |> List.map DefaultCompletionItem, denv, m @@ -1007,6 +1150,10 @@ type internal TypeCheckInfo Some (List.map ItemWithNoInst items, denv, m) |> Option.map toCompletionItems + // Completion at ' match x with S... -> () ' unless we're dotting into a type/module/... + | Some (CompletionContext.Match (MatchContext.ClausePatternIdentifier range)) when origLongIdentOpt.IsNone || origLongIdentOpt.Value.IsEmpty -> + GetMatchCompletionsAtPosition (range, parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, filterCtors, resolveOverloads) + // Completion at ' { XXX = ... with ... } " | Some(CompletionContext.RecordField(RecordContext.Constructor(typeName))) -> Some(GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, [typeName], false)) @@ -1033,6 +1180,7 @@ type internal TypeCheckInfo |> List.map (fun item -> { ItemWithInst = item Kind = CompletionItemKind.Argument + MajorPriority = None MinorPriority = 0 IsOwnMember = false Type = None @@ -1111,7 +1259,7 @@ type internal TypeCheckInfo member _.GetVisibleNamespacesAndModulesAtPosition(cursorPos: pos) : ModuleOrNamespaceRef list = let (nenv, ad), m = GetBestEnvForPos cursorPos - GetVisibleNamespacesAndModulesAtPoint ncenv nenv m ad + GetVisibleNamespacesAndModulesAtPoint ncenv nenv OpenQualified m ad /// Determines if a long ident is resolvable at a specific point. member _.IsRelativeNameResolvable(cursorPos: pos, plid: string list, item: Item) : bool = diff --git a/src/Compiler/Service/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs index 82fc0afae36..34ef97b5d73 100644 --- a/src/Compiler/Service/ServiceDeclarationLists.fs +++ b/src/Compiler/Service/ServiceDeclarationLists.fs @@ -80,6 +80,7 @@ type CompletionItem = { ItemWithInst: ItemWithInst Kind: CompletionItemKind IsOwnMember: bool + MajorPriority: int option MinorPriority: int Type: TyconRef option Unresolved: UnresolvedSymbol option } @@ -916,7 +917,7 @@ module internal DescriptionListsImpl = /// An intellisense declaration [] type DeclarationListItem(textInDeclList: string, textInCode: string, fullName: string, glyph: FSharpGlyph, info, accessibility: FSharpAccessibility, - kind: CompletionItemKind, isOwnMember: bool, priority: int, isResolved: bool, namespaceToOpen: string option) = + kind: CompletionItemKind, isOwnMember: bool, majorPriority: int option, priority: int, isResolved: bool, namespaceToOpen: string option) = member _.Name = textInDeclList member _.NameInCode = textInCode @@ -936,6 +937,8 @@ type DeclarationListItem(textInDeclList: string, textInCode: string, fullName: s member _.IsOwnMember = isOwnMember + member _.MajorPriority = majorPriority + member _.MinorPriority = priority member _.FullName = fullName @@ -1036,12 +1039,13 @@ type DeclarationListInfo(declarations: DeclarationListItem[], isForType: bool, i | Some u -> u.DisplayName | None -> item.Item.DisplayNameCore let textInCode = - match item.Item with - | Item.TypeVar (name, typar) -> (if typar.StaticReq = Syntax.TyparStaticReq.None then "'" else " ^") + name - | _ -> - match item.Unresolved with - | Some u -> u.DisplayName - | None -> item.Item.DisplayName + match item.Unresolved with + | Some u -> u.DisplayName + | None -> + match item.Item with + | Item.UnionCase (uci, true) -> $"{uci.Tycon.DisplayName}.{uci.DisplayName}" + | Item.TypeVar (name, typar) -> (if typar.StaticReq = Syntax.TyparStaticReq.None then "'" else " ^") + name + | _ -> item.Item.DisplayName textInDeclList, textInCode, items) // Filter out operators, active patterns (as values) @@ -1091,14 +1095,14 @@ type DeclarationListInfo(declarations: DeclarationListItem[], isForType: bool, i DeclarationListItem( textInDeclList, textInCode, fullName, glyph, Choice1Of2 (items, infoReader, ad, m, denv), getAccessibility item.Item, - item.Kind, item.IsOwnMember, item.MinorPriority, item.Unresolved.IsNone, namespaceToOpen)) + item.Kind, item.IsOwnMember, item.MajorPriority, item.MinorPriority, item.Unresolved.IsNone, namespaceToOpen)) DeclarationListInfo(Array.ofList decls, isForType, false) static member Error message = DeclarationListInfo( [| DeclarationListItem("", "", "", FSharpGlyph.Error, Choice2Of2 (ToolTipText [ToolTipElement.CompositionError message]), - FSharpAccessibility(taccessPublic), CompletionItemKind.Other, false, 0, false, None) |], false, true) + FSharpAccessibility(taccessPublic), CompletionItemKind.Other, false, None, 0, false, None) |], false, true) static member Empty = empty diff --git a/src/Compiler/Service/ServiceDeclarationLists.fsi b/src/Compiler/Service/ServiceDeclarationLists.fsi index f01f05b9143..fe29582350e 100644 --- a/src/Compiler/Service/ServiceDeclarationLists.fsi +++ b/src/Compiler/Service/ServiceDeclarationLists.fsi @@ -80,6 +80,8 @@ type internal CompletionItem = IsOwnMember: bool + MajorPriority: int option + MinorPriority: int Type: TyconRef option @@ -114,6 +116,8 @@ type public DeclarationListItem = member IsOwnMember: bool + member MajorPriority: int option + member MinorPriority: int member FullName: string diff --git a/src/Compiler/Service/ServiceParsedInputOps.fs b/src/Compiler/Service/ServiceParsedInputOps.fs index 692539a1ca3..fb60ddee977 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -47,6 +47,15 @@ type RecordContext = | New of path: CompletionPath * isFirstField: bool | Declaration of isInIdentifier: bool +[] +type MatchContext = + /// Completing an identifier in a match clause pattern + /// (e.g. 'match x with Som| y -> ...') + | ClausePatternIdentifier of range: range + + /// Completing a match clause guard (e.g. match x with Some y when y| -> ...) + | ClauseGuard + [] type CompletionContext = /// Completion context cannot be determined due to errors @@ -78,6 +87,9 @@ type CompletionContext = /// or a single case union without a bar (type SomeUnion = Abc|) | TypeAbbreviationOrSingleCaseUnion + /// Completing a match expression + | Match of context: MatchContext + type ShortIdent = string type ShortIdents = ShortIdent[] @@ -745,6 +757,72 @@ module ParsedInput = /// Matches the most nested [< and >] pair. let insideAttributeApplicationRegex = Regex(@"(?<=\[\<)(?(.*?))(?=\>\])", RegexOptions.Compiled ||| RegexOptions.ExplicitCapture) + /// Try to determine completion context in match clauses + let tryGetMatchClauseCompletionContext defaultTraverseMatchExpr clauses pos = + let rec traverse pos clausePat = + match clausePat with + // match x with + // | z| -> + | SynPat.Named (range = range) -> + Some (CompletionContext.Match (MatchContext.ClausePatternIdentifier range)) + + // match opt with + // | Som| value -> + // + // but not + // + // match opt with + // | Some va| -> + | SynPat.LongIdent (longDotId = lidwd) when rangeContainsPos lidwd.Range pos -> + Some (CompletionContext.Match (MatchContext.ClausePatternIdentifier lidwd.Range)) + + // match x with + // | Choice1| value + // | Choice2Of3 value -> + | SynPat.Or (lhs, rhs, _, _) -> + match traverse pos lhs with + | None -> traverse pos rhs + | x -> x + + // match x with + // | ActivePattern1 & ActivePatte| -> + | SynPat.Ands (pats, _) -> + pats |> List.tryPick (fun pat -> + if rangeContainsPos pat.Range pos then + traverse pos pat + else + None) + + // match opt with + // | (Som| value) -> + | SynPat.Paren (pat, _) -> traverse pos pat + + // match tup with + // | (x, Som| ) -> + + // match recd with + // | { Fi| = } -> + + // match list with + // | [ Som| ] -> + + // match obj with + // | :? int6| + + // match obj with + // | :? int64 as ActivePatt| + | _ -> None + + clauses + |> List.tryPick (fun (SynMatchClause (pat = pat; whenExpr = whenExpr)) -> + if rangeContainsPos pat.Range pos then + traverse pos pat + elif whenExpr.IsSome && rangeContainsPos whenExpr.Value.Range pos then + Some (CompletionContext.Match MatchContext.ClauseGuard) + else + None) + |> Option.orElseWith defaultTraverseMatchExpr + /// Try to determine completion context for the given pair (row, columns) let TryGetCompletionContext (pos, parsedInput: ParsedInput, lineStr: string) : CompletionContext option = @@ -972,11 +1050,19 @@ module ParsedInput = Some (CompletionContext.ParameterList args) | _ -> defaultTraverse expr + + | SynExpr.MatchLambda (matchClauses = clauses) + | SynExpr.Match (clauses = clauses) + | SynExpr.MatchBang (clauses = clauses) -> + tryGetMatchClauseCompletionContext (fun () -> defaultTraverse expr) clauses pos + | SynExpr.Record(None, None, [], _) -> Some(CompletionContext.RecordField RecordContext.Empty) + // Unchecked.defaultof | SynExpr.TypeApp (typeArgsRange = range) when rangeContainsPos range pos -> Some CompletionContext.PatternType + | _ -> defaultTraverse expr member _.VisitRecordField(path, copyOpt, field) = diff --git a/src/Compiler/Service/ServiceParsedInputOps.fsi b/src/Compiler/Service/ServiceParsedInputOps.fsi index 07a1ac56fe6..16d782c99d1 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fsi +++ b/src/Compiler/Service/ServiceParsedInputOps.fsi @@ -22,6 +22,15 @@ type public RecordContext = | New of path: CompletionPath * isFirstField: bool | Declaration of isInIdentifier: bool +[] +type public MatchContext = + /// Completing an identifier in a match clause pattern + /// (e.g. 'match x with Som| y -> ...') + | ClausePatternIdentifier of range: range + + /// Completing a match clause guard (e.g. match x with Some y when y| -> ...) + | ClauseGuard + [] type public CompletionContext = /// Completion context cannot be determined due to errors @@ -53,6 +62,9 @@ type public CompletionContext = /// or a single case union without a bar (type SomeUnion = Abc|) | TypeAbbreviationOrSingleCaseUnion + /// Completing a match expression + | Match of context: MatchContext + type public ModuleKind = { IsAutoOpen: bool HasModuleSuffix: bool } diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index caaff282912..6927532e493 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3233,6 +3233,16 @@ let trimPathByDisplayEnv denv path = | Some s -> s | None -> if isNil path then "" else textOfPath path + "." +let trimPathByDisplayEnvList denv path = + let findOpenedNamespace openedPath = + if firstEq openedPath path then + Some (firstRem openedPath path) + else + None + + match List.tryPick findOpenedNamespace (denv.openTopPathsSorted.Force()) with + | Some s -> s + | None -> path let superOfTycon (g: TcGlobals) (tycon: Tycon) = match tycon.TypeContents.tcaug_super with diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 9530e3c0662..58ffcce66f7 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -1111,6 +1111,9 @@ val qualifiedInterfaceImplementationName: TcGlobals -> TType -> string -> string val trimPathByDisplayEnv: DisplayEnv -> string list -> string +/// Removes parts of a type's compilation path that are opened in the display environment. +val trimPathByDisplayEnvList: DisplayEnv -> string list -> string list + val prefixOfStaticReq: TyparStaticReq -> string val prefixOfInferenceTypar: Typar -> string diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index ac837cd6a81..5b166a0fa83 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -1157,6 +1157,8 @@ type LayeredMultiMap<'Key, 'Value when 'Key : equality and 'Key : comparison>(co member x.AddMany (kvs: _[]) = (x, kvs) ||> Array.fold (fun x (KeyValue(k, v)) -> x.Add(k, v)) + member _.ContainsKey k = contents.ContainsKey k + member _.TryFind k = contents.TryFind k member _.TryGetValue k = contents.TryGetValue k diff --git a/src/Compiler/Utilities/illib.fsi b/src/Compiler/Utilities/illib.fsi index 6f7a0591bdc..3205f5a6272 100644 --- a/src/Compiler/Utilities/illib.fsi +++ b/src/Compiler/Utilities/illib.fsi @@ -634,6 +634,8 @@ type internal LayeredMultiMap<'Key, 'Value when 'Key: comparison> = member AddMany: kvs: KeyValuePair<'Key, 'Value>[] -> LayeredMultiMap<'Key, 'Value> + member ContainsKey: k: 'Key -> bool + member TryFind: k: 'Key -> 'Value list option member TryGetValue: k: 'Key -> bool * 'Value list diff --git a/tests/FSharp.Compiler.Private.Scripting.UnitTests/CompletionTests.fs b/tests/FSharp.Compiler.Private.Scripting.UnitTests/CompletionTests.fs index 74062d0b028..c915af925cc 100644 --- a/tests/FSharp.Compiler.Private.Scripting.UnitTests/CompletionTests.fs +++ b/tests/FSharp.Compiler.Private.Scripting.UnitTests/CompletionTests.fs @@ -157,4 +157,99 @@ type CompletionTests() = Assert.Equal(1, matchingCompletions.Length) Assert.Equal("A", matchingCompletions.[0].NameInCode) + [] + member _.``Completions in a match clause prepend union name to case when qualified access is required``() = + use script = new FSharpScript() + let text = """ +module M = + [] + type ChoiceZ = + | Choice1 + | Choice2 + +open M + +let call (choice: M.ChoiceZ) = + match choice with + | C + """ + let completions = script.GetCompletionItems(text, 12, 7) |> Async.RunSynchronously + let choiceCaseCompletions = completions |> Array.filter (fun x -> x.Name.StartsWith "Choice") + + Assert.Equal (2, choiceCaseCompletions.Length) + + for c in choiceCaseCompletions do + Assert.Equal (None, c.NamespaceToOpen) + Assert.Equal ("ChoiceZ." + c.Name, c.NameInCode) + + [] + member _.``Completions in a match clause prepend union name to case and open modules when qualified access is required and union is out of scope``() = + use script = new FSharpScript() + let text = """ +module M = + [] + type ChoiceZ = + | Choice1 + | Choice2 + +let call (choice: M.ChoiceZ) = + match choice with + | C + """ + let completions = script.GetCompletionItems(text, 10, 7) |> Async.RunSynchronously + let choiceCaseCompletions = completions |> Array.filter (fun x -> x.Name.StartsWith "Choice") + + Assert.Equal (2, choiceCaseCompletions.Length) + + for c in choiceCaseCompletions do + Assert.Equal (Some "M", c.NamespaceToOpen) + Assert.StartsWith ("ChoiceZ.", c.NameInCode) + + [] + member _.``Completions in a match clause do not unnecessarily open an AutoOpen module``() = + use script = new FSharpScript() + let text = """ +[] +module M = + type ChoiceZ = + | Choice1 + | Choice2 + +let call (choice: M.ChoiceZ) = + match choice with + | C + """ + let completions = script.GetCompletionItems(text, 10, 7) |> Async.RunSynchronously + let choiceCaseCompletions = completions |> Array.filter (fun x -> x.Name.StartsWith "Choice") + + Assert.Equal (2, choiceCaseCompletions.Length) + + for c in choiceCaseCompletions do + Assert.Equal (None, c.NamespaceToOpen) + Assert.Equal (c.Name, c.NameInCode) + + [] + member _.``Completions in a match clause open the correct modules``() = + use script = new FSharpScript() + let text = """ +module F = + module N = + [] + module M = + type ChoiceZ = + | Choice1 + | Choice2 + + let call (choice: N.M.ChoiceZ) = + match choice with + | C + """ + let completions = script.GetCompletionItems(text, 12, 11) |> Async.RunSynchronously + let choiceCaseCompletions = completions |> Array.filter (fun x -> x.Name.StartsWith "Choice") + + Assert.Equal (2, choiceCaseCompletions.Length) + + for c in choiceCaseCompletions do + Assert.Equal (Some "N.M", c.NamespaceToOpen) + Assert.Equal (c.Name, c.NameInCode) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected index 6135b7a3266..dd21f3b321a 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected @@ -2444,6 +2444,8 @@ FSharp.Compiler.EditorServices.CompletionContext+Inherit: FSharp.Compiler.Editor FSharp.Compiler.EditorServices.CompletionContext+Inherit: FSharp.Compiler.EditorServices.InheritanceContext get_context() FSharp.Compiler.EditorServices.CompletionContext+Inherit: System.Tuple`2[Microsoft.FSharp.Collections.FSharpList`1[System.String],Microsoft.FSharp.Core.FSharpOption`1[System.String]] get_path() FSharp.Compiler.EditorServices.CompletionContext+Inherit: System.Tuple`2[Microsoft.FSharp.Collections.FSharpList`1[System.String],Microsoft.FSharp.Core.FSharpOption`1[System.String]] path +FSharp.Compiler.EditorServices.CompletionContext+Match: FSharp.Compiler.EditorServices.MatchContext context +FSharp.Compiler.EditorServices.CompletionContext+Match: FSharp.Compiler.EditorServices.MatchContext get_context() FSharp.Compiler.EditorServices.CompletionContext+OpenDeclaration: Boolean get_isOpenType() FSharp.Compiler.EditorServices.CompletionContext+OpenDeclaration: Boolean isOpenType FSharp.Compiler.EditorServices.CompletionContext+ParameterList: FSharp.Compiler.Text.Position Item1 @@ -2455,6 +2457,7 @@ FSharp.Compiler.EditorServices.CompletionContext+RecordField: FSharp.Compiler.Ed FSharp.Compiler.EditorServices.CompletionContext+Tags: Int32 AttributeApplication FSharp.Compiler.EditorServices.CompletionContext+Tags: Int32 Inherit FSharp.Compiler.EditorServices.CompletionContext+Tags: Int32 Invalid +FSharp.Compiler.EditorServices.CompletionContext+Tags: Int32 Match FSharp.Compiler.EditorServices.CompletionContext+Tags: Int32 OpenDeclaration FSharp.Compiler.EditorServices.CompletionContext+Tags: Int32 ParameterList FSharp.Compiler.EditorServices.CompletionContext+Tags: Int32 PatternType @@ -2468,6 +2471,7 @@ FSharp.Compiler.EditorServices.CompletionContext: Boolean Equals(System.Object, FSharp.Compiler.EditorServices.CompletionContext: Boolean IsAttributeApplication FSharp.Compiler.EditorServices.CompletionContext: Boolean IsInherit FSharp.Compiler.EditorServices.CompletionContext: Boolean IsInvalid +FSharp.Compiler.EditorServices.CompletionContext: Boolean IsMatch FSharp.Compiler.EditorServices.CompletionContext: Boolean IsOpenDeclaration FSharp.Compiler.EditorServices.CompletionContext: Boolean IsParameterList FSharp.Compiler.EditorServices.CompletionContext: Boolean IsPatternType @@ -2478,6 +2482,7 @@ FSharp.Compiler.EditorServices.CompletionContext: Boolean IsUnionCaseFieldsDecla FSharp.Compiler.EditorServices.CompletionContext: Boolean get_IsAttributeApplication() FSharp.Compiler.EditorServices.CompletionContext: Boolean get_IsInherit() FSharp.Compiler.EditorServices.CompletionContext: Boolean get_IsInvalid() +FSharp.Compiler.EditorServices.CompletionContext: Boolean get_IsMatch() FSharp.Compiler.EditorServices.CompletionContext: Boolean get_IsOpenDeclaration() FSharp.Compiler.EditorServices.CompletionContext: Boolean get_IsParameterList() FSharp.Compiler.EditorServices.CompletionContext: Boolean get_IsPatternType() @@ -2488,6 +2493,7 @@ FSharp.Compiler.EditorServices.CompletionContext: Boolean get_IsUnionCaseFieldsD FSharp.Compiler.EditorServices.CompletionContext: FSharp.Compiler.EditorServices.CompletionContext AttributeApplication FSharp.Compiler.EditorServices.CompletionContext: FSharp.Compiler.EditorServices.CompletionContext Invalid FSharp.Compiler.EditorServices.CompletionContext: FSharp.Compiler.EditorServices.CompletionContext NewInherit(FSharp.Compiler.EditorServices.InheritanceContext, System.Tuple`2[Microsoft.FSharp.Collections.FSharpList`1[System.String],Microsoft.FSharp.Core.FSharpOption`1[System.String]]) +FSharp.Compiler.EditorServices.CompletionContext: FSharp.Compiler.EditorServices.CompletionContext NewMatch(FSharp.Compiler.EditorServices.MatchContext) FSharp.Compiler.EditorServices.CompletionContext: FSharp.Compiler.EditorServices.CompletionContext NewOpenDeclaration(Boolean) FSharp.Compiler.EditorServices.CompletionContext: FSharp.Compiler.EditorServices.CompletionContext NewParameterList(FSharp.Compiler.Text.Position, System.Collections.Generic.HashSet`1[System.String]) FSharp.Compiler.EditorServices.CompletionContext: FSharp.Compiler.EditorServices.CompletionContext NewRecordField(FSharp.Compiler.EditorServices.RecordContext) @@ -2502,6 +2508,7 @@ FSharp.Compiler.EditorServices.CompletionContext: FSharp.Compiler.EditorServices FSharp.Compiler.EditorServices.CompletionContext: FSharp.Compiler.EditorServices.CompletionContext get_TypeAbbreviationOrSingleCaseUnion() FSharp.Compiler.EditorServices.CompletionContext: FSharp.Compiler.EditorServices.CompletionContext get_UnionCaseFieldsDeclaration() FSharp.Compiler.EditorServices.CompletionContext: FSharp.Compiler.EditorServices.CompletionContext+Inherit +FSharp.Compiler.EditorServices.CompletionContext: FSharp.Compiler.EditorServices.CompletionContext+Match FSharp.Compiler.EditorServices.CompletionContext: FSharp.Compiler.EditorServices.CompletionContext+OpenDeclaration FSharp.Compiler.EditorServices.CompletionContext: FSharp.Compiler.EditorServices.CompletionContext+ParameterList FSharp.Compiler.EditorServices.CompletionContext: FSharp.Compiler.EditorServices.CompletionContext+RecordField @@ -3078,6 +3085,28 @@ FSharp.Compiler.EditorServices.LookupType: Int32 GetHashCode(System.Collections. FSharp.Compiler.EditorServices.LookupType: Int32 Tag FSharp.Compiler.EditorServices.LookupType: Int32 get_Tag() FSharp.Compiler.EditorServices.LookupType: System.String ToString() +FSharp.Compiler.EditorServices.MatchContext +FSharp.Compiler.EditorServices.MatchContext+ClausePatternIdentifier: FSharp.Compiler.Text.Range get_range() +FSharp.Compiler.EditorServices.MatchContext+ClausePatternIdentifier: FSharp.Compiler.Text.Range range +FSharp.Compiler.EditorServices.MatchContext+Tags: Int32 ClauseGuard +FSharp.Compiler.EditorServices.MatchContext+Tags: Int32 ClausePatternIdentifier +FSharp.Compiler.EditorServices.MatchContext: Boolean Equals(FSharp.Compiler.EditorServices.MatchContext) +FSharp.Compiler.EditorServices.MatchContext: Boolean Equals(System.Object) +FSharp.Compiler.EditorServices.MatchContext: Boolean Equals(System.Object, System.Collections.IEqualityComparer) +FSharp.Compiler.EditorServices.MatchContext: Boolean IsClauseGuard +FSharp.Compiler.EditorServices.MatchContext: Boolean IsClausePatternIdentifier +FSharp.Compiler.EditorServices.MatchContext: Boolean get_IsClauseGuard() +FSharp.Compiler.EditorServices.MatchContext: Boolean get_IsClausePatternIdentifier() +FSharp.Compiler.EditorServices.MatchContext: FSharp.Compiler.EditorServices.MatchContext ClauseGuard +FSharp.Compiler.EditorServices.MatchContext: FSharp.Compiler.EditorServices.MatchContext NewClausePatternIdentifier(FSharp.Compiler.Text.Range) +FSharp.Compiler.EditorServices.MatchContext: FSharp.Compiler.EditorServices.MatchContext get_ClauseGuard() +FSharp.Compiler.EditorServices.MatchContext: FSharp.Compiler.EditorServices.MatchContext+ClausePatternIdentifier +FSharp.Compiler.EditorServices.MatchContext: FSharp.Compiler.EditorServices.MatchContext+Tags +FSharp.Compiler.EditorServices.MatchContext: Int32 GetHashCode() +FSharp.Compiler.EditorServices.MatchContext: Int32 GetHashCode(System.Collections.IEqualityComparer) +FSharp.Compiler.EditorServices.MatchContext: Int32 Tag +FSharp.Compiler.EditorServices.MatchContext: Int32 get_Tag() +FSharp.Compiler.EditorServices.MatchContext: System.String ToString() FSharp.Compiler.EditorServices.MaybeUnresolvedIdent FSharp.Compiler.EditorServices.MaybeUnresolvedIdent: Boolean Equals(FSharp.Compiler.EditorServices.MaybeUnresolvedIdent) FSharp.Compiler.EditorServices.MaybeUnresolvedIdent: Boolean Equals(System.Object) diff --git a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs index 3d93c28d3b8..85073cd058f 100644 --- a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs +++ b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs @@ -124,13 +124,15 @@ type internal FSharpCompletionProvider |> Array.sortWith (fun x y -> let mutable n = (not x.IsResolved).CompareTo(not y.IsResolved) if n <> 0 then n else - n <- (CompletionUtils.getKindPriority x.Kind).CompareTo(CompletionUtils.getKindPriority y.Kind) + n <- (Option.defaultValue Int32.MaxValue x.MajorPriority).CompareTo(Option.defaultValue Int32.MaxValue y.MajorPriority) if n <> 0 then n else - n <- (not x.IsOwnMember).CompareTo(not y.IsOwnMember) + n <- (CompletionUtils.getKindPriority x.Kind).CompareTo(CompletionUtils.getKindPriority y.Kind) if n <> 0 then n else - n <- String.Compare(x.Name, y.Name, StringComparison.OrdinalIgnoreCase) + n <- (not x.IsOwnMember).CompareTo(not y.IsOwnMember) if n <> 0 then n else - x.MinorPriority.CompareTo(y.MinorPriority)) + n <- String.Compare(x.Name, y.Name, StringComparison.OrdinalIgnoreCase) + if n <> 0 then n else + x.MinorPriority.CompareTo(y.MinorPriority)) let maxHints = if mruItems.Values.Count = 0 then 0 else Seq.max mruItems.Values diff --git a/vsintegration/tests/UnitTests/CompletionProviderTests.fs b/vsintegration/tests/UnitTests/CompletionProviderTests.fs index ea808bc81a9..5c666de3ce8 100644 --- a/vsintegration/tests/UnitTests/CompletionProviderTests.fs +++ b/vsintegration/tests/UnitTests/CompletionProviderTests.fs @@ -860,6 +860,168 @@ let emptyMap<'keyType, 'lValueType> () = """ VerifyCompletionList(fileContents, ", l", ["LanguagePrimitives"; "List"; "lValueType"], ["let"; "log"]) +[] +let ``Completion list in match clause contains union cases and compatible active pattern when the match expression type is known``() = + let fileContents = """ +let (|CPat|_|) (str: string) (x: Choice) = + Some CPat + +let (|CPatIncompatible|_|) (str: string) (x: Choice) = + Some CPatIncompatible + +let (|CPat1|CPat2|) (x: Choice) = + if true then CPat1 else CPat2 + +let call (choice: Choice) = + match choice with + | C +""" + VerifyCompletionList(fileContents, "| C", [ "Choice1Of2"; "Choice2Of2"; "CPat"; "CPat1"; "CPat2"; "System" ], []) + +[] +let ``Completion list in match clause contains union cases and compatible active pattern when the match expression type is known2``() = + let fileContents = """ +let (|CPat|_|) (str: string) (x: Choice) = + Some CPat + +let (|CPat1|CPat2|) (x: Choice) = + if true then CPat1 else CPat2 + +let (|CComparablePat|_|) (x: System.IComparable) = + Some CComparablePat + +let call (choice: unit -> Async>) = async { + match! choice () with + | (CPat "param" & c) +""" + VerifyCompletionList(fileContents, "& c", [ "Choice1Of2"; "Choice2Of2"; "CPat"; "CPat1"; "CPat2"; "CComparablePat"; "System" ], []) + +[] +let ``Completion list in match clause contains union cases, namespaces and compatible active pattern when the match expression type is known3``() = + let fileContents = """ +let call x = + match x "" with + | None when true -> () + | None + | s +""" + VerifyCompletionList(fileContents, "| s", [ "None"; "Some"; "System" ], []) + +[] +let ``Completion list in match clause contains union cases and namespaces when the match expression type is known but in an unopened module``() = + let fileContents = """ +module M = + type ChoiceZ = + | Choice1 + | Choice2 + +let call (choice: M.ChoiceZ) = + match choice with + | c +""" + VerifyCompletionList(fileContents, "| c", [ "Choice1"; "Choice2"; "System" ], [ "Some" ]) + +[] +let ``Completion list in match clause contains union cases and namespaces when the match expression type is a union with RequireQualifiedAccess``() = + let fileContents = """ +[] +type ChoiceZ = + | Choice1 + | Choice2 + +let call (choice: ChoiceZ) = + match choice with + | c +""" + VerifyCompletionList(fileContents, "| c", [ "Choice1"; "Choice2"; "System" ], [ "Some" ]) + +[] +let ``Completion list in match clause does not contain compatible active pattern out of scope when the match expression type is known``() = + let fileContents = """ +module M = + let (|CPat|_|) (str: string) (x: Choice) = + Some CPat + +let call (choice: unit -> Async>) = task { + match! choice () with + | C +""" + VerifyCompletionList(fileContents, "| C", [ "Choice1Of2"; "Choice2Of2" ], []) + +[] +let ``Completion list in match clause on union case parameters not filtered when the match expression type is known``() = + let fileContents = """ +let call (choice: unit -> Async>) = task { + match! choice () with + | Choice1Of2 (s) +""" + VerifyCompletionList(fileContents, "(s", [ "Some"; "Choice1Of2"; "Choice2Of2" ], []) + +[] +let ``Completion list in match clause is not empty on an identifier in a list``() = + let fileContents = """ +let call x = + match x "" with + | [ e ] -> () +""" + VerifyCompletionList(fileContents, "[ e", [ "Choice1Of2"; "System" ], []) + +[] +let ``Completion list in match clause is not empty on an identifier in an array``() = + let fileContents = """ +let call x = + match x "" with + | [| e |] -> () +""" + VerifyCompletionList(fileContents, "[| e", [ "Choice1Of2"; "System" ], []) + +[] +let ``Completion list in match clause contains only legal items when the match expression type is not known``() = + let fileContents = """ +let (|EPat|_|) (str: string) (x: Choice) = + Some EPat + +let [] ELiteral = "" + +type EEnum = + | A = 0 + +type EUnion = + | ECase + +module EMod = + let a = "" + +type EClass = class end + +let eVal = 11 + +let eFunc x = x + "ff" + +let call x = + match x with + | e +""" + VerifyCompletionList(fileContents, "| e", [ "ELiteral"; "EEnum"; "EUnion"; "ECase"; "EPat"; "MatchFailureException"; "EMod"; "System" ], [ "eVal"; "eFunc"; "EClass" ]) + +[] +let ``Completion list in match clause only contains type members including constants when dotting into a class``() = + let fileContents = """ +let call x = + match x with + | System.Int32.m +""" + VerifyCompletionListExactly(fileContents, ".m", [ "MaxValue"; "MinValue"; "Parse"; "TryParse" ]) + +[] +let ``Completion list in match clause contains enum cases when dotting into an enum``() = + let fileContents = """ +let call x = + match x with + | System.ConsoleColor.b +""" + VerifyCompletionList(fileContents, ".b", [ "Black"; "Blue"; "DarkBlue" ], []) + #if EXE ShouldDisplaySystemNamespace() #endif