From 29e522bbc45f68335f3d03588f57ebdcc63314b4 Mon Sep 17 00:00:00 2001 From: kerams Date: Thu, 14 Apr 2022 19:37:56 +0200 Subject: [PATCH 01/14] Filter match clause completions --- src/fsharp/InfoReader.fs | 14 ++++++ src/fsharp/InfoReader.fsi | 2 + src/fsharp/NameResolution.fs | 10 +++++ src/fsharp/NameResolution.fsi | 3 ++ src/fsharp/service/FSharpCheckerResults.fs | 46 ++++++++++++++++++++ src/fsharp/service/ServiceParsedInputOps.fs | 42 ++++++++++++++++++ src/fsharp/service/ServiceParsedInputOps.fsi | 3 ++ 7 files changed, 120 insertions(+) diff --git a/src/fsharp/InfoReader.fs b/src/fsharp/InfoReader.fs index 5427e257b70..2d456f38533 100644 --- a/src/fsharp/InfoReader.fs +++ b/src/fsharp/InfoReader.fs @@ -367,6 +367,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) = @@ -385,6 +392,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 [] @@ -677,6 +687,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 @@ -710,6 +721,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/fsharp/InfoReader.fsi b/src/fsharp/InfoReader.fsi index 6e1eebd234d..053bd84dd37 100644 --- a/src/fsharp/InfoReader.fsi +++ b/src/fsharp/InfoReader.fsi @@ -87,6 +87,8 @@ type InfoReader = /// Read the record or class fields of a type, including inherited ones. Cache the result for monomorphic types. 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/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index d77c6c11f41..e732a6df43c 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -3829,6 +3829,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) diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 0b96de1fac1..70f0f59973a 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -563,6 +563,9 @@ val internal ResolvePartialLongIdentToClassOrRecdFields: NameResolver -> NameRes /// 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 = diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 407777f6664..38e3abb45b9 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -641,6 +641,42 @@ type internal TypeCheckInfo let items = items |> RemoveExplicitlySuppressed g items, nenv.DisplayEnv, m + /// Find union cases and compatible active patterns in the best naming environment. + let GetUnionCasesAndActivePatternsEnvironmentLookupResolutionsAtPosition cursorPos = + let rec doesActivePatternTakeTypeAsInput g ty paramType = + match paramType with + | TType_var (typar, _) -> + match typar.Solution with + | Some paramType -> + doesActivePatternTakeTypeAsInput g ty paramType + | _ -> false + | TType_fun (domainType, rangeType, _) -> + if typeEquiv g domainType ty then + true + else + doesActivePatternTakeTypeAsInput g ty rangeType + | _ -> false + + let _, quals = GetExprTypingForPosition cursorPos + + match quals with + | [| ty, nenv, ad, m |] -> + match tryTcrefOfAppTy nenv.DisplayEnv.g ty with + | ValueSome tcRef when tcRef.IsUnionTycon -> + let cases = ResolveUnionCasesOfType ncenv m ad ty tcRef + let activePatterns = + nenv.ePatItems + |> Seq.choose (fun x -> + match x.Value with + | Item.ActivePatternCase item when doesActivePatternTakeTypeAsInput nenv.DisplayEnv.g ty item.ActivePatternVal.Type -> + Some x.Value + | _ -> None) + |> Seq.toList + + Some (cases @ activePatterns, nenv.DisplayEnv, m) + | _ -> None + | _ -> None + /// Resolve a location and/or text to items. // Three techniques are used // - look for an exact known name resolution from type checking @@ -976,6 +1012,16 @@ type internal TypeCheckInfo Some (List.map ItemWithNoInst items, denv, m) |> Option.map toCompletionItems + // Completion at ' match x with S... -> () ' + | Some (CompletionContext.MatchClause range) -> + match GetUnionCasesAndActivePatternsEnvironmentLookupResolutionsAtPosition range.End with + | Some (items, denv, range) -> + toCompletionItems (List.map ItemWithNoInst items, denv, range) + |> Some + | _ -> + // Fall back to regular completions when we're not matching against a DU + GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, filterCtors,resolveOverloads, false, fun() -> []) + // Completion at ' { XXX = ... with ... } " | Some(CompletionContext.RecordField(RecordContext.Constructor(typeName))) -> Some(GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, [typeName])) diff --git a/src/fsharp/service/ServiceParsedInputOps.fs b/src/fsharp/service/ServiceParsedInputOps.fs index b945de135a7..172f76bab89 100644 --- a/src/fsharp/service/ServiceParsedInputOps.fs +++ b/src/fsharp/service/ServiceParsedInputOps.fs @@ -77,6 +77,9 @@ type CompletionContext = /// or a single case union without a bar (type SomeUnion = Abc|) | TypeAbbreviationOrSingleCaseUnion + /// Completing a pattern in a match clause (e.g. 'match expr with Som| -> () | _ -> ()') + | MatchClause of rangeOfMatchedExpr: range + type ShortIdent = string type ShortIdents = ShortIdent[] @@ -957,6 +960,45 @@ module ParsedInput = | _ -> defaultTraverse expr + | SynExpr.Match (expr = expr; clauses = clauses) + | SynExpr.MatchBang (expr = expr; clauses = clauses) -> + let rec traverse pos defaultTraverse (matchExpr: SynExpr) clausePat = + match clausePat with + // match x with + // | z| -> + | SynPat.Named _ -> Some (CompletionContext.MatchClause matchExpr.Range) + + // match opt with + // | Som| value -> + | SynPat.LongIdent (longDotId = lidwd) when rangeContainsPos lidwd.Range pos -> Some (CompletionContext.MatchClause matchExpr.Range) + + // match x with + // | Choice1| value + // | Choice2Of3 value -> + | SynPat.Or (lhs, rhs, _, _) -> + match traverse pos defaultTraverse matchExpr lhs with + | Some _ as x -> x + | _ -> traverse pos defaultTraverse matchExpr rhs + + // match x with + // | (ActivePattern1 & ActivePatte| ) -> + | SynPat.Ands (pats, _) -> + pats |> List.tryPick (fun pat -> + if rangeContainsPos pat.Range pos then + traverse pos defaultTraverse matchExpr pat + else + None) + + | _ -> defaultTraverse matchExpr + + let clausePat = + clauses |> List.tryPick (fun (SynMatchClause (pat = pat)) -> if rangeContainsPos pat.Range pos then Some pat else None) + + // Proceed with defaultTraverse if the caret is in a guard or clause body + match clausePat with + | Some clausePat -> traverse pos defaultTraverse expr clausePat + | _ -> defaultTraverse expr + | _ -> defaultTraverse expr member _.VisitRecordField(path, copyOpt, field) = diff --git a/src/fsharp/service/ServiceParsedInputOps.fsi b/src/fsharp/service/ServiceParsedInputOps.fsi index 0aa0bbcc590..b5b743a83b9 100644 --- a/src/fsharp/service/ServiceParsedInputOps.fsi +++ b/src/fsharp/service/ServiceParsedInputOps.fsi @@ -52,6 +52,9 @@ type public CompletionContext = /// or a single case union without a bar (type SomeUnion = Abc|) | TypeAbbreviationOrSingleCaseUnion + /// Completing a pattern in a match clause (e.g. match expr with Som| -> () | _ -> ()) + | MatchClause of rangeOfMatchedExpr: range + type public ModuleKind = { IsAutoOpen: bool HasModuleSuffix: bool } From 5641af57340ce313f753f4c0832793e97716485c Mon Sep 17 00:00:00 2001 From: kerams Date: Wed, 20 Apr 2022 21:59:28 +0200 Subject: [PATCH 02/14] Surface area --- ...FSharp.CompilerService.SurfaceArea.netstandard.expected | 7 +++++++ 1 file changed, 7 insertions(+) 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 dc9699557a6..25628dc3ebb 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected @@ -2442,6 +2442,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+MatchClause: FSharp.Compiler.Text.Range get_rangeOfMatchedExpr() +FSharp.Compiler.EditorServices.CompletionContext+MatchClause: FSharp.Compiler.Text.Range rangeOfMatchedExpr 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 @@ -2453,6 +2455,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 MatchClause FSharp.Compiler.EditorServices.CompletionContext+Tags: Int32 OpenDeclaration FSharp.Compiler.EditorServices.CompletionContext+Tags: Int32 ParameterList FSharp.Compiler.EditorServices.CompletionContext+Tags: Int32 PatternType @@ -2466,6 +2469,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 IsMatchClause FSharp.Compiler.EditorServices.CompletionContext: Boolean IsOpenDeclaration FSharp.Compiler.EditorServices.CompletionContext: Boolean IsParameterList FSharp.Compiler.EditorServices.CompletionContext: Boolean IsPatternType @@ -2476,6 +2480,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_IsMatchClause() FSharp.Compiler.EditorServices.CompletionContext: Boolean get_IsOpenDeclaration() FSharp.Compiler.EditorServices.CompletionContext: Boolean get_IsParameterList() FSharp.Compiler.EditorServices.CompletionContext: Boolean get_IsPatternType() @@ -2486,6 +2491,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 NewMatchClause(FSharp.Compiler.Text.Range) 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) @@ -2500,6 +2506,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+MatchClause 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 From df3a0833eaec1bb17bd06098e126d01626e5496c Mon Sep 17 00:00:00 2001 From: kerams Date: Fri, 22 Apr 2022 18:46:32 +0200 Subject: [PATCH 03/14] Oh yeah --- src/fsharp/absil/illib.fs | 2 + src/fsharp/absil/illib.fsi | 2 + src/fsharp/service/FSharpCheckerResults.fs | 91 ++++++++++++++----- src/fsharp/service/ServiceDeclarationLists.fs | 5 +- src/fsharp/service/ServiceParsedInputOps.fs | 44 ++++++--- src/fsharp/service/ServiceParsedInputOps.fsi | 9 +- ...erService.SurfaceArea.netstandard.expected | 36 ++++++-- 7 files changed, 141 insertions(+), 48 deletions(-) diff --git a/src/fsharp/absil/illib.fs b/src/fsharp/absil/illib.fs index 999c677859b..1c0d19d3974 100644 --- a/src/fsharp/absil/illib.fs +++ b/src/fsharp/absil/illib.fs @@ -1149,6 +1149,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/fsharp/absil/illib.fsi b/src/fsharp/absil/illib.fsi index b9f86798fd2..8a14182368a 100644 --- a/src/fsharp/absil/illib.fsi +++ b/src/fsharp/absil/illib.fsi @@ -627,6 +627,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/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 38e3abb45b9..87618ede5df 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -641,7 +641,7 @@ type internal TypeCheckInfo let items = items |> RemoveExplicitlySuppressed g items, nenv.DisplayEnv, m - /// Find union cases and compatible active patterns in the best naming environment. + /// 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 rec doesActivePatternTakeTypeAsInput g ty paramType = match paramType with @@ -657,25 +657,35 @@ type internal TypeCheckInfo doesActivePatternTakeTypeAsInput g ty rangeType | _ -> false - let _, quals = GetExprTypingForPosition cursorPos - - match quals with - | [| ty, nenv, ad, m |] -> - match tryTcrefOfAppTy nenv.DisplayEnv.g ty with - | ValueSome tcRef when tcRef.IsUnionTycon -> - let cases = ResolveUnionCasesOfType ncenv m ad ty tcRef - let activePatterns = - nenv.ePatItems - |> Seq.choose (fun x -> - match x.Value with - | Item.ActivePatternCase item when doesActivePatternTakeTypeAsInput nenv.DisplayEnv.g ty item.ActivePatternVal.Type -> - Some x.Value - | _ -> None) - |> Seq.toList - - Some (cases @ activePatterns, nenv.DisplayEnv, m) + 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 activePatterns = + nenv.ePatItems + |> Seq.choose (fun x -> + match x.Value with + | Item.ActivePatternCase item when doesActivePatternTakeTypeAsInput nenv.DisplayEnv.g ty item.ActivePatternVal.Type -> + Some x.Value + | _ -> None) + |> Seq.toList + + Some (isUnionInScopeAsUnqualified, cases @ activePatterns, nenv.DisplayEnv, m) + | _ -> None | _ -> None - | _ -> None + else + None /// Resolve a location and/or text to items. // Three techniques are used @@ -1013,14 +1023,47 @@ type internal TypeCheckInfo |> Option.map toCompletionItems // Completion at ' match x with S... -> () ' - | Some (CompletionContext.MatchClause range) -> + | Some (CompletionContext.Match (MatchContext.ClausePatternOutermostIdentifier range)) when origLongIdentOpt.IsNone || origLongIdentOpt.Value.IsEmpty -> match GetUnionCasesAndActivePatternsEnvironmentLookupResolutionsAtPosition range.End with - | Some (items, denv, range) -> - toCompletionItems (List.map ItemWithNoInst items, denv, range) - |> Some + | 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 = uci.Tycon.PublicPath |> Option.map (fun x -> x.EnclosingPath) |> Option.defaultValue [||] + 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) | _ -> - // Fall back to regular completions when we're not matching against a DU + // 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 (_, types) -> + types |> List.exists (fun ty -> isUnionTy g ty || isEnumTy g ty) + | Item.ModuleOrNamespaces _ + | Item.ActivePatternCase _ + | Item.UnionCase _ + | Item.ExnCase _ -> true + | _ -> false), denv, m) // Completion at ' { XXX = ... with ... } " | Some(CompletionContext.RecordField(RecordContext.Constructor(typeName))) -> diff --git a/src/fsharp/service/ServiceDeclarationLists.fs b/src/fsharp/service/ServiceDeclarationLists.fs index 730955375be..384af1bc004 100644 --- a/src/fsharp/service/ServiceDeclarationLists.fs +++ b/src/fsharp/service/ServiceDeclarationLists.fs @@ -1029,7 +1029,10 @@ type DeclarationListInfo(declarations: DeclarationListItem[], isForType: bool, i let textInCode = match item.Unresolved with | Some u -> u.DisplayName - | None -> item.Item.DisplayName + | None -> + match item.Item with + | Item.UnionCase (uci, true) -> $"{uci.Tycon.DisplayName}.{uci.DisplayName}" + | _ -> item.Item.DisplayName textInDeclList, textInCode, items) // Filter out operators, active patterns (as values) diff --git a/src/fsharp/service/ServiceParsedInputOps.fs b/src/fsharp/service/ServiceParsedInputOps.fs index 172f76bab89..73900e891e7 100644 --- a/src/fsharp/service/ServiceParsedInputOps.fs +++ b/src/fsharp/service/ServiceParsedInputOps.fs @@ -46,6 +46,16 @@ type RecordContext = | New of path: CompletionPath | Declaration of isInIdentifier: bool +[] +type MatchContext = + /// Completing the outermost identifier in a match clause pattern + /// (e.g. 'match x with Som| y -> ...' + /// but not 'match x: int option option with Some (Som| y) -> ...') + | ClausePatternOutermostIdentifier 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 @@ -77,8 +87,8 @@ type CompletionContext = /// or a single case union without a bar (type SomeUnion = Abc|) | TypeAbbreviationOrSingleCaseUnion - /// Completing a pattern in a match clause (e.g. 'match expr with Som| -> () | _ -> ()') - | MatchClause of rangeOfMatchedExpr: range + /// Completing a match expression + | Match of context: MatchContext type ShortIdent = string @@ -966,22 +976,22 @@ module ParsedInput = match clausePat with // match x with // | z| -> - | SynPat.Named _ -> Some (CompletionContext.MatchClause matchExpr.Range) + | SynPat.Named (range = range) -> Some (CompletionContext.Match (MatchContext.ClausePatternOutermostIdentifier range)) // match opt with // | Som| value -> - | SynPat.LongIdent (longDotId = lidwd) when rangeContainsPos lidwd.Range pos -> Some (CompletionContext.MatchClause matchExpr.Range) + | SynPat.LongIdent (longDotId = lidwd) when rangeContainsPos lidwd.Range pos -> Some (CompletionContext.Match (MatchContext.ClausePatternOutermostIdentifier lidwd.Range)) // match x with // | Choice1| value // | Choice2Of3 value -> | SynPat.Or (lhs, rhs, _, _) -> match traverse pos defaultTraverse matchExpr lhs with - | Some _ as x -> x - | _ -> traverse pos defaultTraverse matchExpr rhs + | None -> traverse pos defaultTraverse matchExpr rhs + | x -> x // match x with - // | (ActivePattern1 & ActivePatte| ) -> + // | ActivePattern1 & ActivePatte| -> | SynPat.Ands (pats, _) -> pats |> List.tryPick (fun pat -> if rangeContainsPos pat.Range pos then @@ -989,15 +999,21 @@ module ParsedInput = else None) - | _ -> defaultTraverse matchExpr + // match opt with + // | (Som| value) -> + | SynPat.Paren (pat, _) -> traverse pos defaultTraverse matchExpr pat - let clausePat = - clauses |> List.tryPick (fun (SynMatchClause (pat = pat)) -> if rangeContainsPos pat.Range pos then Some pat else None) + | _ -> defaultTraverse matchExpr - // Proceed with defaultTraverse if the caret is in a guard or clause body - match clausePat with - | Some clausePat -> traverse pos defaultTraverse expr clausePat - | _ -> defaultTraverse expr + clauses + |> List.tryPick (fun (SynMatchClause (pat = pat; whenExpr = whenExpr)) -> + if rangeContainsPos pat.Range pos then + traverse pos defaultTraverse expr pat + elif whenExpr.IsSome && rangeContainsPos whenExpr.Value.Range pos then + Some (CompletionContext.Match MatchContext.ClauseGuard) + else + None) + |> Option.orElseWith (fun () -> defaultTraverse expr) | _ -> defaultTraverse expr diff --git a/src/fsharp/service/ServiceParsedInputOps.fsi b/src/fsharp/service/ServiceParsedInputOps.fsi index b5b743a83b9..4874778e4a1 100644 --- a/src/fsharp/service/ServiceParsedInputOps.fsi +++ b/src/fsharp/service/ServiceParsedInputOps.fsi @@ -21,6 +21,11 @@ type public RecordContext = | New of path: CompletionPath | Declaration of isInIdentifier: bool +[] +type public MatchContext = + | ClausePatternOutermostIdentifier of range: range + | ClauseGuard + [] type public CompletionContext = /// Completion context cannot be determined due to errors @@ -52,8 +57,8 @@ type public CompletionContext = /// or a single case union without a bar (type SomeUnion = Abc|) | TypeAbbreviationOrSingleCaseUnion - /// Completing a pattern in a match clause (e.g. match expr with Som| -> () | _ -> ()) - | MatchClause of rangeOfMatchedExpr: range + /// Completing a match expression + | Match of context: MatchContext type public ModuleKind = { IsAutoOpen: bool 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 25628dc3ebb..c7450bb7848 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected @@ -2442,8 +2442,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+MatchClause: FSharp.Compiler.Text.Range get_rangeOfMatchedExpr() -FSharp.Compiler.EditorServices.CompletionContext+MatchClause: FSharp.Compiler.Text.Range rangeOfMatchedExpr +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,7 +2455,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 MatchClause +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 @@ -2469,7 +2469,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 IsMatchClause +FSharp.Compiler.EditorServices.CompletionContext: Boolean IsMatch FSharp.Compiler.EditorServices.CompletionContext: Boolean IsOpenDeclaration FSharp.Compiler.EditorServices.CompletionContext: Boolean IsParameterList FSharp.Compiler.EditorServices.CompletionContext: Boolean IsPatternType @@ -2480,7 +2480,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_IsMatchClause() +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() @@ -2491,7 +2491,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 NewMatchClause(FSharp.Compiler.Text.Range) +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) @@ -2506,7 +2506,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+MatchClause +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 +3078,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+ClausePatternOutermostIdentifier: FSharp.Compiler.Text.Range get_range() +FSharp.Compiler.EditorServices.MatchContext+ClausePatternOutermostIdentifier: FSharp.Compiler.Text.Range range +FSharp.Compiler.EditorServices.MatchContext+Tags: Int32 ClauseGuard +FSharp.Compiler.EditorServices.MatchContext+Tags: Int32 ClausePatternOutermostIdentifier +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 IsClausePatternOutermostIdentifier +FSharp.Compiler.EditorServices.MatchContext: Boolean get_IsClauseGuard() +FSharp.Compiler.EditorServices.MatchContext: Boolean get_IsClausePatternOutermostIdentifier() +FSharp.Compiler.EditorServices.MatchContext: FSharp.Compiler.EditorServices.MatchContext ClauseGuard +FSharp.Compiler.EditorServices.MatchContext: FSharp.Compiler.EditorServices.MatchContext NewClausePatternOutermostIdentifier(FSharp.Compiler.Text.Range) +FSharp.Compiler.EditorServices.MatchContext: FSharp.Compiler.EditorServices.MatchContext get_ClauseGuard() +FSharp.Compiler.EditorServices.MatchContext: FSharp.Compiler.EditorServices.MatchContext+ClausePatternOutermostIdentifier +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) From ffc2c4ea577103295981e695a14fde266683dc93 Mon Sep 17 00:00:00 2001 From: kerams Date: Fri, 29 Apr 2022 20:54:28 +0200 Subject: [PATCH 04/14] Some tests --- src/fsharp/service/ServiceDeclarationLists.fs | 16 ++- src/fsharp/service/ServiceParsedInputOps.fs | 16 +-- src/fsharp/service/ServiceParsedInputOps.fsi | 5 + .../UnitTests/CompletionProviderTests.fs | 101 ++++++++++++++++++ 4 files changed, 121 insertions(+), 17 deletions(-) diff --git a/src/fsharp/service/ServiceDeclarationLists.fs b/src/fsharp/service/ServiceDeclarationLists.fs index a788a03b2d9..0c6e60f4760 100644 --- a/src/fsharp/service/ServiceDeclarationLists.fs +++ b/src/fsharp/service/ServiceDeclarationLists.fs @@ -1036,15 +1036,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 -> - match item.Item with - | Item.UnionCase (uci, true) -> $"{uci.Tycon.DisplayName}.{uci.DisplayName}" - | _ -> 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) diff --git a/src/fsharp/service/ServiceParsedInputOps.fs b/src/fsharp/service/ServiceParsedInputOps.fs index d80a645a567..3f5592b639b 100644 --- a/src/fsharp/service/ServiceParsedInputOps.fs +++ b/src/fsharp/service/ServiceParsedInputOps.fs @@ -971,9 +971,9 @@ module ParsedInput = | _ -> defaultTraverse expr - | SynExpr.Match (expr = expr; clauses = clauses) - | SynExpr.MatchBang (expr = expr; clauses = clauses) -> - let rec traverse pos defaultTraverse (matchExpr: SynExpr) clausePat = + | SynExpr.Match (clauses = clauses) + | SynExpr.MatchBang (clauses = clauses) -> + let rec traverse pos defaultTraverse (expr: SynExpr) clausePat = match clausePat with // match x with // | z| -> @@ -987,8 +987,8 @@ module ParsedInput = // | Choice1| value // | Choice2Of3 value -> | SynPat.Or (lhs, rhs, _, _) -> - match traverse pos defaultTraverse matchExpr lhs with - | None -> traverse pos defaultTraverse matchExpr rhs + match traverse pos defaultTraverse expr lhs with + | None -> traverse pos defaultTraverse expr rhs | x -> x // match x with @@ -996,15 +996,15 @@ module ParsedInput = | SynPat.Ands (pats, _) -> pats |> List.tryPick (fun pat -> if rangeContainsPos pat.Range pos then - traverse pos defaultTraverse matchExpr pat + traverse pos defaultTraverse expr pat else None) // match opt with // | (Som| value) -> - | SynPat.Paren (pat, _) -> traverse pos defaultTraverse matchExpr pat + | SynPat.Paren (pat, _) -> traverse pos defaultTraverse expr pat - | _ -> defaultTraverse matchExpr + | _ -> defaultTraverse expr clauses |> List.tryPick (fun (SynMatchClause (pat = pat; whenExpr = whenExpr)) -> diff --git a/src/fsharp/service/ServiceParsedInputOps.fsi b/src/fsharp/service/ServiceParsedInputOps.fsi index 7bce8f3c79b..8db0e3e8672 100644 --- a/src/fsharp/service/ServiceParsedInputOps.fsi +++ b/src/fsharp/service/ServiceParsedInputOps.fsi @@ -24,7 +24,12 @@ type public RecordContext = [] type public MatchContext = + /// Completing the outermost identifier in a match clause pattern + /// (e.g. 'match x with Som| y -> ...' + /// but not 'match x: int option option with Some (Som| y) -> ...') | ClausePatternOutermostIdentifier of range: range + + /// Completing a match clause guard (e.g. match x with Some y when y| -> ...) | ClauseGuard [] diff --git a/vsintegration/tests/UnitTests/CompletionProviderTests.fs b/vsintegration/tests/UnitTests/CompletionProviderTests.fs index 52193afac40..dcd382a888d 100644 --- a/vsintegration/tests/UnitTests/CompletionProviderTests.fs +++ b/vsintegration/tests/UnitTests/CompletionProviderTests.fs @@ -877,6 +877,107 @@ let emptyMap<'keyType, 'lValueType> () = """ VerifyCompletionList(fileContents, ", l", ["LanguagePrimitives"; "List"; "lValueType"], ["let"; "log"]) +[] +let ``Completion list in match clause contains only union cases and compatible active pattern when the match expression type is known``() = + let fileContents = """ +let (|CPat|_|) (str: string) (x: Choice) = + Some CPat + +let (|CPat1|CPat2|) (x: Choice) = + match x with + | Choice1Of2 _ -> CPat1 + | _ -> CPat2 + +let call (choice: Choice) = + match choice with + | C +""" + VerifyCompletionListExactly(fileContents, "| C", [ "Choice1Of2"; "Choice2Of2"; "CPat"; "CPat1"; "CPat2" ]) + +[] +let ``Completion list in match clause contains only 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) = + match x with + | Choice1Of2 _ -> CPat1 + | _ -> CPat2 + +let call (choice: unit -> Async>) = async { + match! choice () with + | C +""" + VerifyCompletionListExactly(fileContents, "| C", [ "Choice1Of2"; "Choice2Of2"; "CPat"; "CPat1"; "CPat2" ]) + +[] +let ``Completion list in match clause contains only union cases and compatible active pattern when the match expression type is known3``() = + let fileContents = """ +let call x = + match x "" with + | None -> () + | s +""" + VerifyCompletionListExactly(fileContents, "| s", [ "None"; "Some" ]) + +[] +let ``Completion list in match clause is empty on the outer identifier when the match expression type is list``() = + let fileContents = """ +let call x = + match x "" with + | [] -> () + | s +""" + VerifyNoCompletionList(fileContents, "| s") + +[] +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" ]) + #if EXE ShouldDisplaySystemNamespace() #endif From fe755dbf0b919f4d73dec42bccb1da47ff140cab Mon Sep 17 00:00:00 2001 From: kerams Date: Fri, 29 Apr 2022 21:57:21 +0200 Subject: [PATCH 05/14] Try fix tests --- vsintegration/tests/UnitTests/CompletionProviderTests.fs | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/vsintegration/tests/UnitTests/CompletionProviderTests.fs b/vsintegration/tests/UnitTests/CompletionProviderTests.fs index dcd382a888d..01fd0dff7ac 100644 --- a/vsintegration/tests/UnitTests/CompletionProviderTests.fs +++ b/vsintegration/tests/UnitTests/CompletionProviderTests.fs @@ -884,9 +884,7 @@ let (|CPat|_|) (str: string) (x: Choice) = Some CPat let (|CPat1|CPat2|) (x: Choice) = - match x with - | Choice1Of2 _ -> CPat1 - | _ -> CPat2 + if true then CPat1 else CPat2 let call (choice: Choice) = match choice with @@ -901,9 +899,7 @@ let (|CPat|_|) (str: string) (x: Choice) = Some CPat let (|CPat1|CPat2|) (x: Choice) = - match x with - | Choice1Of2 _ -> CPat1 - | _ -> CPat2 + if true then CPat1 else CPat2 let call (choice: unit -> Async>) = async { match! choice () with From de33a662d9533a235269de194312836de13eeca8 Mon Sep 17 00:00:00 2001 From: kerams Date: Sat, 30 Apr 2022 10:30:01 +0200 Subject: [PATCH 06/14] More tests and fixes --- src/fsharp/service/FSharpCheckerResults.fs | 4 +- src/fsharp/service/ServiceParsedInputOps.fs | 26 ++++---- src/fsharp/service/ServiceParsedInputOps.fsi | 7 +-- ...erService.SurfaceArea.netstandard.expected | 14 ++--- .../UnitTests/CompletionProviderTests.fs | 62 +++++++++++++++++++ 5 files changed, 87 insertions(+), 26 deletions(-) diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index ecf873660f0..38eb0d4026c 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -1053,8 +1053,8 @@ type internal TypeCheckInfo Some (List.map ItemWithNoInst items, denv, m) |> Option.map toCompletionItems - // Completion at ' match x with S... -> () ' - | Some (CompletionContext.Match (MatchContext.ClausePatternOutermostIdentifier range)) when origLongIdentOpt.IsNone || origLongIdentOpt.Value.IsEmpty -> + // 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 -> match GetUnionCasesAndActivePatternsEnvironmentLookupResolutionsAtPosition range.End with | Some (isUnionInScopeAsUnqualified, items, denv, range) -> let items = diff --git a/src/fsharp/service/ServiceParsedInputOps.fs b/src/fsharp/service/ServiceParsedInputOps.fs index 3f5592b639b..01c3cdf96b5 100644 --- a/src/fsharp/service/ServiceParsedInputOps.fs +++ b/src/fsharp/service/ServiceParsedInputOps.fs @@ -49,10 +49,9 @@ type RecordContext = [] type MatchContext = - /// Completing the outermost identifier in a match clause pattern - /// (e.g. 'match x with Som| y -> ...' - /// but not 'match x: int option option with Some (Som| y) -> ...') - | ClausePatternOutermostIdentifier of range: range + /// 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 @@ -973,22 +972,23 @@ module ParsedInput = | SynExpr.Match (clauses = clauses) | SynExpr.MatchBang (clauses = clauses) -> - let rec traverse pos defaultTraverse (expr: SynExpr) clausePat = + let rec traverse pos clausePat = match clausePat with // match x with // | z| -> - | SynPat.Named (range = range) -> Some (CompletionContext.Match (MatchContext.ClausePatternOutermostIdentifier range)) + | SynPat.Named (range = range) -> Some (CompletionContext.Match (MatchContext.ClausePatternIdentifier range)) // match opt with // | Som| value -> - | SynPat.LongIdent (longDotId = lidwd) when rangeContainsPos lidwd.Range pos -> Some (CompletionContext.Match (MatchContext.ClausePatternOutermostIdentifier lidwd.Range)) + | 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 defaultTraverse expr lhs with - | None -> traverse pos defaultTraverse expr rhs + match traverse pos lhs with + | None -> traverse pos rhs | x -> x // match x with @@ -996,20 +996,20 @@ module ParsedInput = | SynPat.Ands (pats, _) -> pats |> List.tryPick (fun pat -> if rangeContainsPos pat.Range pos then - traverse pos defaultTraverse expr pat + traverse pos pat else None) // match opt with // | (Som| value) -> - | SynPat.Paren (pat, _) -> traverse pos defaultTraverse expr pat + | SynPat.Paren (pat, _) -> traverse pos pat - | _ -> defaultTraverse expr + | _ -> None clauses |> List.tryPick (fun (SynMatchClause (pat = pat; whenExpr = whenExpr)) -> if rangeContainsPos pat.Range pos then - traverse pos defaultTraverse expr pat + traverse pos pat elif whenExpr.IsSome && rangeContainsPos whenExpr.Value.Range pos then Some (CompletionContext.Match MatchContext.ClauseGuard) else diff --git a/src/fsharp/service/ServiceParsedInputOps.fsi b/src/fsharp/service/ServiceParsedInputOps.fsi index 8db0e3e8672..8b5cc7a732f 100644 --- a/src/fsharp/service/ServiceParsedInputOps.fsi +++ b/src/fsharp/service/ServiceParsedInputOps.fsi @@ -24,10 +24,9 @@ type public RecordContext = [] type public MatchContext = - /// Completing the outermost identifier in a match clause pattern - /// (e.g. 'match x with Som| y -> ...' - /// but not 'match x: int option option with Some (Som| y) -> ...') - | ClausePatternOutermostIdentifier of range: range + /// 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 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 fd4d17028f7..6c88b263224 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected @@ -3086,21 +3086,21 @@ 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+ClausePatternOutermostIdentifier: FSharp.Compiler.Text.Range get_range() -FSharp.Compiler.EditorServices.MatchContext+ClausePatternOutermostIdentifier: FSharp.Compiler.Text.Range range +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 ClausePatternOutermostIdentifier +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 IsClausePatternOutermostIdentifier +FSharp.Compiler.EditorServices.MatchContext: Boolean IsClausePatternIdentifier FSharp.Compiler.EditorServices.MatchContext: Boolean get_IsClauseGuard() -FSharp.Compiler.EditorServices.MatchContext: Boolean get_IsClausePatternOutermostIdentifier() +FSharp.Compiler.EditorServices.MatchContext: Boolean get_IsClausePatternIdentifier() FSharp.Compiler.EditorServices.MatchContext: FSharp.Compiler.EditorServices.MatchContext ClauseGuard -FSharp.Compiler.EditorServices.MatchContext: FSharp.Compiler.EditorServices.MatchContext NewClausePatternOutermostIdentifier(FSharp.Compiler.Text.Range) +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+ClausePatternOutermostIdentifier +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) diff --git a/vsintegration/tests/UnitTests/CompletionProviderTests.fs b/vsintegration/tests/UnitTests/CompletionProviderTests.fs index 01fd0dff7ac..2c37a19de12 100644 --- a/vsintegration/tests/UnitTests/CompletionProviderTests.fs +++ b/vsintegration/tests/UnitTests/CompletionProviderTests.fs @@ -883,6 +883,9 @@ let ``Completion list in match clause contains only union cases and compatible a 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 @@ -917,6 +920,47 @@ let call x = """ VerifyCompletionListExactly(fileContents, "| s", [ "None"; "Some" ]) +[] +let ``Completion list in match clause contains only union cases 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 +""" + VerifyCompletionListExactly(fileContents, "| C", [ "Choice1"; "Choice2" ]) + +[] +let ``Completion list in match clause contains only union cases when the match expression type is a union with RequireQualifiedAccess``() = + let fileContents = """ +[] +type ChoiceZ = + | Choice1 + | Choice2 + +let call (choice: ChoiceZ) = + match choice with + | C +""" + VerifyCompletionListExactly(fileContents, "| C", [ "Choice1"; "Choice2" ]) + +[] +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 +""" + VerifyCompletionListExactly(fileContents, "| C", [ "Choice1Of2"; "Choice2Of2" ]) + [] let ``Completion list in match clause is empty on the outer identifier when the match expression type is list``() = let fileContents = """ @@ -974,6 +1018,24 @@ let call x = """ 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 From 6e61a4d4c1470e358475b9d4e4fee37c90dd4032 Mon Sep 17 00:00:00 2001 From: kerams Date: Sat, 30 Apr 2022 11:31:06 +0200 Subject: [PATCH 07/14] Yet more tests --- .../CompletionTests.fs | 45 +++++++++++++++++++ .../UnitTests/CompletionProviderTests.fs | 16 +++++-- 2 files changed, 58 insertions(+), 3 deletions(-) diff --git a/tests/FSharp.Compiler.Private.Scripting.UnitTests/CompletionTests.fs b/tests/FSharp.Compiler.Private.Scripting.UnitTests/CompletionTests.fs index 74062d0b028..cd2158ee228 100644 --- a/tests/FSharp.Compiler.Private.Scripting.UnitTests/CompletionTests.fs +++ b/tests/FSharp.Compiler.Private.Scripting.UnitTests/CompletionTests.fs @@ -157,4 +157,49 @@ 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 + + Assert.Equal (2, completions.Length) + + for c in completions 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 + + Assert.Equal (2, completions.Length) + + for c in completions do + Assert.Equal (Some "M", c.NamespaceToOpen) + Assert.StartsWith ("ChoiceZ.", c.NameInCode) diff --git a/vsintegration/tests/UnitTests/CompletionProviderTests.fs b/vsintegration/tests/UnitTests/CompletionProviderTests.fs index 2c37a19de12..0cb2de90b9c 100644 --- a/vsintegration/tests/UnitTests/CompletionProviderTests.fs +++ b/vsintegration/tests/UnitTests/CompletionProviderTests.fs @@ -906,16 +906,17 @@ let (|CPat1|CPat2|) (x: Choice) = let call (choice: unit -> Async>) = async { match! choice () with - | C + | (CPat "param" & c) """ - VerifyCompletionListExactly(fileContents, "| C", [ "Choice1Of2"; "Choice2Of2"; "CPat"; "CPat1"; "CPat2" ]) + VerifyCompletionListExactly(fileContents, "& c", [ "Choice1Of2"; "Choice2Of2"; "CPat"; "CPat1"; "CPat2" ]) [] let ``Completion list in match clause contains only union cases and compatible active pattern when the match expression type is known3``() = let fileContents = """ let call x = match x "" with - | None -> () + | None when true -> () + | None | s """ VerifyCompletionListExactly(fileContents, "| s", [ "None"; "Some" ]) @@ -961,6 +962,15 @@ let call (choice: unit -> Async>) = task { """ VerifyCompletionListExactly(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 empty on the outer identifier when the match expression type is list``() = let fileContents = """ From d73b1bdbf213a3d4549a6f5d9ad9e308e5e4e53f Mon Sep 17 00:00:00 2001 From: kerams Date: Sat, 30 Apr 2022 11:33:26 +0200 Subject: [PATCH 08/14] Fix tests --- vsintegration/tests/UnitTests/CompletionProviderTests.fs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/vsintegration/tests/UnitTests/CompletionProviderTests.fs b/vsintegration/tests/UnitTests/CompletionProviderTests.fs index 0cb2de90b9c..970d15d4f22 100644 --- a/vsintegration/tests/UnitTests/CompletionProviderTests.fs +++ b/vsintegration/tests/UnitTests/CompletionProviderTests.fs @@ -931,9 +931,9 @@ module M = let call (choice: M.ChoiceZ) = match choice with - | C + | c """ - VerifyCompletionListExactly(fileContents, "| C", [ "Choice1"; "Choice2" ]) + VerifyCompletionListExactly(fileContents, "| c", [ "Choice1"; "Choice2" ]) [] let ``Completion list in match clause contains only union cases when the match expression type is a union with RequireQualifiedAccess``() = @@ -945,9 +945,9 @@ type ChoiceZ = let call (choice: ChoiceZ) = match choice with - | C + | c """ - VerifyCompletionListExactly(fileContents, "| C", [ "Choice1"; "Choice2" ]) + VerifyCompletionListExactly(fileContents, "| c", [ "Choice1"; "Choice2" ]) [] let ``Completion list in match clause does not contain compatible active pattern out of scope when the match expression type is known``() = From be14d0a676709a8dbfad852207e4c41bfaa644bf Mon Sep 17 00:00:00 2001 From: kerams Date: Sun, 1 May 2022 09:33:47 +0200 Subject: [PATCH 09/14] Fix namespaces to open --- src/fsharp/TypedTreeOps.fs | 10 ++++ src/fsharp/TypedTreeOps.fsi | 2 + src/fsharp/service/FSharpCheckerResults.fs | 2 +- .../CompletionTests.fs | 46 +++++++++++++++++++ 4 files changed, 59 insertions(+), 1 deletion(-) diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 20e6e201cbf..e07dfa89dc5 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -3169,6 +3169,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/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index c505e865c83..877ed2eb04d 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -1054,6 +1054,8 @@ val qualifiedInterfaceImplementationName: TcGlobals -> TType -> string -> string val trimPathByDisplayEnv: DisplayEnv -> string list -> string +val trimPathByDisplayEnvList: DisplayEnv -> string list -> string list + val prefixOfStaticReq: TyparStaticReq -> string val prefixOfRigidTypar: Typar -> string diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 38eb0d4026c..696c33adb2a 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -1065,7 +1065,7 @@ type internal TypeCheckInfo | Item.UnionCase (uci, requiresQualifiedAccess) when not isUnionInScopeAsUnqualified -> Some { FullName = uci.Tycon.CompiledRepresentationForNamedType.FullName - Namespace = uci.Tycon.PublicPath |> Option.map (fun x -> x.EnclosingPath) |> Option.defaultValue [||] + Namespace = trimPathByDisplayEnvList denv uci.Tycon.CompilationPath.DemangledPath |> List.toArray DisplayName = if requiresQualifiedAccess then $"{uci.Tycon.DisplayName}.{uci.DisplayName}" else uci.DisplayName } | _ -> None diff --git a/tests/FSharp.Compiler.Private.Scripting.UnitTests/CompletionTests.fs b/tests/FSharp.Compiler.Private.Scripting.UnitTests/CompletionTests.fs index cd2158ee228..b1acc1a06fa 100644 --- a/tests/FSharp.Compiler.Private.Scripting.UnitTests/CompletionTests.fs +++ b/tests/FSharp.Compiler.Private.Scripting.UnitTests/CompletionTests.fs @@ -203,3 +203,49 @@ let call (choice: M.ChoiceZ) = 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 + + Assert.Equal (2, completions.Length) + + for c in completions 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 + + Assert.Equal (2, completions.Length) + + for c in completions do + Assert.Equal (Some "N.M", c.NamespaceToOpen) + Assert.Equal (c.Name, c.NameInCode) + From e5090c970ba7e66cd7c5a61d332e1d64d1438930 Mon Sep 17 00:00:00 2001 From: kerams Date: Wed, 11 May 2022 22:45:05 +0200 Subject: [PATCH 10/14] Address comments --- src/Compiler/Service/FSharpCheckerResults.fs | 19 +++++++++---------- src/Compiler/Service/ServiceParsedInputOps.fs | 4 +++- 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index cd278302b91..4792eb9591b 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -649,7 +649,7 @@ type internal TypeCheckInfo /// 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 rec doesActivePatternTakeTypeAsInput g ty paramType = - match paramType with + match stripTyEqns g paramType with | TType_var (typar, _) -> match typar.Solution with | Some paramType -> @@ -677,14 +677,13 @@ type internal TypeCheckInfo | ValueSome tcRef when tcRef.IsUnionTycon -> let isUnionInScopeAsUnqualified = nenv.eTyconsByAccessNames.ContainsKey tcRef.DisplayName let cases = ResolveUnionCasesOfType ncenv m res.AccessorDomain ty tcRef - let activePatterns = - nenv.ePatItems - |> Seq.choose (fun x -> - match x.Value with + let activePatterns = [ + for kvp in nenv.ePatItems do + match kvp.Value with | Item.ActivePatternCase item when doesActivePatternTakeTypeAsInput nenv.DisplayEnv.g ty item.ActivePatternVal.Type -> - Some x.Value - | _ -> None) - |> Seq.toList + kvp.Value + | _ -> () + ] Some (isUnionInScopeAsUnqualified, cases @ activePatterns, nenv.DisplayEnv, m) | _ -> None @@ -1088,8 +1087,8 @@ type internal TypeCheckInfo |> List.filter (fun cItem -> match cItem.Item with | Item.Value vref -> vref.LiteralValue.IsSome - | Item.Types (_, types) -> - types |> List.exists (fun ty -> isUnionTy g ty || isEnumTy g ty) + | Item.Types (_, tys) -> + tys |> List.exists (fun ty -> isUnionTy g ty || isEnumTy g ty) | Item.ModuleOrNamespaces _ | Item.ActivePatternCase _ | Item.UnionCase _ diff --git a/src/Compiler/Service/ServiceParsedInputOps.fs b/src/Compiler/Service/ServiceParsedInputOps.fs index 31cc13b46da..ef9babfdf83 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -985,13 +985,15 @@ module ParsedInput = | _ -> defaultTraverse expr + | SynExpr.MatchLambda (matchClauses = clauses) | SynExpr.Match (clauses = clauses) | SynExpr.MatchBang (clauses = clauses) -> let rec traverse pos clausePat = match clausePat with // match x with // | z| -> - | SynPat.Named (range = range) -> Some (CompletionContext.Match (MatchContext.ClausePatternIdentifier range)) + | SynPat.Named (range = range) -> + Some (CompletionContext.Match (MatchContext.ClausePatternIdentifier range)) // match opt with // | Som| value -> From 076fb98c7a0cfa4c2ec7a6fdffdf6c1e424ed6c8 Mon Sep 17 00:00:00 2001 From: kerams Date: Thu, 12 May 2022 22:42:51 +0200 Subject: [PATCH 11/14] Address more comments --- src/Compiler/Checking/NameResolution.fs | 84 ++++--------- src/Compiler/Checking/NameResolution.fsi | 2 +- src/Compiler/Service/FSharpCheckerResults.fs | 87 +++++++------- src/Compiler/Service/ServiceParsedInputOps.fs | 111 +++++++++++------- src/Compiler/TypedTree/TypedTreeOps.fsi | 1 + 5 files changed, 139 insertions(+), 146 deletions(-) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 7f38ac6dce2..592cc4d98a4 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -4316,6 +4316,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 = @@ -4351,20 +4372,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 @@ -4529,21 +4537,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 @@ -4952,19 +4946,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 @@ -5018,21 +5000,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 927a3545624..8541349078f 100644 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -789,7 +789,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/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 4792eb9591b..bbca2a14820 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -954,6 +954,50 @@ 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) = + + match GetUnionCasesAndActivePatternsEnvironmentLookupResolutionsAtPosition identifierRange.End 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 @@ -1054,46 +1098,7 @@ type internal TypeCheckInfo // 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 -> - match GetUnionCasesAndActivePatternsEnvironmentLookupResolutionsAtPosition range.End 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) + GetMatchCompletionsAtPosition (range, parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, filterCtors, resolveOverloads) // Completion at ' { XXX = ... with ... } " | Some(CompletionContext.RecordField(RecordContext.Constructor(typeName))) -> @@ -1199,7 +1204,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/ServiceParsedInputOps.fs b/src/Compiler/Service/ServiceParsedInputOps.fs index ef9babfdf83..fb60ddee977 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -757,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 = @@ -988,50 +1054,7 @@ module ParsedInput = | SynExpr.MatchLambda (matchClauses = clauses) | SynExpr.Match (clauses = clauses) | SynExpr.MatchBang (clauses = clauses) -> - 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 -> - | 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 - - | _ -> 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 (fun () -> defaultTraverse expr) + tryGetMatchClauseCompletionContext (fun () -> defaultTraverse expr) clauses pos | SynExpr.Record(None, None, [], _) -> Some(CompletionContext.RecordField RecordContext.Empty) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 09e93797182..2ac26e01763 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -1104,6 +1104,7 @@ 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 From 301ffaa4d8325b0f54e26660762bbeacec4af669 Mon Sep 17 00:00:00 2001 From: kerams Date: Mon, 16 May 2022 17:45:55 +0200 Subject: [PATCH 12/14] Address more comments, fixes --- src/Compiler/Checking/TypeRelations.fs | 18 +++++++++- src/Compiler/Checking/TypeRelations.fsi | 3 ++ src/Compiler/Service/FSharpCheckerResults.fs | 25 +++++-------- .../UnitTests/CompletionProviderTests.fs | 35 ++++++++----------- 4 files changed, 42 insertions(+), 39 deletions(-) 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..1a9e2f11903 100644 --- a/src/Compiler/Checking/TypeRelations.fsi +++ b/src/Compiler/Checking/TypeRelations.fsi @@ -80,3 +80,6 @@ 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 f9e2c06d30b..2b57fa99c98 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -648,20 +648,6 @@ type internal TypeCheckInfo /// 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 rec doesActivePatternTakeTypeAsInput g ty paramType = - match stripTyEqns g paramType with - | TType_var (typar, _) -> - match typar.Solution with - | Some paramType -> - doesActivePatternTakeTypeAsInput g ty paramType - | _ -> false - | TType_fun (domainType, rangeType, _) -> - if typeEquiv g domainType ty then - true - else - doesActivePatternTakeTypeAsInput g ty rangeType - | _ -> false - let resolutions = GetCapturedNameResolutions cursorPos ResolveOverloads.Yes if resolutions.Count = 1 then @@ -677,15 +663,18 @@ type internal TypeCheckInfo | 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 doesActivePatternTakeTypeAsInput nenv.DisplayEnv.g ty item.ActivePatternVal.Type -> + | Item.ActivePatternCase item when TypeRelations.ActivePatternFeasiblyAcceptsTypeAsInput ncenv.g ncenv.amap m ty item.ActivePatternVal.Type -> kvp.Value | _ -> () ] - Some (isUnionInScopeAsUnqualified, cases @ activePatterns, nenv.DisplayEnv, m) + Some (isUnionInScopeAsUnqualified, cases @ activePatterns @ modulesAndNamespaces, nenv.DisplayEnv, m) | _ -> None | _ -> None else @@ -958,7 +947,9 @@ type internal TypeCheckInfo let GetMatchCompletionsAtPosition (identifierRange: range, parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, filterCtors, resolveOverloads) = - match GetUnionCasesAndActivePatternsEnvironmentLookupResolutionsAtPosition identifierRange.End with + let patternItems = GetUnionCasesAndActivePatternsEnvironmentLookupResolutionsAtPosition identifierRange.End + + match patternItems with | Some (isUnionInScopeAsUnqualified, items, denv, range) -> let items = items diff --git a/vsintegration/tests/UnitTests/CompletionProviderTests.fs b/vsintegration/tests/UnitTests/CompletionProviderTests.fs index e3d3d343191..5c666de3ce8 100644 --- a/vsintegration/tests/UnitTests/CompletionProviderTests.fs +++ b/vsintegration/tests/UnitTests/CompletionProviderTests.fs @@ -861,7 +861,7 @@ let emptyMap<'keyType, 'lValueType> () = VerifyCompletionList(fileContents, ", l", ["LanguagePrimitives"; "List"; "lValueType"], ["let"; "log"]) [] -let ``Completion list in match clause contains only union cases and compatible active pattern when the match expression type is known``() = +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 @@ -876,10 +876,10 @@ let call (choice: Choice) = match choice with | C """ - VerifyCompletionListExactly(fileContents, "| C", [ "Choice1Of2"; "Choice2Of2"; "CPat"; "CPat1"; "CPat2" ]) + VerifyCompletionList(fileContents, "| C", [ "Choice1Of2"; "Choice2Of2"; "CPat"; "CPat1"; "CPat2"; "System" ], []) [] -let ``Completion list in match clause contains only union cases and compatible active pattern when the match expression type is known2``() = +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 @@ -887,14 +887,17 @@ let (|CPat|_|) (str: string) (x: Choice) = 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) """ - VerifyCompletionListExactly(fileContents, "& c", [ "Choice1Of2"; "Choice2Of2"; "CPat"; "CPat1"; "CPat2" ]) + VerifyCompletionList(fileContents, "& c", [ "Choice1Of2"; "Choice2Of2"; "CPat"; "CPat1"; "CPat2"; "CComparablePat"; "System" ], []) [] -let ``Completion list in match clause contains only union cases and compatible active pattern when the match expression type is known3``() = +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 @@ -902,10 +905,10 @@ let call x = | None | s """ - VerifyCompletionListExactly(fileContents, "| s", [ "None"; "Some" ]) + VerifyCompletionList(fileContents, "| s", [ "None"; "Some"; "System" ], []) [] -let ``Completion list in match clause contains only union cases when the match expression type is known but in an unopened module``() = +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 = @@ -916,10 +919,10 @@ let call (choice: M.ChoiceZ) = match choice with | c """ - VerifyCompletionListExactly(fileContents, "| c", [ "Choice1"; "Choice2" ]) + VerifyCompletionList(fileContents, "| c", [ "Choice1"; "Choice2"; "System" ], [ "Some" ]) [] -let ``Completion list in match clause contains only union cases when the match expression type is a union with RequireQualifiedAccess``() = +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 = @@ -930,7 +933,7 @@ let call (choice: ChoiceZ) = match choice with | c """ - VerifyCompletionListExactly(fileContents, "| c", [ "Choice1"; "Choice2" ]) + 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``() = @@ -943,7 +946,7 @@ let call (choice: unit -> Async>) = task { match! choice () with | C """ - VerifyCompletionListExactly(fileContents, "| C", [ "Choice1Of2"; "Choice2Of2" ]) + VerifyCompletionList(fileContents, "| C", [ "Choice1Of2"; "Choice2Of2" ], []) [] let ``Completion list in match clause on union case parameters not filtered when the match expression type is known``() = @@ -954,16 +957,6 @@ let call (choice: unit -> Async>) = task { """ VerifyCompletionList(fileContents, "(s", [ "Some"; "Choice1Of2"; "Choice2Of2" ], []) -[] -let ``Completion list in match clause is empty on the outer identifier when the match expression type is list``() = - let fileContents = """ -let call x = - match x "" with - | [] -> () - | s -""" - VerifyNoCompletionList(fileContents, "| s") - [] let ``Completion list in match clause is not empty on an identifier in a list``() = let fileContents = """ From a563aaf2e2ba4379f64baab704289fc95571ef61 Mon Sep 17 00:00:00 2001 From: kerams Date: Mon, 16 May 2022 18:19:35 +0200 Subject: [PATCH 13/14] Fix tests --- .../CompletionTests.fs | 20 +++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/tests/FSharp.Compiler.Private.Scripting.UnitTests/CompletionTests.fs b/tests/FSharp.Compiler.Private.Scripting.UnitTests/CompletionTests.fs index b1acc1a06fa..c915af925cc 100644 --- a/tests/FSharp.Compiler.Private.Scripting.UnitTests/CompletionTests.fs +++ b/tests/FSharp.Compiler.Private.Scripting.UnitTests/CompletionTests.fs @@ -174,10 +174,11 @@ let call (choice: M.ChoiceZ) = | C """ let completions = script.GetCompletionItems(text, 12, 7) |> Async.RunSynchronously + let choiceCaseCompletions = completions |> Array.filter (fun x -> x.Name.StartsWith "Choice") - Assert.Equal (2, completions.Length) + Assert.Equal (2, choiceCaseCompletions.Length) - for c in completions do + for c in choiceCaseCompletions do Assert.Equal (None, c.NamespaceToOpen) Assert.Equal ("ChoiceZ." + c.Name, c.NameInCode) @@ -196,10 +197,11 @@ let call (choice: M.ChoiceZ) = | C """ let completions = script.GetCompletionItems(text, 10, 7) |> Async.RunSynchronously + let choiceCaseCompletions = completions |> Array.filter (fun x -> x.Name.StartsWith "Choice") - Assert.Equal (2, completions.Length) + Assert.Equal (2, choiceCaseCompletions.Length) - for c in completions do + for c in choiceCaseCompletions do Assert.Equal (Some "M", c.NamespaceToOpen) Assert.StartsWith ("ChoiceZ.", c.NameInCode) @@ -218,10 +220,11 @@ let call (choice: M.ChoiceZ) = | C """ let completions = script.GetCompletionItems(text, 10, 7) |> Async.RunSynchronously + let choiceCaseCompletions = completions |> Array.filter (fun x -> x.Name.StartsWith "Choice") - Assert.Equal (2, completions.Length) + Assert.Equal (2, choiceCaseCompletions.Length) - for c in completions do + for c in choiceCaseCompletions do Assert.Equal (None, c.NamespaceToOpen) Assert.Equal (c.Name, c.NameInCode) @@ -242,10 +245,11 @@ module F = | C """ let completions = script.GetCompletionItems(text, 12, 11) |> Async.RunSynchronously + let choiceCaseCompletions = completions |> Array.filter (fun x -> x.Name.StartsWith "Choice") - Assert.Equal (2, completions.Length) + Assert.Equal (2, choiceCaseCompletions.Length) - for c in completions do + for c in choiceCaseCompletions do Assert.Equal (Some "N.M", c.NamespaceToOpen) Assert.Equal (c.Name, c.NameInCode) From dbfcbfe88276243f0b95125317502a5fbdfd4b47 Mon Sep 17 00:00:00 2001 From: kerams Date: Fri, 20 May 2022 21:30:13 +0200 Subject: [PATCH 14/14] Refactor --- src/Compiler/Checking/TypeRelations.fsi | 8 +- src/Compiler/Service/FSharpCheckerResults.fs | 158 ++++++++++++------ .../Service/ServiceDeclarationLists.fs | 9 +- .../Service/ServiceDeclarationLists.fsi | 4 + .../Completion/CompletionProvider.fs | 10 +- 5 files changed, 134 insertions(+), 55 deletions(-) diff --git a/src/Compiler/Checking/TypeRelations.fsi b/src/Compiler/Checking/TypeRelations.fsi index 1a9e2f11903..86cd4647cc7 100644 --- a/src/Compiler/Checking/TypeRelations.fsi +++ b/src/Compiler/Checking/TypeRelations.fsi @@ -82,4 +82,10 @@ val IteratedAdjustArityOfLambda: 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 +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 2b57fa99c98..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 @@ -647,7 +641,7 @@ type internal TypeCheckInfo 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 _GetUnionCasesAndActivePatternsEnvironmentLookupResolutionsAtPosition cursorPos = let resolutions = GetCapturedNameResolutions cursorPos ResolveOverloads.Yes if resolutions.Count = 1 then @@ -770,6 +764,7 @@ type internal TypeCheckInfo | _ -> CompletionItemKind.Other { ItemWithInst = item + MajorPriority = None MinorPriority = 0 Kind = kind IsOwnMember = false @@ -947,48 +942,116 @@ type internal TypeCheckInfo let GetMatchCompletionsAtPosition (identifierRange: range, parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, filterCtors, resolveOverloads) = - 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 -> + 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.Value vref -> vref.LiteralValue.IsSome + | 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) -> - tys |> List.exists (fun ty -> isUnionTy g ty || isEnumTy g ty) - | Item.ModuleOrNamespaces _ - | Item.ActivePatternCase _ - | Item.UnionCase _ - | Item.ExnCase _ -> true - | _ -> false), denv, m) + 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 @@ -1117,6 +1180,7 @@ type internal TypeCheckInfo |> List.map (fun item -> { ItemWithInst = item Kind = CompletionItemKind.Argument + MajorPriority = None MinorPriority = 0 IsOwnMember = false Type = None diff --git a/src/Compiler/Service/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs index 70f8cf3fb67..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 @@ -1092,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/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