From 7309b2d3e18f3a0a64e7f0f2da9d59f0bf246148 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Fri, 23 Dec 2016 17:12:29 +0300 Subject: [PATCH 01/11] add FSharpDeclarationListItem.IsAttribute try to handle attributes in a special way at attribute application point (wip) --- src/fsharp/vs/ServiceDeclarations.fs | 20 +++++-- src/fsharp/vs/ServiceDeclarations.fsi | 1 + .../Completion/CompletionProvider.fs | 54 +++++++++++-------- 3 files changed, 48 insertions(+), 27 deletions(-) diff --git a/src/fsharp/vs/ServiceDeclarations.fs b/src/fsharp/vs/ServiceDeclarations.fs index 4f6b4bc9091..795f2db9253 100644 --- a/src/fsharp/vs/ServiceDeclarations.fs +++ b/src/fsharp/vs/ServiceDeclarations.fs @@ -705,6 +705,15 @@ module internal ItemDescriptionsImpl = | _ -> GetXmlCommentForItemAux None infoReader m d + let IsAttribute (infoReader: InfoReader) d = + let g = infoReader.g + let amap = infoReader.amap + match d with + | Item.Types(_,((TType_app(tcref,_)):: _)) -> + let ty = generalizedTyconRef tcref + Infos.ExistsHeadTypeInEntireHierarchy g amap range0 ty g.tcref_System_Attribute + | _ -> false + /// Output a the description of a language item let rec FormatItemDescriptionToToolTipElement isDecl (infoReader:InfoReader) m denv d = let g = infoReader.g @@ -1168,7 +1177,6 @@ module internal ItemDescriptionsImpl = // Compute the index of the VS glyph shown with an item in the Intellisense menu let GlyphOfItem(denv,d) = - /// Find the glyph for the given representation. let reprToGlyph repr = match repr with @@ -1255,7 +1263,7 @@ module internal ItemDescriptionsImpl = /// An intellisense declaration [] -type FSharpDeclarationListItem(name, glyphMajor:GlyphMajor, glyphMinor:GlyphMinor, info) = +type FSharpDeclarationListItem(name, glyphMajor:GlyphMajor, glyphMinor:GlyphMinor, info, isAttributeType: bool) = let mutable descriptionTextHolder:FSharpToolTipText option = None let mutable task = null @@ -1303,6 +1311,7 @@ type FSharpDeclarationListItem(name, glyphMajor:GlyphMajor, glyphMinor:GlyphMino member decl.Glyph = 6 * int glyphMajor + int glyphMinor member decl.GlyphMajor = glyphMajor member decl.GlyphMinor = glyphMinor + member decl.IsAttributeType = isAttributeType /// A table of declarations for Intellisense completion [] @@ -1363,11 +1372,14 @@ type FSharpDeclarationListInfo(declarations: FSharpDeclarationListItem[]) = | [] -> failwith "Unexpected empty bag" | items -> let glyphMajor, glyphMinor = GlyphOfItem(denv,items.Head) - new FSharpDeclarationListItem(nm, glyphMajor, glyphMinor, Choice1Of2 (items, infoReader, m, denv, reactor, checkAlive))) + let isAttribute = IsAttribute infoReader items.Head + new FSharpDeclarationListItem(nm, glyphMajor, glyphMinor, Choice1Of2 (items, infoReader, m, denv, reactor, checkAlive), isAttribute)) new FSharpDeclarationListInfo(Array.ofList decls) - static member Error msg = new FSharpDeclarationListInfo([| new FSharpDeclarationListItem("", GlyphMajor.Error, GlyphMinor.Normal, Choice2Of2 (FSharpToolTipText [FSharpToolTipElement.CompositionError msg])) |] ) + static member Error msg = + new FSharpDeclarationListInfo( + [| new FSharpDeclarationListItem("", GlyphMajor.Error, GlyphMinor.Normal, Choice2Of2 (FSharpToolTipText [FSharpToolTipElement.CompositionError msg]), false) |] ) static member Empty = new FSharpDeclarationListInfo([| |]) diff --git a/src/fsharp/vs/ServiceDeclarations.fsi b/src/fsharp/vs/ServiceDeclarations.fsi index b1f6b156c21..42cc536f3e2 100755 --- a/src/fsharp/vs/ServiceDeclarations.fsi +++ b/src/fsharp/vs/ServiceDeclarations.fsi @@ -69,6 +69,7 @@ type internal FSharpDeclarationListItem = member Glyph : int member GlyphMajor : ItemDescriptionIcons.GlyphMajor member GlyphMinor : ItemDescriptionIcons.GlyphMinor + member IsAttributeType : bool [] /// Represents a set of declarations in F# source code, with information attached ready for display by an editor. diff --git a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs index 052321b4ae6..97a33ac87d9 100644 --- a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs +++ b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs @@ -92,29 +92,37 @@ type internal FSharpCompletionProvider static member ProvideCompletionsAsyncAux(checker: FSharpChecker, sourceText: SourceText, caretPosition: int, options: FSharpProjectOptions, filePath: string, textVersionHash: int) = async { let! parseResults, checkFileAnswer = checker.ParseAndCheckFileInProject(filePath, textVersionHash, sourceText.ToString(), options) - match checkFileAnswer with - | FSharpCheckFileAnswer.Aborted -> return List() - | FSharpCheckFileAnswer.Succeeded(checkFileResults) -> - - let textLines = sourceText.Lines - let caretLine = textLines.GetLineFromPosition(caretPosition) - let caretLinePos = textLines.GetLinePosition(caretPosition) - let fcsCaretLineNumber = Line.fromZ caretLinePos.Line // Roslyn line numbers are zero-based, FSharp.Compiler.Service line numbers are 1-based - let caretLineColumn = caretLinePos.Character - - let qualifyingNames, partialName = QuickParse.GetPartialLongNameEx(caretLine.ToString(), caretLineColumn - 1) - let! declarations = checkFileResults.GetDeclarationListInfo(Some(parseResults), fcsCaretLineNumber, caretLineColumn, caretLine.ToString(), qualifyingNames, partialName) - - let results = List() - - for declarationItem in declarations.Items do - let glyph = CommonRoslynHelpers.FSharpGlyphToRoslynGlyph declarationItem.GlyphMajor - let completionItem = CommonCompletionItem.Create(declarationItem.Name, glyph=Nullable(glyph)) - declarationItemsCache.Remove(completionItem.DisplayText) |> ignore // clear out stale entries if they exist - declarationItemsCache.Add(completionItem.DisplayText, declarationItem) - results.Add(completionItem) - - return results + match parseResults.ParseTree, checkFileAnswer with + | _, FSharpCheckFileAnswer.Aborted + | None, _ -> return List() + | Some(parsedInput), FSharpCheckFileAnswer.Succeeded(checkFileResults) -> + let textLines = sourceText.Lines + let caretLine = textLines.GetLineFromPosition(caretPosition) + let caretLinePos = textLines.GetLinePosition(caretPosition) + let fcsCaretLineNumber = Line.fromZ caretLinePos.Line // Roslyn line numbers are zero-based, FSharp.Compiler.Service line numbers are 1-based + let caretLineColumn = caretLinePos.Character + + let qualifyingNames, partialName = QuickParse.GetPartialLongNameEx(caretLine.ToString(), caretLineColumn - 1) + let! declarations = checkFileResults.GetDeclarationListInfo(Some(parseResults), fcsCaretLineNumber, caretLineColumn, caretLine.ToString(), qualifyingNames, partialName) + + let results = List() + + for declarationItem in declarations.Items do + let displayText = + if declarationItem.IsAttributeType then + let pos = Pos.fromZ caretLinePos.Line caretLinePos.Character + if ParsedInput.getEntityKind parsedInput pos = Some EntityKind.Attribute then + declarationItem.Name.[0..declarationItem.Name.Length - 10] + else declarationItem.Name + else declarationItem.Name + + let glyph = CommonRoslynHelpers.FSharpGlyphToRoslynGlyph declarationItem.GlyphMajor + let completionItem = CommonCompletionItem.Create(displayText, glyph=Nullable(glyph)) + declarationItemsCache.Remove(completionItem.DisplayText) |> ignore // clear out stale entries if they exist + declarationItemsCache.Add(completionItem.DisplayText, declarationItem) + results.Add(completionItem) + + return results } override this.ShouldTriggerCompletion(sourceText: SourceText, caretPosition: int, trigger: CompletionTrigger, _: OptionSet) = From 2bdbbae1ef08072aba4c840391725bc913e48c42 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Fri, 23 Dec 2016 22:07:51 +0300 Subject: [PATCH 02/11] almost works --- src/fsharp/vs/ServiceDeclarations.fs | 3 +- src/fsharp/vs/ServiceDeclarations.fsi | 2 +- src/fsharp/vs/ServiceParseTreeWalk.fs | 45 +++++++++++++----- src/fsharp/vs/ServiceUntypedParse.fs | 8 ++-- src/fsharp/vs/ServiceUntypedParse.fsi | 1 + src/fsharp/vs/service.fs | 47 ++++++++++++------- .../Completion/CompletionProvider.fs | 12 +---- 7 files changed, 75 insertions(+), 43 deletions(-) diff --git a/src/fsharp/vs/ServiceDeclarations.fs b/src/fsharp/vs/ServiceDeclarations.fs index 795f2db9253..083b147ead7 100644 --- a/src/fsharp/vs/ServiceDeclarations.fs +++ b/src/fsharp/vs/ServiceDeclarations.fs @@ -1320,7 +1320,7 @@ type FSharpDeclarationListInfo(declarations: FSharpDeclarationListItem[]) = member self.Items = declarations // Make a 'Declarations' object for a set of selected items - static member Create(infoReader:InfoReader, m, denv, items, reactor, checkAlive) = + static member Create(infoReader:InfoReader, m, denv, items, reactor, checkAlive, isAttributes) = let g = infoReader.g let items = items |> RemoveExplicitlySuppressed g @@ -1373,6 +1373,7 @@ type FSharpDeclarationListInfo(declarations: FSharpDeclarationListItem[]) = | items -> let glyphMajor, glyphMinor = GlyphOfItem(denv,items.Head) let isAttribute = IsAttribute infoReader items.Head + let nm = if isAttributes then nm.[0..nm.Length-10] else nm new FSharpDeclarationListItem(nm, glyphMajor, glyphMinor, Choice1Of2 (items, infoReader, m, denv, reactor, checkAlive), isAttribute)) new FSharpDeclarationListInfo(Array.ofList decls) diff --git a/src/fsharp/vs/ServiceDeclarations.fsi b/src/fsharp/vs/ServiceDeclarations.fsi index 42cc536f3e2..6417b917abd 100755 --- a/src/fsharp/vs/ServiceDeclarations.fsi +++ b/src/fsharp/vs/ServiceDeclarations.fsi @@ -80,7 +80,7 @@ type internal FSharpDeclarationListInfo = member Items : FSharpDeclarationListItem[] // Implementation details used by other code in the compiler - static member internal Create : infoReader:InfoReader * m:range * denv:DisplayEnv * items:Item list * reactor:IReactorOperations * checkAlive:(unit -> bool) -> FSharpDeclarationListInfo + static member internal Create : infoReader:InfoReader * m:range * denv:DisplayEnv * items:Item list * reactor:IReactorOperations * checkAlive:(unit -> bool) * isAttributes:bool -> FSharpDeclarationListInfo static member internal Error : message:string -> FSharpDeclarationListInfo static member Empty : FSharpDeclarationListInfo diff --git a/src/fsharp/vs/ServiceParseTreeWalk.fs b/src/fsharp/vs/ServiceParseTreeWalk.fs index 84c374f318e..ae237022189 100755 --- a/src/fsharp/vs/ServiceParseTreeWalk.fs +++ b/src/fsharp/vs/ServiceParseTreeWalk.fs @@ -74,6 +74,8 @@ module internal AstTraversal = // VisitRecordField allows overriding behavior when visiting l.h.s. of constructed record instances abstract VisitRecordField : TraversePath * SynExpr option * LongIdentWithDots option -> 'T option default this.VisitRecordField (_path, _copyOpt, _recordField) = None + abstract VisitAttribute : SynAttribute -> 'T option + default this.VisitAttribute (_synAttribute) = None let dive node range project = range,(fun() -> project node) @@ -142,14 +144,16 @@ module internal AstTraversal = | SynModuleDecl.Types(synTypeDefnList, _range) -> synTypeDefnList |> List.map (fun x -> dive x x.Range (traverseSynTypeDefn path)) |> pick decl | SynModuleDecl.Exception(_synExceptionDefn, _range) -> None | SynModuleDecl.Open(_longIdent, _range) -> None - | SynModuleDecl.Attributes(_synAttributes, _range) -> None + | SynModuleDecl.Attributes(synAttributes, _range) -> traverseAttributes synAttributes | SynModuleDecl.HashDirective(_parsedHashDirective, _range) -> None | SynModuleDecl.NamespaceFragment(synModuleOrNamespace) -> traverseSynModuleOrNamespace path synModuleOrNamespace visitor.VisitModuleDecl(defaultTraverse, decl) - and traverseSynModuleOrNamespace path (SynModuleOrNamespace(_longIdent, _isRec, _isModule, synModuleDecls, _preXmlDoc, _synAttributes, _synAccessOpt, range) as mors) = - let path = TraverseStep.ModuleOrNamespace mors :: path - synModuleDecls |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path)) |> pick range mors + and traverseSynModuleOrNamespace path (SynModuleOrNamespace(_longIdent, _isRec, _isModule, synModuleDecls, _preXmlDoc, attributes, _synAccessOpt, range) as mors) = + traverseAttributes attributes + |> Option.orElseWith (fun _ -> + let path = TraverseStep.ModuleOrNamespace mors :: path + synModuleDecls |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path)) |> pick range mors) and traverseSynExpr path (expr:SynExpr) = let pick = pick expr.Range let defaultTraverse e = @@ -453,6 +457,19 @@ module internal AstTraversal = #endif ) + and walkField (SynField.Field(attrs, _, _, _, _, _, _, _)) = traverseAttributes attrs + + and walkEnumCase (EnumCase(attrs, _, _, _, _)) = traverseAttributes attrs + + and walkUnionCaseType = function + | SynUnionCaseType.UnionCaseFields fields -> List.tryPick walkField fields + | SynUnionCaseType.UnionCaseFullType(_, _) -> None + + and walkUnionCase (UnionCase(attrs, _, t, _, _, _)) = + traverseAttributes attrs |> Option.orElse (walkUnionCaseType t) + + and traverseAttributes (attributes: SynAttributes) = attributes |> List.tryPick visitor.VisitAttribute + and traverseSynTypeDefn path (SynTypeDefn.TypeDefn(synComponentInfo, synTypeDefnRepr, synMemberDefns, tRange) as tydef) = let path = TraverseStep.TypeDefn tydef :: path [ @@ -470,8 +487,13 @@ module internal AstTraversal = match synTypeDefnSimpleRepr with | SynTypeDefnSimpleRepr.TypeAbbrev(_,synType,m) -> yield dive synTypeDefnRepr synTypeDefnRepr.Range (fun _ -> visitor.VisitTypeAbbrev(synType,m)) - | _ -> - () // enums/DUs/record definitions don't have any SynExprs inside them + | SynTypeDefnSimpleRepr.Enum (cases, r) -> yield r, fun _ -> List.tryPick walkEnumCase cases + | SynTypeDefnSimpleRepr.Union(_, cases, r) -> yield r, fun _ -> List.tryPick walkUnionCase cases + | SynTypeDefnSimpleRepr.Record(_, fields, r) -> yield r, fun _ -> List.tryPick walkField fields + | SynTypeDefnSimpleRepr.Exception (SynExceptionDefnRepr(attribs, unionCase, _, _, _, r)) -> + yield r, (fun _ -> traverseAttributes attribs |> Option.orElseWith (fun _ -> walkUnionCase unionCase)) + | _ -> () + yield! synMemberDefns |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None) ] |> pick tRange tydef @@ -481,7 +503,7 @@ module internal AstTraversal = match m with | SynMemberDefn.Open(_longIdent, _range) -> None | SynMemberDefn.Member(synBinding, _range) -> traverseSynBinding path synBinding - | SynMemberDefn.ImplicitCtor(_synAccessOption, _synAttributes, _synSimplePatList, _identOption, _range) -> None + | SynMemberDefn.ImplicitCtor(_synAccessOption, synAttributes, _synSimplePatList, _identOption, _range) -> traverseAttributes synAttributes | SynMemberDefn.ImplicitInherit(synType, synExpr, _identOption, range) -> [ dive () synType.Range (fun () -> @@ -492,7 +514,8 @@ module internal AstTraversal = visitor.VisitImplicitInherit(traverseSynExpr path, synType, synExpr, range) ) ] |> pick m - | SynMemberDefn.AutoProperty(_attribs, _isStatic, _id, _tyOpt, _propKind, _, _xmlDoc, _access, synExpr, _, _) -> traverseSynExpr path synExpr + | SynMemberDefn.AutoProperty(attribs, _isStatic, _id, _tyOpt, _propKind, _, _xmlDoc, _access, synExpr, _, _) -> + traverseSynExpr path synExpr |> Option.orElseWith (fun _ -> traverseAttributes attribs) | SynMemberDefn.LetBindings(synBindingList, _, _, _range) -> synBindingList |> List.map (fun x -> dive x x.RangeOfBindingAndRhs (traverseSynBinding path)) |> pick m | SynMemberDefn.AbstractSlot(_synValSig, _memberFlags, _range) -> None | SynMemberDefn.Interface(synType, synMemberDefnsOption, _range) -> @@ -503,7 +526,7 @@ module internal AstTraversal = | Some(x) -> [ yield! x |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None) ] |> pick x | ok -> ok | SynMemberDefn.Inherit(synType, _identOption, range) -> traverseInherit (synType, range) - | SynMemberDefn.ValField(_synField, _range) -> None + | SynMemberDefn.ValField(field, _range) -> walkField field | SynMemberDefn.NestedType(synTypeDefn, _synAccessOption, _range) -> traverseSynTypeDefn path synTypeDefn and traverseSynMatchClause path mc = @@ -522,8 +545,8 @@ module internal AstTraversal = let defaultTraverse b = let path = TraverseStep.Binding b :: path match b with - | (SynBinding.Binding(_synAccessOption, _synBindingKind, _, _, _synAttributes, _preXmlDoc, _synValData, _synPat, _synBindingReturnInfoOption, synExpr, _range, _sequencePointInfoForBinding)) -> - traverseSynExpr path synExpr + | (SynBinding.Binding(_synAccessOption, _synBindingKind, _, _, synAttributes, _preXmlDoc, _synValData, _synPat, _synBindingReturnInfoOption, synExpr, _range, _sequencePointInfoForBinding)) -> + traverseSynExpr path synExpr |> Option.orElseWith (fun _ -> traverseAttributes synAttributes) visitor.VisitBinding(defaultTraverse,b) match parseTree with diff --git a/src/fsharp/vs/ServiceUntypedParse.fs b/src/fsharp/vs/ServiceUntypedParse.fs index a6cd9b48622..31006f49bc6 100755 --- a/src/fsharp/vs/ServiceUntypedParse.fs +++ b/src/fsharp/vs/ServiceUntypedParse.fs @@ -72,6 +72,7 @@ type CompletionContext = // completing named parameters\setters in parameter list of constructor\method calls // end of name ast node * list of properties\parameters that were already set | ParameterList of pos * HashSet + | AttributeApplication //---------------------------------------------------------------------------- // FSharpParseFileResults @@ -861,6 +862,7 @@ module UntypedParseImpl = match parseLid lidwd with | Some (completionPath) -> GetCompletionContextForInheritSynMember (componentInfo, typeDefnKind, completionPath) | None -> Some (CompletionContext.Invalid) // A $ .B -> no completion list - | _ -> None } - AstTraversal.Traverse(pos, pt, walker) - + | _ -> None + + member this.VisitAttribute(_attr) = Some CompletionContext.AttributeApplication } + AstTraversal.Traverse(pos, pt, walker) \ No newline at end of file diff --git a/src/fsharp/vs/ServiceUntypedParse.fsi b/src/fsharp/vs/ServiceUntypedParse.fsi index 3133f6b5a22..bbd6110d6a1 100755 --- a/src/fsharp/vs/ServiceUntypedParse.fsi +++ b/src/fsharp/vs/ServiceUntypedParse.fsi @@ -74,6 +74,7 @@ type internal CompletionContext = // completing named parameters\setters in parameter list of constructor\method calls // end of name ast node * list of properties\parameters that were already set | ParameterList of pos * HashSet + | AttributeApplication // implementation details used by other code in the compiler module internal UntypedParseImpl = diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index 7bb1fbdff35..e50bdba88de 100755 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -1002,21 +1002,23 @@ type TypeCheckInfo | Some (CompletionContext.Inherit(InheritanceContext.Class, (plid, _))) -> GetEnvironmentLookupResolutions(mkPos line loc, plid, filterCtors, false) |> FilterRelevantItemsBy None GetBaseClassCandidates + |> Option.map (fun x -> x, false) // Completion at 'interface ..." | Some (CompletionContext.Inherit(InheritanceContext.Interface, (plid, _))) -> GetEnvironmentLookupResolutions(mkPos line loc, plid, filterCtors, false) |> FilterRelevantItemsBy None GetInterfaceCandidates + |> Option.map (fun x -> x, false) // Completion at 'implement ..." | Some (CompletionContext.Inherit(InheritanceContext.Unknown, (plid, _))) -> GetEnvironmentLookupResolutions(mkPos line loc, plid, filterCtors, false) |> FilterRelevantItemsBy None (fun t -> GetBaseClassCandidates t || GetInterfaceCandidates t) + |> Option.map (fun x -> x, false) // Completion at ' { XXX = ... } " | Some(CompletionContext.RecordField(RecordContext.New(plid, residue))) -> - GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, plid, residue) - |> Some + Some(GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, plid, residue), false) // Completion at ' { XXX = ... with ... } " | Some(CompletionContext.RecordField(RecordContext.CopyOnUpdate(r, (plid, residue)))) -> @@ -1025,11 +1027,11 @@ type TypeCheckInfo GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, plid, residue) |> Some | x -> x + |> Option.map (fun x -> x, false) // Completion at ' { XXX = ... with ... } " | Some(CompletionContext.RecordField(RecordContext.Constructor(typeName))) -> - GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, [typeName], None) - |> Some + Some(GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, [typeName], None), false) // Completion at ' SomeMethod( ... ) ' with named arguments | Some(CompletionContext.ParameterList (endPos, fields)) -> @@ -1048,12 +1050,23 @@ type TypeCheckInfo | None -> Some (items, denv, m) | Some (declItems, declaredDisplayEnv, declaredRange) -> Some (filtered @ declItems, declaredDisplayEnv, declaredRange) | _ -> declaredItems + |> Option.map (fun x -> x, false) + + | Some(CompletionContext.AttributeApplication) -> + let isAttribute = function + | Item.Types(_,((TType_app(tcref,_)):: _)) -> + let ty = generalizedTyconRef tcref + Infos.ExistsHeadTypeInEntireHierarchy infoReader.g infoReader.amap range0 ty infoReader.g.tcref_System_Attribute + | _ -> false + + GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, line, loc, filterCtors, resolveOverloads, hasTextChangedSinceLastTypecheck, false) + |> Option.map (fun (items, denv, r) -> (items |> List.filter isAttribute, denv, r), true) // Other completions | cc -> let isInRangeOperator = (match cc with Some (CompletionContext.RangeOperator) -> true | _ -> false) let declaredItems = GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, line, loc, filterCtors,resolveOverloads, hasTextChangedSinceLastTypecheck, isInRangeOperator) - declaredItems + declaredItems |> Option.map (fun x -> x, false) /// Return 'false' if this is not a completion item valid in an interface file. let IsValidSignatureFileItem item = @@ -1135,10 +1148,10 @@ type TypeCheckInfo (fun () -> match GetDeclItemsForNamesAtPosition(parseResultsOpt, Some qualifyingNames, Some partialName, line, lineStr, colAtEndOfNamesAndResidue, ResolveTypeNamesToCtors, ResolveOverloads.Yes, hasTextChangedSinceLastTypecheck) with | None -> FSharpDeclarationListInfo.Empty - | Some(items,denv,m) -> + | Some((items,denv,m), isAttributes) -> let items = items |> FilterAutoCompletesBasedOnParseContext parseResultsOpt (mkPos line colAtEndOfNamesAndResidue) let items = if isInterfaceFile then items |> List.filter IsValidSignatureFileItem else items - FSharpDeclarationListInfo.Create(infoReader,m,denv,items,reactorOps,checkAlive)) + FSharpDeclarationListInfo.Create(infoReader,m,denv,items,reactorOps,checkAlive,isAttributes)) (fun msg -> FSharpDeclarationListInfo.Error msg) /// Get the symbols for auto-complete items at a location @@ -1149,7 +1162,7 @@ type TypeCheckInfo (fun () -> match GetDeclItemsForNamesAtPosition(parseResultsOpt, Some qualifyingNames, Some partialName, line, lineStr, colAtEndOfNamesAndResidue, ResolveTypeNamesToCtors, ResolveOverloads.Yes, hasTextChangedSinceLastTypecheck) with | None -> List.Empty - | Some(items,_denv,_m) -> + | Some((items,_denv,_m),_) -> let items = items |> FilterAutoCompletesBasedOnParseContext parseResultsOpt (mkPos line colAtEndOfNamesAndResidue) let items = if isInterfaceFile then items |> List.filter IsValidSignatureFileItem else items @@ -1251,7 +1264,7 @@ type TypeCheckInfo (fun () -> match GetDeclItemsForNamesAtPosition(None,Some(names),None,line,lineStr,colAtEndOfNames,ResolveTypeNamesToCtors,ResolveOverloads.Yes,fun _ -> false) with | None -> FSharpToolTipText [] - | Some(items,denv,m) -> + | Some((items,denv,m),_) -> FSharpToolTipText(items |> List.map (FormatDescriptionOfItem false infoReader m denv ))) (fun err -> FSharpToolTipText [FSharpToolTipElement.CompositionError err]) @@ -1270,7 +1283,7 @@ type TypeCheckInfo (fun () -> match GetDeclItemsForNamesAtPosition(None, Some names, None, line, lineStr, colAtEndOfNames, ResolveTypeNamesToCtors, ResolveOverloads.No, fun _ -> false) with // F1 Keywords do not distiguish between overloads | None -> None - | Some(items,_,_) -> + | Some((items,_,_),_) -> match items with | [] -> None | [item] -> @@ -1301,14 +1314,14 @@ type TypeCheckInfo (fun () -> match GetDeclItemsForNamesAtPosition(None,namesOpt,None,line,lineStr,colAtEndOfNames,ResolveTypeNamesToCtors,ResolveOverloads.No, fun _ -> false) with | None -> FSharpMethodGroup("",[| |]) - | Some(items,denv,m) -> FSharpMethodGroup.Create(infoReader,m,denv,items)) + | Some((items,denv,m),_) -> FSharpMethodGroup.Create(infoReader,m,denv,items)) (fun msg -> FSharpMethodGroup(msg,[| |])) member scope.GetMethodsAsSymbols (line, lineStr, colAtEndOfNames, names) = match GetDeclItemsForNamesAtPosition (None,Some(names), None, line, lineStr, colAtEndOfNames, ResolveTypeNamesToCtors, ResolveOverloads.No, fun _ -> false) with - | None | Some ([], _, _) -> None - | Some (items, denv, m) -> + | None | Some (([], _, _), _) -> None + | Some ((items, denv, m),_) -> let allItems = items |> List.collect (fun item -> @@ -1341,8 +1354,8 @@ type TypeCheckInfo member scope.GetDeclarationLocation (line, lineStr, colAtEndOfNames, names, preferFlag) = match GetDeclItemsForNamesAtPosition (None,Some(names), None, line, lineStr, colAtEndOfNames, ResolveTypeNamesToCtors,ResolveOverloads.Yes, fun _ -> false) with | None - | Some ([], _, _) -> FSharpFindDeclResult.DeclNotFound FSharpFindDeclFailureReason.Unknown - | Some (item :: _ , _, _) -> + | Some (([], _, _), _) -> FSharpFindDeclResult.DeclNotFound FSharpFindDeclFailureReason.Unknown + | Some ((item :: _ , _, _), _) -> // For IL-based entities, switch to a different item. This is because // rangeOfItem, ccuOfItem don't work on IL methods or fields. @@ -1382,8 +1395,8 @@ type TypeCheckInfo member scope.GetSymbolUseAtLocation (line, lineStr, colAtEndOfNames, names) = match GetDeclItemsForNamesAtPosition (None,Some(names), None, line, lineStr, colAtEndOfNames, ResolveTypeNamesToCtors, ResolveOverloads.Yes, fun _ -> false) with - | None | Some ([], _, _) -> None - | Some (item :: _ , denv, m) -> + | None | Some (([], _, _), _) -> None + | Some ((item :: _ , denv, m), _) -> let symbol = FSharpSymbol.Create(g, thisCcu, tcImports, item) Some (symbol, denv, m) diff --git a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs index 97a33ac87d9..c0bcab58fd9 100644 --- a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs +++ b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs @@ -95,7 +95,7 @@ type internal FSharpCompletionProvider match parseResults.ParseTree, checkFileAnswer with | _, FSharpCheckFileAnswer.Aborted | None, _ -> return List() - | Some(parsedInput), FSharpCheckFileAnswer.Succeeded(checkFileResults) -> + | Some(_), FSharpCheckFileAnswer.Succeeded(checkFileResults) -> let textLines = sourceText.Lines let caretLine = textLines.GetLineFromPosition(caretPosition) let caretLinePos = textLines.GetLinePosition(caretPosition) @@ -108,16 +108,8 @@ type internal FSharpCompletionProvider let results = List() for declarationItem in declarations.Items do - let displayText = - if declarationItem.IsAttributeType then - let pos = Pos.fromZ caretLinePos.Line caretLinePos.Character - if ParsedInput.getEntityKind parsedInput pos = Some EntityKind.Attribute then - declarationItem.Name.[0..declarationItem.Name.Length - 10] - else declarationItem.Name - else declarationItem.Name - let glyph = CommonRoslynHelpers.FSharpGlyphToRoslynGlyph declarationItem.GlyphMajor - let completionItem = CommonCompletionItem.Create(displayText, glyph=Nullable(glyph)) + let completionItem = CommonCompletionItem.Create(declarationItem.Name, glyph=Nullable(glyph)) declarationItemsCache.Remove(completionItem.DisplayText) |> ignore // clear out stale entries if they exist declarationItemsCache.Add(completionItem.DisplayText, declarationItem) results.Add(completionItem) From 511875c6d30b471432e72057d724db1bf023ab4e Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Fri, 23 Dec 2016 23:25:05 +0300 Subject: [PATCH 03/11] suggest all types, modules and namespaces at attribute application position --- src/fsharp/vs/ServiceDeclarations.fs | 14 ++++++-------- src/fsharp/vs/ServiceDeclarations.fsi | 1 - src/fsharp/vs/ServiceUntypedParse.fs | 5 ++++- src/fsharp/vs/ServiceUntypedParse.fsi | 2 +- src/fsharp/vs/service.fs | 17 ++++++++--------- 5 files changed, 19 insertions(+), 20 deletions(-) diff --git a/src/fsharp/vs/ServiceDeclarations.fs b/src/fsharp/vs/ServiceDeclarations.fs index 083b147ead7..c41898336fd 100644 --- a/src/fsharp/vs/ServiceDeclarations.fs +++ b/src/fsharp/vs/ServiceDeclarations.fs @@ -1263,7 +1263,7 @@ module internal ItemDescriptionsImpl = /// An intellisense declaration [] -type FSharpDeclarationListItem(name, glyphMajor:GlyphMajor, glyphMinor:GlyphMinor, info, isAttributeType: bool) = +type FSharpDeclarationListItem(name, glyphMajor:GlyphMajor, glyphMinor:GlyphMinor, info) = let mutable descriptionTextHolder:FSharpToolTipText option = None let mutable task = null @@ -1310,8 +1310,7 @@ type FSharpDeclarationListItem(name, glyphMajor:GlyphMajor, glyphMinor:GlyphMino member decl.Glyph = 6 * int glyphMajor + int glyphMinor member decl.GlyphMajor = glyphMajor - member decl.GlyphMinor = glyphMinor - member decl.IsAttributeType = isAttributeType + member decl.GlyphMinor = glyphMinor /// A table of declarations for Intellisense completion [] @@ -1320,7 +1319,7 @@ type FSharpDeclarationListInfo(declarations: FSharpDeclarationListItem[]) = member self.Items = declarations // Make a 'Declarations' object for a set of selected items - static member Create(infoReader:InfoReader, m, denv, items, reactor, checkAlive, isAttributes) = + static member Create(infoReader:InfoReader, m, denv, items, reactor, checkAlive, atAttributeApplication) = let g = infoReader.g let items = items |> RemoveExplicitlySuppressed g @@ -1372,15 +1371,14 @@ type FSharpDeclarationListInfo(declarations: FSharpDeclarationListItem[]) = | [] -> failwith "Unexpected empty bag" | items -> let glyphMajor, glyphMinor = GlyphOfItem(denv,items.Head) - let isAttribute = IsAttribute infoReader items.Head - let nm = if isAttributes then nm.[0..nm.Length-10] else nm - new FSharpDeclarationListItem(nm, glyphMajor, glyphMinor, Choice1Of2 (items, infoReader, m, denv, reactor, checkAlive), isAttribute)) + let nm = if atAttributeApplication && IsAttribute infoReader items.Head then nm.[0..nm.Length-10] else nm + new FSharpDeclarationListItem(nm, glyphMajor, glyphMinor, Choice1Of2 (items, infoReader, m, denv, reactor, checkAlive))) new FSharpDeclarationListInfo(Array.ofList decls) static member Error msg = new FSharpDeclarationListInfo( - [| new FSharpDeclarationListItem("", GlyphMajor.Error, GlyphMinor.Normal, Choice2Of2 (FSharpToolTipText [FSharpToolTipElement.CompositionError msg]), false) |] ) + [| new FSharpDeclarationListItem("", GlyphMajor.Error, GlyphMinor.Normal, Choice2Of2 (FSharpToolTipText [FSharpToolTipElement.CompositionError msg])) |] ) static member Empty = new FSharpDeclarationListInfo([| |]) diff --git a/src/fsharp/vs/ServiceDeclarations.fsi b/src/fsharp/vs/ServiceDeclarations.fsi index 6417b917abd..de940dd2e47 100755 --- a/src/fsharp/vs/ServiceDeclarations.fsi +++ b/src/fsharp/vs/ServiceDeclarations.fsi @@ -69,7 +69,6 @@ type internal FSharpDeclarationListItem = member Glyph : int member GlyphMajor : ItemDescriptionIcons.GlyphMajor member GlyphMinor : ItemDescriptionIcons.GlyphMinor - member IsAttributeType : bool [] /// Represents a set of declarations in F# source code, with information attached ready for display by an editor. diff --git a/src/fsharp/vs/ServiceUntypedParse.fs b/src/fsharp/vs/ServiceUntypedParse.fs index 31006f49bc6..9bf7e02b567 100755 --- a/src/fsharp/vs/ServiceUntypedParse.fs +++ b/src/fsharp/vs/ServiceUntypedParse.fs @@ -864,5 +864,8 @@ module UntypedParseImpl = | None -> Some (CompletionContext.Invalid) // A $ .B -> no completion list | _ -> None - member this.VisitAttribute(_attr) = Some CompletionContext.AttributeApplication } + member this.VisitAttribute(attr) = + if rangeContainsPos attr.TypeName.Range pos then + Some CompletionContext.AttributeApplication + else None } AstTraversal.Traverse(pos, pt, walker) \ No newline at end of file diff --git a/src/fsharp/vs/ServiceUntypedParse.fsi b/src/fsharp/vs/ServiceUntypedParse.fsi index bbd6110d6a1..864d8109db1 100755 --- a/src/fsharp/vs/ServiceUntypedParse.fsi +++ b/src/fsharp/vs/ServiceUntypedParse.fsi @@ -9,6 +9,7 @@ namespace Microsoft.FSharp.Compiler.SourceCodeServices open System.Collections.Generic open Microsoft.FSharp.Compiler +open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.ErrorLogger @@ -78,7 +79,6 @@ type internal CompletionContext = // implementation details used by other code in the compiler module internal UntypedParseImpl = - open Microsoft.FSharp.Compiler.Ast val TryFindExpressionASTLeftOfDotLeftOfCursor : pos * ParsedInput option -> (pos * bool) option val GetRangeOfExprLeftOfDot : pos * ParsedInput option -> range option val TryFindExpressionIslandInPosition : pos * ParsedInput option -> string option diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index e50bdba88de..489b569eb94 100755 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -1053,14 +1053,13 @@ type TypeCheckInfo |> Option.map (fun x -> x, false) | Some(CompletionContext.AttributeApplication) -> - let isAttribute = function - | Item.Types(_,((TType_app(tcref,_)):: _)) -> - let ty = generalizedTyconRef tcref - Infos.ExistsHeadTypeInEntireHierarchy infoReader.g infoReader.amap range0 ty infoReader.g.tcref_System_Attribute - | _ -> false - GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, line, loc, filterCtors, resolveOverloads, hasTextChangedSinceLastTypecheck, false) - |> Option.map (fun (items, denv, r) -> (items |> List.filter isAttribute, denv, r), true) + |> Option.map (fun (items, denv, r) -> + (items + |> List.filter (function + | Item.Types _ + | Item.ModuleOrNamespaces _ -> true + | _ -> false), denv, r), true) // Other completions | cc -> @@ -1148,10 +1147,10 @@ type TypeCheckInfo (fun () -> match GetDeclItemsForNamesAtPosition(parseResultsOpt, Some qualifyingNames, Some partialName, line, lineStr, colAtEndOfNamesAndResidue, ResolveTypeNamesToCtors, ResolveOverloads.Yes, hasTextChangedSinceLastTypecheck) with | None -> FSharpDeclarationListInfo.Empty - | Some((items,denv,m), isAttributes) -> + | Some((items,denv,m), atAttributeApplication) -> let items = items |> FilterAutoCompletesBasedOnParseContext parseResultsOpt (mkPos line colAtEndOfNamesAndResidue) let items = if isInterfaceFile then items |> List.filter IsValidSignatureFileItem else items - FSharpDeclarationListInfo.Create(infoReader,m,denv,items,reactorOps,checkAlive,isAttributes)) + FSharpDeclarationListInfo.Create(infoReader,m,denv,items,reactorOps,checkAlive,atAttributeApplication)) (fun msg -> FSharpDeclarationListInfo.Error msg) /// Get the symbols for auto-complete items at a location From fbdb9279cbd12488e1baf66cbc90a41c3650564d Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sat, 24 Dec 2016 12:59:49 +0300 Subject: [PATCH 04/11] fix Context.AttributeApplication detection --- src/fsharp/ast.fs | 10 +- src/fsharp/vs/ServiceDeclarations.fs | 5 +- src/fsharp/vs/ServiceParseTreeWalk.fs | 196 +++++++++++++++++--------- src/fsharp/vs/ServiceUntypedParse.fs | 2 + 4 files changed, 138 insertions(+), 75 deletions(-) diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index f285d511183..6d6e2b7a255 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -1063,12 +1063,12 @@ and SynBindingKind * mustInline:bool * isMutable:bool * - SynAttributes * + attrs:SynAttributes * xmlDoc:PreXmlDoc * SynValData * headPat:SynPat * SynBindingReturnInfo option * - SynExpr * + expr:SynExpr * range:range * SequencePointInfoForBinding // no member just named "Range", as that would be confusing: @@ -1178,7 +1178,7 @@ and [] SynEnumCase = /// The untyped, unchecked syntax tree for one case in an enum definition. - | EnumCase of SynAttributes * ident:Ident * SynConst * PreXmlDoc * range:range + | EnumCase of attrs:SynAttributes * ident:Ident * SynConst * PreXmlDoc * range:range member this.Range = match this with | EnumCase (range=m) -> m @@ -1234,7 +1234,7 @@ and [] /// The untyped, unchecked syntax tree for a field declaration in a record or class SynField = - | Field of SynAttributes * isStatic:bool * Ident option * SynType * bool * xmlDoc:PreXmlDoc * accessibility:SynAccess option * range:range + | Field of attrs:SynAttributes * isStatic:bool * Ident option * SynType * bool * xmlDoc:PreXmlDoc * accessibility:SynAccess option * range:range and @@ -1344,7 +1344,7 @@ and | Inherit of SynType * Ident option * range:range | ValField of SynField * range:range /// A feature that is not implemented - | NestedType of SynTypeDefn * accessibility:SynAccess option * range:range + | NestedType of typeDefn:SynTypeDefn * accessibility:SynAccess option * range:range /// SynMemberDefn.AutoProperty (attribs,isStatic,id,tyOpt,propKind,memberFlags,xmlDoc,access,synExpr,mGetSet,mWholeAutoProp). /// /// F# syntax: 'member val X = expr' diff --git a/src/fsharp/vs/ServiceDeclarations.fs b/src/fsharp/vs/ServiceDeclarations.fs index c41898336fd..fdf50868e58 100644 --- a/src/fsharp/vs/ServiceDeclarations.fs +++ b/src/fsharp/vs/ServiceDeclarations.fs @@ -1315,13 +1315,13 @@ type FSharpDeclarationListItem(name, glyphMajor:GlyphMajor, glyphMinor:GlyphMino /// A table of declarations for Intellisense completion [] type FSharpDeclarationListInfo(declarations: FSharpDeclarationListItem[]) = + static let attributeSuffixLength = "Attribute".Length member self.Items = declarations // Make a 'Declarations' object for a set of selected items static member Create(infoReader:InfoReader, m, denv, items, reactor, checkAlive, atAttributeApplication) = let g = infoReader.g - let items = items |> RemoveExplicitlySuppressed g // Sort by name. For things with the same name, @@ -1371,7 +1371,8 @@ type FSharpDeclarationListInfo(declarations: FSharpDeclarationListItem[]) = | [] -> failwith "Unexpected empty bag" | items -> let glyphMajor, glyphMinor = GlyphOfItem(denv,items.Head) - let nm = if atAttributeApplication && IsAttribute infoReader items.Head then nm.[0..nm.Length-10] else nm + // If we at an attribute application position and the completion item is an attribute, remove "Attribute" suffix from its name. + let nm = if atAttributeApplication && IsAttribute infoReader items.Head then nm.[0..nm.Length-attributeSuffixLength-1] else nm new FSharpDeclarationListItem(nm, glyphMajor, glyphMinor, Choice1Of2 (items, infoReader, m, denv, reactor, checkAlive))) new FSharpDeclarationListInfo(Array.ofList decls) diff --git a/src/fsharp/vs/ServiceParseTreeWalk.fs b/src/fsharp/vs/ServiceParseTreeWalk.fs index ae237022189..15fbea70b79 100755 --- a/src/fsharp/vs/ServiceParseTreeWalk.fs +++ b/src/fsharp/vs/ServiceParseTreeWalk.fs @@ -10,7 +10,6 @@ namespace Microsoft.FSharp.Compiler.SourceCodeServices open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.Ast - /// A range of utility functions to assist with traversing an AST module internal AstTraversal = @@ -38,6 +37,7 @@ module internal AstTraversal = | MemberDefn of SynMemberDefn | MatchClause of SynMatchClause | Binding of SynBinding + | Pat of SynPat type TraversePath = TraverseStep list @@ -128,6 +128,10 @@ module internal AstTraversal = None #endif + let (|ConstructorPats|) = function + | SynConstructorArgs.Pats ps -> ps + | SynConstructorArgs.NamePatPairs(xs, _) -> List.map snd xs + /// traverse an implementation file walking all the way down to SynExpr or TypeAbbrev at a particular location /// let (*internal*) Traverse(pos:pos, parseTree, visitor:AstVisitorBase<'T>) = @@ -154,6 +158,41 @@ module internal AstTraversal = |> Option.orElseWith (fun _ -> let path = TraverseStep.ModuleOrNamespace mors :: path synModuleDecls |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path)) |> pick range mors) + + and traverseTyparDecl (SynTyparDecl.TyparDecl (attrs, _typar)) = traverseAttributes attrs + + and traverseSynPat path (synPat: SynPat) = + let path = TraverseStep.Pat synPat :: path + match synPat with + | SynPat.Tuple (pats, _) + | SynPat.ArrayOrList (_, pats, _) + | SynPat.Ands (pats, _) -> List.tryPick (traverseSynPat path) pats + | SynPat.Named (pat, _, _, _, _) -> traverseSynPat path pat + | SynPat.Typed (pat, _, _) -> traverseSynPat path pat + | SynPat.Attrib (pat, attrs, _) -> + traverseSynPat path pat |> Option.orElseWith (fun _ -> traverseAttributes attrs) + | SynPat.Or (pat1, pat2, _) -> List.tryPick (traverseSynPat path) [pat1; pat2] + | SynPat.LongIdent (_, _, typars, ConstructorPats pats, _, _) -> + typars + |> Option.bind (fun (SynValTyparDecls (typars, _, _)) -> + typars |> List.tryPick traverseTyparDecl) + |> Option.orElseWith (fun _ -> List.tryPick (traverseSynPat path) pats) + | SynPat.Paren (pat, _) -> traverseSynPat path pat + | SynPat.QuoteExpr(e, _) -> traverseSynExpr path e + | _ -> None + + and traverseSimplePat = function + | SynSimplePat.Attrib (pat, attrs, _) -> + traverseSimplePat pat + |> Option.orElseWith (fun _ -> traverseAttributes attrs) + | SynSimplePat.Typed(pat, _, _) -> + traverseSimplePat pat + | _ -> None + + and traverseSimplePats = function + | SynSimplePats.SimplePats (pats, _) -> List.tryPick traverseSimplePat pats + | SynSimplePats.Typed (pats, _, _) -> traverseSimplePats pats + and traverseSynExpr path (expr:SynExpr) = let pick = pick expr.Range let defaultTraverse e = @@ -289,10 +328,11 @@ module internal AstTraversal = dive synExpr2 synExpr2.Range traverseSynExpr dive synExpr3 synExpr3.Range traverseSynExpr] |> pick expr - | SynExpr.ForEach(_sequencePointInfoForForLoop, _seqExprOnly, _isFromSource, _synPat, synExpr, synExpr2, _range) -> + | SynExpr.ForEach(_sequencePointInfoForForLoop, _seqExprOnly, _isFromSource, synPat, synExpr, synExpr2, _range) -> [dive synExpr synExpr.Range traverseSynExpr dive synExpr2 synExpr2.Range traverseSynExpr] |> pick expr + |> Option.orElseWith (fun _ -> traverseSynPat path synPat) | SynExpr.ArrayOrListOfSeqExpr(_, synExpr, _range) -> traverseSynExpr synExpr | SynExpr.CompExpr(_, _, synExpr, _range) -> // now parser treats this syntactic expression as computation expression @@ -311,7 +351,9 @@ module internal AstTraversal = if ok.IsSome then ok else traverseSynExpr synExpr - | SynExpr.Lambda(_, _, _synSimplePats, synExpr, _range) -> traverseSynExpr synExpr + | SynExpr.Lambda(_, _, synSimplePats, synExpr, _range) -> + traverseSynExpr synExpr + |> Option.orElseWith (fun _ -> traverseSimplePats synSimplePats) | SynExpr.MatchLambda(_isExnMatch,_argm,synMatchClauseList,_spBind,_wholem) -> synMatchClauseList |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) @@ -402,10 +444,11 @@ module internal AstTraversal = | SynExpr.ImplicitZero(_range) -> None | SynExpr.YieldOrReturn(_, synExpr, _range) -> traverseSynExpr synExpr | SynExpr.YieldOrReturnFrom(_, synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.LetOrUseBang(_sequencePointInfoForBinding, _, _, _synPat, synExpr, synExpr2, _range) -> + | SynExpr.LetOrUseBang(_sequencePointInfoForBinding, _, _, synPat, synExpr, synExpr2, _range) -> [dive synExpr synExpr.Range traverseSynExpr dive synExpr2 synExpr2.Range traverseSynExpr] |> pick expr + |> Option.orElseWith (fun _ -> traverseSynPat path synPat) | SynExpr.DoBang(synExpr, _range) -> traverseSynExpr synExpr | SynExpr.LibraryOnlyILAssembly _ -> None | SynExpr.LibraryOnlyStaticOptimization _ -> None @@ -419,59 +462,59 @@ module internal AstTraversal = and normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path traverseInherit (synMemberDefns:SynMemberDefns) = synMemberDefns - // property getters are setters are two members that can have the same range, so do some somersaults to deal with this - |> Seq.groupBy (fun x -> x.Range) - |> Seq.choose (fun (r, mems) -> - match mems |> Seq.toList with - | [mem] -> // the typical case, a single member has this range 'r' - Some (dive mem r (traverseSynMemberDefn path traverseInherit)) - | [SynMemberDefn.Member(Binding(_,_,_,_,_,_,_,SynPat.LongIdent(lid1,Some(info1),_,_,_,_),_,_,_,_),_) as mem1 - SynMemberDefn.Member(Binding(_,_,_,_,_,_,_,SynPat.LongIdent(lid2,Some(info2),_,_,_,_),_,_,_,_),_) as mem2] -> // can happen if one is a getter and one is a setter - // ensure same long id - assert( (lid1.Lid,lid2.Lid) ||> List.forall2 (fun x y -> x.idText = y.idText) ) - // ensure one is getter, other is setter - assert( (info1.idText="set" && info2.idText="get") || - (info2.idText="set" && info1.idText="get") ) - Some ( - r,(fun() -> - // both mem1 and mem2 have same range, would violate dive-and-pick assertions, so just try the first one, else try the second one: - match traverseSynMemberDefn path (fun _ -> None) mem1 with - | Some _ as x -> x - | _ -> traverseSynMemberDefn path (fun _ -> None) mem2 ) - ) - | [] -> + // property getters are setters are two members that can have the same range, so do some somersaults to deal with this + |> Seq.groupBy getSynMemberRangeWithAttributes + |> Seq.choose (fun (range, mems) -> + match mems |> Seq.toList with + | [mem] -> // the typical case, a single member has this range 'range' + Some (dive mem range (traverseSynMemberDefn path traverseInherit)) + | [SynMemberDefn.Member(memberDefn=Binding(headPat=SynPat.LongIdent(lid1,Some(info1),_,_,_,_))) as mem1 + SynMemberDefn.Member(memberDefn=Binding(headPat=SynPat.LongIdent(lid2,Some(info2),_,_,_,_))) as mem2] -> // can happen if one is a getter and one is a setter + // ensure same long id + assert((lid1.Lid,lid2.Lid) ||> List.forall2 (fun x y -> x.idText = y.idText)) + // ensure one is getter, other is setter + assert((info1.idText="set" && info2.idText="get") || (info2.idText="set" && info1.idText="get")) + Some( + range, (fun() -> + // both mem1 and mem2 have same range, would violate dive-and-pick assertions, so just try the first one, else try the second one: + match traverseSynMemberDefn path (fun _ -> None) mem1 with + | Some _ as x -> x + | _ -> traverseSynMemberDefn path (fun _ -> None) mem2 ) + ) + | [] -> #if DEBUG - assert(false) - failwith "impossible, Seq.groupBy never returns empty results" + assert(false) + failwith "impossible, Seq.groupBy never returns empty results" #else - // swallow AST error and recover silently - None + // swallow AST error and recover silently + None #endif - | _ -> + | _ -> #if DEBUG - assert(false) // more than 2 members claim to have the same range, this indicates a bug in the AST - failwith "bug in AST" + assert(false) // more than 2 members claim to have the same range, this indicates a bug in the AST + failwith "bug in AST" #else - // swallow AST error and recover silently - None + // swallow AST error and recover silently + None #endif - ) + ) - and walkField (SynField.Field(attrs, _, _, _, _, _, _, _)) = traverseAttributes attrs + and traverseField (SynField.Field(attrs=attrs)) = traverseAttributes attrs - and walkEnumCase (EnumCase(attrs, _, _, _, _)) = traverseAttributes attrs + and traverseEnumCase (EnumCase(attrs=attrs)) = traverseAttributes attrs - and walkUnionCaseType = function - | SynUnionCaseType.UnionCaseFields fields -> List.tryPick walkField fields - | SynUnionCaseType.UnionCaseFullType(_, _) -> None + and traverseUnionCaseType = function + | SynUnionCaseType.UnionCaseFields fields -> List.tryPick traverseField fields + | SynUnionCaseType.UnionCaseFullType _ -> None - and walkUnionCase (UnionCase(attrs, _, t, _, _, _)) = - traverseAttributes attrs |> Option.orElse (walkUnionCaseType t) + and traverseUnionCase (UnionCase(attrs, _, t, _, _, _)) = + traverseAttributes attrs |> Option.orElse (traverseUnionCaseType t) - and traverseAttributes (attributes: SynAttributes) = attributes |> List.tryPick visitor.VisitAttribute + and traverseAttributes (attributes: SynAttributes) : 'T option = attributes |> List.tryPick visitor.VisitAttribute and traverseSynTypeDefn path (SynTypeDefn.TypeDefn(synComponentInfo, synTypeDefnRepr, synMemberDefns, tRange) as tydef) = let path = TraverseStep.TypeDefn tydef :: path + let (SynComponentInfo.ComponentInfo(attribs = attribs)) = synComponentInfo [ match synTypeDefnRepr with | SynTypeDefnRepr.Exception _ -> @@ -487,24 +530,26 @@ module internal AstTraversal = match synTypeDefnSimpleRepr with | SynTypeDefnSimpleRepr.TypeAbbrev(_,synType,m) -> yield dive synTypeDefnRepr synTypeDefnRepr.Range (fun _ -> visitor.VisitTypeAbbrev(synType,m)) - | SynTypeDefnSimpleRepr.Enum (cases, r) -> yield r, fun _ -> List.tryPick walkEnumCase cases - | SynTypeDefnSimpleRepr.Union(_, cases, r) -> yield r, fun _ -> List.tryPick walkUnionCase cases - | SynTypeDefnSimpleRepr.Record(_, fields, r) -> yield r, fun _ -> List.tryPick walkField fields + | SynTypeDefnSimpleRepr.Enum (cases, r) -> yield r, fun _ -> List.tryPick traverseEnumCase cases + | SynTypeDefnSimpleRepr.Union(_, cases, r) -> yield r, fun _ -> List.tryPick traverseUnionCase cases + | SynTypeDefnSimpleRepr.Record(_, fields, r) -> yield r, fun _ -> List.tryPick traverseField fields | SynTypeDefnSimpleRepr.Exception (SynExceptionDefnRepr(attribs, unionCase, _, _, _, r)) -> - yield r, (fun _ -> traverseAttributes attribs |> Option.orElseWith (fun _ -> walkUnionCase unionCase)) + yield r, (fun _ -> traverseAttributes attribs |> Option.orElseWith (fun _ -> traverseUnionCase unionCase)) | _ -> () yield! synMemberDefns |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None) - ] |> pick tRange tydef + ] + |> pick tRange tydef + |> Option.orElseWith (fun _ -> traverseAttributes attribs) and traverseSynMemberDefn path traverseInherit (m:SynMemberDefn) = let pick (debugObj:obj) = pick m.Range debugObj let path = TraverseStep.MemberDefn m :: path match m with - | SynMemberDefn.Open(_longIdent, _range) -> None - | SynMemberDefn.Member(synBinding, _range) -> traverseSynBinding path synBinding - | SynMemberDefn.ImplicitCtor(_synAccessOption, synAttributes, _synSimplePatList, _identOption, _range) -> traverseAttributes synAttributes - | SynMemberDefn.ImplicitInherit(synType, synExpr, _identOption, range) -> + | SynMemberDefn.Open _ -> None + | SynMemberDefn.Member(synBinding, _) -> traverseSynBinding path synBinding + | SynMemberDefn.ImplicitCtor(attributes=attributes) -> traverseAttributes attributes + | SynMemberDefn.ImplicitInherit(synType, synExpr, _, range) -> [ dive () synType.Range (fun () -> match traverseInherit (synType, range) with @@ -514,39 +559,54 @@ module internal AstTraversal = visitor.VisitImplicitInherit(traverseSynExpr path, synType, synExpr, range) ) ] |> pick m - | SynMemberDefn.AutoProperty(attribs, _isStatic, _id, _tyOpt, _propKind, _, _xmlDoc, _access, synExpr, _, _) -> + | SynMemberDefn.AutoProperty(attribs=attribs; synExpr=synExpr) -> traverseSynExpr path synExpr |> Option.orElseWith (fun _ -> traverseAttributes attribs) - | SynMemberDefn.LetBindings(synBindingList, _, _, _range) -> synBindingList |> List.map (fun x -> dive x x.RangeOfBindingAndRhs (traverseSynBinding path)) |> pick m - | SynMemberDefn.AbstractSlot(_synValSig, _memberFlags, _range) -> None - | SynMemberDefn.Interface(synType, synMemberDefnsOption, _range) -> + | SynMemberDefn.LetBindings(synBindingList, _, _, _) -> + synBindingList |> List.map (fun x -> dive x x.RangeOfBindingAndRhs (traverseSynBinding path)) |> pick m + | SynMemberDefn.AbstractSlot _ -> None + | SynMemberDefn.Interface(synType, synMemberDefnsOption, _) -> match visitor.VisitInterfaceSynMemberDefnType(synType) with | None -> match synMemberDefnsOption with | None -> None | Some(x) -> [ yield! x |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None) ] |> pick x | ok -> ok - | SynMemberDefn.Inherit(synType, _identOption, range) -> traverseInherit (synType, range) - | SynMemberDefn.ValField(field, _range) -> walkField field - | SynMemberDefn.NestedType(synTypeDefn, _synAccessOption, _range) -> traverseSynTypeDefn path synTypeDefn + | SynMemberDefn.Inherit(synType, _, range) -> traverseInherit (synType, range) + | SynMemberDefn.ValField(field, _) -> traverseField field + | SynMemberDefn.NestedType(typeDefn=typeDefn) -> traverseSynTypeDefn path typeDefn + + and getSynMemberRangeWithAttributes synMember = + let unionRanges (attrs: SynAttributes) = attrs |> List.map (fun x -> x.Range) |> List.fold Range.unionRanges synMember.Range + match synMember with + | SynMemberDefn.Member(SynBinding.Binding(attrs=attrs), _) -> unionRanges attrs + | SynMemberDefn.ImplicitCtor(attributes=attrs) -> unionRanges attrs + | SynMemberDefn.AutoProperty(attribs=attrs) -> unionRanges attrs + | SynMemberDefn.ValField(SynField.Field(attrs=attrs), _) -> unionRanges attrs + | _ -> synMember.Range and traverseSynMatchClause path mc = let path = TraverseStep.MatchClause mc :: path let defaultTraverse mc = match mc with - | (SynMatchClause.Clause(_synPat, synExprOption, synExpr, _range, _sequencePointInfoForTarget) as all) -> - [ - match synExprOption with - | None -> () - | Some guard -> yield guard - yield synExpr - ] |> List.map (fun x -> dive x x.Range (traverseSynExpr path)) |> pick all.Range all + | (SynMatchClause.Clause(synPat, synExprOption, synExpr, _range, _sequencePointInfoForTarget) as all) -> + traverseSynPat path synPat + |> Option.orElseWith (fun _ -> + [ + match synExprOption with + | None -> () + | Some guard -> yield guard + yield synExpr + ] |> List.map (fun x -> dive x x.Range (traverseSynExpr path)) |> pick all.Range all) visitor.VisitMatchClause(defaultTraverse,mc) + and traverseSynBinding path b = let defaultTraverse b = let path = TraverseStep.Binding b :: path match b with - | (SynBinding.Binding(_synAccessOption, _synBindingKind, _, _, synAttributes, _preXmlDoc, _synValData, _synPat, _synBindingReturnInfoOption, synExpr, _range, _sequencePointInfoForBinding)) -> - traverseSynExpr path synExpr |> Option.orElseWith (fun _ -> traverseAttributes synAttributes) + | SynBinding.Binding(attrs=attrs; headPat=synPat; expr=synExpr) -> + traverseAttributes attrs + |> Option.orElseWith (fun _ -> traverseSynPat path synPat) + |> Option.orElseWith (fun _ -> traverseSynExpr path synExpr) visitor.VisitBinding(defaultTraverse,b) match parseTree with diff --git a/src/fsharp/vs/ServiceUntypedParse.fs b/src/fsharp/vs/ServiceUntypedParse.fs index 9bf7e02b567..f461ea88412 100755 --- a/src/fsharp/vs/ServiceUntypedParse.fs +++ b/src/fsharp/vs/ServiceUntypedParse.fs @@ -864,6 +864,8 @@ module UntypedParseImpl = | None -> Some (CompletionContext.Invalid) // A $ .B -> no completion list | _ -> None + member this.VisitBinding(defaultTraverse, synBinding) = defaultTraverse synBinding + member this.VisitAttribute(attr) = if rangeContainsPos attr.TypeName.Range pos then Some CompletionContext.AttributeApplication From 6e66a031fc2d62102cd340a224b357a9c288d0ca Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Wed, 28 Dec 2016 11:08:38 +0300 Subject: [PATCH 05/11] autocomplete does not remove "Attribute" suffix if an attribute type does not have it fix related tests --- src/fsharp/vs/ServiceDeclarations.fs | 15 ++++++++++++-- .../Tests.LanguageService.Completion.fs | 20 +++++++++---------- 2 files changed, 23 insertions(+), 12 deletions(-) diff --git a/src/fsharp/vs/ServiceDeclarations.fs b/src/fsharp/vs/ServiceDeclarations.fs index fdf50868e58..2875857d193 100644 --- a/src/fsharp/vs/ServiceDeclarations.fs +++ b/src/fsharp/vs/ServiceDeclarations.fs @@ -1371,8 +1371,19 @@ type FSharpDeclarationListInfo(declarations: FSharpDeclarationListItem[]) = | [] -> failwith "Unexpected empty bag" | items -> let glyphMajor, glyphMinor = GlyphOfItem(denv,items.Head) - // If we at an attribute application position and the completion item is an attribute, remove "Attribute" suffix from its name. - let nm = if atAttributeApplication && IsAttribute infoReader items.Head then nm.[0..nm.Length-attributeSuffixLength-1] else nm + (* If: + * we at an attribute application position + * the completion item is an attribute type + * the item name has "Attribute" sufix (yes, it's possible to define a System.Attribute derivative that has no this suffix) + then remove "Attribute" suffix from its name. + *) + let nm = + if atAttributeApplication + && IsAttribute infoReader items.Head + && nm.EndsWith "Attribute" + then nm.[0..nm.Length-attributeSuffixLength-1] + else nm + new FSharpDeclarationListItem(nm, glyphMajor, glyphMinor, Choice1Of2 (items, infoReader, m, denv, reactor, checkAlive))) new FSharpDeclarationListInfo(Array.ofList decls) diff --git a/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs b/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs index db2a4d2211d..2ee66700ae0 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs @@ -183,7 +183,7 @@ type UsingMSBuild() as this = shouldNotContain member public this.AutoCompleteBug70080Helper(programText:string) = - this.AutoCompleteBug70080HelperHelper(programText, ["AttributeUsageAttribute"], []) + this.AutoCompleteBug70080HelperHelper(programText, ["AttributeUsage"], []) member private this.testAutoCompleteAdjacentToDot op = let text = sprintf "System.Console%s" op @@ -3476,21 +3476,21 @@ let x = query { for bbbb in abbbbc(*D0*) do member public this.``Attribute.WhenAttachedToLet.Bug70080``() = this.AutoCompleteBug70080Helper @" open System - [] member public this.``Attribute.WhenAttachedToType.Bug70080``() = this.AutoCompleteBug70080Helper @" open System - [] member public this.``Attribute.WhenAttachedToNothing.Bug70080``() = this.AutoCompleteBug70080Helper @" open System - [] @@ -3498,7 +3498,7 @@ let x = query { for bbbb in abbbbc(*D0*) do this.AutoCompleteBug70080Helper @" namespace Foo open System - [] @@ -3506,7 +3506,7 @@ let x = query { for bbbb in abbbbc(*D0*) do this.AutoCompleteBug70080Helper @" namespace Foo open System - [] @@ -3514,7 +3514,7 @@ let x = query { for bbbb in abbbbc(*D0*) do this.AutoCompleteBug70080Helper @" namespace Foo open System - [] @@ -3522,7 +3522,7 @@ let x = query { for bbbb in abbbbc(*D0*) do this.AutoCompleteBug70080Helper @" namespace Foo open System - [] member this.``ImportStatment.System.ImportDirectly``() = From 11d1e99e8beca70ce59888c607008ab8d1db023c Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Wed, 28 Dec 2016 12:35:40 +0300 Subject: [PATCH 06/11] do not try to use AstVisitorBase to determine that we are at attribute application position --- src/fsharp/vs/ServiceAssemblyContent.fs | 280 +--------------- src/fsharp/vs/ServiceParseTreeWalk.fs | 2 - src/fsharp/vs/ServiceUntypedParse.fs | 298 +++++++++++++++++- src/fsharp/vs/ServiceUntypedParse.fsi | 9 + .../FSharp.Editor/Common/LanguageService.fs | 2 +- 5 files changed, 302 insertions(+), 289 deletions(-) diff --git a/src/fsharp/vs/ServiceAssemblyContent.fs b/src/fsharp/vs/ServiceAssemblyContent.fs index 08156324e27..72c7be80fd4 100644 --- a/src/fsharp/vs/ServiceAssemblyContent.fs +++ b/src/fsharp/vs/ServiceAssemblyContent.fs @@ -16,7 +16,6 @@ open Microsoft.FSharp.Compiler.Range type internal ShortIdent = string type Idents = ShortIdent[] type IsAutoOpen = bool -type ModuleKind = { IsAutoOpen: bool; HasModuleSuffix: bool } [] module internal Extensions = @@ -189,13 +188,6 @@ module internal Utils = res))) |> Option.isSome -type EntityKind = - | Attribute - | Type - | FunctionOrValue of isActivePattern:bool - | Module of ModuleKind - override x.ToString() = sprintf "%A" x - [] type LookupType = | Fuzzy @@ -1028,274 +1020,4 @@ module internal ParsedInput = match scope.Kind with | TopModule -> NestedModule | x -> x - { ScopeKind = scopeKind; Pos = Point.make (endLine + 1) startCol }) - - let getEntityKind (input: ParsedInput) (pos: Range.pos) : EntityKind option = - let (|ConstructorPats|) = function - | Pats ps -> ps - | NamePatPairs(xs, _) -> List.map snd xs - - let isPosInRange range = Range.rangeContainsPos range pos - - let ifPosInRange range f = - if isPosInRange range then f() - else None - - let rec walkImplFileInput (ParsedImplFileInput(_, _, _, _, _, moduleOrNamespaceList, _)) = - List.tryPick (walkSynModuleOrNamespace true) moduleOrNamespaceList - - and walkSynModuleOrNamespace isTopLevel (SynModuleOrNamespace(_, _, isModule, decls, _, attrs, _, r)) = - if isModule && isTopLevel then None else List.tryPick walkAttribute attrs - |> Option.orElse (ifPosInRange r (fun _ -> List.tryPick (walkSynModuleDecl isTopLevel) decls)) - - and walkAttribute (attr: SynAttribute) = - if isPosInRange attr.Range then Some EntityKind.Attribute else None - |> Option.orElse (walkExprWithKind (Some EntityKind.Type) attr.ArgExpr) - - and walkTypar (Typar (ident, _, _)) = ifPosInRange ident.idRange (fun _ -> Some EntityKind.Type) - - and walkTyparDecl (SynTyparDecl.TyparDecl (attrs, typar)) = - List.tryPick walkAttribute attrs - |> Option.orElse (walkTypar typar) - - and walkTypeConstraint = function - | SynTypeConstraint.WhereTyparDefaultsToType (t1, t2, _) -> walkTypar t1 |> Option.orElse (walkType t2) - | SynTypeConstraint.WhereTyparIsValueType(t, _) -> walkTypar t - | SynTypeConstraint.WhereTyparIsReferenceType(t, _) -> walkTypar t - | SynTypeConstraint.WhereTyparIsUnmanaged(t, _) -> walkTypar t - | SynTypeConstraint.WhereTyparSupportsNull (t, _) -> walkTypar t - | SynTypeConstraint.WhereTyparIsComparable(t, _) -> walkTypar t - | SynTypeConstraint.WhereTyparIsEquatable(t, _) -> walkTypar t - | SynTypeConstraint.WhereTyparSubtypeOfType(t, ty, _) -> walkTypar t |> Option.orElse (walkType ty) - | SynTypeConstraint.WhereTyparSupportsMember(ts, sign, _) -> - List.tryPick walkType ts |> Option.orElse (walkMemberSig sign) - | SynTypeConstraint.WhereTyparIsEnum(t, ts, _) -> walkTypar t |> Option.orElse (List.tryPick walkType ts) - | SynTypeConstraint.WhereTyparIsDelegate(t, ts, _) -> walkTypar t |> Option.orElse (List.tryPick walkType ts) - - and walkPatWithKind (kind: EntityKind option) = function - | SynPat.Ands (pats, _) -> List.tryPick walkPat pats - | SynPat.Named(SynPat.Wild nameRange as pat, _, _, _, _) -> - if isPosInRange nameRange then None - else walkPat pat - | SynPat.Typed(pat, t, _) -> walkPat pat |> Option.orElse (walkType t) - | SynPat.Attrib(pat, attrs, _) -> walkPat pat |> Option.orElse (List.tryPick walkAttribute attrs) - | SynPat.Or(pat1, pat2, _) -> List.tryPick walkPat [pat1; pat2] - | SynPat.LongIdent(_, _, typars, ConstructorPats pats, _, r) -> - ifPosInRange r (fun _ -> kind) - |> Option.orElse ( - typars - |> Option.bind (fun (SynValTyparDecls (typars, _, constraints)) -> - List.tryPick walkTyparDecl typars - |> Option.orElse (List.tryPick walkTypeConstraint constraints))) - |> Option.orElse (List.tryPick walkPat pats) - | SynPat.Tuple(pats, _) -> List.tryPick walkPat pats - | SynPat.Paren(pat, _) -> walkPat pat - | SynPat.ArrayOrList(_, pats, _) -> List.tryPick walkPat pats - | SynPat.IsInst(t, _) -> walkType t - | SynPat.QuoteExpr(e, _) -> walkExpr e - | _ -> None - - and walkPat = walkPatWithKind None - - and walkBinding (SynBinding.Binding(_, _, _, _, attrs, _, _, pat, returnInfo, e, _, _)) = - List.tryPick walkAttribute attrs - |> Option.orElse (walkPat pat) - |> Option.orElse (walkExpr e) - |> Option.orElse ( - match returnInfo with - | Some (SynBindingReturnInfo (t, _, _)) -> walkType t - | None -> None) - - and walkInterfaceImpl (InterfaceImpl(_, bindings, _)) = - List.tryPick walkBinding bindings - - and walkIndexerArg = function - | SynIndexerArg.One e -> walkExpr e - | SynIndexerArg.Two(e1, e2) -> List.tryPick walkExpr [e1; e2] - - and walkType = function - | SynType.LongIdent ident -> ifPosInRange ident.Range (fun _ -> Some EntityKind.Type) - | SynType.App(ty, _, types, _, _, _, _) -> - walkType ty |> Option.orElse (List.tryPick walkType types) - | SynType.LongIdentApp(_, _, _, types, _, _, _) -> List.tryPick walkType types - | SynType.Tuple(ts, _) -> ts |> List.tryPick (fun (_, t) -> walkType t) - | SynType.Array(_, t, _) -> walkType t - | SynType.Fun(t1, t2, _) -> walkType t1 |> Option.orElse (walkType t2) - | SynType.WithGlobalConstraints(t, _, _) -> walkType t - | SynType.HashConstraint(t, _) -> walkType t - | SynType.MeasureDivide(t1, t2, _) -> walkType t1 |> Option.orElse (walkType t2) - | SynType.MeasurePower(t, _, _) -> walkType t - | _ -> None - - and walkClause (Clause(pat, e1, e2, _, _)) = - walkPatWithKind (Some EntityKind.Type) pat - |> Option.orElse (walkExpr e2) - |> Option.orElse (Option.bind walkExpr e1) - - and walkExprWithKind (parentKind: EntityKind option) = function - | SynExpr.LongIdent (_, LongIdentWithDots(_, dotRanges), _, r) -> - match dotRanges with - | [] when isPosInRange r -> parentKind |> Option.orElse (Some (EntityKind.FunctionOrValue false)) - | firstDotRange :: _ -> - let firstPartRange = - Range.mkRange "" r.Start (Range.mkPos firstDotRange.StartLine (firstDotRange.StartColumn - 1)) - if isPosInRange firstPartRange then - parentKind |> Option.orElse (Some (EntityKind.FunctionOrValue false)) - else None - | _ -> None - | SynExpr.Paren (e, _, _, _) -> walkExprWithKind parentKind e - | SynExpr.Quote(_, _, e, _, _) -> walkExprWithKind parentKind e - | SynExpr.Typed(e, _, _) -> walkExprWithKind parentKind e - | SynExpr.Tuple(es, _, _) -> List.tryPick (walkExprWithKind parentKind) es - | SynExpr.ArrayOrList(_, es, _) -> List.tryPick (walkExprWithKind parentKind) es - | SynExpr.Record(_, _, fields, r) -> - ifPosInRange r (fun _ -> - fields |> List.tryPick (fun (_, e, _) -> e |> Option.bind (walkExprWithKind parentKind))) - | SynExpr.New(_, t, e, _) -> walkExprWithKind parentKind e |> Option.orElse (walkType t) - | SynExpr.ObjExpr(ty, _, bindings, ifaces, _, _) -> - walkType ty - |> Option.orElse (List.tryPick walkBinding bindings) - |> Option.orElse (List.tryPick walkInterfaceImpl ifaces) - | SynExpr.While(_, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] - | SynExpr.For(_, _, e1, _, e2, e3, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2; e3] - | SynExpr.ForEach(_, _, _, _, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] - | SynExpr.ArrayOrListOfSeqExpr(_, e, _) -> walkExprWithKind parentKind e - | SynExpr.CompExpr(_, _, e, _) -> walkExprWithKind parentKind e - | SynExpr.Lambda(_, _, _, e, _) -> walkExprWithKind parentKind e - | SynExpr.MatchLambda(_, _, synMatchClauseList, _, _) -> - List.tryPick walkClause synMatchClauseList - | SynExpr.Match(_, e, synMatchClauseList, _, _) -> - walkExprWithKind parentKind e |> Option.orElse (List.tryPick walkClause synMatchClauseList) - | SynExpr.Do(e, _) -> walkExprWithKind parentKind e - | SynExpr.Assert(e, _) -> walkExprWithKind parentKind e - | SynExpr.App(_, _, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] - | SynExpr.TypeApp(e, _, tys, _, _, _, _) -> - walkExprWithKind (Some EntityKind.Type) e |> Option.orElse (List.tryPick walkType tys) - | SynExpr.LetOrUse(_, _, bindings, e, _) -> List.tryPick walkBinding bindings |> Option.orElse (walkExprWithKind parentKind e) - | SynExpr.TryWith(e, _, clauses, _, _, _, _) -> walkExprWithKind parentKind e |> Option.orElse (List.tryPick walkClause clauses) - | SynExpr.TryFinally(e1, e2, _, _, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] - | SynExpr.Lazy(e, _) -> walkExprWithKind parentKind e - | Sequentials es -> List.tryPick (walkExprWithKind parentKind) es - | SynExpr.IfThenElse(e1, e2, e3, _, _, _, _) -> - List.tryPick (walkExprWithKind parentKind) [e1; e2] |> Option.orElse (match e3 with None -> None | Some e -> walkExprWithKind parentKind e) - | SynExpr.Ident ident -> ifPosInRange ident.idRange (fun _ -> Some (EntityKind.FunctionOrValue false)) - | SynExpr.LongIdentSet(_, e, _) -> walkExprWithKind parentKind e - | SynExpr.DotGet(e, _, _, _) -> walkExprWithKind parentKind e - | SynExpr.DotSet(e, _, _, _) -> walkExprWithKind parentKind e - | SynExpr.DotIndexedGet(e, args, _, _) -> walkExprWithKind parentKind e |> Option.orElse (List.tryPick walkIndexerArg args) - | SynExpr.DotIndexedSet(e, args, _, _, _, _) -> walkExprWithKind parentKind e |> Option.orElse (List.tryPick walkIndexerArg args) - | SynExpr.NamedIndexedPropertySet(_, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] - | SynExpr.DotNamedIndexedPropertySet(e1, _, e2, e3, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2; e3] - | SynExpr.TypeTest(e, t, _) -> walkExprWithKind parentKind e |> Option.orElse (walkType t) - | SynExpr.Upcast(e, t, _) -> walkExprWithKind parentKind e |> Option.orElse (walkType t) - | SynExpr.Downcast(e, t, _) -> walkExprWithKind parentKind e |> Option.orElse (walkType t) - | SynExpr.InferredUpcast(e, _) -> walkExprWithKind parentKind e - | SynExpr.InferredDowncast(e, _) -> walkExprWithKind parentKind e - | SynExpr.AddressOf(_, e, _, _) -> walkExprWithKind parentKind e - | SynExpr.JoinIn(e1, _, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] - | SynExpr.YieldOrReturn(_, e, _) -> walkExprWithKind parentKind e - | SynExpr.YieldOrReturnFrom(_, e, _) -> walkExprWithKind parentKind e - | SynExpr.LetOrUseBang(_, _, _, _, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] - | SynExpr.DoBang(e, _) -> walkExprWithKind parentKind e - | SynExpr.TraitCall (ts, sign, e, _) -> - List.tryPick walkTypar ts - |> Option.orElse (walkMemberSig sign) - |> Option.orElse (walkExprWithKind parentKind e) - | _ -> None - - and walkExpr = walkExprWithKind None - - and walkSimplePat = function - | SynSimplePat.Attrib (pat, attrs, _) -> - walkSimplePat pat |> Option.orElse (List.tryPick walkAttribute attrs) - | SynSimplePat.Typed(pat, t, _) -> walkSimplePat pat |> Option.orElse (walkType t) - | _ -> None - - and walkField (SynField.Field(attrs, _, _, t, _, _, _, _)) = - List.tryPick walkAttribute attrs |> Option.orElse (walkType t) - - and walkValSig (SynValSig.ValSpfn(attrs, _, _, t, _, _, _, _, _, _, _)) = - List.tryPick walkAttribute attrs |> Option.orElse (walkType t) - - and walkMemberSig = function - | SynMemberSig.Inherit (t, _) -> walkType t - | SynMemberSig.Member(vs, _, _) -> walkValSig vs - | SynMemberSig.Interface(t, _) -> walkType t - | SynMemberSig.ValField(f, _) -> walkField f - | SynMemberSig.NestedType(SynTypeDefnSig.TypeDefnSig (info, repr, memberSigs, _), _) -> - walkComponentInfo false info - |> Option.orElse (walkTypeDefnSigRepr repr) - |> Option.orElse (List.tryPick walkMemberSig memberSigs) - - and walkMember = function - | SynMemberDefn.AbstractSlot (valSig, _, _) -> walkValSig valSig - | SynMemberDefn.Member(binding, _) -> walkBinding binding - | SynMemberDefn.ImplicitCtor(_, attrs, pats, _, _) -> - List.tryPick walkAttribute attrs |> Option.orElse (List.tryPick walkSimplePat pats) - | SynMemberDefn.ImplicitInherit(t, e, _, _) -> walkType t |> Option.orElse (walkExpr e) - | SynMemberDefn.LetBindings(bindings, _, _, _) -> List.tryPick walkBinding bindings - | SynMemberDefn.Interface(t, members, _) -> - walkType t - |> Option.orElse (members |> Option.bind (List.tryPick walkMember)) - | SynMemberDefn.Inherit(t, _, _) -> walkType t - | SynMemberDefn.ValField(field, _) -> walkField field - | SynMemberDefn.NestedType(tdef, _, _) -> walkTypeDefn tdef - | SynMemberDefn.AutoProperty(attrs, _, _, t, _, _, _, _, e, _, _) -> - List.tryPick walkAttribute attrs - |> Option.orElse (Option.bind walkType t) - |> Option.orElse (walkExpr e) - | _ -> None - - and walkEnumCase (EnumCase(attrs, _, _, _, _)) = List.tryPick walkAttribute attrs - - and walkUnionCaseType = function - | SynUnionCaseType.UnionCaseFields fields -> List.tryPick walkField fields - | SynUnionCaseType.UnionCaseFullType(t, _) -> walkType t - - and walkUnionCase (UnionCase(attrs, _, t, _, _, _)) = - List.tryPick walkAttribute attrs |> Option.orElse (walkUnionCaseType t) - - and walkTypeDefnSimple = function - | SynTypeDefnSimpleRepr.Enum (cases, _) -> List.tryPick walkEnumCase cases - | SynTypeDefnSimpleRepr.Union(_, cases, _) -> List.tryPick walkUnionCase cases - | SynTypeDefnSimpleRepr.Record(_, fields, _) -> List.tryPick walkField fields - | SynTypeDefnSimpleRepr.TypeAbbrev(_, t, _) -> walkType t - | _ -> None - - and walkComponentInfo isModule (ComponentInfo(attrs, typars, constraints, _, _, _, _, r)) = - if isModule then None else ifPosInRange r (fun _ -> Some EntityKind.Type) - |> Option.orElse ( - List.tryPick walkAttribute attrs - |> Option.orElse (List.tryPick walkTyparDecl typars) - |> Option.orElse (List.tryPick walkTypeConstraint constraints)) - - and walkTypeDefnRepr = function - | SynTypeDefnRepr.ObjectModel (_, defns, _) -> List.tryPick walkMember defns - | SynTypeDefnRepr.Simple(defn, _) -> walkTypeDefnSimple defn - | SynTypeDefnRepr.Exception(_) -> None - - and walkTypeDefnSigRepr = function - | SynTypeDefnSigRepr.ObjectModel (_, defns, _) -> List.tryPick walkMemberSig defns - | SynTypeDefnSigRepr.Simple(defn, _) -> walkTypeDefnSimple defn - | SynTypeDefnSigRepr.Exception(_) -> None - - and walkTypeDefn (TypeDefn (info, repr, members, _)) = - walkComponentInfo false info - |> Option.orElse (walkTypeDefnRepr repr) - |> Option.orElse (List.tryPick walkMember members) - - and walkSynModuleDecl isTopLevel (decl: SynModuleDecl) = - match decl with - | SynModuleDecl.NamespaceFragment fragment -> walkSynModuleOrNamespace isTopLevel fragment - | SynModuleDecl.NestedModule(info, _, modules, _, range) -> - walkComponentInfo true info - |> Option.orElse (ifPosInRange range (fun _ -> List.tryPick (walkSynModuleDecl false) modules)) - | SynModuleDecl.Open _ -> None - | SynModuleDecl.Let (_, bindings, _) -> List.tryPick walkBinding bindings - | SynModuleDecl.DoExpr (_, expr, _) -> walkExpr expr - | SynModuleDecl.Types (types, _) -> List.tryPick walkTypeDefn types - | _ -> None - - match input with - | ParsedInput.SigFile _ -> None - | ParsedInput.ImplFile input -> walkImplFileInput input \ No newline at end of file + { ScopeKind = scopeKind; Pos = Point.make (endLine + 1) startCol }) \ No newline at end of file diff --git a/src/fsharp/vs/ServiceParseTreeWalk.fs b/src/fsharp/vs/ServiceParseTreeWalk.fs index 15fbea70b79..25447d00592 100755 --- a/src/fsharp/vs/ServiceParseTreeWalk.fs +++ b/src/fsharp/vs/ServiceParseTreeWalk.fs @@ -74,8 +74,6 @@ module internal AstTraversal = // VisitRecordField allows overriding behavior when visiting l.h.s. of constructed record instances abstract VisitRecordField : TraversePath * SynExpr option * LongIdentWithDots option -> 'T option default this.VisitRecordField (_path, _copyOpt, _recordField) = None - abstract VisitAttribute : SynAttribute -> 'T option - default this.VisitAttribute (_synAttribute) = None let dive node range project = range,(fun() -> project node) diff --git a/src/fsharp/vs/ServiceUntypedParse.fs b/src/fsharp/vs/ServiceUntypedParse.fs index f461ea88412..6be7ada2941 100755 --- a/src/fsharp/vs/ServiceUntypedParse.fs +++ b/src/fsharp/vs/ServiceUntypedParse.fs @@ -604,6 +604,292 @@ module UntypedParseImpl = | _ -> defaultTraverse(expr) } AstTraversal.Traverse(pos, parseTree, walker) + type ModuleKind = { IsAutoOpen: bool; HasModuleSuffix: bool } + + type EntityKind = + | Attribute + | Type + | FunctionOrValue of isActivePattern:bool + | Module of ModuleKind + override x.ToString() = sprintf "%A" x + + let GetEntityKind (pos: pos, input: ParsedInput) : EntityKind option = + let (|ConstructorPats|) = function + | Pats ps -> ps + | NamePatPairs(xs, _) -> List.map snd xs + + /// An recursive pattern that collect all sequential expressions to avoid StackOverflowException + let rec (|Sequentials|_|) = function + | SynExpr.Sequential(_, _, e, Sequentials es, _) -> Some(e::es) + | SynExpr.Sequential(_, _, e1, e2, _) -> Some [e1; e2] + | _ -> None + + let inline orElse x = Microsoft.FSharp.Core.Option.orElse x + + let inline isPosInRange range = Range.rangeContainsPos range pos + + let inline ifPosInRange range f = + if isPosInRange range then f() + else None + + let rec walkImplFileInput (ParsedImplFileInput(_, _, _, _, _, moduleOrNamespaceList, _)) = + List.tryPick (walkSynModuleOrNamespace true) moduleOrNamespaceList + + and walkSynModuleOrNamespace isTopLevel (SynModuleOrNamespace(_, _, isModule, decls, _, attrs, _, r)) = + if isModule && isTopLevel then None else List.tryPick walkAttribute attrs + |> orElse (ifPosInRange r (fun _ -> List.tryPick (walkSynModuleDecl isTopLevel) decls)) + + and walkAttribute (attr: SynAttribute) = + if isPosInRange attr.Range then Some EntityKind.Attribute else None + |> orElse (walkExprWithKind (Some EntityKind.Type) attr.ArgExpr) + + and walkTypar (Typar (ident, _, _)) = ifPosInRange ident.idRange (fun _ -> Some EntityKind.Type) + + and walkTyparDecl (SynTyparDecl.TyparDecl (attrs, typar)) = + List.tryPick walkAttribute attrs + |> orElse (walkTypar typar) + + and walkTypeConstraint = function + | SynTypeConstraint.WhereTyparDefaultsToType (t1, t2, _) -> walkTypar t1 |> orElse (walkType t2) + | SynTypeConstraint.WhereTyparIsValueType(t, _) -> walkTypar t + | SynTypeConstraint.WhereTyparIsReferenceType(t, _) -> walkTypar t + | SynTypeConstraint.WhereTyparIsUnmanaged(t, _) -> walkTypar t + | SynTypeConstraint.WhereTyparSupportsNull (t, _) -> walkTypar t + | SynTypeConstraint.WhereTyparIsComparable(t, _) -> walkTypar t + | SynTypeConstraint.WhereTyparIsEquatable(t, _) -> walkTypar t + | SynTypeConstraint.WhereTyparSubtypeOfType(t, ty, _) -> walkTypar t |> orElse (walkType ty) + | SynTypeConstraint.WhereTyparSupportsMember(ts, sign, _) -> + List.tryPick walkType ts |> orElse (walkMemberSig sign) + | SynTypeConstraint.WhereTyparIsEnum(t, ts, _) -> walkTypar t |> orElse (List.tryPick walkType ts) + | SynTypeConstraint.WhereTyparIsDelegate(t, ts, _) -> walkTypar t |> orElse (List.tryPick walkType ts) + + and walkPatWithKind (kind: EntityKind option) = function + | SynPat.Ands (pats, _) -> List.tryPick walkPat pats + | SynPat.Named(SynPat.Wild nameRange as pat, _, _, _, _) -> + if isPosInRange nameRange then None + else walkPat pat + | SynPat.Typed(pat, t, _) -> walkPat pat |> orElse (walkType t) + | SynPat.Attrib(pat, attrs, _) -> walkPat pat |> orElse (List.tryPick walkAttribute attrs) + | SynPat.Or(pat1, pat2, _) -> List.tryPick walkPat [pat1; pat2] + | SynPat.LongIdent(_, _, typars, ConstructorPats pats, _, r) -> + ifPosInRange r (fun _ -> kind) + |> orElse ( + typars + |> Option.bind (fun (SynValTyparDecls (typars, _, constraints)) -> + List.tryPick walkTyparDecl typars + |> orElse (List.tryPick walkTypeConstraint constraints))) + |> orElse (List.tryPick walkPat pats) + | SynPat.Tuple(pats, _) -> List.tryPick walkPat pats + | SynPat.Paren(pat, _) -> walkPat pat + | SynPat.ArrayOrList(_, pats, _) -> List.tryPick walkPat pats + | SynPat.IsInst(t, _) -> walkType t + | SynPat.QuoteExpr(e, _) -> walkExpr e + | _ -> None + + and walkPat = walkPatWithKind None + + and walkBinding (SynBinding.Binding(_, _, _, _, attrs, _, _, pat, returnInfo, e, _, _)) = + List.tryPick walkAttribute attrs + |> orElse (walkPat pat) + |> orElse (walkExpr e) + |> orElse ( + match returnInfo with + | Some (SynBindingReturnInfo (t, _, _)) -> walkType t + | None -> None) + + and walkInterfaceImpl (InterfaceImpl(_, bindings, _)) = + List.tryPick walkBinding bindings + + and walkIndexerArg = function + | SynIndexerArg.One e -> walkExpr e + | SynIndexerArg.Two(e1, e2) -> List.tryPick walkExpr [e1; e2] + + and walkType = function + | SynType.LongIdent ident -> ifPosInRange ident.Range (fun _ -> Some EntityKind.Type) + | SynType.App(ty, _, types, _, _, _, _) -> + walkType ty |> orElse (List.tryPick walkType types) + | SynType.LongIdentApp(_, _, _, types, _, _, _) -> List.tryPick walkType types + | SynType.Tuple(ts, _) -> ts |> List.tryPick (fun (_, t) -> walkType t) + | SynType.Array(_, t, _) -> walkType t + | SynType.Fun(t1, t2, _) -> walkType t1 |> orElse (walkType t2) + | SynType.WithGlobalConstraints(t, _, _) -> walkType t + | SynType.HashConstraint(t, _) -> walkType t + | SynType.MeasureDivide(t1, t2, _) -> walkType t1 |> orElse (walkType t2) + | SynType.MeasurePower(t, _, _) -> walkType t + | _ -> None + + and walkClause (Clause(pat, e1, e2, _, _)) = + walkPatWithKind (Some EntityKind.Type) pat + |> orElse (walkExpr e2) + |> orElse (Option.bind walkExpr e1) + + and walkExprWithKind (parentKind: EntityKind option) = function + | SynExpr.LongIdent (_, LongIdentWithDots(_, dotRanges), _, r) -> + match dotRanges with + | [] when isPosInRange r -> parentKind |> orElse (Some (EntityKind.FunctionOrValue false)) + | firstDotRange :: _ -> + let firstPartRange = + Range.mkRange "" r.Start (Range.mkPos firstDotRange.StartLine (firstDotRange.StartColumn - 1)) + if isPosInRange firstPartRange then + parentKind |> orElse (Some (EntityKind.FunctionOrValue false)) + else None + | _ -> None + | SynExpr.Paren (e, _, _, _) -> walkExprWithKind parentKind e + | SynExpr.Quote(_, _, e, _, _) -> walkExprWithKind parentKind e + | SynExpr.Typed(e, _, _) -> walkExprWithKind parentKind e + | SynExpr.Tuple(es, _, _) -> List.tryPick (walkExprWithKind parentKind) es + | SynExpr.ArrayOrList(_, es, _) -> List.tryPick (walkExprWithKind parentKind) es + | SynExpr.Record(_, _, fields, r) -> + ifPosInRange r (fun _ -> + fields |> List.tryPick (fun (_, e, _) -> e |> Option.bind (walkExprWithKind parentKind))) + | SynExpr.New(_, t, e, _) -> walkExprWithKind parentKind e |> orElse (walkType t) + | SynExpr.ObjExpr(ty, _, bindings, ifaces, _, _) -> + walkType ty + |> orElse (List.tryPick walkBinding bindings) + |> orElse (List.tryPick walkInterfaceImpl ifaces) + | SynExpr.While(_, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.For(_, _, e1, _, e2, e3, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2; e3] + | SynExpr.ForEach(_, _, _, _, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.ArrayOrListOfSeqExpr(_, e, _) -> walkExprWithKind parentKind e + | SynExpr.CompExpr(_, _, e, _) -> walkExprWithKind parentKind e + | SynExpr.Lambda(_, _, _, e, _) -> walkExprWithKind parentKind e + | SynExpr.MatchLambda(_, _, synMatchClauseList, _, _) -> + List.tryPick walkClause synMatchClauseList + | SynExpr.Match(_, e, synMatchClauseList, _, _) -> + walkExprWithKind parentKind e |> orElse (List.tryPick walkClause synMatchClauseList) + | SynExpr.Do(e, _) -> walkExprWithKind parentKind e + | SynExpr.Assert(e, _) -> walkExprWithKind parentKind e + | SynExpr.App(_, _, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.TypeApp(e, _, tys, _, _, _, _) -> + walkExprWithKind (Some EntityKind.Type) e |> orElse (List.tryPick walkType tys) + | SynExpr.LetOrUse(_, _, bindings, e, _) -> List.tryPick walkBinding bindings |> orElse (walkExprWithKind parentKind e) + | SynExpr.TryWith(e, _, clauses, _, _, _, _) -> walkExprWithKind parentKind e |> orElse (List.tryPick walkClause clauses) + | SynExpr.TryFinally(e1, e2, _, _, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.Lazy(e, _) -> walkExprWithKind parentKind e + | Sequentials es -> List.tryPick (walkExprWithKind parentKind) es + | SynExpr.IfThenElse(e1, e2, e3, _, _, _, _) -> + List.tryPick (walkExprWithKind parentKind) [e1; e2] |> orElse (match e3 with None -> None | Some e -> walkExprWithKind parentKind e) + | SynExpr.Ident ident -> ifPosInRange ident.idRange (fun _ -> Some (EntityKind.FunctionOrValue false)) + | SynExpr.LongIdentSet(_, e, _) -> walkExprWithKind parentKind e + | SynExpr.DotGet(e, _, _, _) -> walkExprWithKind parentKind e + | SynExpr.DotSet(e, _, _, _) -> walkExprWithKind parentKind e + | SynExpr.DotIndexedGet(e, args, _, _) -> walkExprWithKind parentKind e |> orElse (List.tryPick walkIndexerArg args) + | SynExpr.DotIndexedSet(e, args, _, _, _, _) -> walkExprWithKind parentKind e |> orElse (List.tryPick walkIndexerArg args) + | SynExpr.NamedIndexedPropertySet(_, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.DotNamedIndexedPropertySet(e1, _, e2, e3, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2; e3] + | SynExpr.TypeTest(e, t, _) -> walkExprWithKind parentKind e |> orElse (walkType t) + | SynExpr.Upcast(e, t, _) -> walkExprWithKind parentKind e |> orElse (walkType t) + | SynExpr.Downcast(e, t, _) -> walkExprWithKind parentKind e |> orElse (walkType t) + | SynExpr.InferredUpcast(e, _) -> walkExprWithKind parentKind e + | SynExpr.InferredDowncast(e, _) -> walkExprWithKind parentKind e + | SynExpr.AddressOf(_, e, _, _) -> walkExprWithKind parentKind e + | SynExpr.JoinIn(e1, _, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.YieldOrReturn(_, e, _) -> walkExprWithKind parentKind e + | SynExpr.YieldOrReturnFrom(_, e, _) -> walkExprWithKind parentKind e + | SynExpr.LetOrUseBang(_, _, _, _, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.DoBang(e, _) -> walkExprWithKind parentKind e + | SynExpr.TraitCall (ts, sign, e, _) -> + List.tryPick walkTypar ts + |> orElse (walkMemberSig sign) + |> orElse (walkExprWithKind parentKind e) + | _ -> None + + and walkExpr = walkExprWithKind None + + and walkSimplePat = function + | SynSimplePat.Attrib (pat, attrs, _) -> + walkSimplePat pat |> orElse (List.tryPick walkAttribute attrs) + | SynSimplePat.Typed(pat, t, _) -> walkSimplePat pat |> orElse (walkType t) + | _ -> None + + and walkField (SynField.Field(attrs, _, _, t, _, _, _, _)) = + List.tryPick walkAttribute attrs |> orElse (walkType t) + + and walkValSig (SynValSig.ValSpfn(attrs, _, _, t, _, _, _, _, _, _, _)) = + List.tryPick walkAttribute attrs |> orElse (walkType t) + + and walkMemberSig = function + | SynMemberSig.Inherit (t, _) -> walkType t + | SynMemberSig.Member(vs, _, _) -> walkValSig vs + | SynMemberSig.Interface(t, _) -> walkType t + | SynMemberSig.ValField(f, _) -> walkField f + | SynMemberSig.NestedType(SynTypeDefnSig.TypeDefnSig (info, repr, memberSigs, _), _) -> + walkComponentInfo false info + |> orElse (walkTypeDefnSigRepr repr) + |> orElse (List.tryPick walkMemberSig memberSigs) + + and walkMember = function + | SynMemberDefn.AbstractSlot (valSig, _, _) -> walkValSig valSig + | SynMemberDefn.Member(binding, _) -> walkBinding binding + | SynMemberDefn.ImplicitCtor(_, attrs, pats, _, _) -> + List.tryPick walkAttribute attrs |> orElse (List.tryPick walkSimplePat pats) + | SynMemberDefn.ImplicitInherit(t, e, _, _) -> walkType t |> orElse (walkExpr e) + | SynMemberDefn.LetBindings(bindings, _, _, _) -> List.tryPick walkBinding bindings + | SynMemberDefn.Interface(t, members, _) -> + walkType t |> orElse (members |> Option.bind (List.tryPick walkMember)) + | SynMemberDefn.Inherit(t, _, _) -> walkType t + | SynMemberDefn.ValField(field, _) -> walkField field + | SynMemberDefn.NestedType(tdef, _, _) -> walkTypeDefn tdef + | SynMemberDefn.AutoProperty(attrs, _, _, t, _, _, _, _, e, _, _) -> + List.tryPick walkAttribute attrs + |> orElse (Option.bind walkType t) + |> orElse (walkExpr e) + | _ -> None + + and walkEnumCase (EnumCase(attrs, _, _, _, _)) = List.tryPick walkAttribute attrs + + and walkUnionCaseType = function + | SynUnionCaseType.UnionCaseFields fields -> List.tryPick walkField fields + | SynUnionCaseType.UnionCaseFullType(t, _) -> walkType t + + and walkUnionCase (UnionCase(attrs, _, t, _, _, _)) = + List.tryPick walkAttribute attrs |> orElse (walkUnionCaseType t) + + and walkTypeDefnSimple = function + | SynTypeDefnSimpleRepr.Enum (cases, _) -> List.tryPick walkEnumCase cases + | SynTypeDefnSimpleRepr.Union(_, cases, _) -> List.tryPick walkUnionCase cases + | SynTypeDefnSimpleRepr.Record(_, fields, _) -> List.tryPick walkField fields + | SynTypeDefnSimpleRepr.TypeAbbrev(_, t, _) -> walkType t + | _ -> None + + and walkComponentInfo isModule (ComponentInfo(attrs, typars, constraints, _, _, _, _, r)) = + if isModule then None else ifPosInRange r (fun _ -> Some EntityKind.Type) + |> orElse ( + List.tryPick walkAttribute attrs + |> orElse (List.tryPick walkTyparDecl typars) + |> orElse (List.tryPick walkTypeConstraint constraints)) + + and walkTypeDefnRepr = function + | SynTypeDefnRepr.ObjectModel (_, defns, _) -> List.tryPick walkMember defns + | SynTypeDefnRepr.Simple(defn, _) -> walkTypeDefnSimple defn + | SynTypeDefnRepr.Exception(_) -> None + + and walkTypeDefnSigRepr = function + | SynTypeDefnSigRepr.ObjectModel (_, defns, _) -> List.tryPick walkMemberSig defns + | SynTypeDefnSigRepr.Simple(defn, _) -> walkTypeDefnSimple defn + | SynTypeDefnSigRepr.Exception(_) -> None + + and walkTypeDefn (TypeDefn (info, repr, members, _)) = + walkComponentInfo false info + |> orElse (walkTypeDefnRepr repr) + |> orElse (List.tryPick walkMember members) + + and walkSynModuleDecl isTopLevel (decl: SynModuleDecl) = + match decl with + | SynModuleDecl.NamespaceFragment fragment -> walkSynModuleOrNamespace isTopLevel fragment + | SynModuleDecl.NestedModule(info, _, modules, _, range) -> + walkComponentInfo true info + |> orElse (ifPosInRange range (fun _ -> List.tryPick (walkSynModuleDecl false) modules)) + | SynModuleDecl.Open _ -> None + | SynModuleDecl.Let (_, bindings, _) -> List.tryPick walkBinding bindings + | SynModuleDecl.DoExpr (_, expr, _) -> walkExpr expr + | SynModuleDecl.Types (types, _) -> List.tryPick walkTypeDefn types + | _ -> None + + match input with + | ParsedInput.SigFile _ -> None + | ParsedInput.ImplFile input -> walkImplFileInput input + type internal TS = AstTraversal.TraverseStep /// Try to determine completion context for the given pair (row, columns) @@ -615,7 +901,10 @@ module UntypedParseImpl = match parsedInputOpt with | None -> None - | Some pt -> + | Some pt -> + match GetEntityKind(pos, pt) with + | Some EntityKind.Attribute -> Some CompletionContext.AttributeApplication + | _ -> let parseLid (LongIdentWithDots(lid, dots)) = let rec collect plid (parts : Ident list) (dots : range list) = @@ -864,10 +1153,5 @@ module UntypedParseImpl = | None -> Some (CompletionContext.Invalid) // A $ .B -> no completion list | _ -> None - member this.VisitBinding(defaultTraverse, synBinding) = defaultTraverse synBinding - - member this.VisitAttribute(attr) = - if rangeContainsPos attr.TypeName.Range pos then - Some CompletionContext.AttributeApplication - else None } + member this.VisitBinding(defaultTraverse, synBinding) = defaultTraverse synBinding } AstTraversal.Traverse(pos, pt, walker) \ No newline at end of file diff --git a/src/fsharp/vs/ServiceUntypedParse.fsi b/src/fsharp/vs/ServiceUntypedParse.fsi index 864d8109db1..4be910f598c 100755 --- a/src/fsharp/vs/ServiceUntypedParse.fsi +++ b/src/fsharp/vs/ServiceUntypedParse.fsi @@ -77,12 +77,21 @@ type internal CompletionContext = | ParameterList of pos * HashSet | AttributeApplication +type internal ModuleKind = { IsAutoOpen: bool; HasModuleSuffix: bool } + +type internal EntityKind = + | Attribute + | Type + | FunctionOrValue of isActivePattern:bool + | Module of ModuleKind + // implementation details used by other code in the compiler module internal UntypedParseImpl = val TryFindExpressionASTLeftOfDotLeftOfCursor : pos * ParsedInput option -> (pos * bool) option val GetRangeOfExprLeftOfDot : pos * ParsedInput option -> range option val TryFindExpressionIslandInPosition : pos * ParsedInput option -> string option val TryGetCompletionContext : pos * FSharpParseFileResults option -> CompletionContext option + val GetEntityKind: pos * ParsedInput -> EntityKind option // implementation details used by other code in the compiler module internal SourceFileImpl = diff --git a/vsintegration/src/FSharp.Editor/Common/LanguageService.fs b/vsintegration/src/FSharp.Editor/Common/LanguageService.fs index 66e42536d75..61b2bff9fa8 100644 --- a/vsintegration/src/FSharp.Editor/Common/LanguageService.fs +++ b/vsintegration/src/FSharp.Editor/Common/LanguageService.fs @@ -48,7 +48,7 @@ type internal FSharpCheckerProvider ) = let checker = lazy - let checker = FSharpChecker.Create() + let checker = FSharpChecker.Create(projectCacheSize = 200, keepAssemblyContents = false, keepAllBackgroundResolutions = false) // This is one half of the bridge between the F# background builder and the Roslyn analysis engine. // When the F# background builder refreshes the background semantic build context for a file, From 21be4033d6581b5dab3707d63019cd85babf8c36 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Wed, 28 Dec 2016 13:27:38 +0300 Subject: [PATCH 07/11] try to fix tests --- src/fsharp/vs/ServiceAssemblyContent.fs | 4 +- src/fsharp/vs/ServiceParseTreeWalk.fs | 208 ++++++------------ src/fsharp/vs/ServiceUntypedParse.fs | 27 ++- .../CodeFix/AddOpenCodeFixProvider.fs | 2 +- .../Tests.LanguageService.Completion.fs | 19 +- 5 files changed, 92 insertions(+), 168 deletions(-) diff --git a/src/fsharp/vs/ServiceAssemblyContent.fs b/src/fsharp/vs/ServiceAssemblyContent.fs index 72c7be80fd4..926c78bec82 100644 --- a/src/fsharp/vs/ServiceAssemblyContent.fs +++ b/src/fsharp/vs/ServiceAssemblyContent.fs @@ -189,12 +189,12 @@ module internal Utils = |> Option.isSome [] -type LookupType = +type internal LookupType = | Fuzzy | Precise [] -type RawEntity = +type internal RawEntity = { /// Full entity name as it's seen in compiled code (raw FSharpEntity.FullName, FSharpValueOrFunction.FullName). FullName: string /// Entity name parts with removed module suffixes (Ns.M1Module.M2Module.M3.entity -> Ns.M1.M2.M3.entity) diff --git a/src/fsharp/vs/ServiceParseTreeWalk.fs b/src/fsharp/vs/ServiceParseTreeWalk.fs index 25447d00592..15fe90fec2e 100755 --- a/src/fsharp/vs/ServiceParseTreeWalk.fs +++ b/src/fsharp/vs/ServiceParseTreeWalk.fs @@ -10,6 +10,7 @@ namespace Microsoft.FSharp.Compiler.SourceCodeServices open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.Ast + /// A range of utility functions to assist with traversing an AST module internal AstTraversal = @@ -37,7 +38,6 @@ module internal AstTraversal = | MemberDefn of SynMemberDefn | MatchClause of SynMatchClause | Binding of SynBinding - | Pat of SynPat type TraversePath = TraverseStep list @@ -126,10 +126,6 @@ module internal AstTraversal = None #endif - let (|ConstructorPats|) = function - | SynConstructorArgs.Pats ps -> ps - | SynConstructorArgs.NamePatPairs(xs, _) -> List.map snd xs - /// traverse an implementation file walking all the way down to SynExpr or TypeAbbrev at a particular location /// let (*internal*) Traverse(pos:pos, parseTree, visitor:AstVisitorBase<'T>) = @@ -146,51 +142,14 @@ module internal AstTraversal = | SynModuleDecl.Types(synTypeDefnList, _range) -> synTypeDefnList |> List.map (fun x -> dive x x.Range (traverseSynTypeDefn path)) |> pick decl | SynModuleDecl.Exception(_synExceptionDefn, _range) -> None | SynModuleDecl.Open(_longIdent, _range) -> None - | SynModuleDecl.Attributes(synAttributes, _range) -> traverseAttributes synAttributes + | SynModuleDecl.Attributes(_synAttributes, _range) -> None | SynModuleDecl.HashDirective(_parsedHashDirective, _range) -> None | SynModuleDecl.NamespaceFragment(synModuleOrNamespace) -> traverseSynModuleOrNamespace path synModuleOrNamespace visitor.VisitModuleDecl(defaultTraverse, decl) - and traverseSynModuleOrNamespace path (SynModuleOrNamespace(_longIdent, _isRec, _isModule, synModuleDecls, _preXmlDoc, attributes, _synAccessOpt, range) as mors) = - traverseAttributes attributes - |> Option.orElseWith (fun _ -> - let path = TraverseStep.ModuleOrNamespace mors :: path - synModuleDecls |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path)) |> pick range mors) - - and traverseTyparDecl (SynTyparDecl.TyparDecl (attrs, _typar)) = traverseAttributes attrs - - and traverseSynPat path (synPat: SynPat) = - let path = TraverseStep.Pat synPat :: path - match synPat with - | SynPat.Tuple (pats, _) - | SynPat.ArrayOrList (_, pats, _) - | SynPat.Ands (pats, _) -> List.tryPick (traverseSynPat path) pats - | SynPat.Named (pat, _, _, _, _) -> traverseSynPat path pat - | SynPat.Typed (pat, _, _) -> traverseSynPat path pat - | SynPat.Attrib (pat, attrs, _) -> - traverseSynPat path pat |> Option.orElseWith (fun _ -> traverseAttributes attrs) - | SynPat.Or (pat1, pat2, _) -> List.tryPick (traverseSynPat path) [pat1; pat2] - | SynPat.LongIdent (_, _, typars, ConstructorPats pats, _, _) -> - typars - |> Option.bind (fun (SynValTyparDecls (typars, _, _)) -> - typars |> List.tryPick traverseTyparDecl) - |> Option.orElseWith (fun _ -> List.tryPick (traverseSynPat path) pats) - | SynPat.Paren (pat, _) -> traverseSynPat path pat - | SynPat.QuoteExpr(e, _) -> traverseSynExpr path e - | _ -> None - - and traverseSimplePat = function - | SynSimplePat.Attrib (pat, attrs, _) -> - traverseSimplePat pat - |> Option.orElseWith (fun _ -> traverseAttributes attrs) - | SynSimplePat.Typed(pat, _, _) -> - traverseSimplePat pat - | _ -> None - - and traverseSimplePats = function - | SynSimplePats.SimplePats (pats, _) -> List.tryPick traverseSimplePat pats - | SynSimplePats.Typed (pats, _, _) -> traverseSimplePats pats - + and traverseSynModuleOrNamespace path (SynModuleOrNamespace(_longIdent, _isRec, _isModule, synModuleDecls, _preXmlDoc, _synAttributes, _synAccessOpt, range) as mors) = + let path = TraverseStep.ModuleOrNamespace mors :: path + synModuleDecls |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path)) |> pick range mors and traverseSynExpr path (expr:SynExpr) = let pick = pick expr.Range let defaultTraverse e = @@ -326,11 +285,10 @@ module internal AstTraversal = dive synExpr2 synExpr2.Range traverseSynExpr dive synExpr3 synExpr3.Range traverseSynExpr] |> pick expr - | SynExpr.ForEach(_sequencePointInfoForForLoop, _seqExprOnly, _isFromSource, synPat, synExpr, synExpr2, _range) -> + | SynExpr.ForEach(_sequencePointInfoForForLoop, _seqExprOnly, _isFromSource, _synPat, synExpr, synExpr2, _range) -> [dive synExpr synExpr.Range traverseSynExpr dive synExpr2 synExpr2.Range traverseSynExpr] |> pick expr - |> Option.orElseWith (fun _ -> traverseSynPat path synPat) | SynExpr.ArrayOrListOfSeqExpr(_, synExpr, _range) -> traverseSynExpr synExpr | SynExpr.CompExpr(_, _, synExpr, _range) -> // now parser treats this syntactic expression as computation expression @@ -349,9 +307,7 @@ module internal AstTraversal = if ok.IsSome then ok else traverseSynExpr synExpr - | SynExpr.Lambda(_, _, synSimplePats, synExpr, _range) -> - traverseSynExpr synExpr - |> Option.orElseWith (fun _ -> traverseSimplePats synSimplePats) + | SynExpr.Lambda(_, _, _synSimplePats, synExpr, _range) -> traverseSynExpr synExpr | SynExpr.MatchLambda(_isExnMatch,_argm,synMatchClauseList,_spBind,_wholem) -> synMatchClauseList |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) @@ -442,11 +398,10 @@ module internal AstTraversal = | SynExpr.ImplicitZero(_range) -> None | SynExpr.YieldOrReturn(_, synExpr, _range) -> traverseSynExpr synExpr | SynExpr.YieldOrReturnFrom(_, synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.LetOrUseBang(_sequencePointInfoForBinding, _, _, synPat, synExpr, synExpr2, _range) -> + | SynExpr.LetOrUseBang(_sequencePointInfoForBinding, _, _, _synPat, synExpr, synExpr2, _range) -> [dive synExpr synExpr.Range traverseSynExpr dive synExpr2 synExpr2.Range traverseSynExpr] |> pick expr - |> Option.orElseWith (fun _ -> traverseSynPat path synPat) | SynExpr.DoBang(synExpr, _range) -> traverseSynExpr synExpr | SynExpr.LibraryOnlyILAssembly _ -> None | SynExpr.LibraryOnlyStaticOptimization _ -> None @@ -460,59 +415,46 @@ module internal AstTraversal = and normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path traverseInherit (synMemberDefns:SynMemberDefns) = synMemberDefns - // property getters are setters are two members that can have the same range, so do some somersaults to deal with this - |> Seq.groupBy getSynMemberRangeWithAttributes - |> Seq.choose (fun (range, mems) -> - match mems |> Seq.toList with - | [mem] -> // the typical case, a single member has this range 'range' - Some (dive mem range (traverseSynMemberDefn path traverseInherit)) - | [SynMemberDefn.Member(memberDefn=Binding(headPat=SynPat.LongIdent(lid1,Some(info1),_,_,_,_))) as mem1 - SynMemberDefn.Member(memberDefn=Binding(headPat=SynPat.LongIdent(lid2,Some(info2),_,_,_,_))) as mem2] -> // can happen if one is a getter and one is a setter - // ensure same long id - assert((lid1.Lid,lid2.Lid) ||> List.forall2 (fun x y -> x.idText = y.idText)) - // ensure one is getter, other is setter - assert((info1.idText="set" && info2.idText="get") || (info2.idText="set" && info1.idText="get")) - Some( - range, (fun() -> - // both mem1 and mem2 have same range, would violate dive-and-pick assertions, so just try the first one, else try the second one: - match traverseSynMemberDefn path (fun _ -> None) mem1 with - | Some _ as x -> x - | _ -> traverseSynMemberDefn path (fun _ -> None) mem2 ) - ) - | [] -> + // property getters are setters are two members that can have the same range, so do some somersaults to deal with this + |> Seq.groupBy (fun x -> x.Range) + |> Seq.choose (fun (r, mems) -> + match mems |> Seq.toList with + | [mem] -> // the typical case, a single member has this range 'r' + Some (dive mem r (traverseSynMemberDefn path traverseInherit)) + | [SynMemberDefn.Member(Binding(_,_,_,_,_,_,_,SynPat.LongIdent(lid1,Some(info1),_,_,_,_),_,_,_,_),_) as mem1 + SynMemberDefn.Member(Binding(_,_,_,_,_,_,_,SynPat.LongIdent(lid2,Some(info2),_,_,_,_),_,_,_,_),_) as mem2] -> // can happen if one is a getter and one is a setter + // ensure same long id + assert( (lid1.Lid,lid2.Lid) ||> List.forall2 (fun x y -> x.idText = y.idText) ) + // ensure one is getter, other is setter + assert( (info1.idText="set" && info2.idText="get") || + (info2.idText="set" && info1.idText="get") ) + Some ( + r,(fun() -> + // both mem1 and mem2 have same range, would violate dive-and-pick assertions, so just try the first one, else try the second one: + match traverseSynMemberDefn path (fun _ -> None) mem1 with + | Some _ as x -> x + | _ -> traverseSynMemberDefn path (fun _ -> None) mem2 ) + ) + | [] -> #if DEBUG - assert(false) - failwith "impossible, Seq.groupBy never returns empty results" + assert(false) + failwith "impossible, Seq.groupBy never returns empty results" #else - // swallow AST error and recover silently - None + // swallow AST error and recover silently + None #endif - | _ -> + | _ -> #if DEBUG - assert(false) // more than 2 members claim to have the same range, this indicates a bug in the AST - failwith "bug in AST" + assert(false) // more than 2 members claim to have the same range, this indicates a bug in the AST + failwith "bug in AST" #else - // swallow AST error and recover silently - None + // swallow AST error and recover silently + None #endif - ) - - and traverseField (SynField.Field(attrs=attrs)) = traverseAttributes attrs - - and traverseEnumCase (EnumCase(attrs=attrs)) = traverseAttributes attrs - - and traverseUnionCaseType = function - | SynUnionCaseType.UnionCaseFields fields -> List.tryPick traverseField fields - | SynUnionCaseType.UnionCaseFullType _ -> None - - and traverseUnionCase (UnionCase(attrs, _, t, _, _, _)) = - traverseAttributes attrs |> Option.orElse (traverseUnionCaseType t) - - and traverseAttributes (attributes: SynAttributes) : 'T option = attributes |> List.tryPick visitor.VisitAttribute + ) and traverseSynTypeDefn path (SynTypeDefn.TypeDefn(synComponentInfo, synTypeDefnRepr, synMemberDefns, tRange) as tydef) = let path = TraverseStep.TypeDefn tydef :: path - let (SynComponentInfo.ComponentInfo(attribs = attribs)) = synComponentInfo [ match synTypeDefnRepr with | SynTypeDefnRepr.Exception _ -> @@ -528,26 +470,19 @@ module internal AstTraversal = match synTypeDefnSimpleRepr with | SynTypeDefnSimpleRepr.TypeAbbrev(_,synType,m) -> yield dive synTypeDefnRepr synTypeDefnRepr.Range (fun _ -> visitor.VisitTypeAbbrev(synType,m)) - | SynTypeDefnSimpleRepr.Enum (cases, r) -> yield r, fun _ -> List.tryPick traverseEnumCase cases - | SynTypeDefnSimpleRepr.Union(_, cases, r) -> yield r, fun _ -> List.tryPick traverseUnionCase cases - | SynTypeDefnSimpleRepr.Record(_, fields, r) -> yield r, fun _ -> List.tryPick traverseField fields - | SynTypeDefnSimpleRepr.Exception (SynExceptionDefnRepr(attribs, unionCase, _, _, _, r)) -> - yield r, (fun _ -> traverseAttributes attribs |> Option.orElseWith (fun _ -> traverseUnionCase unionCase)) - | _ -> () - + | _ -> + () // enums/DUs/record definitions don't have any SynExprs inside them yield! synMemberDefns |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None) - ] - |> pick tRange tydef - |> Option.orElseWith (fun _ -> traverseAttributes attribs) + ] |> pick tRange tydef and traverseSynMemberDefn path traverseInherit (m:SynMemberDefn) = let pick (debugObj:obj) = pick m.Range debugObj let path = TraverseStep.MemberDefn m :: path match m with - | SynMemberDefn.Open _ -> None - | SynMemberDefn.Member(synBinding, _) -> traverseSynBinding path synBinding - | SynMemberDefn.ImplicitCtor(attributes=attributes) -> traverseAttributes attributes - | SynMemberDefn.ImplicitInherit(synType, synExpr, _, range) -> + | SynMemberDefn.Open(_longIdent, _range) -> None + | SynMemberDefn.Member(synBinding, _range) -> traverseSynBinding path synBinding + | SynMemberDefn.ImplicitCtor(_synAccessOption, _synAttributes, _synSimplePatList, _identOption, _range) -> None + | SynMemberDefn.ImplicitInherit(synType, synExpr, _identOption, range) -> [ dive () synType.Range (fun () -> match traverseInherit (synType, range) with @@ -557,54 +492,38 @@ module internal AstTraversal = visitor.VisitImplicitInherit(traverseSynExpr path, synType, synExpr, range) ) ] |> pick m - | SynMemberDefn.AutoProperty(attribs=attribs; synExpr=synExpr) -> - traverseSynExpr path synExpr |> Option.orElseWith (fun _ -> traverseAttributes attribs) - | SynMemberDefn.LetBindings(synBindingList, _, _, _) -> - synBindingList |> List.map (fun x -> dive x x.RangeOfBindingAndRhs (traverseSynBinding path)) |> pick m - | SynMemberDefn.AbstractSlot _ -> None - | SynMemberDefn.Interface(synType, synMemberDefnsOption, _) -> + | SynMemberDefn.AutoProperty(_attribs, _isStatic, _id, _tyOpt, _propKind, _, _xmlDoc, _access, synExpr, _, _) -> traverseSynExpr path synExpr + | SynMemberDefn.LetBindings(synBindingList, _, _, _range) -> synBindingList |> List.map (fun x -> dive x x.RangeOfBindingAndRhs (traverseSynBinding path)) |> pick m + | SynMemberDefn.AbstractSlot(_synValSig, _memberFlags, _range) -> None + | SynMemberDefn.Interface(synType, synMemberDefnsOption, _range) -> match visitor.VisitInterfaceSynMemberDefnType(synType) with | None -> match synMemberDefnsOption with | None -> None | Some(x) -> [ yield! x |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None) ] |> pick x | ok -> ok - | SynMemberDefn.Inherit(synType, _, range) -> traverseInherit (synType, range) - | SynMemberDefn.ValField(field, _) -> traverseField field - | SynMemberDefn.NestedType(typeDefn=typeDefn) -> traverseSynTypeDefn path typeDefn - - and getSynMemberRangeWithAttributes synMember = - let unionRanges (attrs: SynAttributes) = attrs |> List.map (fun x -> x.Range) |> List.fold Range.unionRanges synMember.Range - match synMember with - | SynMemberDefn.Member(SynBinding.Binding(attrs=attrs), _) -> unionRanges attrs - | SynMemberDefn.ImplicitCtor(attributes=attrs) -> unionRanges attrs - | SynMemberDefn.AutoProperty(attribs=attrs) -> unionRanges attrs - | SynMemberDefn.ValField(SynField.Field(attrs=attrs), _) -> unionRanges attrs - | _ -> synMember.Range + | SynMemberDefn.Inherit(synType, _identOption, range) -> traverseInherit (synType, range) + | SynMemberDefn.ValField(_synField, _range) -> None + | SynMemberDefn.NestedType(synTypeDefn, _synAccessOption, _range) -> traverseSynTypeDefn path synTypeDefn and traverseSynMatchClause path mc = let path = TraverseStep.MatchClause mc :: path let defaultTraverse mc = match mc with - | (SynMatchClause.Clause(synPat, synExprOption, synExpr, _range, _sequencePointInfoForTarget) as all) -> - traverseSynPat path synPat - |> Option.orElseWith (fun _ -> - [ - match synExprOption with - | None -> () - | Some guard -> yield guard - yield synExpr - ] |> List.map (fun x -> dive x x.Range (traverseSynExpr path)) |> pick all.Range all) + | (SynMatchClause.Clause(_synPat, synExprOption, synExpr, _range, _sequencePointInfoForTarget) as all) -> + [ + match synExprOption with + | None -> () + | Some guard -> yield guard + yield synExpr + ] |> List.map (fun x -> dive x x.Range (traverseSynExpr path)) |> pick all.Range all visitor.VisitMatchClause(defaultTraverse,mc) - and traverseSynBinding path b = let defaultTraverse b = let path = TraverseStep.Binding b :: path match b with - | SynBinding.Binding(attrs=attrs; headPat=synPat; expr=synExpr) -> - traverseAttributes attrs - |> Option.orElseWith (fun _ -> traverseSynPat path synPat) - |> Option.orElseWith (fun _ -> traverseSynExpr path synExpr) + | (SynBinding.Binding(_synAccessOption, _synBindingKind, _, _, _synAttributes, _preXmlDoc, _synValData, _synPat, _synBindingReturnInfoOption, synExpr, _range, _sequencePointInfoForBinding)) -> + traverseSynExpr path synExpr visitor.VisitBinding(defaultTraverse,b) match parseTree with @@ -616,5 +535,4 @@ module internal AstTraversal = range0 // only used for asserting, does not matter in non-debug #endif l |> List.map (fun x -> dive x x.Range (traverseSynModuleOrNamespace [])) |> pick fileRange l - | ParsedInput.SigFile _sigFile -> None - + | ParsedInput.SigFile _sigFile -> None \ No newline at end of file diff --git a/src/fsharp/vs/ServiceUntypedParse.fs b/src/fsharp/vs/ServiceUntypedParse.fs index 6be7ada2941..fb5d956a0a1 100755 --- a/src/fsharp/vs/ServiceUntypedParse.fs +++ b/src/fsharp/vs/ServiceUntypedParse.fs @@ -361,6 +361,15 @@ type FSharpParseFileResults(errors : FSharpErrorInfo[], input : Ast.ParsedInput // This does not need to be run on the background thread scope.ValidateBreakpointLocationImpl(pos) +type ModuleKind = { IsAutoOpen: bool; HasModuleSuffix: bool } + +type EntityKind = + | Attribute + | Type + | FunctionOrValue of isActivePattern:bool + | Module of ModuleKind + override x.ToString() = sprintf "%A" x + module UntypedParseImpl = let emptyStringSet = HashSet() @@ -604,15 +613,6 @@ module UntypedParseImpl = | _ -> defaultTraverse(expr) } AstTraversal.Traverse(pos, parseTree, walker) - type ModuleKind = { IsAutoOpen: bool; HasModuleSuffix: bool } - - type EntityKind = - | Attribute - | Type - | FunctionOrValue of isActivePattern:bool - | Module of ModuleKind - override x.ToString() = sprintf "%A" x - let GetEntityKind (pos: pos, input: ParsedInput) : EntityKind option = let (|ConstructorPats|) = function | Pats ps -> ps @@ -635,8 +635,8 @@ module UntypedParseImpl = let rec walkImplFileInput (ParsedImplFileInput(_, _, _, _, _, moduleOrNamespaceList, _)) = List.tryPick (walkSynModuleOrNamespace true) moduleOrNamespaceList - and walkSynModuleOrNamespace isTopLevel (SynModuleOrNamespace(_, _, isModule, decls, _, attrs, _, r)) = - if isModule && isTopLevel then None else List.tryPick walkAttribute attrs + and walkSynModuleOrNamespace isTopLevel (SynModuleOrNamespace(_, _, _, decls, _, attrs, _, r)) = + List.tryPick walkAttribute attrs |> orElse (ifPosInRange r (fun _ -> List.tryPick (walkSynModuleDecl isTopLevel) decls)) and walkAttribute (attr: SynAttribute) = @@ -888,7 +888,10 @@ module UntypedParseImpl = match input with | ParsedInput.SigFile _ -> None - | ParsedInput.ImplFile input -> walkImplFileInput input + | ParsedInput.ImplFile input -> + let ast = sprintf "%+A" input + let _x = ast + walkImplFileInput input type internal TS = AstTraversal.TraverseStep diff --git a/vsintegration/src/FSharp.Editor/CodeFix/AddOpenCodeFixProvider.fs b/vsintegration/src/FSharp.Editor/CodeFix/AddOpenCodeFixProvider.fs index ae41ef67574..57923da0763 100644 --- a/vsintegration/src/FSharp.Editor/CodeFix/AddOpenCodeFixProvider.fs +++ b/vsintegration/src/FSharp.Editor/CodeFix/AddOpenCodeFixProvider.fs @@ -184,7 +184,7 @@ type internal FSharpAddOpenCodeFixProvider match symbol with | Some symbol -> let pos = Pos.fromZ textLinePos.Line textLinePos.Character - let isAttribute = ParsedInput.getEntityKind parsedInput pos = Some EntityKind.Attribute + let isAttribute = UntypedParseImpl.GetEntityKind(pos, parsedInput) = Some EntityKind.Attribute let entities = assemblyContentProvider.GetAllEntitiesInProjectAndReferencedAssemblies checkFileResults |> List.map (fun e -> diff --git a/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs b/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs index 2ee66700ae0..df623082458 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs @@ -183,6 +183,9 @@ type UsingMSBuild() as this = shouldNotContain member public this.AutoCompleteBug70080Helper(programText:string) = + this.AutoCompleteBug70080HelperHelper(programText, ["AttributeUsageAttribute"], []) + + member public this.AutoCompleteBug70080HelperNoSuffix(programText:string) = this.AutoCompleteBug70080HelperHelper(programText, ["AttributeUsage"], []) member private this.testAutoCompleteAdjacentToDot op = @@ -3474,7 +3477,7 @@ let x = query { for bbbb in abbbbc(*D0*) do [] member public this.``Attribute.WhenAttachedToLet.Bug70080``() = - this.AutoCompleteBug70080Helper @" + this.AutoCompleteBug70080HelperNoSuffix @" open System [] member public this.``Attribute.WhenAttachedToNothing.Bug70080``() = - this.AutoCompleteBug70080Helper @" + this.AutoCompleteBug70080HelperNoSuffix @" open System [] member public this.``Attribute.WhenAttachedToLetInNamespace.Bug70080``() = - this.AutoCompleteBug70080Helper @" + this.AutoCompleteBug70080HelperNoSuffix @" namespace Foo open System [] @@ -3514,7 +3517,7 @@ let x = query { for bbbb in abbbbc(*D0*) do this.AutoCompleteBug70080Helper @" namespace Foo open System - [] @@ -3522,7 +3525,7 @@ let x = query { for bbbb in abbbbc(*D0*) do this.AutoCompleteBug70080Helper @" namespace Foo open System - [ Date: Wed, 28 Dec 2016 21:57:33 +0300 Subject: [PATCH 08/11] fix some tests --- src/fsharp/vs/ServiceUntypedParse.fs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/fsharp/vs/ServiceUntypedParse.fs b/src/fsharp/vs/ServiceUntypedParse.fs index fb5d956a0a1..9f8bbccb972 100755 --- a/src/fsharp/vs/ServiceUntypedParse.fs +++ b/src/fsharp/vs/ServiceUntypedParse.fs @@ -705,7 +705,10 @@ module UntypedParseImpl = | SynIndexerArg.Two(e1, e2) -> List.tryPick walkExpr [e1; e2] and walkType = function - | SynType.LongIdent ident -> ifPosInRange ident.Range (fun _ -> Some EntityKind.Type) + | SynType.LongIdent ident -> + // we protect it with try..with because System.Exception : rangeOfLidwd may raise + // at Microsoft.FSharp.Compiler.Ast.LongIdentWithDots.get_Range() in D:\j\workspace\release_ci_pa---3f142ccc\src\fsharp\ast.fs:line 156 + try ifPosInRange ident.Range (fun _ -> Some EntityKind.Type) with _ -> None | SynType.App(ty, _, types, _, _, _, _) -> walkType ty |> orElse (List.tryPick walkType types) | SynType.LongIdentApp(_, _, _, types, _, _, _) -> List.tryPick walkType types From 1610e11a14786968187e695f49288cff6327bff7 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Wed, 28 Dec 2016 23:37:50 +0300 Subject: [PATCH 09/11] cut attribute prefix on editor side --- src/fsharp/vs/ServiceDeclarations.fs | 28 +++-------- src/fsharp/vs/ServiceDeclarations.fsi | 5 +- src/fsharp/vs/service.fs | 46 ++++++++----------- .../Completion/CompletionProvider.fs | 16 +++++-- vsintegration/tests/Salsa/SalsaUtils.fs | 2 +- .../Tests.LanguageService.Completion.fs | 13 ++---- 6 files changed, 47 insertions(+), 63 deletions(-) diff --git a/src/fsharp/vs/ServiceDeclarations.fs b/src/fsharp/vs/ServiceDeclarations.fs index 2875857d193..0518dedfc1f 100644 --- a/src/fsharp/vs/ServiceDeclarations.fs +++ b/src/fsharp/vs/ServiceDeclarations.fs @@ -1263,7 +1263,7 @@ module internal ItemDescriptionsImpl = /// An intellisense declaration [] -type FSharpDeclarationListItem(name, glyphMajor:GlyphMajor, glyphMinor:GlyphMinor, info) = +type FSharpDeclarationListItem(name: string, glyphMajor: GlyphMajor, glyphMinor: GlyphMinor, info, isAttribute: bool) = let mutable descriptionTextHolder:FSharpToolTipText option = None let mutable task = null @@ -1311,16 +1311,15 @@ type FSharpDeclarationListItem(name, glyphMajor:GlyphMajor, glyphMinor:GlyphMino member decl.Glyph = 6 * int glyphMajor + int glyphMinor member decl.GlyphMajor = glyphMajor member decl.GlyphMinor = glyphMinor + member decl.IsAttribute = isAttribute /// A table of declarations for Intellisense completion [] type FSharpDeclarationListInfo(declarations: FSharpDeclarationListItem[]) = - static let attributeSuffixLength = "Attribute".Length - member self.Items = declarations // Make a 'Declarations' object for a set of selected items - static member Create(infoReader:InfoReader, m, denv, items, reactor, checkAlive, atAttributeApplication) = + static member Create(infoReader:InfoReader, m, denv, items, reactor, checkAlive) = let g = infoReader.g let items = items |> RemoveExplicitlySuppressed g @@ -1371,26 +1370,11 @@ type FSharpDeclarationListInfo(declarations: FSharpDeclarationListItem[]) = | [] -> failwith "Unexpected empty bag" | items -> let glyphMajor, glyphMinor = GlyphOfItem(denv,items.Head) - (* If: - * we at an attribute application position - * the completion item is an attribute type - * the item name has "Attribute" sufix (yes, it's possible to define a System.Attribute derivative that has no this suffix) - then remove "Attribute" suffix from its name. - *) - let nm = - if atAttributeApplication - && IsAttribute infoReader items.Head - && nm.EndsWith "Attribute" - then nm.[0..nm.Length-attributeSuffixLength-1] - else nm - - new FSharpDeclarationListItem(nm, glyphMajor, glyphMinor, Choice1Of2 (items, infoReader, m, denv, reactor, checkAlive))) + new FSharpDeclarationListItem(nm, glyphMajor, glyphMinor, Choice1Of2 (items, infoReader, m, denv, reactor, checkAlive), IsAttribute infoReader items.Head)) new FSharpDeclarationListInfo(Array.ofList decls) - static member Error msg = new FSharpDeclarationListInfo( - [| new FSharpDeclarationListItem("", GlyphMajor.Error, GlyphMinor.Normal, Choice2Of2 (FSharpToolTipText [FSharpToolTipElement.CompositionError msg])) |] ) - static member Empty = new FSharpDeclarationListInfo([| |]) - + [| new FSharpDeclarationListItem("", GlyphMajor.Error, GlyphMinor.Normal, Choice2Of2 (FSharpToolTipText [FSharpToolTipElement.CompositionError msg]), false) |] ) + static member Empty = FSharpDeclarationListInfo([| |]) \ No newline at end of file diff --git a/src/fsharp/vs/ServiceDeclarations.fsi b/src/fsharp/vs/ServiceDeclarations.fsi index de940dd2e47..d32cad3d241 100755 --- a/src/fsharp/vs/ServiceDeclarations.fsi +++ b/src/fsharp/vs/ServiceDeclarations.fsi @@ -69,7 +69,8 @@ type internal FSharpDeclarationListItem = member Glyph : int member GlyphMajor : ItemDescriptionIcons.GlyphMajor member GlyphMinor : ItemDescriptionIcons.GlyphMinor - + member IsAttribute : bool + [] /// Represents a set of declarations in F# source code, with information attached ready for display by an editor. /// Returned by GetDeclarations. @@ -79,7 +80,7 @@ type internal FSharpDeclarationListInfo = member Items : FSharpDeclarationListItem[] // Implementation details used by other code in the compiler - static member internal Create : infoReader:InfoReader * m:range * denv:DisplayEnv * items:Item list * reactor:IReactorOperations * checkAlive:(unit -> bool) * isAttributes:bool -> FSharpDeclarationListInfo + static member internal Create : infoReader:InfoReader * m:range * denv:DisplayEnv * items:Item list * reactor:IReactorOperations * checkAlive:(unit -> bool) -> FSharpDeclarationListInfo static member internal Error : message:string -> FSharpDeclarationListInfo static member Empty : FSharpDeclarationListInfo diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index 489b569eb94..83fbc37a656 100755 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -1002,23 +1002,20 @@ type TypeCheckInfo | Some (CompletionContext.Inherit(InheritanceContext.Class, (plid, _))) -> GetEnvironmentLookupResolutions(mkPos line loc, plid, filterCtors, false) |> FilterRelevantItemsBy None GetBaseClassCandidates - |> Option.map (fun x -> x, false) // Completion at 'interface ..." | Some (CompletionContext.Inherit(InheritanceContext.Interface, (plid, _))) -> GetEnvironmentLookupResolutions(mkPos line loc, plid, filterCtors, false) |> FilterRelevantItemsBy None GetInterfaceCandidates - |> Option.map (fun x -> x, false) // Completion at 'implement ..." | Some (CompletionContext.Inherit(InheritanceContext.Unknown, (plid, _))) -> GetEnvironmentLookupResolutions(mkPos line loc, plid, filterCtors, false) |> FilterRelevantItemsBy None (fun t -> GetBaseClassCandidates t || GetInterfaceCandidates t) - |> Option.map (fun x -> x, false) // Completion at ' { XXX = ... } " | Some(CompletionContext.RecordField(RecordContext.New(plid, residue))) -> - Some(GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, plid, residue), false) + Some(GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, plid, residue)) // Completion at ' { XXX = ... with ... } " | Some(CompletionContext.RecordField(RecordContext.CopyOnUpdate(r, (plid, residue)))) -> @@ -1027,11 +1024,10 @@ type TypeCheckInfo GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, plid, residue) |> Some | x -> x - |> Option.map (fun x -> x, false) // Completion at ' { XXX = ... with ... } " | Some(CompletionContext.RecordField(RecordContext.Constructor(typeName))) -> - Some(GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, [typeName], None), false) + Some(GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, [typeName], None)) // Completion at ' SomeMethod( ... ) ' with named arguments | Some(CompletionContext.ParameterList (endPos, fields)) -> @@ -1050,22 +1046,20 @@ type TypeCheckInfo | None -> Some (items, denv, m) | Some (declItems, declaredDisplayEnv, declaredRange) -> Some (filtered @ declItems, declaredDisplayEnv, declaredRange) | _ -> declaredItems - |> Option.map (fun x -> x, false) | Some(CompletionContext.AttributeApplication) -> GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, line, loc, filterCtors, resolveOverloads, hasTextChangedSinceLastTypecheck, false) |> Option.map (fun (items, denv, r) -> - (items - |> List.filter (function - | Item.Types _ - | Item.ModuleOrNamespaces _ -> true - | _ -> false), denv, r), true) + items + |> List.filter (function + | Item.Types _ + | Item.ModuleOrNamespaces _ -> true + | _ -> false), denv, r) // Other completions | cc -> let isInRangeOperator = (match cc with Some (CompletionContext.RangeOperator) -> true | _ -> false) - let declaredItems = GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, line, loc, filterCtors,resolveOverloads, hasTextChangedSinceLastTypecheck, isInRangeOperator) - declaredItems |> Option.map (fun x -> x, false) + GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, line, loc, filterCtors,resolveOverloads, hasTextChangedSinceLastTypecheck, isInRangeOperator) /// Return 'false' if this is not a completion item valid in an interface file. let IsValidSignatureFileItem item = @@ -1147,10 +1141,10 @@ type TypeCheckInfo (fun () -> match GetDeclItemsForNamesAtPosition(parseResultsOpt, Some qualifyingNames, Some partialName, line, lineStr, colAtEndOfNamesAndResidue, ResolveTypeNamesToCtors, ResolveOverloads.Yes, hasTextChangedSinceLastTypecheck) with | None -> FSharpDeclarationListInfo.Empty - | Some((items,denv,m), atAttributeApplication) -> + | Some (items, denv, m) -> let items = items |> FilterAutoCompletesBasedOnParseContext parseResultsOpt (mkPos line colAtEndOfNamesAndResidue) let items = if isInterfaceFile then items |> List.filter IsValidSignatureFileItem else items - FSharpDeclarationListInfo.Create(infoReader,m,denv,items,reactorOps,checkAlive,atAttributeApplication)) + FSharpDeclarationListInfo.Create(infoReader,m,denv,items,reactorOps,checkAlive)) (fun msg -> FSharpDeclarationListInfo.Error msg) /// Get the symbols for auto-complete items at a location @@ -1161,7 +1155,7 @@ type TypeCheckInfo (fun () -> match GetDeclItemsForNamesAtPosition(parseResultsOpt, Some qualifyingNames, Some partialName, line, lineStr, colAtEndOfNamesAndResidue, ResolveTypeNamesToCtors, ResolveOverloads.Yes, hasTextChangedSinceLastTypecheck) with | None -> List.Empty - | Some((items,_denv,_m),_) -> + | Some (items, _denv, _m) -> let items = items |> FilterAutoCompletesBasedOnParseContext parseResultsOpt (mkPos line colAtEndOfNamesAndResidue) let items = if isInterfaceFile then items |> List.filter IsValidSignatureFileItem else items @@ -1263,7 +1257,7 @@ type TypeCheckInfo (fun () -> match GetDeclItemsForNamesAtPosition(None,Some(names),None,line,lineStr,colAtEndOfNames,ResolveTypeNamesToCtors,ResolveOverloads.Yes,fun _ -> false) with | None -> FSharpToolTipText [] - | Some((items,denv,m),_) -> + | Some (items, denv, m) -> FSharpToolTipText(items |> List.map (FormatDescriptionOfItem false infoReader m denv ))) (fun err -> FSharpToolTipText [FSharpToolTipElement.CompositionError err]) @@ -1282,7 +1276,7 @@ type TypeCheckInfo (fun () -> match GetDeclItemsForNamesAtPosition(None, Some names, None, line, lineStr, colAtEndOfNames, ResolveTypeNamesToCtors, ResolveOverloads.No, fun _ -> false) with // F1 Keywords do not distiguish between overloads | None -> None - | Some((items,_,_),_) -> + | Some (items, _, _) -> match items with | [] -> None | [item] -> @@ -1313,14 +1307,14 @@ type TypeCheckInfo (fun () -> match GetDeclItemsForNamesAtPosition(None,namesOpt,None,line,lineStr,colAtEndOfNames,ResolveTypeNamesToCtors,ResolveOverloads.No, fun _ -> false) with | None -> FSharpMethodGroup("",[| |]) - | Some((items,denv,m),_) -> FSharpMethodGroup.Create(infoReader,m,denv,items)) + | Some (items, denv, m) -> FSharpMethodGroup.Create(infoReader,m,denv,items)) (fun msg -> FSharpMethodGroup(msg,[| |])) member scope.GetMethodsAsSymbols (line, lineStr, colAtEndOfNames, names) = match GetDeclItemsForNamesAtPosition (None,Some(names), None, line, lineStr, colAtEndOfNames, ResolveTypeNamesToCtors, ResolveOverloads.No, fun _ -> false) with - | None | Some (([], _, _), _) -> None - | Some ((items, denv, m),_) -> + | None | Some ([], _, _) -> None + | Some (items, denv, m) -> let allItems = items |> List.collect (fun item -> @@ -1353,8 +1347,8 @@ type TypeCheckInfo member scope.GetDeclarationLocation (line, lineStr, colAtEndOfNames, names, preferFlag) = match GetDeclItemsForNamesAtPosition (None,Some(names), None, line, lineStr, colAtEndOfNames, ResolveTypeNamesToCtors,ResolveOverloads.Yes, fun _ -> false) with | None - | Some (([], _, _), _) -> FSharpFindDeclResult.DeclNotFound FSharpFindDeclFailureReason.Unknown - | Some ((item :: _ , _, _), _) -> + | Some ([], _, _) -> FSharpFindDeclResult.DeclNotFound FSharpFindDeclFailureReason.Unknown + | Some (item :: _ , _, _) -> // For IL-based entities, switch to a different item. This is because // rangeOfItem, ccuOfItem don't work on IL methods or fields. @@ -1394,8 +1388,8 @@ type TypeCheckInfo member scope.GetSymbolUseAtLocation (line, lineStr, colAtEndOfNames, names) = match GetDeclItemsForNamesAtPosition (None,Some(names), None, line, lineStr, colAtEndOfNames, ResolveTypeNamesToCtors, ResolveOverloads.Yes, fun _ -> false) with - | None | Some (([], _, _), _) -> None - | Some ((item :: _ , denv, m), _) -> + | None | Some ([], _, _) -> None + | Some (item :: _ , denv, m) -> let symbol = FSharpSymbol.Create(g, thisCcu, tcImports, item) Some (symbol, denv, m) diff --git a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs index 4f2e8872589..5137226cafa 100644 --- a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs +++ b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs @@ -49,7 +49,8 @@ type internal FSharpCompletionProvider let xmlMemberIndexService = serviceProvider.GetService(typeof) :?> IVsXMLMemberIndexService let documentationBuilder = XmlDocumentation.CreateDocumentationBuilder(xmlMemberIndexService, serviceProvider.DTE) - + static let attributeSuffixLength = "Attribute".Length + static member ShouldTriggerCompletionAux(sourceText: SourceText, caretPosition: int, trigger: CompletionTriggerKind, getInfo: (unit -> DocumentId * string * string list)) = // Skip if we are at the start of a document if caretPosition = 0 then @@ -95,10 +96,12 @@ type internal FSharpCompletionProvider match parseResults.ParseTree, checkFileAnswer with | _, FSharpCheckFileAnswer.Aborted | None, _ -> return List() - | Some(_), FSharpCheckFileAnswer.Succeeded(checkFileResults) -> + | Some parsedInput, FSharpCheckFileAnswer.Succeeded(checkFileResults) -> let textLines = sourceText.Lines - let caretLine = textLines.GetLineFromPosition(caretPosition) let caretLinePos = textLines.GetLinePosition(caretPosition) + let entityKind = UntypedParseImpl.GetEntityKind(Pos.fromZ caretLinePos.Line caretLinePos.Character, parsedInput) + + let caretLine = textLines.GetLineFromPosition(caretPosition) let fcsCaretLineNumber = Line.fromZ caretLinePos.Line // Roslyn line numbers are zero-based, FSharp.Compiler.Service line numbers are 1-based let caretLineColumn = caretLinePos.Character @@ -109,7 +112,12 @@ type internal FSharpCompletionProvider for declarationItem in declarations.Items do let glyph = CommonRoslynHelpers.FSharpGlyphToRoslynGlyph declarationItem.GlyphMajor - let completionItem = CommonCompletionItem.Create(declarationItem.Name, glyph=Nullable(glyph)) + let name = + match entityKind with + | Some EntityKind.Attribute when declarationItem.IsAttribute && declarationItem.Name.EndsWith "Attribute" -> + declarationItem.Name.[0..declarationItem.Name.Length - attributeSuffixLength - 1] + | _ -> declarationItem.Name + let completionItem = CommonCompletionItem.Create(name, glyph = Nullable glyph) declarationItemsCache.Remove(completionItem.DisplayText) |> ignore // clear out stale entries if they exist declarationItemsCache.Add(completionItem.DisplayText, declarationItem) results.Add(completionItem) diff --git a/vsintegration/tests/Salsa/SalsaUtils.fs b/vsintegration/tests/Salsa/SalsaUtils.fs index 54c1dae5583..a776fb0dc9b 100644 --- a/vsintegration/tests/Salsa/SalsaUtils.fs +++ b/vsintegration/tests/Salsa/SalsaUtils.fs @@ -220,7 +220,7 @@ module internal VsOpsUtils = printfn "Failed to find expected value %s in " membername let MAX = 25 printfn "Completion list = %s" (if completions.Length > MAX then sprintf "%A ... and more" completions.[0..MAX] else sprintf "%A" completions) - Assert.Fail(sprintf "Couldn't find '%s' in completion list" membername) + Assert.Fail(sprintf "Couldn't find '%s' in completion list: %+A" membername (completions |> Array.map (fun (name,_,_,_) -> name))) /// Verify the completion list does not contain a member with the given name let AssertCompListDoesNotContain(completions : CompletionItem[], membername) = diff --git a/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs b/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs index df623082458..1a9df4cf1d8 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs @@ -185,9 +185,6 @@ type UsingMSBuild() as this = member public this.AutoCompleteBug70080Helper(programText:string) = this.AutoCompleteBug70080HelperHelper(programText, ["AttributeUsageAttribute"], []) - member public this.AutoCompleteBug70080HelperNoSuffix(programText:string) = - this.AutoCompleteBug70080HelperHelper(programText, ["AttributeUsage"], []) - member private this.testAutoCompleteAdjacentToDot op = let text = sprintf "System.Console%s" op // First, test that pressing dot works. @@ -3477,7 +3474,7 @@ let x = query { for bbbb in abbbbc(*D0*) do [] member public this.``Attribute.WhenAttachedToLet.Bug70080``() = - this.AutoCompleteBug70080HelperNoSuffix @" + this.AutoCompleteBug70080Helper @" open System [] member public this.``Attribute.WhenAttachedToNothing.Bug70080``() = - this.AutoCompleteBug70080HelperNoSuffix @" + this.AutoCompleteBug70080Helper @" open System - [] member public this.``Attribute.WhenAttachedToLetInNamespace.Bug70080``() = - this.AutoCompleteBug70080HelperNoSuffix @" + this.AutoCompleteBug70080Helper @" namespace Foo open System - [] From 6feb8a623b657b392d0316848967c82bdaf092de Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Thu, 29 Dec 2016 12:02:44 +0300 Subject: [PATCH 10/11] fixed: IsAttribute can throw exceptions which results with empty completion list --- src/fsharp/vs/ServiceDeclarations.fs | 16 +++++++++------- src/fsharp/vs/ServiceUntypedParse.fs | 5 +---- 2 files changed, 10 insertions(+), 11 deletions(-) diff --git a/src/fsharp/vs/ServiceDeclarations.fs b/src/fsharp/vs/ServiceDeclarations.fs index 0518dedfc1f..2b02dbe40a6 100644 --- a/src/fsharp/vs/ServiceDeclarations.fs +++ b/src/fsharp/vs/ServiceDeclarations.fs @@ -706,13 +706,15 @@ module internal ItemDescriptionsImpl = GetXmlCommentForItemAux None infoReader m d let IsAttribute (infoReader: InfoReader) d = - let g = infoReader.g - let amap = infoReader.amap - match d with - | Item.Types(_,((TType_app(tcref,_)):: _)) -> - let ty = generalizedTyconRef tcref - Infos.ExistsHeadTypeInEntireHierarchy g amap range0 ty g.tcref_System_Attribute - | _ -> false + try + let g = infoReader.g + let amap = infoReader.amap + match d with + | Item.Types(_,((TType_app(tcref,_)):: _)) -> + let ty = generalizedTyconRef tcref + Infos.ExistsHeadTypeInEntireHierarchy g amap range0 ty g.tcref_System_Attribute + | _ -> false + with _ -> false /// Output a the description of a language item let rec FormatItemDescriptionToToolTipElement isDecl (infoReader:InfoReader) m denv d = diff --git a/src/fsharp/vs/ServiceUntypedParse.fs b/src/fsharp/vs/ServiceUntypedParse.fs index 9f8bbccb972..07b14db3b0b 100755 --- a/src/fsharp/vs/ServiceUntypedParse.fs +++ b/src/fsharp/vs/ServiceUntypedParse.fs @@ -891,10 +891,7 @@ module UntypedParseImpl = match input with | ParsedInput.SigFile _ -> None - | ParsedInput.ImplFile input -> - let ast = sprintf "%+A" input - let _x = ast - walkImplFileInput input + | ParsedInput.ImplFile input -> walkImplFileInput input type internal TS = AstTraversal.TraverseStep From 09f42ff936c9051605bf0633e3928d24b86f9175 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Thu, 29 Dec 2016 21:01:02 +0300 Subject: [PATCH 11/11] fix tests --- .../tests/unittests/Tests.LanguageService.Completion.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs b/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs index 1a9df4cf1d8..20d65e140d2 100644 --- a/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs +++ b/vsintegration/tests/unittests/Tests.LanguageService.Completion.fs @@ -6063,7 +6063,7 @@ let rec f l = type TestAttribute() = member x.print() = "print" """, marker = "(*Mattribute*)", - list = ["Int32";"Obsolete"]) + list = ["Int32";"ObsoleteAttribute"]) [] member this.``ImportStatment.System.ImportDirectly``() =