diff --git a/src/Compiler/Service/ExternalSymbol.fs b/src/Compiler/Service/ExternalSymbol.fs index f91a586cd488..0111eb5731af 100644 --- a/src/Compiler/Service/ExternalSymbol.fs +++ b/src/Compiler/Service/ExternalSymbol.fs @@ -9,13 +9,13 @@ open System.Diagnostics module Option = - let ofOptionList (xs : 'a option list) : 'a list option = + let ofOptionList (xs: 'a option list) : 'a list option = if xs |> List.forall Option.isSome then xs |> List.map Option.get |> Some else None - + /// Represents a type in an external (non F#) assembly. [] type FindDeclExternalType = @@ -36,36 +36,29 @@ type FindDeclExternalType = | Type (name, genericArgs) -> match genericArgs with | [] -> "" - | args -> - args - |> List.map (sprintf "%O") - |> String.concat ", " - |> sprintf "<%s>" + | args -> args |> List.map (sprintf "%O") |> String.concat ", " |> sprintf "<%s>" |> sprintf "%s%s" name | Array inner -> sprintf "%O[]" inner | Pointer inner -> sprintf "&%O" inner | TypeVar name -> sprintf "'%s" name - + module FindDeclExternalType = let rec tryOfILType (typeVarNames: string array) (ilType: ILType) = - + match ilType with - | ILType.Array (_, inner) -> - tryOfILType typeVarNames inner |> Option.map FindDeclExternalType.Array + | ILType.Array (_, inner) -> tryOfILType typeVarNames inner |> Option.map FindDeclExternalType.Array | ILType.Boxed tyspec | ILType.Value tyspec -> tyspec.GenericArgs |> List.map (tryOfILType typeVarNames) |> Option.ofOptionList - |> Option.map (fun genericArgs -> FindDeclExternalType.Type (tyspec.FullName, genericArgs)) - | ILType.Ptr inner -> - tryOfILType typeVarNames inner |> Option.map FindDeclExternalType.Pointer + |> Option.map (fun genericArgs -> FindDeclExternalType.Type(tyspec.FullName, genericArgs)) + | ILType.Ptr inner -> tryOfILType typeVarNames inner |> Option.map FindDeclExternalType.Pointer | ILType.TypeVar ordinal -> typeVarNames |> Array.tryItem (int ordinal) |> Option.map (fun typeVarName -> FindDeclExternalType.TypeVar typeVarName) - | _ -> - None + | _ -> None [] type FindDeclExternalParam = @@ -74,27 +67,37 @@ type FindDeclExternalParam = | Byref of parameterType: FindDeclExternalType - member c.IsByRef = match c with Byref _ -> true | _ -> false + member c.IsByRef = + match c with + | Byref _ -> true + | _ -> false - member c.ParameterType = match c with Byref ty -> ty | Param ty -> ty + member c.ParameterType = + match c with + | Byref ty -> ty + | Param ty -> ty - static member Create(parameterType, isByRef) = + static member Create(parameterType, isByRef) = if isByRef then Byref parameterType else Param parameterType - override this.ToString () = + override this.ToString() = match this with | Param t -> t.ToString() | Byref t -> sprintf "ref %O" t module FindDeclExternalParam = - let tryOfILType (typeVarNames : string array) = + let tryOfILType (typeVarNames: string array) = function - | ILType.Byref inner -> FindDeclExternalType.tryOfILType typeVarNames inner |> Option.map FindDeclExternalParam.Byref - | ilType -> FindDeclExternalType.tryOfILType typeVarNames ilType |> Option.map FindDeclExternalParam.Param + | ILType.Byref inner -> + FindDeclExternalType.tryOfILType typeVarNames inner + |> Option.map FindDeclExternalParam.Byref + | ilType -> + FindDeclExternalType.tryOfILType typeVarNames ilType + |> Option.map FindDeclExternalParam.Param let tryOfILTypes typeVarNames ilTypes = ilTypes |> List.map (tryOfILType typeVarNames) |> Option.ofOptionList - + [] [] type FindDeclExternalSymbol = @@ -105,7 +108,7 @@ type FindDeclExternalSymbol = | Event of typeName: string * name: string | Property of typeName: string * name: string - override this.ToString () = + override this.ToString() = match this with | Type fullName -> fullName | Constructor (typeName, args) -> @@ -114,9 +117,7 @@ type FindDeclExternalSymbol = |> String.concat ", " |> sprintf "%s..ctor(%s)" typeName | Method (typeName, name, args, genericArity) -> - let genericAritySuffix = - if genericArity > 0 then sprintf "`%d" genericArity - else "" + let genericAritySuffix = if genericArity > 0 then sprintf "`%d" genericArity else "" args |> List.map (sprintf "%O") @@ -124,15 +125,14 @@ type FindDeclExternalSymbol = |> sprintf "%s.%s%s(%s)" typeName name genericAritySuffix | Field (typeName, name) | Event (typeName, name) - | Property (typeName, name) -> - sprintf "%s.%s" typeName name + | Property (typeName, name) -> sprintf "%s.%s" typeName name - member this.ToDebuggerDisplay () = + member this.ToDebuggerDisplay() = let caseInfo, _ = FSharpValue.GetUnionFields(this, typeof) sprintf "%s %O" caseInfo.Name this [] -type FindDeclFailureReason = +type FindDeclFailureReason = // generic reason: no particular information about error | Unknown of message: string @@ -147,7 +147,7 @@ type FindDeclFailureReason = | ProvidedMember of memberName: string [] -type FindDeclResult = +type FindDeclResult = /// declaration not found + reason | DeclNotFound of FindDeclFailureReason @@ -156,5 +156,4 @@ type FindDeclResult = | DeclFound of location: range /// Indicates an external declaration was found - | ExternalDecl of assembly : string * externalSym : FindDeclExternalSymbol - + | ExternalDecl of assembly: string * externalSym: FindDeclExternalSymbol diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 05687af67fbd..12db1c07065e 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -62,19 +62,26 @@ type FSharpUnresolvedReferencesSet = FSharpUnresolvedReferencesSet of Unresolved [] type internal DelayedILModuleReader = - val private name : string - val private gate : obj - val mutable private getStream : (CancellationToken -> Stream option) - val mutable private result : ILModuleReader + val private name: string + val private gate: obj + val mutable private getStream: (CancellationToken -> Stream option) + val mutable private result: ILModuleReader - new (name, getStream) = { name = name; gate = obj(); getStream = getStream; result = Unchecked.defaultof<_> } + new(name, getStream) = + { + name = name + gate = obj () + getStream = getStream + result = Unchecked.defaultof<_> + } member this.TryGetILModuleReader() = // fast path match box this.result with | null -> cancellable { - let! ct = Cancellable.token() + let! ct = Cancellable.token () + return lock this.gate (fun () -> // see if we have a result or not after the lock so we do not evaluate the stream more than once @@ -82,6 +89,7 @@ type internal DelayedILModuleReader = | null -> try let streamOpt = this.getStream ct + match streamOpt with | Some stream -> let ilReaderOptions: ILReaderOptions = @@ -91,25 +99,20 @@ type internal DelayedILModuleReader = metadataOnly = MetadataOnlyFlag.Yes tryGetMetadataSnapshot = fun _ -> None } + let ilReader = OpenILModuleReaderFromStream this.name stream ilReaderOptions this.result <- ilReader this.getStream <- Unchecked.defaultof<_> // clear out the function so we do not hold onto anything Some ilReader - | _ -> - None - with - | ex -> + | _ -> None + with ex -> Trace.TraceInformation("FCS: Unable to get an ILModuleReader: {0}", ex) None - | _ -> - Some this.result - ) + | _ -> Some this.result) } - | _ -> - Cancellable.ret (Some this.result) - + | _ -> Cancellable.ret (Some this.result) -[] +[] type FSharpReferencedProject = | FSharpReference of projectOutputFile: string * options: FSharpProjectOptions | PEReference of projectOutputFile: string * getStamp: (unit -> DateTime) * delayedReader: DelayedILModuleReader @@ -117,9 +120,9 @@ type FSharpReferencedProject = member this.OutputFile = match this with - | FSharpReference(projectOutputFile=projectOutputFile) - | PEReference(projectOutputFile=projectOutputFile) - | ILModuleReference(projectOutputFile=projectOutputFile) -> projectOutputFile + | FSharpReference (projectOutputFile = projectOutputFile) + | PEReference (projectOutputFile = projectOutputFile) + | ILModuleReference (projectOutputFile = projectOutputFile) -> projectOutputFile static member CreateFSharp(projectOutputFile, options) = FSharpReference(projectOutputFile, options) @@ -134,88 +137,97 @@ type FSharpReferencedProject = match o with | :? FSharpReferencedProject as o -> match this, o with - | FSharpReference(projectOutputFile1, options1), FSharpReference(projectOutputFile2, options2) -> + | FSharpReference (projectOutputFile1, options1), FSharpReference (projectOutputFile2, options2) -> projectOutputFile1 = projectOutputFile2 && options1 = options2 - | PEReference(projectOutputFile1, getStamp1, _), PEReference(projectOutputFile2, getStamp2, _) -> - projectOutputFile1 = projectOutputFile2 && (getStamp1()) = (getStamp2()) - | ILModuleReference(projectOutputFile1, getStamp1, _), ILModuleReference(projectOutputFile2, getStamp2, _) -> - projectOutputFile1 = projectOutputFile2 && (getStamp1()) = (getStamp2()) - | _ -> - false - | _ -> - false + | PEReference (projectOutputFile1, getStamp1, _), PEReference (projectOutputFile2, getStamp2, _) -> + projectOutputFile1 = projectOutputFile2 && (getStamp1 ()) = (getStamp2 ()) + | ILModuleReference (projectOutputFile1, getStamp1, _), ILModuleReference (projectOutputFile2, getStamp2, _) -> + projectOutputFile1 = projectOutputFile2 && (getStamp1 ()) = (getStamp2 ()) + | _ -> false + | _ -> false override this.GetHashCode() = this.OutputFile.GetHashCode() // NOTE: may be better just to move to optional arguments here and FSharpProjectOptions = { - ProjectFileName: string - ProjectId: string option - SourceFiles: string[] - OtherOptions: string[] - ReferencedProjects: FSharpReferencedProject[] - IsIncompleteTypeCheckEnvironment: bool - UseScriptResolutionRules: bool - LoadTime: DateTime - UnresolvedReferences: FSharpUnresolvedReferencesSet option - OriginalLoadReferences: (range * string * string) list - Stamp: int64 option + ProjectFileName: string + ProjectId: string option + SourceFiles: string[] + OtherOptions: string[] + ReferencedProjects: FSharpReferencedProject[] + IsIncompleteTypeCheckEnvironment: bool + UseScriptResolutionRules: bool + LoadTime: DateTime + UnresolvedReferences: FSharpUnresolvedReferencesSet option + OriginalLoadReferences: (range * string * string) list + Stamp: int64 option } - static member UseSameProject(options1,options2) = + static member UseSameProject(options1, options2) = match options1.ProjectId, options2.ProjectId with - | Some(projectId1), Some(projectId2) when not (String.IsNullOrWhiteSpace(projectId1)) && not (String.IsNullOrWhiteSpace(projectId2)) -> + | Some (projectId1), Some (projectId2) when + not (String.IsNullOrWhiteSpace(projectId1)) + && not (String.IsNullOrWhiteSpace(projectId2)) + -> projectId1 = projectId2 | Some _, Some _ | None, None -> options1.ProjectFileName = options2.ProjectFileName | _ -> false - static member AreSameForChecking(options1,options2) = + static member AreSameForChecking(options1, options2) = match options1.Stamp, options2.Stamp with | Some x, Some y -> (x = y) | _ -> - FSharpProjectOptions.UseSameProject(options1, options2) && - options1.SourceFiles = options2.SourceFiles && - options1.OtherOptions = options2.OtherOptions && - options1.UnresolvedReferences = options2.UnresolvedReferences && - options1.OriginalLoadReferences = options2.OriginalLoadReferences && - options1.ReferencedProjects.Length = options2.ReferencedProjects.Length && - (options1.ReferencedProjects, options2.ReferencedProjects) - ||> Array.forall2 (fun r1 r2 -> - match r1, r2 with - | FSharpReferencedProject.FSharpReference(n1,a), FSharpReferencedProject.FSharpReference(n2,b) -> - n1 = n2 && FSharpProjectOptions.AreSameForChecking(a,b) - | FSharpReferencedProject.PEReference(n1, getStamp1, _), FSharpReferencedProject.PEReference(n2, getStamp2, _) -> - n1 = n2 && (getStamp1()) = (getStamp2()) - | _ -> - false) && - options1.LoadTime = options2.LoadTime + FSharpProjectOptions.UseSameProject(options1, options2) + && options1.SourceFiles = options2.SourceFiles + && options1.OtherOptions = options2.OtherOptions + && options1.UnresolvedReferences = options2.UnresolvedReferences + && options1.OriginalLoadReferences = options2.OriginalLoadReferences + && options1.ReferencedProjects.Length = options2.ReferencedProjects.Length + && (options1.ReferencedProjects, options2.ReferencedProjects) + ||> Array.forall2 (fun r1 r2 -> + match r1, r2 with + | FSharpReferencedProject.FSharpReference (n1, a), FSharpReferencedProject.FSharpReference (n2, b) -> + n1 = n2 && FSharpProjectOptions.AreSameForChecking(a, b) + | FSharpReferencedProject.PEReference (n1, getStamp1, _), FSharpReferencedProject.PEReference (n2, getStamp2, _) -> + n1 = n2 && (getStamp1 ()) = (getStamp2 ()) + | _ -> false) + && options1.LoadTime = options2.LoadTime member po.ProjectDirectory = Path.GetDirectoryName(po.ProjectFileName) - override this.ToString() = "FSharpProjectOptions(" + this.ProjectFileName + ")" + override this.ToString() = + "FSharpProjectOptions(" + this.ProjectFileName + ")" [] module internal FSharpCheckerResultsSettings = let getToolTipTextSize = GetEnvInteger "FCS_GetToolTipTextCacheSize" 5 - let maxTypeCheckErrorsOutOfProjectContext = GetEnvInteger "FCS_MaxErrorsOutOfProjectContext" 3 + let maxTypeCheckErrorsOutOfProjectContext = + GetEnvInteger "FCS_MaxErrorsOutOfProjectContext" 3 // Look for DLLs in the location of the service DLL first. - let defaultFSharpBinariesDir = FSharpEnvironment.BinFolderOfDefaultFSharpCompiler(Some(Path.GetDirectoryName(typeof.Assembly.Location))).Value + let defaultFSharpBinariesDir = + FSharpEnvironment + .BinFolderOfDefaultFSharpCompiler( + Some(Path.GetDirectoryName(typeof.Assembly.Location)) + ) + .Value [] -type FSharpSymbolUse(denv: DisplayEnv, symbol:FSharpSymbol, inst: TyparInstantiation, itemOcc, range: range) = +type FSharpSymbolUse(denv: DisplayEnv, symbol: FSharpSymbol, inst: TyparInstantiation, itemOcc, range: range) = - member _.Symbol = symbol + member _.Symbol = symbol member _.GenericArguments = let cenv = symbol.SymbolEnv - inst |> List.map (fun (v, ty) -> FSharpGenericParameter(cenv, v), FSharpType(cenv, ty)) - member _.DisplayContext = FSharpDisplayContext(fun _ -> denv) + inst + |> List.map (fun (v, ty) -> FSharpGenericParameter(cenv, v), FSharpType(cenv, ty)) + + member _.DisplayContext = FSharpDisplayContext(fun _ -> denv) member x.IsDefinition = x.IsFromDefinition @@ -232,9 +244,11 @@ type FSharpSymbolUse(denv: DisplayEnv, symbol:FSharpSymbol, inst: TyparInstantia member _.IsFromComputationExpression = match symbol.Item, itemOcc with // 'seq' in 'seq { ... }' gets colored as keywords - | Item.Value vref, ItemOccurence.Use when valRefEq denv.g denv.g.seq_vref vref -> true + | Item.Value vref, ItemOccurence.Use when valRefEq denv.g denv.g.seq_vref vref -> true // custom builders, custom operations get colored as keywords - | (Item.CustomBuilder _ | Item.CustomOperation _), ItemOccurence.Use -> true + | (Item.CustomBuilder _ + | Item.CustomOperation _), + ItemOccurence.Use -> true | _ -> false member _.IsFromOpenStatement = itemOcc = ItemOccurence.Open @@ -268,7 +282,8 @@ type FSharpSymbolUse(denv: DisplayEnv, symbol:FSharpSymbol, inst: TyparInstantia isPrivate && declaredInTheFile - override _.ToString() = sprintf "%O, %O, %O" symbol itemOcc range + override _.ToString() = + sprintf "%O, %O, %O" symbol itemOcc range /// This type is used to describe what was found during the name resolution. /// (Depending on the kind of the items, we may stop processing or continue to find better items) @@ -280,8 +295,8 @@ type NameResResult = [] type ResolveOverloads = -| Yes -| No + | Yes + | No [] type ExprTypingsResult = @@ -298,51 +313,51 @@ type Names = string list /// scope object on the floor and make a new one. [] type internal TypeCheckInfo - (// Information corresponding to miscellaneous command-line options (--define, etc). - _sTcConfig: TcConfig, - g: TcGlobals, - // The signature of the assembly being checked, up to and including the current file - ccuSigForFile: ModuleOrNamespaceType, - thisCcu: CcuThunk, - tcImports: TcImports, - tcAccessRights: AccessorDomain, - projectFileName: string, - mainInputFileName: string, - projectOptions: FSharpProjectOptions, - sResolutions: TcResolutions, - sSymbolUses: TcSymbolUses, - // This is a name resolution environment to use if no better match can be found. - sFallback: NameResolutionEnv, - loadClosure : LoadClosure option, - implFileOpt: CheckedImplFile option, - openDeclarations: OpenDeclaration[]) = + ( + _sTcConfig: TcConfig, + g: TcGlobals, + ccuSigForFile: ModuleOrNamespaceType, + thisCcu: CcuThunk, + tcImports: TcImports, + tcAccessRights: AccessorDomain, + projectFileName: string, + mainInputFileName: string, + projectOptions: FSharpProjectOptions, + sResolutions: TcResolutions, + sSymbolUses: TcSymbolUses, + sFallback: NameResolutionEnv, + loadClosure: LoadClosure option, + implFileOpt: CheckedImplFile option, + openDeclarations: OpenDeclaration[] + ) = // These strings are potentially large and the editor may choose to hold them for a while. // Use this cache to fold together data tip text results that are the same. // Is not keyed on 'Names' collection because this is invariant for the current position in // this unchanged file. Keyed on lineStr though to prevent a change to the currently line // being available against a stale scope. - let getToolTipTextCache = AgedLookup(getToolTipTextSize,areSimilar=(fun (x,y) -> x = y)) + let getToolTipTextCache = + AgedLookup(getToolTipTextSize, areSimilar = (fun (x, y) -> x = y)) let amap = tcImports.GetImportMap() - let infoReader = InfoReader(g,amap) - let ncenv = NameResolver(g,amap,infoReader,FakeInstantiationGenerator) + let infoReader = InfoReader(g, amap) + let ncenv = NameResolver(g, amap, infoReader, FakeInstantiationGenerator) let cenv = SymbolEnv(g, thisCcu, Some ccuSigForFile, tcImports, amap, infoReader) /// Find the most precise naming environment for the given line and column - let GetBestEnvForPos cursorPos = + let GetBestEnvForPos cursorPos = let mutable bestSoFar = None // Find the most deeply nested enclosing scope that contains given position - sResolutions.CapturedEnvs |> ResizeArray.iter (fun (possm,env,ad) -> + sResolutions.CapturedEnvs + |> ResizeArray.iter (fun (possm, env, ad) -> if rangeContainsPos possm cursorPos then match bestSoFar with - | Some (bestm,_,_) -> + | Some (bestm, _, _) -> if rangeContainsRange bestm possm then - bestSoFar <- Some (possm,env,ad) - | None -> - bestSoFar <- Some (possm,env,ad)) + bestSoFar <- Some(possm, env, ad) + | None -> bestSoFar <- Some(possm, env, ad)) let mostDeeplyNestedEnclosingScope = bestSoFar @@ -354,48 +369,55 @@ type internal TypeCheckInfo let mutable bestAlmostIncludedSoFar = None - sResolutions.CapturedEnvs |> ResizeArray.iter (fun (possm,env,ad) -> + sResolutions.CapturedEnvs + |> ResizeArray.iter (fun (possm, env, ad) -> // take only ranges that strictly do not include cursorPos (all ranges that touch cursorPos were processed during 'Strict Inclusion' part) if rangeBeforePos possm cursorPos && not (posEq possm.End cursorPos) then let contained = match mostDeeplyNestedEnclosingScope with - | Some (bestm,_,_) -> rangeContainsRange bestm possm + | Some (bestm, _, _) -> rangeContainsRange bestm possm | None -> true if contained then match bestAlmostIncludedSoFar with - | Some (rightm:range,_,_) -> - if posGt possm.End rightm.End || - (posEq possm.End rightm.End && posGt possm.Start rightm.Start) then - bestAlmostIncludedSoFar <- Some (possm,env,ad) - | _ -> bestAlmostIncludedSoFar <- Some (possm,env,ad)) + | Some (rightm: range, _, _) -> + if posGt possm.End rightm.End + || (posEq possm.End rightm.End && posGt possm.Start rightm.Start) then + bestAlmostIncludedSoFar <- Some(possm, env, ad) + | _ -> bestAlmostIncludedSoFar <- Some(possm, env, ad)) let resEnv = match bestAlmostIncludedSoFar, mostDeeplyNestedEnclosingScope with - | Some (_,env,ad), None -> env, ad - | Some (_,almostIncludedEnv,ad), Some (_,mostDeeplyNestedEnv,_) - when almostIncludedEnv.eFieldLabels.Count >= mostDeeplyNestedEnv.eFieldLabels.Count -> - almostIncludedEnv,ad + | Some (_, env, ad), None -> env, ad + | Some (_, almostIncludedEnv, ad), Some (_, mostDeeplyNestedEnv, _) when + almostIncludedEnv.eFieldLabels.Count >= mostDeeplyNestedEnv.eFieldLabels.Count + -> + almostIncludedEnv, ad | _ -> match mostDeeplyNestedEnclosingScope with - | Some (_,env,ad) -> - env,ad - | None -> - sFallback,AccessibleFromSomeFSharpCode + | Some (_, env, ad) -> env, ad + | None -> sFallback, AccessibleFromSomeFSharpCode + let pm = mkRange mainInputFileName cursorPos cursorPos - resEnv,pm + resEnv, pm /// The items that come back from ResolveCompletionsInType are a bit /// noisy. Filter a few things out. /// /// e.g. prefer types to constructors for ToolTipText let FilterItemsForCtors filterCtors (items: ItemWithInst list) = - let items = items |> List.filter (fun item -> match item.Item with Item.CtorGroup _ when filterCtors = ResolveTypeNamesToTypeRefs -> false | _ -> true) + let items = + items + |> List.filter (fun item -> + match item.Item with + | Item.CtorGroup _ when filterCtors = ResolveTypeNamesToTypeRefs -> false + | _ -> true) + items // Filter items to show only valid & return Some if there are any - let ReturnItemsOfType (items: ItemWithInst list) g denv (m:range) filterCtors = + let ReturnItemsOfType (items: ItemWithInst list) g denv (m: range) filterCtors = let items = items |> RemoveDuplicateItems g @@ -403,22 +425,23 @@ type internal TypeCheckInfo |> FilterItemsForCtors filterCtors if not (isNil items) then - NameResResult.Members (items, denv, m) + NameResResult.Members(items, denv, m) else NameResResult.Empty let GetCapturedNameResolutions (endOfNamesPos: pos) resolveOverloads = let filter (endPos: pos) items = - items |> ResizeArray.filter (fun (cnr: CapturedNameResolution) -> + items + |> ResizeArray.filter (fun (cnr: CapturedNameResolution) -> let range = cnr.Range range.EndLine = endPos.Line && range.EndColumn = endPos.Column) match resolveOverloads with - | ResolveOverloads.Yes -> - filter endOfNamesPos sResolutions.CapturedNameResolutions + | ResolveOverloads.Yes -> filter endOfNamesPos sResolutions.CapturedNameResolutions | ResolveOverloads.No -> let items = filter endOfNamesPos sResolutions.CapturedMethodGroupResolutions + if items.Count <> 0 then items else @@ -427,18 +450,23 @@ type internal TypeCheckInfo /// Looks at the exact name resolutions that occurred during type checking /// If 'membersByResidue' is specified, we look for members of the item obtained /// from the name resolution and filter them by the specified residue (?) - let GetPreciseItemsFromNameResolution(line, colAtEndOfNames, membersByResidue, filterCtors, resolveOverloads) = + let GetPreciseItemsFromNameResolution (line, colAtEndOfNames, membersByResidue, filterCtors, resolveOverloads) = let endOfNamesPos = mkPos line colAtEndOfNames // Logic below expects the list to be in reverse order of resolution - let cnrs = GetCapturedNameResolutions endOfNamesPos resolveOverloads |> ResizeArray.toList |> List.rev + let cnrs = + GetCapturedNameResolutions endOfNamesPos resolveOverloads + |> ResizeArray.toList + |> List.rev match cnrs, membersByResidue with // If we're looking for members using a residue, we'd expect only // a single item (pick the first one) and we need the residue (which may be "") - | CNR(Item.Types(_,ty::_), _, denv, nenv, ad, m)::_, Some _ -> - let targets = ResolveCompletionTargets.All(ConstraintSolver.IsApplicableMethApprox g amap m) + | CNR (Item.Types (_, ty :: _), _, denv, nenv, ad, m) :: _, Some _ -> + let targets = + ResolveCompletionTargets.All(ConstraintSolver.IsApplicableMethApprox g amap m) + let items = ResolveCompletionsInType ncenv nenv targets m ad true ty let items = List.map ItemWithNoInst items ReturnItemsOfType items g denv m filterCtors @@ -450,91 +478,115 @@ type internal TypeCheckInfo // let varA = if b then 0 else varA. // then the expression typings get confused (thinking 'varA:int'), so we use name resolution even for usual values. - | CNR(Item.Value(vref), occurence, denv, nenv, ad, m)::_, Some _ -> + | CNR (Item.Value (vref), occurence, denv, nenv, ad, m) :: _, Some _ -> if occurence = ItemOccurence.Binding || occurence = ItemOccurence.Pattern then - // Return empty list to stop further lookup - for value declarations - NameResResult.Cancel(denv, m) + // Return empty list to stop further lookup - for value declarations + NameResResult.Cancel(denv, m) else - // If we have any valid items for the value, then return completions for its type now. - // Adjust the type in case this is the 'this' pointer stored in a reference cell. - let ty = StripSelfRefCell(g, vref.BaseOrThisInfo, vref.TauType) - // patch accessibility domain to remove protected members if accessing NormalVal - let ad = - match vref.BaseOrThisInfo, ad with - | ValBaseOrThisInfo.NormalVal, AccessibleFrom(paths, Some tcref) -> - let thisTy = generalizedTyconRef g tcref - // check that type of value is the same or subtype of tcref - // yes - allow access to protected members - // no - strip ability to access protected members - if TypeRelations.TypeFeasiblySubsumesType 0 g amap m thisTy TypeRelations.CanCoerce ty then - ad - else - AccessibleFrom(paths, None) - | _ -> ad + // If we have any valid items for the value, then return completions for its type now. + // Adjust the type in case this is the 'this' pointer stored in a reference cell. + let ty = StripSelfRefCell(g, vref.BaseOrThisInfo, vref.TauType) + // patch accessibility domain to remove protected members if accessing NormalVal + let ad = + match vref.BaseOrThisInfo, ad with + | ValBaseOrThisInfo.NormalVal, AccessibleFrom (paths, Some tcref) -> + let thisTy = generalizedTyconRef g tcref + // check that type of value is the same or subtype of tcref + // yes - allow access to protected members + // no - strip ability to access protected members + if TypeRelations.TypeFeasiblySubsumesType 0 g amap m thisTy TypeRelations.CanCoerce ty then + ad + else + AccessibleFrom(paths, None) + | _ -> ad + + let targets = + ResolveCompletionTargets.All(ConstraintSolver.IsApplicableMethApprox g amap m) - let targets = ResolveCompletionTargets.All(ConstraintSolver.IsApplicableMethApprox g amap m) - let items = ResolveCompletionsInType ncenv nenv targets m ad false ty - let items = List.map ItemWithNoInst items - ReturnItemsOfType items g denv m filterCtors + let items = ResolveCompletionsInType ncenv nenv targets m ad false ty + let items = List.map ItemWithNoInst items + ReturnItemsOfType items g denv m filterCtors // No residue, so the items are the full resolution of the name - | CNR(_, _, denv, _, _, m) :: _, None -> + | CNR (_, _, denv, _, _, m) :: _, None -> let items = cnrs |> List.map (fun cnr -> cnr.ItemWithInst) // "into" is special magic syntax, not an identifier or a library call. It is part of capturedNameResolutions as an // implementation detail of syntax coloring, but we should not report name resolution results for it, to prevent spurious QuickInfo. - |> List.filter (fun item -> match item.Item with Item.CustomOperation(CustomOperations.Into,_,_) -> false | _ -> true) + |> List.filter (fun item -> + match item.Item with + | Item.CustomOperation (CustomOperations.Into, _, _) -> false + | _ -> true) + ReturnItemsOfType items g denv m filterCtors | _, _ -> NameResResult.Empty - let TryGetTypeFromNameResolution(line, colAtEndOfNames, membersByResidue, resolveOverloads) = + let TryGetTypeFromNameResolution (line, colAtEndOfNames, membersByResidue, resolveOverloads) = let endOfNamesPos = mkPos line colAtEndOfNames - let items = GetCapturedNameResolutions endOfNamesPos resolveOverloads |> ResizeArray.toList |> List.rev + + let items = + GetCapturedNameResolutions endOfNamesPos resolveOverloads + |> ResizeArray.toList + |> List.rev match items, membersByResidue with - | CNR(Item.Types(_,ty::_),_,_,_,_,_)::_, Some _ -> Some ty - | CNR(Item.Value(vref), occurence,_,_,_,_)::_, Some _ -> - if (occurence = ItemOccurence.Binding || occurence = ItemOccurence.Pattern) then None - else Some (StripSelfRefCell(g, vref.BaseOrThisInfo, vref.TauType)) + | CNR (Item.Types (_, ty :: _), _, _, _, _, _) :: _, Some _ -> Some ty + | CNR (Item.Value (vref), occurence, _, _, _, _) :: _, Some _ -> + if (occurence = ItemOccurence.Binding || occurence = ItemOccurence.Pattern) then + None + else + Some(StripSelfRefCell(g, vref.BaseOrThisInfo, vref.TauType)) | _, _ -> None - let CollectParameters (methods: MethInfo list) amap m: Item list = + let CollectParameters (methods: MethInfo list) amap m : Item list = methods |> List.collect (fun meth -> match meth.GetParamDatas(amap, m, meth.FormalMethodInst) with - | x::_ -> x |> List.choose(fun (ParamData(_isParamArray, _isInArg, _isOutArg, _optArgInfo, _callerInfo, name, _, ty)) -> - match name with - | Some n -> Some (Item.ArgName(n, ty, Some (ArgumentContainer.Method meth))) - | None -> None - ) - | _ -> [] - ) + | x :: _ -> + x + |> List.choose (fun (ParamData (_isParamArray, _isInArg, _isOutArg, _optArgInfo, _callerInfo, name, _, ty)) -> + match name with + | Some n -> Some(Item.ArgName(n, ty, Some(ArgumentContainer.Method meth))) + | None -> None) + | _ -> []) let GetNamedParametersAndSettableFields endOfExprPos = - let cnrs = GetCapturedNameResolutions endOfExprPos ResolveOverloads.No |> ResizeArray.toList |> List.rev + let cnrs = + GetCapturedNameResolutions endOfExprPos ResolveOverloads.No + |> ResizeArray.toList + |> List.rev + let result = match cnrs with - | CNR(Item.CtorGroup(_, (ctor::_ as ctors)), _, denv, nenv, ad, m) ::_ -> - let props = ResolveCompletionsInType ncenv nenv ResolveCompletionTargets.SettablePropertiesAndFields m ad false ctor.ApparentEnclosingType + | CNR (Item.CtorGroup (_, (ctor :: _ as ctors)), _, denv, nenv, ad, m) :: _ -> + let props = + ResolveCompletionsInType + ncenv + nenv + ResolveCompletionTargets.SettablePropertiesAndFields + m + ad + false + ctor.ApparentEnclosingType + let parameters = CollectParameters ctors amap m let items = props @ parameters - Some (denv, m, items) - | CNR(Item.MethodGroup(_, methods, _), _, denv, nenv, ad, m) ::_ -> + Some(denv, m, items) + | CNR (Item.MethodGroup (_, methods, _), _, denv, nenv, ad, m) :: _ -> let props = methods |> List.collect (fun meth -> let retTy = meth.GetFSharpReturnType(amap, m, meth.FormalMethodInst) - ResolveCompletionsInType ncenv nenv ResolveCompletionTargets.SettablePropertiesAndFields m ad false retTy - ) + ResolveCompletionsInType ncenv nenv ResolveCompletionTargets.SettablePropertiesAndFields m ad false retTy) + let parameters = CollectParameters methods amap m let items = props @ parameters - Some (denv, m, items) - | _ -> - None + Some(denv, m, items) + | _ -> None + match result with - | None -> - NameResResult.Empty + | None -> NameResResult.Empty | Some (denv, m, items) -> let items = List.map ItemWithNoInst items ReturnItemsOfType items g denv m TypeNameResolutionFlag.ResolveTypeNamesToTypeRefs @@ -543,51 +595,56 @@ type internal TypeCheckInfo let GetExprTypingForPosition endOfExprPos = let quals = sResolutions.CapturedExpressionTypings - |> Seq.filter (fun (ty,nenv,_,m) -> - // We only want expression types that end at the particular position in the file we are looking at. - posEq m.End endOfExprPos && - - // Get rid of function types. True, given a 2-arg curried function "f x y", it is legal to do "(f x).GetType()", - // but you almost never want to do this in practice, and we choose not to offer up any intellisense for - // F# function types. - not (isFunTy nenv.DisplayEnv.g ty)) + |> Seq.filter (fun (ty, nenv, _, m) -> + // We only want expression types that end at the particular position in the file we are looking at. + posEq m.End endOfExprPos + && + + // Get rid of function types. True, given a 2-arg curried function "f x y", it is legal to do "(f x).GetType()", + // but you almost never want to do this in practice, and we choose not to offer up any intellisense for + // F# function types. + not (isFunTy nenv.DisplayEnv.g ty)) |> Seq.toArray // filter out errors - let quals = quals - |> Array.filter (fun (ty,nenv,_,_) -> - let denv = nenv.DisplayEnv - not (isTyparTy denv.g ty && (destTyparTy denv.g ty).IsFromError)) + let quals = + quals + |> Array.filter (fun (ty, nenv, _, _) -> + let denv = nenv.DisplayEnv + not (isTyparTy denv.g ty && (destTyparTy denv.g ty).IsFromError)) let thereWereSomeQuals = not (Array.isEmpty quals) thereWereSomeQuals, quals /// obtains captured typing for the given position /// if type of captured typing is record - returns list of record fields - let GetRecdFieldsForExpr(r : range) = + let GetRecdFieldsForExpr (r: range) = let _, quals = GetExprTypingForPosition(r.End) + let bestQual = match quals with | [||] -> None | quals -> - quals |> Array.tryFind (fun (_,_,_,rq) -> - ignore(r) // for breakpoint - posEq r.Start rq.Start) + quals + |> Array.tryFind (fun (_, _, _, rq) -> + ignore (r) // for breakpoint + posEq r.Start rq.Start) + match bestQual with - | Some (ty,nenv,ad,m) when isRecdTy nenv.DisplayEnv.g ty -> + | Some (ty, nenv, ad, m) when isRecdTy nenv.DisplayEnv.g ty -> let items = ResolveRecordOrClassFieldsOfType ncenv m ad ty false - Some (items, nenv.DisplayEnv, m) + Some(items, nenv.DisplayEnv, m) | _ -> None /// Looks at the exact expression types at the position to the left of the /// residue then the source when it was typechecked. - let GetPreciseCompletionListFromExprTypings(parseResults:FSharpParseFileResults, endOfExprPos, filterCtors) = + let GetPreciseCompletionListFromExprTypings (parseResults: FSharpParseFileResults, endOfExprPos, filterCtors) = let thereWereSomeQuals, quals = GetExprTypingForPosition(endOfExprPos) match quals with - | [| |] -> + | [||] -> if thereWereSomeQuals then ExprTypingsResult.NoneBecauseThereWereTypeErrors else @@ -595,16 +652,19 @@ type internal TypeCheckInfo | _ -> let bestQual, textChanged = let input = parseResults.ParseTree - match ParsedInput.GetRangeOfExprLeftOfDot(endOfExprPos,input) with // TODO we say "colAtEndOfNames" everywhere, but that's not really a good name ("foo . $" hit Ctrl-Space at $) - | Some( exprRange) -> + + match ParsedInput.GetRangeOfExprLeftOfDot(endOfExprPos, input) with // TODO we say "colAtEndOfNames" everywhere, but that's not really a good name ("foo . $" hit Ctrl-Space at $) + | Some (exprRange) -> // We have an up-to-date sync parse, and know the exact range of the prior expression. // The quals all already have the same ending position, so find one with a matching starting position, if it exists. // If not, then the stale typecheck info does not have a capturedExpressionTyping for this exact expression, and the // user can wait for typechecking to catch up and second-chance intellisense to give the right result. let qual = - quals |> Array.tryFind (fun (_,_,_,r) -> - ignore(r) // for breakpoint - posEq exprRange.Start r.Start) + quals + |> Array.tryFind (fun (_, _, _, r) -> + ignore (r) // for breakpoint + posEq exprRange.Start r.Start) + qual, false | None -> // TODO In theory I think we should never get to this code path; it would be nice to add an assert. @@ -614,21 +674,28 @@ type internal TypeCheckInfo match bestQual with | Some bestQual -> - let ty,nenv,ad,m = bestQual - let targets = ResolveCompletionTargets.All(ConstraintSolver.IsApplicableMethApprox g amap m) + let ty, nenv, ad, m = bestQual + + let targets = + ResolveCompletionTargets.All(ConstraintSolver.IsApplicableMethApprox g amap m) + let items = ResolveCompletionsInType ncenv nenv targets m ad false ty let items = items |> List.map ItemWithNoInst let items = items |> RemoveDuplicateItems g let items = items |> RemoveExplicitlySuppressed g let items = items |> FilterItemsForCtors filterCtors - ExprTypingsResult.Some((items,nenv.DisplayEnv,m), ty) + ExprTypingsResult.Some((items, nenv.DisplayEnv, m), ty) | None -> - if textChanged then ExprTypingsResult.NoneBecauseTypecheckIsStaleAndTextChanged - else ExprTypingsResult.None + if textChanged then + ExprTypingsResult.NoneBecauseTypecheckIsStaleAndTextChanged + else + ExprTypingsResult.None /// Find items in the best naming environment. - let GetEnvironmentLookupResolutions(nenv, ad, m, plid, filterCtors, showObsolete) = - let items = ResolvePartialLongIdent ncenv nenv (ConstraintSolver.IsApplicableMethApprox g amap m) m ad plid showObsolete + let GetEnvironmentLookupResolutions (nenv, ad, m, plid, filterCtors, showObsolete) = + let items = + ResolvePartialLongIdent ncenv nenv (ConstraintSolver.IsApplicableMethApprox g amap m) m ad plid showObsolete + let items = items |> List.map ItemWithNoInst let items = items |> RemoveDuplicateItems g let items = items |> RemoveExplicitlySuppressed g @@ -636,14 +703,17 @@ type internal TypeCheckInfo (items, nenv.DisplayEnv, m) /// Find items in the best naming environment. - let GetEnvironmentLookupResolutionsAtPosition(cursorPos, plid, filterCtors, showObsolete) = - let (nenv,ad),m = GetBestEnvForPos cursorPos + let GetEnvironmentLookupResolutionsAtPosition (cursorPos, plid, filterCtors, showObsolete) = + let (nenv, ad), m = GetBestEnvForPos cursorPos GetEnvironmentLookupResolutions(nenv, ad, m, plid, filterCtors, showObsolete) /// Find record fields in the best naming environment. - let GetClassOrRecordFieldsEnvironmentLookupResolutions(cursorPos, plid, fieldsOnly) = - let (nenv, ad),m = GetBestEnvForPos cursorPos - let items = ResolvePartialLongIdentToClassOrRecdFields ncenv nenv m ad plid false fieldsOnly + let GetClassOrRecordFieldsEnvironmentLookupResolutions (cursorPos, plid, fieldsOnly) = + let (nenv, ad), m = GetBestEnvForPos cursorPos + + let items = + ResolvePartialLongIdentToClassOrRecdFields ncenv nenv m ad plid false fieldsOnly + let items = items |> List.map ItemWithNoInst let items = items |> RemoveDuplicateItems g let items = items |> RemoveExplicitlySuppressed g @@ -657,43 +727,54 @@ type internal TypeCheckInfo // // The overall aim is to resolve as accurately as possible based on what we know from type inference - let GetBaseClassCandidates = function + let GetBaseClassCandidates = + function | Item.ModuleOrNamespaces _ -> true - | Item.Types(_, ty::_) when (isClassTy g ty) && not (isSealedTy g ty) -> true + | Item.Types (_, ty :: _) when (isClassTy g ty) && not (isSealedTy g ty) -> true | _ -> false - let GetInterfaceCandidates = function + let GetInterfaceCandidates = + function | Item.ModuleOrNamespaces _ -> true - | Item.Types(_, ty::_) when (isInterfaceTy g ty) -> true + | Item.Types (_, ty :: _) when (isInterfaceTy g ty) -> true | _ -> false - // Return only items with the specified name let FilterDeclItemsByResidue (getItem: 'a -> Item) residue (items: 'a list) = let attributedResidue = residue + "Attribute" - let nameMatchesResidue name = (residue = name) || (attributedResidue = name) - items |> List.filter (fun x -> + let nameMatchesResidue name = + (residue = name) || (attributedResidue = name) + + items + |> List.filter (fun x -> let item = getItem x - let n1 = item.DisplayName + let n1 = item.DisplayName + match item with | Item.Types _ -> nameMatchesResidue n1 | Item.CtorGroup (_, meths) -> - nameMatchesResidue n1 || - meths |> List.exists (fun meth -> - let tcref = meth.ApparentEnclosingTyconRef + nameMatchesResidue n1 + || meths + |> List.exists (fun meth -> + let tcref = meth.ApparentEnclosingTyconRef #if !NO_TYPEPROVIDERS - tcref.IsProvided || + tcref.IsProvided + || #endif - nameMatchesResidue tcref.DisplayName) + nameMatchesResidue tcref.DisplayName) | _ -> residue = n1) /// Post-filter items to make sure they have precisely the right name /// This also checks that there are some remaining results /// exactMatchResidueOpt = Some _ -- means that we are looking for exact matches - let FilterRelevantItemsBy (getItem: 'a -> Item) (exactMatchResidueOpt : _ option) check (items: 'a list, denv, m) = + let FilterRelevantItemsBy (getItem: 'a -> Item) (exactMatchResidueOpt: _ option) check (items: 'a list, denv, m) = // can throw if type is in located in non-resolved CCU: i.e. bigint if reference to System.Numerics is absent - let inline safeCheck item = try check item with _ -> false + let inline safeCheck item = + try + check item + with _ -> + false // Are we looking for items with precisely the given name? if isNil items then @@ -707,6 +788,7 @@ type internal TypeCheckInfo items |> FilterDeclItemsByResidue getItem exactMatchResidue |> List.filter safeCheck + if not (isNil items) then Some(items, denv, m) else None | _ -> let items = items |> List.filter safeCheck @@ -719,12 +801,15 @@ type internal TypeCheckInfo /// Find the first non-whitespace position in a line prior to the given character let FindFirstNonWhitespacePosition (lineStr: string) i = - if i >= lineStr.Length then None + if i >= lineStr.Length then + None else - let mutable p = i - while p >= 0 && Char.IsWhiteSpace(lineStr[p]) do - p <- p - 1 - if p >= 0 then Some p else None + let mutable p = i + + while p >= 0 && Char.IsWhiteSpace(lineStr[p]) do + p <- p - 1 + + if p >= 0 then Some p else None let CompletionItem (ty: ValueOption) (assemblySymbol: ValueOption) (item: ItemWithInst) = let kind = @@ -737,47 +822,76 @@ type internal TypeCheckInfo | Item.Value _ -> CompletionItemKind.Field | Item.CustomOperation _ -> CompletionItemKind.CustomOperation | _ -> CompletionItemKind.Other - let isUnresolved = match assemblySymbol with ValueSome x -> Some x.UnresolvedSymbol | _ -> None - let ty = match ty with ValueSome x -> Some x | _ -> None - { ItemWithInst = item - MinorPriority = 0 - Kind = kind - IsOwnMember = false - Type = ty - Unresolved = isUnresolved } + let isUnresolved = + match assemblySymbol with + | ValueSome x -> Some x.UnresolvedSymbol + | _ -> None + + let ty = + match ty with + | ValueSome x -> Some x + | _ -> None + + { + ItemWithInst = item + MinorPriority = 0 + Kind = kind + IsOwnMember = false + Type = ty + Unresolved = isUnresolved + } let DefaultCompletionItem item = CompletionItem ValueNone ValueNone item let getItem (x: ItemWithInst) = x.Item - let GetDeclaredItems (parseResultsOpt: FSharpParseFileResults option, lineStr: string, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, - filterCtors, resolveOverloads, isInRangeOperator, allSymbols: unit -> AssemblySymbol list) = - // Are the last two chars (except whitespaces) = ".." - let isLikeRangeOp = - match FindFirstNonWhitespacePosition lineStr (colAtEndOfNamesAndResidue - 1) with - | Some x when x >= 1 && lineStr[x] = '.' && lineStr[x - 1] = '.' -> true - | _ -> false + let GetDeclaredItems + ( + parseResultsOpt: FSharpParseFileResults option, + lineStr: string, + origLongIdentOpt, + colAtEndOfNamesAndResidue, + residueOpt, + lastDotPos, + line, + loc, + filterCtors, + resolveOverloads, + isInRangeOperator, + allSymbols: unit -> AssemblySymbol list + ) = + + // Are the last two chars (except whitespaces) = ".." + let isLikeRangeOp = + match FindFirstNonWhitespacePosition lineStr (colAtEndOfNamesAndResidue - 1) with + | Some x when x >= 1 && lineStr[x] = '.' && lineStr[x - 1] = '.' -> true + | _ -> false - // if last two chars are .. and we are not in range operator context - no completion - if isLikeRangeOp && not isInRangeOperator then None else + // if last two chars are .. and we are not in range operator context - no completion + if isLikeRangeOp && not isInRangeOperator then + None + else // Try to use the exact results of name resolution during type checking to generate the results // This is based on position (i.e. colAtEndOfNamesAndResidue). This is not used if a residueOpt is given. let nameResItems = match residueOpt with - | None -> GetPreciseItemsFromNameResolution(line, colAtEndOfNamesAndResidue, None, filterCtors,resolveOverloads) + | None -> GetPreciseItemsFromNameResolution(line, colAtEndOfNamesAndResidue, None, filterCtors, resolveOverloads) | Some residue -> // Deals with cases when we have spaces between dot and\or identifier, like A . $ // if this is our case - then we need to locate end position of the name skipping whitespaces // this allows us to handle cases like: let x . $ = 1 - let lastPos = lastDotPos |> Option.orElseWith (fun _ -> FindFirstNonWhitespacePosition lineStr (colAtEndOfNamesAndResidue - 1)) + let lastPos = + lastDotPos + |> Option.orElseWith (fun _ -> FindFirstNonWhitespacePosition lineStr (colAtEndOfNamesAndResidue - 1)) + match lastPos with | Some p when lineStr[p] = '.' -> match FindFirstNonWhitespacePosition lineStr (p - 1) with | Some colAtEndOfNames -> - let colAtEndOfNames = colAtEndOfNames + 1 // convert 0-based to 1-based - GetPreciseItemsFromNameResolution(line, colAtEndOfNames, Some(residue), filterCtors,resolveOverloads) + let colAtEndOfNames = colAtEndOfNames + 1 // convert 0-based to 1-based + GetPreciseItemsFromNameResolution(line, colAtEndOfNames, Some(residue), filterCtors, resolveOverloads) | None -> NameResResult.Empty | _ -> NameResResult.Empty @@ -786,8 +900,8 @@ type internal TypeCheckInfo let plid, exactMatchResidueOpt = match origLongIdentOpt, residueOpt with | None, _ -> [], None - | Some(origLongIdent), Some _ -> origLongIdent, None - | Some(origLongIdent), None -> + | Some (origLongIdent), Some _ -> origLongIdent, None + | Some (origLongIdent), None -> Debug.Assert(not (isNil origLongIdent), "origLongIdent is empty") // note: as above, this happens when we are called for "precise" resolution - (F1 keyword, data tip etc..) let plid, residue = List.frontAndBack origLongIdent @@ -796,15 +910,18 @@ type internal TypeCheckInfo let pos = mkPos line loc let (nenv, ad), m = GetBestEnvForPos pos - let getType() = + let getType () = match TryToResolveLongIdentAsType ncenv nenv m plid with | Some x -> tryTcrefOfAppTy g x | None -> - match lastDotPos |> Option.orElseWith (fun _ -> FindFirstNonWhitespacePosition lineStr (colAtEndOfNamesAndResidue - 1)) with + match lastDotPos + |> Option.orElseWith (fun _ -> FindFirstNonWhitespacePosition lineStr (colAtEndOfNamesAndResidue - 1)) + with | Some p when lineStr[p] = '.' -> match FindFirstNonWhitespacePosition lineStr (p - 1) with | Some colAtEndOfNames -> let colAtEndOfNames = colAtEndOfNames + 1 // convert 0-based to 1-based + match TryGetTypeFromNameResolution(line, colAtEndOfNames, residueOpt, resolveOverloads) with | Some x -> tryTcrefOfAppTy g x | _ -> ValueNone @@ -812,10 +929,10 @@ type internal TypeCheckInfo | _ -> ValueNone match nameResItems with - | NameResResult.Cancel(denv,m) -> Some([], denv, m) - | NameResResult.Members(FilterRelevantItems getItem exactMatchResidueOpt (items, denv, m)) -> + | NameResResult.Cancel (denv, m) -> Some([], denv, m) + | NameResResult.Members (FilterRelevantItems getItem exactMatchResidueOpt (items, denv, m)) -> // lookup based on name resolution results successful - Some (items |> List.map (CompletionItem (getType()) ValueNone), denv, m) + Some(items |> List.map (CompletionItem (getType ()) ValueNone), denv, m) | _ -> match origLongIdentOpt with | None -> None @@ -833,25 +950,30 @@ type internal TypeCheckInfo ExprTypingsResult.None, false | Some parseResults -> - let leftOfDot = ParsedInput.TryFindExpressionASTLeftOfDotLeftOfCursor(mkPos line colAtEndOfNamesAndResidue,parseResults.ParseTree) - match leftOfDot with - | Some(pos,_) -> - GetPreciseCompletionListFromExprTypings(parseResults, pos, filterCtors), true - | None -> - // Can get here in a case like: if "f xxx yyy" is legal, and we do "f xxx y" - // We have no interest in expression typings, those are only useful for dot-completion. We want to fallback - // to "Use an environment lookup as the last resort" below - ExprTypingsResult.None, false - - match qualItems,thereIsADotInvolved with - | ExprTypingsResult.Some(FilterRelevantItems getItem exactMatchResidueOpt (items, denv, m), ty), _ - // Initially we only use the expression typings when looking up, e.g. (expr).Nam or (expr).Name1.Nam - // These come through as an empty plid and residue "". Otherwise we try an environment lookup - // and then return to the qualItems. This is because the expression typings are a little inaccurate, primarily because - // it appears we're getting some typings recorded for non-atomic expressions like "f x" - when isNil plid -> + let leftOfDot = + ParsedInput.TryFindExpressionASTLeftOfDotLeftOfCursor( + mkPos line colAtEndOfNamesAndResidue, + parseResults.ParseTree + ) + + match leftOfDot with + | Some (pos, _) -> GetPreciseCompletionListFromExprTypings(parseResults, pos, filterCtors), true + | None -> + // Can get here in a case like: if "f xxx yyy" is legal, and we do "f xxx y" + // We have no interest in expression typings, those are only useful for dot-completion. We want to fallback + // to "Use an environment lookup as the last resort" below + ExprTypingsResult.None, false + + match qualItems, thereIsADotInvolved with + | ExprTypingsResult.Some (FilterRelevantItems getItem exactMatchResidueOpt (items, denv, m), ty), _ when + // Initially we only use the expression typings when looking up, e.g. (expr).Nam or (expr).Name1.Nam + // These come through as an empty plid and residue "". Otherwise we try an environment lookup + // and then return to the qualItems. This is because the expression typings are a little inaccurate, primarily because + // it appears we're getting some typings recorded for non-atomic expressions like "f x" + isNil plid + -> // lookup based on expression typings successful - Some (items |> List.map (CompletionItem (tryTcrefOfAppTy g ty) ValueNone), denv, m) + Some(items |> List.map (CompletionItem (tryTcrefOfAppTy g ty) ValueNone), denv, m) | ExprTypingsResult.NoneBecauseThereWereTypeErrors, _ -> // There was an error, e.g. we have "." and there is an error determining the type of // In this case, we don't want any of the fallback logic, rather, we want to produce zero results. @@ -865,59 +987,67 @@ type internal TypeCheckInfo // Second-chance intellisense will bring up the correct list in a moment. None | _ -> - // Use an environment lookup as the last resort - let envItems, denv, m = GetEnvironmentLookupResolutions(nenv, ad, m, plid, filterCtors, residueOpt.IsSome) + // Use an environment lookup as the last resort + let envItems, denv, m = + GetEnvironmentLookupResolutions(nenv, ad, m, plid, filterCtors, residueOpt.IsSome) - let envResult = - match nameResItems, (envItems, denv, m), qualItems with + let envResult = + match nameResItems, (envItems, denv, m), qualItems with - // First, use unfiltered name resolution items, if they're not empty - | NameResResult.Members(items, denv, m), _, _ when not (isNil items) -> - // lookup based on name resolution results successful - ValueSome(items |> List.map (CompletionItem (getType()) ValueNone), denv, m) + // First, use unfiltered name resolution items, if they're not empty + | NameResResult.Members (items, denv, m), _, _ when not (isNil items) -> + // lookup based on name resolution results successful + ValueSome(items |> List.map (CompletionItem (getType ()) ValueNone), denv, m) - // If we have nonempty items from environment that were resolved from a type, then use them... - // (that's better than the next case - here we'd return 'int' as a type) - | _, FilterRelevantItems getItem exactMatchResidueOpt (items, denv, m), _ when not (isNil items) -> - // lookup based on name and environment successful - ValueSome(items |> List.map (CompletionItem (getType()) ValueNone), denv, m) + // If we have nonempty items from environment that were resolved from a type, then use them... + // (that's better than the next case - here we'd return 'int' as a type) + | _, FilterRelevantItems getItem exactMatchResidueOpt (items, denv, m), _ when not (isNil items) -> + // lookup based on name and environment successful + ValueSome(items |> List.map (CompletionItem (getType ()) ValueNone), denv, m) - // Try again with the qualItems - | _, _, ExprTypingsResult.Some(FilterRelevantItems getItem exactMatchResidueOpt (items, denv, m), ty) -> - ValueSome(items |> List.map (CompletionItem (tryTcrefOfAppTy g ty) ValueNone), denv, m) + // Try again with the qualItems + | _, _, ExprTypingsResult.Some (FilterRelevantItems getItem exactMatchResidueOpt (items, denv, m), ty) -> + ValueSome(items |> List.map (CompletionItem (tryTcrefOfAppTy g ty) ValueNone), denv, m) - | _ -> ValueNone + | _ -> ValueNone - let globalResult = - match origLongIdentOpt with - | None | Some [] -> - let globalItems = - allSymbols() - |> List.filter (fun x -> - not x.Symbol.IsExplicitlySuppressed && + let globalResult = + match origLongIdentOpt with + | None + | Some [] -> + let globalItems = + allSymbols () + |> List.filter (fun x -> + not x.Symbol.IsExplicitlySuppressed + && match x.Symbol with - | :? FSharpMemberOrFunctionOrValue as m when m.IsConstructor && filterCtors = ResolveTypeNamesToTypeRefs -> false + | :? FSharpMemberOrFunctionOrValue as m when + m.IsConstructor && filterCtors = ResolveTypeNamesToTypeRefs + -> + false | _ -> true) - let getItem (x: AssemblySymbol) = x.Symbol.Item - - match globalItems, denv, m with - | FilterRelevantItems getItem exactMatchResidueOpt (globalItemsFiltered, denv, m) when not (isNil globalItemsFiltered) -> - globalItemsFiltered - |> List.map(fun globalItem -> CompletionItem (getType()) (ValueSome globalItem) (ItemWithNoInst globalItem.Symbol.Item)) - |> fun r -> ValueSome(r, denv, m) - | _ -> ValueNone - | _ -> ValueNone // do not return unresolved items after dot - - match envResult, globalResult with - | ValueSome (items, denv, m), ValueSome (gItems,_,_) -> Some (items @ gItems, denv, m) - | ValueSome x, ValueNone -> Some x - | ValueNone, ValueSome y -> Some y - | ValueNone, ValueNone -> None - - - let toCompletionItems (items: ItemWithInst list, denv: DisplayEnv, m: range ) = + let getItem (x: AssemblySymbol) = x.Symbol.Item + + match globalItems, denv, m with + | FilterRelevantItems getItem exactMatchResidueOpt (globalItemsFiltered, denv, m) when + not (isNil globalItemsFiltered) + -> + globalItemsFiltered + |> List.map (fun globalItem -> + CompletionItem (getType ()) (ValueSome globalItem) (ItemWithNoInst globalItem.Symbol.Item)) + |> fun r -> ValueSome(r, denv, m) + | _ -> ValueNone + | _ -> ValueNone // do not return unresolved items after dot + + match envResult, globalResult with + | ValueSome (items, denv, m), ValueSome (gItems, _, _) -> Some(items @ gItems, denv, m) + | ValueSome x, ValueNone -> Some x + | ValueNone, ValueSome y -> Some y + | ValueNone, ValueNone -> None + + let toCompletionItems (items: ItemWithInst list, denv: DisplayEnv, m: range) = items |> List.map DefaultCompletionItem, denv, m /// Find record fields in the best naming environment. @@ -928,18 +1058,31 @@ type internal TypeCheckInfo // Provide both expression items in scope and available record fields. let (nenv, _), m = GetBestEnvForPos cursorPos - let fieldItems, _, _ = GetClassOrRecordFieldsEnvironmentLookupResolutions(cursorPos, plid, true) - let fieldCompletionItems, _, _ as fieldsResult = (fieldItems, nenv.DisplayEnv, m) |> toCompletionItems + let fieldItems, _, _ = + GetClassOrRecordFieldsEnvironmentLookupResolutions(cursorPos, plid, true) + + let fieldCompletionItems, _, _ as fieldsResult = + (fieldItems, nenv.DisplayEnv, m) |> toCompletionItems match envItems with - | Some(items, denv, m) -> Some(fieldCompletionItems @ items, denv, m) + | Some (items, denv, m) -> Some(fieldCompletionItems @ items, denv, m) | _ -> Some(fieldsResult) /// Get the auto-complete items at a particular location. - let GetDeclItemsForNamesAtPosition(parseResultsOpt: FSharpParseFileResults option, origLongIdentOpt: string list option, - residueOpt:string option, lastDotPos: int option, line:int, lineStr:string, colAtEndOfNamesAndResidue, filterCtors, resolveOverloads, - completionContextAtPos: (pos * CompletionContext option) option, getAllSymbols: unit -> AssemblySymbol list) - : (CompletionItem list * DisplayEnv * CompletionContext option * range) option = + let GetDeclItemsForNamesAtPosition + ( + parseResultsOpt: FSharpParseFileResults option, + origLongIdentOpt: string list option, + residueOpt: string option, + lastDotPos: int option, + line: int, + lineStr: string, + colAtEndOfNamesAndResidue, + filterCtors, + resolveOverloads, + completionContextAtPos: (pos * CompletionContext option) option, + getAllSymbols: unit -> AssemblySymbol list + ) : (CompletionItem list * DisplayEnv * CompletionContext option * range) option = let loc = match colAtEndOfNamesAndResidue with @@ -967,107 +1110,198 @@ type internal TypeCheckInfo | Some CompletionContext.Invalid -> None // Completion at 'inherit C(...)" - | Some (CompletionContext.Inherit(InheritanceContext.Class, (plid, _))) -> + | Some (CompletionContext.Inherit (InheritanceContext.Class, (plid, _))) -> GetEnvironmentLookupResolutionsAtPosition(mkPos line loc, plid, filterCtors, false) |> FilterRelevantItemsBy getItem None (getItem >> GetBaseClassCandidates) |> Option.map toCompletionItems // Completion at 'interface ..." - | Some (CompletionContext.Inherit(InheritanceContext.Interface, (plid, _))) -> + | Some (CompletionContext.Inherit (InheritanceContext.Interface, (plid, _))) -> GetEnvironmentLookupResolutionsAtPosition(mkPos line loc, plid, filterCtors, false) |> FilterRelevantItemsBy getItem None (getItem >> GetInterfaceCandidates) |> Option.map toCompletionItems // Completion at 'implement ..." - | Some (CompletionContext.Inherit(InheritanceContext.Unknown, (plid, _))) -> + | Some (CompletionContext.Inherit (InheritanceContext.Unknown, (plid, _))) -> GetEnvironmentLookupResolutionsAtPosition(mkPos line loc, plid, filterCtors, false) |> FilterRelevantItemsBy getItem None (getItem >> (fun t -> GetBaseClassCandidates t || GetInterfaceCandidates t)) |> Option.map toCompletionItems // Completion at ' { XXX = ... } " - | Some(CompletionContext.RecordField(RecordContext.New((plid, _), isFirstField))) -> + | Some (CompletionContext.RecordField (RecordContext.New ((plid, _), isFirstField))) -> if isFirstField then let cursorPos = mkPos line loc - let envItems = GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, filterCtors,resolveOverloads, false, fun () -> []) + + let envItems = + GetDeclaredItems( + parseResultsOpt, + lineStr, + origLongIdentOpt, + colAtEndOfNamesAndResidue, + residueOpt, + lastDotPos, + line, + loc, + filterCtors, + resolveOverloads, + false, + fun () -> [] + ) + GetEnvironmentLookupResolutionsIncludingRecordFieldsAtPosition cursorPos plid envItems else // { x. } can be either record construction or computation expression. Try to get all visible record fields first - match GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, plid, false) |> toCompletionItems with - | [],_,_ -> + match + GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, plid, false) + |> toCompletionItems + with + | [], _, _ -> // no record fields found, return completion list as if we were outside any computation expression - GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, filterCtors,resolveOverloads, false, fun() -> []) + GetDeclaredItems( + parseResultsOpt, + lineStr, + origLongIdentOpt, + colAtEndOfNamesAndResidue, + residueOpt, + lastDotPos, + line, + loc, + filterCtors, + resolveOverloads, + false, + fun () -> [] + ) | result -> Some(result) // Completion at '{ ... }' - | Some(CompletionContext.RecordField RecordContext.Empty) -> + | Some (CompletionContext.RecordField RecordContext.Empty) -> let cursorPos = mkPos line loc - let envItems = GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, filterCtors,resolveOverloads, false, fun () -> []) - GetEnvironmentLookupResolutionsIncludingRecordFieldsAtPosition cursorPos [] envItems + + let envItems = + GetDeclaredItems( + parseResultsOpt, + lineStr, + origLongIdentOpt, + colAtEndOfNamesAndResidue, + residueOpt, + lastDotPos, + line, + loc, + filterCtors, + resolveOverloads, + false, + fun () -> [] + ) + + GetEnvironmentLookupResolutionsIncludingRecordFieldsAtPosition cursorPos [] envItems // Completion at ' { XXX = ... with ... } " - | Some(CompletionContext.RecordField(RecordContext.CopyOnUpdate(r, (plid, _)))) -> + | Some (CompletionContext.RecordField (RecordContext.CopyOnUpdate (r, (plid, _)))) -> match GetRecdFieldsForExpr(r) with | None -> - Some (GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, plid, false)) - |> Option.map toCompletionItems - | Some (items, denv, m) -> - Some (List.map ItemWithNoInst items, denv, m) + Some(GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, plid, false)) |> Option.map toCompletionItems + | Some (items, denv, m) -> Some(List.map ItemWithNoInst items, denv, m) |> Option.map toCompletionItems // Completion at ' { XXX = ... with ... } " - | Some(CompletionContext.RecordField(RecordContext.Constructor(typeName))) -> - Some(GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, [typeName], false)) + | Some (CompletionContext.RecordField (RecordContext.Constructor (typeName))) -> + Some(GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, [ typeName ], false)) |> Option.map toCompletionItems // No completion at '...: string' - | Some(CompletionContext.RecordField(RecordContext.Declaration true)) -> None + | Some (CompletionContext.RecordField (RecordContext.Declaration true)) -> None // Completion at ' SomeMethod( ... ) ' with named arguments - | Some(CompletionContext.ParameterList (endPos, fields)) -> + | Some (CompletionContext.ParameterList (endPos, fields)) -> let results = GetNamedParametersAndSettableFields endPos let declaredItems = - GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, filterCtors, resolveOverloads, - false, getAllSymbols) + GetDeclaredItems( + parseResultsOpt, + lineStr, + origLongIdentOpt, + colAtEndOfNamesAndResidue, + residueOpt, + lastDotPos, + line, + loc, + filterCtors, + resolveOverloads, + false, + getAllSymbols + ) match results with - | NameResResult.Members(items, denv, m) -> + | NameResResult.Members (items, denv, m) -> let filtered = items |> RemoveDuplicateItems g |> RemoveExplicitlySuppressed g |> List.filter (fun item -> not (fields.Contains item.Item.DisplayName)) |> List.map (fun item -> - { ItemWithInst = item - Kind = CompletionItemKind.Argument - MinorPriority = 0 - IsOwnMember = false - Type = None - Unresolved = None }) + { + ItemWithInst = item + Kind = CompletionItemKind.Argument + MinorPriority = 0 + IsOwnMember = false + Type = None + Unresolved = None + }) + match declaredItems with - | None -> Some (toCompletionItems (items, denv, m)) - | Some (declItems, declaredDisplayEnv, declaredRange) -> Some (filtered @ declItems, declaredDisplayEnv, declaredRange) + | None -> Some(toCompletionItems (items, denv, m)) + | Some (declItems, declaredDisplayEnv, declaredRange) -> Some(filtered @ declItems, declaredDisplayEnv, declaredRange) | _ -> declaredItems - | Some(CompletionContext.AttributeApplication) -> - GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, filterCtors, resolveOverloads, false, getAllSymbols) + | Some (CompletionContext.AttributeApplication) -> + GetDeclaredItems( + parseResultsOpt, + lineStr, + origLongIdentOpt, + colAtEndOfNamesAndResidue, + residueOpt, + lastDotPos, + line, + loc, + filterCtors, + resolveOverloads, + false, + getAllSymbols + ) |> Option.map (fun (items, denv, m) -> - items - |> List.filter (fun cItem -> - match cItem.Item with - | Item.ModuleOrNamespaces _ -> true - | _ when IsAttribute infoReader cItem.Item -> true - | _ -> false), denv, m) - - | Some(CompletionContext.OpenDeclaration isOpenType) -> - GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, filterCtors, resolveOverloads, false, getAllSymbols) + items + |> List.filter (fun cItem -> + match cItem.Item with + | Item.ModuleOrNamespaces _ -> true + | _ when IsAttribute infoReader cItem.Item -> true + | _ -> false), + denv, + m) + + | Some (CompletionContext.OpenDeclaration isOpenType) -> + GetDeclaredItems( + parseResultsOpt, + lineStr, + origLongIdentOpt, + colAtEndOfNamesAndResidue, + residueOpt, + lastDotPos, + line, + loc, + filterCtors, + resolveOverloads, + false, + getAllSymbols + ) |> Option.map (fun (items, denv, m) -> items |> List.filter (fun x -> match x.Item with | Item.ModuleOrNamespaces _ -> true | Item.Types _ when isOpenType -> true - | _ -> false), denv, m) + | _ -> false), + denv, + m) // Completion at '(x: ...)" | Some CompletionContext.PatternType @@ -1076,8 +1310,21 @@ type internal TypeCheckInfo // Completion at 'type Long = int6...' or 'type SomeUnion = Abc...' | Some CompletionContext.TypeAbbreviationOrSingleCaseUnion // Completion at 'Field1: ...' - | Some(CompletionContext.RecordField(RecordContext.Declaration false)) -> - GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, residueOpt, lastDotPos, line, loc, filterCtors, resolveOverloads, false, getAllSymbols) + | Some (CompletionContext.RecordField (RecordContext.Declaration false)) -> + GetDeclaredItems( + parseResultsOpt, + lineStr, + origLongIdentOpt, + colAtEndOfNamesAndResidue, + residueOpt, + lastDotPos, + line, + loc, + filterCtors, + resolveOverloads, + false, + getAllSymbols + ) |> Option.map (fun (items, denv, m) -> items |> List.filter (fun cItem -> @@ -1087,7 +1334,9 @@ type internal TypeCheckInfo | Item.TypeVar _ | Item.UnqualifiedType _ | Item.ExnCase _ -> true - | _ -> false), denv, m) + | _ -> false), + denv, + m) // Other completions | cc -> @@ -1100,21 +1349,37 @@ type internal TypeCheckInfo // because providing generic parameters list is context aware, which we don't have here (yet). None | _ -> - let isInRangeOperator = (match cc with Some CompletionContext.RangeOperator -> true | _ -> false) - GetDeclaredItems (parseResultsOpt, lineStr, origLongIdentOpt, colAtEndOfNamesAndResidue, - residueOpt, lastDotPos, line, loc, filterCtors, resolveOverloads, - isInRangeOperator, getAllSymbols) + let isInRangeOperator = + (match cc with + | Some CompletionContext.RangeOperator -> true + | _ -> false) + + GetDeclaredItems( + parseResultsOpt, + lineStr, + origLongIdentOpt, + colAtEndOfNamesAndResidue, + residueOpt, + lastDotPos, + line, + loc, + filterCtors, + resolveOverloads, + isInRangeOperator, + getAllSymbols + ) res |> Option.map (fun (items, denv, m) -> items, denv, completionContext, m) /// Return 'false' if this is not a completion item valid in an interface file. let IsValidSignatureFileItem item = match item with - | Item.Types _ | Item.ModuleOrNamespaces _ -> true + | Item.Types _ + | Item.ModuleOrNamespaces _ -> true | _ -> false /// Find the most precise display context for the given line and column. - member _.GetBestDisplayEnvForPos cursorPos = GetBestEnvForPos cursorPos + member _.GetBestDisplayEnvForPos cursorPos = GetBestEnvForPos cursorPos member _.GetVisibleNamespacesAndModulesAtPosition(cursorPos: pos) : ModuleOrNamespaceRef list = let (nenv, ad), m = GetBestEnvForPos cursorPos @@ -1137,48 +1402,93 @@ type internal TypeCheckInfo scope.IsRelativeNameResolvable(cursorPos, plid, symbol.Item) /// Get the auto-complete items at a location - member _.GetDeclarations (parseResultsOpt, line, lineStr, partialName, completionContextAtPos, getAllEntities) = + member _.GetDeclarations(parseResultsOpt, line, lineStr, partialName, completionContextAtPos, getAllEntities) = let isInterfaceFile = SourceFileImpl.IsInterfaceFile mainInputFileName - DiagnosticsScope.Protect range0 + + DiagnosticsScope.Protect + range0 (fun () -> let declItemsOpt = - GetDeclItemsForNamesAtPosition(parseResultsOpt, Some partialName.QualifyingIdents, - Some partialName.PartialIdent, partialName.LastDotPos, line, - lineStr, partialName.EndColumn + 1, ResolveTypeNamesToCtors, ResolveOverloads.Yes, - completionContextAtPos, getAllEntities) + GetDeclItemsForNamesAtPosition( + parseResultsOpt, + Some partialName.QualifyingIdents, + Some partialName.PartialIdent, + partialName.LastDotPos, + line, + lineStr, + partialName.EndColumn + 1, + ResolveTypeNamesToCtors, + ResolveOverloads.Yes, + completionContextAtPos, + getAllEntities + ) match declItemsOpt with | None -> DeclarationListInfo.Empty | Some (items, denv, ctx, m) -> - let items = if isInterfaceFile then items |> List.filter (fun x -> IsValidSignatureFileItem x.Item) else items - let getAccessibility item = FSharpSymbol.Create(cenv, item).Accessibility + let items = + if isInterfaceFile then + items |> List.filter (fun x -> IsValidSignatureFileItem x.Item) + else + items + + let getAccessibility item = + FSharpSymbol.Create(cenv, item).Accessibility + let currentNamespaceOrModule = parseResultsOpt |> Option.map (fun x -> x.ParseTree) - |> Option.map (fun parsedInput -> ParsedInput.GetFullNameOfSmallestModuleOrNamespaceAtPoint(mkPos line 0, parsedInput)) + |> Option.map (fun parsedInput -> + ParsedInput.GetFullNameOfSmallestModuleOrNamespaceAtPoint(mkPos line 0, parsedInput)) + let isAttributeApplication = ctx = Some CompletionContext.AttributeApplication - DeclarationListInfo.Create(infoReader,tcAccessRights,m,denv,getAccessibility,items,currentNamespaceOrModule,isAttributeApplication)) + + DeclarationListInfo.Create( + infoReader, + tcAccessRights, + m, + denv, + getAccessibility, + items, + currentNamespaceOrModule, + isAttributeApplication + )) (fun msg -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetDeclarations: '%s'" msg) DeclarationListInfo.Error msg) /// Get the symbols for auto-complete items at a location - member _.GetDeclarationListSymbols (parseResultsOpt, line, lineStr, partialName, getAllEntities) = + member _.GetDeclarationListSymbols(parseResultsOpt, line, lineStr, partialName, getAllEntities) = let isInterfaceFile = SourceFileImpl.IsInterfaceFile mainInputFileName - DiagnosticsScope.Protect range0 + + DiagnosticsScope.Protect + range0 (fun () -> let declItemsOpt = - GetDeclItemsForNamesAtPosition(parseResultsOpt, Some partialName.QualifyingIdents, - Some partialName.PartialIdent, partialName.LastDotPos, line, lineStr, - partialName.EndColumn + 1, ResolveTypeNamesToCtors, ResolveOverloads.Yes, - None, getAllEntities) + GetDeclItemsForNamesAtPosition( + parseResultsOpt, + Some partialName.QualifyingIdents, + Some partialName.PartialIdent, + partialName.LastDotPos, + line, + lineStr, + partialName.EndColumn + 1, + ResolveTypeNamesToCtors, + ResolveOverloads.Yes, + None, + getAllEntities + ) match declItemsOpt with | None -> List.Empty | Some (items, denv, _, m) -> - let items = if isInterfaceFile then items |> List.filter (fun x -> IsValidSignatureFileItem x.Item) else items + let items = + if isInterfaceFile then + items |> List.filter (fun x -> IsValidSignatureFileItem x.Item) + else + items //do filtering like Declarationset let items = items |> RemoveExplicitlySuppressedCompletionItems g @@ -1187,16 +1497,18 @@ type internal TypeCheckInfo // - show types with fewer generic parameters first // - show types before over other related items - they usually have very useful XmlDocs let items = - items |> List.sortBy (fun d -> + items + |> List.sortBy (fun d -> let n = match d.Item with - | Item.Types (_, TType_app(tcref, _, _) :: _) -> 1 + tcref.TyparsNoRange.Length + | Item.Types (_, TType_app (tcref, _, _) :: _) -> 1 + tcref.TyparsNoRange.Length // Put delegate ctors after types, sorted by #typars. RemoveDuplicateItems will remove FakeInterfaceCtor and DelegateCtor if an earlier type is also reported with this name - | Item.FakeInterfaceCtor (TType_app(tcref, _, _)) - | Item.DelegateCtor (TType_app(tcref, _, _)) -> 1000 + tcref.TyparsNoRange.Length + | Item.FakeInterfaceCtor (TType_app (tcref, _, _)) + | Item.DelegateCtor (TType_app (tcref, _, _)) -> 1000 + tcref.TyparsNoRange.Length // Put type ctors after types, sorted by #typars. RemoveDuplicateItems will remove DefaultStructCtors if a type is also reported with this name | Item.CtorGroup (_, cinfo :: _) -> 1000 + 10 * cinfo.DeclaringTyconRef.TyparsNoRange.Length | _ -> 0 + (d.Item.DisplayName, n)) // Remove all duplicates. We've put the types first, so this removes the DelegateCtor and DefaultStructCtor's. @@ -1205,40 +1517,43 @@ type internal TypeCheckInfo // Group by compiled name for types, display name for functions // (We don't want types with the same display name to be grouped as overloads) let items = - items |> List.groupBy (fun d -> + items + |> List.groupBy (fun d -> match d.Item with - | Item.Types (_,TType_app(tcref, _, _) :: _) + | Item.Types (_, TType_app (tcref, _, _) :: _) | Item.ExnCase tcref -> tcref.LogicalName - | Item.UnqualifiedType(tcref :: _) - | Item.FakeInterfaceCtor (TType_app(tcref, _, _)) - | Item.DelegateCtor (TType_app(tcref, _, _)) -> tcref.CompiledName - | Item.CtorGroup (_, cinfo :: _) -> - cinfo.ApparentEnclosingTyconRef.CompiledName + | Item.UnqualifiedType (tcref :: _) + | Item.FakeInterfaceCtor (TType_app (tcref, _, _)) + | Item.DelegateCtor (TType_app (tcref, _, _)) -> tcref.CompiledName + | Item.CtorGroup (_, cinfo :: _) -> cinfo.ApparentEnclosingTyconRef.CompiledName | _ -> d.Item.DisplayName) // Filter out operators (and list) let items = // Check whether this item looks like an operator. - let isOpItem(nm, item: CompletionItem list) = + let isOpItem (nm, item: CompletionItem list) = match item |> List.map (fun x -> x.Item) with - | [Item.Value _] - | [Item.MethodGroup(_,[_],_)] -> IsOperatorDisplayName nm - | [Item.UnionCase _] -> IsOperatorDisplayName nm + | [ Item.Value _ ] + | [ Item.MethodGroup (_, [ _ ], _) ] -> IsOperatorDisplayName nm + | [ Item.UnionCase _ ] -> IsOperatorDisplayName nm | _ -> false let isFSharpList nm = (nm = "[]") // list shows up as a Type and a UnionCase, only such entity with a symbolic name, but want to filter out of intellisense - items |> List.filter (fun (nm,items) -> not (isOpItem(nm,items)) && not(isFSharpList nm)) + items + |> List.filter (fun (nm, items) -> not (isOpItem (nm, items)) && not (isFSharpList nm)) let items = // Filter out duplicate names - items |> List.map (fun (_nm,itemsWithSameName) -> + items + |> List.map (fun (_nm, itemsWithSameName) -> match itemsWithSameName with | [] -> failwith "Unexpected empty bag" | items -> items - |> List.map (fun item -> let symbol = FSharpSymbol.Create(cenv, item.Item) - FSharpSymbolUse(denv, symbol, item.ItemWithInst.TyparInstantiation, ItemOccurence.Use, m))) + |> List.map (fun item -> + let symbol = FSharpSymbol.Create(cenv, item.Item) + FSharpSymbolUse(denv, symbol, item.ItemWithInst.TyparInstantiation, ItemOccurence.Use, m))) //end filtering items) @@ -1247,53 +1562,65 @@ type internal TypeCheckInfo []) /// Get the "reference resolution" tooltip for at a location - member _.GetReferenceResolutionStructuredToolTipText(line,col) = + member _.GetReferenceResolutionStructuredToolTipText(line, col) = let pos = mkPos line col - let isPosMatch(pos, ar:AssemblyReference) : bool = + + let isPosMatch (pos, ar: AssemblyReference) : bool = let isRangeMatch = (rangeContainsPos ar.Range pos) - let isNotSpecialRange = not (equals ar.Range rangeStartup) && not (equals ar.Range range0) && not (equals ar.Range rangeCmdArgs) + + let isNotSpecialRange = + not (equals ar.Range rangeStartup) + && not (equals ar.Range range0) + && not (equals ar.Range rangeCmdArgs) + let isMatch = isRangeMatch && isNotSpecialRange isMatch - let dataTipOfReferences() = + let dataTipOfReferences () = let matches = match loadClosure with | None -> [] - | Some(loadClosure) -> + | Some (loadClosure) -> loadClosure.References |> List.collect snd - |> List.filter(fun ar -> isPosMatch(pos, ar.originalReference)) + |> List.filter (fun ar -> isPosMatch (pos, ar.originalReference)) match matches with - | resolved::_ // Take the first seen - | [resolved] -> - let tip = wordL (TaggedText.tagStringLiteral((resolved.prepareToolTip ()).TrimEnd([|'\n'|]))) + | resolved :: _ // Take the first seen + | [ resolved ] -> + let tip = + wordL (TaggedText.tagStringLiteral ((resolved.prepareToolTip ()).TrimEnd([| '\n' |]))) + let tip = LayoutRender.toArray tip - ToolTipText.ToolTipText [ToolTipElement.Single(tip, FSharpXmlDoc.None)] + ToolTipText.ToolTipText [ ToolTipElement.Single(tip, FSharpXmlDoc.None) ] | [] -> let matches = match loadClosure with | None -> None - | Some(loadClosure) -> + | Some (loadClosure) -> loadClosure.PackageReferences |> Array.tryFind (fun (m, _) -> rangeContainsPos m pos) + match matches with | None -> emptyToolTip | Some (_, lines) -> - let lines = lines |> List.filter (fun line -> not (line.StartsWith("//")) && not (String.IsNullOrEmpty line)) + let lines = + lines + |> List.filter (fun line -> not (line.StartsWith("//")) && not (String.IsNullOrEmpty line)) + ToolTipText.ToolTipText - [ for line in lines -> - let tip = wordL (TaggedText.tagStringLiteral line) - let tip = LayoutRender.toArray tip - ToolTipElement.Single(tip, FSharpXmlDoc.None)] + [ + for line in lines -> + let tip = wordL (TaggedText.tagStringLiteral line) + let tip = LayoutRender.toArray tip + ToolTipElement.Single(tip, FSharpXmlDoc.None) + ] - DiagnosticsScope.Protect range0 - dataTipOfReferences - (fun err -> - Trace.TraceInformation(sprintf "FCS: recovering from error in GetReferenceResolutionStructuredToolTipText: '%s'" err) - ToolTipText [ToolTipElement.CompositionError err]) + DiagnosticsScope.Protect range0 dataTipOfReferences (fun err -> + Trace.TraceInformation(sprintf "FCS: recovering from error in GetReferenceResolutionStructuredToolTipText: '%s'" err) + ToolTipText [ ToolTipElement.CompositionError err ]) member _.GetDescription(symbol: FSharpSymbol, inst: (FSharpGenericParameter * FSharpType) list, displayFullName, m: range) = let (nenv, accessorDomain), _ = GetBestEnvForPos m.Start @@ -1301,244 +1628,358 @@ type internal TypeCheckInfo let item = symbol.Item let inst = inst |> List.map (fun (typar, t) -> typar.TypeParameter, t.Type) - let itemWithInst = { ItemWithInst.Item = item; ItemWithInst.TyparInstantiation = inst } - let toolTipElement = FormatStructuredDescriptionOfItem displayFullName infoReader accessorDomain m denv itemWithInst - ToolTipText [toolTipElement] + let itemWithInst = + { + ItemWithInst.Item = item + ItemWithInst.TyparInstantiation = inst + } + + let toolTipElement = + FormatStructuredDescriptionOfItem displayFullName infoReader accessorDomain m denv itemWithInst + + ToolTipText [ toolTipElement ] // GetToolTipText: return the "pop up" (or "Quick Info") text given a certain context. member _.GetStructuredToolTipText(line, lineStr, colAtEndOfNames, names) = - let Compute() = - DiagnosticsScope.Protect range0 + let Compute () = + DiagnosticsScope.Protect + range0 (fun () -> let declItemsOpt = - GetDeclItemsForNamesAtPosition(None, Some names, None, None, - line, lineStr, colAtEndOfNames, ResolveTypeNamesToCtors, - ResolveOverloads.Yes, None, (fun() -> [])) + GetDeclItemsForNamesAtPosition( + None, + Some names, + None, + None, + line, + lineStr, + colAtEndOfNames, + ResolveTypeNamesToCtors, + ResolveOverloads.Yes, + None, + (fun () -> []) + ) match declItemsOpt with | None -> emptyToolTip - | Some(items, denv, _, m) -> - ToolTipText(items |> List.map (fun x -> FormatStructuredDescriptionOfItem false infoReader tcAccessRights m denv x.ItemWithInst))) + | Some (items, denv, _, m) -> + ToolTipText( + items + |> List.map (fun x -> FormatStructuredDescriptionOfItem false infoReader tcAccessRights m denv x.ItemWithInst) + )) (fun err -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetStructuredToolTipText: '%s'" err) - ToolTipText [ToolTipElement.CompositionError err]) + ToolTipText [ ToolTipElement.CompositionError err ]) // See devdiv bug 646520 for rationale behind truncating and caching these quick infos (they can be big!) - let key = line,colAtEndOfNames,lineStr - match getToolTipTextCache.TryGet (AnyCallerThread, key) with + let key = line, colAtEndOfNames, lineStr + + match getToolTipTextCache.TryGet(AnyCallerThread, key) with | Some res -> res | None -> - let res = Compute() - getToolTipTextCache.Put(AnyCallerThread, key,res) - res + let res = Compute() + getToolTipTextCache.Put(AnyCallerThread, key, res) + res - member _.GetF1Keyword (line, lineStr, colAtEndOfNames, names) : string option = - DiagnosticsScope.Protect range0 + member _.GetF1Keyword(line, lineStr, colAtEndOfNames, names) : string option = + DiagnosticsScope.Protect + range0 (fun () -> let declItemsOpt = - GetDeclItemsForNamesAtPosition(None, Some names, None, None, - line, lineStr, colAtEndOfNames, ResolveTypeNamesToCtors, - ResolveOverloads.No, None, (fun() -> [])) + GetDeclItemsForNamesAtPosition( + None, + Some names, + None, + None, + line, + lineStr, + colAtEndOfNames, + ResolveTypeNamesToCtors, + ResolveOverloads.No, + None, + (fun () -> []) + ) match declItemsOpt with | None -> None - | Some (items: CompletionItem list, _,_, _) -> + | Some (items: CompletionItem list, _, _, _) -> match items with | [] -> None - | [item] -> - GetF1Keyword g item.Item + | [ item ] -> GetF1Keyword g item.Item | _ -> // handle new Type() let allTypes, constr, ty = List.fold - (fun (allTypes,constr,ty) (item: CompletionItem) -> + (fun (allTypes, constr, ty) (item: CompletionItem) -> match item.Item, constr, ty with - | Item.Types _ as t, _, None -> allTypes, constr, Some t - | Item.Types _, _, _ -> allTypes, constr, ty - | Item.CtorGroup _, None, _ -> allTypes, Some item.Item, ty - | _ -> false, None, None) - (true,None,None) items + | Item.Types _ as t, _, None -> allTypes, constr, Some t + | Item.Types _, _, _ -> allTypes, constr, ty + | Item.CtorGroup _, None, _ -> allTypes, Some item.Item, ty + | _ -> false, None, None) + (true, None, None) + items + match allTypes, constr, ty with - | true, Some (Item.CtorGroup _ as item), _ - -> GetF1Keyword g item - | true, _, Some ty - -> GetF1Keyword g ty - | _ -> None - ) + | true, Some (Item.CtorGroup _ as item), _ -> GetF1Keyword g item + | true, _, Some ty -> GetF1Keyword g ty + | _ -> None) (fun msg -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetF1Keyword: '%s'" msg) None) - member _.GetMethods (line, lineStr, colAtEndOfNames, namesOpt) = - DiagnosticsScope.Protect range0 + member _.GetMethods(line, lineStr, colAtEndOfNames, namesOpt) = + DiagnosticsScope.Protect + range0 (fun () -> let declItemsOpt = - GetDeclItemsForNamesAtPosition(None, namesOpt, None, None, - line, lineStr, colAtEndOfNames, ResolveTypeNamesToCtors, - ResolveOverloads.No, None, (fun() -> [])) + GetDeclItemsForNamesAtPosition( + None, + namesOpt, + None, + None, + line, + lineStr, + colAtEndOfNames, + ResolveTypeNamesToCtors, + ResolveOverloads.No, + None, + (fun () -> []) + ) match declItemsOpt with - | None -> MethodGroup("",[| |]) + | None -> MethodGroup("", [||]) | Some (items, denv, _, m) -> // GetDeclItemsForNamesAtPosition returns Items.Types and Item.CtorGroup for `new T(|)`, // the Item.Types is not needed here as it duplicates (at best) parameterless ctor. - let ctors = items |> List.filter (fun x -> match x.Item with Item.CtorGroup _ -> true | _ -> false) + let ctors = + items + |> List.filter (fun x -> + match x.Item with + | Item.CtorGroup _ -> true + | _ -> false) + let items = match ctors with | [] -> items | ctors -> ctors + MethodGroup.Create(infoReader, tcAccessRights, m, denv, items |> List.map (fun x -> x.ItemWithInst))) (fun msg -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetMethods: '%s'" msg) - MethodGroup(msg,[| |])) + MethodGroup(msg, [||])) - member _.GetMethodsAsSymbols (line, lineStr, colAtEndOfNames, names) = - DiagnosticsScope.Protect range0 + member _.GetMethodsAsSymbols(line, lineStr, colAtEndOfNames, names) = + DiagnosticsScope.Protect + range0 (fun () -> let declItemsOpt = - GetDeclItemsForNamesAtPosition (None, Some names, None, - None, line, lineStr, colAtEndOfNames, - ResolveTypeNamesToCtors, ResolveOverloads.No, - None, (fun() -> [])) + GetDeclItemsForNamesAtPosition( + None, + Some names, + None, + None, + line, + lineStr, + colAtEndOfNames, + ResolveTypeNamesToCtors, + ResolveOverloads.No, + None, + (fun () -> []) + ) match declItemsOpt with - | None | Some ([],_,_,_) -> None + | None + | Some ([], _, _, _) -> None | Some (items, denv, _, m) -> - let allItems = items |> List.collect (fun item -> FlattenItems g m item.ItemWithInst) - let symbols = allItems |> List.map (fun item -> FSharpSymbol.Create(cenv, item.Item), item) - Some (symbols, denv, m) - ) + let allItems = + items |> List.collect (fun item -> FlattenItems g m item.ItemWithInst) + + let symbols = + allItems |> List.map (fun item -> FSharpSymbol.Create(cenv, item.Item), item) + + Some(symbols, denv, m)) (fun msg -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetMethodsAsSymbols: '%s'" msg) None) - member _.GetDeclarationLocation (line, lineStr, colAtEndOfNames, names, preferFlag) = - DiagnosticsScope.Protect range0 + member _.GetDeclarationLocation(line, lineStr, colAtEndOfNames, names, preferFlag) = + DiagnosticsScope.Protect + range0 (fun () -> let declItemsOpt = - GetDeclItemsForNamesAtPosition (None, Some names, None, None, - line, lineStr, colAtEndOfNames, ResolveTypeNamesToCtors, - ResolveOverloads.Yes, None, (fun() -> [])) + GetDeclItemsForNamesAtPosition( + None, + Some names, + None, + None, + line, + lineStr, + colAtEndOfNames, + ResolveTypeNamesToCtors, + ResolveOverloads.Yes, + None, + (fun () -> []) + ) match declItemsOpt with | None - | Some ([], _, _, _) -> FindDeclResult.DeclNotFound (FindDeclFailureReason.Unknown "") + | Some ([], _, _, _) -> FindDeclResult.DeclNotFound(FindDeclFailureReason.Unknown "") | Some (item :: _, _, _, _) -> - let getTypeVarNames (ilinfo: ILMethInfo) = - let classTypeParams = ilinfo.DeclaringTyconRef.ILTyconRawMetadata.GenericParams |> List.map (fun paramDef -> paramDef.Name) - let methodTypeParams = ilinfo.FormalMethodTypars |> List.map (fun ty -> ty.Name) - classTypeParams @ methodTypeParams |> Array.ofList + let getTypeVarNames (ilinfo: ILMethInfo) = + let classTypeParams = + ilinfo.DeclaringTyconRef.ILTyconRawMetadata.GenericParams + |> List.map (fun paramDef -> paramDef.Name) + + let methodTypeParams = ilinfo.FormalMethodTypars |> List.map (fun ty -> ty.Name) + classTypeParams @ methodTypeParams |> Array.ofList + + let result = + match item.Item with + | Item.CtorGroup (_, ILMeth (_, ilinfo, _) :: _) -> + match ilinfo.MetadataScope with + | ILScopeRef.Assembly assemblyRef -> + let typeVarNames = getTypeVarNames ilinfo - let result = - match item.Item with - | Item.CtorGroup (_, ILMeth (_,ilinfo,_) :: _) -> - match ilinfo.MetadataScope with - | ILScopeRef.Assembly assemblyRef -> - let typeVarNames = getTypeVarNames ilinfo - FindDeclExternalParam.tryOfILTypes typeVarNames ilinfo.ILMethodRef.ArgTypes - |> Option.map (fun args -> - let externalSym = FindDeclExternalSymbol.Constructor (ilinfo.ILMethodRef.DeclaringTypeRef.FullName, args) - FindDeclResult.ExternalDecl (assemblyRef.Name, externalSym)) - | _ -> None + FindDeclExternalParam.tryOfILTypes typeVarNames ilinfo.ILMethodRef.ArgTypes + |> Option.map (fun args -> + let externalSym = + FindDeclExternalSymbol.Constructor(ilinfo.ILMethodRef.DeclaringTypeRef.FullName, args) - | Item.MethodGroup (name, ILMeth (_,ilinfo,_) :: _, _) -> - match ilinfo.MetadataScope with - | ILScopeRef.Assembly assemblyRef -> - let typeVarNames = getTypeVarNames ilinfo - FindDeclExternalParam.tryOfILTypes typeVarNames ilinfo.ILMethodRef.ArgTypes - |> Option.map (fun args -> - let externalSym = FindDeclExternalSymbol.Method (ilinfo.ILMethodRef.DeclaringTypeRef.FullName, name, args, ilinfo.ILMethodRef.GenericArity) - FindDeclResult.ExternalDecl (assemblyRef.Name, externalSym)) - | _ -> None + FindDeclResult.ExternalDecl(assemblyRef.Name, externalSym)) + | _ -> None - | Item.Property (name, ILProp propInfo :: _) -> - let methInfo = - if propInfo.HasGetter then Some propInfo.GetterMethod - elif propInfo.HasSetter then Some propInfo.SetterMethod - else None + | Item.MethodGroup (name, ILMeth (_, ilinfo, _) :: _, _) -> + match ilinfo.MetadataScope with + | ILScopeRef.Assembly assemblyRef -> + let typeVarNames = getTypeVarNames ilinfo + + FindDeclExternalParam.tryOfILTypes typeVarNames ilinfo.ILMethodRef.ArgTypes + |> Option.map (fun args -> + let externalSym = + FindDeclExternalSymbol.Method( + ilinfo.ILMethodRef.DeclaringTypeRef.FullName, + name, + args, + ilinfo.ILMethodRef.GenericArity + ) + + FindDeclResult.ExternalDecl(assemblyRef.Name, externalSym)) + | _ -> None - match methInfo with - | Some methInfo -> - match methInfo.MetadataScope with + | Item.Property (name, ILProp propInfo :: _) -> + let methInfo = + if propInfo.HasGetter then Some propInfo.GetterMethod + elif propInfo.HasSetter then Some propInfo.SetterMethod + else None + + match methInfo with + | Some methInfo -> + match methInfo.MetadataScope with + | ILScopeRef.Assembly assemblyRef -> + let externalSym = + FindDeclExternalSymbol.Property(methInfo.ILMethodRef.DeclaringTypeRef.FullName, name) + + Some(FindDeclResult.ExternalDecl(assemblyRef.Name, externalSym)) + | _ -> None + | None -> None + + | Item.ILField (ILFieldInfo (typeInfo, fieldDef)) when not typeInfo.TyconRefOfRawMetadata.IsLocalRef -> + match typeInfo.ILScopeRef with | ILScopeRef.Assembly assemblyRef -> - let externalSym = FindDeclExternalSymbol.Property (methInfo.ILMethodRef.DeclaringTypeRef.FullName, name) - Some (FindDeclResult.ExternalDecl (assemblyRef.Name, externalSym)) + let externalSym = + FindDeclExternalSymbol.Field(typeInfo.ILTypeRef.FullName, fieldDef.Name) + + Some(FindDeclResult.ExternalDecl(assemblyRef.Name, externalSym)) | _ -> None - | None -> None - | Item.ILField (ILFieldInfo (typeInfo, fieldDef)) when not typeInfo.TyconRefOfRawMetadata.IsLocalRef -> - match typeInfo.ILScopeRef with - | ILScopeRef.Assembly assemblyRef -> - let externalSym = FindDeclExternalSymbol.Field (typeInfo.ILTypeRef.FullName, fieldDef.Name) - Some (FindDeclResult.ExternalDecl (assemblyRef.Name, externalSym)) - | _ -> None + | Item.Event (ILEvent (ILEventInfo (typeInfo, eventDef))) when not typeInfo.TyconRefOfRawMetadata.IsLocalRef -> + match typeInfo.ILScopeRef with + | ILScopeRef.Assembly assemblyRef -> + let externalSym = + FindDeclExternalSymbol.Event(typeInfo.ILTypeRef.FullName, eventDef.Name) - | Item.Event (ILEvent (ILEventInfo (typeInfo, eventDef))) when not typeInfo.TyconRefOfRawMetadata.IsLocalRef -> - match typeInfo.ILScopeRef with - | ILScopeRef.Assembly assemblyRef -> - let externalSym = FindDeclExternalSymbol.Event (typeInfo.ILTypeRef.FullName, eventDef.Name) - Some (FindDeclResult.ExternalDecl (assemblyRef.Name, externalSym)) - | _ -> None + Some(FindDeclResult.ExternalDecl(assemblyRef.Name, externalSym)) + | _ -> None - | Item.ImplicitOp(_, {contents = Some(TraitConstraintSln.FSMethSln(_, _vref, _))}) -> - //Item.Value(vref) - None + | Item.ImplicitOp (_, + { + contents = Some (TraitConstraintSln.FSMethSln (_, _vref, _)) + }) -> + //Item.Value(vref) + None - | Item.Types (_, TType_app (tr, _, _) :: _) when tr.IsLocalRef && tr.IsTypeAbbrev -> None + | Item.Types (_, TType_app (tr, _, _) :: _) when tr.IsLocalRef && tr.IsTypeAbbrev -> None - | Item.Types (_, [ AppTy g (tr, _) ]) when not tr.IsLocalRef -> - match tr.TypeReprInfo, tr.PublicPath with - | TILObjectRepr(TILObjectReprData (ILScopeRef.Assembly assemblyRef, _, _)), Some (PubPath parts) -> - let fullName = parts |> String.concat "." - Some (FindDeclResult.ExternalDecl (assemblyRef.Name, FindDeclExternalSymbol.Type fullName)) + | Item.Types (_, [ AppTy g (tr, _) ]) when not tr.IsLocalRef -> + match tr.TypeReprInfo, tr.PublicPath with + | TILObjectRepr (TILObjectReprData (ILScopeRef.Assembly assemblyRef, _, _)), Some (PubPath parts) -> + let fullName = parts |> String.concat "." + Some(FindDeclResult.ExternalDecl(assemblyRef.Name, FindDeclExternalSymbol.Type fullName)) + | _ -> None | _ -> None - | _ -> None - match result with - | Some x -> x - | None -> - match rangeOfItem g preferFlag item.Item with - | Some itemRange -> - let projectDir = FileSystem.GetDirectoryNameShim (if projectFileName = "" then mainInputFileName else projectFileName) - let range = fileNameOfItem g (Some projectDir) itemRange item.Item - mkRange range itemRange.Start itemRange.End - |> FindDeclResult.DeclFound - | None -> - match item.Item with + + match result with + | Some x -> x + | None -> + match rangeOfItem g preferFlag item.Item with + | Some itemRange -> + let projectDir = + FileSystem.GetDirectoryNameShim( + if projectFileName = "" then + mainInputFileName + else + projectFileName + ) + + let range = fileNameOfItem g (Some projectDir) itemRange item.Item + mkRange range itemRange.Start itemRange.End |> FindDeclResult.DeclFound + | None -> + match item.Item with #if !NO_TYPEPROVIDERS -// provided items may have TypeProviderDefinitionLocationAttribute that binds them to some location - | Item.CtorGroup (name, ProvidedMeth _::_ ) - | Item.MethodGroup(name, ProvidedMeth _::_, _) - | Item.Property (name, ProvidedProp _::_ ) -> FindDeclFailureReason.ProvidedMember name - | Item.Event ( ProvidedEvent _ as e ) -> FindDeclFailureReason.ProvidedMember e.EventName - | Item.ILField ( ProvidedField _ as f ) -> FindDeclFailureReason.ProvidedMember f.FieldName - | ItemIsProvidedType g tcref -> FindDeclFailureReason.ProvidedType tcref.DisplayName + // provided items may have TypeProviderDefinitionLocationAttribute that binds them to some location + | Item.CtorGroup (name, ProvidedMeth _ :: _) + | Item.MethodGroup (name, ProvidedMeth _ :: _, _) + | Item.Property (name, ProvidedProp _ :: _) -> FindDeclFailureReason.ProvidedMember name + | Item.Event (ProvidedEvent _ as e) -> FindDeclFailureReason.ProvidedMember e.EventName + | Item.ILField (ProvidedField _ as f) -> FindDeclFailureReason.ProvidedMember f.FieldName + | ItemIsProvidedType g tcref -> FindDeclFailureReason.ProvidedType tcref.DisplayName #endif - | _ -> FindDeclFailureReason.Unknown "" - |> FindDeclResult.DeclNotFound - ) + | _ -> FindDeclFailureReason.Unknown "" + |> FindDeclResult.DeclNotFound) (fun msg -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetDeclarationLocation: '%s'" msg) - FindDeclResult.DeclNotFound (FindDeclFailureReason.Unknown msg)) + FindDeclResult.DeclNotFound(FindDeclFailureReason.Unknown msg)) - member _.GetSymbolUseAtLocation (line, lineStr, colAtEndOfNames, names) = - DiagnosticsScope.Protect range0 + member _.GetSymbolUseAtLocation(line, lineStr, colAtEndOfNames, names) = + DiagnosticsScope.Protect + range0 (fun () -> let declItemsOpt = - GetDeclItemsForNamesAtPosition (None, Some names, None, None, - line, lineStr, colAtEndOfNames, ResolveTypeNamesToCtors, - ResolveOverloads.Yes, None, (fun() -> [])) + GetDeclItemsForNamesAtPosition( + None, + Some names, + None, + None, + line, + lineStr, + colAtEndOfNames, + ResolveTypeNamesToCtors, + ResolveOverloads.Yes, + None, + (fun () -> []) + ) match declItemsOpt with - | None | Some ([], _, _, _) -> None + | None + | Some ([], _, _, _) -> None | Some (item :: _, denv, _, m) -> let symbol = FSharpSymbol.Create(cenv, item.Item) - Some (symbol, item.ItemWithInst, denv, m) - ) + Some(symbol, item.ItemWithInst, denv, m)) (fun msg -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetSymbolUseAtLocation: '%s'" msg) None) @@ -1546,18 +1987,20 @@ type internal TypeCheckInfo member _.PartialAssemblySignatureForFile = FSharpAssemblySignature(g, thisCcu, ccuSigForFile, tcImports, None, ccuSigForFile) - member _.AccessRights = tcAccessRights + member _.AccessRights = tcAccessRights - member _.ProjectOptions = projectOptions + member _.ProjectOptions = projectOptions member _.GetReferencedAssemblies() = - [ for x in tcImports.GetImportedAssemblies() do - FSharpAssembly(g, tcImports, x.FSharpViewOfMetadata) ] + [ + for x in tcImports.GetImportedAssemblies() do + FSharpAssembly(g, tcImports, x.FSharpViewOfMetadata) + ] member _.GetFormatSpecifierLocationsAndArity() = - sSymbolUses.GetFormatSpecifierLocationsAndArity() + sSymbolUses.GetFormatSpecifierLocationsAndArity() - member _.GetSemanticClassification(range: range option) : SemanticClassificationItem [] = + member _.GetSemanticClassification(range: range option) : SemanticClassificationItem[] = sResolutions.GetSemanticClassification(g, amap, sSymbolUses.GetFormatSpecifierLocationsAndArity(), range) /// The resolutions in the file @@ -1583,58 +2026,72 @@ type internal TypeCheckInfo member _.SymbolEnv = cenv - override _.ToString() = "TypeCheckInfo(" + mainInputFileName + ")" + override _.ToString() = + "TypeCheckInfo(" + mainInputFileName + ")" type FSharpParsingOptions = - { SourceFiles: string [] - ConditionalDefines: string list - DiagnosticOptions: FSharpDiagnosticOptions - LangVersionText: string - IsInteractive: bool - IndentationAwareSyntax: bool option - CompilingFSharpCore: bool - IsExe: bool } + { + SourceFiles: string[] + ConditionalDefines: string list + DiagnosticOptions: FSharpDiagnosticOptions + LangVersionText: string + IsInteractive: bool + IndentationAwareSyntax: bool option + CompilingFSharpCore: bool + IsExe: bool + } member x.LastFileName = Debug.Assert(not (Array.isEmpty x.SourceFiles), "Parsing options don't contain any file") Array.last x.SourceFiles static member Default = - { SourceFiles = Array.empty - ConditionalDefines = [] - DiagnosticOptions = FSharpDiagnosticOptions.Default - LangVersionText = LanguageVersion.Default.VersionText - IsInteractive = false - IndentationAwareSyntax = None - CompilingFSharpCore = false - IsExe = false } + { + SourceFiles = Array.empty + ConditionalDefines = [] + DiagnosticOptions = FSharpDiagnosticOptions.Default + LangVersionText = LanguageVersion.Default.VersionText + IsInteractive = false + IndentationAwareSyntax = None + CompilingFSharpCore = false + IsExe = false + } static member FromTcConfig(tcConfig: TcConfig, sourceFiles, isInteractive: bool) = - { SourceFiles = sourceFiles - ConditionalDefines = tcConfig.conditionalDefines - DiagnosticOptions = tcConfig.diagnosticsOptions - LangVersionText = tcConfig.langVersion.VersionText - IsInteractive = isInteractive - IndentationAwareSyntax = tcConfig.indentationAwareSyntax - CompilingFSharpCore = tcConfig.compilingFSharpCore - IsExe = tcConfig.target.IsExe } + { + SourceFiles = sourceFiles + ConditionalDefines = tcConfig.conditionalDefines + DiagnosticOptions = tcConfig.diagnosticsOptions + LangVersionText = tcConfig.langVersion.VersionText + IsInteractive = isInteractive + IndentationAwareSyntax = tcConfig.indentationAwareSyntax + CompilingFSharpCore = tcConfig.compilingFSharpCore + IsExe = tcConfig.target.IsExe + } static member FromTcConfigBuilder(tcConfigB: TcConfigBuilder, sourceFiles, isInteractive: bool) = { - SourceFiles = sourceFiles - ConditionalDefines = tcConfigB.conditionalDefines - DiagnosticOptions = tcConfigB.diagnosticsOptions - LangVersionText = tcConfigB.langVersion.VersionText - IsInteractive = isInteractive - IndentationAwareSyntax = tcConfigB.indentationAwareSyntax - CompilingFSharpCore = tcConfigB.compilingFSharpCore - IsExe = tcConfigB.target.IsExe + SourceFiles = sourceFiles + ConditionalDefines = tcConfigB.conditionalDefines + DiagnosticOptions = tcConfigB.diagnosticsOptions + LangVersionText = tcConfigB.langVersion.VersionText + IsInteractive = isInteractive + IndentationAwareSyntax = tcConfigB.indentationAwareSyntax + CompilingFSharpCore = tcConfigB.compilingFSharpCore + IsExe = tcConfigB.target.IsExe } module internal ParseAndCheckFile = /// Error handler for parsing & type checking while processing a single file - type ErrorHandler(reportErrors, mainInputFileName, diagnosticsOptions: FSharpDiagnosticOptions, sourceText: ISourceText, suggestNamesForErrors: bool) = + type ErrorHandler + ( + reportErrors, + mainInputFileName, + diagnosticsOptions: FSharpDiagnosticOptions, + sourceText: ISourceText, + suggestNamesForErrors: bool + ) = let mutable options = diagnosticsOptions let diagnosticsCollector = ResizeArray<_>() let mutable errorCount = 0 @@ -1643,8 +2100,10 @@ module internal ParseAndCheckFile = let fileInfo = sourceText.GetLastCharacterPosition() let collectOne severity diagnostic = - for diagnostic in DiagnosticHelpers.ReportDiagnostic (options, false, mainInputFileName, fileInfo, diagnostic, severity, suggestNamesForErrors) do + for diagnostic in + DiagnosticHelpers.ReportDiagnostic(options, false, mainInputFileName, fileInfo, diagnostic, severity, suggestNamesForErrors) do diagnosticsCollector.Add diagnostic + if severity = FSharpDiagnosticSeverity.Error then errorCount <- errorCount + 1 @@ -1652,25 +2111,35 @@ module internal ParseAndCheckFile = let diagnosticSink severity (diagnostic: PhasedDiagnostic) = // Sanity check here. The phase of an error should be in a phase known to the language service. let diagnostic = - if not(diagnostic.IsPhaseInCompile()) then + if not (diagnostic.IsPhaseInCompile()) then // Reaching this point means that the error would be sticky if we let it prop up to the language service. // Assert and recover by replacing phase with one known to the language service. - Trace.TraceInformation(sprintf "The subcategory '%s' seen in an error should not be seen by the language service" (diagnostic.Subcategory())) - { diagnostic with Phase = BuildPhase.TypeCheck } - else diagnostic + Trace.TraceInformation( + sprintf + "The subcategory '%s' seen in an error should not be seen by the language service" + (diagnostic.Subcategory()) + ) + + { diagnostic with + Phase = BuildPhase.TypeCheck + } + else + diagnostic if reportErrors then match diagnostic with #if !NO_TYPEPROVIDERS - | { Exception = :? TypeProviderError as tpe } -> - tpe.Iter(fun exn -> collectOne severity { diagnostic with Exception = exn }) + | { + Exception = :? TypeProviderError as tpe + } -> tpe.Iter(fun exn -> collectOne severity { diagnostic with Exception = exn }) #endif | _ -> collectOne severity diagnostic let diagnosticsLogger = { new DiagnosticsLogger("ErrorHandler") with - member _.DiagnosticSink (exn, severity) = diagnosticSink severity exn - member _.ErrorCount = errorCount } + member _.DiagnosticSink(exn, severity) = diagnosticSink severity exn + member _.ErrorCount = errorCount + } // Public members member _.DiagnosticsLogger = diagnosticsLogger @@ -1679,13 +2148,21 @@ module internal ParseAndCheckFile = member _.ErrorCount = errorCount - member _.DiagnosticOptions with set opts = options <- opts + member _.DiagnosticOptions + with set opts = options <- opts member _.AnyErrors = errorCount > 0 let getLightSyntaxStatus fileName options = - let indentationAwareSyntaxOnByDefault = List.exists (FileSystemUtils.checkSuffix fileName) FSharpIndentationAwareSyntaxFileSuffixes - let indentationSyntaxStatus = if indentationAwareSyntaxOnByDefault then (options.IndentationAwareSyntax <> Some false) else (options.IndentationAwareSyntax = Some true) + let indentationAwareSyntaxOnByDefault = + List.exists (FileSystemUtils.checkSuffix fileName) FSharpIndentationAwareSyntaxFileSuffixes + + let indentationSyntaxStatus = + if indentationAwareSyntaxOnByDefault then + (options.IndentationAwareSyntax <> Some false) + else + (options.IndentationAwareSyntax = Some true) + IndentationAwareSyntaxStatus(indentationSyntaxStatus, true) let createLexerFunction fileName options lexbuf (errHandler: ErrorHandler) = @@ -1702,31 +2179,42 @@ module internal ParseAndCheckFile = // When analyzing files using ParseOneFile, i.e. for the use of editing clients, we do not apply line directives. // TODO(pathmap): expose PathMap on the service API, and thread it through here - let lexargs = mkLexargs(conditionalDefines, indentationSyntaxStatus, lexResourceManager, [], errHandler.DiagnosticsLogger, PathMap.empty) - let lexargs = { lexargs with applyLineDirectives = false } + let lexargs = + mkLexargs (conditionalDefines, indentationSyntaxStatus, lexResourceManager, [], errHandler.DiagnosticsLogger, PathMap.empty) + + let lexargs = + { lexargs with + applyLineDirectives = false + } + + let tokenizer = + LexFilter.LexFilter(indentationSyntaxStatus, options.CompilingFSharpCore, Lexer.token lexargs true, lexbuf) - let tokenizer = LexFilter.LexFilter(indentationSyntaxStatus, options.CompilingFSharpCore, Lexer.token lexargs true, lexbuf) (fun _ -> tokenizer.GetToken()) let createLexbuf langVersion sourceText = UnicodeLexing.SourceTextAsLexbuf(true, LanguageVersion(langVersion), sourceText) - let matchBraces(sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = + let matchBraces (sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = let delayedLogger = CapturingDiagnosticsLogger("matchBraces") - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> delayedLogger) + use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> delayedLogger) use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "matchBraces", fileName) // Make sure there is an DiagnosticsLogger installed whenever we do stuff that might record errors, even if we ultimately ignore the errors let delayedLogger = CapturingDiagnosticsLogger("matchBraces") - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> delayedLogger) + use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> delayedLogger) use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse let matchingBraces = ResizeArray<_>() - usingLexbufForParsing(createLexbuf options.LangVersionText sourceText, fileName) (fun lexbuf -> - let errHandler = ErrorHandler(false, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors) + + usingLexbufForParsing (createLexbuf options.LangVersionText sourceText, fileName) (fun lexbuf -> + let errHandler = + ErrorHandler(false, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors) + let lexfun = createLexerFunction fileName options lexbuf errHandler + let parenTokensBalance t1 t2 = match t1, t2 with | LPAREN, RPAREN @@ -1757,8 +2245,7 @@ module internal ParseAndCheckFile = let m2Start = match tok2 with | INTERP_STRING_PART _ - | INTERP_STRING_END _ -> - mkFileIndexRange m2.FileIndex m2.Start (mkPos m2.Start.Line (m2.Start.Column+1)) + | INTERP_STRING_END _ -> mkFileIndexRange m2.FileIndex m2.Start (mkPos m2.Start.Line (m2.Start.Column + 1)) | _ -> m2 matchingBraces.Add(m1, m2Start) @@ -1768,14 +2255,22 @@ module internal ParseAndCheckFile = let stackAfterMatch = match tok2 with | INTERP_STRING_PART _ -> - let m2End = mkFileIndexRange m2.FileIndex (mkPos m2.End.Line (max (m2.End.Column-1) 0)) m2.End - (tok2, m2End) :: stackAfterMatch + let m2End = + mkFileIndexRange m2.FileIndex (mkPos m2.End.Line (max (m2.End.Column - 1) 0)) m2.End + + (tok2, m2End) :: stackAfterMatch | _ -> stackAfterMatch matchBraces stackAfterMatch - | LPAREN | LBRACE _ | LBRACK | LBRACE_BAR | LBRACK_BAR | LQUOTE _ | LBRACK_LESS as tok, _ -> - matchBraces ((tok, lexbuf.LexemeRange) :: stack) + | LPAREN + | LBRACE _ + | LBRACK + | LBRACE_BAR + | LBRACK_BAR + | LQUOTE _ + | LBRACK_LESS as tok, + _ -> matchBraces ((tok, lexbuf.LexemeRange) :: stack) // INTERP_STRING_BEGIN_PART corresponds to $"... {" at the start of an interpolated string // @@ -1784,41 +2279,72 @@ module internal ParseAndCheckFile = // interpolation expression) // // Either way we start a new potential match at the last character - | INTERP_STRING_BEGIN_PART _ | INTERP_STRING_PART _ as tok, _ -> - let m = lexbuf.LexemeRange - let m2 = mkFileIndexRange m.FileIndex (mkPos m.End.Line (max (m.End.Column-1) 0)) m.End - matchBraces ((tok, m2) :: stack) + | INTERP_STRING_BEGIN_PART _ + | INTERP_STRING_PART _ as tok, + _ -> + let m = lexbuf.LexemeRange + + let m2 = + mkFileIndexRange m.FileIndex (mkPos m.End.Line (max (m.End.Column - 1) 0)) m.End + + matchBraces ((tok, m2) :: stack) - | (EOF _ | LEX_FAILURE _), _ -> () + | (EOF _ + | LEX_FAILURE _), + _ -> () | _ -> matchBraces stack + matchBraces []) + matchingBraces.ToArray() - let parseFile(sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = + let parseFile (sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "parseFile", fileName) - let errHandler = ErrorHandler(true, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors) - use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.DiagnosticsLogger) + + let errHandler = + ErrorHandler(true, fileName, options.DiagnosticOptions, sourceText, suggestNamesForErrors) + + use unwindEL = + PushDiagnosticsLoggerPhaseUntilUnwind(fun _oldLogger -> errHandler.DiagnosticsLogger) + use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse let parseResult = - usingLexbufForParsing(createLexbuf options.LangVersionText sourceText, fileName) (fun lexbuf -> + usingLexbufForParsing (createLexbuf options.LangVersionText sourceText, fileName) (fun lexbuf -> let lexfun = createLexerFunction fileName options lexbuf errHandler + let isLastCompiland = - fileName.Equals(options.LastFileName, StringComparison.CurrentCultureIgnoreCase) || - IsScript(fileName) + fileName.Equals(options.LastFileName, StringComparison.CurrentCultureIgnoreCase) + || IsScript(fileName) + let isExe = options.IsExe try - ParseInput(lexfun, options.DiagnosticOptions, errHandler.DiagnosticsLogger, lexbuf, None, fileName, (isLastCompiland, isExe)) + ParseInput( + lexfun, + options.DiagnosticOptions, + errHandler.DiagnosticsLogger, + lexbuf, + None, + fileName, + (isLastCompiland, isExe) + ) with e -> errHandler.DiagnosticsLogger.StopProcessingRecovery e range0 // don't re-raise any exceptions, we must return None. EmptyParsedInput(fileName, (isLastCompiland, isExe))) errHandler.CollectedDiagnostics, parseResult, errHandler.AnyErrors - - let ApplyLoadClosure(tcConfig, parsedMainInput, mainInputFileName, loadClosure: LoadClosure option, tcImports: TcImports, backgroundDiagnostics) = + let ApplyLoadClosure + ( + tcConfig, + parsedMainInput, + mainInputFileName, + loadClosure: LoadClosure option, + tcImports: TcImports, + backgroundDiagnostics + ) = // If additional references were brought in by the preprocessor then we need to process them match loadClosure with @@ -1830,9 +2356,9 @@ module internal ParseAndCheckFile = loadClosure.LoadClosureRootFileDiagnostics |> List.iter diagnosticSink let fileOfBackgroundError err = - match GetRangeOfDiagnostic (fst err) with - | Some m -> Some m.FileName - | None -> None + match GetRangeOfDiagnostic(fst err) with + | Some m -> Some m.FileName + | None -> None let sameFile file hashLoadInFile = match file with @@ -1841,21 +2367,20 @@ module internal ParseAndCheckFile = // walk the list of #loads and keep the ones for this file. let hashLoadsInFile = - loadClosure.SourceFiles - |> List.filter(fun (_,ms) -> ms<>[]) // #loaded file, ranges of #load + loadClosure.SourceFiles |> List.filter (fun (_, ms) -> ms <> []) // #loaded file, ranges of #load let hashLoadBackgroundDiagnostics, otherBackgroundDiagnostics = backgroundDiagnostics |> Array.partition (fun backgroundError -> hashLoadsInFile - |> List.exists (fst >> sameFile (fileOfBackgroundError backgroundError))) + |> List.exists (fst >> sameFile (fileOfBackgroundError backgroundError))) // Create single errors for the #load-ed files. // Group errors and warnings by file name. let hashLoadBackgroundDiagnosticsGroupedByFileName = hashLoadBackgroundDiagnostics - |> Array.map(fun err -> fileOfBackgroundError err,err) - |> Array.groupBy fst // fileWithErrors, error list + |> Array.map (fun err -> fileOfBackgroundError err, err) + |> Array.groupBy fst // fileWithErrors, error list // Join the sets and report errors. // It is by-design that these messages are only present in the language service. A true build would report the errors at their @@ -1864,18 +2389,32 @@ module internal ParseAndCheckFile = for file, errorGroupedByFileName in hashLoadBackgroundDiagnosticsGroupedByFileName do if sameFile file fileOfHashLoad then for rangeOfHashLoad in rangesOfHashLoad do // Handle the case of two #loads of the same file - let diagnostics = errorGroupedByFileName |> Array.map(fun (_,(pe,f)) -> pe.Exception,f) // Strip the build phase here. It will be replaced, in total, with TypeCheck - let errors = [ for err, severity in diagnostics do if severity = FSharpDiagnosticSeverity.Error then err ] - let warnings = [ for err, severity in diagnostics do if severity = FSharpDiagnosticSeverity.Warning then err ] - let infos = [ for err, severity in diagnostics do if severity = FSharpDiagnosticSeverity.Info then err ] + let diagnostics = + errorGroupedByFileName |> Array.map (fun (_, (pe, f)) -> pe.Exception, f) // Strip the build phase here. It will be replaced, in total, with TypeCheck + + let errors = + [ + for err, severity in diagnostics do + if severity = FSharpDiagnosticSeverity.Error then err + ] + + let warnings = + [ + for err, severity in diagnostics do + if severity = FSharpDiagnosticSeverity.Warning then err + ] + + let infos = + [ + for err, severity in diagnostics do + if severity = FSharpDiagnosticSeverity.Info then err + ] let message = HashLoadedSourceHasIssues(infos, warnings, errors, rangeOfHashLoad) - if isNil errors && isNil warnings then - warning message - elif isNil errors then - warning message - else - errorR message + + if isNil errors && isNil warnings then warning message + elif isNil errors then warning message + else errorR message // Replay other background errors. for diagnostic, severity in otherBackgroundDiagnostics do @@ -1887,150 +2426,185 @@ module internal ParseAndCheckFile = | None -> // For non-scripts, check for disallow #r and #load. - ApplyMetaCommandsFromInputToTcConfig (tcConfig, parsedMainInput, Path.GetDirectoryName mainInputFileName, tcImports.DependencyProvider) |> ignore + ApplyMetaCommandsFromInputToTcConfig( + tcConfig, + parsedMainInput, + Path.GetDirectoryName mainInputFileName, + tcImports.DependencyProvider + ) + |> ignore // Type check a single file against an initial context, gleaning both errors and intellisense information. let CheckOneFile - (parseResults: FSharpParseFileResults, - sourceText: ISourceText, - mainInputFileName: string, - projectOptions: FSharpProjectOptions, - projectFileName: string, - tcConfig: TcConfig, - tcGlobals: TcGlobals, - tcImports: TcImports, - tcState: TcState, - moduleNamesDict: ModuleNamesDict, - loadClosure: LoadClosure option, - // These are the errors and warnings seen by the background compiler for the entire antecedent - backgroundDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity)[], - suggestNamesForErrors: bool) = - - cancellable { - use _logBlock = Logger.LogBlock LogCompilerFunctionId.Service_CheckOneFile - - let parsedMainInput = parseResults.ParseTree - - // Initialize the error handler - let errHandler = ErrorHandler(true, mainInputFileName, tcConfig.diagnosticsOptions, sourceText, suggestNamesForErrors) - - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.DiagnosticsLogger) - use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck - - // Apply nowarns to tcConfig (may generate errors, so ensure diagnosticsLogger is installed) - let tcConfig = ApplyNoWarnsToTcConfig (tcConfig, parsedMainInput,Path.GetDirectoryName mainInputFileName) - - // update the error handler with the modified tcConfig - errHandler.DiagnosticOptions <- tcConfig.diagnosticsOptions - - // Play background errors and warnings for this file. - do for err, severity in backgroundDiagnostics do - diagnosticSink (err, severity) - - // If additional references were brought in by the preprocessor then we need to process them - ApplyLoadClosure(tcConfig, parsedMainInput, mainInputFileName, loadClosure, tcImports, backgroundDiagnostics) - - // A problem arises with nice name generation, which really should only - // be done in the backend, but is also done in the typechecker for better or worse. - // If we don't do this the NNG accumulates data and we get a memory leak. - tcState.NiceNameGenerator.Reset() - - // Typecheck the real input. - let sink = TcResultsSinkImpl(tcGlobals, sourceText = sourceText) + ( + parseResults: FSharpParseFileResults, + sourceText: ISourceText, + mainInputFileName: string, + projectOptions: FSharpProjectOptions, + projectFileName: string, + tcConfig: TcConfig, + tcGlobals: TcGlobals, + tcImports: TcImports, + tcState: TcState, + moduleNamesDict: ModuleNamesDict, + loadClosure: LoadClosure option, + backgroundDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity)[], + suggestNamesForErrors: bool + ) = - let! resOpt = - cancellable { - try - let checkForErrors() = (parseResults.ParseHadErrors || errHandler.ErrorCount > 0) - - let parsedMainInput, _moduleNamesDict = DeduplicateParsedInputModuleName moduleNamesDict parsedMainInput - - // Typecheck is potentially a long running operation. We chop it up here with an Eventually continuation and, at each slice, give a chance - // for the client to claim the result as obsolete and have the typecheck abort. - - use _unwind = new CompilationGlobalsScope (errHandler.DiagnosticsLogger, BuildPhase.TypeCheck) - let! result = - CheckOneInputAndFinish(checkForErrors, tcConfig, tcImports, tcGlobals, None, TcResultsSink.WithSink sink, tcState, parsedMainInput) - - return result - with e -> - errorR e - let mty = Construct.NewEmptyModuleOrNamespaceType ModuleOrNamespaceKind.Namespace - return ((tcState.TcEnvFromSignatures, EmptyTopAttrs, [], [ mty ]), tcState) - } + cancellable { + use _logBlock = Logger.LogBlock LogCompilerFunctionId.Service_CheckOneFile + + let parsedMainInput = parseResults.ParseTree + + // Initialize the error handler + let errHandler = + ErrorHandler(true, mainInputFileName, tcConfig.diagnosticsOptions, sourceText, suggestNamesForErrors) + + use _unwindEL = + PushDiagnosticsLoggerPhaseUntilUnwind(fun _oldLogger -> errHandler.DiagnosticsLogger) + + use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck + + // Apply nowarns to tcConfig (may generate errors, so ensure diagnosticsLogger is installed) + let tcConfig = + ApplyNoWarnsToTcConfig(tcConfig, parsedMainInput, Path.GetDirectoryName mainInputFileName) + + // update the error handler with the modified tcConfig + errHandler.DiagnosticOptions <- tcConfig.diagnosticsOptions + + // Play background errors and warnings for this file. + do + for err, severity in backgroundDiagnostics do + diagnosticSink (err, severity) + + // If additional references were brought in by the preprocessor then we need to process them + ApplyLoadClosure(tcConfig, parsedMainInput, mainInputFileName, loadClosure, tcImports, backgroundDiagnostics) + + // A problem arises with nice name generation, which really should only + // be done in the backend, but is also done in the typechecker for better or worse. + // If we don't do this the NNG accumulates data and we get a memory leak. + tcState.NiceNameGenerator.Reset() + + // Typecheck the real input. + let sink = TcResultsSinkImpl(tcGlobals, sourceText = sourceText) + + let! resOpt = + cancellable { + try + let checkForErrors () = + (parseResults.ParseHadErrors || errHandler.ErrorCount > 0) + + let parsedMainInput, _moduleNamesDict = + DeduplicateParsedInputModuleName moduleNamesDict parsedMainInput + + // Typecheck is potentially a long running operation. We chop it up here with an Eventually continuation and, at each slice, give a chance + // for the client to claim the result as obsolete and have the typecheck abort. + + use _unwind = + new CompilationGlobalsScope(errHandler.DiagnosticsLogger, BuildPhase.TypeCheck) + + let! result = + CheckOneInputAndFinish( + checkForErrors, + tcConfig, + tcImports, + tcGlobals, + None, + TcResultsSink.WithSink sink, + tcState, + parsedMainInput + ) + + return result + with e -> + errorR e + let mty = Construct.NewEmptyModuleOrNamespaceType ModuleOrNamespaceKind.Namespace + return ((tcState.TcEnvFromSignatures, EmptyTopAttrs, [], [ mty ]), tcState) + } - let errors = errHandler.CollectedDiagnostics + let errors = errHandler.CollectedDiagnostics + + let res = + match resOpt with + | (tcEnvAtEnd, _, implFiles, ccuSigsForFiles), tcState -> + TypeCheckInfo( + tcConfig, + tcGlobals, + List.head ccuSigsForFiles, + tcState.Ccu, + tcImports, + tcEnvAtEnd.AccessRights, + projectFileName, + mainInputFileName, + projectOptions, + sink.GetResolutions(), + sink.GetSymbolUses(), + tcEnvAtEnd.NameEnv, + loadClosure, + List.tryHead implFiles, + sink.GetOpenDeclarations() + ) - let res = - match resOpt with - | (tcEnvAtEnd, _, implFiles, ccuSigsForFiles), tcState -> - TypeCheckInfo(tcConfig, tcGlobals, - List.head ccuSigsForFiles, - tcState.Ccu, - tcImports, - tcEnvAtEnd.AccessRights, - projectFileName, - mainInputFileName, - projectOptions, - sink.GetResolutions(), - sink.GetSymbolUses(), - tcEnvAtEnd.NameEnv, - loadClosure, - List.tryHead implFiles, - sink.GetOpenDeclarations()) - return errors, res - } + return errors, res + } [] type FSharpProjectContext(thisCcu: CcuThunk, assemblies: FSharpAssembly list, ad: AccessorDomain, projectOptions: FSharpProjectOptions) = - member _.ProjectOptions = projectOptions + member _.ProjectOptions = projectOptions member _.GetReferencedAssemblies() = assemblies member _.AccessibilityRights = FSharpAccessibilityRights(thisCcu, ad) - /// A live object of this type keeps the background corresponding background builder (and type providers) alive (through reference-counting). // // Note: objects returned by the methods of this type do not require the corresponding background builder to be alive. [] type FSharpCheckFileResults - (fileName: string, - errors: FSharpDiagnostic[], - scopeOptX: TypeCheckInfo option, - dependencyFiles: string[], - builderX: IncrementalBuilder option, - keepAssemblyContents: bool) = + ( + fileName: string, + errors: FSharpDiagnostic[], + scopeOptX: TypeCheckInfo option, + dependencyFiles: string[], + builderX: IncrementalBuilder option, + keepAssemblyContents: bool + ) = // Here 'details' keeps 'builder' alive - let details = match scopeOptX with None -> None | Some scopeX -> Some (scopeX, builderX) + let details = + match scopeOptX with + | None -> None + | Some scopeX -> Some(scopeX, builderX) - static let emptyFindDeclResult = FindDeclResult.DeclNotFound (FindDeclFailureReason.Unknown "") + static let emptyFindDeclResult = + FindDeclResult.DeclNotFound(FindDeclFailureReason.Unknown "") member _.Diagnostics = errors member _.HasFullTypeCheckInfo = details.IsSome - member _.TryGetCurrentTcImports () = + member _.TryGetCurrentTcImports() = match details with | None -> None | Some (scope, _builderOpt) -> Some scope.TcImports /// Intellisense autocompletions member _.GetDeclarationListInfo(parsedFileResults, line, lineText, partialName, ?getAllEntities, ?completionContextAtPos) = - let getAllEntities = defaultArg getAllEntities (fun() -> []) + let getAllEntities = defaultArg getAllEntities (fun () -> []) + match details with | None -> DeclarationListInfo.Empty | Some (scope, _builderOpt) -> scope.GetDeclarations(parsedFileResults, line, lineText, partialName, completionContextAtPos, getAllEntities) member _.GetDeclarationListSymbols(parsedFileResults, line, lineText, partialName, ?getAllEntities) = - let getAllEntities = defaultArg getAllEntities (fun() -> []) + let getAllEntities = defaultArg getAllEntities (fun () -> []) + match details with | None -> [] - | Some (scope, _builderOpt) -> - scope.GetDeclarationListSymbols(parsedFileResults, line, lineText, partialName, getAllEntities) + | Some (scope, _builderOpt) -> scope.GetDeclarationListSymbols(parsedFileResults, line, lineText, partialName, getAllEntities) /// Resolve the names at the given location to give a data tip member _.GetToolTip(line, colAtEndOfNames, lineText, names, tokenTag) = @@ -2038,134 +2612,131 @@ type FSharpCheckFileResults | TOKEN_IDENT -> match details with | None -> emptyToolTip - | Some (scope, _builderOpt) -> - scope.GetStructuredToolTipText(line, lineText, colAtEndOfNames, names) - | TOKEN_STRING | TOKEN_STRING_TEXT -> + | Some (scope, _builderOpt) -> scope.GetStructuredToolTipText(line, lineText, colAtEndOfNames, names) + | TOKEN_STRING + | TOKEN_STRING_TEXT -> match details with | None -> emptyToolTip - | Some (scope, _builderOpt) -> - scope.GetReferenceResolutionStructuredToolTipText(line, colAtEndOfNames) - | _ -> - emptyToolTip + | Some (scope, _builderOpt) -> scope.GetReferenceResolutionStructuredToolTipText(line, colAtEndOfNames) + | _ -> emptyToolTip member _.GetDescription(symbol: FSharpSymbol, inst: (FSharpGenericParameter * FSharpType) list, displayFullName, range: range) = match details with | None -> emptyToolTip - | Some (scope, _builderOpt) -> - scope.GetDescription(symbol, inst, displayFullName, range) + | Some (scope, _builderOpt) -> scope.GetDescription(symbol, inst, displayFullName, range) - member _.GetF1Keyword (line, colAtEndOfNames, lineText, names) = + member _.GetF1Keyword(line, colAtEndOfNames, lineText, names) = match details with | None -> None - | Some (scope, _builderOpt) -> - scope.GetF1Keyword (line, lineText, colAtEndOfNames, names) + | Some (scope, _builderOpt) -> scope.GetF1Keyword(line, lineText, colAtEndOfNames, names) // Resolve the names at the given location to a set of methods member _.GetMethods(line, colAtEndOfNames, lineText, names) = match details with | None -> MethodGroup.Empty - | Some (scope, _builderOpt) -> - scope.GetMethods (line, lineText, colAtEndOfNames, names) + | Some (scope, _builderOpt) -> scope.GetMethods(line, lineText, colAtEndOfNames, names) - member _.GetDeclarationLocation (line, colAtEndOfNames, lineText, names, ?preferFlag) = + member _.GetDeclarationLocation(line, colAtEndOfNames, lineText, names, ?preferFlag) = match details with | None -> emptyFindDeclResult - | Some (scope, _builderOpt) -> - scope.GetDeclarationLocation (line, lineText, colAtEndOfNames, names, preferFlag) + | Some (scope, _builderOpt) -> scope.GetDeclarationLocation(line, lineText, colAtEndOfNames, names, preferFlag) - member _.GetSymbolUseAtLocation (line, colAtEndOfNames, lineText, names) = + member _.GetSymbolUseAtLocation(line, colAtEndOfNames, lineText, names) = match details with | None -> None | Some (scope, _builderOpt) -> - scope.GetSymbolUseAtLocation (line, lineText, colAtEndOfNames, names) - |> Option.map (fun (sym, itemWithInst, denv,m) -> FSharpSymbolUse(denv,sym,itemWithInst.TyparInstantiation,ItemOccurence.Use,m)) + scope.GetSymbolUseAtLocation(line, lineText, colAtEndOfNames, names) + |> Option.map (fun (sym, itemWithInst, denv, m) -> + FSharpSymbolUse(denv, sym, itemWithInst.TyparInstantiation, ItemOccurence.Use, m)) - member _.GetMethodsAsSymbols (line, colAtEndOfNames, lineText, names) = + member _.GetMethodsAsSymbols(line, colAtEndOfNames, lineText, names) = match details with | None -> None | Some (scope, _builderOpt) -> - scope.GetMethodsAsSymbols (line, lineText, colAtEndOfNames, names) - |> Option.map (fun (symbols,denv,m) -> - symbols |> List.map (fun (sym, itemWithInst) -> FSharpSymbolUse(denv,sym,itemWithInst.TyparInstantiation,ItemOccurence.Use,m))) + scope.GetMethodsAsSymbols(line, lineText, colAtEndOfNames, names) + |> Option.map (fun (symbols, denv, m) -> + symbols + |> List.map (fun (sym, itemWithInst) -> FSharpSymbolUse(denv, sym, itemWithInst.TyparInstantiation, ItemOccurence.Use, m))) - member _.GetSymbolAtLocation (line, colAtEndOfNames, lineStr, names) = + member _.GetSymbolAtLocation(line, colAtEndOfNames, lineStr, names) = match details with | None -> None | Some (scope, _builderOpt) -> - scope.GetSymbolUseAtLocation (line, lineStr, colAtEndOfNames, names) - |> Option.map (fun (sym,_,_,_) -> sym) + scope.GetSymbolUseAtLocation(line, lineStr, colAtEndOfNames, names) + |> Option.map (fun (sym, _, _, _) -> sym) member info.GetFormatSpecifierLocations() = info.GetFormatSpecifierLocationsAndArity() |> Array.map fst member _.GetFormatSpecifierLocationsAndArity() = match details with - | None -> [| |] - | Some (scope, _builderOpt) -> - scope.GetFormatSpecifierLocationsAndArity() + | None -> [||] + | Some (scope, _builderOpt) -> scope.GetFormatSpecifierLocationsAndArity() member _.GetSemanticClassification(range: range option) = match details with - | None -> [| |] - | Some (scope, _builderOpt) -> - scope.GetSemanticClassification(range) + | None -> [||] + | Some (scope, _builderOpt) -> scope.GetSemanticClassification(range) member _.PartialAssemblySignature = match details with | None -> failwith "not available" - | Some (scope, _builderOpt) -> - scope.PartialAssemblySignatureForFile + | Some (scope, _builderOpt) -> scope.PartialAssemblySignatureForFile member _.ProjectContext = match details with | None -> failwith "not available" | Some (scope, _builderOpt) -> - FSharpProjectContext(scope.ThisCcu, scope.GetReferencedAssemblies(), scope.AccessRights, scope.ProjectOptions) + FSharpProjectContext(scope.ThisCcu, scope.GetReferencedAssemblies(), scope.AccessRights, scope.ProjectOptions) member _.DependencyFiles = dependencyFiles - member _.GetAllUsesOfAllSymbolsInFile(?cancellationToken: CancellationToken ) = + member _.GetAllUsesOfAllSymbolsInFile(?cancellationToken: CancellationToken) = match details with | None -> Seq.empty | Some (scope, _builderOpt) -> - let cenv = scope.SymbolEnv - seq { - for symbolUseChunk in scope.ScopeSymbolUses.AllUsesOfSymbols do - for symbolUse in symbolUseChunk do - cancellationToken |> Option.iter (fun ct -> ct.ThrowIfCancellationRequested()) - if symbolUse.ItemOccurence <> ItemOccurence.RelatedText then - let symbol = FSharpSymbol.Create(cenv, symbolUse.ItemWithInst.Item) - let inst = symbolUse.ItemWithInst.TyparInstantiation - FSharpSymbolUse(symbolUse.DisplayEnv, symbol, inst, symbolUse.ItemOccurence, symbolUse.Range) - } + let cenv = scope.SymbolEnv + + seq { + for symbolUseChunk in scope.ScopeSymbolUses.AllUsesOfSymbols do + for symbolUse in symbolUseChunk do + cancellationToken |> Option.iter (fun ct -> ct.ThrowIfCancellationRequested()) + + if symbolUse.ItemOccurence <> ItemOccurence.RelatedText then + let symbol = FSharpSymbol.Create(cenv, symbolUse.ItemWithInst.Item) + let inst = symbolUse.ItemWithInst.TyparInstantiation + FSharpSymbolUse(symbolUse.DisplayEnv, symbol, inst, symbolUse.ItemOccurence, symbolUse.Range) + } - member _.GetUsesOfSymbolInFile(symbol:FSharpSymbol, ?cancellationToken: CancellationToken) = + member _.GetUsesOfSymbolInFile(symbol: FSharpSymbol, ?cancellationToken: CancellationToken) = match details with - | None -> [| |] + | None -> [||] | Some (scope, _builderOpt) -> - [| for symbolUse in scope.ScopeSymbolUses.GetUsesOfSymbol(symbol.Item) |> Seq.distinctBy (fun symbolUse -> symbolUse.ItemOccurence, symbolUse.Range) do - cancellationToken |> Option.iter (fun ct -> ct.ThrowIfCancellationRequested()) - if symbolUse.ItemOccurence <> ItemOccurence.RelatedText then + [| + for symbolUse in + scope.ScopeSymbolUses.GetUsesOfSymbol(symbol.Item) + |> Seq.distinctBy (fun symbolUse -> symbolUse.ItemOccurence, symbolUse.Range) do + cancellationToken |> Option.iter (fun ct -> ct.ThrowIfCancellationRequested()) + + if symbolUse.ItemOccurence <> ItemOccurence.RelatedText then let inst = symbolUse.ItemWithInst.TyparInstantiation - FSharpSymbolUse(symbolUse.DisplayEnv, symbol, inst, symbolUse.ItemOccurence, symbolUse.Range) |] + FSharpSymbolUse(symbolUse.DisplayEnv, symbol, inst, symbolUse.ItemOccurence, symbolUse.Range) + |] member _.GetVisibleNamespacesAndModulesAtPoint(pos: pos) = match details with - | None -> [| |] - | Some (scope, _builderOpt) -> - scope.GetVisibleNamespacesAndModulesAtPosition(pos) |> List.toArray + | None -> [||] + | Some (scope, _builderOpt) -> scope.GetVisibleNamespacesAndModulesAtPosition(pos) |> List.toArray member _.IsRelativeNameResolvable(cursorPos: pos, plid: string list, item: Item) = match details with | None -> true - | Some (scope, _builderOpt) -> - scope.IsRelativeNameResolvable(cursorPos, plid, item) + | Some (scope, _builderOpt) -> scope.IsRelativeNameResolvable(cursorPos, plid, item) member _.IsRelativeNameResolvableFromSymbol(cursorPos: pos, plid: string list, symbol: FSharpSymbol) = match details with | None -> true - | Some (scope, _builderOpt) -> - scope.IsRelativeNameResolvableFromSymbol(cursorPos, plid, symbol) + | Some (scope, _builderOpt) -> scope.IsRelativeNameResolvableFromSymbol(cursorPos, plid, symbol) member _.GetDisplayContextForPos(cursorPos: pos) = match details with @@ -2174,7 +2745,7 @@ type FSharpCheckFileResults let (nenv, _), _ = scope.GetBestDisplayEnvForPos cursorPos Some(FSharpDisplayContext(fun _ -> nenv.DisplayEnv)) - member _.GenerateSignature () = + member _.GenerateSignature() = match details with | None -> None | Some (scope, _builderOpt) -> @@ -2182,129 +2753,192 @@ type FSharpCheckFileResults |> Option.map (fun implFile -> let denv = DisplayEnv.InitialForSigFileGeneration scope.TcGlobals let infoReader = InfoReader(scope.TcGlobals, scope.TcImports.GetImportMap()) - let (CheckedImplFile (contents=mexpr)) = implFile + let (CheckedImplFile (contents = mexpr)) = implFile + let ad = match scopeOptX with | Some scope -> scope.AccessRights | _ -> AccessibleFromSomewhere - let layout = NicePrint.layoutImpliedSignatureOfModuleOrNamespace true denv infoReader ad range0 mexpr - layout |> LayoutRender.showL |> SourceText.ofString - ) + + let layout = + NicePrint.layoutImpliedSignatureOfModuleOrNamespace true denv infoReader ad range0 mexpr + + layout |> LayoutRender.showL |> SourceText.ofString) member _.ImplementationFile = - if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" + if not keepAssemblyContents then + invalidOp + "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" + scopeOptX |> Option.map (fun scope -> - let cenv = SymbolEnv(scope.TcGlobals, scope.ThisCcu, Some scope.CcuSigForFile, scope.TcImports) - scope.ImplementationFile |> Option.map (fun implFile -> FSharpImplementationFileContents(cenv, implFile))) + let cenv = + SymbolEnv(scope.TcGlobals, scope.ThisCcu, Some scope.CcuSigForFile, scope.TcImports) + + scope.ImplementationFile + |> Option.map (fun implFile -> FSharpImplementationFileContents(cenv, implFile))) |> Option.defaultValue None member _.OpenDeclarations = scopeOptX |> Option.map (fun scope -> let cenv = scope.SymbolEnv - scope.OpenDeclarations |> Array.map (fun x -> + + scope.OpenDeclarations + |> Array.map (fun x -> let modules = x.Modules |> List.map (fun x -> FSharpEntity(cenv, x)) let types = x.Types |> List.map (fun x -> FSharpType(cenv, x)) FSharpOpenDeclaration(x.Target, x.Range, modules, types, x.AppliedScope, x.IsOwnNamespace))) - |> Option.defaultValue [| |] + |> Option.defaultValue [||] - override _.ToString() = "FSharpCheckFileResults(" + fileName + ")" + override _.ToString() = + "FSharpCheckFileResults(" + fileName + ")" static member MakeEmpty(fileName: string, creationErrors: FSharpDiagnostic[], keepAssemblyContents) = - FSharpCheckFileResults (fileName, creationErrors, None, [| |], None, keepAssemblyContents) - - static member JoinErrors(isIncompleteTypeCheckEnvironment, - creationErrors: FSharpDiagnostic[], - parseErrors: FSharpDiagnostic[], - tcErrors: FSharpDiagnostic[]) = - [| yield! creationErrors - yield! parseErrors - if isIncompleteTypeCheckEnvironment then - yield! Seq.truncate maxTypeCheckErrorsOutOfProjectContext tcErrors - else - yield! tcErrors |] + FSharpCheckFileResults(fileName, creationErrors, None, [||], None, keepAssemblyContents) + + static member JoinErrors + ( + isIncompleteTypeCheckEnvironment, + creationErrors: FSharpDiagnostic[], + parseErrors: FSharpDiagnostic[], + tcErrors: FSharpDiagnostic[] + ) = + [| + yield! creationErrors + yield! parseErrors + if isIncompleteTypeCheckEnvironment then + yield! Seq.truncate maxTypeCheckErrorsOutOfProjectContext tcErrors + else + yield! tcErrors + |] static member Make - (mainInputFileName: string, - projectFileName, - tcConfig, tcGlobals, - isIncompleteTypeCheckEnvironment: bool, - builder: IncrementalBuilder, - projectOptions, - dependencyFiles, - creationErrors: FSharpDiagnostic[], - parseErrors: FSharpDiagnostic[], - tcErrors: FSharpDiagnostic[], - keepAssemblyContents, - ccuSigForFile, - thisCcu, tcImports, tcAccessRights, - sResolutions, sSymbolUses, - sFallback, loadClosure, - implFileOpt, - openDeclarations) = + ( + mainInputFileName: string, + projectFileName, + tcConfig, + tcGlobals, + isIncompleteTypeCheckEnvironment: bool, + builder: IncrementalBuilder, + projectOptions, + dependencyFiles, + creationErrors: FSharpDiagnostic[], + parseErrors: FSharpDiagnostic[], + tcErrors: FSharpDiagnostic[], + keepAssemblyContents, + ccuSigForFile, + thisCcu, + tcImports, + tcAccessRights, + sResolutions, + sSymbolUses, + sFallback, + loadClosure, + implFileOpt, + openDeclarations + ) = let tcFileInfo = - TypeCheckInfo(tcConfig, tcGlobals, ccuSigForFile, thisCcu, tcImports, tcAccessRights, - projectFileName, mainInputFileName, - projectOptions, - sResolutions, sSymbolUses, - sFallback, loadClosure, - implFileOpt, openDeclarations) + TypeCheckInfo( + tcConfig, + tcGlobals, + ccuSigForFile, + thisCcu, + tcImports, + tcAccessRights, + projectFileName, + mainInputFileName, + projectOptions, + sResolutions, + sSymbolUses, + sFallback, + loadClosure, + implFileOpt, + openDeclarations + ) - let errors = FSharpCheckFileResults.JoinErrors(isIncompleteTypeCheckEnvironment, creationErrors, parseErrors, tcErrors) - FSharpCheckFileResults (mainInputFileName, errors, Some tcFileInfo, dependencyFiles, Some builder, keepAssemblyContents) + let errors = + FSharpCheckFileResults.JoinErrors(isIncompleteTypeCheckEnvironment, creationErrors, parseErrors, tcErrors) + + FSharpCheckFileResults(mainInputFileName, errors, Some tcFileInfo, dependencyFiles, Some builder, keepAssemblyContents) static member CheckOneFile - (parseResults: FSharpParseFileResults, - sourceText: ISourceText, - mainInputFileName: string, - projectFileName: string, - tcConfig: TcConfig, - tcGlobals: TcGlobals, - tcImports: TcImports, - tcState: TcState, - moduleNamesDict: ModuleNamesDict, - loadClosure: LoadClosure option, - backgroundDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity)[], - isIncompleteTypeCheckEnvironment: bool, - projectOptions: FSharpProjectOptions, - builder: IncrementalBuilder, - dependencyFiles: string[], - creationErrors: FSharpDiagnostic[], - parseErrors: FSharpDiagnostic[], - keepAssemblyContents: bool, - suggestNamesForErrors: bool) = + ( + parseResults: FSharpParseFileResults, + sourceText: ISourceText, + mainInputFileName: string, + projectFileName: string, + tcConfig: TcConfig, + tcGlobals: TcGlobals, + tcImports: TcImports, + tcState: TcState, + moduleNamesDict: ModuleNamesDict, + loadClosure: LoadClosure option, + backgroundDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity)[], + isIncompleteTypeCheckEnvironment: bool, + projectOptions: FSharpProjectOptions, + builder: IncrementalBuilder, + dependencyFiles: string[], + creationErrors: FSharpDiagnostic[], + parseErrors: FSharpDiagnostic[], + keepAssemblyContents: bool, + suggestNamesForErrors: bool + ) = cancellable { let! tcErrors, tcFileInfo = - ParseAndCheckFile.CheckOneFile - (parseResults, sourceText, mainInputFileName, projectOptions, - projectFileName, tcConfig, tcGlobals, tcImports, - tcState, moduleNamesDict, loadClosure, backgroundDiagnostics, suggestNamesForErrors) - let errors = FSharpCheckFileResults.JoinErrors(isIncompleteTypeCheckEnvironment, creationErrors, parseErrors, tcErrors) - let results = FSharpCheckFileResults (mainInputFileName, errors, Some tcFileInfo, dependencyFiles, Some builder, keepAssemblyContents) + ParseAndCheckFile.CheckOneFile( + parseResults, + sourceText, + mainInputFileName, + projectOptions, + projectFileName, + tcConfig, + tcGlobals, + tcImports, + tcState, + moduleNamesDict, + loadClosure, + backgroundDiagnostics, + suggestNamesForErrors + ) + + let errors = + FSharpCheckFileResults.JoinErrors(isIncompleteTypeCheckEnvironment, creationErrors, parseErrors, tcErrors) + + let results = + FSharpCheckFileResults(mainInputFileName, errors, Some tcFileInfo, dependencyFiles, Some builder, keepAssemblyContents) + return results } [] // 'details' is an option because the creation of the tcGlobals etc. for the project may have failed. type FSharpCheckProjectResults - (projectFileName:string, - tcConfigOption: TcConfig option, - keepAssemblyContents: bool, - diagnostics: FSharpDiagnostic[], - details:(TcGlobals * TcImports * CcuThunk * ModuleOrNamespaceType * Choice * - TopAttribs option * (unit -> IRawFSharpAssemblyData option) * ILAssemblyRef * - AccessorDomain * CheckedImplFile list option * string[] * FSharpProjectOptions) option) = - - let getDetails() = + ( + projectFileName: string, + tcConfigOption: TcConfig option, + keepAssemblyContents: bool, + diagnostics: FSharpDiagnostic[], + details: (TcGlobals * TcImports * CcuThunk * ModuleOrNamespaceType * Choice * TopAttribs option * (unit -> IRawFSharpAssemblyData option) * ILAssemblyRef * AccessorDomain * CheckedImplFile list option * string[] * FSharpProjectOptions) option + ) = + + let getDetails () = match details with - | None -> invalidOp ("The project has no results due to critical errors in the project options. Check the HasCriticalErrors before accessing the detailed results. Errors: " + String.concat "\n" [ for e in diagnostics -> e.Message ]) + | None -> + invalidOp ( + "The project has no results due to critical errors in the project options. Check the HasCriticalErrors before accessing the detailed results. Errors: " + + String.concat "\n" [ for e in diagnostics -> e.Message ] + ) | Some d -> d - let getTcConfig() = + let getTcConfig () = match tcConfigOption with - | None -> invalidOp ("The project has no results due to critical errors in the project options. Check the HasCriticalErrors before accessing the detailed results. Errors: " + String.concat "\n" [ for e in diagnostics -> e.Message ]) + | None -> + invalidOp ( + "The project has no results due to critical errors in the project options. Check the HasCriticalErrors before accessing the detailed results. Errors: " + + String.concat "\n" [ for e in diagnostics -> e.Message ] + ) | Some d -> d member _.Diagnostics = diagnostics @@ -2312,51 +2946,73 @@ type FSharpCheckProjectResults member _.HasCriticalErrors = details.IsNone member _.AssemblySignature = - let tcGlobals, tcImports, thisCcu, ccuSig, _, topAttribs, _, _, _, _, _, _ = getDetails() + let tcGlobals, tcImports, thisCcu, ccuSig, _, topAttribs, _, _, _, _, _, _ = + getDetails () + FSharpAssemblySignature(tcGlobals, thisCcu, ccuSig, tcImports, topAttribs, ccuSig) member _.TypedImplementationFiles = - if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" - let tcGlobals, tcImports, thisCcu, _, _, _, _, _, _, tcAssemblyExpr, _, _ = getDetails() + if not keepAssemblyContents then + invalidOp + "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" + + let tcGlobals, tcImports, thisCcu, _, _, _, _, _, _, tcAssemblyExpr, _, _ = + getDetails () + let mimpls = match tcAssemblyExpr with | None -> [] | Some mimpls -> mimpls + tcGlobals, thisCcu, tcImports, mimpls member info.AssemblyContents = - if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" - let tcGlobals, tcImports, thisCcu, ccuSig, _, _, _, _, _, tcAssemblyExpr, _, _ = getDetails() + if not keepAssemblyContents then + invalidOp + "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" + + let tcGlobals, tcImports, thisCcu, ccuSig, _, _, _, _, _, tcAssemblyExpr, _, _ = + getDetails () + let mimpls = match tcAssemblyExpr with | None -> [] | Some mimpls -> mimpls + FSharpAssemblyContents(tcGlobals, thisCcu, Some ccuSig, tcImports, mimpls) member _.GetOptimizedAssemblyContents() = - if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" - let tcGlobals, tcImports, thisCcu, ccuSig, _, _, _, _, _, tcAssemblyExpr, _, _ = getDetails() + if not keepAssemblyContents then + invalidOp + "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" + + let tcGlobals, tcImports, thisCcu, ccuSig, _, _, _, _, _, tcAssemblyExpr, _, _ = + getDetails () + let mimpls = match tcAssemblyExpr with | None -> [] | Some mimpls -> mimpls + let outfile = "" // only used if tcConfig.writeTermsToFiles is true let importMap = tcImports.GetImportMap() - let optEnv0 = GetInitialOptimizationEnv (tcImports, tcGlobals) - let tcConfig = getTcConfig() + let optEnv0 = GetInitialOptimizationEnv(tcImports, tcGlobals) + let tcConfig = getTcConfig () let isIncrementalFragment = false let tcVal = LightweightTcValForUsingInBuildMethodCall tcGlobals - let optimizedImpls, _optimizationData, _ = ApplyAllOptimizations (tcConfig, tcGlobals, tcVal, outfile, importMap, isIncrementalFragment, optEnv0, thisCcu, mimpls) + + let optimizedImpls, _optimizationData, _ = + ApplyAllOptimizations(tcConfig, tcGlobals, tcVal, outfile, importMap, isIncrementalFragment, optEnv0, thisCcu, mimpls) + let mimpls = match optimizedImpls with - | CheckedAssemblyAfterOptimization files -> - files |> List.map (fun implFile -> implFile.ImplFile) + | CheckedAssemblyAfterOptimization files -> files |> List.map (fun implFile -> implFile.ImplFile) FSharpAssemblyContents(tcGlobals, thisCcu, Some ccuSig, tcImports, mimpls) // Not, this does not have to be a SyncOp, it can be called from any thread - member _.GetUsesOfSymbol(symbol:FSharpSymbol, ?cancellationToken: CancellationToken) = - let _, _, _, _, builderOrSymbolUses, _, _, _, _, _, _, _ = getDetails() + member _.GetUsesOfSymbol(symbol: FSharpSymbol, ?cancellationToken: CancellationToken) = + let _, _, _, _, builderOrSymbolUses, _, _, _, _, _, _, _ = getDetails () let results = match builderOrSymbolUses with @@ -2367,28 +3023,25 @@ type FSharpCheckProjectResults match builder.GetCheckResultsForFileInProjectEvenIfStale x with | Some partialCheckResults -> match partialCheckResults.TryPeekTcInfoWithExtras() with - | Some(_, tcInfoExtras) -> - tcInfoExtras.TcSymbolUses.GetUsesOfSymbol symbol.Item - | _ -> - [||] - | _ -> - [||] - ) - | Choice2Of2 tcSymbolUses -> - tcSymbolUses.GetUsesOfSymbol symbol.Item + | Some (_, tcInfoExtras) -> tcInfoExtras.TcSymbolUses.GetUsesOfSymbol symbol.Item + | _ -> [||] + | _ -> [||]) + | Choice2Of2 tcSymbolUses -> tcSymbolUses.GetUsesOfSymbol symbol.Item results |> Seq.filter (fun symbolUse -> symbolUse.ItemOccurence <> ItemOccurence.RelatedText) |> Seq.distinctBy (fun symbolUse -> symbolUse.ItemOccurence, symbolUse.Range) |> Seq.map (fun symbolUse -> - cancellationToken |> Option.iter (fun ct -> ct.ThrowIfCancellationRequested()) - let inst = symbolUse.ItemWithInst.TyparInstantiation - FSharpSymbolUse(symbolUse.DisplayEnv, symbol, inst, symbolUse.ItemOccurence, symbolUse.Range)) + cancellationToken |> Option.iter (fun ct -> ct.ThrowIfCancellationRequested()) + let inst = symbolUse.ItemWithInst.TyparInstantiation + FSharpSymbolUse(symbolUse.DisplayEnv, symbol, inst, symbolUse.ItemOccurence, symbolUse.Range)) |> Seq.toArray // Not, this does not have to be a SyncOp, it can be called from any thread member _.GetAllUsesOfAllSymbols(?cancellationToken: CancellationToken) = - let tcGlobals, tcImports, thisCcu, ccuSig, builderOrSymbolUses, _, _, _, _, _, _, _ = getDetails() + let tcGlobals, tcImports, thisCcu, ccuSig, builderOrSymbolUses, _, _, _, _, _, _, _ = + getDetails () + let cenv = SymbolEnv(tcGlobals, thisCcu, Some ccuSig, tcImports) let tcSymbolUses = @@ -2400,116 +3053,152 @@ type FSharpCheckProjectResults match builder.GetCheckResultsForFileInProjectEvenIfStale x with | Some partialCheckResults -> match partialCheckResults.TryPeekTcInfoWithExtras() with - | Some(_, tcInfoExtras) -> - tcInfoExtras.TcSymbolUses - | _ -> - TcSymbolUses.Empty - | _ -> - TcSymbolUses.Empty - ) - | Choice2Of2 tcSymbolUses -> - [|tcSymbolUses|] - - [| for r in tcSymbolUses do - for symbolUseChunk in r.AllUsesOfSymbols do - for symbolUse in symbolUseChunk do - cancellationToken |> Option.iter (fun ct -> ct.ThrowIfCancellationRequested()) - if symbolUse.ItemOccurence <> ItemOccurence.RelatedText then - let symbol = FSharpSymbol.Create(cenv, symbolUse.ItemWithInst.Item) - let inst = symbolUse.ItemWithInst.TyparInstantiation - FSharpSymbolUse(symbolUse.DisplayEnv, symbol, inst, symbolUse.ItemOccurence, symbolUse.Range) |] + | Some (_, tcInfoExtras) -> tcInfoExtras.TcSymbolUses + | _ -> TcSymbolUses.Empty + | _ -> TcSymbolUses.Empty) + | Choice2Of2 tcSymbolUses -> [| tcSymbolUses |] + + [| + for r in tcSymbolUses do + for symbolUseChunk in r.AllUsesOfSymbols do + for symbolUse in symbolUseChunk do + cancellationToken |> Option.iter (fun ct -> ct.ThrowIfCancellationRequested()) + + if symbolUse.ItemOccurence <> ItemOccurence.RelatedText then + let symbol = FSharpSymbol.Create(cenv, symbolUse.ItemWithInst.Item) + let inst = symbolUse.ItemWithInst.TyparInstantiation + FSharpSymbolUse(symbolUse.DisplayEnv, symbol, inst, symbolUse.ItemOccurence, symbolUse.Range) + |] member _.ProjectContext = - let tcGlobals, tcImports, thisCcu, _, _, _, _, _, ad, _, _, projectOptions = getDetails() + let tcGlobals, tcImports, thisCcu, _, _, _, _, _, ad, _, _, projectOptions = + getDetails () + let assemblies = tcImports.GetImportedAssemblies() |> List.map (fun x -> FSharpAssembly(tcGlobals, tcImports, x.FSharpViewOfMetadata)) + FSharpProjectContext(thisCcu, assemblies, ad, projectOptions) member _.DependencyFiles = - let _tcGlobals, _, _, _, _, _, _, _, _, _, dependencyFiles, _ = getDetails() + let _tcGlobals, _, _, _, _, _, _, _, _, _, dependencyFiles, _ = getDetails () dependencyFiles member _.AssemblyFullName = - let _tcGlobals, _, _, _, _, _, _, ilAssemRef, _, _, _, _ = getDetails() + let _tcGlobals, _, _, _, _, _, _, ilAssemRef, _, _, _, _ = getDetails () ilAssemRef.QualifiedName - override _.ToString() = "FSharpCheckProjectResults(" + projectFileName + ")" + override _.ToString() = + "FSharpCheckProjectResults(" + projectFileName + ")" -type FsiInteractiveChecker(legacyReferenceResolver, - tcConfig: TcConfig, - tcGlobals: TcGlobals, - tcImports: TcImports, - tcState) = +type FsiInteractiveChecker(legacyReferenceResolver, tcConfig: TcConfig, tcGlobals: TcGlobals, tcImports: TcImports, tcState) = let keepAssemblyContents = false - member _.ParseAndCheckInteraction (sourceText: ISourceText, ?userOpName: string) = + member _.ParseAndCheckInteraction(sourceText: ISourceText, ?userOpName: string) = cancellable { let userOpName = defaultArg userOpName "Unknown" let fileName = Path.Combine(tcConfig.implicitIncludeDir, "stdin.fsx") let suggestNamesForErrors = true // Will always be true, this is just for readability // Note: projectSourceFiles is only used to compute isLastCompiland, and is ignored if Build.IsScript(mainInputFileName) is true (which it is in this case). - let parsingOptions = FSharpParsingOptions.FromTcConfig(tcConfig, [| fileName |], true) - let parseErrors, parsedInput, anyErrors = ParseAndCheckFile.parseFile (sourceText, fileName, parsingOptions, userOpName, suggestNamesForErrors) - let dependencyFiles = [| |] // interactions have no dependencies - let parseResults = FSharpParseFileResults(parseErrors, parsedInput, parseHadErrors = anyErrors, dependencyFiles = dependencyFiles) + let parsingOptions = + FSharpParsingOptions.FromTcConfig(tcConfig, [| fileName |], true) - let backgroundDiagnostics = [| |] + let parseErrors, parsedInput, anyErrors = + ParseAndCheckFile.parseFile (sourceText, fileName, parsingOptions, userOpName, suggestNamesForErrors) + + let dependencyFiles = [||] // interactions have no dependencies + + let parseResults = + FSharpParseFileResults(parseErrors, parsedInput, parseHadErrors = anyErrors, dependencyFiles = dependencyFiles) + + let backgroundDiagnostics = [||] let reduceMemoryUsage = ReduceMemoryFlag.Yes let assumeDotNetFramework = (tcConfig.primaryAssembly = PrimaryAssembly.Mscorlib) - let applyCompilerOptions tcConfigB = + let applyCompilerOptions tcConfigB = let fsiCompilerOptions = CompilerOptions.GetCoreFsiCompilerOptions tcConfigB - CompilerOptions.ParseCompilerOptions (ignore, fsiCompilerOptions, [ ]) + CompilerOptions.ParseCompilerOptions(ignore, fsiCompilerOptions, []) let loadClosure = - LoadClosure.ComputeClosureOfScriptText(legacyReferenceResolver, defaultFSharpBinariesDir, - fileName, sourceText, CodeContext.Editing, - tcConfig.useSimpleResolution, tcConfig.useFsiAuxLib, - tcConfig.useSdkRefs, tcConfig.sdkDirOverride, LexResourceManager(), - applyCompilerOptions, assumeDotNetFramework, - tryGetMetadataSnapshot=(fun _ -> None), - reduceMemoryUsage=reduceMemoryUsage, - dependencyProvider=tcImports.DependencyProvider) + LoadClosure.ComputeClosureOfScriptText( + legacyReferenceResolver, + defaultFSharpBinariesDir, + fileName, + sourceText, + CodeContext.Editing, + tcConfig.useSimpleResolution, + tcConfig.useFsiAuxLib, + tcConfig.useSdkRefs, + tcConfig.sdkDirOverride, + LexResourceManager(), + applyCompilerOptions, + assumeDotNetFramework, + tryGetMetadataSnapshot = (fun _ -> None), + reduceMemoryUsage = reduceMemoryUsage, + dependencyProvider = tcImports.DependencyProvider + ) let projectOptions = { - ProjectFileName="script.fsproj" - ProjectId=None - SourceFiles=[||] - OtherOptions=[||] - ReferencedProjects=[||] - IsIncompleteTypeCheckEnvironment=false - UseScriptResolutionRules =false - LoadTime=DateTime.Now - UnresolvedReferences =None - OriginalLoadReferences = [] - Stamp = None + ProjectFileName = "script.fsproj" + ProjectId = None + SourceFiles = [||] + OtherOptions = [||] + ReferencedProjects = [||] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false + LoadTime = DateTime.Now + UnresolvedReferences = None + OriginalLoadReferences = [] + Stamp = None } let! tcErrors, tcFileInfo = - ParseAndCheckFile.CheckOneFile - (parseResults, sourceText, fileName, projectOptions, projectOptions.ProjectFileName, - tcConfig, tcGlobals, tcImports, tcState, - Map.empty, Some loadClosure, backgroundDiagnostics, - suggestNamesForErrors) + ParseAndCheckFile.CheckOneFile( + parseResults, + sourceText, + fileName, + projectOptions, + projectOptions.ProjectFileName, + tcConfig, + tcGlobals, + tcImports, + tcState, + Map.empty, + Some loadClosure, + backgroundDiagnostics, + suggestNamesForErrors + ) let errors = Array.append parseErrors tcErrors - let typeCheckResults = FSharpCheckFileResults (fileName, errors, Some tcFileInfo, dependencyFiles, None, false) + + let typeCheckResults = + FSharpCheckFileResults(fileName, errors, Some tcFileInfo, dependencyFiles, None, false) + let details = - (tcGlobals, tcImports, tcFileInfo.ThisCcu, tcFileInfo.CcuSigForFile, - Choice2Of2 tcFileInfo.ScopeSymbolUses, None, (fun () -> None), mkSimpleAssemblyRef "stdin", - tcState.TcEnvFromImpls.AccessRights, None, dependencyFiles, + (tcGlobals, + tcImports, + tcFileInfo.ThisCcu, + tcFileInfo.CcuSigForFile, + Choice2Of2 tcFileInfo.ScopeSymbolUses, + None, + (fun () -> None), + mkSimpleAssemblyRef "stdin", + tcState.TcEnvFromImpls.AccessRights, + None, + dependencyFiles, projectOptions) + let projectResults = - FSharpCheckProjectResults (fileName, Some tcConfig,keepAssemblyContents, errors, Some details) + FSharpCheckProjectResults(fileName, Some tcConfig, keepAssemblyContents, errors, Some details) return parseResults, typeCheckResults, projectResults } /// The result of calling TypeCheckResult including the possibility of abort and background compiler not caught up. -type [] public FSharpCheckFileAnswer = +[] +type public FSharpCheckFileAnswer = /// Aborted because cancellation caused an abandonment of the operation | Aborted diff --git a/src/Compiler/Service/FSharpParseFileResults.fs b/src/Compiler/Service/FSharpParseFileResults.fs index fd274e0fdc0b..59a4946c2cb4 100644 --- a/src/Compiler/Service/FSharpParseFileResults.fs +++ b/src/Compiler/Service/FSharpParseFileResults.fs @@ -6,7 +6,7 @@ open System open System.IO open System.Collections.Generic open System.Diagnostics -open Internal.Utilities.Library +open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices @@ -21,20 +21,22 @@ module SourceFileImpl = 0 = String.Compare(".fsi", ext, StringComparison.OrdinalIgnoreCase) /// Additional #defines that should be in place when editing a file in a file editor such as VS. - let GetImplicitConditionalDefinesForEditing(isInteractive: bool) = - if isInteractive then ["INTERACTIVE";"EDITING"] // This is still used by the foreground parse - else ["COMPILED";"EDITING"] - + let GetImplicitConditionalDefinesForEditing (isInteractive: bool) = + if isInteractive then + [ "INTERACTIVE"; "EDITING" ] // This is still used by the foreground parse + else + [ "COMPILED"; "EDITING" ] + type CompletionPath = string list * string option // plid * residue [] -type FSharpInheritanceOrigin = +type FSharpInheritanceOrigin = | Class | Interface | Unknown [] -type InheritanceContext = +type InheritanceContext = | Class | Interface | Unknown @@ -46,7 +48,7 @@ type RecordContext = | New of path: CompletionPath [] -type CompletionContext = +type CompletionContext = /// Completion context cannot be determined due to errors | Invalid @@ -74,7 +76,7 @@ type CompletionContext = //---------------------------------------------------------------------------- [] -type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, parseHadErrors: bool, dependencyFiles: string[]) = +type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, parseHadErrors: bool, dependencyFiles: string[]) = member _.Diagnostics = diagnostics @@ -85,15 +87,12 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, member _.TryRangeOfNameOfNearestOuterBindingContainingPos pos = let tryGetIdentRangeFromBinding binding = match binding with - | SynBinding(headPat=headPat) -> + | SynBinding (headPat = headPat) -> match headPat with - | SynPat.LongIdent (longDotId=longIdentWithDots) -> - Some longIdentWithDots.Range - | SynPat.As (rhsPat=SynPat.Named (ident=SynIdent(ident,_); isThisVal=false)) - | SynPat.Named (SynIdent(ident,_), false, _, _) -> - Some ident.idRange - | _ -> - None + | SynPat.LongIdent (longDotId = longIdentWithDots) -> Some longIdentWithDots.Range + | SynPat.As(rhsPat = SynPat.Named (ident = SynIdent (ident, _); isThisVal = false)) + | SynPat.Named (SynIdent (ident, _), false, _, _) -> Some ident.idRange + | _ -> None let rec walkBinding expr workingRange = match expr with @@ -105,71 +104,69 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, else walkBinding expr2 workingRange - - | SynExpr.LetOrUse(bindings=bindings; body=bodyExpr) -> + | SynExpr.LetOrUse (bindings = bindings; body = bodyExpr) -> let potentialNestedRange = bindings |> List.tryFind (fun binding -> rangeContainsPos binding.RangeOfBindingWithRhs pos) |> Option.bind tryGetIdentRangeFromBinding + match potentialNestedRange with - | Some range -> - walkBinding bodyExpr range - | None -> - walkBinding bodyExpr workingRange + | Some range -> walkBinding bodyExpr range + | None -> walkBinding bodyExpr workingRange - - | _ -> - Some workingRange + | _ -> Some workingRange let visitor = { new SyntaxVisitorBase<_>() with - override _.VisitExpr(_, _, defaultTraverse, expr) = - defaultTraverse expr + override _.VisitExpr(_, _, defaultTraverse, expr) = defaultTraverse expr override _.VisitBinding(_path, defaultTraverse, binding) = match binding with - | SynBinding(valData=SynValData (memberFlags=None); expr=expr) as b when rangeContainsPos b.RangeOfBindingWithRhs pos -> + | SynBinding (valData = SynValData(memberFlags = None); expr = expr) as b when + rangeContainsPos b.RangeOfBindingWithRhs pos + -> match tryGetIdentRangeFromBinding b with | Some range -> walkBinding expr range | None -> None - | _ -> defaultTraverse binding } + | _ -> defaultTraverse binding + } + SyntaxTraversal.Traverse(pos, input, visitor) - + member _.TryIdentOfPipelineContainingPosAndNumArgsApplied pos = let visitor = { new SyntaxVisitorBase<_>() with member _.VisitExpr(_, _, defaultTraverse, expr) = match expr with - | SynExpr.App (_, _, SynExpr.App(_, true, SynExpr.LongIdent(longDotId = SynLongIdent(id = [ident])), _, _), argExpr, _) when rangeContainsPos argExpr.Range pos -> + | SynExpr.App (_, + _, + SynExpr.App (_, true, SynExpr.LongIdent(longDotId = SynLongIdent(id = [ ident ])), _, _), + argExpr, + _) when rangeContainsPos argExpr.Range pos -> match argExpr with - | SynExpr.App(_, _, _, SynExpr.Paren(expr, _, _, _), _) when rangeContainsPos expr.Range pos -> - None + | SynExpr.App (_, _, _, SynExpr.Paren (expr, _, _, _), _) when rangeContainsPos expr.Range pos -> None | _ -> - if ident.idText = "op_PipeRight" then - Some (ident, 1) - elif ident.idText = "op_PipeRight2" then - Some (ident, 2) - elif ident.idText = "op_PipeRight3" then - Some (ident, 3) - else - None + if ident.idText = "op_PipeRight" then Some(ident, 1) + elif ident.idText = "op_PipeRight2" then Some(ident, 2) + elif ident.idText = "op_PipeRight3" then Some(ident, 3) + else None | _ -> defaultTraverse expr } + SyntaxTraversal.Traverse(pos, input, visitor) - + member _.IsPosContainedInApplication pos = let visitor = { new SyntaxVisitorBase<_>() with member _.VisitExpr(_, traverseSynExpr, defaultTraverse, expr) = match expr with - | SynExpr.TypeApp (_, _, _, _, _, _, range) when rangeContainsPos range pos -> - Some range - | SynExpr.App(_, _, _, SynExpr.ComputationExpr (_, expr, _), range) when rangeContainsPos range pos -> + | SynExpr.TypeApp (_, _, _, _, _, _, range) when rangeContainsPos range pos -> Some range + | SynExpr.App (_, _, _, SynExpr.ComputationExpr (_, expr, _), range) when rangeContainsPos range pos -> traverseSynExpr expr - | SynExpr.App (_, _, _, _, range) when rangeContainsPos range pos -> - Some range + | SynExpr.App (_, _, _, _, range) when rangeContainsPos range pos -> Some range | _ -> defaultTraverse expr } + let result = SyntaxTraversal.Traverse(pos, input, visitor) result.IsSome @@ -177,14 +174,12 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, let rec getIdentRangeForFuncExprInApp traverseSynExpr expr pos = match expr with | SynExpr.Ident ident -> Some ident.idRange - + | SynExpr.LongIdent (_, _, _, range) -> Some range - | SynExpr.Paren (expr, _, _, range) when rangeContainsPos range pos -> - getIdentRangeForFuncExprInApp traverseSynExpr expr pos + | SynExpr.Paren (expr, _, _, range) when rangeContainsPos range pos -> getIdentRangeForFuncExprInApp traverseSynExpr expr pos - | SynExpr.TypeApp (expr, _, _, _, _, _, _) -> - getIdentRangeForFuncExprInApp traverseSynExpr expr pos + | SynExpr.TypeApp (expr, _, _, _, _, _, _) -> getIdentRangeForFuncExprInApp traverseSynExpr expr pos | SynExpr.App (_, _, funcExpr, argExpr, _) -> match argExpr with @@ -218,7 +213,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | _ -> match funcExpr with | SynExpr.App (_, true, _, _, _) when rangeContainsPos argExpr.Range pos -> - // x |> List.map + // x |> List.map // Don't dive into the funcExpr (the operator expr) // because we dont want to offer sig help for that! getIdentRangeForFuncExprInApp traverseSynExpr argExpr pos @@ -233,17 +228,15 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, else getIdentRangeForFuncExprInApp traverseSynExpr expr2 pos - | SynExpr.LetOrUse (bindings=bindings; body=body; range=range) when rangeContainsPos range pos -> + | SynExpr.LetOrUse (bindings = bindings; body = body; range = range) when rangeContainsPos range pos -> let binding = - bindings - |> List.tryFind (fun x -> rangeContainsPos x.RangeOfBindingWithRhs pos) + bindings |> List.tryFind (fun x -> rangeContainsPos x.RangeOfBindingWithRhs pos) + match binding with - | Some(SynBinding.SynBinding(expr=expr)) -> - getIdentRangeForFuncExprInApp traverseSynExpr expr pos - | None -> - getIdentRangeForFuncExprInApp traverseSynExpr body pos + | Some (SynBinding.SynBinding (expr = expr)) -> getIdentRangeForFuncExprInApp traverseSynExpr expr pos + | None -> getIdentRangeForFuncExprInApp traverseSynExpr body pos - | SynExpr.IfThenElse (ifExpr=ifExpr; thenExpr=thenExpr; elseExpr=elseExpr; range=range) when rangeContainsPos range pos -> + | SynExpr.IfThenElse (ifExpr = ifExpr; thenExpr = thenExpr; elseExpr = elseExpr; range = range) when rangeContainsPos range pos -> if rangeContainsPos ifExpr.Range pos then getIdentRangeForFuncExprInApp traverseSynExpr ifExpr pos elif rangeContainsPos thenExpr.Range pos then @@ -251,52 +244,46 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, else match elseExpr with | None -> None - | Some expr -> - getIdentRangeForFuncExprInApp traverseSynExpr expr pos + | Some expr -> getIdentRangeForFuncExprInApp traverseSynExpr expr pos - | SynExpr.Match (expr=expr; clauses=clauses; range=range) when rangeContainsPos range pos -> + | SynExpr.Match (expr = expr; clauses = clauses; range = range) when rangeContainsPos range pos -> if rangeContainsPos expr.Range pos then getIdentRangeForFuncExprInApp traverseSynExpr expr pos else - let clause = clauses |> List.tryFind (fun clause -> rangeContainsPos clause.Range pos) + let clause = + clauses |> List.tryFind (fun clause -> rangeContainsPos clause.Range pos) + match clause with | None -> None | Some clause -> match clause with - | SynMatchClause.SynMatchClause (whenExpr=whenExprOpt; resultExpr=resultExpr) -> + | SynMatchClause.SynMatchClause (whenExpr = whenExprOpt; resultExpr = resultExpr) -> match whenExprOpt with - | None -> - getIdentRangeForFuncExprInApp traverseSynExpr resultExpr pos + | None -> getIdentRangeForFuncExprInApp traverseSynExpr resultExpr pos | Some whenExpr -> if rangeContainsPos whenExpr.Range pos then getIdentRangeForFuncExprInApp traverseSynExpr whenExpr pos else getIdentRangeForFuncExprInApp traverseSynExpr resultExpr pos - // Ex: C.M(x, y, ...) <--- We want to find where in the tupled application the call is being made - | SynExpr.Tuple(_, exprs, _, tupRange) when rangeContainsPos tupRange pos -> + | SynExpr.Tuple (_, exprs, _, tupRange) when rangeContainsPos tupRange pos -> let expr = exprs |> List.tryFind (fun expr -> rangeContainsPos expr.Range pos) + match expr with | None -> None - | Some expr -> - getIdentRangeForFuncExprInApp traverseSynExpr expr pos + | Some expr -> getIdentRangeForFuncExprInApp traverseSynExpr expr pos // Capture the body of a lambda, often nested in a call to a collection function - | SynExpr.Lambda(body=body) when rangeContainsPos body.Range pos -> - getIdentRangeForFuncExprInApp traverseSynExpr body pos + | SynExpr.Lambda (body = body) when rangeContainsPos body.Range pos -> getIdentRangeForFuncExprInApp traverseSynExpr body pos - | SynExpr.Do(expr, range) when rangeContainsPos range pos -> - getIdentRangeForFuncExprInApp traverseSynExpr expr pos + | SynExpr.Do (expr, range) when rangeContainsPos range pos -> getIdentRangeForFuncExprInApp traverseSynExpr expr pos - | SynExpr.Assert(expr, range) when rangeContainsPos range pos -> - getIdentRangeForFuncExprInApp traverseSynExpr expr pos + | SynExpr.Assert (expr, range) when rangeContainsPos range pos -> getIdentRangeForFuncExprInApp traverseSynExpr expr pos - | SynExpr.ArbitraryAfterError (_debugStr, range) when rangeContainsPos range pos -> - Some range + | SynExpr.ArbitraryAfterError (_debugStr, range) when rangeContainsPos range pos -> Some range - | expr -> - traverseSynExpr expr + | expr -> traverseSynExpr expr let visitor = { new SyntaxVisitorBase<_>() with @@ -308,6 +295,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, getIdentRangeForFuncExprInApp traverseSynExpr app pos | _ -> defaultTraverse expr } + SyntaxTraversal.Traverse(pos, input, visitor) member _.GetAllArgumentsForFunctionApplicationAtPostion pos = @@ -315,107 +303,124 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, member _.TryRangeOfParenEnclosingOpEqualsGreaterUsage opGreaterEqualPos = let (|Ident|_|) ofName = - function | SynExpr.LongIdent(longDotId = SynLongIdent(id = [ident])) when ident.idText = ofName -> Some () - | _ -> None - let (|InfixAppOfOpEqualsGreater|_|) = - function | SynExpr.App(ExprAtomicFlag.NonAtomic, false, SynExpr.App(ExprAtomicFlag.NonAtomic, true, Ident "op_EqualsGreater", actualParamListExpr, _), actualLambdaBodyExpr, _) -> - Some (actualParamListExpr, actualLambdaBodyExpr) - | _ -> None + function + | SynExpr.LongIdent(longDotId = SynLongIdent(id = [ ident ])) when ident.idText = ofName -> Some() + | _ -> None - SyntaxTraversal.Traverse(opGreaterEqualPos, input, { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_, _, defaultTraverse, expr) = - match expr with - | SynExpr.Paren(InfixAppOfOpEqualsGreater(lambdaArgs, lambdaBody) as app, _, _, _) -> - Some (app.Range, lambdaArgs.Range, lambdaBody.Range) - | _ -> defaultTraverse expr + let (|InfixAppOfOpEqualsGreater|_|) = + function + | SynExpr.App (ExprAtomicFlag.NonAtomic, + false, + SynExpr.App (ExprAtomicFlag.NonAtomic, true, Ident "op_EqualsGreater", actualParamListExpr, _), + actualLambdaBodyExpr, + _) -> Some(actualParamListExpr, actualLambdaBodyExpr) + | _ -> None + + SyntaxTraversal.Traverse( + opGreaterEqualPos, + input, + { new SyntaxVisitorBase<_>() with + member _.VisitExpr(_, _, defaultTraverse, expr) = + match expr with + | SynExpr.Paren (InfixAppOfOpEqualsGreater (lambdaArgs, lambdaBody) as app, _, _, _) -> + Some(app.Range, lambdaArgs.Range, lambdaBody.Range) + | _ -> defaultTraverse expr - member _.VisitBinding(_path, defaultTraverse, binding) = - match binding with - | SynBinding(kind=SynBindingKind.Normal; expr=InfixAppOfOpEqualsGreater(lambdaArgs, lambdaBody) as app) -> - Some(app.Range, lambdaArgs.Range, lambdaBody.Range) - | _ -> defaultTraverse binding }) + member _.VisitBinding(_path, defaultTraverse, binding) = + match binding with + | SynBinding (kind = SynBindingKind.Normal; expr = InfixAppOfOpEqualsGreater (lambdaArgs, lambdaBody) as app) -> + Some(app.Range, lambdaArgs.Range, lambdaBody.Range) + | _ -> defaultTraverse binding + } + ) member _.TryRangeOfStringInterpolationContainingPos pos = let visitor = { new SyntaxVisitorBase<_>() with member _.VisitExpr(_, _, defaultTraverse, expr) = match expr with - | SynExpr.InterpolatedString(range = range) when rangeContainsPos range pos -> - Some range - | _ -> defaultTraverse expr } + | SynExpr.InterpolatedString (range = range) when rangeContainsPos range pos -> Some range + | _ -> defaultTraverse expr + } + SyntaxTraversal.Traverse(pos, input, visitor) member _.TryRangeOfExprInYieldOrReturn pos = let visitor = - { new SyntaxVisitorBase<_>() with + { new SyntaxVisitorBase<_>() with member _.VisitExpr(_path, _, defaultTraverse, expr) = match expr with - | SynExpr.YieldOrReturn(_, expr, range) - | SynExpr.YieldOrReturnFrom(_, expr, range) when rangeContainsPos range pos -> - Some expr.Range - | _ -> defaultTraverse expr } + | SynExpr.YieldOrReturn (_, expr, range) + | SynExpr.YieldOrReturnFrom (_, expr, range) when rangeContainsPos range pos -> Some expr.Range + | _ -> defaultTraverse expr + } + SyntaxTraversal.Traverse(pos, input, visitor) member _.TryRangeOfRecordExpressionContainingPos pos = let visitor = - { new SyntaxVisitorBase<_>() with + { new SyntaxVisitorBase<_>() with member _.VisitExpr(_, _, defaultTraverse, expr) = match expr with - | SynExpr.Record(_, _, _, range) when rangeContainsPos range pos -> - Some range - | _ -> defaultTraverse expr } + | SynExpr.Record (_, _, _, range) when rangeContainsPos range pos -> Some range + | _ -> defaultTraverse expr + } + SyntaxTraversal.Traverse(pos, input, visitor) member _.TryRangeOfRefCellDereferenceContainingPos expressionPos = let visitor = - { new SyntaxVisitorBase<_>() with + { new SyntaxVisitorBase<_>() with member _.VisitExpr(_, _, defaultTraverse, expr) = match expr with - | SynExpr.App(_, false, SynExpr.LongIdent(longDotId = SynLongIdent(id = [funcIdent])), expr, _) -> + | SynExpr.App (_, false, SynExpr.LongIdent(longDotId = SynLongIdent(id = [ funcIdent ])), expr, _) -> if funcIdent.idText = "op_Dereference" && rangeContainsPos expr.Range expressionPos then Some funcIdent.idRange else None - | _ -> defaultTraverse expr } + | _ -> defaultTraverse expr + } + SyntaxTraversal.Traverse(expressionPos, input, visitor) member _.TryRangeOfExpressionBeingDereferencedContainingPos expressionPos = let visitor = - { new SyntaxVisitorBase<_>() with + { new SyntaxVisitorBase<_>() with member _.VisitExpr(_, _, defaultTraverse, expr) = match expr with - | SynExpr.App(_, false, SynExpr.LongIdent(longDotId = SynLongIdent(id = [funcIdent])), expr, _) -> + | SynExpr.App (_, false, SynExpr.LongIdent(longDotId = SynLongIdent(id = [ funcIdent ])), expr, _) -> if funcIdent.idText = "op_Dereference" && rangeContainsPos expr.Range expressionPos then Some expr.Range else None - | _ -> defaultTraverse expr } + | _ -> defaultTraverse expr + } + SyntaxTraversal.Traverse(expressionPos, input, visitor) - member _.FindParameterLocations pos = - ParameterLocations.Find(pos, input) + member _.FindParameterLocations pos = ParameterLocations.Find(pos, input) member _.IsPositionContainedInACurriedParameter pos = let visitor = - { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = - defaultTraverse(expr) + { new SyntaxVisitorBase<_>() with + member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = defaultTraverse (expr) - override _.VisitBinding (_path, _, binding) = + override _.VisitBinding(_path, _, binding) = match binding with - | SynBinding(valData=valData; range=range) when rangeContainsPos range pos -> + | SynBinding (valData = valData; range = range) when rangeContainsPos range pos -> let info = valData.SynValInfo.CurriedArgInfos let mutable found = false + for group in info do for arg in group do match arg.Ident with - | Some ident when rangeContainsPos ident.idRange pos -> - found <- true + | Some ident when rangeContainsPos ident.idRange pos -> found <- true | _ -> () + if found then Some range else None - | _ -> - None + | _ -> None } + let result = SyntaxTraversal.Traverse(pos, input, visitor) result.IsSome @@ -424,8 +429,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, { new SyntaxVisitorBase<_>() with member _.VisitExpr(_path, _traverseSynExpr, defaultTraverse, expr) = match expr with - | SynExpr.Typed (_expr, _typeExpr, range) when Position.posEq range.Start pos -> - Some range + | SynExpr.Typed (_expr, _typeExpr, range) when Position.posEq range.Start pos -> Some range | _ -> defaultTraverse expr override _.VisitSimplePats(_path, pats) = @@ -435,408 +439,506 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, let exprFunc pat = match pat with // (s: string) - | SynSimplePat.Typed (_pat, _targetExpr, range) when Position.posEq range.Start pos -> - Some range - | _ -> - None + | SynSimplePat.Typed (_pat, _targetExpr, range) when Position.posEq range.Start pos -> Some range + | _ -> None pats |> List.tryPick exprFunc override _.VisitPat(_path, defaultTraverse, pat) = // (s: string) match pat with - | SynPat.Typed (_pat, _targetType, range) when Position.posEq range.Start pos -> - Some range + | SynPat.Typed (_pat, _targetType, range) when Position.posEq range.Start pos -> Some range | _ -> defaultTraverse pat + override _.VisitBinding(_path, defaultTraverse, binding) = // let x : int = 12 match binding with - | SynBinding(headPat = SynPat.Named (range = patRange); returnInfo = Some (SynBindingReturnInfo(typeName = SynType.LongIdent _))) -> Some patRange + | SynBinding (headPat = SynPat.Named (range = patRange) + returnInfo = Some (SynBindingReturnInfo(typeName = SynType.LongIdent _))) -> Some patRange | _ -> defaultTraverse binding } + + let result = SyntaxTraversal.Traverse(pos, input, visitor) + result.IsSome + + member _.IsBindingALambdaAtPosition pos = + let visitor = + { new SyntaxVisitorBase<_>() with + member _.VisitExpr(_path, _traverseSynExpr, defaultTraverse, expr) = defaultTraverse expr + + override _.VisitBinding(_path, defaultTraverse, binding) = + match binding with + | SynBinding.SynBinding (expr = expr; range = range) when Position.posEq range.Start pos -> + match expr with + | SynExpr.Lambda _ -> Some range + | _ -> None + | _ -> defaultTraverse binding + } + let result = SyntaxTraversal.Traverse(pos, input, visitor) result.IsSome - member _.IsBindingALambdaAtPosition pos = - let visitor = - { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_path, _traverseSynExpr, defaultTraverse, expr) = - defaultTraverse expr - - override _.VisitBinding(_path, defaultTraverse, binding) = - match binding with - | SynBinding.SynBinding(expr=expr; range=range) when Position.posEq range.Start pos -> - match expr with - | SynExpr.Lambda _ -> Some range - | _ -> None - | _ -> defaultTraverse binding } - let result = SyntaxTraversal.Traverse(pos, input, visitor) - result.IsSome - /// Get declared items and the selected item at the specified location member _.GetNavigationItemsImpl() = - DiagnosticsScope.Protect range0 - (fun () -> + DiagnosticsScope.Protect + range0 + (fun () -> match input with - | ParsedInput.ImplFile _ as p -> - Navigation.getNavigation p - | ParsedInput.SigFile _ -> - Navigation.empty) - (fun err -> + | ParsedInput.ImplFile _ as p -> Navigation.getNavigation p + | ParsedInput.SigFile _ -> Navigation.empty) + (fun err -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetNavigationItemsImpl: '%s'" err) Navigation.empty) - + member _.ValidateBreakpointLocationImpl pos = - let isMatchRange m = rangeContainsPos m pos || m.StartLine = pos.Line + let isMatchRange m = + rangeContainsPos m pos || m.StartLine = pos.Line // Process let-binding - let findBreakPoints () = - let checkRange m = [ if isMatchRange m && not m.IsSynthetic then yield m ] - let walkBindSeqPt sp = [ match sp with DebugPointAtBinding.Yes m -> yield! checkRange m | _ -> () ] - let walkForSeqPt sp = [ match sp with DebugPointAtFor.Yes m -> yield! checkRange m | _ -> () ] - let walkInOrToSeqPt sp = [ match sp with DebugPointAtInOrTo.Yes m -> yield! checkRange m | _ -> () ] - let walkWhileSeqPt sp = [ match sp with DebugPointAtWhile.Yes m -> yield! checkRange m | _ -> () ] - let walkTrySeqPt sp = [ match sp with DebugPointAtTry.Yes m -> yield! checkRange m | _ -> () ] - let walkWithSeqPt sp = [ match sp with DebugPointAtWith.Yes m -> yield! checkRange m | _ -> () ] - let walkFinallySeqPt sp = [ match sp with DebugPointAtFinally.Yes m -> yield! checkRange m | _ -> () ] - - let rec walkBind (SynBinding(kind=kind; expr=synExpr; debugPoint=spInfo; range=m)) = - [ yield! walkBindSeqPt spInfo - let extendDebugPointForDo = - match kind with - | SynBindingKind.Do -> not (IsControlFlowExpression synExpr) - | _ -> false - - // This extends the range of the implicit debug point for 'do expr' range to include the 'do' - if extendDebugPointForDo then - yield! checkRange m - - let useImplicitDebugPoint = - match spInfo with - | DebugPointAtBinding.Yes _ -> false - | _-> not extendDebugPointForDo - - yield! walkExpr useImplicitDebugPoint synExpr ] - - and walkExprs exprs = - exprs |> List.collect (walkExpr false) - - and walkBinds exprs = - exprs |> List.collect walkBind - - and walkMatchClauses clauses = - [ for SynMatchClause(whenExpr=whenExprOpt; resultExpr=tgtExpr) in clauses do - match whenExprOpt with - | Some whenExpr -> yield! walkExpr false whenExpr + let findBreakPoints () = + let checkRange m = + [ + if isMatchRange m && not m.IsSynthetic then yield m + ] + + let walkBindSeqPt sp = + [ + match sp with + | DebugPointAtBinding.Yes m -> yield! checkRange m + | _ -> () + ] + + let walkForSeqPt sp = + [ + match sp with + | DebugPointAtFor.Yes m -> yield! checkRange m + | _ -> () + ] + + let walkInOrToSeqPt sp = + [ + match sp with + | DebugPointAtInOrTo.Yes m -> yield! checkRange m + | _ -> () + ] + + let walkWhileSeqPt sp = + [ + match sp with + | DebugPointAtWhile.Yes m -> yield! checkRange m + | _ -> () + ] + + let walkTrySeqPt sp = + [ + match sp with + | DebugPointAtTry.Yes m -> yield! checkRange m + | _ -> () + ] + + let walkWithSeqPt sp = + [ + match sp with + | DebugPointAtWith.Yes m -> yield! checkRange m + | _ -> () + ] + + let walkFinallySeqPt sp = + [ + match sp with + | DebugPointAtFinally.Yes m -> yield! checkRange m | _ -> () - yield! walkExpr true tgtExpr ] + ] + + let rec walkBind (SynBinding (kind = kind; expr = synExpr; debugPoint = spInfo; range = m)) = + [ + yield! walkBindSeqPt spInfo + let extendDebugPointForDo = + match kind with + | SynBindingKind.Do -> not (IsControlFlowExpression synExpr) + | _ -> false + + // This extends the range of the implicit debug point for 'do expr' range to include the 'do' + if extendDebugPointForDo then yield! checkRange m + + let useImplicitDebugPoint = + match spInfo with + | DebugPointAtBinding.Yes _ -> false + | _ -> not extendDebugPointForDo + + yield! walkExpr useImplicitDebugPoint synExpr + ] + + and walkExprs exprs = exprs |> List.collect (walkExpr false) + + and walkBinds exprs = exprs |> List.collect walkBind + + and walkMatchClauses clauses = + [ + for SynMatchClause (whenExpr = whenExprOpt; resultExpr = tgtExpr) in clauses do + match whenExprOpt with + | Some whenExpr -> yield! walkExpr false whenExpr + | _ -> () + + yield! walkExpr true tgtExpr + ] and walkExprOpt (spImplicit: bool) eOpt = - [ match eOpt with Some e -> yield! walkExpr spImplicit e | _ -> () ] - + [ + match eOpt with + | Some e -> yield! walkExpr spImplicit e + | _ -> () + ] + // Determine the breakpoint locations for an expression. spImplicit indicates we always // emit a breakpoint location for the expression unless it is a syntactic control flow construct and walkExpr spImplicit expr = - let m = expr.Range - [ if isMatchRange m then - if spImplicit && not (IsControlFlowExpression expr) then - yield! checkRange m - - match expr with - | SynExpr.ArbitraryAfterError _ - | SynExpr.LongIdent _ - | SynExpr.LibraryOnlyILAssembly _ - | SynExpr.LibraryOnlyStaticOptimization _ - | SynExpr.Null _ - | SynExpr.Ident _ - | SynExpr.ImplicitZero _ - | SynExpr.Const _ - | SynExpr.Dynamic _ -> - () - - | SynExpr.Quote (_, _, e, _, _) - | SynExpr.TypeTest (e, _, _) - | SynExpr.Upcast (e, _, _) - | SynExpr.AddressOf (_, e, _, _) - | SynExpr.ComputationExpr (_, e, _) - | SynExpr.ArrayOrListComputed (_, e, _) - | SynExpr.Typed (e, _, _) - | SynExpr.FromParseError (e, _) - | SynExpr.DiscardAfterMissingQualificationAfterDot (e, _) - | SynExpr.Do (e, _) - | SynExpr.Assert (e, _) - | SynExpr.Fixed (e, _) - | SynExpr.DotGet (e, _, _, _) - | SynExpr.LongIdentSet (_, e, _) - | SynExpr.New (_, _, e, _) - | SynExpr.TypeApp (e, _, _, _, _, _, _) - | SynExpr.LibraryOnlyUnionCaseFieldGet (e, _, _, _) - | SynExpr.Downcast (e, _, _) - | SynExpr.InferredUpcast (e, _) - | SynExpr.InferredDowncast (e, _) - | SynExpr.Lazy (e, _) - | SynExpr.TraitCall (_, _, e, _) - | SynExpr.Paren (e, _, _, _) -> - yield! walkExpr false e - - | SynExpr.InterpolatedString (parts, _, _) -> - yield! walkExprs [ for part in parts do - match part with + let m = expr.Range + + [ + if isMatchRange m then + if spImplicit && not (IsControlFlowExpression expr) then + yield! checkRange m + + match expr with + | SynExpr.ArbitraryAfterError _ + | SynExpr.LongIdent _ + | SynExpr.LibraryOnlyILAssembly _ + | SynExpr.LibraryOnlyStaticOptimization _ + | SynExpr.Null _ + | SynExpr.Ident _ + | SynExpr.ImplicitZero _ + | SynExpr.Const _ + | SynExpr.Dynamic _ -> () + + | SynExpr.Quote (_, _, e, _, _) + | SynExpr.TypeTest (e, _, _) + | SynExpr.Upcast (e, _, _) + | SynExpr.AddressOf (_, e, _, _) + | SynExpr.ComputationExpr (_, e, _) + | SynExpr.ArrayOrListComputed (_, e, _) + | SynExpr.Typed (e, _, _) + | SynExpr.FromParseError (e, _) + | SynExpr.DiscardAfterMissingQualificationAfterDot (e, _) + | SynExpr.Do (e, _) + | SynExpr.Assert (e, _) + | SynExpr.Fixed (e, _) + | SynExpr.DotGet (e, _, _, _) + | SynExpr.LongIdentSet (_, e, _) + | SynExpr.New (_, _, e, _) + | SynExpr.TypeApp (e, _, _, _, _, _, _) + | SynExpr.LibraryOnlyUnionCaseFieldGet (e, _, _, _) + | SynExpr.Downcast (e, _, _) + | SynExpr.InferredUpcast (e, _) + | SynExpr.InferredDowncast (e, _) + | SynExpr.Lazy (e, _) + | SynExpr.TraitCall (_, _, e, _) + | SynExpr.Paren (e, _, _, _) -> yield! walkExpr false e + + | SynExpr.InterpolatedString (parts, _, _) -> + yield! + walkExprs + [ + for part in parts do + match part with | SynInterpolatedStringPart.String _ -> () - | SynInterpolatedStringPart.FillExpr (fillExpr, _) -> yield fillExpr ] - - | SynExpr.DebugPoint (DebugPointAtLeafExpr.Yes m, isControlFlow, innerExpr) -> - yield! checkRange m - yield! walkExpr isControlFlow innerExpr - - | SynExpr.YieldOrReturn (_, e, m) -> - yield! checkRange m - yield! walkExpr false e - - | SynExpr.YieldOrReturnFrom (_, e, _) - | SynExpr.DoBang (e, _) -> - yield! checkRange e.Range - yield! walkExpr false e - - | SynOrElse (e1, e2) - | SynAndAlso (e1, e2) -> - yield! walkExpr true e1 - yield! walkExpr true e2 - - // Always allow breakpoints on input and stages of x |> f1 |> f2 pipelines - | SynPipeRight _ -> - let rec loop e = - seq { - match e with - | SynPipeRight (xExpr, fExpr) -> - yield! checkRange fExpr.Range - yield! walkExpr false fExpr - yield! loop xExpr - | SynPipeRight2 (xExpr1, xExpr2, fExpr) -> - yield! checkRange fExpr.Range - yield! checkRange xExpr1.Range - yield! checkRange xExpr2.Range - yield! walkExpr false xExpr1 - yield! walkExpr false xExpr2 - yield! walkExpr false fExpr - | SynPipeRight3 (xExpr1, xExpr2, xExpr3, fExpr) -> - yield! checkRange fExpr.Range - yield! checkRange xExpr1.Range - yield! checkRange xExpr2.Range - yield! checkRange xExpr3.Range - yield! walkExpr false xExpr1 - yield! walkExpr false xExpr2 - yield! walkExpr false xExpr3 - yield! walkExpr false fExpr - | _ -> - yield! checkRange e.Range - yield! walkExpr false e - } - yield! loop expr - | SynExpr.NamedIndexedPropertySet (_, e1, e2, _) - | SynExpr.DotSet (e1, _, e2, _) - | SynExpr.Set (e1, e2, _) - | SynExpr.LibraryOnlyUnionCaseFieldSet (e1, _, _, e2, _) - | SynExpr.App (_, _, e1, e2, _) -> - yield! walkExpr false e1 - yield! walkExpr false e2 - - | SynExpr.ArrayOrList (_, exprs, _) - | SynExpr.Tuple (_, exprs, _, _) -> - yield! walkExprs exprs - - | SynExpr.Record (_, copyExprOpt, fs, _) -> - match copyExprOpt with - | Some (e, _) -> yield! walkExpr true e - | None -> () - yield! walkExprs (fs |> List.choose (fun (SynExprRecordField(expr=e)) -> e)) - - | SynExpr.AnonRecd (_isStruct, copyExprOpt, fs, _) -> - match copyExprOpt with - | Some (e, _) -> yield! walkExpr true e - | None -> () - yield! walkExprs (fs |> List.map (fun (_, _, e) -> e)) - - | SynExpr.ObjExpr (argOptions=args; bindings=bs; members=ms; extraImpls=is) -> - let bs = unionBindingAndMembers bs ms - match args with - | None -> () - | Some (arg, _) -> yield! walkExpr false arg - yield! walkBinds bs - for SynInterfaceImpl(bindings=bs) in is do yield! walkBinds bs - - | SynExpr.While (spWhile, e1, e2, _) -> - yield! walkWhileSeqPt spWhile - yield! walkExpr false e1 - yield! walkExpr true e2 - - | SynExpr.JoinIn (e1, _range, e2, _range2) -> - yield! walkExpr false e1 - yield! walkExpr false e2 - - | SynExpr.For (forDebugPoint=spFor; toDebugPoint=spTo; identBody=e1; toBody=e2; doBody=e3) -> - yield! walkForSeqPt spFor - yield! walkInOrToSeqPt spTo - yield! walkExpr false e1 - yield! walkExpr true e2 - yield! walkExpr true e3 - - | SynExpr.ForEach (spFor, spIn, _, _, _, e1, e2, _) -> - yield! walkForSeqPt spFor - yield! walkInOrToSeqPt spIn - yield! walkBindSeqPt (DebugPointAtBinding.Yes e1.Range) - yield! walkExpr false e1 - yield! walkExpr true e2 - - | SynExpr.MatchLambda (_isExnMatch, _argm, cl, spBind, _wholem) -> - yield! walkBindSeqPt spBind - for SynMatchClause(whenExpr = whenExpr; resultExpr = resultExpr) in cl do - yield! walkExprOpt true whenExpr - yield! walkExpr true resultExpr - - | SynExpr.Lambda (body = bodyExpr) -> - yield! walkExpr true bodyExpr - - | SynExpr.Match (matchDebugPoint = spBind; expr = inpExpr; clauses=cl) -> - yield! walkBindSeqPt spBind - yield! walkExpr false inpExpr - for SynMatchClause(whenExpr = whenExpr; resultExpr = tgtExpr) in cl do - yield! walkExprOpt true whenExpr - yield! walkExpr true tgtExpr - - | SynExpr.LetOrUse (bindings=binds; body=bodyExpr) -> - yield! walkBinds binds - yield! walkExpr true bodyExpr - - | SynExpr.TryWith (tryExpr=tryExpr; withCases=cl; tryDebugPoint=spTry; withDebugPoint=spWith) -> - yield! walkTrySeqPt spTry - yield! walkWithSeqPt spWith - yield! walkExpr true tryExpr - yield! walkMatchClauses cl - - | SynExpr.TryFinally (tryExpr=e1; finallyExpr=e2; tryDebugPoint=spTry; finallyDebugPoint=spFinally) -> - yield! walkExpr true e1 - yield! walkExpr true e2 - yield! walkTrySeqPt spTry - yield! walkFinallySeqPt spFinally - - | SynExpr.SequentialOrImplicitYield (spSeq, e1, e2, _, _) - | SynExpr.Sequential (spSeq, _, e1, e2, _) -> - let implicit1 = match spSeq with DebugPointAtSequential.SuppressExpr | DebugPointAtSequential.SuppressBoth -> false | _ -> true - yield! walkExpr implicit1 e1 - let implicit2 = match spSeq with DebugPointAtSequential.SuppressStmt | DebugPointAtSequential.SuppressBoth -> false | _ -> true - yield! walkExpr implicit2 e2 - - | SynExpr.IfThenElse (ifExpr=e1; thenExpr=e2; elseExpr=e3opt; spIfToThen=spBind) -> - yield! walkBindSeqPt spBind - yield! walkExpr false e1 - yield! walkExpr true e2 - yield! walkExprOpt true e3opt - - | SynExpr.DotIndexedGet (e1, es, _, _) -> - yield! walkExpr false e1 - yield! walkExpr false es - - | SynExpr.IndexRange (expr1, _, expr2, _, _, _) -> - match expr1 with Some e -> yield! walkExpr false e | None -> () - match expr2 with Some e -> yield! walkExpr false e | None -> () - - | SynExpr.IndexFromEnd (e, _) -> - yield! walkExpr false e - - | SynExpr.DotIndexedSet (e1, es, e2, _, _, _) -> - yield! walkExpr false e1 - yield! walkExpr false es - yield! walkExpr false e2 - - | SynExpr.DotNamedIndexedPropertySet (e1, _, e2, e3, _) -> - yield! walkExpr false e1 - yield! walkExpr false e2 - yield! walkExpr false e3 - - | SynExpr.LetOrUseBang (spBind, _, _, _, rhsExpr, andBangs, bodyExpr, _, _) -> - yield! walkBindSeqPt spBind - yield! walkExpr true rhsExpr - for SynExprAndBang(debugPoint = andBangSpBind; body = eAndBang) in andBangs do - yield! walkBindSeqPt andBangSpBind - yield! walkExpr true eAndBang - yield! walkExpr true bodyExpr - - | SynExpr.MatchBang (matchDebugPoint = spBind; expr = inpExpr; clauses = clauses) -> - yield! walkBindSeqPt spBind - yield! walkExpr false inpExpr - for SynMatchClause(whenExpr = whenExpr; resultExpr = resExpr) in clauses do - yield! walkExprOpt true whenExpr - yield! walkExpr true resExpr ] - + | SynInterpolatedStringPart.FillExpr (fillExpr, _) -> yield fillExpr + ] + + | SynExpr.DebugPoint (DebugPointAtLeafExpr.Yes m, isControlFlow, innerExpr) -> + yield! checkRange m + yield! walkExpr isControlFlow innerExpr + + | SynExpr.YieldOrReturn (_, e, m) -> + yield! checkRange m + yield! walkExpr false e + + | SynExpr.YieldOrReturnFrom (_, e, _) + | SynExpr.DoBang (e, _) -> + yield! checkRange e.Range + yield! walkExpr false e + + | SynOrElse (e1, e2) + | SynAndAlso (e1, e2) -> + yield! walkExpr true e1 + yield! walkExpr true e2 + + // Always allow breakpoints on input and stages of x |> f1 |> f2 pipelines + | SynPipeRight _ -> + let rec loop e = + seq { + match e with + | SynPipeRight (xExpr, fExpr) -> + yield! checkRange fExpr.Range + yield! walkExpr false fExpr + yield! loop xExpr + | SynPipeRight2 (xExpr1, xExpr2, fExpr) -> + yield! checkRange fExpr.Range + yield! checkRange xExpr1.Range + yield! checkRange xExpr2.Range + yield! walkExpr false xExpr1 + yield! walkExpr false xExpr2 + yield! walkExpr false fExpr + | SynPipeRight3 (xExpr1, xExpr2, xExpr3, fExpr) -> + yield! checkRange fExpr.Range + yield! checkRange xExpr1.Range + yield! checkRange xExpr2.Range + yield! checkRange xExpr3.Range + yield! walkExpr false xExpr1 + yield! walkExpr false xExpr2 + yield! walkExpr false xExpr3 + yield! walkExpr false fExpr + | _ -> + yield! checkRange e.Range + yield! walkExpr false e + } + + yield! loop expr + | SynExpr.NamedIndexedPropertySet (_, e1, e2, _) + | SynExpr.DotSet (e1, _, e2, _) + | SynExpr.Set (e1, e2, _) + | SynExpr.LibraryOnlyUnionCaseFieldSet (e1, _, _, e2, _) + | SynExpr.App (_, _, e1, e2, _) -> + yield! walkExpr false e1 + yield! walkExpr false e2 + + | SynExpr.ArrayOrList (_, exprs, _) + | SynExpr.Tuple (_, exprs, _, _) -> yield! walkExprs exprs + + | SynExpr.Record (_, copyExprOpt, fs, _) -> + match copyExprOpt with + | Some (e, _) -> yield! walkExpr true e + | None -> () + + yield! walkExprs (fs |> List.choose (fun (SynExprRecordField (expr = e)) -> e)) + + | SynExpr.AnonRecd (_isStruct, copyExprOpt, fs, _) -> + match copyExprOpt with + | Some (e, _) -> yield! walkExpr true e + | None -> () + + yield! walkExprs (fs |> List.map (fun (_, _, e) -> e)) + + | SynExpr.ObjExpr (argOptions = args; bindings = bs; members = ms; extraImpls = is) -> + let bs = unionBindingAndMembers bs ms + + match args with + | None -> () + | Some (arg, _) -> yield! walkExpr false arg + + yield! walkBinds bs + + for SynInterfaceImpl (bindings = bs) in is do + yield! walkBinds bs + + | SynExpr.While (spWhile, e1, e2, _) -> + yield! walkWhileSeqPt spWhile + yield! walkExpr false e1 + yield! walkExpr true e2 + + | SynExpr.JoinIn (e1, _range, e2, _range2) -> + yield! walkExpr false e1 + yield! walkExpr false e2 + + | SynExpr.For (forDebugPoint = spFor; toDebugPoint = spTo; identBody = e1; toBody = e2; doBody = e3) -> + yield! walkForSeqPt spFor + yield! walkInOrToSeqPt spTo + yield! walkExpr false e1 + yield! walkExpr true e2 + yield! walkExpr true e3 + + | SynExpr.ForEach (spFor, spIn, _, _, _, e1, e2, _) -> + yield! walkForSeqPt spFor + yield! walkInOrToSeqPt spIn + yield! walkBindSeqPt (DebugPointAtBinding.Yes e1.Range) + yield! walkExpr false e1 + yield! walkExpr true e2 + + | SynExpr.MatchLambda (_isExnMatch, _argm, cl, spBind, _wholem) -> + yield! walkBindSeqPt spBind + + for SynMatchClause (whenExpr = whenExpr; resultExpr = resultExpr) in cl do + yield! walkExprOpt true whenExpr + yield! walkExpr true resultExpr + + | SynExpr.Lambda (body = bodyExpr) -> yield! walkExpr true bodyExpr + + | SynExpr.Match (matchDebugPoint = spBind; expr = inpExpr; clauses = cl) -> + yield! walkBindSeqPt spBind + yield! walkExpr false inpExpr + + for SynMatchClause (whenExpr = whenExpr; resultExpr = tgtExpr) in cl do + yield! walkExprOpt true whenExpr + yield! walkExpr true tgtExpr + + | SynExpr.LetOrUse (bindings = binds; body = bodyExpr) -> + yield! walkBinds binds + yield! walkExpr true bodyExpr + + | SynExpr.TryWith (tryExpr = tryExpr; withCases = cl; tryDebugPoint = spTry; withDebugPoint = spWith) -> + yield! walkTrySeqPt spTry + yield! walkWithSeqPt spWith + yield! walkExpr true tryExpr + yield! walkMatchClauses cl + + | SynExpr.TryFinally (tryExpr = e1; finallyExpr = e2; tryDebugPoint = spTry; finallyDebugPoint = spFinally) -> + yield! walkExpr true e1 + yield! walkExpr true e2 + yield! walkTrySeqPt spTry + yield! walkFinallySeqPt spFinally + + | SynExpr.SequentialOrImplicitYield (spSeq, e1, e2, _, _) + | SynExpr.Sequential (spSeq, _, e1, e2, _) -> + let implicit1 = + match spSeq with + | DebugPointAtSequential.SuppressExpr + | DebugPointAtSequential.SuppressBoth -> false + | _ -> true + + yield! walkExpr implicit1 e1 + + let implicit2 = + match spSeq with + | DebugPointAtSequential.SuppressStmt + | DebugPointAtSequential.SuppressBoth -> false + | _ -> true + + yield! walkExpr implicit2 e2 + + | SynExpr.IfThenElse (ifExpr = e1; thenExpr = e2; elseExpr = e3opt; spIfToThen = spBind) -> + yield! walkBindSeqPt spBind + yield! walkExpr false e1 + yield! walkExpr true e2 + yield! walkExprOpt true e3opt + + | SynExpr.DotIndexedGet (e1, es, _, _) -> + yield! walkExpr false e1 + yield! walkExpr false es + + | SynExpr.IndexRange (expr1, _, expr2, _, _, _) -> + match expr1 with + | Some e -> yield! walkExpr false e + | None -> () + + match expr2 with + | Some e -> yield! walkExpr false e + | None -> () + + | SynExpr.IndexFromEnd (e, _) -> yield! walkExpr false e + + | SynExpr.DotIndexedSet (e1, es, e2, _, _, _) -> + yield! walkExpr false e1 + yield! walkExpr false es + yield! walkExpr false e2 + + | SynExpr.DotNamedIndexedPropertySet (e1, _, e2, e3, _) -> + yield! walkExpr false e1 + yield! walkExpr false e2 + yield! walkExpr false e3 + + | SynExpr.LetOrUseBang (spBind, _, _, _, rhsExpr, andBangs, bodyExpr, _, _) -> + yield! walkBindSeqPt spBind + yield! walkExpr true rhsExpr + + for SynExprAndBang (debugPoint = andBangSpBind; body = eAndBang) in andBangs do + yield! walkBindSeqPt andBangSpBind + yield! walkExpr true eAndBang + + yield! walkExpr true bodyExpr + + | SynExpr.MatchBang (matchDebugPoint = spBind; expr = inpExpr; clauses = clauses) -> + yield! walkBindSeqPt spBind + yield! walkExpr false inpExpr + + for SynMatchClause (whenExpr = whenExpr; resultExpr = resExpr) in clauses do + yield! walkExprOpt true whenExpr + yield! walkExpr true resExpr + ] + // Process a class declaration or F# type declaration - let rec walkTycon (SynTypeDefn(typeRepr=repr; members=membDefns; implicitConstructor=implicitCtor; range=m)) = - if not (isMatchRange m) then [] else - [ for memb in membDefns do yield! walkMember memb - match repr with - | SynTypeDefnRepr.ObjectModel(_, membDefns, _) -> - for memb in membDefns do yield! walkMember memb - | _ -> () - for memb in membDefns do yield! walkMember memb - for memb in Option.toList implicitCtor do yield! walkMember memb] - - // Returns class-members for the right dropdown + let rec walkTycon (SynTypeDefn (typeRepr = repr; members = membDefns; implicitConstructor = implicitCtor; range = m)) = + if not (isMatchRange m) then + [] + else + [ + for memb in membDefns do + yield! walkMember memb + match repr with + | SynTypeDefnRepr.ObjectModel (_, membDefns, _) -> + for memb in membDefns do + yield! walkMember memb + | _ -> () + for memb in membDefns do + yield! walkMember memb + for memb in Option.toList implicitCtor do + yield! walkMember memb + ] + + // Returns class-members for the right dropdown and walkMember memb = - if not (isMatchRange memb.Range) then [] else - [ match memb with - | SynMemberDefn.LetBindings(binds, _, _, _) -> yield! walkBinds binds - | SynMemberDefn.AutoProperty(synExpr=synExpr) -> yield! walkExpr true synExpr - | SynMemberDefn.ImplicitCtor(_, _, _, _, _, m) -> yield! checkRange m - | SynMemberDefn.Member(bind, _) -> yield! walkBind bind - | SynMemberDefn.Interface(members=Some membs) -> for m in membs do yield! walkMember m - | SynMemberDefn.Inherit(_, _, m) -> - // can break on the "inherit" clause - yield! checkRange m - | SynMemberDefn.ImplicitInherit(_, arg, _, m) -> - // can break on the "inherit" clause - yield! checkRange m - yield! walkExpr true arg - | _ -> () ] + if not (isMatchRange memb.Range) then + [] + else + [ + match memb with + | SynMemberDefn.LetBindings (binds, _, _, _) -> yield! walkBinds binds + | SynMemberDefn.AutoProperty (synExpr = synExpr) -> yield! walkExpr true synExpr + | SynMemberDefn.ImplicitCtor (_, _, _, _, _, m) -> yield! checkRange m + | SynMemberDefn.Member (bind, _) -> yield! walkBind bind + | SynMemberDefn.Interface(members = Some membs) -> + for m in membs do + yield! walkMember m + | SynMemberDefn.Inherit (_, _, m) -> + // can break on the "inherit" clause + yield! checkRange m + | SynMemberDefn.ImplicitInherit (_, arg, _, m) -> + // can break on the "inherit" clause + yield! checkRange m + yield! walkExpr true arg + | _ -> () + ] // Process declarations nested in a module that should be displayed in the left dropdown - // (such as type declarations, nested modules etc.) - let rec walkDecl decl = - [ match decl with - | SynModuleDecl.Let(_, binds, m) when isMatchRange m -> - yield! walkBinds binds - | SynModuleDecl.Expr(expr, m) when isMatchRange m -> - yield! walkExpr true expr - | SynModuleDecl.ModuleAbbrev _ -> () - | SynModuleDecl.NestedModule(decls=decls; range=m) when isMatchRange m -> - for d in decls do yield! walkDecl d - | SynModuleDecl.Types(tydefs, m) when isMatchRange m -> - for d in tydefs do yield! walkTycon d - | SynModuleDecl.Exception(SynExceptionDefn(SynExceptionDefnRepr _, _, membDefns, _), m) - when isMatchRange m -> - for m in membDefns do yield! walkMember m - | _ -> () ] - - // Collect all the items in a module - let walkModule (SynModuleOrNamespace(decls = decls; range = m)) = - if isMatchRange m then - List.collect walkDecl decls - else - [] - - /// Get information for implementation file + // (such as type declarations, nested modules etc.) + let rec walkDecl decl = + [ + match decl with + | SynModuleDecl.Let (_, binds, m) when isMatchRange m -> yield! walkBinds binds + | SynModuleDecl.Expr (expr, m) when isMatchRange m -> yield! walkExpr true expr + | SynModuleDecl.ModuleAbbrev _ -> () + | SynModuleDecl.NestedModule (decls = decls; range = m) when isMatchRange m -> + for d in decls do + yield! walkDecl d + | SynModuleDecl.Types (tydefs, m) when isMatchRange m -> + for d in tydefs do + yield! walkTycon d + | SynModuleDecl.Exception (SynExceptionDefn (SynExceptionDefnRepr _, _, membDefns, _), m) when isMatchRange m -> + for m in membDefns do + yield! walkMember m + | _ -> () + ] + + // Collect all the items in a module + let walkModule (SynModuleOrNamespace (decls = decls; range = m)) = + if isMatchRange m then List.collect walkDecl decls else [] + + /// Get information for implementation file let walkImplFile (modules: SynModuleOrNamespace list) = List.collect walkModule modules - + match input with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = modules)) -> walkImplFile modules + | ParsedInput.ImplFile (ParsedImplFileInput (modules = modules)) -> walkImplFile modules | _ -> [] - - DiagnosticsScope.Protect range0 - (fun () -> - let locations = findBreakPoints() - + + DiagnosticsScope.Protect + range0 + (fun () -> + let locations = findBreakPoints () + if pos.Column = 0 then // we have a breakpoint that was set with mouse at line start - match locations |> List.filter (fun m -> m.StartLine = m.EndLine && pos.Line = m.StartLine) with + match locations + |> List.filter (fun m -> m.StartLine = m.EndLine && pos.Line = m.StartLine) + with | [] -> match locations |> List.filter (fun m -> rangeContainsPos m pos) with | [] -> @@ -852,16 +954,16 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | [] -> Seq.tryHead locations | locationsAfterPos -> Seq.tryHead locationsAfterPos | coveringLocations -> Seq.tryLast coveringLocations) - (fun msg -> + (fun msg -> Trace.TraceInformation(sprintf "FCS: recovering from error in ValidateBreakpointLocationImpl: '%s'" msg) None) - + /// When these files appear or disappear the configuration for the current project is invalidated. member _.DependencyFiles = dependencyFiles member _.FileName = input.FileName - - // Get items for the navigation drop down bar + + // Get items for the navigation drop down bar member scope.GetNavigationItems() = // This does not need to be run on the background thread scope.GetNavigationItemsImpl() @@ -869,4 +971,3 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, member scope.ValidateBreakpointLocation pos = // This does not need to be run on the background thread scope.ValidateBreakpointLocationImpl pos - diff --git a/src/Compiler/Service/FSharpSource.fs b/src/Compiler/Service/FSharpSource.fs index 1f1d12373a93..b7f13801c985 100644 --- a/src/Compiler/Service/FSharpSource.fs +++ b/src/Compiler/Service/FSharpSource.fs @@ -24,9 +24,9 @@ type TextContainer = [] type FSharpSource internal () = - abstract FilePath : string + abstract FilePath: string - abstract TimeStamp : DateTime + abstract TimeStamp: DateTime abstract GetTextContainer: unit -> TextContainer @@ -37,8 +37,7 @@ type private FSharpSourceMemoryMappedFile(filePath: string, timeStamp: DateTime, override _.TimeStamp = timeStamp - override _.GetTextContainer() = - openStream () |> TextContainer.Stream + override _.GetTextContainer() = openStream () |> TextContainer.Stream type private FSharpSourceByteArray(filePath: string, timeStamp: DateTime, bytes: byte[]) = inherit FSharpSource() @@ -57,18 +56,17 @@ type private FSharpSourceFromFile(filePath: string) = override _.TimeStamp = FileSystem.GetLastWriteTimeShim(filePath) - override _.GetTextContainer() = - TextContainer.OnDisk + override _.GetTextContainer() = TextContainer.OnDisk type private FSharpSourceCustom(filePath: string, getTimeStamp, getSourceText) = inherit FSharpSource() override _.FilePath = filePath - override _.TimeStamp = getTimeStamp() + override _.TimeStamp = getTimeStamp () override _.GetTextContainer() = - TextContainer.SourceText(getSourceText()) + TextContainer.SourceText(getSourceText ()) type FSharpSource with @@ -84,9 +82,14 @@ type FSharpSource with // We want to use mmaped documents only when // not running on mono, since its MemoryMappedFile implementation throws when "mapName" is not provided (is null), (see: https://github.com/mono/mono/issues/10245) if runningOnMono then - let bytes = FileSystem.OpenFileForReadShim(filePath, useMemoryMappedFile = false).ReadAllBytes() + let bytes = + FileSystem + .OpenFileForReadShim(filePath, useMemoryMappedFile = false) + .ReadAllBytes() + FSharpSourceByteArray(filePath, timeStamp, bytes) :> FSharpSource else - let openStream = fun () -> - FileSystem.OpenFileForReadShim(filePath, useMemoryMappedFile = true, shouldShadowCopy = true) - FSharpSourceMemoryMappedFile(filePath, timeStamp, openStream) :> FSharpSource \ No newline at end of file + let openStream = + fun () -> FileSystem.OpenFileForReadShim(filePath, useMemoryMappedFile = true, shouldShadowCopy = true) + + FSharpSourceMemoryMappedFile(filePath, timeStamp, openStream) :> FSharpSource diff --git a/src/Compiler/Service/ItemKey.fs b/src/Compiler/Service/ItemKey.fs index 15b56d8287b9..2854da14a25d 100644 --- a/src/Compiler/Service/ItemKey.fs +++ b/src/Compiler/Service/ItemKey.fs @@ -98,7 +98,8 @@ type ItemKeyStore(mmf: MemoryMappedFile, length) = let rangeBuffer = Array.zeroCreate sizeof let mutable isDisposed = false - let checkDispose() = + + let checkDispose () = if isDisposed then raise (ObjectDisposedException("ItemKeyStore")) @@ -108,13 +109,19 @@ type ItemKeyStore(mmf: MemoryMappedFile, length) = member _.ReadKeyString(reader: byref) = let size = reader.ReadInt32() - let keyString = ReadOnlySpan(reader.CurrentPointer |> NativePtr.toVoidPtr, size) + + let keyString = + ReadOnlySpan(reader.CurrentPointer |> NativePtr.toVoidPtr, size) + reader.Offset <- reader.Offset + size keyString member this.ReadFirstKeyString() = use view = mmf.CreateViewAccessor(0L, length) - let mutable reader = BlobReader(view.SafeMemoryMappedViewHandle.DangerousGetHandle() |> NativePtr.ofNativeInt, int length) + + let mutable reader = + BlobReader(view.SafeMemoryMappedViewHandle.DangerousGetHandle() |> NativePtr.ofNativeInt, int length) + this.ReadRange &reader |> ignore let bytes = (this.ReadKeyString &reader).ToArray() ReadOnlySpan.op_Implicit bytes @@ -124,23 +131,26 @@ type ItemKeyStore(mmf: MemoryMappedFile, length) = let builder = ItemKeyStoreBuilder() builder.Write(range0, item) + match builder.TryBuildAndReset() with | None -> Seq.empty - | Some(singleStore : ItemKeyStore) -> + | Some (singleStore: ItemKeyStore) -> let keyString1 = singleStore.ReadFirstKeyString() (singleStore :> IDisposable).Dispose() let results = ResizeArray() use view = mmf.CreateViewAccessor(0L, length) - let mutable reader = BlobReader(view.SafeMemoryMappedViewHandle.DangerousGetHandle() |> NativePtr.ofNativeInt, int length) + + let mutable reader = + BlobReader(view.SafeMemoryMappedViewHandle.DangerousGetHandle() |> NativePtr.ofNativeInt, int length) reader.Offset <- 0 + while reader.Offset < reader.Length do let m = this.ReadRange &reader let keyString2 = this.ReadKeyString &reader - if keyString1.SequenceEqual keyString2 then - results.Add m + if keyString1.SequenceEqual keyString2 then results.Add m results :> range seq @@ -154,20 +164,15 @@ and [] ItemKeyStoreBuilder() = let b = BlobBuilder() - let writeChar (c: char) = - b.WriteUInt16(uint16 c) + let writeChar (c: char) = b.WriteUInt16(uint16 c) - let writeUInt16 (i: uint16) = - b.WriteUInt16 i + let writeUInt16 (i: uint16) = b.WriteUInt16 i - let writeInt32 (i: int) = - b.WriteInt32 i + let writeInt32 (i: int) = b.WriteInt32 i - let writeInt64 (i: int64) = - b.WriteInt64 i + let writeInt64 (i: int64) = b.WriteInt64 i - let writeString (str: string) = - b.WriteUTF16 str + let writeString (str: string) = b.WriteUTF16 str let writeRange (m: range) = let mutable m = m @@ -177,8 +182,7 @@ and [] ItemKeyStoreBuilder() = let writeEntityRef (eref: EntityRef) = writeString ItemKeyTags.entityRef writeString eref.CompiledName - eref.CompilationPath.MangledPath - |> List.iter (fun str -> writeString str) + eref.CompilationPath.MangledPath |> List.iter (fun str -> writeString str) let rec writeILType (ilTy: ILType) = match ilTy with @@ -186,13 +190,12 @@ and [] ItemKeyStoreBuilder() = writeString "!" writeUInt16 n - | ILType.Modified (_, _, ty2) -> - writeILType ty2 + | ILType.Modified (_, _, ty2) -> writeILType ty2 | ILType.Array (ILArrayShape s, ty) -> writeILType ty writeString "[" - writeInt32 (s.Length-1) + writeInt32 (s.Length - 1) writeString "]" | ILType.Value tr @@ -201,11 +204,11 @@ and [] ItemKeyStoreBuilder() = |> List.iter (fun x -> writeString x writeChar '.') + writeChar '.' writeString tr.TypeRef.Name - | ILType.Void -> - writeString "void" + | ILType.Void -> writeString "void" | ILType.Ptr ty -> writeString "ptr<" @@ -218,18 +221,14 @@ and [] ItemKeyStoreBuilder() = writeChar '>' | ILType.FunctionPointer mref -> - mref.ArgTypes - |> List.iter (fun x -> - writeILType x) + mref.ArgTypes |> List.iter (fun x -> writeILType x) writeILType mref.ReturnType let rec writeType isStandalone (ty: TType) = match stripTyparEqns ty with - | TType_forall (_, ty) -> - writeType false ty + | TType_forall (_, ty) -> writeType false ty - | TType_app (tcref, _, _) -> - writeEntityRef tcref + | TType_app (tcref, _, _) -> writeEntityRef tcref | TType_tuple (_, tinst) -> writeString ItemKeyTags.typeTuple @@ -250,12 +249,11 @@ and [] ItemKeyStoreBuilder() = writeString ItemKeyTags.typeMeasure writeMeasure isStandalone ms - | TType_var (tp, _) -> - writeTypar isStandalone tp + | TType_var (tp, _) -> writeTypar isStandalone tp | TType_ucase (uc, _) -> match uc with - | UnionCaseRef.UnionCaseRef(tcref, nm) -> + | UnionCaseRef.UnionCaseRef (tcref, nm) -> writeString ItemKeyTags.typeUnionCase writeEntityRef tcref writeString nm @@ -268,15 +266,12 @@ and [] ItemKeyStoreBuilder() = | Measure.Con tcref -> writeString ItemKeyTags.typeMeasureCon writeEntityRef tcref - | _ -> - () + | _ -> () and writeTypar (isStandalone: bool) (typar: Typar) = match typar.Solution with | Some ty -> writeType isStandalone ty - | _ -> - if isStandalone then - writeInt64 typar.Stamp + | _ -> if isStandalone then writeInt64 typar.Stamp let writeValRef (vref: ValRef) = match vref.MemberInfo with @@ -291,11 +286,12 @@ and [] ItemKeyStoreBuilder() = writeString vref.LogicalName writeString ItemKeyTags.parameters writeType false vref.Type + match vref.DeclaringEntity with | ParentNone -> writeChar '%' | Parent eref -> writeEntityRef eref - member _.Write (m: range, item: Item) = + member _.Write(m: range, item: Item) = writeRange m let fixup = b.ReserveBytes 4 |> BlobWriter @@ -307,28 +303,25 @@ and [] ItemKeyStoreBuilder() = if vref.IsPropertyGetterMethod || vref.IsPropertySetterMethod then writeString ItemKeyTags.itemProperty writeString vref.PropertyName + match vref.DeclaringEntity with - | ParentRef.Parent parent -> - writeEntityRef parent - | _ -> - () + | ParentRef.Parent parent -> writeEntityRef parent + | _ -> () else writeValRef vref - | Item.UnionCase(info, _) -> + | Item.UnionCase (info, _) -> writeString ItemKeyTags.typeUnionCase writeEntityRef info.TyconRef writeString info.LogicalName - | Item.ActivePatternResult(info, _, _, _) -> + | Item.ActivePatternResult (info, _, _, _) -> writeString ItemKeyTags.itemActivePattern - info.ActiveTags - |> List.iter writeString + info.ActiveTags |> List.iter writeString | Item.ActivePatternCase elemRef -> writeString ItemKeyTags.itemActivePattern - elemRef.ActivePatternInfo.ActiveTags - |> List.iter writeString + elemRef.ActivePatternInfo.ActiveTags |> List.iter writeString | Item.ExnCase tcref -> writeString ItemKeyTags.itemExnCase @@ -340,13 +333,13 @@ and [] ItemKeyStoreBuilder() = writeString info.LogicalName writeType false info.FieldType - | Item.UnionCaseField(info, fieldIndex) -> + | Item.UnionCaseField (info, fieldIndex) -> writeString ItemKeyTags.typeUnionCase writeEntityRef info.TyconRef writeString info.LogicalName writeInt32 fieldIndex - | Item.AnonRecdField(info, tys, i, _) -> + | Item.AnonRecdField (info, tys, i, _) -> writeString ItemKeyTags.itemAnonymousRecordField writeString info.ILTypeRef.BasicQualifiedName tys |> List.iter (writeType false) @@ -366,32 +359,26 @@ and [] ItemKeyStoreBuilder() = writeString info.EventName writeEntityRef info.DeclaringTyconRef - | Item.Property(nm, infos) -> + | Item.Property (nm, infos) -> writeString ItemKeyTags.itemProperty writeString nm + match infos |> List.tryHead with - | Some info -> - writeEntityRef info.DeclaringTyconRef - | _ -> - () + | Some info -> writeEntityRef info.DeclaringTyconRef + | _ -> () - | Item.TypeVar(_, typar) -> - writeTypar true typar + | Item.TypeVar (_, typar) -> writeTypar true typar - | Item.Types(_, [ty]) -> - writeType true ty + | Item.Types (_, [ ty ]) -> writeType true ty - | Item.UnqualifiedType [tcref] -> - writeEntityRef tcref + | Item.UnqualifiedType [ tcref ] -> writeEntityRef tcref - | Item.MethodGroup(_, [info], _) - | Item.CtorGroup(_, [info]) -> + | Item.MethodGroup (_, [ info ], _) + | Item.CtorGroup (_, [ info ]) -> match info with - | FSMeth(_, _, vref, _) -> - writeValRef vref - | ILMeth(_, info, _) -> - info.ILMethodRef.ArgTypes - |> List.iter writeILType + | FSMeth (_, _, vref, _) -> writeValRef vref + | ILMeth (_, info, _) -> + info.ILMethodRef.ArgTypes |> List.iter writeILType writeILType info.ILMethodRef.ReturnType writeString info.ILName writeType false info.ApparentEnclosingType @@ -400,12 +387,14 @@ and [] ItemKeyStoreBuilder() = writeEntityRef info.DeclaringTyconRef writeString info.LogicalName - | Item.ModuleOrNamespaces [x] -> + | Item.ModuleOrNamespaces [ x ] -> writeString ItemKeyTags.itemModuleOrNamespace + x.CompilationPath.DemangledPath |> List.iter (fun x -> writeString x writeString ".") + writeString x.LogicalName | Item.DelegateCtor ty -> @@ -431,6 +420,7 @@ and [] ItemKeyStoreBuilder() = member _.TryBuildAndReset() = if b.Count > 0 then let length = int64 b.Count + let mmf = let mmf = MemoryMappedFile.CreateNew( @@ -438,7 +428,9 @@ and [] ItemKeyStoreBuilder() = length, MemoryMappedFileAccess.ReadWrite, MemoryMappedFileOptions.None, - HandleInheritability.None) + HandleInheritability.None + ) + use stream = mmf.CreateViewStream(0L, length, MemoryMappedFileAccess.ReadWrite) b.WriteContentTo stream mmf diff --git a/src/Compiler/Service/QuickParse.fs b/src/Compiler/Service/QuickParse.fs index 10c446851209..e40d660bb2ff 100644 --- a/src/Compiler/Service/QuickParse.fs +++ b/src/Compiler/Service/QuickParse.fs @@ -10,36 +10,42 @@ open FSharp.Compiler.Tokenization /// Qualified long name. type PartialLongName = { - /// Qualifying idents, prior to the last dot, not including the last part. - QualifyingIdents: string list - - /// Last part of long ident. - PartialIdent: string - - /// The column number at the end of full partial name. - EndColumn: int - - /// Position of the last dot. - LastDotPos: int option + /// Qualifying idents, prior to the last dot, not including the last part. + QualifyingIdents: string list + + /// Last part of long ident. + PartialIdent: string + + /// The column number at the end of full partial name. + EndColumn: int + + /// Position of the last dot. + LastDotPos: int option } - + /// Empty partial long name. - static member Empty(endColumn: int) = { QualifyingIdents = []; PartialIdent = ""; EndColumn = endColumn; LastDotPos = None } + static member Empty(endColumn: int) = + { + QualifyingIdents = [] + PartialIdent = "" + EndColumn = endColumn + LastDotPos = None + } /// Methods for cheaply and inaccurately parsing F#. /// -/// These methods are very old and are mostly to do with extracting "long identifier islands" +/// These methods are very old and are mostly to do with extracting "long identifier islands" /// A.B.C /// from F# source code, an approach taken from pre-F# VS samples for implementing intelliense. /// -/// This code should really no longer be needed since the language service has access to -/// parsed F# source code ASTs. However, the long identifiers are still passed back to GetDeclarations and friends in the +/// This code should really no longer be needed since the language service has access to +/// parsed F# source code ASTs. However, the long identifiers are still passed back to GetDeclarations and friends in the /// F# Compiler Service and it's annoyingly hard to remove their use completely. /// -/// In general it is unlikely much progress will be made by fixing this code - it will be better to +/// In general it is unlikely much progress will be made by fixing this code - it will be better to /// extract more information from the F# ASTs. /// -/// It's also surprising how hard even the job of getting long identifier islands can be. For example the code +/// It's also surprising how hard even the job of getting long identifier islands can be. For example the code /// below is inaccurate for long identifier chains involving ``...`` identifiers. And there are special cases /// for active pattern names and so on. module QuickParse = @@ -49,12 +55,13 @@ module QuickParse = // Adjusts the token tag for the given identifier // - if we're inside active pattern name (at the bar), correct the token TAG to be an identifier - let CorrectIdentifierToken (tokenText: string) (tokenTag: int) = + let CorrectIdentifierToken (tokenText: string) (tokenTag: int) = if tokenText.EndsWithOrdinal("|") then FSharp.Compiler.Parser.tagOfToken (FSharp.Compiler.Parser.token.IDENT tokenText) - else tokenTag + else + tokenTag - let rec isValidStrippedName (name: ReadOnlySpan) idx = + let rec isValidStrippedName (name: ReadOnlySpan) idx = if idx = name.Length then false elif IsIdentifierPartCharacter name[idx] then true else isValidStrippedName name (idx + 1) @@ -63,32 +70,44 @@ module QuickParse = // Extracts the 'core' part without surrounding bars and checks whether it contains some identifier // (Note, this doesn't have to be precise, because this is checked by background compiler, // but it has to be good enough to distinguish operators and active pattern names) - let private isValidActivePatternName (name: string) = - - // Strip the surrounding bars (e.g. from "|xyz|_|") to get "xyz" - match name.StartsWithOrdinal("|"), name.EndsWithOrdinal("|_|"), name.EndsWithOrdinal("|") with - | true, true, _ when name.Length > 4 -> isValidStrippedName (name.AsSpan(1, name.Length - 4)) 0 - | true, _, true when name.Length > 2 -> isValidStrippedName (name.AsSpan(1, name.Length - 2)) 0 - | _ -> false - + let private isValidActivePatternName (name: string) = + + // Strip the surrounding bars (e.g. from "|xyz|_|") to get "xyz" + match name.StartsWithOrdinal("|"), name.EndsWithOrdinal("|_|"), name.EndsWithOrdinal("|") with + | true, true, _ when name.Length > 4 -> isValidStrippedName (name.AsSpan(1, name.Length - 4)) 0 + | true, _, true when name.Length > 2 -> isValidStrippedName (name.AsSpan(1, name.Length - 2)) 0 + | _ -> false + let GetCompleteIdentifierIslandImpl (lineStr: string) (index: int) : (string * int * bool) option = - if index < 0 || isNull lineStr || index >= lineStr.Length then None + if index < 0 || isNull lineStr || index >= lineStr.Length then + None else let fixup = match () with // at a valid position, on a valid character - | _ when (index < lineStr.Length) && (lineStr[index] = '|' || IsIdentifierPartCharacter lineStr[index]) -> Some index + | _ when + (index < lineStr.Length) + && (lineStr[index] = '|' || IsIdentifierPartCharacter lineStr[index]) + -> + Some index | _ -> None // not on a word or '.' - - - let (|Char|_|) p = if p >=0 && p < lineStr.Length then Some(lineStr[p]) else None - let (|IsLongIdentifierPartChar|_|) c = if IsLongIdentifierPartCharacter c then Some () else None - let (|IsIdentifierPartChar|_|) c = if IsIdentifierPartCharacter c then Some () else None + + let (|Char|_|) p = + if p >= 0 && p < lineStr.Length then + Some(lineStr[p]) + else + None + + let (|IsLongIdentifierPartChar|_|) c = + if IsLongIdentifierPartCharacter c then Some() else None + + let (|IsIdentifierPartChar|_|) c = + if IsIdentifierPartCharacter c then Some() else None let rec searchLeft p = match (p - 1), (p - 2) with | Char '|', Char '[' -> p // boundary of array declaration - stop - | Char '|', _ + | Char '|', _ | Char IsLongIdentifierPartChar, _ -> searchLeft (p - 1) // allow normal chars and '.'s | _ -> p @@ -97,36 +116,42 @@ module QuickParse = | Char '|', Char ']' -> p // boundary of array declaration - stop | Char '|', _ | Char IsIdentifierPartChar, _ -> searchRight (p + 1) // allow only normal chars (stop at '.') - | _ -> p - - let tickColsOpt = + | _ -> p + + let tickColsOpt = let rec walkOutsideBackticks i = - if i >= lineStr.Length then None + if i >= lineStr.Length then + None else - match i, i + 1 with - | Char '`', Char '`' -> - // dive into backticked part - // if pos = i then it will be included in backticked range ($``identifier``) - walkInsideBackticks (i + 2) i - | _, _ -> - if i >= index then None - else - // we still not reached position p - continue walking - walkOutsideBackticks (i + 1) - and walkInsideBackticks i start = - if i >= lineStr.Length then None // non-closed backticks + match i, i + 1 with + | Char '`', Char '`' -> + // dive into backticked part + // if pos = i then it will be included in backticked range ($``identifier``) + walkInsideBackticks (i + 2) i + | _, _ -> + if i >= index then + None + else + // we still not reached position p - continue walking + walkOutsideBackticks (i + 1) + + and walkInsideBackticks i start = + if i >= lineStr.Length then + None // non-closed backticks else - match i, i + 1 with - | Char '`', Char '`' -> - // found closing pair of backticks - // if target position is between start and current pos + 1 (entire range of escaped identifier including backticks) - return success - // else climb outside and continue walking - if index >= start && index < (i + 2) then Some (start, i) - else walkOutsideBackticks (i + 2) - | _, _ -> walkInsideBackticks (i + 1) start + match i, i + 1 with + | Char '`', Char '`' -> + // found closing pair of backticks + // if target position is between start and current pos + 1 (entire range of escaped identifier including backticks) - return success + // else climb outside and continue walking + if index >= start && index < (i + 2) then + Some(start, i) + else + walkOutsideBackticks (i + 2) + | _, _ -> walkInsideBackticks (i + 1) start walkOutsideBackticks 0 - + match tickColsOpt with | Some (prevTickTick, idxTickTick) -> // inside ``identifier`` (which can contain any characters!) so we try returning its location @@ -135,14 +160,17 @@ module QuickParse = Some(ident, pos, true) | _ -> // find location of an ordinary identifier - fixup |> Option.bind (fun p -> + fixup + |> Option.bind (fun p -> let l = searchLeft p let r = searchRight p - let ident = lineStr.Substring (l, r - l + 1) - if ident.IndexOf('|') <> -1 && not(isValidActivePatternName(ident)) then None else - let pos = r + MagicalAdjustmentConstant - Some(ident, pos, false) - ) + let ident = lineStr.Substring(l, r - l + 1) + + if ident.IndexOf('|') <> -1 && not (isValidActivePatternName (ident)) then + None + else + let pos = r + MagicalAdjustmentConstant + Some(ident, pos, false)) /// Given a string and a position in that string, find an identifier as /// expected by `GotoDefinition`. This will work when the cursor is @@ -154,7 +182,7 @@ module QuickParse = /// /// In general, only identifiers composed from upper/lower letters and '.' are supported, but there /// are a couple of explicitly handled exceptions to allow some common scenarios: - /// - When the name contains only letters and '|' symbol, it may be an active pattern, so we + /// - When the name contains only letters and '|' symbol, it may be an active pattern, so we /// treat it as a valid identifier - e.g. let ( |Identity| ) a = a /// (but other identifiers that include '|' are not allowed - e.g. '||' operator) /// - It searches for double tick (``) to see if the identifier could be something like ``a b`` @@ -162,200 +190,253 @@ module QuickParse = /// REVIEW: Also support, e.g., operators, performing the necessary mangling. /// (i.e., I would like that the name returned here can be passed as-is /// (post `.`-chopping) to `GetDeclarationLocation.) - /// + /// /// In addition, return the position where a `.` would go if we were making /// a call to `DeclItemsForNamesAtPosition` for intellisense. This will /// allow us to use find the correct qualified items rather than resorting /// to the more expensive and less accurate environment lookup. let GetCompleteIdentifierIsland (tolerateJustAfter: bool) (lineStr: string) (index: int) : (string * int * bool) option = - if String.IsNullOrEmpty lineStr then None - else + if String.IsNullOrEmpty lineStr then + None + else let directResult = GetCompleteIdentifierIslandImpl lineStr index - if tolerateJustAfter && directResult = None then + + if tolerateJustAfter && directResult = None then GetCompleteIdentifierIslandImpl lineStr (index - 1) - else + else directResult let private defaultName = [], "" /// Get the partial long name of the identifier to the left of index. - let GetPartialLongName(lineStr: string, index: int) = - if isNull lineStr then defaultName - elif index < 0 then defaultName - elif index >= lineStr.Length then defaultName + let GetPartialLongName (lineStr: string, index: int) = + if isNull lineStr then + defaultName + elif index < 0 then + defaultName + elif index >= lineStr.Length then + defaultName else let IsIdentifierPartCharacter pos = IsIdentifierPartCharacter lineStr[pos] - let IsLongIdentifierPartCharacter pos = IsLongIdentifierPartCharacter lineStr[pos] + + let IsLongIdentifierPartCharacter pos = + IsLongIdentifierPartCharacter lineStr[pos] + let IsDot pos = lineStr[pos] = '.' - let rec InLeadingIdentifier(pos,right,(prior,residue)) = - let PushName() = ((lineStr.Substring(pos+1,right-pos-1)) :: prior),residue - if pos < 0 then PushName() - elif IsIdentifierPartCharacter pos then InLeadingIdentifier(pos-1,right,(prior,residue)) - elif IsDot pos then InLeadingIdentifier(pos-1,pos,PushName()) - else PushName() - - let rec InName(pos,startResidue,right) = - let NameAndResidue() = - [lineStr.Substring(pos+1,startResidue-pos-1)],(lineStr.Substring(startResidue+1,right-startResidue)) - if pos < 0 then [lineStr.Substring(pos+1,startResidue-pos-1)],(lineStr.Substring(startResidue+1,right-startResidue)) - elif IsIdentifierPartCharacter pos then InName(pos-1,startResidue,right) - elif IsDot pos then InLeadingIdentifier(pos-1,pos,NameAndResidue()) - else NameAndResidue() - - let rec InResidue(pos,right) = - if pos < 0 then [],lineStr.Substring(pos+1,right-pos) - elif IsDot pos then InName(pos-1,pos,right) - elif IsLongIdentifierPartCharacter pos then InResidue(pos-1, right) - else [],lineStr.Substring(pos+1,right-pos) - - let result = InResidue(index,index) + let rec InLeadingIdentifier (pos, right, (prior, residue)) = + let PushName () = + ((lineStr.Substring(pos + 1, right - pos - 1)) :: prior), residue + + if pos < 0 then + PushName() + elif IsIdentifierPartCharacter pos then + InLeadingIdentifier(pos - 1, right, (prior, residue)) + elif IsDot pos then + InLeadingIdentifier(pos - 1, pos, PushName()) + else + PushName() + + let rec InName (pos, startResidue, right) = + let NameAndResidue () = + [ lineStr.Substring(pos + 1, startResidue - pos - 1) ], (lineStr.Substring(startResidue + 1, right - startResidue)) + + if pos < 0 then + [ lineStr.Substring(pos + 1, startResidue - pos - 1) ], (lineStr.Substring(startResidue + 1, right - startResidue)) + elif IsIdentifierPartCharacter pos then + InName(pos - 1, startResidue, right) + elif IsDot pos then + InLeadingIdentifier(pos - 1, pos, NameAndResidue()) + else + NameAndResidue() + + let rec InResidue (pos, right) = + if pos < 0 then + [], lineStr.Substring(pos + 1, right - pos) + elif IsDot pos then + InName(pos - 1, pos, right) + elif IsLongIdentifierPartCharacter pos then + InResidue(pos - 1, right) + else + [], lineStr.Substring(pos + 1, right - pos) + + let result = InResidue(index, index) result - + type private EatCommentCallContext = | SkipWhiteSpaces of ident: string * current: string list * throwAwayNext: bool | StartIdentifier of current: string list * throwAway: bool /// Get the partial long name of the identifier to the left of index. /// For example, for `System.DateTime.Now` it returns PartialLongName ([|"System"; "DateTime"|], "Now", Some 32), where "32" pos of the last dot. - let GetPartialLongNameEx(lineStr: string, index: int) : PartialLongName = - if isNull lineStr then PartialLongName.Empty(index) - elif index < 0 then PartialLongName.Empty(index) - elif index >= lineStr.Length then PartialLongName.Empty(index) + let GetPartialLongNameEx (lineStr: string, index: int) : PartialLongName = + if isNull lineStr then + PartialLongName.Empty(index) + elif index < 0 then + PartialLongName.Empty(index) + elif index >= lineStr.Length then + PartialLongName.Empty(index) else let IsIdentifierPartCharacter pos = IsIdentifierPartCharacter lineStr[pos] let IsIdentifierStartCharacter pos = IsIdentifierPartCharacter pos let IsDot pos = lineStr[pos] = '.' let IsTick pos = lineStr[pos] = '`' - let IsEndOfComment pos = pos < index - 1 && lineStr[pos] = '*' && lineStr[pos + 1] = ')' - let IsStartOfComment pos = pos < index - 1 && lineStr[pos] = '(' && lineStr[pos + 1] = '*' + + let IsEndOfComment pos = + pos < index - 1 && lineStr[pos] = '*' && lineStr[pos + 1] = ')' + + let IsStartOfComment pos = + pos < index - 1 && lineStr[pos] = '(' && lineStr[pos + 1] = '*' + let IsWhitespace pos = Char.IsWhiteSpace(lineStr[pos]) - let rec SkipWhitespaceBeforeDotIdentifier(pos, ident, current, throwAwayNext, lastDotPos) = - if pos > index then PartialLongName.Empty(index) // we're in whitespace after an identifier, if this is where the cursor is, there is no PLID here - elif IsWhitespace pos then SkipWhitespaceBeforeDotIdentifier(pos+1,ident,current,throwAwayNext,lastDotPos) - elif IsDot pos then AtStartOfIdentifier(pos+1,ident :: current,throwAwayNext, Some pos) - elif IsStartOfComment pos then EatComment(1, pos + 1, EatCommentCallContext.SkipWhiteSpaces(ident, current, throwAwayNext), lastDotPos) - else AtStartOfIdentifier(pos,[],false,None) // Throw away what we have and start over. + let rec SkipWhitespaceBeforeDotIdentifier (pos, ident, current, throwAwayNext, lastDotPos) = + if pos > index then + PartialLongName.Empty(index) // we're in whitespace after an identifier, if this is where the cursor is, there is no PLID here + elif IsWhitespace pos then + SkipWhitespaceBeforeDotIdentifier(pos + 1, ident, current, throwAwayNext, lastDotPos) + elif IsDot pos then + AtStartOfIdentifier(pos + 1, ident :: current, throwAwayNext, Some pos) + elif IsStartOfComment pos then + EatComment(1, pos + 1, EatCommentCallContext.SkipWhiteSpaces(ident, current, throwAwayNext), lastDotPos) + else + AtStartOfIdentifier(pos, [], false, None) // Throw away what we have and start over. - and EatComment (nesting, pos, callContext,lastDotPos) = - if pos > index then PartialLongName.Empty(index) else - if IsStartOfComment pos then + and EatComment (nesting, pos, callContext, lastDotPos) = + if pos > index then + PartialLongName.Empty(index) + else if IsStartOfComment pos then // track balance of closing '*)' - EatComment(nesting + 1, pos + 2, callContext,lastDotPos) - else - if IsEndOfComment pos then - if nesting = 1 then + EatComment(nesting + 1, pos + 2, callContext, lastDotPos) + else if IsEndOfComment pos then + if nesting = 1 then // all right, we are at the end of comment, jump outside match callContext with - | EatCommentCallContext.SkipWhiteSpaces(ident, current, throwAway) -> - SkipWhitespaceBeforeDotIdentifier(pos + 2, ident, current, throwAway,lastDotPos) - | EatCommentCallContext.StartIdentifier(current, throwAway) -> - AtStartOfIdentifier(pos + 2, current, throwAway,lastDotPos) - else + | EatCommentCallContext.SkipWhiteSpaces (ident, current, throwAway) -> + SkipWhitespaceBeforeDotIdentifier(pos + 2, ident, current, throwAway, lastDotPos) + | EatCommentCallContext.StartIdentifier (current, throwAway) -> + AtStartOfIdentifier(pos + 2, current, throwAway, lastDotPos) + else // reduce level of nesting and continue EatComment(nesting - 1, pos + 2, callContext, lastDotPos) else // eat next char EatComment(nesting, pos + 1, callContext, lastDotPos) - and InUnquotedIdentifier(left:int,pos:int,current,throwAwayNext,lastDotPos) = - if pos > index then - if throwAwayNext then - PartialLongName.Empty(index) + and InUnquotedIdentifier (left: int, pos: int, current, throwAwayNext, lastDotPos) = + if pos > index then + if throwAwayNext then + PartialLongName.Empty(index) else - { QualifyingIdents = current - PartialIdent = lineStr.Substring(left,pos-left) - EndColumn = index - LastDotPos = lastDotPos } + { + QualifyingIdents = current + PartialIdent = lineStr.Substring(left, pos - left) + EndColumn = index + LastDotPos = lastDotPos + } + else if IsIdentifierPartCharacter pos then + InUnquotedIdentifier(left, pos + 1, current, throwAwayNext, lastDotPos) + elif IsDot pos then + let ident = lineStr.Substring(left, pos - left) + AtStartOfIdentifier(pos + 1, ident :: current, throwAwayNext, Some pos) + elif IsWhitespace pos || IsStartOfComment pos then + let ident = lineStr.Substring(left, pos - left) + SkipWhitespaceBeforeDotIdentifier(pos, ident, current, throwAwayNext, lastDotPos) else - if IsIdentifierPartCharacter pos then InUnquotedIdentifier(left,pos+1,current,throwAwayNext,lastDotPos) - elif IsDot pos then - let ident = lineStr.Substring(left,pos-left) - AtStartOfIdentifier(pos+1,ident :: current,throwAwayNext, Some pos) - elif IsWhitespace pos || IsStartOfComment pos then - let ident = lineStr.Substring(left,pos-left) - SkipWhitespaceBeforeDotIdentifier(pos, ident, current, throwAwayNext, lastDotPos) - else AtStartOfIdentifier(pos,[],false,None) // Throw away what we have and start over. - - and InQuotedIdentifier(left:int,pos:int, current,throwAwayNext,lastDotPos) = - if pos > index then - if throwAwayNext then - PartialLongName.Empty(index) - else - { QualifyingIdents = current - PartialIdent = lineStr.Substring(left,pos-left) - EndColumn = index - LastDotPos = lastDotPos } + AtStartOfIdentifier(pos, [], false, None) // Throw away what we have and start over. + + and InQuotedIdentifier (left: int, pos: int, current, throwAwayNext, lastDotPos) = + if pos > index then + if throwAwayNext then + PartialLongName.Empty(index) + else + { + QualifyingIdents = current + PartialIdent = lineStr.Substring(left, pos - left) + EndColumn = index + LastDotPos = lastDotPos + } else let remainingLength = lineStr.Length - pos - if IsTick pos && remainingLength > 1 && IsTick(pos+1) then - let ident = lineStr.Substring(left, pos-left) - SkipWhitespaceBeforeDotIdentifier(pos+2,ident,current,throwAwayNext,lastDotPos) - else InQuotedIdentifier(left,pos+1,current,throwAwayNext,lastDotPos) - - and AtStartOfIdentifier(pos:int, current, throwAwayNext, lastDotPos: int option) = - if pos > index then - if throwAwayNext then + + if IsTick pos && remainingLength > 1 && IsTick(pos + 1) then + let ident = lineStr.Substring(left, pos - left) + SkipWhitespaceBeforeDotIdentifier(pos + 2, ident, current, throwAwayNext, lastDotPos) + else + InQuotedIdentifier(left, pos + 1, current, throwAwayNext, lastDotPos) + + and AtStartOfIdentifier (pos: int, current, throwAwayNext, lastDotPos: int option) = + if pos > index then + if throwAwayNext then PartialLongName.Empty(index) - else - { QualifyingIdents = current - PartialIdent = "" - EndColumn = index - LastDotPos = lastDotPos } - else - if IsWhitespace pos then AtStartOfIdentifier(pos+1,current,throwAwayNext, lastDotPos) else - let remainingLength = lineStr.Length - pos - if IsTick pos && remainingLength > 1 && IsTick(pos+1) then InQuotedIdentifier(pos+2,pos+2,current,throwAwayNext,lastDotPos) - elif IsStartOfComment pos then EatComment(1, pos + 1, EatCommentCallContext.StartIdentifier(current, throwAwayNext), lastDotPos) - elif IsIdentifierStartCharacter pos then InUnquotedIdentifier(pos,pos+1,current,throwAwayNext,lastDotPos) - elif IsDot pos then - if pos = 0 then - // dot on first char of line, currently treat it like empty identifier to the left - AtStartOfIdentifier(pos+1,"":: current,throwAwayNext, Some pos) - elif not (pos > 0 && (IsIdentifierPartCharacter(pos-1) || IsWhitespace(pos-1))) then - // it's not dots as part.of.a.long.ident, it's e.g. the range operator (..), or some other multi-char operator ending in dot - if lineStr[pos-1] = ')' then - // one very problematic case is someCall(args).Name - // without special logic, we will decide that ). is an operator and parse Name as the plid - // but in fact this is an expression tail, and we don't want a plid, rather we need to use expression typings at that location - // so be sure not to treat the name here as a plid - AtStartOfIdentifier(pos+1,[],true,None) // Throw away what we have, and the next apparent plid, and start over. - else - AtStartOfIdentifier(pos+1,[],false,None) // Throw away what we have and start over. + { + QualifyingIdents = current + PartialIdent = "" + EndColumn = index + LastDotPos = lastDotPos + } + else if IsWhitespace pos then + AtStartOfIdentifier(pos + 1, current, throwAwayNext, lastDotPos) + else + let remainingLength = lineStr.Length - pos + + if IsTick pos && remainingLength > 1 && IsTick(pos + 1) then + InQuotedIdentifier(pos + 2, pos + 2, current, throwAwayNext, lastDotPos) + elif IsStartOfComment pos then + EatComment(1, pos + 1, EatCommentCallContext.StartIdentifier(current, throwAwayNext), lastDotPos) + elif IsIdentifierStartCharacter pos then + InUnquotedIdentifier(pos, pos + 1, current, throwAwayNext, lastDotPos) + elif IsDot pos then + if pos = 0 then + // dot on first char of line, currently treat it like empty identifier to the left + AtStartOfIdentifier(pos + 1, "" :: current, throwAwayNext, Some pos) + elif not (pos > 0 && (IsIdentifierPartCharacter(pos - 1) || IsWhitespace(pos - 1))) then + // it's not dots as part.of.a.long.ident, it's e.g. the range operator (..), or some other multi-char operator ending in dot + if lineStr[pos - 1] = ')' then + // one very problematic case is someCall(args).Name + // without special logic, we will decide that ). is an operator and parse Name as the plid + // but in fact this is an expression tail, and we don't want a plid, rather we need to use expression typings at that location + // so be sure not to treat the name here as a plid + AtStartOfIdentifier(pos + 1, [], true, None) // Throw away what we have, and the next apparent plid, and start over. else - AtStartOfIdentifier(pos+1,"":: current,throwAwayNext, Some pos) - else AtStartOfIdentifier(pos+1,[],throwAwayNext, None) - let partialLongName = AtStartOfIdentifier(0, [], false, None) - + AtStartOfIdentifier(pos + 1, [], false, None) // Throw away what we have and start over. + else + AtStartOfIdentifier(pos + 1, "" :: current, throwAwayNext, Some pos) + else + AtStartOfIdentifier(pos + 1, [], throwAwayNext, None) + + let partialLongName = AtStartOfIdentifier(0, [], false, None) + match List.rev partialLongName.QualifyingIdents with - | s :: _ when s.Length > 0 && Char.IsDigit(s[0]) -> PartialLongName.Empty(index) // "2.0" is not a longId (this might not be right for ``2.0`` but good enough for common case) - | plid -> { partialLongName with QualifyingIdents = plid } - - let TokenNameEquals (tokenInfo: FSharpTokenInfo) (token2: string) = - String.Compare(tokenInfo .TokenName, token2, StringComparison.OrdinalIgnoreCase) = 0 - + | s :: _ when s.Length > 0 && Char.IsDigit(s[0]) -> PartialLongName.Empty(index) // "2.0" is not a longId (this might not be right for ``2.0`` but good enough for common case) + | plid -> + { partialLongName with + QualifyingIdents = plid + } + + let TokenNameEquals (tokenInfo: FSharpTokenInfo) (token2: string) = + String.Compare(tokenInfo.TokenName, token2, StringComparison.OrdinalIgnoreCase) = 0 + // The prefix of the sequence of token names to look for in TestMemberOrOverrideDeclaration, in reverse order - let private expected = [ [|"dot"|]; [|"ident"|]; [|"member"; "override"|] ] + let private expected = [ [| "dot" |]; [| "ident" |]; [| "member"; "override" |] ] /// Tests whether the user is typing something like "member x." or "override (*comment*) x." let TestMemberOrOverrideDeclaration (tokens: FSharpTokenInfo[]) = - let filteredReversed = - tokens + let filteredReversed = + tokens |> Array.filter (fun tok -> // cut out whitespaces\comments\access modifiers - not (TokenNameEquals tok "comment") && - not (TokenNameEquals tok "whitespace") && - not (TokenNameEquals tok "private") && - not (TokenNameEquals tok "internal") && - not (TokenNameEquals tok "public") - ) + not (TokenNameEquals tok "comment") + && not (TokenNameEquals tok "whitespace") + && not (TokenNameEquals tok "private") + && not (TokenNameEquals tok "internal") + && not (TokenNameEquals tok "public")) |> Array.rev - - if filteredReversed.Length < expected.Length then false - else + + if filteredReversed.Length < expected.Length then + false + else // check whether sequences match - (filteredReversed, expected) ||> Seq.forall2 (fun tok expect -> - expect |> Array.exists (TokenNameEquals tok) ) - + (filteredReversed, expected) + ||> Seq.forall2 (fun tok expect -> expect |> Array.exists (TokenNameEquals tok)) diff --git a/src/Compiler/Service/SemanticClassification.fs b/src/Compiler/Service/SemanticClassification.fs index 562eeb01935d..c95195db8ff8 100644 --- a/src/Compiler/Service/SemanticClassification.fs +++ b/src/Compiler/Service/SemanticClassification.fs @@ -5,14 +5,14 @@ namespace FSharp.Compiler.EditorServices open System.Diagnostics open System.Collections.Generic open System.Collections.Immutable -open Internal.Utilities.Library +open Internal.Utilities.Library open FSharp.Compiler.Diagnostics open FSharp.Compiler.Import open FSharp.Compiler.Infos open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.NameResolution open FSharp.Compiler.Syntax.PrettyNaming -open FSharp.Compiler.TcGlobals +open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree @@ -67,332 +67,332 @@ type SemanticClassificationItem = [] module TcResolutionsExtensions = - let (|CNR|) (cnr:CapturedNameResolution) = + let (|CNR|) (cnr: CapturedNameResolution) = (cnr.Item, cnr.ItemOccurence, cnr.DisplayEnv, cnr.NameResolutionEnv, cnr.AccessorDomain, cnr.Range) type TcResolutions with - member sResolutions.GetSemanticClassification(g: TcGlobals, amap: ImportMap, formatSpecifierLocations: (range * int) [], range: range option) : SemanticClassificationItem [] = - DiagnosticsScope.Protect range0 (fun () -> - let (|LegitTypeOccurence|_|) occ = - match occ with - | ItemOccurence.UseInType - | ItemOccurence.UseInAttribute - | ItemOccurence.Use _ - | ItemOccurence.Binding _ - | ItemOccurence.Pattern _ - | ItemOccurence.Open -> Some() - | _ -> None - - let (|KeywordIntrinsicValue|_|) (vref: ValRef) = - if valRefEq g g.raise_vref vref || - valRefEq g g.reraise_vref vref || - valRefEq g g.typeof_vref vref || - valRefEq g g.typedefof_vref vref || - valRefEq g g.sizeof_vref vref || - valRefEq g g.nameof_vref vref then Some() - else None - - let (|EnumCaseFieldInfo|_|) (rfinfo : RecdFieldInfo) = - match rfinfo.TyconRef.TypeReprInfo with - | TFSharpObjectRepr x -> - match x.fsobjmodel_kind with - | TFSharpEnum -> Some () + + member sResolutions.GetSemanticClassification + ( + g: TcGlobals, + amap: ImportMap, + formatSpecifierLocations: (range * int)[], + range: range option + ) : SemanticClassificationItem[] = + DiagnosticsScope.Protect + range0 + (fun () -> + let (|LegitTypeOccurence|_|) occ = + match occ with + | ItemOccurence.UseInType + | ItemOccurence.UseInAttribute + | ItemOccurence.Use _ + | ItemOccurence.Binding _ + | ItemOccurence.Pattern _ + | ItemOccurence.Open -> Some() + | _ -> None + + let (|KeywordIntrinsicValue|_|) (vref: ValRef) = + if valRefEq g g.raise_vref vref + || valRefEq g g.reraise_vref vref + || valRefEq g g.typeof_vref vref + || valRefEq g g.typedefof_vref vref + || valRefEq g g.sizeof_vref vref + || valRefEq g g.nameof_vref vref then + Some() + else + None + + let (|EnumCaseFieldInfo|_|) (rfinfo: RecdFieldInfo) = + match rfinfo.TyconRef.TypeReprInfo with + | TFSharpObjectRepr x -> + match x.fsobjmodel_kind with + | TFSharpEnum -> Some() + | _ -> None | _ -> None - | _ -> None - - // Custome builders like 'async { }' are both Item.Value and Item.CustomBuilder. - // We should prefer the latter, otherwise they would not get classified as CEs. - let takeCustomBuilder (cnrs: CapturedNameResolution[]) = - assert (cnrs.Length > 0) - if cnrs.Length = 1 then - cnrs - elif cnrs.Length = 2 then - match cnrs[0].Item, cnrs[1].Item with - | Item.Value _, Item.CustomBuilder _ -> - [| cnrs[1] |] - | Item.CustomBuilder _, Item.Value _ -> - [| cnrs[0] |] - | _ -> + + // Custome builders like 'async { }' are both Item.Value and Item.CustomBuilder. + // We should prefer the latter, otherwise they would not get classified as CEs. + let takeCustomBuilder (cnrs: CapturedNameResolution[]) = + assert (cnrs.Length > 0) + + if cnrs.Length = 1 then cnrs - else - cnrs - - let resolutions = - match range with - | Some range -> - sResolutions.CapturedNameResolutions.ToArray() - |> Array.filter (fun cnr -> rangeContainsPos range cnr.Range.Start || rangeContainsPos range cnr.Range.End) - |> Array.groupBy (fun cnr -> cnr.Range) - |> Array.map (fun (_, cnrs) -> takeCustomBuilder cnrs) - |> Array.concat - | None -> - sResolutions.CapturedNameResolutions.ToArray() - - let isDisposableTy (ty: TType) = - not (typeEquiv g ty g.system_IDisposable_ty) && - protectAssemblyExplorationNoReraise false false (fun () -> ExistsHeadTypeInEntireHierarchy g amap range0 ty g.tcref_System_IDisposable) - - let isDiscard (str: string) = str.StartsWith("_") - - let isValRefDisposable (vref: ValRef) = - not (isDiscard vref.DisplayName) && - // For values, we actually do want to color things if they literally are IDisposables - protectAssemblyExplorationNoReraise false false (fun () -> ExistsHeadTypeInEntireHierarchy g amap range0 vref.Type g.tcref_System_IDisposable) - - let isStructTyconRef (tyconRef: TyconRef) = - let ty = generalizedTyconRef g tyconRef - let underlyingTy = stripTyEqnsAndMeasureEqns g ty - isStructTy g underlyingTy - - let isValRefMutable (vref: ValRef) = - // Mutable values, ref cells, and non-inref byrefs are mutable. - vref.IsMutable - || isRefCellTy g vref.Type - || (isByrefTy g vref.Type && not (isInByrefTy g vref.Type)) - - let isRecdFieldMutable (rfinfo: RecdFieldInfo) = - (rfinfo.RecdField.IsMutable && rfinfo.LiteralValue.IsNone) - || isRefCellTy g rfinfo.RecdField.FormalType - - let duplicates = HashSet(comparer) - - let results = ImmutableArray.CreateBuilder() - let inline add m (typ: SemanticClassificationType) = - if duplicates.Add m then - results.Add (SemanticClassificationItem((m, typ))) - - resolutions - |> Array.iter (fun cnr -> - match cnr.Item, cnr.ItemOccurence, cnr.Range with - | (Item.CustomBuilder _ | Item.CustomOperation _), ItemOccurence.Use, m -> - add m SemanticClassificationType.ComputationExpression - - | Item.Value vref, _, m when isValRefMutable vref -> - add m SemanticClassificationType.MutableVar - - | Item.Value KeywordIntrinsicValue, ItemOccurence.Use, m -> - add m SemanticClassificationType.IntrinsicFunction - - | Item.Value vref, _, m when isForallFunctionTy g vref.Type -> - if isDiscard vref.DisplayName then - add m SemanticClassificationType.Plaintext - elif valRefEq g g.range_op_vref vref || valRefEq g g.range_step_op_vref vref then - add m SemanticClassificationType.Operator - elif vref.IsPropertyGetterMethod || vref.IsPropertySetterMethod then - add m SemanticClassificationType.Property - elif vref.IsMember then - add m SemanticClassificationType.Method - elif IsOperatorDisplayName vref.DisplayName then - add m SemanticClassificationType.Operator + elif cnrs.Length = 2 then + match cnrs[0].Item, cnrs[1].Item with + | Item.Value _, Item.CustomBuilder _ -> [| cnrs[1] |] + | Item.CustomBuilder _, Item.Value _ -> [| cnrs[0] |] + | _ -> cnrs else - add m SemanticClassificationType.Function + cnrs - | Item.Value vref, _, m -> - if isValRefDisposable vref then - if vref.IsCompiledAsTopLevel then - add m SemanticClassificationType.DisposableTopLevelValue + let resolutions = + match range with + | Some range -> + sResolutions.CapturedNameResolutions.ToArray() + |> Array.filter (fun cnr -> rangeContainsPos range cnr.Range.Start || rangeContainsPos range cnr.Range.End) + |> Array.groupBy (fun cnr -> cnr.Range) + |> Array.map (fun (_, cnrs) -> takeCustomBuilder cnrs) + |> Array.concat + | None -> sResolutions.CapturedNameResolutions.ToArray() + + let isDisposableTy (ty: TType) = + not (typeEquiv g ty g.system_IDisposable_ty) + && protectAssemblyExplorationNoReraise false false (fun () -> + ExistsHeadTypeInEntireHierarchy g amap range0 ty g.tcref_System_IDisposable) + + let isDiscard (str: string) = str.StartsWith("_") + + let isValRefDisposable (vref: ValRef) = + not (isDiscard vref.DisplayName) + && + // For values, we actually do want to color things if they literally are IDisposables + protectAssemblyExplorationNoReraise false false (fun () -> + ExistsHeadTypeInEntireHierarchy g amap range0 vref.Type g.tcref_System_IDisposable) + + let isStructTyconRef (tyconRef: TyconRef) = + let ty = generalizedTyconRef g tyconRef + let underlyingTy = stripTyEqnsAndMeasureEqns g ty + isStructTy g underlyingTy + + let isValRefMutable (vref: ValRef) = + // Mutable values, ref cells, and non-inref byrefs are mutable. + vref.IsMutable + || isRefCellTy g vref.Type + || (isByrefTy g vref.Type && not (isInByrefTy g vref.Type)) + + let isRecdFieldMutable (rfinfo: RecdFieldInfo) = + (rfinfo.RecdField.IsMutable && rfinfo.LiteralValue.IsNone) + || isRefCellTy g rfinfo.RecdField.FormalType + + let duplicates = HashSet(comparer) + + let results = ImmutableArray.CreateBuilder() + + let inline add m (typ: SemanticClassificationType) = + if duplicates.Add m then + results.Add(SemanticClassificationItem((m, typ))) + + resolutions + |> Array.iter (fun cnr -> + match cnr.Item, cnr.ItemOccurence, cnr.Range with + | (Item.CustomBuilder _ + | Item.CustomOperation _), + ItemOccurence.Use, + m -> add m SemanticClassificationType.ComputationExpression + + | Item.Value vref, _, m when isValRefMutable vref -> add m SemanticClassificationType.MutableVar + + | Item.Value KeywordIntrinsicValue, ItemOccurence.Use, m -> add m SemanticClassificationType.IntrinsicFunction + + | Item.Value vref, _, m when isForallFunctionTy g vref.Type -> + if isDiscard vref.DisplayName then + add m SemanticClassificationType.Plaintext + elif valRefEq g g.range_op_vref vref || valRefEq g g.range_step_op_vref vref then + add m SemanticClassificationType.Operator + elif vref.IsPropertyGetterMethod || vref.IsPropertySetterMethod then + add m SemanticClassificationType.Property + elif vref.IsMember then + add m SemanticClassificationType.Method + elif IsOperatorDisplayName vref.DisplayName then + add m SemanticClassificationType.Operator else - add m SemanticClassificationType.DisposableLocalValue - elif Option.isSome vref.LiteralValue then - add m SemanticClassificationType.Literal - elif not vref.IsCompiledAsTopLevel && not(isDiscard vref.DisplayName) then - add m SemanticClassificationType.LocalValue - else - add m SemanticClassificationType.Value - - | Item.RecdField rfinfo, _, m -> - match rfinfo with - | EnumCaseFieldInfo -> - add m SemanticClassificationType.Enumeration - | _ -> - if isRecdFieldMutable rfinfo then + add m SemanticClassificationType.Function + + | Item.Value vref, _, m -> + if isValRefDisposable vref then + if vref.IsCompiledAsTopLevel then + add m SemanticClassificationType.DisposableTopLevelValue + else + add m SemanticClassificationType.DisposableLocalValue + elif Option.isSome vref.LiteralValue then + add m SemanticClassificationType.Literal + elif not vref.IsCompiledAsTopLevel && not (isDiscard vref.DisplayName) then + add m SemanticClassificationType.LocalValue + else + add m SemanticClassificationType.Value + + | Item.RecdField rfinfo, _, m -> + match rfinfo with + | EnumCaseFieldInfo -> add m SemanticClassificationType.Enumeration + | _ -> + if isRecdFieldMutable rfinfo then + add m SemanticClassificationType.MutableRecordField + elif isFunTy g rfinfo.FieldType then + add m SemanticClassificationType.RecordFieldAsFunction + else + add m SemanticClassificationType.RecordField + + | Item.AnonRecdField (_, tys, idx, m), _, _ -> + let ty = tys[idx] + + // It's not currently possible for anon record fields to be mutable, but they can be ref cells + if isRefCellTy g ty then add m SemanticClassificationType.MutableRecordField - elif isFunTy g rfinfo.FieldType then + elif isFunTy g ty then add m SemanticClassificationType.RecordFieldAsFunction else add m SemanticClassificationType.RecordField - | Item.AnonRecdField(_, tys, idx, m), _, _ -> - let ty = tys[idx] + | Item.Property (_, pinfo :: _), _, m -> + if not pinfo.IsIndexer then + add m SemanticClassificationType.Property + + | Item.CtorGroup (_, minfos), _, m -> + match minfos with + | [] -> add m SemanticClassificationType.ConstructorForReferenceType + | _ -> + if minfos |> List.forall (fun minfo -> isDisposableTy minfo.ApparentEnclosingType) then + add m SemanticClassificationType.DisposableType + elif minfos |> List.forall (fun minfo -> isStructTy g minfo.ApparentEnclosingType) then + add m SemanticClassificationType.ConstructorForValueType + else + add m SemanticClassificationType.ConstructorForReferenceType - // It's not currently possible for anon record fields to be mutable, but they can be ref cells - if isRefCellTy g ty then - add m SemanticClassificationType.MutableRecordField - elif isFunTy g ty then - add m SemanticClassificationType.RecordFieldAsFunction - else - add m SemanticClassificationType.RecordField - - | Item.Property (_, pinfo :: _), _, m -> - if not pinfo.IsIndexer then - add m SemanticClassificationType.Property - - | Item.CtorGroup (_, minfos), _, m -> - match minfos with - | [] -> - add m SemanticClassificationType.ConstructorForReferenceType - | _ -> - if minfos |> List.forall (fun minfo -> isDisposableTy minfo.ApparentEnclosingType) then - add m SemanticClassificationType.DisposableType - elif minfos |> List.forall (fun minfo -> isStructTy g minfo.ApparentEnclosingType) then - add m SemanticClassificationType.ConstructorForValueType - else - add m SemanticClassificationType.ConstructorForReferenceType + | Item.DelegateCtor _, _, m -> add m SemanticClassificationType.ConstructorForReferenceType - | Item.DelegateCtor _, _, m -> - add m SemanticClassificationType.ConstructorForReferenceType + | Item.FakeInterfaceCtor _, _, m -> add m SemanticClassificationType.ConstructorForReferenceType - | Item.FakeInterfaceCtor _, _, m -> - add m SemanticClassificationType.ConstructorForReferenceType + | Item.MethodGroup (_, minfos, _), _, m -> + match minfos with + | [] -> add m SemanticClassificationType.Method + | _ -> + if minfos + |> List.forall (fun minfo -> minfo.IsExtensionMember || minfo.IsCSharpStyleExtensionMember) then + add m SemanticClassificationType.ExtensionMethod + else + add m SemanticClassificationType.Method - | Item.MethodGroup (_, minfos, _), _, m -> - match minfos with - | [] -> - add m SemanticClassificationType.Method - | _ -> - if minfos |> List.forall (fun minfo -> minfo.IsExtensionMember || minfo.IsCSharpStyleExtensionMember) then - add m SemanticClassificationType.ExtensionMethod - else - add m SemanticClassificationType.Method + // Special case measures for struct types + | Item.Types (_, AppTy g (tyconRef, TType_measure _ :: _) :: _), LegitTypeOccurence, m when + isStructTyconRef tyconRef + -> + add m SemanticClassificationType.ValueType - // Special case measures for struct types - | Item.Types(_, AppTy g (tyconRef, TType_measure _ :: _) :: _), LegitTypeOccurence, m when isStructTyconRef tyconRef -> - add m SemanticClassificationType.ValueType - - | Item.Types (_, ty :: _), LegitTypeOccurence, m -> - let reprToClassificationType repr tcref = - match repr with - | TFSharpObjectRepr om -> - match om.fsobjmodel_kind with - | TFSharpClass -> SemanticClassificationType.ReferenceType - | TFSharpInterface -> SemanticClassificationType.Interface - | TFSharpStruct -> SemanticClassificationType.ValueType - | TFSharpDelegate _ -> SemanticClassificationType.Delegate - | TFSharpEnum _ -> SemanticClassificationType.Enumeration - | TFSharpRecdRepr _ - | TFSharpUnionRepr _ -> - if isStructTyconRef tcref then - SemanticClassificationType.ValueType - else - SemanticClassificationType.Type - | TILObjectRepr (TILObjectReprData (_, _, td)) -> - if td.IsClass then - SemanticClassificationType.ReferenceType - elif td.IsStruct then - SemanticClassificationType.ValueType - elif td.IsInterface then - SemanticClassificationType.Interface - elif td.IsEnum then - SemanticClassificationType.Enumeration - else - SemanticClassificationType.Delegate - | TAsmRepr _ -> SemanticClassificationType.TypeDef - | TMeasureableRepr _-> SemanticClassificationType.TypeDef + | Item.Types (_, ty :: _), LegitTypeOccurence, m -> + let reprToClassificationType repr tcref = + match repr with + | TFSharpObjectRepr om -> + match om.fsobjmodel_kind with + | TFSharpClass -> SemanticClassificationType.ReferenceType + | TFSharpInterface -> SemanticClassificationType.Interface + | TFSharpStruct -> SemanticClassificationType.ValueType + | TFSharpDelegate _ -> SemanticClassificationType.Delegate + | TFSharpEnum _ -> SemanticClassificationType.Enumeration + | TFSharpRecdRepr _ + | TFSharpUnionRepr _ -> + if isStructTyconRef tcref then + SemanticClassificationType.ValueType + else + SemanticClassificationType.Type + | TILObjectRepr (TILObjectReprData (_, _, td)) -> + if td.IsClass then + SemanticClassificationType.ReferenceType + elif td.IsStruct then + SemanticClassificationType.ValueType + elif td.IsInterface then + SemanticClassificationType.Interface + elif td.IsEnum then + SemanticClassificationType.Enumeration + else + SemanticClassificationType.Delegate + | TAsmRepr _ -> SemanticClassificationType.TypeDef + | TMeasureableRepr _ -> SemanticClassificationType.TypeDef #if !NO_TYPEPROVIDERS - | TProvidedTypeRepr _-> SemanticClassificationType.TypeDef - | TProvidedNamespaceRepr _-> SemanticClassificationType.TypeDef + | TProvidedTypeRepr _ -> SemanticClassificationType.TypeDef + | TProvidedNamespaceRepr _ -> SemanticClassificationType.TypeDef #endif - | TNoRepr -> SemanticClassificationType.ReferenceType + | TNoRepr -> SemanticClassificationType.ReferenceType - let ty = stripTyEqns g ty - if isDisposableTy ty then - add m SemanticClassificationType.DisposableType - else - match tryTcrefOfAppTy g ty with - | ValueSome tcref -> - add m (reprToClassificationType tcref.TypeReprInfo tcref) - | ValueNone -> - if isStructTupleTy g ty then - add m SemanticClassificationType.ValueType - elif isRefTupleTy g ty then - add m SemanticClassificationType.ReferenceType - elif isForallFunctionTy g ty then - add m SemanticClassificationType.Function - elif isTyparTy g ty then - add m SemanticClassificationType.ValueType - else - add m SemanticClassificationType.TypeDef + let ty = stripTyEqns g ty - | Item.TypeVar _, LegitTypeOccurence, m -> - add m SemanticClassificationType.TypeArgument + if isDisposableTy ty then + add m SemanticClassificationType.DisposableType + else + match tryTcrefOfAppTy g ty with + | ValueSome tcref -> add m (reprToClassificationType tcref.TypeReprInfo tcref) + | ValueNone -> + if isStructTupleTy g ty then + add m SemanticClassificationType.ValueType + elif isRefTupleTy g ty then + add m SemanticClassificationType.ReferenceType + elif isForallFunctionTy g ty then + add m SemanticClassificationType.Function + elif isTyparTy g ty then + add m SemanticClassificationType.ValueType + else + add m SemanticClassificationType.TypeDef + + | Item.TypeVar _, LegitTypeOccurence, m -> add m SemanticClassificationType.TypeArgument + + | Item.ExnCase _, LegitTypeOccurence, m -> add m SemanticClassificationType.Exception + + | Item.ModuleOrNamespaces (modref :: _), LegitTypeOccurence, m -> + if modref.IsNamespace then + add m SemanticClassificationType.Namespace + else + add m SemanticClassificationType.Module - | Item.ExnCase _, LegitTypeOccurence, m -> - add m SemanticClassificationType.Exception + | Item.ActivePatternCase _, _, m -> add m SemanticClassificationType.UnionCase - | Item.ModuleOrNamespaces (modref :: _), LegitTypeOccurence, m -> - if modref.IsNamespace then - add m SemanticClassificationType.Namespace - else - add m SemanticClassificationType.Module + | Item.UnionCase _, _, m -> add m SemanticClassificationType.UnionCase - | Item.ActivePatternCase _, _, m -> - add m SemanticClassificationType.UnionCase + | Item.ActivePatternResult _, _, m -> add m SemanticClassificationType.UnionCase - | Item.UnionCase _, _, m -> - add m SemanticClassificationType.UnionCase + | Item.UnionCaseField _, _, m -> add m SemanticClassificationType.UnionCaseField - | Item.ActivePatternResult _, _, m -> - add m SemanticClassificationType.UnionCase + | Item.ILField _, _, m -> add m SemanticClassificationType.Field - | Item.UnionCaseField _, _, m -> - add m SemanticClassificationType.UnionCaseField + | Item.Event _, _, m -> add m SemanticClassificationType.Event - | Item.ILField _, _, m -> - add m SemanticClassificationType.Field + | Item.ArgName _, _, m -> add m SemanticClassificationType.NamedArgument - | Item.Event _, _, m -> - add m SemanticClassificationType.Event + | Item.SetterArg _, _, m -> add m SemanticClassificationType.NamedArgument - | Item.ArgName _, _, m -> - add m SemanticClassificationType.NamedArgument + | Item.SetterArg _, _, m -> add m SemanticClassificationType.Property - | Item.SetterArg _, _, m -> - add m SemanticClassificationType.NamedArgument + | Item.UnqualifiedType (tcref :: _), LegitTypeOccurence, m -> + if tcref.IsEnumTycon || tcref.IsILEnumTycon then + add m SemanticClassificationType.Enumeration + elif tcref.IsFSharpException then + add m SemanticClassificationType.Exception + elif tcref.IsFSharpDelegateTycon then + add m SemanticClassificationType.Delegate + elif tcref.IsFSharpInterfaceTycon then + add m SemanticClassificationType.Interface + elif tcref.IsFSharpStructOrEnumTycon then + add m SemanticClassificationType.ValueType + elif tcref.IsModule then + add m SemanticClassificationType.Module + elif tcref.IsNamespace then + add m SemanticClassificationType.Namespace + elif tcref.IsUnionTycon || tcref.IsRecordTycon then + if isStructTyconRef tcref then + add m SemanticClassificationType.ValueType + else + add m SemanticClassificationType.UnionCase + elif tcref.IsILTycon then + let (TILObjectReprData (_, _, tydef)) = tcref.ILTyconInfo + + if tydef.IsInterface then + add m SemanticClassificationType.Interface + elif tydef.IsDelegate then + add m SemanticClassificationType.Delegate + elif tydef.IsEnum then + add m SemanticClassificationType.Enumeration + elif tydef.IsStruct then + add m SemanticClassificationType.ValueType + else + add m SemanticClassificationType.ReferenceType - | Item.SetterArg _, _, m -> - add m SemanticClassificationType.Property + | _, _, m -> add m SemanticClassificationType.Plaintext) - | Item.UnqualifiedType (tcref :: _), LegitTypeOccurence, m -> - if tcref.IsEnumTycon || tcref.IsILEnumTycon then - add m SemanticClassificationType.Enumeration - elif tcref.IsFSharpException then - add m SemanticClassificationType.Exception - elif tcref.IsFSharpDelegateTycon then - add m SemanticClassificationType.Delegate - elif tcref.IsFSharpInterfaceTycon then - add m SemanticClassificationType.Interface - elif tcref.IsFSharpStructOrEnumTycon then - add m SemanticClassificationType.ValueType - elif tcref.IsModule then - add m SemanticClassificationType.Module - elif tcref.IsNamespace then - add m SemanticClassificationType.Namespace - elif tcref.IsUnionTycon || tcref.IsRecordTycon then - if isStructTyconRef tcref then - add m SemanticClassificationType.ValueType - else - add m SemanticClassificationType.UnionCase - elif tcref.IsILTycon then - let (TILObjectReprData (_, _, tydef)) = tcref.ILTyconInfo + let locs = + formatSpecifierLocations + |> Array.map (fun (m, _) -> SemanticClassificationItem((m, SemanticClassificationType.Printf))) - if tydef.IsInterface then - add m SemanticClassificationType.Interface - elif tydef.IsDelegate then - add m SemanticClassificationType.Delegate - elif tydef.IsEnum then - add m SemanticClassificationType.Enumeration - elif tydef.IsStruct then - add m SemanticClassificationType.ValueType - else - add m SemanticClassificationType.ReferenceType - - | _, _, m -> - add m SemanticClassificationType.Plaintext) - - let locs = formatSpecifierLocations |> Array.map (fun (m, _) -> SemanticClassificationItem((m, SemanticClassificationType.Printf))) - results.AddRange(locs) - results.ToArray() - ) - (fun msg -> - Trace.TraceInformation(sprintf "FCS: recovering from error in GetSemanticClassification: '%s'" msg) - Array.empty) \ No newline at end of file + results.AddRange(locs) + results.ToArray()) + (fun msg -> + Trace.TraceInformation(sprintf "FCS: recovering from error in GetSemanticClassification: '%s'" msg) + Array.empty) diff --git a/src/Compiler/Service/SemanticClassificationKey.fs b/src/Compiler/Service/SemanticClassificationKey.fs index 153c33a5e7ac..c6b1279e7623 100644 --- a/src/Compiler/Service/SemanticClassificationKey.fs +++ b/src/Compiler/Service/SemanticClassificationKey.fs @@ -22,9 +22,12 @@ type SemanticClassificationView(mmf: MemoryMappedFile, length) = member this.ForEach(f: SemanticClassificationItem -> unit) = use view = mmf.CreateViewAccessor(0L, length) - let mutable reader = BlobReader(view.SafeMemoryMappedViewHandle.DangerousGetHandle() |> NativePtr.ofNativeInt, int length) + + let mutable reader = + BlobReader(view.SafeMemoryMappedViewHandle.DangerousGetHandle() |> NativePtr.ofNativeInt, int length) reader.Offset <- 0 + while reader.Offset < reader.Length do let item = this.ReadItem(&reader) f item @@ -32,32 +35,34 @@ type SemanticClassificationView(mmf: MemoryMappedFile, length) = [] type SemanticClassificationKeyStore(mmf: MemoryMappedFile, length) = let mutable isDisposed = false - let checkDispose() = + + let checkDispose () = if isDisposed then raise (ObjectDisposedException("SemanticClassificationKeyStore")) member _.GetView() = - checkDispose() + checkDispose () SemanticClassificationView(mmf, length) interface IDisposable with - member _.Dispose() = - isDisposed <- true - mmf.Dispose() + member _.Dispose() = + isDisposed <- true + mmf.Dispose() [] type SemanticClassificationKeyStoreBuilder() = let b = BlobBuilder() - member _.WriteAll (semanticClassification: SemanticClassificationItem[]) = + member _.WriteAll(semanticClassification: SemanticClassificationItem[]) = use ptr = fixed semanticClassification b.WriteBytes(NativePtr.ofNativeInt (NativePtr.toNativeInt ptr), semanticClassification.Length * sizeof) member _.TryBuildAndReset() = if b.Count > 0 then let length = int64 b.Count + let mmf = let mmf = MemoryMappedFile.CreateNew( @@ -65,7 +70,9 @@ type SemanticClassificationKeyStoreBuilder() = length, MemoryMappedFileAccess.ReadWrite, MemoryMappedFileOptions.None, - HandleInheritability.None) + HandleInheritability.None + ) + use stream = mmf.CreateViewStream(0L, length, MemoryMappedFileAccess.ReadWrite) b.WriteContentTo stream mmf diff --git a/src/Compiler/Service/ServiceAnalysis.fs b/src/Compiler/Service/ServiceAnalysis.fs index 976431ecb4ac..09e3545e8adf 100644 --- a/src/Compiler/Service/ServiceAnalysis.fs +++ b/src/Compiler/Service/ServiceAnalysis.fs @@ -13,73 +13,83 @@ open FSharp.Compiler.Text.Range module UnusedOpens = - let symbolHash = HashIdentity.FromFunctions (fun (x: FSharpSymbol) -> x.GetEffectivelySameAsHash()) (fun x y -> x.IsEffectivelySameAs(y)) + let symbolHash = + HashIdentity.FromFunctions (fun (x: FSharpSymbol) -> x.GetEffectivelySameAsHash()) (fun x y -> x.IsEffectivelySameAs(y)) /// Represents one namespace or module opened by an 'open' statement - type OpenedModule(entity: FSharpEntity, isNestedAutoOpen: bool) = + type OpenedModule(entity: FSharpEntity, isNestedAutoOpen: bool) = /// Compute an indexed table of the set of symbols revealed by 'open', on-demand - let revealedSymbols : Lazy> = - lazy - let symbols : FSharpSymbol[] = - [| for ent in entity.NestedEntities do - ent - - if ent.IsFSharpRecord then - for rf in ent.FSharpFields do - rf - - if ent.IsFSharpUnion && not (ent.HasAttribute()) then - for unionCase in ent.UnionCases do - unionCase - - if ent.HasAttribute() then - for fv in ent.MembersFunctionsAndValues do - // fv.IsExtensionMember is always false for C# extension methods returning by `MembersFunctionsAndValues`, - // so we have to check Extension attribute instead. - // (note: fv.IsExtensionMember has proper value for symbols returning by GetAllUsesOfAllSymbolsInFile though) - if fv.HasAttribute() then - fv - - for apCase in entity.ActivePatternCases do - apCase - - // The IsNamespace and IsFSharpModule cases are handled by looking at DeclaringEntity below - if not entity.IsNamespace && not entity.IsFSharpModule then - for fv in entity.MembersFunctionsAndValues do - fv |] - - HashSet<_>(symbols, symbolHash) + let revealedSymbols: Lazy> = + lazy + let symbols: FSharpSymbol[] = + [| + for ent in entity.NestedEntities do + ent + + if ent.IsFSharpRecord then + for rf in ent.FSharpFields do + rf + + if ent.IsFSharpUnion && not (ent.HasAttribute()) then + for unionCase in ent.UnionCases do + unionCase + + if ent.HasAttribute() then + for fv in ent.MembersFunctionsAndValues do + // fv.IsExtensionMember is always false for C# extension methods returning by `MembersFunctionsAndValues`, + // so we have to check Extension attribute instead. + // (note: fv.IsExtensionMember has proper value for symbols returning by GetAllUsesOfAllSymbolsInFile though) + if fv.HasAttribute() then fv + + for apCase in entity.ActivePatternCases do + apCase + + // The IsNamespace and IsFSharpModule cases are handled by looking at DeclaringEntity below + if not entity.IsNamespace && not entity.IsFSharpModule then + for fv in entity.MembersFunctionsAndValues do + fv + |] + + HashSet<_>(symbols, symbolHash) member _.Entity = entity member _.IsNestedAutoOpen = isNestedAutoOpen member _.RevealedSymbolsContains(symbol) = revealedSymbols.Force().Contains symbol - type OpenedModuleGroup = - { OpenedModules: OpenedModule [] } - - static member Create (modul: FSharpEntity) = + type OpenedModuleGroup = + { + OpenedModules: OpenedModule[] + } + + static member Create(modul: FSharpEntity) = let rec getModuleAndItsAutoOpens (isNestedAutoOpen: bool) (modul: FSharpEntity) = [| - yield OpenedModule (modul, isNestedAutoOpen) + yield OpenedModule(modul, isNestedAutoOpen) for ent in modul.NestedEntities do if ent.IsFSharpModule && ent.HasAttribute() then - yield! getModuleAndItsAutoOpens true ent |] - { OpenedModules = getModuleAndItsAutoOpens false modul } + yield! getModuleAndItsAutoOpens true ent + |] + + { + OpenedModules = getModuleAndItsAutoOpens false modul + } /// Represents a single open statement type OpenStatement = - { /// All namespaces, modules and types which this open declaration effectively opens, including the AutoOpen ones - OpenedGroups: OpenedModuleGroup list + { + /// All namespaces, modules and types which this open declaration effectively opens, including the AutoOpen ones + OpenedGroups: OpenedModuleGroup list - /// The range of open statement itself - Range: range + /// The range of open statement itself + Range: range - /// The scope on which this open declaration is applied - AppliedScope: range } + /// The scope on which this open declaration is applied + AppliedScope: range + } /// Gets the open statements, their scopes and their resolutions - let getOpenStatements (openDeclarations: FSharpOpenDeclaration[]) : OpenStatement[] = + let getOpenStatements (openDeclarations: FSharpOpenDeclaration[]) : OpenStatement[] = openDeclarations |> Array.choose (fun openDecl -> if openDecl.IsOwnNamespace then @@ -87,59 +97,65 @@ module UnusedOpens = else match openDecl.LongId, openDecl.Range with | firstId :: _, Some range -> - if firstId.idText = MangledGlobalName then + if firstId.idText = MangledGlobalName then None else - let openedModulesAndTypes = List.concat [openDecl.Modules; openDecl.Types |> List.map(fun ty -> ty.TypeDefinition)] - Some { OpenedGroups = openedModulesAndTypes |> List.map OpenedModuleGroup.Create - Range = range - AppliedScope = openDecl.AppliedScope } + let openedModulesAndTypes = + List.concat [ openDecl.Modules; openDecl.Types |> List.map (fun ty -> ty.TypeDefinition) ] + + Some + { + OpenedGroups = openedModulesAndTypes |> List.map OpenedModuleGroup.Create + Range = range + AppliedScope = openDecl.AppliedScope + } | _ -> None) /// Only consider symbol uses which are the first part of a long ident, i.e. with no qualifying identifiers let filterSymbolUses (getSourceLineStr: int -> string) (symbolUses: seq) = symbolUses - |> Seq.filter(fun (su: FSharpSymbolUse) -> + |> Seq.filter (fun (su: FSharpSymbolUse) -> match su.Symbol with - | :? FSharpMemberOrFunctionOrValue as fv when fv.IsExtensionMember -> + | :? FSharpMemberOrFunctionOrValue as fv when fv.IsExtensionMember -> // Extension members should be taken into account even though they have a prefix (as they do most of the time) true - | :? FSharpMemberOrFunctionOrValue as fv when not fv.IsModuleValueOrMember -> + | :? FSharpMemberOrFunctionOrValue as fv when not fv.IsModuleValueOrMember -> // Local values can be ignored false - | :? FSharpMemberOrFunctionOrValue when su.IsFromDefinition -> + | :? FSharpMemberOrFunctionOrValue when su.IsFromDefinition -> // Value definitions should be ignored false - | :? FSharpGenericParameter -> + | :? FSharpGenericParameter -> // Generic parameters can be ignored, they never come into scope via 'open' false - | :? FSharpUnionCase when su.IsFromDefinition -> - false + | :? FSharpUnionCase when su.IsFromDefinition -> false - | :? FSharpField as field when - field.DeclaringEntity.IsSome && field.DeclaringEntity.Value.IsFSharpRecord -> + | :? FSharpField as field when field.DeclaringEntity.IsSome && field.DeclaringEntity.Value.IsFSharpRecord -> // Record fields are used in name resolution true - | :? FSharpField as field when field.IsUnionCaseField -> - false + | :? FSharpField as field when field.IsUnionCaseField -> false | _ -> // For the rest of symbols we pick only those which are the first part of a long ident, because it's they which are // contained in opened namespaces / modules. For example, we pick `IO` from long ident `IO.File.OpenWrite` because // it's `open System` which really brings it into scope. - let partialName = QuickParse.GetPartialLongNameEx (getSourceLineStr su.Range.StartLine, su.Range.EndColumn - 1) + let partialName = + QuickParse.GetPartialLongNameEx(getSourceLineStr su.Range.StartLine, su.Range.EndColumn - 1) + List.isEmpty partialName.QualifyingIdents) |> Array.ofSeq /// Split symbol uses into cases that are easy to handle (via DeclaringEntity) and those that don't have a good DeclaringEntity - let splitSymbolUses (symbolUses: FSharpSymbolUse[]) = - symbolUses |> Array.partition (fun symbolUse -> + let splitSymbolUses (symbolUses: FSharpSymbolUse[]) = + symbolUses + |> Array.partition (fun symbolUse -> let symbol = symbolUse.Symbol + match symbol with | :? FSharpMemberOrFunctionOrValue as f -> match f.DeclaringEntity with @@ -151,79 +167,126 @@ module UnusedOpens = /// in the scope of the 'open' is from that module. /// /// Performance will be roughly NumberOfOpenStatements x NumberOfSymbolUses - let isOpenStatementUsed (symbolUses2: FSharpSymbolUse[]) (symbolUsesRangesByDeclaringEntity: Dictionary) - (usedModules: Dictionary) (openStatement: OpenStatement) = + let isOpenStatementUsed + (symbolUses2: FSharpSymbolUse[]) + (symbolUsesRangesByDeclaringEntity: Dictionary) + (usedModules: Dictionary) + (openStatement: OpenStatement) + = // Don't re-check modules whose symbols are already known to have been used let openedGroupsToExamine = - openStatement.OpenedGroups |> List.choose (fun openedGroup -> + openStatement.OpenedGroups + |> List.choose (fun openedGroup -> let openedEntitiesToExamine = - openedGroup.OpenedModules + openedGroup.OpenedModules |> Array.filter (fun openedEntity -> - not (usedModules.BagExistsValueForKey(openedEntity.Entity, fun scope -> rangeContainsRange scope openStatement.AppliedScope))) - + not ( + usedModules.BagExistsValueForKey( + openedEntity.Entity, + fun scope -> rangeContainsRange scope openStatement.AppliedScope + ) + )) + match openedEntitiesToExamine with | [||] -> None - | _ when openedEntitiesToExamine |> Array.exists (fun x -> not x.IsNestedAutoOpen) -> Some { OpenedModules = openedEntitiesToExamine } + | _ when openedEntitiesToExamine |> Array.exists (fun x -> not x.IsNestedAutoOpen) -> + Some + { + OpenedModules = openedEntitiesToExamine + } | _ -> None) // Find the opened groups that are used by some symbol use - let newlyUsedOpenedGroups = - openedGroupsToExamine |> List.filter (fun openedGroup -> - openedGroup.OpenedModules |> Array.exists (fun openedEntity -> - symbolUsesRangesByDeclaringEntity.BagExistsValueForKey(openedEntity.Entity, fun symbolUseRange -> - rangeContainsRange openStatement.AppliedScope symbolUseRange && - Position.posGt symbolUseRange.Start openStatement.Range.End) || - - symbolUses2 |> Array.exists (fun symbolUse -> - rangeContainsRange openStatement.AppliedScope symbolUse.Range && - Position.posGt symbolUse.Range.Start openStatement.Range.End && - openedEntity.RevealedSymbolsContains symbolUse.Symbol))) + let newlyUsedOpenedGroups = + openedGroupsToExamine + |> List.filter (fun openedGroup -> + openedGroup.OpenedModules + |> Array.exists (fun openedEntity -> + symbolUsesRangesByDeclaringEntity.BagExistsValueForKey( + openedEntity.Entity, + fun symbolUseRange -> + rangeContainsRange openStatement.AppliedScope symbolUseRange + && Position.posGt symbolUseRange.Start openStatement.Range.End + ) + || + + symbolUses2 + |> Array.exists (fun symbolUse -> + rangeContainsRange openStatement.AppliedScope symbolUse.Range + && Position.posGt symbolUse.Range.Start openStatement.Range.End + && openedEntity.RevealedSymbolsContains symbolUse.Symbol))) // Return them as interim used entities - let newlyOpenedModules = newlyUsedOpenedGroups |> List.collect (fun openedGroup -> openedGroup.OpenedModules |> List.ofArray) + let newlyOpenedModules = + newlyUsedOpenedGroups + |> List.collect (fun openedGroup -> openedGroup.OpenedModules |> List.ofArray) + for openedModule in newlyOpenedModules do let scopes = match usedModules.TryGetValue openedModule.Entity with | true, scopes -> openStatement.AppliedScope :: scopes - | _ -> [openStatement.AppliedScope] + | _ -> [ openStatement.AppliedScope ] + usedModules[openedModule.Entity] <- scopes + not newlyOpenedModules.IsEmpty - + /// Incrementally filter out the open statements one by one. Filter those whose contents are referred to somewhere in the symbol uses. /// Async to allow cancellation. - let rec filterOpenStatementsIncremental symbolUses2 (symbolUsesRangesByDeclaringEntity: Dictionary) (openStatements: OpenStatement list) - (usedModules: Dictionary) acc = - async { + let rec filterOpenStatementsIncremental + symbolUses2 + (symbolUsesRangesByDeclaringEntity: Dictionary) + (openStatements: OpenStatement list) + (usedModules: Dictionary) + acc + = + async { match openStatements with | openStatement :: rest -> if isOpenStatementUsed symbolUses2 symbolUsesRangesByDeclaringEntity usedModules openStatement then return! filterOpenStatementsIncremental symbolUses2 symbolUsesRangesByDeclaringEntity rest usedModules acc else // The open statement has not been used, include it in the results - return! filterOpenStatementsIncremental symbolUses2 symbolUsesRangesByDeclaringEntity rest usedModules (openStatement :: acc) + return! + filterOpenStatementsIncremental + symbolUses2 + symbolUsesRangesByDeclaringEntity + rest + usedModules + (openStatement :: acc) | [] -> return List.rev acc } - let entityHash = HashIdentity.FromFunctions (fun (x: FSharpEntity) -> x.GetEffectivelySameAsHash()) (fun x y -> x.IsEffectivelySameAs(y)) + let entityHash = + HashIdentity.FromFunctions (fun (x: FSharpEntity) -> x.GetEffectivelySameAsHash()) (fun x y -> x.IsEffectivelySameAs(y)) /// Filter out the open statements whose contents are referred to somewhere in the symbol uses. /// Async to allow cancellation. let filterOpenStatements (symbolUses1: FSharpSymbolUse[], symbolUses2: FSharpSymbolUse[]) openStatements = async { - // the key is a namespace or module, the value is a list of FSharpSymbolUse range of symbols defined in the - // namespace or module. So, it's just symbol uses ranges grouped by namespace or module where they are _defined_. - let symbolUsesRangesByDeclaringEntity = Dictionary(entityHash) + // the key is a namespace or module, the value is a list of FSharpSymbolUse range of symbols defined in the + // namespace or module. So, it's just symbol uses ranges grouped by namespace or module where they are _defined_. + let symbolUsesRangesByDeclaringEntity = + Dictionary(entityHash) + for symbolUse in symbolUses1 do match symbolUse.Symbol with | :? FSharpMemberOrFunctionOrValue as f -> match f.DeclaringEntity with - | Some entity when entity.IsNamespace || entity.IsFSharpModule -> + | Some entity when entity.IsNamespace || entity.IsFSharpModule -> symbolUsesRangesByDeclaringEntity.BagAdd(entity, symbolUse.Range) | _ -> () | _ -> () - let! results = filterOpenStatementsIncremental symbolUses2 symbolUsesRangesByDeclaringEntity (List.ofArray openStatements) (Dictionary(entityHash)) [] + let! results = + filterOpenStatementsIncremental + symbolUses2 + symbolUsesRangesByDeclaringEntity + (List.ofArray openStatements) + (Dictionary(entityHash)) + [] + return results |> List.map (fun os -> os.Range) } @@ -238,20 +301,18 @@ module UnusedOpens = let openStatements = getOpenStatements checkFileResults.OpenDeclarations return! filterOpenStatements symbolUses openStatements } - -module SimplifyNames = - type SimplifiableRange = - { - Range: range - RelativeName: string - } - let getPlidLength (plid: string list) = (plid |> List.sumBy String.length) + plid.Length +module SimplifyNames = + type SimplifiableRange = { Range: range; RelativeName: string } + + let getPlidLength (plid: string list) = + (plid |> List.sumBy String.length) + plid.Length let getSimplifiableNames (checkFileResults: FSharpCheckFileResults, getSourceLineStr: int -> string) = async { let result = ResizeArray() let! ct = Async.CancellationToken + let symbolUses = checkFileResults.GetAllUsesOfAllSymbolsInFile(ct) |> Seq.choose (fun symbolUse -> @@ -260,63 +321,94 @@ module SimplifyNames = else let lineStr = getSourceLineStr symbolUse.Range.StartLine // for `System.DateTime.Now` it returns ([|"System"; "DateTime"|], "Now") - let partialName = QuickParse.GetPartialLongNameEx(lineStr, symbolUse.Range.EndColumn - 1) + let partialName = + QuickParse.GetPartialLongNameEx(lineStr, symbolUse.Range.EndColumn - 1) // `symbolUse.Range.Start` does not point to the start of plid, it points to start of `name`, // so we have to calculate plid's start ourselves. - let plidStartCol = symbolUse.Range.EndColumn - partialName.PartialIdent.Length - (getPlidLength partialName.QualifyingIdents) + let plidStartCol = + symbolUse.Range.EndColumn + - partialName.PartialIdent.Length + - (getPlidLength partialName.QualifyingIdents) + if partialName.PartialIdent = "" || List.isEmpty partialName.QualifyingIdents then None else - Some (symbolUse, partialName.QualifyingIdents, plidStartCol, partialName.PartialIdent)) + Some(symbolUse, partialName.QualifyingIdents, plidStartCol, partialName.PartialIdent)) |> Seq.groupBy (fun (symbolUse, _, plidStartCol, _) -> symbolUse.Range.StartLine, plidStartCol) |> Seq.map (fun (_, xs) -> xs |> Seq.maxBy (fun (symbolUse, _, _, _) -> symbolUse.Range.EndColumn)) for symbolUse, plid, plidStartCol, name in symbolUses do let posAtStartOfName = let r = symbolUse.Range - if r.StartLine = r.EndLine then Position.mkPos r.StartLine (r.EndColumn - name.Length) - else r.Start + + if r.StartLine = r.EndLine then + Position.mkPos r.StartLine (r.EndColumn - name.Length) + else + r.Start let getNecessaryPlid (plid: string list) : string list = let rec loop (rest: string list) (current: string list) = match rest with | [] -> current | headIdent :: restPlid -> - let res = checkFileResults.IsRelativeNameResolvableFromSymbol(posAtStartOfName, current, symbolUse.Symbol) - if res then current - else loop restPlid (headIdent :: current) + let res = + checkFileResults.IsRelativeNameResolvableFromSymbol(posAtStartOfName, current, symbolUse.Symbol) + + if res then + current + else + loop restPlid (headIdent :: current) + loop (List.rev plid) [] - - let necessaryPlid = getNecessaryPlid plid - + + let necessaryPlid = getNecessaryPlid plid + match necessaryPlid with | necessaryPlid when necessaryPlid = plid -> () | necessaryPlid -> let r = symbolUse.Range - let necessaryPlidStartCol = r.EndColumn - name.Length - (getPlidLength necessaryPlid) - - let unnecessaryRange = + + let necessaryPlidStartCol = + r.EndColumn - name.Length - (getPlidLength necessaryPlid) + + let unnecessaryRange = mkRange r.FileName (Position.mkPos r.StartLine plidStartCol) (Position.mkPos r.EndLine necessaryPlidStartCol) - + let relativeName = (String.concat "." plid) + "." + name - result.Add({Range = unnecessaryRange; RelativeName = relativeName}) + + result.Add( + { + Range = unnecessaryRange + RelativeName = relativeName + } + ) return (result :> seq<_>) } -module UnusedDeclarations = +module UnusedDeclarations = let isPotentiallyUnusedDeclaration (symbol: FSharpSymbol) : bool = match symbol with // Determining that a record, DU or module is used anywhere requires inspecting all their enclosed entities (fields, cases and func / vals) // for usages, which is too expensive to do. Hence we never gray them out. - | :? FSharpEntity as e when e.IsFSharpRecord || e.IsFSharpUnion || e.IsInterface || e.IsFSharpModule || e.IsClass || e.IsNamespace -> false + | :? FSharpEntity as e when + e.IsFSharpRecord + || e.IsFSharpUnion + || e.IsInterface + || e.IsFSharpModule + || e.IsClass + || e.IsNamespace + -> + false // FCS returns inconsistent results for override members; we're skipping these symbols. - | :? FSharpMemberOrFunctionOrValue as f when - f.IsOverrideOrExplicitInterfaceImplementation || - f.IsBaseValue || - f.IsConstructor -> false + | :? FSharpMemberOrFunctionOrValue as f when + f.IsOverrideOrExplicitInterfaceImplementation + || f.IsBaseValue + || f.IsConstructor + -> + false // Usage of DU case parameters does not give any meaningful feedback; we never gray them out. | :? FSharpParameter -> false @@ -324,31 +416,35 @@ module UnusedDeclarations = let getUnusedDeclarationRanges (symbolsUses: seq) (isScript: bool) = let usages = - let usages = + let usages = symbolsUses - |> Seq.choose (fun su -> if not su.IsFromDefinition then su.Symbol.DeclarationLocation else None) + |> Seq.choose (fun su -> + if not su.IsFromDefinition then + su.Symbol.DeclarationLocation + else + None) + HashSet(usages) symbolsUses |> Seq.distinctBy (fun su -> su.Range) // Account for "hidden" uses, like a val in a member val definition. These aren't relevant - |> Seq.choose(fun (su: FSharpSymbolUse) -> - if su.IsFromDefinition && - su.Symbol.DeclarationLocation.IsSome && - (isScript || su.IsPrivateToFile) && - not (su.Symbol.DisplayName.StartsWith "_") && - isPotentiallyUnusedDeclaration su.Symbol - then - Some (su, usages.Contains su.Symbol.DeclarationLocation.Value) + |> Seq.choose (fun (su: FSharpSymbolUse) -> + if su.IsFromDefinition + && su.Symbol.DeclarationLocation.IsSome + && (isScript || su.IsPrivateToFile) + && not (su.Symbol.DisplayName.StartsWith "_") + && isPotentiallyUnusedDeclaration su.Symbol then + Some(su, usages.Contains su.Symbol.DeclarationLocation.Value) else None) |> Seq.groupBy (fun (defSu, _) -> defSu.Range) |> Seq.filter (fun (_, defSus) -> defSus |> Seq.forall (fun (_, isUsed) -> not isUsed)) |> Seq.map (fun (m, _) -> m) - - let getUnusedDeclarations(checkFileResults: FSharpCheckFileResults, isScriptFile: bool) = + + let getUnusedDeclarations (checkFileResults: FSharpCheckFileResults, isScriptFile: bool) = async { let! ct = Async.CancellationToken let allSymbolUsesInFile = checkFileResults.GetAllUsesOfAllSymbolsInFile(ct) let unusedRanges = getUnusedDeclarationRanges allSymbolUsesInFile isScriptFile return unusedRanges - } \ No newline at end of file + } diff --git a/src/Compiler/Service/ServiceCompilerDiagnostics.fs b/src/Compiler/Service/ServiceCompilerDiagnostics.fs index dcfed4262522..bc54a3f5f754 100644 --- a/src/Compiler/Service/ServiceCompilerDiagnostics.fs +++ b/src/Compiler/Service/ServiceCompilerDiagnostics.fs @@ -7,20 +7,21 @@ open FSharp.Compiler.DiagnosticResolutionHints [] type FSharpDiagnosticKind = | AddIndexerDot - | ReplaceWithSuggestion of suggestion:string + | ReplaceWithSuggestion of suggestion: string [] module CompilerDiagnostics = let GetErrorMessage diagnosticKind = match diagnosticKind with - | FSharpDiagnosticKind.AddIndexerDot -> FSComp.SR.addIndexerDot() - | FSharpDiagnosticKind.ReplaceWithSuggestion s -> FSComp.SR.replaceWithSuggestion(s) + | FSharpDiagnosticKind.AddIndexerDot -> FSComp.SR.addIndexerDot () + | FSharpDiagnosticKind.ReplaceWithSuggestion s -> FSComp.SR.replaceWithSuggestion (s) let GetSuggestedNames (suggestionsF: FSharp.Compiler.DiagnosticsLogger.Suggestions) (unresolvedIdentifier: string) = let buffer = SuggestionBuffer(unresolvedIdentifier) + if buffer.Disabled then Seq.empty else suggestionsF buffer.Add - buffer :> seq \ No newline at end of file + buffer :> seq diff --git a/src/Compiler/Service/ServiceConstants.fs b/src/Compiler/Service/ServiceConstants.fs index 97b6a16d228e..5a1e180d4403 100644 --- a/src/Compiler/Service/ServiceConstants.fs +++ b/src/Compiler/Service/ServiceConstants.fs @@ -25,4 +25,4 @@ type FSharpGlyph = | Variable | ExtensionMethod | Error - | TypeParameter \ No newline at end of file + | TypeParameter diff --git a/src/Compiler/Service/ServiceInterfaceStubGenerator.fs b/src/Compiler/Service/ServiceInterfaceStubGenerator.fs index 5e0c82560186..e54f5922bc9d 100644 --- a/src/Compiler/Service/ServiceInterfaceStubGenerator.fs +++ b/src/Compiler/Service/ServiceInterfaceStubGenerator.fs @@ -4,7 +4,7 @@ namespace FSharp.Compiler.EditorServices open System open System.Diagnostics -open Internal.Utilities.Library +open Internal.Utilities.Library open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Symbols open FSharp.Compiler.Syntax @@ -22,30 +22,25 @@ module internal CodeGenerationUtils = let stringWriter = new StringWriter() let indentWriter = new IndentedTextWriter(stringWriter, " ") - member _.Write(s: string) = - indentWriter.Write("{0}", s) + member _.Write(s: string) = indentWriter.Write("{0}", s) - member _.Write(s: string, [] objs: obj []) = - indentWriter.Write(s, objs) + member _.Write(s: string, [] objs: obj[]) = indentWriter.Write(s, objs) - member _.WriteLine(s: string) = - indentWriter.WriteLine("{0}", s) + member _.WriteLine(s: string) = indentWriter.WriteLine("{0}", s) - member _.WriteLine(s: string, [] objs: obj []) = - indentWriter.WriteLine(s, objs) + member _.WriteLine(s: string, [] objs: obj[]) = indentWriter.WriteLine(s, objs) member x.WriteBlankLines count = for _ in 0 .. count - 1 do x.WriteLine "" - member _.Indent i = + member _.Indent i = indentWriter.Indent <- indentWriter.Indent + i - member _.Unindent i = + member _.Unindent i = indentWriter.Indent <- max 0 (indentWriter.Indent - i) - member _.Dump() = - indentWriter.InnerWriter.ToString() + member _.Dump() = indentWriter.InnerWriter.ToString() interface IDisposable with member _.Dispose() = @@ -53,11 +48,10 @@ module internal CodeGenerationUtils = indentWriter.Dispose() /// 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] + let rec (|Sequentials|_|) = + function + | SynExpr.Sequential (_, _, e, Sequentials es, _) -> Some(e :: es) + | SynExpr.Sequential (_, _, e1, e2, _) -> Some [ e1; e2 ] | _ -> None /// Represent environment where a captured identifier should be renamed @@ -72,25 +66,32 @@ module internal CodeGenerationUtils = | _ -> let nm = String.lowerCaseFirstChar nm let nm, index = String.extractTrailingIndex nm - + let index, namesWithIndices = match namesWithIndices |> Map.tryFind nm, index with | Some indexes, index -> let rec getAvailableIndex idx = - if indexes |> Set.contains idx then + if indexes |> Set.contains idx then getAvailableIndex (idx + 1) - else idx + else + idx + let index = index |> Option.defaultValue 1 |> getAvailableIndex Some index, namesWithIndices |> Map.add nm (indexes |> Set.add index) - | None, Some index -> Some index, namesWithIndices |> Map.add nm (Set.ofList [index]) + | None, Some index -> Some index, namesWithIndices |> Map.add nm (Set.ofList [ index ]) | None, None -> None, namesWithIndices |> Map.add nm Set.empty - let nm = + let nm = match index with | Some index -> sprintf "%s%d" nm index | None -> nm - - let nm = if Set.contains nm keywordSet then sprintf "``%s``" nm else nm + + let nm = + if Set.contains nm keywordSet then + sprintf "``%s``" nm + else + nm + nm, namesWithIndices /// Capture information about an interface in ASTs @@ -101,69 +102,56 @@ type InterfaceData = member x.Range = match x with - | InterfaceData.Interface(ty, _) -> - ty.Range - | InterfaceData.ObjExpr(ty, _) -> - ty.Range + | InterfaceData.Interface (ty, _) -> ty.Range + | InterfaceData.ObjExpr (ty, _) -> ty.Range - member x.TypeParameters = + member x.TypeParameters = match x with - | InterfaceData.Interface(StripParenTypes ty, _) - | InterfaceData.ObjExpr(StripParenTypes ty, _) -> - let rec (|RationalConst|) = function - | SynRationalConst.Integer i -> - string i - | SynRationalConst.Rational(numerator, denominator, _) -> - sprintf "(%i/%i)" numerator denominator - | SynRationalConst.Negate (RationalConst s) -> - sprintf "- %s" s - - let rec (|TypeIdent|_|) = function - | SynType.Var(SynTypar(s, req, _), _) -> + | InterfaceData.Interface (StripParenTypes ty, _) + | InterfaceData.ObjExpr (StripParenTypes ty, _) -> + let rec (|RationalConst|) = + function + | SynRationalConst.Integer i -> string i + | SynRationalConst.Rational (numerator, denominator, _) -> sprintf "(%i/%i)" numerator denominator + | SynRationalConst.Negate (RationalConst s) -> sprintf "- %s" s + + let rec (|TypeIdent|_|) = + function + | SynType.Var (SynTypar (s, req, _), _) -> match req with - | TyparStaticReq.None -> - Some ("'" + s.idText) - | TyparStaticReq.HeadType -> - Some ("^" + s.idText) - | SynType.LongIdent(SynLongIdent(xs, _, _)) -> - xs |> Seq.map (fun x -> x.idText) |> String.concat "." |> Some - | SynType.App(t, _, ts, _, _, isPostfix, _) -> + | TyparStaticReq.None -> Some("'" + s.idText) + | TyparStaticReq.HeadType -> Some("^" + s.idText) + | SynType.LongIdent (SynLongIdent (xs, _, _)) -> xs |> Seq.map (fun x -> x.idText) |> String.concat "." |> Some + | SynType.App (t, _, ts, _, _, isPostfix, _) -> match t, ts with | TypeIdent typeName, [] -> Some typeName - | TypeIdent typeName, [TypeIdent typeArg] -> - if isPostfix then - Some (sprintf "%s %s" typeArg typeName) + | TypeIdent typeName, [ TypeIdent typeArg ] -> + if isPostfix then + Some(sprintf "%s %s" typeArg typeName) else - Some (sprintf "%s<%s>" typeName typeArg) - | TypeIdent typeName, _ -> + Some(sprintf "%s<%s>" typeName typeArg) + | TypeIdent typeName, _ -> let typeArgs = ts |> Seq.choose (|TypeIdent|_|) |> String.concat ", " - if isPostfix then - Some (sprintf "(%s) %s" typeArgs typeName) + + if isPostfix then + Some(sprintf "(%s) %s" typeArgs typeName) else Some(sprintf "%s<%s>" typeName typeArgs) | _ -> //debug "Unsupported case with %A and %A" t ts None - | SynType.Anon _ -> - Some "_" - | SynType.AnonRecd (_, ts, _) -> - Some (ts |> Seq.choose (snd >> (|TypeIdent|_|)) |> String.concat "; ") - | SynType.Array(dimension, TypeIdent typeName, _) -> - Some (sprintf "%s [%s]" typeName (String(',', dimension-1))) - | SynType.MeasurePower(TypeIdent typeName, RationalConst power, _) -> - Some (sprintf "%s^%s" typeName power) - | SynType.MeasureDivide(TypeIdent numerator, TypeIdent denominator, _) -> - Some (sprintf "%s/%s" numerator denominator) - | SynType.Paren(TypeIdent typeName, _) -> - Some typeName - | _ -> - None + | SynType.Anon _ -> Some "_" + | SynType.AnonRecd (_, ts, _) -> Some(ts |> Seq.choose (snd >> (|TypeIdent|_|)) |> String.concat "; ") + | SynType.Array (dimension, TypeIdent typeName, _) -> Some(sprintf "%s [%s]" typeName (String(',', dimension - 1))) + | SynType.MeasurePower (TypeIdent typeName, RationalConst power, _) -> Some(sprintf "%s^%s" typeName power) + | SynType.MeasureDivide (TypeIdent numerator, TypeIdent denominator, _) -> Some(sprintf "%s/%s" numerator denominator) + | SynType.Paren (TypeIdent typeName, _) -> Some typeName + | _ -> None + match ty with - | SynType.App(_, _, ts, _, _, _, _) - | SynType.LongIdentApp(_, _, _, ts, _, _, _) -> - ts |> Seq.choose (|TypeIdent|_|) |> Seq.toArray - | _ -> - [||] + | SynType.App (_, _, ts, _, _, _, _) + | SynType.LongIdentApp (_, _, _, ts, _, _, _) -> ts |> Seq.choose (|TypeIdent|_|) |> Seq.toArray + | _ -> [||] module InterfaceStubGenerator = [] @@ -184,73 +172,86 @@ module InterfaceStubGenerator = ObjectIdent: string /// A list of lines represents skeleton of each member - MethodBody: string [] + MethodBody: string[] /// Context in order to display types in the short form DisplayContext: FSharpDisplayContext } - // Adapt from MetadataFormat module in FSharp.Formatting + // Adapt from MetadataFormat module in FSharp.Formatting - let internal (|AllAndLast|_|) (xs: 'T list) = + let internal (|AllAndLast|_|) (xs: 'T list) = match xs with - | [] -> - None - | _ -> + | [] -> None + | _ -> let revd = List.rev xs - Some (List.rev revd.Tail, revd.Head) + Some(List.rev revd.Tail, revd.Head) let internal getTypeParameterName (typar: FSharpGenericParameter) = (if typar.IsSolveAtCompileTime then "^" else "'") + typar.Name - let internal bracket (str: string) = + let internal bracket (str: string) = if str.Contains(" ") then "(" + str + ")" else str let internal formatType ctx (ty: FSharpType) = - let genericDefinition = ty.Instantiate(Seq.toList ctx.ArgInstantiations).Format(ctx.DisplayContext) + let genericDefinition = + ty.Instantiate(Seq.toList ctx.ArgInstantiations).Format(ctx.DisplayContext) + (genericDefinition, ctx.TypeInstantations) ||> Map.fold (fun s k v -> s.Replace(k, v)) - // Format each argument, including its name and type - let internal formatArgUsage ctx hasTypeAnnotation (namesWithIndices: Map>) (arg: FSharpParameter) = - let nm = - match arg.Name with + // Format each argument, including its name and type + let internal formatArgUsage ctx hasTypeAnnotation (namesWithIndices: Map>) (arg: FSharpParameter) = + let nm = + match arg.Name with | None -> - if arg.Type.HasTypeDefinition && arg.Type.TypeDefinition.CompiledName = "unit" && arg.Type.TypeDefinition.Namespace = Some "Microsoft.FSharp.Core" then "()" - else sprintf "arg%d" (namesWithIndices |> Map.toSeq |> Seq.map snd |> Seq.sumBy Set.count |> max 1) + if arg.Type.HasTypeDefinition + && arg.Type.TypeDefinition.CompiledName = "unit" + && arg.Type.TypeDefinition.Namespace = Some "Microsoft.FSharp.Core" then + "()" + else + sprintf "arg%d" (namesWithIndices |> Map.toSeq |> Seq.map snd |> Seq.sumBy Set.count |> max 1) | Some x -> x - + let nm, namesWithIndices = normalizeArgName namesWithIndices nm - + // Detect an optional argument let isOptionalArg = arg.HasAttribute() let argName = if isOptionalArg then "?" + nm else nm - (if hasTypeAnnotation && argName <> "()" then - argName + ": " + formatType ctx arg.Type - else argName), + + (if hasTypeAnnotation && argName <> "()" then + argName + ": " + formatType ctx arg.Type + else + argName), namesWithIndices let internal formatArgsUsage ctx hasTypeAnnotation (v: FSharpMemberOrFunctionOrValue) args = let isItemIndexer = (v.IsInstanceMember && v.DisplayName = "Item") let unit, argSep, tupSep = "()", " ", ", " + let args, namesWithIndices = args - |> List.fold (fun (argsSoFar: string list list, namesWithIndices) args -> - let argsSoFar', namesWithIndices = - args - |> List.fold (fun (acc: string list, allNames) arg -> - let name, allNames = formatArgUsage ctx hasTypeAnnotation allNames arg - name :: acc, allNames) ([], namesWithIndices) - List.rev argsSoFar' :: argsSoFar, namesWithIndices) + |> List.fold + (fun (argsSoFar: string list list, namesWithIndices) args -> + let argsSoFar', namesWithIndices = + args + |> List.fold + (fun (acc: string list, allNames) arg -> + let name, allNames = formatArgUsage ctx hasTypeAnnotation allNames arg + name :: acc, allNames) + ([], namesWithIndices) + + List.rev argsSoFar' :: argsSoFar, namesWithIndices) ([], Map.ofList [ ctx.ObjectIdent, Set.empty ]) + let argText = args |> List.rev - |> List.map (function - | [] -> unit - | [arg] when arg = unit -> unit - | [arg] when not v.IsMember || isItemIndexer -> arg + |> List.map (function + | [] -> unit + | [ arg ] when arg = unit -> unit + | [ arg ] when not v.IsMember || isItemIndexer -> arg | args when isItemIndexer -> String.concat tupSep args | args -> bracket (String.concat tupSep args)) |> String.concat argSep @@ -263,131 +264,169 @@ module InterfaceStubGenerator = | Member of FSharpMemberOrFunctionOrValue let internal getArgTypes (ctx: Context) (v: FSharpMemberOrFunctionOrValue) = - let argInfos = v.CurriedParameterGroups |> Seq.map Seq.toList |> Seq.toList - + let argInfos = v.CurriedParameterGroups |> Seq.map Seq.toList |> Seq.toList + let retType = v.ReturnParameter.Type - let argInfos, retType = + let argInfos, retType = match argInfos, v.IsPropertyGetterMethod, v.IsPropertySetterMethod with - | [ AllAndLast(args, last) ], _, true -> [ args ], Some last.Type - | [[]], true, _ -> [], Some retType + | [ AllAndLast (args, last) ], _, true -> [ args ], Some last.Type + | [ [] ], true, _ -> [], Some retType | _, _, _ -> argInfos, Some retType - let retType = + let retType = match retType with | Some ty -> let coreType = formatType ctx ty + if v.IsEvent then - let isEventHandler = - ty.BaseType - |> Option.bind (fun t -> + let isEventHandler = + ty.BaseType + |> Option.bind (fun t -> if t.HasTypeDefinition then t.TypeDefinition.TryGetFullName() - else None) + else + None) |> Option.exists ((=) "System.MulticastDelegate") - if isEventHandler then sprintf "IEvent<%s, _>" coreType else coreType - else coreType - | None -> - "unit" - + + if isEventHandler then + sprintf "IEvent<%s, _>" coreType + else + coreType + else + coreType + | None -> "unit" + argInfos, retType /// Convert a getter/setter to its canonical form let internal normalizePropertyName (v: FSharpMemberOrFunctionOrValue) = let displayName = v.DisplayName - if (v.IsPropertyGetterMethod && displayName.StartsWithOrdinal("get_")) || - (v.IsPropertySetterMethod && displayName.StartsWithOrdinal("set_")) then + + if (v.IsPropertyGetterMethod && displayName.StartsWithOrdinal("get_")) + || (v.IsPropertySetterMethod && displayName.StartsWithOrdinal("set_")) then displayName[4..] - else displayName + else + displayName let internal isEventMember (m: FSharpMemberOrFunctionOrValue) = m.IsEvent || m.HasAttribute() - - let internal formatMember (ctx: Context) m verboseMode = - let getParamArgs (argInfos: FSharpParameter list list) (ctx: Context) (v: FSharpMemberOrFunctionOrValue) = + + let internal formatMember (ctx: Context) m verboseMode = + let getParamArgs (argInfos: FSharpParameter list list) (ctx: Context) (v: FSharpMemberOrFunctionOrValue) = let args, namesWithIndices = match argInfos with - | [[x]] when v.IsPropertyGetterMethod && x.Name.IsNone - && x.Type.TypeDefinition.CompiledName = "unit" - && x.Type.TypeDefinition.Namespace = Some "Microsoft.FSharp.Core" -> - "", Map.ofList [ctx.ObjectIdent, Set.empty] - | _ -> formatArgsUsage ctx verboseMode v argInfos - - let argText = - if String.IsNullOrWhiteSpace(args) then "" - elif args.StartsWithOrdinal("(") then args - elif v.CurriedParameterGroups.Count > 1 && (not verboseMode) then " " + args - else sprintf "(%s)" args + | [ [ x ] ] when + v.IsPropertyGetterMethod + && x.Name.IsNone + && x.Type.TypeDefinition.CompiledName = "unit" + && x.Type.TypeDefinition.Namespace = Some "Microsoft.FSharp.Core" + -> + "", Map.ofList [ ctx.ObjectIdent, Set.empty ] + | _ -> formatArgsUsage ctx verboseMode v argInfos + + let argText = + if String.IsNullOrWhiteSpace(args) then + "" + elif args.StartsWithOrdinal("(") then + args + elif v.CurriedParameterGroups.Count > 1 && (not verboseMode) then + " " + args + else + sprintf "(%s)" args + argText, namesWithIndices - let preprocess (ctx: Context) (v: FSharpMemberOrFunctionOrValue) = - let buildUsage argInfos = + let preprocess (ctx: Context) (v: FSharpMemberOrFunctionOrValue) = + let buildUsage argInfos = let parArgs, _ = getParamArgs argInfos ctx v + match v.IsMember, v.IsInstanceMember, v.LogicalName, v.DisplayName with // Constructors | _, _, ".ctor", _ -> "new" + parArgs // Properties (skipping arguments) - | _, true, _, name when v.IsPropertyGetterMethod || v.IsPropertySetterMethod -> - if name.StartsWithOrdinal("get_") || name.StartsWithOrdinal("set_") then name[4..] else name + | _, true, _, name when v.IsPropertyGetterMethod || v.IsPropertySetterMethod -> + if name.StartsWithOrdinal("get_") || name.StartsWithOrdinal("set_") then + name[4..] + else + name // Ordinary instance members | _, true, _, name -> name + parArgs // Ordinary functions or values - | false, _, _, name when - not (v.ApparentEnclosingEntity.HasAttribute()) -> + | false, _, _, name when not (v.ApparentEnclosingEntity.HasAttribute()) -> name + " " + parArgs // Ordinary static members or things (?) that require fully qualified access | _, _, _, name -> name + parArgs let modifiers = - [ if v.InlineAnnotation = FSharpInlineAnnotation.AlwaysInline then yield "inline" - if v.Accessibility.IsInternal then yield "internal" ] + [ + if v.InlineAnnotation = FSharpInlineAnnotation.AlwaysInline then + yield "inline" + if v.Accessibility.IsInternal then yield "internal" + ] let argInfos, retType = getArgTypes ctx v let usage = buildUsage argInfos usage, modifiers, argInfos, retType // A couple of helper methods for emitting close declarations of members and stub method bodies. - let closeDeclaration (returnType:string) (writer:ColumnIndentedTextWriter) = + let closeDeclaration (returnType: string) (writer: ColumnIndentedTextWriter) = if verboseMode then writer.Write(": {0}", returnType) writer.Write(" = ", returnType) if verboseMode then writer.WriteLine("") - let writeImplementation (ctx:Context) (writer:ColumnIndentedTextWriter) = + + let writeImplementation (ctx: Context) (writer: ColumnIndentedTextWriter) = match verboseMode, ctx.MethodBody with | false, [| singleLine |] -> writer.WriteLine(singleLine) | _, lines -> writer.Indent ctx.Indentation + for line in lines do writer.WriteLine(line) + writer.Unindent ctx.Indentation match m with - | MemberInfo.PropertyGetSet(getter, setter) -> + | MemberInfo.PropertyGetSet (getter, setter) -> let usage, modifiers, getterArgInfos, retType = preprocess ctx getter let closeDeclaration = closeDeclaration retType let writeImplementation = writeImplementation ctx let _, _, setterArgInfos, _ = preprocess ctx setter let writer = ctx.Writer writer.Write("member ") + for modifier in modifiers do writer.Write("{0} ", modifier) + writer.Write("{0}.", ctx.ObjectIdent) // Try to print getters and setters on the same identifier writer.WriteLine(usage) writer.Indent ctx.Indentation + match getParamArgs getterArgInfos ctx getter with - | "", _ | "()", _ -> writer.Write("with get ()") + | "", _ + | "()", _ -> writer.Write("with get ()") | args, _ -> writer.Write("with get {0}", args) + writer |> closeDeclaration writer |> writeImplementation + match getParamArgs setterArgInfos ctx setter with - | "", _ | "()", _ -> - if verboseMode then writer.WriteLine("and set (v: {0}): unit = ", retType) - else writer.Write("and set v = ") + | "", _ + | "()", _ -> + if verboseMode then + writer.WriteLine("and set (v: {0}): unit = ", retType) + else + writer.Write("and set v = ") | args, namesWithIndices -> let valueArgName, _ = normalizeArgName namesWithIndices "v" - if verboseMode then writer.WriteLine("and set {0} ({1}: {2}): unit = ", args, valueArgName, retType) - else writer.Write("and set {0} {1} = ", args, valueArgName) + + if verboseMode then + writer.WriteLine("and set {0} ({1}: {2}): unit = ", args, valueArgName, retType) + else + writer.Write("and set {0} {1} = ", args, valueArgName) + writer |> writeImplementation writer.Unindent ctx.Indentation @@ -396,13 +435,14 @@ module InterfaceStubGenerator = let closeDeclaration = closeDeclaration retType let writeImplementation = writeImplementation ctx let writer = ctx.Writer - if isEventMember v then - writer.WriteLine("[]") + if isEventMember v then writer.WriteLine("[]") writer.Write("member ") + for modifier in modifiers do writer.Write("{0} ", modifier) + writer.Write("{0}.", ctx.ObjectIdent) - + if v.IsEvent then writer.Write(usage) writer |> closeDeclaration @@ -410,14 +450,19 @@ module InterfaceStubGenerator = elif v.IsPropertySetterMethod then writer.WriteLine(usage) writer.Indent ctx.Indentation + match getParamArgs argInfos ctx v with - | "", _ | "()", _ -> - writer.WriteLine("with set (v: {0}): unit = ", retType) + | "", _ + | "()", _ -> writer.WriteLine("with set (v: {0}): unit = ", retType) | args, namesWithIndices -> let valueArgName, _ = normalizeArgName namesWithIndices "v" writer.Write("with set {0} ({1}", args, valueArgName) - if verboseMode then writer.Write(": {0}): unit", retType) - else writer.Write(")") + + if verboseMode then + writer.Write(": {0}): unit", retType) + else + writer.Write(")") + writer.Write(" = ") if verboseMode then writer.WriteLine("") @@ -425,8 +470,10 @@ module InterfaceStubGenerator = writer.Unindent ctx.Indentation elif v.IsPropertyGetterMethod then writer.Write(usage) + match getParamArgs argInfos ctx v with - | "", _ | "()", _ -> + | "", _ + | "()", _ -> // Use the short-hand notation for getters without arguments writer |> closeDeclaration writer |> writeImplementation @@ -445,19 +492,20 @@ module InterfaceStubGenerator = let rec internal getNonAbbreviatedType (ty: FSharpType) = if ty.HasTypeDefinition && ty.TypeDefinition.IsFSharpAbbreviation then getNonAbbreviatedType ty.AbbreviatedType - else ty + else + ty // Sometimes interface members are stored in the form of `IInterface<'T> -> ...`, // so we need to get the 2nd generic argument let internal (|MemberFunctionType|_|) (ty: FSharpType) = if ty.IsFunctionType && ty.GenericArguments.Count = 2 then Some ty.GenericArguments[1] - else None + else + None let internal (|TypeOfMember|_|) (m: FSharpMemberOrFunctionOrValue) = match m.FullTypeSafe with - | Some (MemberFunctionType ty) when m.IsProperty && m.DeclaringEntity.IsSome && m.DeclaringEntity.Value.IsFSharp -> - Some ty + | Some (MemberFunctionType ty) when m.IsProperty && m.DeclaringEntity.IsSome && m.DeclaringEntity.Value.IsFSharp -> Some ty | Some ty -> Some ty | None -> None @@ -467,19 +515,21 @@ module InterfaceStubGenerator = if ty.IsFunctionType && ty.GenericArguments.Count = 2 then let retType = ty.GenericArguments[0] let argType = ty.GenericArguments[1] + if argType.GenericArguments.Count = 2 then - Some (argType.GenericArguments[0], retType) - else None - else None - | _ -> - None + Some(argType.GenericArguments[0], retType) + else + None + else + None + | _ -> None - let internal removeWhitespace (str: string) = - str.Replace(" ", "") + let internal removeWhitespace (str: string) = str.Replace(" ", "") /// Filter out duplicated interfaces in inheritance chain - let rec internal getInterfaces (e: FSharpEntity) = - seq { for iface in e.AllInterfaces -> + let rec internal getInterfaces (e: FSharpEntity) = + seq { + for iface in e.AllInterfaces -> let ty = getNonAbbreviatedType iface // Argument should be kept lazy so that it is only evaluated when instantiating a new type ty.TypeDefinition, Seq.zip ty.TypeDefinition.GenericParameters ty.GenericArguments @@ -487,138 +537,177 @@ module InterfaceStubGenerator = |> Seq.distinct /// Get members in the decreasing order of inheritance chain - let GetInterfaceMembers (entity: FSharpEntity) = + let GetInterfaceMembers (entity: FSharpEntity) = seq { for iface, instantiations in getInterfaces entity do - yield! iface.TryGetMembersFunctionsAndValues() - |> Seq.choose (fun m -> - // Use this hack when FCS doesn't return enough information on .NET properties and events - if m.IsProperty || m.IsEventAddMethod || m.IsEventRemoveMethod then - None - else Some (m, instantiations)) - } + yield! + iface.TryGetMembersFunctionsAndValues() + |> Seq.choose (fun m -> + // Use this hack when FCS doesn't return enough information on .NET properties and events + if m.IsProperty || m.IsEventAddMethod || m.IsEventRemoveMethod then + None + else + Some(m, instantiations)) + } /// Check whether an interface is empty let HasNoInterfaceMember entity = GetInterfaceMembers entity |> Seq.isEmpty - let internal (|LongIdentPattern|_|) = function - | SynPat.LongIdent(longDotId=SynLongIdent(xs, _, _)) -> -// let (name, range) = xs |> List.map (fun x -> x.idText, x.idRange) |> List.last + let internal (|LongIdentPattern|_|) = + function + | SynPat.LongIdent(longDotId = SynLongIdent (xs, _, _)) -> + // let (name, range) = xs |> List.map (fun x -> x.idText, x.idRange) |> List.last let last = List.last xs Some(last.idText, last.idRange) - | _ -> - None + | _ -> None // Get name and associated range of a member // On merged properties (consisting both getters and setters), they have the same range values, // so we use 'get_' and 'set_' prefix to ensure corresponding symbols are retrieved correctly. - let internal (|MemberNameAndRange|_|) = function - | SynBinding(valData=SynValData(memberFlags=Some mf); headPat=LongIdentPattern(name, range)) when mf.MemberKind = SynMemberKind.PropertyGet -> - if name.StartsWithOrdinal("get_") then Some(name, range) else Some("get_" + name, range) - | SynBinding(valData=SynValData(memberFlags=Some mf); headPat=LongIdentPattern(name, range)) when mf.MemberKind = SynMemberKind.PropertySet -> - if name.StartsWithOrdinal("set_") then Some(name, range) else Some("set_" + name, range) - | SynBinding(headPat=LongIdentPattern(name, range)) -> - Some(name, range) - | _ -> - None + let internal (|MemberNameAndRange|_|) = + function + | SynBinding (valData = SynValData(memberFlags = Some mf); headPat = LongIdentPattern (name, range)) when + mf.MemberKind = SynMemberKind.PropertyGet + -> + if name.StartsWithOrdinal("get_") then + Some(name, range) + else + Some("get_" + name, range) + | SynBinding (valData = SynValData(memberFlags = Some mf); headPat = LongIdentPattern (name, range)) when + mf.MemberKind = SynMemberKind.PropertySet + -> + if name.StartsWithOrdinal("set_") then + Some(name, range) + else + Some("set_" + name, range) + | SynBinding(headPat = LongIdentPattern (name, range)) -> Some(name, range) + | _ -> None /// Get associated member names and ranges /// In case of properties, intrinsic ranges might not be correct for the purpose of getting /// positions of 'member', which indicate the indentation for generating new members - let GetMemberNameAndRanges interfaceData = + let GetMemberNameAndRanges interfaceData = match interfaceData with - | InterfaceData.Interface(_, None) -> - [] - | InterfaceData.Interface(_, Some memberDefns) -> + | InterfaceData.Interface (_, None) -> [] + | InterfaceData.Interface (_, Some memberDefns) -> memberDefns - |> Seq.choose (function SynMemberDefn.Member(binding, _) -> Some binding | _ -> None) + |> Seq.choose (function + | SynMemberDefn.Member (binding, _) -> Some binding + | _ -> None) |> Seq.choose (|MemberNameAndRange|_|) |> Seq.toList - | InterfaceData.ObjExpr(_, bindings) -> - List.choose (|MemberNameAndRange|_|) bindings + | InterfaceData.ObjExpr (_, bindings) -> List.choose (|MemberNameAndRange|_|) bindings let internal normalizeEventName (m: FSharpMemberOrFunctionOrValue) = let name = m.DisplayName + if name.StartsWithOrdinal("add_") then name[4..] - elif name.StartsWithOrdinal("remove_") then name[7..] + elif name.StartsWithOrdinal("remove_") then name[7..] else name - /// Ideally this info should be returned in error symbols from FCS. + /// Ideally this info should be returned in error symbols from FCS. /// Because it isn't, we implement a crude way of getting member signatures: /// (1) Crack ASTs to get member names and their associated ranges /// (2) Check symbols of those members based on ranges - /// (3) If any symbol found, capture its member signature - let GetImplementedMemberSignatures (getMemberByLocation: string * range -> FSharpSymbolUse option) displayContext interfaceData = - let formatMemberSignature (symbolUse: FSharpSymbolUse) = + /// (3) If any symbol found, capture its member signature + let GetImplementedMemberSignatures (getMemberByLocation: string * range -> FSharpSymbolUse option) displayContext interfaceData = + let formatMemberSignature (symbolUse: FSharpSymbolUse) = match symbolUse.Symbol with | :? FSharpMemberOrFunctionOrValue as m -> match m.FullTypeSafe with | Some _ when isEventMember m -> // Events don't have overloads so we use only display names for comparison let signature = normalizeEventName m - Some [signature] + Some [ signature ] | Some ty -> - let signature = removeWhitespace (sprintf "%s:%s" m.DisplayName (ty.Format(displayContext))) - Some [signature] - | None -> - None + let signature = + removeWhitespace (sprintf "%s:%s" m.DisplayName (ty.Format(displayContext))) + + Some [ signature ] + | None -> None | _ -> //fail "Should only accept symbol uses of members." None + async { - let symbolUses = + let symbolUses = GetMemberNameAndRanges interfaceData |> List.toArray |> Array.map getMemberByLocation - return symbolUses |> Array.choose (Option.bind formatMemberSignature >> Option.map String.Concat) - |> Set.ofArray + + return + symbolUses + |> Array.choose (Option.bind formatMemberSignature >> Option.map String.Concat) + |> Set.ofArray } /// Check whether an entity is an interface or type abbreviation of an interface let rec IsInterface (entity: FSharpEntity) = - entity.IsInterface || (entity.IsFSharpAbbreviation && IsInterface entity.AbbreviatedType.TypeDefinition) + entity.IsInterface + || (entity.IsFSharpAbbreviation && IsInterface entity.AbbreviatedType.TypeDefinition) /// Generate stub implementation of an interface at a start column - let FormatInterface startColumn indentation (typeInstances: string []) objectIdent - (methodBody: string) (displayContext: FSharpDisplayContext) excludedMemberSignatures - (e: FSharpEntity) verboseMode = + let FormatInterface + startColumn + indentation + (typeInstances: string[]) + objectIdent + (methodBody: string) + (displayContext: FSharpDisplayContext) + excludedMemberSignatures + (e: FSharpEntity) + verboseMode + = Debug.Assert(IsInterface e, "The entity should be an interface.") let lines = String.getLines methodBody use writer = new ColumnIndentedTextWriter() let typeParams = Seq.map getTypeParameterName e.GenericParameters - let instantiations = + + let instantiations = let insts = Seq.zip typeParams typeInstances // Filter out useless instances (when it is replaced by the same name or by wildcard) - |> Seq.filter(fun (t1, t2) -> t1 <> t2 && t2 <> "_") + |> Seq.filter (fun (t1, t2) -> t1 <> t2 && t2 <> "_") |> Map.ofSeq - // A simple hack to handle instantiation of type alias + // A simple hack to handle instantiation of type alias if e.IsFSharpAbbreviation then let ty = getNonAbbreviatedType e.AbbreviatedType - (ty.TypeDefinition.GenericParameters |> Seq.map getTypeParameterName, - ty.GenericArguments |> Seq.map (fun ty -> ty.Format(displayContext))) + + (ty.TypeDefinition.GenericParameters |> Seq.map getTypeParameterName, + ty.GenericArguments |> Seq.map (fun ty -> ty.Format(displayContext))) ||> Seq.zip |> Seq.fold (fun acc (x, y) -> Map.add x y acc) insts - else insts - let ctx = { Writer = writer; TypeInstantations = instantiations; ArgInstantiations = Seq.empty; - Indentation = indentation; ObjectIdent = objectIdent; MethodBody = lines; DisplayContext = displayContext } + else + insts + + let ctx = + { + Writer = writer + TypeInstantations = instantiations + ArgInstantiations = Seq.empty + Indentation = indentation + ObjectIdent = objectIdent + MethodBody = lines + DisplayContext = displayContext + } + let missingMembers = GetInterfaceMembers e - |> Seq.groupBy (fun (m, insts) -> + |> Seq.groupBy (fun (m, insts) -> match m with - | _ when isEventMember m -> - Some (normalizeEventName m) + | _ when isEventMember m -> Some(normalizeEventName m) | TypeOfMember ty -> - let signature = removeWhitespace (sprintf "%s:%s" m.DisplayName (formatType { ctx with ArgInstantiations = insts } ty)) - Some signature - | _ -> + let signature = + removeWhitespace (sprintf "%s:%s" m.DisplayName (formatType { ctx with ArgInstantiations = insts } ty)) + + Some signature + | _ -> //debug "FullType throws exceptions due to bugs in FCS." None) - |> Seq.collect (fun (signature, members) -> + |> Seq.collect (fun (signature, members) -> match signature with - | None -> - members + | None -> members | Some signature when not (Set.contains signature excludedMemberSignatures) -> // Return the first member from a group of members for a particular signature Seq.truncate 1 members @@ -630,15 +719,17 @@ module InterfaceStubGenerator = else writer.Indent startColumn writer.WriteLine("") + let duplicatedMembers = missingMembers - |> Seq.countBy(fun (m, insts) -> m.DisplayName, insts |> Seq.length) + |> Seq.countBy (fun (m, insts) -> m.DisplayName, insts |> Seq.length) |> Seq.filter (snd >> (<) 1) |> Seq.map (fst >> fst) |> Set.ofSeq let getReturnType v = snd (getArgTypes ctx v) - let rec formatMembers (members : (FSharpMemberOrFunctionOrValue * _) list) = + + let rec formatMembers (members: (FSharpMemberOrFunctionOrValue * _) list) = match members with // Since there is no unified source of information for properties, // we try to merge getters and setters when they seem to match. @@ -646,9 +737,11 @@ module InterfaceStubGenerator = // They belong to the same property if names and return types are the same | (getter as first, insts) :: (setter, _) :: otherMembers | (setter as first, _) :: (getter, insts) :: otherMembers when - getter.IsPropertyGetterMethod && setter.IsPropertySetterMethod && - normalizePropertyName getter = normalizePropertyName setter && - getReturnType getter = getReturnType setter -> + getter.IsPropertyGetterMethod + && setter.IsPropertySetterMethod + && normalizePropertyName getter = normalizePropertyName setter + && getReturnType getter = getReturnType setter + -> let useVerboseMode = verboseMode || duplicatedMembers.Contains first.DisplayName formatMember { ctx with ArgInstantiations = insts } (MemberInfo.PropertyGetSet(getter, setter)) useVerboseMode formatMembers otherMembers @@ -659,65 +752,56 @@ module InterfaceStubGenerator = | [] -> () missingMembers - |> Seq.sortBy (fun (m, _) -> + |> Seq.sortBy (fun (m, _) -> // Sort by normalized name and return type so that getters and setters of the same properties // are guaranteed to be neighboring. normalizePropertyName m, getReturnType m) |> Seq.toList |> formatMembers + writer.Dump() /// Find corresponding interface declaration at a given position let TryFindInterfaceDeclaration (pos: pos) (parsedInput: ParsedInput) = - let rec walkImplFileInput (ParsedImplFileInput (modules = moduleOrNamespaceList)) = + let rec walkImplFileInput (ParsedImplFileInput (modules = moduleOrNamespaceList)) = List.tryPick walkSynModuleOrNamespace moduleOrNamespaceList - and walkSynModuleOrNamespace(SynModuleOrNamespace(decls = decls; range = range)) = + and walkSynModuleOrNamespace (SynModuleOrNamespace (decls = decls; range = range)) = if not <| rangeContainsPos range pos then None else List.tryPick walkSynModuleDecl decls - and walkSynModuleDecl(decl: SynModuleDecl) = + and walkSynModuleDecl (decl: SynModuleDecl) = if not <| rangeContainsPos decl.Range pos then None else match decl with - | SynModuleDecl.Exception(SynExceptionDefn(_, _, synMembers, _), _) -> - List.tryPick walkSynMemberDefn synMembers - | SynModuleDecl.Let(_isRecursive, bindings, _range) -> - List.tryPick walkBinding bindings - | SynModuleDecl.ModuleAbbrev(_lhs, _rhs, _range) -> - None - | SynModuleDecl.NamespaceFragment(fragment) -> - walkSynModuleOrNamespace fragment - | SynModuleDecl.NestedModule(decls = modules) -> - List.tryPick walkSynModuleDecl modules - | SynModuleDecl.Types(typeDefs, _range) -> - List.tryPick walkSynTypeDefn typeDefs - | SynModuleDecl.Expr (expr, _) -> - walkExpr expr + | SynModuleDecl.Exception (SynExceptionDefn (_, _, synMembers, _), _) -> List.tryPick walkSynMemberDefn synMembers + | SynModuleDecl.Let (_isRecursive, bindings, _range) -> List.tryPick walkBinding bindings + | SynModuleDecl.ModuleAbbrev (_lhs, _rhs, _range) -> None + | SynModuleDecl.NamespaceFragment (fragment) -> walkSynModuleOrNamespace fragment + | SynModuleDecl.NestedModule (decls = modules) -> List.tryPick walkSynModuleDecl modules + | SynModuleDecl.Types (typeDefs, _range) -> List.tryPick walkSynTypeDefn typeDefs + | SynModuleDecl.Expr (expr, _) -> walkExpr expr | SynModuleDecl.Attributes _ | SynModuleDecl.HashDirective _ - | SynModuleDecl.Open _ -> - None + | SynModuleDecl.Open _ -> None - and walkSynTypeDefn(SynTypeDefn(typeRepr=representation; members=members; range=range)) = + and walkSynTypeDefn (SynTypeDefn (typeRepr = representation; members = members; range = range)) = if not <| rangeContainsPos range pos then None else walkSynTypeDefnRepr representation - |> Option.orElse (List.tryPick walkSynMemberDefn members) + |> Option.orElse (List.tryPick walkSynMemberDefn members) - and walkSynTypeDefnRepr(typeDefnRepr: SynTypeDefnRepr) = + and walkSynTypeDefnRepr (typeDefnRepr: SynTypeDefnRepr) = if not <| rangeContainsPos typeDefnRepr.Range pos then None else match typeDefnRepr with - | SynTypeDefnRepr.ObjectModel(_kind, members, _range) -> - List.tryPick walkSynMemberDefn members - | SynTypeDefnRepr.Simple(_repr, _range) -> - None + | SynTypeDefnRepr.ObjectModel (_kind, members, _range) -> List.tryPick walkSynMemberDefn members + | SynTypeDefnRepr.Simple (_repr, _range) -> None | SynTypeDefnRepr.Exception _ -> None and walkSynMemberDefn (memberDefn: SynMemberDefn) = @@ -725,210 +809,169 @@ module InterfaceStubGenerator = None else match memberDefn with - | SynMemberDefn.AbstractSlot(_synValSig, _memberFlags, _range) -> - None - | SynMemberDefn.AutoProperty(synExpr=expr) -> - walkExpr expr - | SynMemberDefn.Interface(interfaceType=interfaceType; members=members) -> + | SynMemberDefn.AbstractSlot (_synValSig, _memberFlags, _range) -> None + | SynMemberDefn.AutoProperty (synExpr = expr) -> walkExpr expr + | SynMemberDefn.Interface (interfaceType = interfaceType; members = members) -> if rangeContainsPos interfaceType.Range pos then Some(InterfaceData.Interface(interfaceType, members)) else Option.bind (List.tryPick walkSynMemberDefn) members - | SynMemberDefn.Member(binding, _range) -> - walkBinding binding - | SynMemberDefn.NestedType(typeDef, _access, _range) -> - walkSynTypeDefn typeDef - | SynMemberDefn.ValField(_field, _range) -> - None - | SynMemberDefn.LetBindings(bindings, _isStatic, _isRec, _range) -> - List.tryPick walkBinding bindings + | SynMemberDefn.Member (binding, _range) -> walkBinding binding + | SynMemberDefn.NestedType (typeDef, _access, _range) -> walkSynTypeDefn typeDef + | SynMemberDefn.ValField (_field, _range) -> None + | SynMemberDefn.LetBindings (bindings, _isStatic, _isRec, _range) -> List.tryPick walkBinding bindings | SynMemberDefn.Open _ | SynMemberDefn.ImplicitCtor _ | SynMemberDefn.Inherit _ -> None | SynMemberDefn.ImplicitInherit (_, expr, _, _) -> walkExpr expr - and walkBinding (SynBinding(expr=expr)) = - walkExpr expr + and walkBinding (SynBinding (expr = expr)) = walkExpr expr and walkExpr expr = - if not <| rangeContainsPos expr.Range pos then + if not <| rangeContainsPos expr.Range pos then None else match expr with - | SynExpr.Quote (synExpr1, _, synExpr2, _, _range) -> - List.tryPick walkExpr [synExpr1; synExpr2] + | SynExpr.Quote (synExpr1, _, synExpr2, _, _range) -> List.tryPick walkExpr [ synExpr1; synExpr2 ] - | SynExpr.Const (_synConst, _range) -> - None + | SynExpr.Const (_synConst, _range) -> None - | SynExpr.Paren (synExpr, _, _, _parenRange) -> - walkExpr synExpr - | SynExpr.Typed (synExpr, _synType, _range) -> - walkExpr synExpr + | SynExpr.Paren (synExpr, _, _, _parenRange) -> walkExpr synExpr + | SynExpr.Typed (synExpr, _synType, _range) -> walkExpr synExpr | SynExpr.Tuple (_, synExprList, _, _range) - | SynExpr.ArrayOrList (_, synExprList, _range) -> - List.tryPick walkExpr synExprList + | SynExpr.ArrayOrList (_, synExprList, _range) -> List.tryPick walkExpr synExprList - | SynExpr.Record (_inheritOpt, _copyOpt, fields, _range) -> - List.tryPick (fun (SynExprRecordField(expr=e)) -> Option.bind walkExpr e) fields + | SynExpr.Record (_inheritOpt, _copyOpt, fields, _range) -> + List.tryPick (fun (SynExprRecordField (expr = e)) -> Option.bind walkExpr e) fields - | SynExpr.New (_, _synType, synExpr, _range) -> - walkExpr synExpr + | SynExpr.New (_, _synType, synExpr, _range) -> walkExpr synExpr - | SynExpr.ObjExpr (objType=ty; argOptions=baseCallOpt; bindings=binds; members=ms; extraImpls=ifaces) -> + | SynExpr.ObjExpr (objType = ty; argOptions = baseCallOpt; bindings = binds; members = ms; extraImpls = ifaces) -> let binds = unionBindingAndMembers binds ms + match baseCallOpt with - | None -> + | None -> if rangeContainsPos ty.Range pos then - Some (InterfaceData.ObjExpr(ty, binds)) + Some(InterfaceData.ObjExpr(ty, binds)) else - ifaces |> List.tryPick (fun (SynInterfaceImpl(interfaceTy=ty; bindings=binds; range=range)) -> - if rangeContainsPos range pos then - Some (InterfaceData.ObjExpr(ty, binds)) - else None) - | Some _ -> + ifaces + |> List.tryPick (fun (SynInterfaceImpl (interfaceTy = ty; bindings = binds; range = range)) -> + if rangeContainsPos range pos then + Some(InterfaceData.ObjExpr(ty, binds)) + else + None) + | Some _ -> // Ignore object expressions of normal objects None - | SynExpr.While (_spWhile, synExpr1, synExpr2, _range) -> - List.tryPick walkExpr [synExpr1; synExpr2] + | SynExpr.While (_spWhile, synExpr1, synExpr2, _range) -> List.tryPick walkExpr [ synExpr1; synExpr2 ] - | SynExpr.ForEach (_spFor, _spIn, _seqExprOnly, _isFromSource, _synPat, synExpr1, synExpr2, _range) -> - List.tryPick walkExpr [synExpr1; synExpr2] + | SynExpr.ForEach (_spFor, _spIn, _seqExprOnly, _isFromSource, _synPat, synExpr1, synExpr2, _range) -> + List.tryPick walkExpr [ synExpr1; synExpr2 ] - | SynExpr.For (identBody=synExpr1; toBody=synExpr2; doBody=synExpr3) -> - List.tryPick walkExpr [synExpr1; synExpr2; synExpr3] + | SynExpr.For (identBody = synExpr1; toBody = synExpr2; doBody = synExpr3) -> + List.tryPick walkExpr [ synExpr1; synExpr2; synExpr3 ] - | SynExpr.ArrayOrListComputed (_, synExpr, _range) -> - walkExpr synExpr + | SynExpr.ArrayOrListComputed (_, synExpr, _range) -> walkExpr synExpr - | SynExpr.ComputationExpr (_, synExpr, _range) -> - walkExpr synExpr + | SynExpr.ComputationExpr (_, synExpr, _range) -> walkExpr synExpr - | SynExpr.Lambda (body=synExpr) -> - walkExpr synExpr + | SynExpr.Lambda (body = synExpr) -> walkExpr synExpr - | SynExpr.MatchLambda (_isExnMatch, _argm, synMatchClauseList, _spBind, _wholem) -> - synMatchClauseList |> List.tryPick (fun (SynMatchClause(resultExpr = e)) -> walkExpr e) + | SynExpr.MatchLambda (_isExnMatch, _argm, synMatchClauseList, _spBind, _wholem) -> + synMatchClauseList + |> List.tryPick (fun (SynMatchClause (resultExpr = e)) -> walkExpr e) - | SynExpr.Match (expr=synExpr; clauses=synMatchClauseList) -> + | SynExpr.Match (expr = synExpr; clauses = synMatchClauseList) -> walkExpr synExpr - |> Option.orElse (synMatchClauseList |> List.tryPick (fun (SynMatchClause(resultExpr = e)) -> walkExpr e)) + |> Option.orElse ( + synMatchClauseList + |> List.tryPick (fun (SynMatchClause (resultExpr = e)) -> walkExpr e) + ) - | SynExpr.Lazy (synExpr, _range) -> - walkExpr synExpr + | SynExpr.Lazy (synExpr, _range) -> walkExpr synExpr - | SynExpr.Do (synExpr, _range) -> - walkExpr synExpr + | SynExpr.Do (synExpr, _range) -> walkExpr synExpr - | SynExpr.Assert (synExpr, _range) -> - walkExpr synExpr + | SynExpr.Assert (synExpr, _range) -> walkExpr synExpr - | SynExpr.App (_exprAtomicFlag, _isInfix, synExpr1, synExpr2, _range) -> - List.tryPick walkExpr [synExpr1; synExpr2] + | SynExpr.App (_exprAtomicFlag, _isInfix, synExpr1, synExpr2, _range) -> List.tryPick walkExpr [ synExpr1; synExpr2 ] - | SynExpr.TypeApp (synExpr, _, _synTypeList, _commas, _, _, _range) -> - walkExpr synExpr + | SynExpr.TypeApp (synExpr, _, _synTypeList, _commas, _, _, _range) -> walkExpr synExpr - | SynExpr.LetOrUse (bindings=synBindingList; body=synExpr) -> + | SynExpr.LetOrUse (bindings = synBindingList; body = synExpr) -> Option.orElse (List.tryPick walkBinding synBindingList) (walkExpr synExpr) - | SynExpr.TryWith (tryExpr=synExpr) -> - walkExpr synExpr + | SynExpr.TryWith (tryExpr = synExpr) -> walkExpr synExpr - | SynExpr.TryFinally (tryExpr=synExpr1; finallyExpr=synExpr2) -> - List.tryPick walkExpr [synExpr1; synExpr2] + | SynExpr.TryFinally (tryExpr = synExpr1; finallyExpr = synExpr2) -> List.tryPick walkExpr [ synExpr1; synExpr2 ] - | Sequentials exprs -> - List.tryPick walkExpr exprs + | Sequentials exprs -> List.tryPick walkExpr exprs - | SynExpr.IfThenElse (ifExpr=synExpr1; thenExpr=synExpr2; elseExpr=synExprOpt) -> + | SynExpr.IfThenElse (ifExpr = synExpr1; thenExpr = synExpr2; elseExpr = synExprOpt) -> match synExprOpt with - | Some synExpr3 -> - List.tryPick walkExpr [synExpr1; synExpr2; synExpr3] - | None -> - List.tryPick walkExpr [synExpr1; synExpr2] + | Some synExpr3 -> List.tryPick walkExpr [ synExpr1; synExpr2; synExpr3 ] + | None -> List.tryPick walkExpr [ synExpr1; synExpr2 ] - | SynExpr.Ident _ident -> - None + | SynExpr.Ident _ident -> None - | SynExpr.LongIdent (_, _longIdent, _altNameRefCell, _range) -> - None + | SynExpr.LongIdent (_, _longIdent, _altNameRefCell, _range) -> None - | SynExpr.LongIdentSet (_longIdent, synExpr, _range) -> - walkExpr synExpr + | SynExpr.LongIdentSet (_longIdent, synExpr, _range) -> walkExpr synExpr - | SynExpr.DotGet (synExpr, _dotm, _longIdent, _range) -> - walkExpr synExpr + | SynExpr.DotGet (synExpr, _dotm, _longIdent, _range) -> walkExpr synExpr - | SynExpr.DotSet (synExpr1, _longIdent, synExpr2, _range) -> - List.tryPick walkExpr [synExpr1; synExpr2] + | SynExpr.DotSet (synExpr1, _longIdent, synExpr2, _range) -> List.tryPick walkExpr [ synExpr1; synExpr2 ] - | SynExpr.Set (synExpr1, synExpr2, _range) -> - List.tryPick walkExpr [synExpr1; synExpr2] + | SynExpr.Set (synExpr1, synExpr2, _range) -> List.tryPick walkExpr [ synExpr1; synExpr2 ] - | SynExpr.DotIndexedGet (synExpr, indexArgs, _range, _range2) -> - Option.orElse (walkExpr synExpr) (walkExpr indexArgs) + | SynExpr.DotIndexedGet (synExpr, indexArgs, _range, _range2) -> Option.orElse (walkExpr synExpr) (walkExpr indexArgs) - | SynExpr.DotIndexedSet (synExpr1, indexArgs, synExpr2, _, _range, _range2) -> - [ synExpr1; indexArgs; synExpr2 ] - |> List.tryPick walkExpr + | SynExpr.DotIndexedSet (synExpr1, indexArgs, synExpr2, _, _range, _range2) -> + [ synExpr1; indexArgs; synExpr2 ] |> List.tryPick walkExpr - | SynExpr.JoinIn (synExpr1, _range, synExpr2, _range2) -> - List.tryPick walkExpr [synExpr1; synExpr2] - | SynExpr.NamedIndexedPropertySet (_longIdent, synExpr1, synExpr2, _range) -> - List.tryPick walkExpr [synExpr1; synExpr2] + | SynExpr.JoinIn (synExpr1, _range, synExpr2, _range2) -> List.tryPick walkExpr [ synExpr1; synExpr2 ] + | SynExpr.NamedIndexedPropertySet (_longIdent, synExpr1, synExpr2, _range) -> List.tryPick walkExpr [ synExpr1; synExpr2 ] - | SynExpr.DotNamedIndexedPropertySet (synExpr1, _longIdent, synExpr2, synExpr3, _range) -> - List.tryPick walkExpr [synExpr1; synExpr2; synExpr3] + | SynExpr.DotNamedIndexedPropertySet (synExpr1, _longIdent, synExpr2, synExpr3, _range) -> + List.tryPick walkExpr [ synExpr1; synExpr2; synExpr3 ] | SynExpr.TypeTest (synExpr, _synType, _range) | SynExpr.Upcast (synExpr, _synType, _range) - | SynExpr.Downcast (synExpr, _synType, _range) -> - walkExpr synExpr + | SynExpr.Downcast (synExpr, _synType, _range) -> walkExpr synExpr | SynExpr.InferredUpcast (synExpr, _range) - | SynExpr.InferredDowncast (synExpr, _range) -> - walkExpr synExpr - | SynExpr.AddressOf (_, synExpr, _range, _range2) -> - walkExpr synExpr - | SynExpr.TraitCall (_synTyparList, _synMemberSig, synExpr, _range) -> - walkExpr synExpr + | SynExpr.InferredDowncast (synExpr, _range) -> walkExpr synExpr + | SynExpr.AddressOf (_, synExpr, _range, _range2) -> walkExpr synExpr + | SynExpr.TraitCall (_synTyparList, _synMemberSig, synExpr, _range) -> walkExpr synExpr | SynExpr.Null _range - | SynExpr.ImplicitZero _range -> - None + | SynExpr.ImplicitZero _range -> None | SynExpr.YieldOrReturn (_, synExpr, _range) - | SynExpr.YieldOrReturnFrom (_, synExpr, _range) - | SynExpr.DoBang (synExpr, _range) -> - walkExpr synExpr + | SynExpr.YieldOrReturnFrom (_, synExpr, _range) + | SynExpr.DoBang (synExpr, _range) -> walkExpr synExpr - | SynExpr.LetOrUseBang (rhs=synExpr1; andBangs=synExprAndBangs; body=synExpr2) -> + | SynExpr.LetOrUseBang (rhs = synExpr1; andBangs = synExprAndBangs; body = synExpr2) -> [ yield synExpr1 - for SynExprAndBang(body=eAndBang) in synExprAndBangs do + for SynExprAndBang (body = eAndBang) in synExprAndBangs do yield eAndBang yield synExpr2 ] |> List.tryPick walkExpr | SynExpr.LibraryOnlyILAssembly _ - | SynExpr.LibraryOnlyStaticOptimization _ + | SynExpr.LibraryOnlyStaticOptimization _ | SynExpr.LibraryOnlyUnionCaseFieldGet _ - | SynExpr.LibraryOnlyUnionCaseFieldSet _ -> - None - | SynExpr.ArbitraryAfterError (_debugStr, _range) -> - None + | SynExpr.LibraryOnlyUnionCaseFieldSet _ -> None + | SynExpr.ArbitraryAfterError (_debugStr, _range) -> None | SynExpr.FromParseError (synExpr, _range) - | SynExpr.DiscardAfterMissingQualificationAfterDot (synExpr, _range) -> - walkExpr synExpr + | SynExpr.DiscardAfterMissingQualificationAfterDot (synExpr, _range) -> walkExpr synExpr | _ -> None match parsedInput with - | ParsedInput.SigFile _input -> - None - | ParsedInput.ImplFile input -> - walkImplFileInput input + | ParsedInput.SigFile _input -> None + | ParsedInput.ImplFile input -> walkImplFileInput input diff --git a/src/Compiler/Service/ServiceLexing.fs b/src/Compiler/Service/ServiceLexing.fs index e3e5aa58280b..9ecdbb823a49 100644 --- a/src/Compiler/Service/ServiceLexing.fs +++ b/src/Compiler/Service/ServiceLexing.fs @@ -24,15 +24,20 @@ open FSharp.Compiler.Text.Range module FSharpTokenTag = let Identifier = tagOfToken (IDENT "a") - let String = tagOfToken (STRING ("a", SynStringKind.Regular, LexCont.Default)) + let String = tagOfToken (STRING("a", SynStringKind.Regular, LexCont.Default)) let IDENT = tagOfToken (IDENT "a") let HASH_IDENT = tagOfToken (HASH_IDENT "a") let STRING = String - let INTERP_STRING_BEGIN_END = tagOfToken (INTERP_STRING_BEGIN_END ("a", SynStringKind.Regular, LexCont.Default)) - let INTERP_STRING_BEGIN_PART = tagOfToken (INTERP_STRING_BEGIN_PART ("a", SynStringKind.Regular, LexCont.Default)) - let INTERP_STRING_PART = tagOfToken (INTERP_STRING_PART ("a", LexCont.Default)) - let INTERP_STRING_END = tagOfToken (INTERP_STRING_END ("a", LexCont.Default)) + + let INTERP_STRING_BEGIN_END = + tagOfToken (INTERP_STRING_BEGIN_END("a", SynStringKind.Regular, LexCont.Default)) + + let INTERP_STRING_BEGIN_PART = + tagOfToken (INTERP_STRING_BEGIN_PART("a", SynStringKind.Regular, LexCont.Default)) + + let INTERP_STRING_PART = tagOfToken (INTERP_STRING_PART("a", LexCont.Default)) + let INTERP_STRING_END = tagOfToken (INTERP_STRING_END("a", LexCont.Default)) let LPAREN = tagOfToken LPAREN let RPAREN = tagOfToken RPAREN let LBRACK = tagOfToken LBRACK @@ -90,7 +95,6 @@ module FSharpTokenTag = let WITH = tagOfToken WITH let OWITH = tagOfToken OWITH - /// This corresponds to a token categorization originally used in Visual Studio 2003. /// /// NOTE: This corresponds to a token categorization originally used in Visual Studio 2003 and the original Babel source code. @@ -116,15 +120,14 @@ type FSharpTokenColorKind = /// It is not clear it is a primary logical classification that should be being used in the /// more recent language service work. type FSharpTokenTriggerClass = - | None = 0x00000000 + | None = 0x00000000 | MemberSelect = 0x00000001 - | MatchBraces = 0x00000002 + | MatchBraces = 0x00000002 | ChoiceSelect = 0x00000004 - | MethodTip = 0x000000F0 - | ParamStart = 0x00000010 - | ParamNext = 0x00000020 - | ParamEnd = 0x00000040 - + | MethodTip = 0x000000F0 + | ParamStart = 0x00000010 + | ParamNext = 0x00000020 + | ParamEnd = 0x00000040 /// This corresponds to a token categorization originally used in Visual Studio 2003. /// @@ -132,29 +135,30 @@ type FSharpTokenTriggerClass = /// It is not clear it is a primary logical classification that should be being used in the /// more recent language service work. type FSharpTokenCharKind = - | Default = 0x00000000 - | Text = 0x00000000 - | Keyword = 0x00000001 - | Identifier = 0x00000002 - | String = 0x00000003 - | Literal = 0x00000004 - | Operator = 0x00000005 - | Delimiter = 0x00000006 - | WhiteSpace = 0x00000008 + | Default = 0x00000000 + | Text = 0x00000000 + | Keyword = 0x00000001 + | Identifier = 0x00000002 + | String = 0x00000003 + | Literal = 0x00000004 + | Operator = 0x00000005 + | Delimiter = 0x00000006 + | WhiteSpace = 0x00000008 | LineComment = 0x00000009 - | Comment = 0x0000000A - + | Comment = 0x0000000A /// Information about a particular token from the tokenizer -type FSharpTokenInfo = { - LeftColumn: int - RightColumn: int - ColorClass: FSharpTokenColorKind - CharClass: FSharpTokenCharKind - FSharpTokenTriggerClass: FSharpTokenTriggerClass - Tag: int - TokenName: string - FullMatchedLength: int } +type FSharpTokenInfo = + { + LeftColumn: int + RightColumn: int + ColorClass: FSharpTokenColorKind + CharClass: FSharpTokenCharKind + FSharpTokenTriggerClass: FSharpTokenTriggerClass + Tag: int + TokenName: string + FullMatchedLength: int + } //---------------------------------------------------------------------------- // Babel flags @@ -174,37 +178,61 @@ module internal TokenClassifications = System.Diagnostics.Debug.Assert(false, "BUG: Received zero length IDENT token.") // This is related to 4783. Recover by treating as lower case identifier. (FSharpTokenColorKind.Identifier, FSharpTokenCharKind.Identifier, FSharpTokenTriggerClass.None) + else if Char.ToUpperInvariant s[0] = s[0] then + (FSharpTokenColorKind.UpperIdentifier, FSharpTokenCharKind.Identifier, FSharpTokenTriggerClass.None) else - if Char.ToUpperInvariant s[0] = s[0] then - (FSharpTokenColorKind.UpperIdentifier, FSharpTokenCharKind.Identifier, FSharpTokenTriggerClass.None) - else - (FSharpTokenColorKind.Identifier, FSharpTokenCharKind.Identifier, FSharpTokenTriggerClass.None) + (FSharpTokenColorKind.Identifier, FSharpTokenCharKind.Identifier, FSharpTokenTriggerClass.None) // 'in' when used in a 'join' in a query expression - | JOIN_IN -> - (FSharpTokenColorKind.Identifier, FSharpTokenCharKind.Identifier, FSharpTokenTriggerClass.None) + | JOIN_IN -> (FSharpTokenColorKind.Identifier, FSharpTokenCharKind.Identifier, FSharpTokenTriggerClass.None) | DECIMAL _ - | BIGNUM _ | INT8 _ | UINT8 _ | INT16 _ | UINT16 _ | INT32 _ | UINT32 _ | INT64 _ | UINT64 _ - | UNATIVEINT _ | NATIVEINT _ | IEEE32 _ | IEEE64 _ -> - (FSharpTokenColorKind.Number, FSharpTokenCharKind.Literal, FSharpTokenTriggerClass.None) + | BIGNUM _ + | INT8 _ + | UINT8 _ + | INT16 _ + | UINT16 _ + | INT32 _ + | UINT32 _ + | INT64 _ + | UINT64 _ + | UNATIVEINT _ + | NATIVEINT _ + | IEEE32 _ + | IEEE64 _ -> (FSharpTokenColorKind.Number, FSharpTokenCharKind.Literal, FSharpTokenTriggerClass.None) | INT32_DOT_DOT _ -> - // This will color the whole "1.." expression in a 'number' color - // (this isn't entirely correct, but it'll work for now - see bug 3727) + // This will color the whole "1.." expression in a 'number' color + // (this isn't entirely correct, but it'll work for now - see bug 3727) (FSharpTokenColorKind.Number, FSharpTokenCharKind.Operator, FSharpTokenTriggerClass.None) - | INFIX_STAR_DIV_MOD_OP ("mod" | "land" | "lor" | "lxor") - | INFIX_STAR_STAR_OP ("lsl" | "lsr" | "asr") -> - (FSharpTokenColorKind.Keyword, FSharpTokenCharKind.Keyword, FSharpTokenTriggerClass.None) + | INFIX_STAR_DIV_MOD_OP ("mod" + | "land" + | "lor" + | "lxor") + | INFIX_STAR_STAR_OP ("lsl" + | "lsr" + | "asr") -> (FSharpTokenColorKind.Keyword, FSharpTokenCharKind.Keyword, FSharpTokenTriggerClass.None) | LPAREN_STAR_RPAREN - | DOLLAR | COLON_GREATER | COLON_COLON - | PERCENT_OP _ | PLUS_MINUS_OP _ | PREFIX_OP _ | COLON_QMARK_GREATER - | AMP | AMP_AMP | BAR_BAR | QMARK | QMARK_QMARK | COLON_QMARK + | DOLLAR + | COLON_GREATER + | COLON_COLON + | PERCENT_OP _ + | PLUS_MINUS_OP _ + | PREFIX_OP _ + | COLON_QMARK_GREATER + | AMP + | AMP_AMP + | BAR_BAR + | QMARK + | QMARK_QMARK + | COLON_QMARK | HIGH_PRECEDENCE_TYAPP - | COLON_EQUALS | EQUALS | RQUOTE_DOT _ - | MINUS | ADJACENT_PREFIX_OP _ -> - (FSharpTokenColorKind.Operator, FSharpTokenCharKind.Operator, FSharpTokenTriggerClass.None) + | COLON_EQUALS + | EQUALS + | RQUOTE_DOT _ + | MINUS + | ADJACENT_PREFIX_OP _ -> (FSharpTokenColorKind.Operator, FSharpTokenCharKind.Operator, FSharpTokenTriggerClass.None) | INFIX_COMPARE_OP _ // This is a whole family: .< .> .= .!= .$ | FUNKY_OPERATOR_NAME _ // This is another whole family, including: .[] and .() @@ -213,115 +241,204 @@ module internal TokenClassifications = | INFIX_AMP_OP _ | INFIX_BAR_OP _ | INFIX_STAR_DIV_MOD_OP _ - | INFIX_AMP_OP _ -> - (FSharpTokenColorKind.Operator, FSharpTokenCharKind.Operator, FSharpTokenTriggerClass.None) + | INFIX_AMP_OP _ -> (FSharpTokenColorKind.Operator, FSharpTokenCharKind.Operator, FSharpTokenTriggerClass.None) - | DOT_DOT | DOT_DOT_HAT -> - (FSharpTokenColorKind.Operator, FSharpTokenCharKind.Operator, FSharpTokenTriggerClass.MemberSelect) + | DOT_DOT + | DOT_DOT_HAT -> (FSharpTokenColorKind.Operator, FSharpTokenCharKind.Operator, FSharpTokenTriggerClass.MemberSelect) - | COMMA -> - (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.ParamNext) + | COMMA -> (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.ParamNext) - | DOT -> - (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.MemberSelect) + | DOT -> (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.MemberSelect) | BAR -> - (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.None (* FSharpTokenTriggerClass.ChoiceSelect *)) + (FSharpTokenColorKind.Punctuation, + FSharpTokenCharKind.Delimiter, + FSharpTokenTriggerClass.None (* FSharpTokenTriggerClass.ChoiceSelect *) ) - | HASH | STAR | SEMICOLON | SEMICOLON_SEMICOLON | COLON -> - (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.None) + | HASH + | STAR + | SEMICOLON + | SEMICOLON_SEMICOLON + | COLON -> (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.None) - | QUOTE | UNDERSCORE - | INFIX_AT_HAT_OP _ -> - (FSharpTokenColorKind.Identifier, FSharpTokenCharKind.Identifier, FSharpTokenTriggerClass.None) + | QUOTE + | UNDERSCORE + | INFIX_AT_HAT_OP _ -> (FSharpTokenColorKind.Identifier, FSharpTokenCharKind.Identifier, FSharpTokenTriggerClass.None) - | LESS _ -> - (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Operator, FSharpTokenTriggerClass.ParamStart) // for type provider static arguments + | LESS _ -> (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Operator, FSharpTokenTriggerClass.ParamStart) // for type provider static arguments - | GREATER _ -> - (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Operator, FSharpTokenTriggerClass.ParamEnd) // for type provider static arguments + | GREATER _ -> (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Operator, FSharpTokenTriggerClass.ParamEnd) // for type provider static arguments | LPAREN -> // We need 'ParamStart' to trigger the 'GetDeclarations' method to show param info automatically // this is needed even if we don't use MPF for determining information about params - (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.ParamStart ||| FSharpTokenTriggerClass.MatchBraces) - - | RPAREN | RPAREN_COMING_SOON | RPAREN_IS_HERE -> - (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.ParamEnd ||| FSharpTokenTriggerClass.MatchBraces) - - | LBRACK_LESS -> - (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.None ) - - | LQUOTE _ | LBRACK | LBRACE _ | LBRACK_BAR | LBRACE_BAR -> - (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.MatchBraces ) - - | GREATER_RBRACK | GREATER_BAR_RBRACK -> - (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.None ) - - | RQUOTE _ | RBRACK | RBRACE _ | RBRACE_COMING_SOON | RBRACE_IS_HERE | BAR_RBRACK | BAR_RBRACE -> - (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.MatchBraces ) - - | PUBLIC | PRIVATE | INTERNAL | BASE | GLOBAL - | CONSTRAINT | INSTANCE | DELEGATE | INHERIT|CONSTRUCTOR|DEFAULT|OVERRIDE|ABSTRACT|CLASS - | MEMBER | STATIC | NAMESPACE - | OASSERT | OLAZY | ODECLEND | OBLOCKSEP | OEND | OBLOCKBEGIN | ORIGHT_BLOCK_END - | OBLOCKEND | OBLOCKEND_COMING_SOON | OBLOCKEND_IS_HERE | OTHEN | OELSE | OLET _ - | OBINDER _ | OAND_BANG _ | BINDER _ | ODO | OWITH | OFUNCTION | OFUN | ORESET | ODUMMY _ | DO_BANG - | ODO_BANG | YIELD _ | YIELD_BANG _ | OINTERFACE_MEMBER - | ELIF | RARROW | LARROW | SIG | STRUCT - | UPCAST | DOWNCAST | NULL | RESERVED | MODULE | AND | AS | ASSERT | ASR - | DOWNTO | EXCEPTION | FALSE | FOR | FUN | FUNCTION - | FINALLY | LAZY | MATCH | MATCH_BANG | MUTABLE | NEW | OF | OPEN | OR | VOID | EXTERN - | INTERFACE | REC | TO | TRUE | TRY | TYPE | VAL | INLINE | WHEN | WHILE | WITH - | IF | THEN | ELSE | DO | DONE | LET _ | AND_BANG _ | IN | CONST - | HIGH_PRECEDENCE_PAREN_APP | FIXED + (FSharpTokenColorKind.Punctuation, + FSharpTokenCharKind.Delimiter, + FSharpTokenTriggerClass.ParamStart ||| FSharpTokenTriggerClass.MatchBraces) + + | RPAREN + | RPAREN_COMING_SOON + | RPAREN_IS_HERE -> + (FSharpTokenColorKind.Punctuation, + FSharpTokenCharKind.Delimiter, + FSharpTokenTriggerClass.ParamEnd ||| FSharpTokenTriggerClass.MatchBraces) + + | LBRACK_LESS -> (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.None) + + | LQUOTE _ + | LBRACK + | LBRACE _ + | LBRACK_BAR + | LBRACE_BAR -> (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.MatchBraces) + + | GREATER_RBRACK + | GREATER_BAR_RBRACK -> (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.None) + + | RQUOTE _ + | RBRACK + | RBRACE _ + | RBRACE_COMING_SOON + | RBRACE_IS_HERE + | BAR_RBRACK + | BAR_RBRACE -> (FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.MatchBraces) + + | PUBLIC + | PRIVATE + | INTERNAL + | BASE + | GLOBAL + | CONSTRAINT + | INSTANCE + | DELEGATE + | INHERIT + | CONSTRUCTOR + | DEFAULT + | OVERRIDE + | ABSTRACT + | CLASS + | MEMBER + | STATIC + | NAMESPACE + | OASSERT + | OLAZY + | ODECLEND + | OBLOCKSEP + | OEND + | OBLOCKBEGIN + | ORIGHT_BLOCK_END + | OBLOCKEND + | OBLOCKEND_COMING_SOON + | OBLOCKEND_IS_HERE + | OTHEN + | OELSE + | OLET _ + | OBINDER _ + | OAND_BANG _ + | BINDER _ + | ODO + | OWITH + | OFUNCTION + | OFUN + | ORESET + | ODUMMY _ + | DO_BANG + | ODO_BANG + | YIELD _ + | YIELD_BANG _ + | OINTERFACE_MEMBER + | ELIF + | RARROW + | LARROW + | SIG + | STRUCT + | UPCAST + | DOWNCAST + | NULL + | RESERVED + | MODULE + | AND + | AS + | ASSERT + | ASR + | DOWNTO + | EXCEPTION + | FALSE + | FOR + | FUN + | FUNCTION + | FINALLY + | LAZY + | MATCH + | MATCH_BANG + | MUTABLE + | NEW + | OF + | OPEN + | OR + | VOID + | EXTERN + | INTERFACE + | REC + | TO + | TRUE + | TRY + | TYPE + | VAL + | INLINE + | WHEN + | WHILE + | WITH + | IF + | THEN + | ELSE + | DO + | DONE + | LET _ + | AND_BANG _ + | IN + | CONST + | HIGH_PRECEDENCE_PAREN_APP + | FIXED | HIGH_PRECEDENCE_BRACK_APP - | TYPE_COMING_SOON | TYPE_IS_HERE | MODULE_COMING_SOON | MODULE_IS_HERE -> - (FSharpTokenColorKind.Keyword, FSharpTokenCharKind.Keyword, FSharpTokenTriggerClass.None) + | TYPE_COMING_SOON + | TYPE_IS_HERE + | MODULE_COMING_SOON + | MODULE_IS_HERE -> (FSharpTokenColorKind.Keyword, FSharpTokenCharKind.Keyword, FSharpTokenTriggerClass.None) - | BEGIN -> - (FSharpTokenColorKind.Keyword, FSharpTokenCharKind.Keyword, FSharpTokenTriggerClass.None) + | BEGIN -> (FSharpTokenColorKind.Keyword, FSharpTokenCharKind.Keyword, FSharpTokenTriggerClass.None) - | END -> - (FSharpTokenColorKind.Keyword, FSharpTokenCharKind.Keyword, FSharpTokenTriggerClass.None) + | END -> (FSharpTokenColorKind.Keyword, FSharpTokenCharKind.Keyword, FSharpTokenTriggerClass.None) | HASH_LIGHT _ | HASH_LINE _ | HASH_IF _ | HASH_ELSE _ - | HASH_ENDIF _ -> - (FSharpTokenColorKind.PreprocessorKeyword, FSharpTokenCharKind.WhiteSpace, FSharpTokenTriggerClass.None) - - | INACTIVECODE _ -> - (FSharpTokenColorKind.InactiveCode, FSharpTokenCharKind.WhiteSpace, FSharpTokenTriggerClass.None) + | HASH_ENDIF _ -> (FSharpTokenColorKind.PreprocessorKeyword, FSharpTokenCharKind.WhiteSpace, FSharpTokenTriggerClass.None) + | INACTIVECODE _ -> (FSharpTokenColorKind.InactiveCode, FSharpTokenCharKind.WhiteSpace, FSharpTokenTriggerClass.None) | LEX_FAILURE _ - | WHITESPACE _ -> - (FSharpTokenColorKind.Default, FSharpTokenCharKind.WhiteSpace, FSharpTokenTriggerClass.None) + | WHITESPACE _ -> (FSharpTokenColorKind.Default, FSharpTokenCharKind.WhiteSpace, FSharpTokenTriggerClass.None) - | COMMENT _ -> - (FSharpTokenColorKind.Comment, FSharpTokenCharKind.Comment, FSharpTokenTriggerClass.None) + | COMMENT _ -> (FSharpTokenColorKind.Comment, FSharpTokenCharKind.Comment, FSharpTokenTriggerClass.None) - | LINE_COMMENT _ -> - (FSharpTokenColorKind.Comment, FSharpTokenCharKind.LineComment, FSharpTokenTriggerClass.None) + | LINE_COMMENT _ -> (FSharpTokenColorKind.Comment, FSharpTokenCharKind.LineComment, FSharpTokenTriggerClass.None) - | KEYWORD_STRING _ -> - (FSharpTokenColorKind.Keyword, FSharpTokenCharKind.Keyword, FSharpTokenTriggerClass.None) + | KEYWORD_STRING _ -> (FSharpTokenColorKind.Keyword, FSharpTokenCharKind.Keyword, FSharpTokenTriggerClass.None) | STRING_TEXT _ | INTERP_STRING_BEGIN_END _ | INTERP_STRING_BEGIN_PART _ | INTERP_STRING_PART _ | INTERP_STRING_END _ - | BYTEARRAY _ | STRING _ - | CHAR _ -> - (FSharpTokenColorKind.String, FSharpTokenCharKind.String, FSharpTokenTriggerClass.None) + | BYTEARRAY _ + | STRING _ + | CHAR _ -> (FSharpTokenColorKind.String, FSharpTokenCharKind.String, FSharpTokenTriggerClass.None) | EOF _ -> failwith "tokenInfo" module internal TestExpose = - let TokenInfo tok = TokenClassifications.tokenInfo tok + let TokenInfo tok = TokenClassifications.tokenInfo tok /// Lexer states are encoded to/from integers. Typically one lexer state is /// keep at the end of each line in an IDE service. IDE services are sometimes highly limited in the @@ -332,22 +449,22 @@ module internal TestExpose = /// or accurate error messages from lexing for mismtached #if are not supported. [] type FSharpTokenizerLexState = - { PosBits: int64 - OtherBits: int64 } + { + PosBits: int64 + OtherBits: int64 + } static member Initial = { PosBits = 0L; OtherBits = 0L } - member this.Equals (other: FSharpTokenizerLexState) = - (this.PosBits = other.PosBits) && - (this.OtherBits = other.OtherBits) + member this.Equals(other: FSharpTokenizerLexState) = + (this.PosBits = other.PosBits) && (this.OtherBits = other.OtherBits) - override this.Equals (obj: obj) = + override this.Equals(obj: obj) = match obj with | :? FSharpTokenizerLexState as other -> this.Equals other | _ -> false - override this.GetHashCode () = - hash this.PosBits + hash this.OtherBits + override this.GetHashCode() = hash this.PosBits + hash this.OtherBits type FSharpTokenizerColorState = | Token = 1 @@ -365,31 +482,30 @@ type FSharpTokenizerColorState = | TripleQuoteStringInComment = 14 | InitialState = 0 - module internal LexerStateEncoding = let computeNextLexState token (prevLexcont: LexerContinuation) = - match token with - | HASH_LINE cont - | HASH_LIGHT cont - | HASH_IF(_, _, cont) - | HASH_ELSE(_, _, cont) - | HASH_ENDIF(_, _, cont) - | INACTIVECODE cont - | WHITESPACE cont - | COMMENT cont - | LINE_COMMENT cont - | STRING_TEXT cont - | EOF cont - | INTERP_STRING_BEGIN_PART (_, _, cont) - | INTERP_STRING_PART (_, cont) - | INTERP_STRING_BEGIN_END (_, _, cont) - | INTERP_STRING_END (_, cont) - | LBRACE cont - | RBRACE cont - | BYTEARRAY (_, _, cont) - | STRING (_, _, cont) -> cont - | _ -> prevLexcont + match token with + | HASH_LINE cont + | HASH_LIGHT cont + | HASH_IF (_, _, cont) + | HASH_ELSE (_, _, cont) + | HASH_ENDIF (_, _, cont) + | INACTIVECODE cont + | WHITESPACE cont + | COMMENT cont + | LINE_COMMENT cont + | STRING_TEXT cont + | EOF cont + | INTERP_STRING_BEGIN_PART (_, _, cont) + | INTERP_STRING_PART (_, cont) + | INTERP_STRING_BEGIN_END (_, _, cont) + | INTERP_STRING_END (_, cont) + | LBRACE cont + | RBRACE cont + | BYTEARRAY (_, _, cont) + | STRING (_, _, cont) -> cont + | _ -> prevLexcont // Note that this will discard all lexcont state, including the ifdefStack. let revertToDefaultLexCont = LexCont.Default @@ -398,32 +514,51 @@ module internal LexerStateEncoding = let ncommentsNumBits = 4 let hardwhiteNumBits = 1 let ifdefstackCountNumBits = 8 - let ifdefstackNumBits = 24 // 0 means if, 1 means else + let ifdefstackNumBits = 24 // 0 means if, 1 means else let stringKindBits = 3 let nestingBits = 12 - let _ = assert (lexstateNumBits - + ncommentsNumBits - + hardwhiteNumBits - + ifdefstackCountNumBits - + ifdefstackNumBits - + stringKindBits - + nestingBits <= 64) - - let lexstateStart = 0 - let ncommentsStart = lexstateNumBits - let hardwhitePosStart = lexstateNumBits+ncommentsNumBits - let ifdefstackCountStart = lexstateNumBits+ncommentsNumBits+hardwhiteNumBits - let ifdefstackStart = lexstateNumBits+ncommentsNumBits+hardwhiteNumBits+ifdefstackCountNumBits - let stringKindStart = lexstateNumBits+ncommentsNumBits+hardwhiteNumBits+ifdefstackCountNumBits+ifdefstackNumBits - let nestingStart = lexstateNumBits+ncommentsNumBits+hardwhiteNumBits+ifdefstackCountNumBits+ifdefstackNumBits+stringKindBits - - let lexstateMask = Bits.mask64 lexstateStart lexstateNumBits - let ncommentsMask = Bits.mask64 ncommentsStart ncommentsNumBits - let hardwhitePosMask = Bits.mask64 hardwhitePosStart hardwhiteNumBits - let ifdefstackCountMask = Bits.mask64 ifdefstackCountStart ifdefstackCountNumBits - let ifdefstackMask = Bits.mask64 ifdefstackStart ifdefstackNumBits - let stringKindMask = Bits.mask64 stringKindStart stringKindBits - let nestingMask = Bits.mask64 nestingStart nestingBits + + let _ = + assert + (lexstateNumBits + + ncommentsNumBits + + hardwhiteNumBits + + ifdefstackCountNumBits + + ifdefstackNumBits + + stringKindBits + + nestingBits + <= 64) + + let lexstateStart = 0 + let ncommentsStart = lexstateNumBits + let hardwhitePosStart = lexstateNumBits + ncommentsNumBits + let ifdefstackCountStart = lexstateNumBits + ncommentsNumBits + hardwhiteNumBits + + let ifdefstackStart = + lexstateNumBits + ncommentsNumBits + hardwhiteNumBits + ifdefstackCountNumBits + + let stringKindStart = + lexstateNumBits + + ncommentsNumBits + + hardwhiteNumBits + + ifdefstackCountNumBits + + ifdefstackNumBits + + let nestingStart = + lexstateNumBits + + ncommentsNumBits + + hardwhiteNumBits + + ifdefstackCountNumBits + + ifdefstackNumBits + + stringKindBits + + let lexstateMask = Bits.mask64 lexstateStart lexstateNumBits + let ncommentsMask = Bits.mask64 ncommentsStart ncommentsNumBits + let hardwhitePosMask = Bits.mask64 hardwhitePosStart hardwhiteNumBits + let ifdefstackCountMask = Bits.mask64 ifdefstackCountStart ifdefstackCountNumBits + let ifdefstackMask = Bits.mask64 ifdefstackStart ifdefstackNumBits + let stringKindMask = Bits.mask64 stringKindStart stringKindBits + let nestingMask = Bits.mask64 nestingStart nestingBits let bitOfBool b = if b then 1 else 0 let boolOfBit n = (n = 1L) @@ -445,38 +580,52 @@ module internal LexerStateEncoding = | 0 -> LexerStringStyle.SingleQuote | 1 -> LexerStringStyle.Verbatim | 2 -> LexerStringStyle.TripleQuote - | _ -> assert false; LexerStringStyle.SingleQuote - - let encodeLexCont (colorState: FSharpTokenizerColorState, numComments, b: pos, ifdefStack, light, stringKind: LexerStringKind, stringNest) = + | _ -> + assert false + LexerStringStyle.SingleQuote + + let encodeLexCont + ( + colorState: FSharpTokenizerColorState, + numComments, + b: pos, + ifdefStack, + light, + stringKind: LexerStringKind, + stringNest + ) = let mutable ifdefStackCount = 0 let mutable ifdefStackBits = 0 + for ifOrElse in ifdefStack do match ifOrElse with | IfDefIf, _ -> () - | IfDefElse, _ -> - ifdefStackBits <- (ifdefStackBits ||| (1 <<< ifdefStackCount)) + | IfDefElse, _ -> ifdefStackBits <- (ifdefStackBits ||| (1 <<< ifdefStackCount)) + ifdefStackCount <- ifdefStackCount + 1 let stringKindValue = - (if stringKind.IsByteString then 0b100 else 0) ||| - (if stringKind.IsInterpolated then 0b010 else 0) ||| - (if stringKind.IsInterpolatedFirst then 0b001 else 0) + (if stringKind.IsByteString then 0b100 else 0) + ||| (if stringKind.IsInterpolated then 0b010 else 0) + ||| (if stringKind.IsInterpolatedFirst then 0b001 else 0) let nestingValue = let tag1, i1, kind1, rest = match stringNest with | [] -> false, 0, 0, [] - | (i1, kind1, _)::rest -> true, i1, encodeStringStyle kind1, rest + | (i1, kind1, _) :: rest -> true, i1, encodeStringStyle kind1, rest + let tag2, i2, kind2 = match rest with | [] -> false, 0, 0 - | (i2, kind2, _)::_ -> true, i2, encodeStringStyle kind2 - (if tag1 then 0b100000000000 else 0) ||| - (if tag2 then 0b010000000000 else 0) ||| - ((i1 <<< 7) &&& 0b001110000000) ||| - ((i2 <<< 4) &&& 0b000001110000) ||| - ((kind1 <<< 2) &&& 0b000000001100) ||| - ((kind2 <<< 0) &&& 0b000000000011) + | (i2, kind2, _) :: _ -> true, i2, encodeStringStyle kind2 + + (if tag1 then 0b100000000000 else 0) + ||| (if tag2 then 0b010000000000 else 0) + ||| ((i1 <<< 7) &&& 0b001110000000) + ||| ((i2 <<< 4) &&& 0b000001110000) + ||| ((kind1 <<< 2) &&& 0b000000001100) + ||| ((kind2 <<< 0) &&& 0b000000000011) let bits = lexStateOfColorState colorState @@ -487,9 +636,10 @@ module internal LexerStateEncoding = ||| ((int64 stringKindValue <<< stringKindStart) &&& stringKindMask) ||| ((int64 nestingValue <<< nestingStart) &&& nestingMask) - { PosBits = b.Encoding - OtherBits = bits } - + { + PosBits = b.Encoding + OtherBits = bits + } let decodeLexCont (state: FSharpTokenizerLexState) = let mutable ifDefs = [] @@ -499,35 +649,42 @@ module internal LexerStateEncoding = let ncomments = int32 ((bits &&& ncommentsMask) >>> ncommentsStart) let pos = pos.Decode state.PosBits - let ifdefStackCount = int32 ((bits &&& ifdefstackCountMask) >>> ifdefstackCountStart) - if ifdefStackCount>0 then + let ifdefStackCount = + int32 ((bits &&& ifdefstackCountMask) >>> ifdefstackCountStart) + + if ifdefStackCount > 0 then let ifdefStack = int32 ((bits &&& ifdefstackMask) >>> ifdefstackStart) + for i in 1..ifdefStackCount do - let bit = ifdefStackCount-i + let bit = ifdefStackCount - i let mask = 1 <<< bit let ifDef = (if ifdefStack &&& mask = 0 then IfDefIf else IfDefElse) ifDefs <- (ifDef, range0) :: ifDefs let stringKindValue = int32 ((bits &&& stringKindMask) >>> stringKindStart) - let stringKind : LexerStringKind = - { IsByteString = ((stringKindValue &&& 0b100) = 0b100) - IsInterpolated = ((stringKindValue &&& 0b010) = 0b010) - IsInterpolatedFirst = ((stringKindValue &&& 0b001) = 0b001) } + + let stringKind: LexerStringKind = + { + IsByteString = ((stringKindValue &&& 0b100) = 0b100) + IsInterpolated = ((stringKindValue &&& 0b010) = 0b010) + IsInterpolatedFirst = ((stringKindValue &&& 0b001) = 0b001) + } let hardwhite = boolOfBit ((bits &&& hardwhitePosMask) >>> hardwhitePosStart) let nestingValue = int32 ((bits &&& nestingMask) >>> nestingStart) - let stringNest : LexerInterpolatedStringNesting = - let tag1 = ((nestingValue &&& 0b100000000000) = 0b100000000000) - let tag2 = ((nestingValue &&& 0b010000000000) = 0b010000000000) - let i1 = ((nestingValue &&& 0b001110000000) >>> 7) - let i2 = ((nestingValue &&& 0b000001110000) >>> 4) + + let stringNest: LexerInterpolatedStringNesting = + let tag1 = ((nestingValue &&& 0b100000000000) = 0b100000000000) + let tag2 = ((nestingValue &&& 0b010000000000) = 0b010000000000) + let i1 = ((nestingValue &&& 0b001110000000) >>> 7) + let i2 = ((nestingValue &&& 0b000001110000) >>> 4) let kind1 = ((nestingValue &&& 0b000000001100) >>> 2) let kind2 = ((nestingValue &&& 0b000000000011) >>> 0) - [ if tag1 then - i1, decodeStringStyle kind1, range0 - if tag2 then - i2, decodeStringStyle kind2, range0 + + [ + if tag1 then i1, decodeStringStyle kind1, range0 + if tag2 then i2, decodeStringStyle kind2, range0 ] (colorState, ncomments, pos, ifDefs, hardwhite, stringKind, stringNest) @@ -537,65 +694,112 @@ module internal LexerStateEncoding = | LexCont.Token (ifdefs, stringNest) -> encodeLexCont (FSharpTokenizerColorState.Token, 0L, pos0, ifdefs, indentationSyntaxStatus, LexerStringKind.String, stringNest) | LexCont.IfDefSkip (ifdefs, stringNest, n, m) -> - encodeLexCont (FSharpTokenizerColorState.IfDefSkip, int64 n, m.Start, ifdefs, indentationSyntaxStatus, LexerStringKind.String, stringNest) - | LexCont.EndLine(ifdefs, stringNest, econt) -> + encodeLexCont ( + FSharpTokenizerColorState.IfDefSkip, + int64 n, + m.Start, + ifdefs, + indentationSyntaxStatus, + LexerStringKind.String, + stringNest + ) + | LexCont.EndLine (ifdefs, stringNest, econt) -> match econt with - | LexerEndlineContinuation.Skip(n, m) -> - encodeLexCont (FSharpTokenizerColorState.EndLineThenSkip, int64 n, m.Start, ifdefs, indentationSyntaxStatus, LexerStringKind.String, stringNest) + | LexerEndlineContinuation.Skip (n, m) -> + encodeLexCont ( + FSharpTokenizerColorState.EndLineThenSkip, + int64 n, + m.Start, + ifdefs, + indentationSyntaxStatus, + LexerStringKind.String, + stringNest + ) | LexerEndlineContinuation.Token -> - encodeLexCont (FSharpTokenizerColorState.EndLineThenToken, 0L, pos0, ifdefs, indentationSyntaxStatus, LexerStringKind.String, stringNest) + encodeLexCont ( + FSharpTokenizerColorState.EndLineThenToken, + 0L, + pos0, + ifdefs, + indentationSyntaxStatus, + LexerStringKind.String, + stringNest + ) | LexCont.String (ifdefs, stringNest, style, kind, m) -> let state = match style with | LexerStringStyle.SingleQuote -> FSharpTokenizerColorState.String | LexerStringStyle.Verbatim -> FSharpTokenizerColorState.VerbatimString | LexerStringStyle.TripleQuote -> FSharpTokenizerColorState.TripleQuoteString + encodeLexCont (state, 0L, m.Start, ifdefs, indentationSyntaxStatus, kind, stringNest) | LexCont.Comment (ifdefs, stringNest, n, m) -> - encodeLexCont (FSharpTokenizerColorState.Comment, int64 n, m.Start, ifdefs, indentationSyntaxStatus, LexerStringKind.String, stringNest) + encodeLexCont ( + FSharpTokenizerColorState.Comment, + int64 n, + m.Start, + ifdefs, + indentationSyntaxStatus, + LexerStringKind.String, + stringNest + ) | LexCont.SingleLineComment (ifdefs, stringNest, n, m) -> - encodeLexCont (FSharpTokenizerColorState.SingleLineComment, int64 n, m.Start, ifdefs, indentationSyntaxStatus, LexerStringKind.String, stringNest) + encodeLexCont ( + FSharpTokenizerColorState.SingleLineComment, + int64 n, + m.Start, + ifdefs, + indentationSyntaxStatus, + LexerStringKind.String, + stringNest + ) | LexCont.StringInComment (ifdefs, stringNest, style, n, m) -> let state = match style with | LexerStringStyle.SingleQuote -> FSharpTokenizerColorState.StringInComment | LexerStringStyle.Verbatim -> FSharpTokenizerColorState.VerbatimStringInComment | LexerStringStyle.TripleQuote -> FSharpTokenizerColorState.TripleQuoteStringInComment + encodeLexCont (state, int64 n, m.Start, ifdefs, indentationSyntaxStatus, LexerStringKind.String, stringNest) | LexCont.MLOnly (ifdefs, stringNest, m) -> - encodeLexCont (FSharpTokenizerColorState.CamlOnly, 0L, m.Start, ifdefs, indentationSyntaxStatus, LexerStringKind.String, stringNest) + encodeLexCont ( + FSharpTokenizerColorState.CamlOnly, + 0L, + m.Start, + ifdefs, + indentationSyntaxStatus, + LexerStringKind.String, + stringNest + ) let decodeLexInt (state: FSharpTokenizerLexState) = - let tag, n1, p1, ifdefs, lightSyntaxStatusInitial, stringKind, stringNest = decodeLexCont state + let tag, n1, p1, ifdefs, lightSyntaxStatusInitial, stringKind, stringNest = + decodeLexCont state + let lexcont = match tag with - | FSharpTokenizerColorState.Token -> - LexCont.Token (ifdefs, stringNest) - | FSharpTokenizerColorState.IfDefSkip -> - LexCont.IfDefSkip (ifdefs, stringNest, n1, mkRange "file" p1 p1) + | FSharpTokenizerColorState.Token -> LexCont.Token(ifdefs, stringNest) + | FSharpTokenizerColorState.IfDefSkip -> LexCont.IfDefSkip(ifdefs, stringNest, n1, mkRange "file" p1 p1) | FSharpTokenizerColorState.String -> - LexCont.String (ifdefs, stringNest, LexerStringStyle.SingleQuote, stringKind, mkRange "file" p1 p1) - | FSharpTokenizerColorState.Comment -> - LexCont.Comment (ifdefs, stringNest, n1, mkRange "file" p1 p1) - | FSharpTokenizerColorState.SingleLineComment -> - LexCont.SingleLineComment (ifdefs, stringNest, n1, mkRange "file" p1 p1) + LexCont.String(ifdefs, stringNest, LexerStringStyle.SingleQuote, stringKind, mkRange "file" p1 p1) + | FSharpTokenizerColorState.Comment -> LexCont.Comment(ifdefs, stringNest, n1, mkRange "file" p1 p1) + | FSharpTokenizerColorState.SingleLineComment -> LexCont.SingleLineComment(ifdefs, stringNest, n1, mkRange "file" p1 p1) | FSharpTokenizerColorState.StringInComment -> - LexCont.StringInComment (ifdefs, stringNest, LexerStringStyle.SingleQuote, n1, mkRange "file" p1 p1) + LexCont.StringInComment(ifdefs, stringNest, LexerStringStyle.SingleQuote, n1, mkRange "file" p1 p1) | FSharpTokenizerColorState.VerbatimStringInComment -> - LexCont.StringInComment (ifdefs, stringNest, LexerStringStyle.Verbatim, n1, mkRange "file" p1 p1) + LexCont.StringInComment(ifdefs, stringNest, LexerStringStyle.Verbatim, n1, mkRange "file" p1 p1) | FSharpTokenizerColorState.TripleQuoteStringInComment -> - LexCont.StringInComment (ifdefs, stringNest, LexerStringStyle.TripleQuote, n1, mkRange "file" p1 p1) - | FSharpTokenizerColorState.CamlOnly -> - LexCont.MLOnly (ifdefs, stringNest, mkRange "file" p1 p1) + LexCont.StringInComment(ifdefs, stringNest, LexerStringStyle.TripleQuote, n1, mkRange "file" p1 p1) + | FSharpTokenizerColorState.CamlOnly -> LexCont.MLOnly(ifdefs, stringNest, mkRange "file" p1 p1) | FSharpTokenizerColorState.VerbatimString -> - LexCont.String (ifdefs, stringNest, LexerStringStyle.Verbatim, stringKind, mkRange "file" p1 p1) + LexCont.String(ifdefs, stringNest, LexerStringStyle.Verbatim, stringKind, mkRange "file" p1 p1) | FSharpTokenizerColorState.TripleQuoteString -> - LexCont.String (ifdefs, stringNest, LexerStringStyle.TripleQuote, stringKind, mkRange "file" p1 p1) + LexCont.String(ifdefs, stringNest, LexerStringStyle.TripleQuote, stringKind, mkRange "file" p1 p1) | FSharpTokenizerColorState.EndLineThenSkip -> LexCont.EndLine(ifdefs, stringNest, LexerEndlineContinuation.Skip(n1, mkRange "file" p1 p1)) - | FSharpTokenizerColorState.EndLineThenToken -> - LexCont.EndLine(ifdefs, stringNest, LexerEndlineContinuation.Token) - | _ -> LexCont.Token ([], stringNest) + | FSharpTokenizerColorState.EndLineThenToken -> LexCont.EndLine(ifdefs, stringNest, LexerEndlineContinuation.Token) + | _ -> LexCont.Token([], stringNest) + lightSyntaxStatusInitial, lexcont //---------------------------------------------------------------------------- @@ -608,17 +812,14 @@ type SingleLineTokenState = | BeforeHash = 0 | NoFurtherMatchPossible = 1 - /// Split a line into tokens and attach information about the tokens. This information is used by Visual Studio. [] -type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, - maxLength: int option, - fileName: string option, - lexargs: LexArgs) = +type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, maxLength: int option, fileName: string option, lexargs: LexArgs) = - let skip = false // don't skip whitespace in the lexer + let skip = false // don't skip whitespace in the lexer let mutable singleLineTokenState = SingleLineTokenState.BeforeHash + let fsx = match fileName with | None -> false @@ -636,8 +837,11 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, // Process: anywhite* # let processDirective (str: string) directiveLength delay cont = let hashIdx = str.IndexOf("#", StringComparison.Ordinal) - if (hashIdx <> 0) then delay(WHITESPACE cont, 0, hashIdx - 1) - delay(HASH_IF(range0, "", cont), hashIdx, hashIdx + directiveLength) + + if (hashIdx <> 0) then + delay (WHITESPACE cont, 0, hashIdx - 1) + + delay (HASH_IF(range0, "", cont), hashIdx, hashIdx + directiveLength) hashIdx + directiveLength + 1 // Process: anywhite* ("//" [^'\n''\r']*)? @@ -645,15 +849,21 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, let rest = str.Substring(offset, str.Length - offset) let comment = rest.IndexOf('/') let spaceLength = if comment = -1 then rest.Length else comment - if (spaceLength > 0) then delay(WHITESPACE cont, offset, offset + spaceLength - 1) - if (comment <> -1) then delay(COMMENT cont, offset + comment, offset + rest.Length - 1) + + if (spaceLength > 0) then + delay (WHITESPACE cont, offset, offset + spaceLength - 1) + + if (comment <> -1) then + delay (COMMENT cont, offset + comment, offset + rest.Length - 1) // Split a directive line from lexer into tokens usable in VS let processDirectiveLine ofs f = let delayed = ResizeArray<_>() - f (fun (tok, s, e) -> delayed.Add (tok, s + ofs, e + ofs) ) + f (fun (tok, s, e) -> delayed.Add(tok, s + ofs, e + ofs)) // delay all the tokens and return the remaining one - for i = delayed.Count - 1 downto 1 do delayToken delayed[i] + for i = delayed.Count - 1 downto 1 do + delayToken delayed[i] + delayed[0] // Split the following line: @@ -663,12 +873,13 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, // Process: anywhite* "#else" / anywhite* "#endif" let offset = processDirective str length delay cont // Process: anywhite* ("//" [^'\n''\r']*)? - processWhiteAndComment str offset delay cont ) + processWhiteAndComment str offset delay cont) // Split the following line: // anywhite* "#if" anywhite+ ident anywhite* ("//" [^'\n''\r']*)? let processHashIfLine ofs (str: string) cont = let With n m = if (n < 0) then m else n + processDirectiveLine ofs (fun delay -> // Process: anywhite* "#if" let offset = processDirective str 2 delay cont @@ -677,16 +888,18 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, let w = str.Substring offset let r = w.TrimStart [| ' '; '\t' |] r, w.Length - r.Length + let beforeIdent = offset + spaces let identLength = With (rest.IndexOfAny([| '/'; '\t'; ' ' |])) rest.Length - delay(WHITESPACE cont, offset, beforeIdent - 1) - delay(IDENT(rest.Substring(0, identLength)), beforeIdent, beforeIdent + identLength - 1) + delay (WHITESPACE cont, offset, beforeIdent - 1) + delay (IDENT(rest.Substring(0, identLength)), beforeIdent, beforeIdent + identLength - 1) // Process: anywhite* ("//" [^'\n''\r']*)? let offset = beforeIdent + identLength - processWhiteAndComment str offset delay cont ) + processWhiteAndComment str offset delay cont) // Set up the initial file position - do match fileName with + do + match fileName with | None -> lexbuf.EndPos <- Internal.Utilities.Text.Lexing.Position.Empty | Some value -> resetLexbufPos value lexbuf @@ -718,6 +931,7 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, lexargs.stringNest <- stringNest use buf = ByteBuffer.Create Lexer.StringCapacity let args = (buf, LexerStringFinisher.Default, m, kind, lexargs) + match style with | LexerStringStyle.SingleQuote -> Lexer.singleQuoteString args skip lexbuf | LexerStringStyle.Verbatim -> Lexer.verbatimString args skip lexbuf @@ -737,6 +951,7 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, | LexCont.StringInComment (ifdefs, stringNest, style, n, m) -> lexargs.ifdefStack <- ifdefs lexargs.stringNest <- stringNest + match style with | LexerStringStyle.SingleQuote -> Lexer.stringInComment n m lexargs skip lexbuf | LexerStringStyle.Verbatim -> Lexer.verbatimStringInComment n m lexargs skip lexbuf @@ -747,14 +962,16 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, lexargs.stringNest <- stringNest Lexer.mlOnly m lexargs skip lexbuf - let columnsOfCurrentToken() = + let columnsOfCurrentToken () = let leftp = lexbuf.StartPos let rightp = lexbuf.EndPos let leftc = leftp.Column + let rightc = match maxLength with | Some mx when rightp.Line > leftp.Line -> mx | _ -> rightp.Column + let rightc = rightc - 1 struct (leftc, rightc) @@ -767,78 +984,80 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, else // Choose which lexer entry point to call and call it let token = callLexCont lexcont indentationSyntaxStatus skip - let struct (leftc, rightc) = columnsOfCurrentToken() + let struct (leftc, rightc) = columnsOfCurrentToken () // Splits tokens like ">." into multiple tokens - this duplicates behavior from the 'lexfilter' // which cannot be (easily) used from the language service. The rules here are not always valid, // because sometimes token shouldn't be split. However it is just for colorization & // for VS (which needs to recognize when user types "."). match token with - | HASH_IF (m, lineStr, cont) when lineStr <> "" -> - false, processHashIfLine m.StartColumn lineStr cont - | HASH_ELSE (m, lineStr, cont) when lineStr <> "" -> - false, processHashEndElse m.StartColumn lineStr 4 cont - | HASH_ENDIF (m, lineStr, cont) when lineStr <> "" -> - false, processHashEndElse m.StartColumn lineStr 5 cont - | HASH_IDENT(ident) -> - delayToken(IDENT ident, leftc + 1, rightc) + | HASH_IF (m, lineStr, cont) when lineStr <> "" -> false, processHashIfLine m.StartColumn lineStr cont + | HASH_ELSE (m, lineStr, cont) when lineStr <> "" -> false, processHashEndElse m.StartColumn lineStr 4 cont + | HASH_ENDIF (m, lineStr, cont) when lineStr <> "" -> false, processHashEndElse m.StartColumn lineStr 5 cont + | HASH_IDENT (ident) -> + delayToken (IDENT ident, leftc + 1, rightc) false, (HASH, leftc, leftc) | RQUOTE_DOT (s, raw) -> - delayToken(DOT, rightc, rightc) - false, (RQUOTE (s, raw), leftc, rightc - 1) - | INFIX_COMPARE_OP (LexFilter.TyparsCloseOp(greaters, afterOp) as opstr) -> + delayToken (DOT, rightc, rightc) + false, (RQUOTE(s, raw), leftc, rightc - 1) + | INFIX_COMPARE_OP (LexFilter.TyparsCloseOp (greaters, afterOp) as opstr) -> match afterOp with | None -> () - | Some tok -> delayToken(tok, leftc + greaters.Length, rightc) + | Some tok -> delayToken (tok, leftc + greaters.Length, rightc) + for i = greaters.Length - 1 downto 1 do - delayToken(greaters[i] false, leftc + i, rightc - opstr.Length + i + 1) - false, (greaters[0] false, leftc, rightc - opstr.Length + 1) + delayToken (greaters[i]false, leftc + i, rightc - opstr.Length + i + 1) + + false, (greaters[0]false, leftc, rightc - opstr.Length + 1) // break up any operators that start with '.' so that we can get auto-popup-completion for e.g. "x.+1" when typing the dot | INFIX_STAR_STAR_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(INFIX_STAR_STAR_OP(opstr.Substring 1), leftc+1, rightc) + delayToken (INFIX_STAR_STAR_OP(opstr.Substring 1), leftc + 1, rightc) false, (DOT, leftc, leftc) | PLUS_MINUS_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(PLUS_MINUS_OP(opstr.Substring 1), leftc+1, rightc) + delayToken (PLUS_MINUS_OP(opstr.Substring 1), leftc + 1, rightc) false, (DOT, leftc, leftc) | INFIX_COMPARE_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(INFIX_COMPARE_OP(opstr.Substring 1), leftc+1, rightc) + delayToken (INFIX_COMPARE_OP(opstr.Substring 1), leftc + 1, rightc) false, (DOT, leftc, leftc) | INFIX_AT_HAT_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(INFIX_AT_HAT_OP(opstr.Substring 1), leftc+1, rightc) + delayToken (INFIX_AT_HAT_OP(opstr.Substring 1), leftc + 1, rightc) false, (DOT, leftc, leftc) | INFIX_BAR_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(INFIX_BAR_OP(opstr.Substring 1), leftc+1, rightc) + delayToken (INFIX_BAR_OP(opstr.Substring 1), leftc + 1, rightc) false, (DOT, leftc, leftc) | PREFIX_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(PREFIX_OP(opstr.Substring 1), leftc+1, rightc) + delayToken (PREFIX_OP(opstr.Substring 1), leftc + 1, rightc) false, (DOT, leftc, leftc) | INFIX_STAR_DIV_MOD_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(INFIX_STAR_DIV_MOD_OP(opstr.Substring 1), leftc+1, rightc) + delayToken (INFIX_STAR_DIV_MOD_OP(opstr.Substring 1), leftc + 1, rightc) false, (DOT, leftc, leftc) | INFIX_AMP_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(INFIX_AMP_OP(opstr.Substring 1), leftc+1, rightc) + delayToken (INFIX_AMP_OP(opstr.Substring 1), leftc + 1, rightc) false, (DOT, leftc, leftc) | ADJACENT_PREFIX_OP opstr when opstr.StartsWithOrdinal(".") -> - delayToken(ADJACENT_PREFIX_OP(opstr.Substring 1), leftc+1, rightc) + delayToken (ADJACENT_PREFIX_OP(opstr.Substring 1), leftc + 1, rightc) false, (DOT, leftc, leftc) | FUNKY_OPERATOR_NAME opstr when opstr.StartsWithOrdinal(".") -> - delayToken(FUNKY_OPERATOR_NAME(opstr.Substring 1), leftc+1, rightc) + delayToken (FUNKY_OPERATOR_NAME(opstr.Substring 1), leftc + 1, rightc) false, (DOT, leftc, leftc) | _ -> false, (token, leftc, rightc) with _ -> false, (EOF LexerStateEncoding.revertToDefaultLexCont, 0, 0) // Scan a token starting with the given lexer state - member x.ScanToken (lexState: FSharpTokenizerLexState) : FSharpTokenInfo option * FSharpTokenizerLexState = + member x.ScanToken(lexState: FSharpTokenizerLexState) : FSharpTokenInfo option * FSharpTokenizerLexState = use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) + use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> DiscardErrorsLogger) let indentationSyntaxStatus, lexcont = LexerStateEncoding.decodeLexInt lexState - let indentationSyntaxStatus = IndentationAwareSyntaxStatus(indentationSyntaxStatus, false) + + let indentationSyntaxStatus = + IndentationAwareSyntaxStatus(indentationSyntaxStatus, false) // Grab a token - let isCached, (token, leftc, rightc) = getTokenWithPosition lexcont indentationSyntaxStatus + let isCached, (token, leftc, rightc) = + getTokenWithPosition lexcont indentationSyntaxStatus // Check for end-of-string and failure let tokenDataOption, lexcontFinal, tokenTag = @@ -846,43 +1065,52 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, | EOF lexcont -> // End of text! No more tokens. None, lexcont, 0 - | LEX_FAILURE _ -> - None, LexerStateEncoding.revertToDefaultLexCont, 0 + | LEX_FAILURE _ -> None, LexerStateEncoding.revertToDefaultLexCont, 0 | _ -> // Get the information about the token let colorClass, charClass, triggerClass = TokenClassifications.tokenInfo token let lexcontFinal = // If we're using token from cache, we don't move forward with lexing - if isCached then lexcont - else LexerStateEncoding.computeNextLexState token lexcont + if isCached then + lexcont + else + LexerStateEncoding.computeNextLexState token lexcont let tokenTag = tagOfToken token let tokenName = token_to_string token - let fullMatchedLength = lexbuf.EndPos.AbsoluteOffset - lexbuf.StartPos.AbsoluteOffset + let fullMatchedLength = + lexbuf.EndPos.AbsoluteOffset - lexbuf.StartPos.AbsoluteOffset let tokenData = - { TokenName = tokenName - LeftColumn=leftc - RightColumn=rightc - ColorClass=colorClass - CharClass=charClass - FSharpTokenTriggerClass=triggerClass - Tag=tokenTag - FullMatchedLength=fullMatchedLength} + { + TokenName = tokenName + LeftColumn = leftc + RightColumn = rightc + ColorClass = colorClass + CharClass = charClass + FSharpTokenTriggerClass = triggerClass + Tag = tokenTag + FullMatchedLength = fullMatchedLength + } + Some tokenData, lexcontFinal, tokenTag // Check for patterns like #-IDENT and see if they look like meta commands for .fsx files. If they do then merge them into a single token. let tokenDataOption, lexintFinal = - let lexintFinal = LexerStateEncoding.encodeLexInt indentationSyntaxStatus.Status lexcontFinal + let lexintFinal = + LexerStateEncoding.encodeLexInt indentationSyntaxStatus.Status lexcontFinal + match tokenDataOption, singleLineTokenState, tokenTagToTokenId tokenTag with | Some tokenData, SingleLineTokenState.BeforeHash, TOKEN_HASH -> // Don't allow further matches. singleLineTokenState <- SingleLineTokenState.NoFurtherMatchPossible // Peek at the next token - let isCached, (nextToken, _, rightc) = getTokenWithPosition lexcont indentationSyntaxStatus + let isCached, (nextToken, _, rightc) = + getTokenWithPosition lexcont indentationSyntaxStatus + match nextToken with | IDENT possibleMetaCommand -> match fsx, possibleMetaCommand with @@ -907,9 +1135,23 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, // These are for script and non-script | _, "nowarn" -> // Merge both tokens into one. - let lexcontFinal = if isCached then lexcont else LexerStateEncoding.computeNextLexState token lexcont - let tokenData = {tokenData with RightColumn=rightc;ColorClass=FSharpTokenColorKind.PreprocessorKeyword;CharClass=FSharpTokenCharKind.Keyword;FSharpTokenTriggerClass=FSharpTokenTriggerClass.None} - let lexintFinal = LexerStateEncoding.encodeLexInt indentationSyntaxStatus.Status lexcontFinal + let lexcontFinal = + if isCached then + lexcont + else + LexerStateEncoding.computeNextLexState token lexcont + + let tokenData = + { tokenData with + RightColumn = rightc + ColorClass = FSharpTokenColorKind.PreprocessorKeyword + CharClass = FSharpTokenCharKind.Keyword + FSharpTokenTriggerClass = FSharpTokenTriggerClass.None + } + + let lexintFinal = + LexerStateEncoding.encodeLexInt indentationSyntaxStatus.Status lexcontFinal + Some tokenData, lexintFinal | _ -> tokenDataOption, lexintFinal | _ -> tokenDataOption, lexintFinal @@ -926,7 +1168,10 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, LexerStateEncoding.colorStateOfLexState lexState static member LexStateOfColorState(colorState: FSharpTokenizerColorState) = - { PosBits = 0L; OtherBits = LexerStateEncoding.lexStateOfColorState colorState } + { + PosBits = 0L + OtherBits = LexerStateEncoding.lexStateOfColorState colorState + } [] type FSharpSourceTokenizer(conditionalDefines: string list, fileName: string option) = @@ -936,23 +1181,38 @@ type FSharpSourceTokenizer(conditionalDefines: string list, fileName: string opt let lexResourceManager = LexResourceManager() - let lexargs = mkLexargs(conditionalDefines, IndentationAwareSyntaxStatus(true, false), lexResourceManager, [], DiscardErrorsLogger, PathMap.empty) + let lexargs = + mkLexargs ( + conditionalDefines, + IndentationAwareSyntaxStatus(true, false), + lexResourceManager, + [], + DiscardErrorsLogger, + PathMap.empty + ) member _.CreateLineTokenizer(lineText: string) = - let lexbuf = UnicodeLexing.StringAsLexbuf(reportLibraryOnlyFeatures, langVersion, lineText) + let lexbuf = + UnicodeLexing.StringAsLexbuf(reportLibraryOnlyFeatures, langVersion, lineText) + FSharpLineTokenizer(lexbuf, Some lineText.Length, fileName, lexargs) member _.CreateBufferTokenizer bufferFiller = - let lexbuf = UnicodeLexing.FunctionAsLexbuf(reportLibraryOnlyFeatures, langVersion, bufferFiller) + let lexbuf = + UnicodeLexing.FunctionAsLexbuf(reportLibraryOnlyFeatures, langVersion, bufferFiller) + FSharpLineTokenizer(lexbuf, None, fileName, lexargs) module FSharpKeywords = - let DoesIdentifierNeedBackticks s = PrettyNaming.DoesIdentifierNeedBackticks s + let DoesIdentifierNeedBackticks s = + PrettyNaming.DoesIdentifierNeedBackticks s - let AddBackticksToIdentifierIfNeeded s = PrettyNaming.AddBackticksToIdentifierIfNeeded s + let AddBackticksToIdentifierIfNeeded s = + PrettyNaming.AddBackticksToIdentifierIfNeeded s - let NormalizeIdentifierBackticks s = PrettyNaming.NormalizeIdentifierBackticks s + let NormalizeIdentifierBackticks s = + PrettyNaming.NormalizeIdentifierBackticks s let KeywordsWithDescription = PrettyNaming.keywordsWithDescription @@ -960,12 +1220,12 @@ module FSharpKeywords = [] type FSharpLexerFlags = - | Default = 0x11011 - | LightSyntaxOn = 0x00001 - | Compiling = 0x00010 - | CompilingFSharpCore = 0x00110 - | SkipTrivia = 0x01000 - | UseLexFilter = 0x10000 + | Default = 0x11011 + | LightSyntaxOn = 0x00001 + | Compiling = 0x00010 + | CompilingFSharpCore = 0x00110 + | SkipTrivia = 0x01000 + | UseLexFilter = 0x10000 [] type FSharpTokenKind = @@ -1160,13 +1420,13 @@ type FSharpTokenKind = | InfixLxor | InfixMod -[] +[] type FSharpToken = val private tok: token val private tokRange: range - new (tok, tokRange) = { tok = tok; tokRange = tokRange } + new(tok, tokRange) = { tok = tok; tokRange = tokRange } member this.Range = this.tokRange @@ -1190,137 +1450,137 @@ type FSharpToken = | INACTIVECODE _ -> FSharpTokenKind.InactiveCode | LINE_COMMENT _ -> FSharpTokenKind.LineCommentTrivia | STRING_TEXT _ -> FSharpTokenKind.StringText - | FIXED -> FSharpTokenKind.Fixed - | OINTERFACE_MEMBER -> FSharpTokenKind.OffsideInterfaceMember - | OBLOCKEND -> FSharpTokenKind.OffsideBlockEnd - | ORIGHT_BLOCK_END -> FSharpTokenKind.OffsideRightBlockEnd - | ODECLEND -> FSharpTokenKind.OffsideDeclEnd - | OEND -> FSharpTokenKind.OffsideEnd - | OBLOCKSEP -> FSharpTokenKind.OffsideBlockSep - | OBLOCKBEGIN -> FSharpTokenKind.OffsideBlockBegin - | ORESET -> FSharpTokenKind.OffsideReset - | OFUN -> FSharpTokenKind.OffsideFun - | OFUNCTION -> FSharpTokenKind.OffsideFunction - | OWITH -> FSharpTokenKind.OffsideWith - | OELSE -> FSharpTokenKind.OffsideElse - | OTHEN -> FSharpTokenKind.OffsideThen - | ODO_BANG -> FSharpTokenKind.OffsideDoBang - | ODO -> FSharpTokenKind.OffsideDo + | FIXED -> FSharpTokenKind.Fixed + | OINTERFACE_MEMBER -> FSharpTokenKind.OffsideInterfaceMember + | OBLOCKEND -> FSharpTokenKind.OffsideBlockEnd + | ORIGHT_BLOCK_END -> FSharpTokenKind.OffsideRightBlockEnd + | ODECLEND -> FSharpTokenKind.OffsideDeclEnd + | OEND -> FSharpTokenKind.OffsideEnd + | OBLOCKSEP -> FSharpTokenKind.OffsideBlockSep + | OBLOCKBEGIN -> FSharpTokenKind.OffsideBlockBegin + | ORESET -> FSharpTokenKind.OffsideReset + | OFUN -> FSharpTokenKind.OffsideFun + | OFUNCTION -> FSharpTokenKind.OffsideFunction + | OWITH -> FSharpTokenKind.OffsideWith + | OELSE -> FSharpTokenKind.OffsideElse + | OTHEN -> FSharpTokenKind.OffsideThen + | ODO_BANG -> FSharpTokenKind.OffsideDoBang + | ODO -> FSharpTokenKind.OffsideDo | OBINDER _ -> FSharpTokenKind.OffsideBinder | OLET _ -> FSharpTokenKind.OffsideLet - | HIGH_PRECEDENCE_TYAPP -> FSharpTokenKind.HighPrecedenceTypeApp - | HIGH_PRECEDENCE_PAREN_APP -> FSharpTokenKind.HighPrecedenceParenthesisApp - | HIGH_PRECEDENCE_BRACK_APP -> FSharpTokenKind.HighPrecedenceBracketApp - | EXTERN -> FSharpTokenKind.Extern - | VOID -> FSharpTokenKind.Void - | PUBLIC -> FSharpTokenKind.Public - | PRIVATE -> FSharpTokenKind.Private - | INTERNAL -> FSharpTokenKind.Internal - | GLOBAL -> FSharpTokenKind.Global - | STATIC -> FSharpTokenKind.Static - | MEMBER -> FSharpTokenKind.Member - | CLASS -> FSharpTokenKind.Class - | ABSTRACT -> FSharpTokenKind.Abstract - | OVERRIDE -> FSharpTokenKind.Override - | DEFAULT -> FSharpTokenKind.Default - | CONSTRUCTOR -> FSharpTokenKind.Constructor - | INHERIT -> FSharpTokenKind.Inherit - | GREATER_RBRACK -> FSharpTokenKind.GreaterRightBracket - | STRUCT -> FSharpTokenKind.Struct - | SIG -> FSharpTokenKind.Sig - | BAR -> FSharpTokenKind.Bar - | RBRACK -> FSharpTokenKind.RightBracket + | HIGH_PRECEDENCE_TYAPP -> FSharpTokenKind.HighPrecedenceTypeApp + | HIGH_PRECEDENCE_PAREN_APP -> FSharpTokenKind.HighPrecedenceParenthesisApp + | HIGH_PRECEDENCE_BRACK_APP -> FSharpTokenKind.HighPrecedenceBracketApp + | EXTERN -> FSharpTokenKind.Extern + | VOID -> FSharpTokenKind.Void + | PUBLIC -> FSharpTokenKind.Public + | PRIVATE -> FSharpTokenKind.Private + | INTERNAL -> FSharpTokenKind.Internal + | GLOBAL -> FSharpTokenKind.Global + | STATIC -> FSharpTokenKind.Static + | MEMBER -> FSharpTokenKind.Member + | CLASS -> FSharpTokenKind.Class + | ABSTRACT -> FSharpTokenKind.Abstract + | OVERRIDE -> FSharpTokenKind.Override + | DEFAULT -> FSharpTokenKind.Default + | CONSTRUCTOR -> FSharpTokenKind.Constructor + | INHERIT -> FSharpTokenKind.Inherit + | GREATER_RBRACK -> FSharpTokenKind.GreaterRightBracket + | STRUCT -> FSharpTokenKind.Struct + | SIG -> FSharpTokenKind.Sig + | BAR -> FSharpTokenKind.Bar + | RBRACK -> FSharpTokenKind.RightBracket | RBRACE _ -> FSharpTokenKind.RightBrace - | MINUS -> FSharpTokenKind.Minus - | DOLLAR -> FSharpTokenKind.Dollar - | BAR_RBRACK -> FSharpTokenKind.BarRightBracket - | BAR_RBRACE -> FSharpTokenKind.BarRightBrace - | UNDERSCORE -> FSharpTokenKind.Underscore - | SEMICOLON_SEMICOLON -> FSharpTokenKind.SemicolonSemicolon - | LARROW -> FSharpTokenKind.LeftArrow - | EQUALS -> FSharpTokenKind.Equals - | LBRACK -> FSharpTokenKind.LeftBracket - | LBRACK_BAR -> FSharpTokenKind.LeftBracketBar - | LBRACE_BAR -> FSharpTokenKind.LeftBraceBar - | LBRACK_LESS -> FSharpTokenKind.LeftBracketLess + | MINUS -> FSharpTokenKind.Minus + | DOLLAR -> FSharpTokenKind.Dollar + | BAR_RBRACK -> FSharpTokenKind.BarRightBracket + | BAR_RBRACE -> FSharpTokenKind.BarRightBrace + | UNDERSCORE -> FSharpTokenKind.Underscore + | SEMICOLON_SEMICOLON -> FSharpTokenKind.SemicolonSemicolon + | LARROW -> FSharpTokenKind.LeftArrow + | EQUALS -> FSharpTokenKind.Equals + | LBRACK -> FSharpTokenKind.LeftBracket + | LBRACK_BAR -> FSharpTokenKind.LeftBracketBar + | LBRACE_BAR -> FSharpTokenKind.LeftBraceBar + | LBRACK_LESS -> FSharpTokenKind.LeftBracketLess | LBRACE _ -> FSharpTokenKind.LeftBrace - | QMARK -> FSharpTokenKind.QuestionMark - | QMARK_QMARK -> FSharpTokenKind.QuestionMarkQuestionMark - | DOT -> FSharpTokenKind.Dot - | COLON -> FSharpTokenKind.Colon - | COLON_COLON -> FSharpTokenKind.ColonColon - | COLON_GREATER -> FSharpTokenKind.ColonGreater - | COLON_QMARK_GREATER -> FSharpTokenKind.ColonQuestionMarkGreater - | COLON_QMARK -> FSharpTokenKind.ColonQuestionMark - | COLON_EQUALS -> FSharpTokenKind.ColonEquals - | SEMICOLON -> FSharpTokenKind.SemicolonSemicolon - | WHEN -> FSharpTokenKind.When - | WHILE -> FSharpTokenKind.While - | WITH -> FSharpTokenKind.With - | HASH -> FSharpTokenKind.Hash - | AMP -> FSharpTokenKind.Ampersand - | AMP_AMP -> FSharpTokenKind.AmpersandAmpersand - | QUOTE -> FSharpTokenKind.RightQuote - | LPAREN -> FSharpTokenKind.LeftParenthesis - | RPAREN -> FSharpTokenKind.RightParenthesis - | STAR -> FSharpTokenKind.Star - | COMMA -> FSharpTokenKind.Comma - | RARROW -> FSharpTokenKind.RightArrow - | GREATER_BAR_RBRACK -> FSharpTokenKind.GreaterBarRightBracket - | LPAREN_STAR_RPAREN -> FSharpTokenKind.LeftParenthesisStarRightParenthesis - | OPEN -> FSharpTokenKind.Open - | OR -> FSharpTokenKind.Or - | REC -> FSharpTokenKind.Rec - | THEN -> FSharpTokenKind.Then - | TO -> FSharpTokenKind.To - | TRUE -> FSharpTokenKind.True - | TRY -> FSharpTokenKind.Try - | TYPE -> FSharpTokenKind.Type - | VAL -> FSharpTokenKind.Val - | INLINE -> FSharpTokenKind.Inline - | INTERFACE -> FSharpTokenKind.Interface - | INSTANCE -> FSharpTokenKind.Instance - | CONST -> FSharpTokenKind.Const - | LAZY -> FSharpTokenKind.Lazy - | OLAZY -> FSharpTokenKind.OffsideLazy - | MATCH -> FSharpTokenKind.Match - | MATCH_BANG -> FSharpTokenKind.MatchBang - | MUTABLE -> FSharpTokenKind.Mutable - | NEW -> FSharpTokenKind.New - | OF -> FSharpTokenKind.Of - | EXCEPTION -> FSharpTokenKind.Exception - | FALSE -> FSharpTokenKind.False - | FOR -> FSharpTokenKind.For - | FUN -> FSharpTokenKind.Fun - | FUNCTION -> FSharpTokenKind.Function - | IF -> FSharpTokenKind.If - | IN -> FSharpTokenKind.In - | JOIN_IN -> FSharpTokenKind.JoinIn - | FINALLY -> FSharpTokenKind.Finally - | DO_BANG -> FSharpTokenKind.DoBang - | AND -> FSharpTokenKind.And - | AS -> FSharpTokenKind.As - | ASSERT -> FSharpTokenKind.Assert - | OASSERT -> FSharpTokenKind.OffsideAssert - | BEGIN -> FSharpTokenKind.Begin - | DO -> FSharpTokenKind.Do - | DONE -> FSharpTokenKind.Done - | DOWNTO -> FSharpTokenKind.DownTo - | ELSE -> FSharpTokenKind.Else - | ELIF -> FSharpTokenKind.Elif - | END -> FSharpTokenKind.End - | DOT_DOT -> FSharpTokenKind.DotDot - | DOT_DOT_HAT -> FSharpTokenKind.DotDotHat - | BAR_BAR -> FSharpTokenKind.BarBar - | UPCAST -> FSharpTokenKind.Upcast - | DOWNCAST -> FSharpTokenKind.Downcast - | NULL -> FSharpTokenKind.Null - | RESERVED -> FSharpTokenKind.Reserved - | MODULE -> FSharpTokenKind.Module - | NAMESPACE -> FSharpTokenKind.Namespace - | DELEGATE -> FSharpTokenKind.Delegate - | CONSTRAINT -> FSharpTokenKind.Constraint - | BASE -> FSharpTokenKind.Base + | QMARK -> FSharpTokenKind.QuestionMark + | QMARK_QMARK -> FSharpTokenKind.QuestionMarkQuestionMark + | DOT -> FSharpTokenKind.Dot + | COLON -> FSharpTokenKind.Colon + | COLON_COLON -> FSharpTokenKind.ColonColon + | COLON_GREATER -> FSharpTokenKind.ColonGreater + | COLON_QMARK_GREATER -> FSharpTokenKind.ColonQuestionMarkGreater + | COLON_QMARK -> FSharpTokenKind.ColonQuestionMark + | COLON_EQUALS -> FSharpTokenKind.ColonEquals + | SEMICOLON -> FSharpTokenKind.SemicolonSemicolon + | WHEN -> FSharpTokenKind.When + | WHILE -> FSharpTokenKind.While + | WITH -> FSharpTokenKind.With + | HASH -> FSharpTokenKind.Hash + | AMP -> FSharpTokenKind.Ampersand + | AMP_AMP -> FSharpTokenKind.AmpersandAmpersand + | QUOTE -> FSharpTokenKind.RightQuote + | LPAREN -> FSharpTokenKind.LeftParenthesis + | RPAREN -> FSharpTokenKind.RightParenthesis + | STAR -> FSharpTokenKind.Star + | COMMA -> FSharpTokenKind.Comma + | RARROW -> FSharpTokenKind.RightArrow + | GREATER_BAR_RBRACK -> FSharpTokenKind.GreaterBarRightBracket + | LPAREN_STAR_RPAREN -> FSharpTokenKind.LeftParenthesisStarRightParenthesis + | OPEN -> FSharpTokenKind.Open + | OR -> FSharpTokenKind.Or + | REC -> FSharpTokenKind.Rec + | THEN -> FSharpTokenKind.Then + | TO -> FSharpTokenKind.To + | TRUE -> FSharpTokenKind.True + | TRY -> FSharpTokenKind.Try + | TYPE -> FSharpTokenKind.Type + | VAL -> FSharpTokenKind.Val + | INLINE -> FSharpTokenKind.Inline + | INTERFACE -> FSharpTokenKind.Interface + | INSTANCE -> FSharpTokenKind.Instance + | CONST -> FSharpTokenKind.Const + | LAZY -> FSharpTokenKind.Lazy + | OLAZY -> FSharpTokenKind.OffsideLazy + | MATCH -> FSharpTokenKind.Match + | MATCH_BANG -> FSharpTokenKind.MatchBang + | MUTABLE -> FSharpTokenKind.Mutable + | NEW -> FSharpTokenKind.New + | OF -> FSharpTokenKind.Of + | EXCEPTION -> FSharpTokenKind.Exception + | FALSE -> FSharpTokenKind.False + | FOR -> FSharpTokenKind.For + | FUN -> FSharpTokenKind.Fun + | FUNCTION -> FSharpTokenKind.Function + | IF -> FSharpTokenKind.If + | IN -> FSharpTokenKind.In + | JOIN_IN -> FSharpTokenKind.JoinIn + | FINALLY -> FSharpTokenKind.Finally + | DO_BANG -> FSharpTokenKind.DoBang + | AND -> FSharpTokenKind.And + | AS -> FSharpTokenKind.As + | ASSERT -> FSharpTokenKind.Assert + | OASSERT -> FSharpTokenKind.OffsideAssert + | BEGIN -> FSharpTokenKind.Begin + | DO -> FSharpTokenKind.Do + | DONE -> FSharpTokenKind.Done + | DOWNTO -> FSharpTokenKind.DownTo + | ELSE -> FSharpTokenKind.Else + | ELIF -> FSharpTokenKind.Elif + | END -> FSharpTokenKind.End + | DOT_DOT -> FSharpTokenKind.DotDot + | DOT_DOT_HAT -> FSharpTokenKind.DotDotHat + | BAR_BAR -> FSharpTokenKind.BarBar + | UPCAST -> FSharpTokenKind.Upcast + | DOWNCAST -> FSharpTokenKind.Downcast + | NULL -> FSharpTokenKind.Null + | RESERVED -> FSharpTokenKind.Reserved + | MODULE -> FSharpTokenKind.Module + | NAMESPACE -> FSharpTokenKind.Namespace + | DELEGATE -> FSharpTokenKind.Delegate + | CONSTRAINT -> FSharpTokenKind.Constraint + | BASE -> FSharpTokenKind.Base | LQUOTE _ -> FSharpTokenKind.LeftQuote | RQUOTE _ -> FSharpTokenKind.RightQuote | RQUOTE_DOT _ -> FSharpTokenKind.RightQuoteDot @@ -1521,40 +1781,81 @@ type FSharpToken = [] module FSharpLexerImpl = - let lexWithDiagnosticsLogger (text: ISourceText) conditionalDefines (flags: FSharpLexerFlags) reportLibraryOnlyFeatures langVersion diagnosticsLogger onToken pathMap (ct: CancellationToken) = - let canSkipTrivia = (flags &&& FSharpLexerFlags.SkipTrivia) = FSharpLexerFlags.SkipTrivia - let isLightSyntaxOn = (flags &&& FSharpLexerFlags.LightSyntaxOn) = FSharpLexerFlags.LightSyntaxOn - let isCompiling = (flags &&& FSharpLexerFlags.Compiling) = FSharpLexerFlags.Compiling - let isCompilingFSharpCore = (flags &&& FSharpLexerFlags.CompilingFSharpCore) = FSharpLexerFlags.CompilingFSharpCore - let canUseLexFilter = (flags &&& FSharpLexerFlags.UseLexFilter) = FSharpLexerFlags.UseLexFilter - - let lexbuf = UnicodeLexing.SourceTextAsLexbuf(reportLibraryOnlyFeatures, langVersion, text) + let lexWithDiagnosticsLogger + (text: ISourceText) + conditionalDefines + (flags: FSharpLexerFlags) + reportLibraryOnlyFeatures + langVersion + diagnosticsLogger + onToken + pathMap + (ct: CancellationToken) + = + let canSkipTrivia = + (flags &&& FSharpLexerFlags.SkipTrivia) = FSharpLexerFlags.SkipTrivia + + let isLightSyntaxOn = + (flags &&& FSharpLexerFlags.LightSyntaxOn) = FSharpLexerFlags.LightSyntaxOn + + let isCompiling = + (flags &&& FSharpLexerFlags.Compiling) = FSharpLexerFlags.Compiling + + let isCompilingFSharpCore = + (flags &&& FSharpLexerFlags.CompilingFSharpCore) = FSharpLexerFlags.CompilingFSharpCore + + let canUseLexFilter = + (flags &&& FSharpLexerFlags.UseLexFilter) = FSharpLexerFlags.UseLexFilter + + let lexbuf = + UnicodeLexing.SourceTextAsLexbuf(reportLibraryOnlyFeatures, langVersion, text) + let indentationSyntaxStatus = IndentationAwareSyntaxStatus(isLightSyntaxOn, true) - let lexargs = mkLexargs (conditionalDefines, indentationSyntaxStatus, LexResourceManager(0), [], diagnosticsLogger, pathMap) - let lexargs = { lexargs with applyLineDirectives = isCompiling } + + let lexargs = + mkLexargs (conditionalDefines, indentationSyntaxStatus, LexResourceManager(0), [], diagnosticsLogger, pathMap) + + let lexargs = + { lexargs with + applyLineDirectives = isCompiling + } let getNextToken = let lexer = Lexer.token lexargs canSkipTrivia if canUseLexFilter then - let lexFilter = LexFilter.LexFilter(lexargs.indentationSyntaxStatus, isCompilingFSharpCore, lexer, lexbuf) + let lexFilter = + LexFilter.LexFilter(lexargs.indentationSyntaxStatus, isCompilingFSharpCore, lexer, lexbuf) + (fun _ -> lexFilter.GetToken()) else lexer use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) + use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> DiscardErrorsLogger) resetLexbufPos "" lexbuf + while not lexbuf.IsPastEndOfStream do - ct.ThrowIfCancellationRequested () + ct.ThrowIfCancellationRequested() onToken (getNextToken lexbuf) lexbuf.LexemeRange let lex text conditionalDefines flags reportLibraryOnlyFeatures langVersion lexCallback pathMap ct = - let diagnosticsLogger = CompilationDiagnosticLogger("Lexer", FSharpDiagnosticOptions.Default) - lexWithDiagnosticsLogger text conditionalDefines flags reportLibraryOnlyFeatures langVersion diagnosticsLogger lexCallback pathMap ct - -[] + let diagnosticsLogger = + CompilationDiagnosticLogger("Lexer", FSharpDiagnosticOptions.Default) + + lexWithDiagnosticsLogger + text + conditionalDefines + flags + reportLibraryOnlyFeatures + langVersion + diagnosticsLogger + lexCallback + pathMap + ct + +[] type FSharpLexer = static member Tokenize(text: ISourceText, tokenCallback, ?langVersion, ?filePath: string, ?conditionalDefines, ?flags, ?pathMap, ?ct) = @@ -1570,10 +1871,11 @@ type FSharpLexer = ||> Seq.fold (fun state pair -> state |> PathMap.addMapping pair.Key pair.Value) let onToken tok m = - let fsTok = FSharpToken(tok, m) - match fsTok.Kind with - | FSharpTokenKind.None -> () - | _ -> tokenCallback fsTok + let fsTok = FSharpToken(tok, m) + + match fsTok.Kind with + | FSharpTokenKind.None -> () + | _ -> tokenCallback fsTok let reportLibraryOnlyFeatures = true lex text conditionalDefines flags reportLibraryOnlyFeatures langVersion onToken pathMap ct diff --git a/src/Compiler/Service/ServiceLexing.fsi b/src/Compiler/Service/ServiceLexing.fsi index 5e2e5a9732d0..df1dfdde2942 100755 --- a/src/Compiler/Service/ServiceLexing.fsi +++ b/src/Compiler/Service/ServiceLexing.fsi @@ -6,6 +6,7 @@ open System open System.Threading open FSharp.Compiler open FSharp.Compiler.Text + #nowarn "57" /// Represents encoded information for the end-of-line continuation of lexing diff --git a/src/Compiler/Service/ServiceNavigation.fs b/src/Compiler/Service/ServiceNavigation.fs index 169253987451..61dffe2213ca 100755 --- a/src/Compiler/Service/ServiceNavigation.fs +++ b/src/Compiler/Service/ServiceNavigation.fs @@ -40,10 +40,20 @@ type NavigationEntityKind = /// Represents an item to be displayed in the navigation bar [] -type NavigationItem(uniqueName: string, name: string, kind: NavigationItemKind, glyph: FSharpGlyph, range: range, - bodyRange: range, singleTopLevel: bool, enclosingEntityKind: NavigationEntityKind, - isAbstract: bool, access: SynAccess option) = - +type NavigationItem + ( + uniqueName: string, + name: string, + kind: NavigationItemKind, + glyph: FSharpGlyph, + range: range, + bodyRange: range, + singleTopLevel: bool, + enclosingEntityKind: NavigationEntityKind, + isAbstract: bool, + access: SynAccess option + ) = + member _.bodyRange = bodyRange member _.UniqueName = uniqueName @@ -56,34 +66,36 @@ type NavigationItem(uniqueName: string, name: string, kind: NavigationItemKind, member _.Range = range - member _.BodyRange = bodyRange + member _.BodyRange = bodyRange member _.IsSingleTopLevel = singleTopLevel member _.EnclosingEntityKind = enclosingEntityKind member _.IsAbstract = isAbstract - + member _.Access = access - + member _.WithUniqueName(uniqueName: string) = - NavigationItem(uniqueName, name, kind, glyph, range, bodyRange, singleTopLevel, enclosingEntityKind, isAbstract, access) + NavigationItem(uniqueName, name, kind, glyph, range, bodyRange, singleTopLevel, enclosingEntityKind, isAbstract, access) - static member Create(name, kind, glyph, range, bodyRange, singleTopLevel, enclosingEntityKind, isAbstract, access) = - NavigationItem("", name, kind, glyph, range, bodyRange, singleTopLevel, enclosingEntityKind, isAbstract, access) + static member Create(name, kind, glyph, range, bodyRange, singleTopLevel, enclosingEntityKind, isAbstract, access) = + NavigationItem("", name, kind, glyph, range, bodyRange, singleTopLevel, enclosingEntityKind, isAbstract, access) /// Represents top-level declarations (that should be in the type drop-down) /// with nested declarations (that can be shown in the member drop-down) [] -type NavigationTopLevelDeclaration = - { Declaration: NavigationItem - Nested: NavigationItem[] } - +type NavigationTopLevelDeclaration = + { + Declaration: NavigationItem + Nested: NavigationItem[] + } + /// Represents result of 'GetNavigationItems' operation - this contains /// all the members and currently selected indices. First level correspond to /// types & modules and second level are methods etc. [] -type NavigationItems(declarations:NavigationTopLevelDeclaration[]) = +type NavigationItems(declarations: NavigationTopLevelDeclaration[]) = member _.Declarations = declarations module NavigationImpl = @@ -91,454 +103,568 @@ module NavigationImpl = if equals r1 range.Zero then r2 elif equals r2 range.Zero then r1 else unionRanges r1 r2 - - let rangeOfDecls2 f decls = - match decls |> List.map (f >> (fun (d:NavigationItem) -> d.bodyRange)) with + + let rangeOfDecls2 f decls = + match decls |> List.map (f >> (fun (d: NavigationItem) -> d.bodyRange)) with | hd :: tl -> tl |> List.fold unionRangesChecked hd | [] -> range.Zero - + let rangeOfDecls = rangeOfDecls2 fst - let moduleRange (idm:range) others = - unionRangesChecked idm.EndRange (rangeOfDecls2 (fun (a, _, _) -> a) others) - + let moduleRange (idm: range) others = + unionRangesChecked idm.EndRange (rangeOfDecls2 (fun (a, _, _) -> a) others) + let fldspecRange fldspec = - match fldspec with - | SynUnionCaseKind.Fields(flds) -> flds |> List.fold (fun st (SynField(_, _, _, _, _, _, _, m)) -> unionRangesChecked m st) range.Zero - | SynUnionCaseKind.FullType(ty, _) -> ty.Range - + match fldspec with + | SynUnionCaseKind.Fields (flds) -> + flds + |> List.fold (fun st (SynField (_, _, _, _, _, _, _, m)) -> unionRangesChecked m st) range.Zero + | SynUnionCaseKind.FullType (ty, _) -> ty.Range + let bodyRange mb decls = - unionRangesChecked (rangeOfDecls decls) mb - - /// Get information for implementation file + unionRangesChecked (rangeOfDecls decls) mb + + /// Get information for implementation file let getNavigationFromImplFile (modules: SynModuleOrNamespace list) = // Map for dealing with name conflicts let names = Dictionary() - let addItemName name = + let addItemName name = let count = match names.TryGetValue name with | true, count -> count + 1 | _ -> 1 + names[name] <- count count - - let uniqueName name idx = + + let uniqueName name idx = let total = names[name] sprintf "%s_%d_of_%d" name idx total - // Create declaration (for the left dropdown) - let createDeclLid(baseName, lid, kind, baseGlyph, m, bodym, nested, enclosingEntityKind, access) = + // Create declaration (for the left dropdown) + let createDeclLid (baseName, lid, kind, baseGlyph, m, bodym, nested, enclosingEntityKind, access) = let name = (if baseName <> "" then baseName + "." else "") + textOfLid lid - let item = NavigationItem.Create (name, kind, baseGlyph, m, bodym, false, enclosingEntityKind, false, access) + let item = NavigationItem.Create(name, kind, baseGlyph, m, bodym, false, enclosingEntityKind, false, access) item, addItemName name, nested - - let createDecl(baseName, id:Ident, kind, baseGlyph, m, bodym, nested, enclosingEntityKind, isAbstract, access) = + + let createDecl (baseName, id: Ident, kind, baseGlyph, m, bodym, nested, enclosingEntityKind, isAbstract, access) = let name = (if baseName <> "" then baseName + "." else "") + id.idText - let item = NavigationItem.Create (name, kind, baseGlyph, m, bodym, false, enclosingEntityKind, isAbstract, access) + let item = NavigationItem.Create(name, kind, baseGlyph, m, bodym, false, enclosingEntityKind, isAbstract, access) item, addItemName name, nested - - let createTypeDecl(baseName, lid, baseGlyph, m, bodym, nested, enclosingEntityKind, access) = - createDeclLid(baseName, lid, NavigationItemKind.Type, baseGlyph, m, bodym, nested, enclosingEntityKind, access) - + + let createTypeDecl (baseName, lid, baseGlyph, m, bodym, nested, enclosingEntityKind, access) = + createDeclLid (baseName, lid, NavigationItemKind.Type, baseGlyph, m, bodym, nested, enclosingEntityKind, access) + // Create member-kind-of-thing for the right dropdown - let createMemberLid(lid, kind, baseGlyph, m, enclosingEntityKind, isAbstract, access) = + let createMemberLid (lid, kind, baseGlyph, m, enclosingEntityKind, isAbstract, access) = let item = NavigationItem.Create(textOfLid lid, kind, baseGlyph, m, m, false, enclosingEntityKind, isAbstract, access) - item, addItemName(textOfLid lid) + item, addItemName (textOfLid lid) - let createMember(id:Ident, kind, baseGlyph, m, enclosingEntityKind, isAbstract, access) = + let createMember (id: Ident, kind, baseGlyph, m, enclosingEntityKind, isAbstract, access) = let item = NavigationItem.Create(id.idText, kind, baseGlyph, m, m, false, enclosingEntityKind, isAbstract, access) - item, addItemName(id.idText) + item, addItemName (id.idText) // Process let-binding let processBinding isMember enclosingEntityKind isAbstract synBinding = - let (SynBinding(valData=valData; headPat=synPat; expr=synExpr)) = synBinding - let (SynValData(memberOpt, _, _)) = valData - let m = - match synExpr with + let (SynBinding (valData = valData; headPat = synPat; expr = synExpr)) = synBinding + let (SynValData (memberOpt, _, _)) = valData + + let m = + match synExpr with | SynExpr.Typed (e, _, _) -> e.Range // fix range for properties with type annotations | _ -> synExpr.Range match synPat, memberOpt with - | SynPat.LongIdent(longDotId=SynLongIdent(lid,_,_); accessibility=access), Some(flags) when isMember -> + | SynPat.LongIdent (longDotId = SynLongIdent (lid, _, _); accessibility = access), Some (flags) when isMember -> let icon, kind = - match flags.MemberKind with - | SynMemberKind.ClassConstructor - | SynMemberKind.Constructor - | SynMemberKind.Member -> - let glyph = if flags.IsOverrideOrExplicitImpl then FSharpGlyph.OverridenMethod else FSharpGlyph.Method + match flags.MemberKind with + | SynMemberKind.ClassConstructor + | SynMemberKind.Constructor + | SynMemberKind.Member -> + let glyph = + if flags.IsOverrideOrExplicitImpl then + FSharpGlyph.OverridenMethod + else + FSharpGlyph.Method + glyph, NavigationItemKind.Method - | SynMemberKind.PropertyGetSet - | SynMemberKind.PropertySet - | SynMemberKind.PropertyGet -> FSharpGlyph.Property, NavigationItemKind.Property - let lidShow, rangeMerge = - match lid with - | _thisVar :: nm :: _ -> (List.tail lid, nm.idRange) - | hd :: _ -> (lid, hd.idRange) - | _ -> (lid, m) + | SynMemberKind.PropertyGetSet + | SynMemberKind.PropertySet + | SynMemberKind.PropertyGet -> FSharpGlyph.Property, NavigationItemKind.Property + + let lidShow, rangeMerge = + match lid with + | _thisVar :: nm :: _ -> (List.tail lid, nm.idRange) + | hd :: _ -> (lid, hd.idRange) + | _ -> (lid, m) + let m = unionRanges rangeMerge m - [ createMemberLid(lidShow, kind, icon, m, enclosingEntityKind, isAbstract, access) ] - | SynPat.LongIdent(longDotId=SynLongIdent(lid,_,_); accessibility=access), _ -> + [ + createMemberLid (lidShow, kind, icon, m, enclosingEntityKind, isAbstract, access) + ] + + | SynPat.LongIdent (longDotId = SynLongIdent (lid, _, _); accessibility = access), _ -> let m = unionRanges (List.head lid).idRange m - [ createMemberLid(lid, NavigationItemKind.Field, FSharpGlyph.Field, m, enclosingEntityKind, isAbstract, access) ] - | SynPat.Named (SynIdent(id,_), _, access, _), _ - | SynPat.As(_, SynPat.Named (SynIdent(id,_), _, access, _), _), _ -> + [ + createMemberLid (lid, NavigationItemKind.Field, FSharpGlyph.Field, m, enclosingEntityKind, isAbstract, access) + ] + + | SynPat.Named (SynIdent (id, _), _, access, _), _ + | SynPat.As (_, SynPat.Named (SynIdent (id, _), _, access, _), _), _ -> let glyph = if isMember then FSharpGlyph.Method else FSharpGlyph.Field let m = unionRanges id.idRange m - [ createMember(id, NavigationItemKind.Field, glyph, m, enclosingEntityKind, isAbstract, access) ] + + [ + createMember (id, NavigationItemKind.Field, glyph, m, enclosingEntityKind, isAbstract, access) + ] | _ -> [] - + // Process a class declaration or F# type declaration let rec processExnDefnRepr baseName nested synExnRepr = - let (SynExceptionDefnRepr(_, ucase, _, _, access, m)) = synExnRepr - let (SynUnionCase(ident=SynIdent(id,_); caseType=fldspec)) = ucase + let (SynExceptionDefnRepr (_, ucase, _, _, access, m)) = synExnRepr + let (SynUnionCase (ident = SynIdent (id, _); caseType = fldspec)) = ucase let bodym = fldspecRange fldspec - [ createDecl(baseName, id, NavigationItemKind.Exception, FSharpGlyph.Exception, m, bodym, nested, NavigationEntityKind.Exception, false, access) ] + + [ + createDecl (baseName, id, NavigationItemKind.Exception, FSharpGlyph.Exception, m, bodym, nested, NavigationEntityKind.Exception, false, access) + ] // Process a class declaration or F# type declaration - and processExnDefn baseName synExnDefn = - let (SynExceptionDefn(repr, _, membDefns, _)) = synExnDefn + and processExnDefn baseName synExnDefn = + let (SynExceptionDefn (repr, _, membDefns, _)) = synExnDefn let nested = processMembers membDefns NavigationEntityKind.Exception |> snd processExnDefnRepr baseName nested repr and processTycon baseName synTypeDefn = - let (SynTypeDefn(typeInfo=typeInfo; typeRepr=repr; members=membDefns; range=m)) = synTypeDefn - let (SynComponentInfo(longId=lid; accessibility=access)) = typeInfo + let (SynTypeDefn (typeInfo = typeInfo; typeRepr = repr; members = membDefns; range = m)) = synTypeDefn + let (SynComponentInfo (longId = lid; accessibility = access)) = typeInfo let topMembers = processMembers membDefns NavigationEntityKind.Class |> snd match repr with | SynTypeDefnRepr.Exception repr -> processExnDefnRepr baseName [] repr - | SynTypeDefnRepr.ObjectModel(_, membDefns, mb) -> + | SynTypeDefnRepr.ObjectModel (_, membDefns, mb) -> // F# class declaration let members = processMembers membDefns NavigationEntityKind.Class |> snd - let nested = members@topMembers + let nested = members @ topMembers let bodym = bodyRange mb nested - [ createTypeDecl(baseName, lid, FSharpGlyph.Class, m, bodym, nested, NavigationEntityKind.Class, access) ] - | SynTypeDefnRepr.Simple(simple, _) -> + [ + createTypeDecl (baseName, lid, FSharpGlyph.Class, m, bodym, nested, NavigationEntityKind.Class, access) + ] + + | SynTypeDefnRepr.Simple (simple, _) -> // F# type declaration match simple with - | SynTypeDefnSimpleRepr.Union(_, cases, mb) -> - let cases = - [ for SynUnionCase(ident=SynIdent(id,_); caseType=fldspec) in cases -> - let bodym = unionRanges (fldspecRange fldspec) id.idRange - createMember(id, NavigationItemKind.Other, FSharpGlyph.Struct, bodym, NavigationEntityKind.Union, false, access) ] - let nested = cases@topMembers + | SynTypeDefnSimpleRepr.Union (_, cases, mb) -> + let cases = + [ + for SynUnionCase (ident = SynIdent (id, _); caseType = fldspec) in cases -> + let bodym = unionRanges (fldspecRange fldspec) id.idRange + createMember (id, NavigationItemKind.Other, FSharpGlyph.Struct, bodym, NavigationEntityKind.Union, false, access) + ] + + let nested = cases @ topMembers let bodym = bodyRange mb nested - [ createTypeDecl(baseName, lid, FSharpGlyph.Union, m, bodym, nested, NavigationEntityKind.Union, access) ] - | SynTypeDefnSimpleRepr.Enum(cases, mb) -> - let cases = - [ for SynEnumCase(ident=SynIdent(id,_); range=m) in cases -> - createMember(id, NavigationItemKind.Field, FSharpGlyph.EnumMember, m, NavigationEntityKind.Enum, false, access) ] - let nested = cases@topMembers + [ + createTypeDecl (baseName, lid, FSharpGlyph.Union, m, bodym, nested, NavigationEntityKind.Union, access) + ] + + | SynTypeDefnSimpleRepr.Enum (cases, mb) -> + let cases = + [ + for SynEnumCase (ident = SynIdent (id, _); range = m) in cases -> + createMember (id, NavigationItemKind.Field, FSharpGlyph.EnumMember, m, NavigationEntityKind.Enum, false, access) + ] + + let nested = cases @ topMembers let bodym = bodyRange mb nested - [ createTypeDecl(baseName, lid, FSharpGlyph.Enum, m, bodym, nested, NavigationEntityKind.Enum, access) ] - - | SynTypeDefnSimpleRepr.Record(_, fields, mb) -> - let fields = - [ for SynField(_, _, id, _, _, _, _, m) in fields do - match id with - | Some ident -> - yield createMember(ident, NavigationItemKind.Field, FSharpGlyph.Field, m, NavigationEntityKind.Record, false, access) - | _ -> - () ] - let nested = fields@topMembers + + [ + createTypeDecl (baseName, lid, FSharpGlyph.Enum, m, bodym, nested, NavigationEntityKind.Enum, access) + ] + + | SynTypeDefnSimpleRepr.Record (_, fields, mb) -> + let fields = + [ + for SynField (_, _, id, _, _, _, _, m) in fields do + match id with + | Some ident -> yield createMember (ident, NavigationItemKind.Field, FSharpGlyph.Field, m, NavigationEntityKind.Record, false, access) + | _ -> () + ] + + let nested = fields @ topMembers let bodym = bodyRange mb nested - [ createTypeDecl(baseName, lid, FSharpGlyph.Type, m, bodym, nested, NavigationEntityKind.Record, access) ] - | SynTypeDefnSimpleRepr.TypeAbbrev(_, _, mb) -> + [ + createTypeDecl (baseName, lid, FSharpGlyph.Type, m, bodym, nested, NavigationEntityKind.Record, access) + ] + + | SynTypeDefnSimpleRepr.TypeAbbrev (_, _, mb) -> let bodym = bodyRange mb topMembers - [ createTypeDecl(baseName, lid, FSharpGlyph.Typedef, m, bodym, topMembers, NavigationEntityKind.Class, access) ] - - //| SynTypeDefnSimpleRepr.General of TyconKind * (SynType * Range * ident option) list * (valSpfn * MemberFlags) list * fieldDecls * bool * bool * Range + + [ + createTypeDecl (baseName, lid, FSharpGlyph.Typedef, m, bodym, topMembers, NavigationEntityKind.Class, access) + ] + + //| SynTypeDefnSimpleRepr.General of TyconKind * (SynType * Range * ident option) list * (valSpfn * MemberFlags) list * fieldDecls * bool * bool * Range //| SynTypeDefnSimpleRepr.LibraryOnlyILAssembly of ILType * Range //| TyconCore_repr_hidden of Range - | _ -> [] - - // Returns class-members for the right dropdown - and processMembers members enclosingEntityKind = - let members = - members + | _ -> [] + + // Returns class-members for the right dropdown + and processMembers members enclosingEntityKind = + let members = + members |> List.groupBy (fun x -> x.Range) |> List.map (fun (range, members) -> range, (match members with - | [memb] -> + | [ memb ] -> match memb with - | SynMemberDefn.LetBindings(binds, _, _, _) -> List.collect (processBinding false enclosingEntityKind false) binds - | SynMemberDefn.Member(bind, _) -> processBinding true enclosingEntityKind false bind - | SynMemberDefn.ValField(SynField(_, _, Some(rcid), _, _, _, access, range), _) -> - [ createMember(rcid, NavigationItemKind.Field, FSharpGlyph.Field, range, enclosingEntityKind, false, access) ] - | SynMemberDefn.AutoProperty(ident=id; accessibility=access) -> - [ createMember(id, NavigationItemKind.Field, FSharpGlyph.Field, id.idRange, enclosingEntityKind, false, access) ] - | SynMemberDefn.AbstractSlot(SynValSig(ident=SynIdent(id,_); synType=ty; accessibility=access), _, _) -> - [ createMember(id, NavigationItemKind.Method, FSharpGlyph.OverridenMethod, ty.Range, enclosingEntityKind, true, access) ] - | SynMemberDefn.NestedType _ -> failwith "tycon as member????" //processTycon tycon - | SynMemberDefn.Interface(members=Some(membs)) -> - processMembers membs enclosingEntityKind |> snd - | _ -> [] + | SynMemberDefn.LetBindings (binds, _, _, _) -> List.collect (processBinding false enclosingEntityKind false) binds + | SynMemberDefn.Member (bind, _) -> processBinding true enclosingEntityKind false bind + | SynMemberDefn.ValField (SynField (_, _, Some (rcid), _, _, _, access, range), _) -> + [ + createMember (rcid, NavigationItemKind.Field, FSharpGlyph.Field, range, enclosingEntityKind, false, access) + ] + | SynMemberDefn.AutoProperty (ident = id; accessibility = access) -> + [ + createMember (id, NavigationItemKind.Field, FSharpGlyph.Field, id.idRange, enclosingEntityKind, false, access) + ] + | SynMemberDefn.AbstractSlot (SynValSig (ident = SynIdent (id, _); synType = ty; accessibility = access), _, _) -> + [ + createMember (id, NavigationItemKind.Method, FSharpGlyph.OverridenMethod, ty.Range, enclosingEntityKind, true, access) + ] + | SynMemberDefn.NestedType _ -> failwith "tycon as member????" //processTycon tycon + | SynMemberDefn.Interface(members = Some (membs)) -> processMembers membs enclosingEntityKind |> snd + | _ -> [] // can happen if one is a getter and one is a setter - | [SynMemberDefn.Member(memberDefn=SynBinding(headPat=SynPat.LongIdent(longDotId=lid1; extraId=Some(info1))) as binding1) - SynMemberDefn.Member(memberDefn=SynBinding(headPat=SynPat.LongIdent(longDotId=lid2; extraId=Some(info2))) as binding2)] -> + | [ SynMemberDefn.Member(memberDefn = SynBinding(headPat = SynPat.LongIdent (longDotId = lid1; extraId = Some (info1))) as binding1) + SynMemberDefn.Member(memberDefn = SynBinding(headPat = SynPat.LongIdent (longDotId = lid2; extraId = Some (info2))) as binding2) ] -> // ensure same long id - assert((lid1.LongIdent,lid2.LongIdent) ||> List.forall2 (fun x y -> x.idText = y.idText)) + assert + ((lid1.LongIdent, lid2.LongIdent) + ||> 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")) + assert + ((info1.idText = "set" && info2.idText = "get") + || (info2.idText = "set" && info1.idText = "get")) // both binding1 and binding2 have same range, so just try the first one, else try the second one match processBinding true enclosingEntityKind false binding1 with | [] -> processBinding true enclosingEntityKind false binding2 | x -> x - | _ -> [])) - + | _ -> [])) + let m2 = members |> Seq.map fst |> Seq.fold unionRangesChecked range.Zero let items = members |> List.collect snd m2, items // Process declarations in a module that belong to the right drop-down (let bindings) let processNestedDeclarations decls = - [ for decl in decls do - match decl with - | SynModuleDecl.Let(_, binds, _) -> - for bind in binds do - yield! processBinding false NavigationEntityKind.Module false bind - | _ -> () ] + [ + for decl in decls do + match decl with + | SynModuleDecl.Let (_, binds, _) -> + for bind in binds do + yield! processBinding false NavigationEntityKind.Module false bind + | _ -> () + ] // Process declarations nested in a module that should be displayed in the left dropdown - // (such as type declarations, nested modules etc.) - let rec processNavigationTopLevelDeclarations(baseName, decls) = - [ for decl in decls do - match decl with - | SynModuleDecl.ModuleAbbrev(id, lid, m) -> - let bodym = rangeOfLid lid - createDecl(baseName, id, NavigationItemKind.Module, FSharpGlyph.Module, m, bodym, [], NavigationEntityKind.Namespace, false, None) - - | SynModuleDecl.NestedModule(moduleInfo=SynComponentInfo(longId=lid; accessibility=access); decls=decls; range=m) -> - // Find let bindings (for the right dropdown) - let nested = processNestedDeclarations(decls) - let newBaseName = (if (baseName = "") then "" else baseName+".") + (textOfLid lid) - let other = processNavigationTopLevelDeclarations(newBaseName, decls) - - let bodym = unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other) - createDeclLid(baseName, lid, NavigationItemKind.Module, FSharpGlyph.Module, m, bodym, nested, NavigationEntityKind.Module, access) - // Get nested modules and types (for the left dropdown) - yield! other - - | SynModuleDecl.Types(tydefs, _) -> - for tydef in tydefs do - yield! processTycon baseName tydef - | SynModuleDecl.Exception (defn,_) -> - yield! processExnDefn baseName defn - | _ -> () + // (such as type declarations, nested modules etc.) + let rec processNavigationTopLevelDeclarations (baseName, decls) = + [ + for decl in decls do + match decl with + | SynModuleDecl.ModuleAbbrev (id, lid, m) -> + let bodym = rangeOfLid lid + createDecl (baseName, id, NavigationItemKind.Module, FSharpGlyph.Module, m, bodym, [], NavigationEntityKind.Namespace, false, None) + + | SynModuleDecl.NestedModule (moduleInfo = SynComponentInfo (longId = lid; accessibility = access); decls = decls; range = m) -> + // Find let bindings (for the right dropdown) + let nested = processNestedDeclarations (decls) + let newBaseName = (if (baseName = "") then "" else baseName + ".") + (textOfLid lid) + let other = processNavigationTopLevelDeclarations (newBaseName, decls) + + let bodym = unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other) + createDeclLid (baseName, lid, NavigationItemKind.Module, FSharpGlyph.Module, m, bodym, nested, NavigationEntityKind.Module, access) + // Get nested modules and types (for the left dropdown) + yield! other + + | SynModuleDecl.Types (tydefs, _) -> + for tydef in tydefs do + yield! processTycon baseName tydef + | SynModuleDecl.Exception (defn, _) -> yield! processExnDefn baseName defn + | _ -> () ] - // Collect all the items - let items = + // Collect all the items + let items = // Show base name for this module only if it's not the root one let singleTopLevel = (modules.Length = 1) - [ for modul in modules do - let (SynModuleOrNamespace(id, _isRec, kind, decls, _, _, access, m, _)) = modul - let baseName = if (not singleTopLevel) then textOfLid id else "" - // Find let bindings (for the right dropdown) - let nested = processNestedDeclarations(decls) - // Get nested modules and types (for the left dropdown) - let other = processNavigationTopLevelDeclarations(baseName, decls) - - // Create explicitly - it can be 'single top level' thing that is hidden - if not (List.isEmpty id) then - let kind = if kind.IsModule then NavigationItemKind.ModuleFile else NavigationItemKind.Namespace - let bodym = unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid id) other) - let nm = textOfLid id - let item = NavigationItem.Create (nm, kind, FSharpGlyph.Module, m, bodym, singleTopLevel, NavigationEntityKind.Module, false, access) - let decl = (item, addItemName(nm), nested) - decl - yield! other ] - - let items = - [| for (d, idx, nested) in items do - let nested = nested |> Array.ofList |> Array.map (fun (decl, idx) -> decl.WithUniqueName(uniqueName d.Name idx)) + [ + for modul in modules do + let (SynModuleOrNamespace (id, _isRec, kind, decls, _, _, access, m, _)) = modul + let baseName = if (not singleTopLevel) then textOfLid id else "" + // Find let bindings (for the right dropdown) + let nested = processNestedDeclarations (decls) + // Get nested modules and types (for the left dropdown) + let other = processNavigationTopLevelDeclarations (baseName, decls) + + // Create explicitly - it can be 'single top level' thing that is hidden + if not (List.isEmpty id) then + let kind = + if kind.IsModule then + NavigationItemKind.ModuleFile + else + NavigationItemKind.Namespace + + let bodym = unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid id) other) + let nm = textOfLid id + + let item = + NavigationItem.Create(nm, kind, FSharpGlyph.Module, m, bodym, singleTopLevel, NavigationEntityKind.Module, false, access) + + let decl = (item, addItemName (nm), nested) + decl + + yield! other + ] + + let items = + [| + for (d, idx, nested) in items do + let nested = + nested + |> Array.ofList + |> Array.map (fun (decl, idx) -> decl.WithUniqueName(uniqueName d.Name idx)) - nested |> Array.sortInPlaceWith (fun a b -> compare a.Name b.Name) + nested |> Array.sortInPlaceWith (fun a b -> compare a.Name b.Name) - { Declaration = d.WithUniqueName(uniqueName d.Name idx); Nested = nested } |] + { + Declaration = d.WithUniqueName(uniqueName d.Name idx) + Nested = nested + } + |] - items |> Array.sortInPlaceWith (fun a b -> compare a.Declaration.Name b.Declaration.Name) + items + |> Array.sortInPlaceWith (fun a b -> compare a.Declaration.Name b.Declaration.Name) NavigationItems(items) - /// Get information for signature file + /// Get information for signature file let getNavigationFromSigFile (modules: SynModuleOrNamespaceSig list) = // Map for dealing with name conflicts - let mutable nameMap = Map.empty + let mutable nameMap = Map.empty - let addItemName name = + let addItemName name = let count = defaultArg (nameMap |> Map.tryFind name) 0 nameMap <- (Map.add name (count + 1) nameMap) (count + 1) - let uniqueName name idx = + let uniqueName name idx = let total = Map.find name nameMap sprintf "%s_%d_of_%d" name idx total - // Create declaration (for the left dropdown) - let createDeclLid(baseName, lid, kind, baseGlyph, m, bodym, nested, enclosingEntityKind, access) = + // Create declaration (for the left dropdown) + let createDeclLid (baseName, lid, kind, baseGlyph, m, bodym, nested, enclosingEntityKind, access) = let name = (if baseName <> "" then baseName + "." else "") + (textOfLid lid) let item = NavigationItem.Create(name, kind, baseGlyph, m, bodym, false, enclosingEntityKind, false, access) item, addItemName name, nested - - let createTypeDecl(baseName, lid, baseGlyph, m, bodym, nested, enclosingEntityKind, access) = - createDeclLid(baseName, lid, NavigationItemKind.Type, baseGlyph, m, bodym, nested, enclosingEntityKind, access) - - let createDecl(baseName, id:Ident, kind, baseGlyph, m, bodym, nested, enclosingEntityKind, isAbstract, access) = + + let createTypeDecl (baseName, lid, baseGlyph, m, bodym, nested, enclosingEntityKind, access) = + createDeclLid (baseName, lid, NavigationItemKind.Type, baseGlyph, m, bodym, nested, enclosingEntityKind, access) + + let createDecl (baseName, id: Ident, kind, baseGlyph, m, bodym, nested, enclosingEntityKind, isAbstract, access) = let name = (if baseName <> "" then baseName + "." else "") + id.idText - let item = NavigationItem.Create (name, kind, baseGlyph, m, bodym, false, enclosingEntityKind, isAbstract, access) + let item = NavigationItem.Create(name, kind, baseGlyph, m, bodym, false, enclosingEntityKind, isAbstract, access) item, addItemName name, nested - - let createMember(id:Ident, kind, baseGlyph, m, enclosingEntityKind, isAbstract, access) = + + let createMember (id: Ident, kind, baseGlyph, m, enclosingEntityKind, isAbstract, access) = let item = NavigationItem.Create(id.idText, kind, baseGlyph, m, m, false, enclosingEntityKind, isAbstract, access) - item, addItemName(id.idText) + item, addItemName (id.idText) let rec processExnRepr baseName nested inp = - let (SynExceptionDefnRepr(_, SynUnionCase(ident=SynIdent(id,_); caseType=fldspec), _, _, access, m)) = inp + let (SynExceptionDefnRepr (_, SynUnionCase (ident = SynIdent (id, _); caseType = fldspec), _, _, access, m)) = inp let bodym = fldspecRange fldspec - [ createDecl(baseName, id, NavigationItemKind.Exception, FSharpGlyph.Exception, m, bodym, nested, NavigationEntityKind.Exception, false, access) ] - - and processExnSig baseName inp = - let (SynExceptionSig(exnRepr=repr; members=memberSigs)) = inp + + [ + createDecl (baseName, id, NavigationItemKind.Exception, FSharpGlyph.Exception, m, bodym, nested, NavigationEntityKind.Exception, false, access) + ] + + and processExnSig baseName inp = + let (SynExceptionSig (exnRepr = repr; members = memberSigs)) = inp let nested = processSigMembers memberSigs processExnRepr baseName nested repr and processTycon baseName inp = - let (SynTypeDefnSig(typeInfo=SynComponentInfo(longId=lid; accessibility=access); typeRepr=repr; members=membDefns; range=m)) = inp + let (SynTypeDefnSig (typeInfo = SynComponentInfo (longId = lid; accessibility = access); typeRepr = repr; members = membDefns; range = m)) = + inp + let topMembers = processSigMembers membDefns - [ match repr with - | SynTypeDefnSigRepr.Exception repr -> - yield! processExnRepr baseName [] repr - | SynTypeDefnSigRepr.ObjectModel(_, membDefns, mb) -> - // F# class declaration - let members = processSigMembers membDefns - let nested = members @ topMembers - let bodym = bodyRange mb nested - createTypeDecl(baseName, lid, FSharpGlyph.Class, m, bodym, nested, NavigationEntityKind.Class, access) - | SynTypeDefnSigRepr.Simple(simple, _) -> - // F# type declaration - match simple with - | SynTypeDefnSimpleRepr.Union(_, cases, mb) -> - let cases = - [ for SynUnionCase(ident=SynIdent(id,_); caseType=fldspec) in cases -> - let m = unionRanges (fldspecRange fldspec) id.idRange - createMember(id, NavigationItemKind.Other, FSharpGlyph.Struct, m, NavigationEntityKind.Union, false, access) ] - let nested = cases@topMembers - let bodym = bodyRange mb nested - createTypeDecl(baseName, lid, FSharpGlyph.Union, m, bodym, nested, NavigationEntityKind.Union, access) - | SynTypeDefnSimpleRepr.Enum(cases, mb) -> - let cases = - [ for SynEnumCase(ident = SynIdent(id,_); range = m) in cases -> - createMember(id, NavigationItemKind.Field, FSharpGlyph.EnumMember, m, NavigationEntityKind.Enum, false, access) ] - let nested = cases@topMembers - let bodym = bodyRange mb nested - createTypeDecl(baseName, lid, FSharpGlyph.Enum, m, bodym, nested, NavigationEntityKind.Enum, access) - | SynTypeDefnSimpleRepr.Record(_, fields, mb) -> - let fields = - [ for SynField(_, _, id, _, _, _, _, m) in fields do - match id with - | Some ident -> - yield createMember(ident, NavigationItemKind.Field, FSharpGlyph.Field, m, NavigationEntityKind.Record, false, access) - | _ -> - () ] - let nested = fields@topMembers + + [ + match repr with + | SynTypeDefnSigRepr.Exception repr -> yield! processExnRepr baseName [] repr + | SynTypeDefnSigRepr.ObjectModel (_, membDefns, mb) -> + // F# class declaration + let members = processSigMembers membDefns + let nested = members @ topMembers let bodym = bodyRange mb nested - createTypeDecl(baseName, lid, FSharpGlyph.Type, m, bodym, nested, NavigationEntityKind.Record, access) - | SynTypeDefnSimpleRepr.TypeAbbrev(_, _, mb) -> - let bodym = bodyRange mb topMembers - createTypeDecl(baseName, lid, FSharpGlyph.Typedef, m, bodym, topMembers, NavigationEntityKind.Class, access) - - //| SynTypeDefnSimpleRepr.General of TyconKind * (SynType * range * ident option) list * (valSpfn * MemberFlags) list * fieldDecls * bool * bool * range - //| SynTypeDefnSimpleRepr.LibraryOnlyILAssembly of ILType * range - //| TyconCore_repr_hidden of range - | _ -> () ] - - and processSigMembers (members: SynMemberSig list) = - [ for memb in members do - match memb with - | SynMemberSig.Member(SynValSig.SynValSig(ident=SynIdent(id,_); accessibility=access; range=m), _, _) -> - createMember(id, NavigationItemKind.Method, FSharpGlyph.Method, m, NavigationEntityKind.Class, false, access) - | SynMemberSig.ValField(SynField(_, _, Some(rcid), ty, _, _, access, _), _) -> - createMember(rcid, NavigationItemKind.Field, FSharpGlyph.Field, ty.Range, NavigationEntityKind.Class, false, access) - | _ -> () ] + createTypeDecl (baseName, lid, FSharpGlyph.Class, m, bodym, nested, NavigationEntityKind.Class, access) + | SynTypeDefnSigRepr.Simple (simple, _) -> + // F# type declaration + match simple with + | SynTypeDefnSimpleRepr.Union (_, cases, mb) -> + let cases = + [ + for SynUnionCase (ident = SynIdent (id, _); caseType = fldspec) in cases -> + let m = unionRanges (fldspecRange fldspec) id.idRange + createMember (id, NavigationItemKind.Other, FSharpGlyph.Struct, m, NavigationEntityKind.Union, false, access) + ] + + let nested = cases @ topMembers + let bodym = bodyRange mb nested + createTypeDecl (baseName, lid, FSharpGlyph.Union, m, bodym, nested, NavigationEntityKind.Union, access) + | SynTypeDefnSimpleRepr.Enum (cases, mb) -> + let cases = + [ + for SynEnumCase (ident = SynIdent (id, _); range = m) in cases -> + createMember (id, NavigationItemKind.Field, FSharpGlyph.EnumMember, m, NavigationEntityKind.Enum, false, access) + ] + + let nested = cases @ topMembers + let bodym = bodyRange mb nested + createTypeDecl (baseName, lid, FSharpGlyph.Enum, m, bodym, nested, NavigationEntityKind.Enum, access) + | SynTypeDefnSimpleRepr.Record (_, fields, mb) -> + let fields = + [ + for SynField (_, _, id, _, _, _, _, m) in fields do + match id with + | Some ident -> yield createMember (ident, NavigationItemKind.Field, FSharpGlyph.Field, m, NavigationEntityKind.Record, false, access) + | _ -> () + ] + + let nested = fields @ topMembers + let bodym = bodyRange mb nested + createTypeDecl (baseName, lid, FSharpGlyph.Type, m, bodym, nested, NavigationEntityKind.Record, access) + | SynTypeDefnSimpleRepr.TypeAbbrev (_, _, mb) -> + let bodym = bodyRange mb topMembers + createTypeDecl (baseName, lid, FSharpGlyph.Typedef, m, bodym, topMembers, NavigationEntityKind.Class, access) + + //| SynTypeDefnSimpleRepr.General of TyconKind * (SynType * range * ident option) list * (valSpfn * MemberFlags) list * fieldDecls * bool * bool * range + //| SynTypeDefnSimpleRepr.LibraryOnlyILAssembly of ILType * range + //| TyconCore_repr_hidden of range + | _ -> () + ] + + and processSigMembers (members: SynMemberSig list) = + [ + for memb in members do + match memb with + | SynMemberSig.Member (SynValSig.SynValSig (ident = SynIdent (id, _); accessibility = access; range = m), _, _) -> + createMember (id, NavigationItemKind.Method, FSharpGlyph.Method, m, NavigationEntityKind.Class, false, access) + | SynMemberSig.ValField (SynField (_, _, Some (rcid), ty, _, _, access, _), _) -> + createMember (rcid, NavigationItemKind.Field, FSharpGlyph.Field, ty.Range, NavigationEntityKind.Class, false, access) + | _ -> () + ] // Process declarations in a module that belong to the right drop-down (let bindings) let processNestedSigDeclarations decls = - [ for decl in decls do - match decl with - | SynModuleSigDecl.Val(SynValSig.SynValSig(ident=SynIdent(id,_); accessibility=access; range=m), _) -> - createMember(id, NavigationItemKind.Method, FSharpGlyph.Method, m, NavigationEntityKind.Module, false, access) - | _ -> () ] + [ + for decl in decls do + match decl with + | SynModuleSigDecl.Val (SynValSig.SynValSig (ident = SynIdent (id, _); accessibility = access; range = m), _) -> + createMember (id, NavigationItemKind.Method, FSharpGlyph.Method, m, NavigationEntityKind.Module, false, access) + | _ -> () + ] // Process declarations nested in a module that should be displayed in the left dropdown - // (such as type declarations, nested modules etc.) - let rec processNavigationTopLevelSigDeclarations(baseName, decls) = - [ for decl in decls do - match decl with - | SynModuleSigDecl.ModuleAbbrev(id, lid, m) -> - let bodym = rangeOfLid lid - createDecl(baseName, id, NavigationItemKind.Module, FSharpGlyph.Module, m, bodym, [], NavigationEntityKind.Module, false, None) - - | SynModuleSigDecl.NestedModule(moduleInfo=SynComponentInfo(longId=lid; accessibility=access); moduleDecls=decls; range=m) -> + // (such as type declarations, nested modules etc.) + let rec processNavigationTopLevelSigDeclarations (baseName, decls) = + [ + for decl in decls do + match decl with + | SynModuleSigDecl.ModuleAbbrev (id, lid, m) -> + let bodym = rangeOfLid lid + createDecl (baseName, id, NavigationItemKind.Module, FSharpGlyph.Module, m, bodym, [], NavigationEntityKind.Module, false, None) + + | SynModuleSigDecl.NestedModule (moduleInfo = SynComponentInfo (longId = lid; accessibility = access); moduleDecls = decls; range = m) -> + // Find let bindings (for the right dropdown) + let nested = processNestedSigDeclarations (decls) + let newBaseName = (if baseName = "" then "" else baseName + ".") + (textOfLid lid) + let other = processNavigationTopLevelSigDeclarations (newBaseName, decls) + + // Get nested modules and types (for the left dropdown) + let bodym = unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other) + createDeclLid (baseName, lid, NavigationItemKind.Module, FSharpGlyph.Module, m, bodym, nested, NavigationEntityKind.Module, access) + yield! other + + | SynModuleSigDecl.Types (tydefs, _) -> + for tydef in tydefs do + yield! processTycon baseName tydef + | SynModuleSigDecl.Exception (defn, _) -> yield! processExnSig baseName defn + | _ -> () + ] + + // Collect all the items + let items = + // Show base name for this module only if it's not the root one + let singleTopLevel = (modules.Length = 1) + + [ + for modulSig in modules do + let (SynModuleOrNamespaceSig (id, _isRec, kind, decls, _, _, access, m, _)) = modulSig + let baseName = if (not singleTopLevel) then textOfLid id else "" // Find let bindings (for the right dropdown) - let nested = processNestedSigDeclarations(decls) - let newBaseName = (if baseName = "" then "" else baseName + ".") + (textOfLid lid) - let other = processNavigationTopLevelSigDeclarations(newBaseName, decls) - + let nested = processNestedSigDeclarations (decls) // Get nested modules and types (for the left dropdown) - let bodym = unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other) - createDeclLid(baseName, lid, NavigationItemKind.Module, FSharpGlyph.Module, m, bodym, nested, NavigationEntityKind.Module, access) + let other = processNavigationTopLevelSigDeclarations (baseName, decls) + + // Create explicitly - it can be 'single top level' thing that is hidden + let kind = + if kind.IsModule then + NavigationItemKind.ModuleFile + else + NavigationItemKind.Namespace + + let bodym = unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid id) other) + + let item = + NavigationItem.Create(textOfLid id, kind, FSharpGlyph.Module, m, bodym, singleTopLevel, NavigationEntityKind.Module, false, access) + + let decl = (item, addItemName (textOfLid id), nested) + decl yield! other - - | SynModuleSigDecl.Types(tydefs, _) -> - for tydef in tydefs do - yield! processTycon baseName tydef - | SynModuleSigDecl.Exception (defn,_) -> - yield! processExnSig baseName defn - | _ -> () ] - - // Collect all the items - let items = - // Show base name for this module only if it's not the root one - let singleTopLevel = (modules.Length = 1) - [ for modulSig in modules do - let (SynModuleOrNamespaceSig(id, _isRec, kind, decls, _, _, access, m, _)) = modulSig - let baseName = if (not singleTopLevel) then textOfLid id else "" - // Find let bindings (for the right dropdown) - let nested = processNestedSigDeclarations(decls) - // Get nested modules and types (for the left dropdown) - let other = processNavigationTopLevelSigDeclarations(baseName, decls) - - // Create explicitly - it can be 'single top level' thing that is hidden - let kind = if kind.IsModule then NavigationItemKind.ModuleFile else NavigationItemKind.Namespace - let bodym = unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid id) other) - let item = NavigationItem.Create (textOfLid id, kind, FSharpGlyph.Module, m, bodym, singleTopLevel, NavigationEntityKind.Module, false, access) - let decl = (item, addItemName(textOfLid id), nested) - decl - yield! other ] - - let items = - [| for (d, idx, nested) in items do - let nested = nested |> Array.ofList |> Array.map (fun (decl, idx) -> decl.WithUniqueName(uniqueName d.Name idx)) - - nested |> Array.sortInPlaceWith (fun a b -> compare a.Name b.Name) - - let nested = nested |> Array.distinctBy (fun x -> x.Range, x.BodyRange, x.Name, x.Kind) - - { Declaration = d.WithUniqueName(uniqueName d.Name idx); Nested = nested } |] - - items |> Array.sortInPlaceWith (fun a b -> compare a.Declaration.Name b.Declaration.Name) + ] + + let items = + [| + for (d, idx, nested) in items do + let nested = + nested + |> Array.ofList + |> Array.map (fun (decl, idx) -> decl.WithUniqueName(uniqueName d.Name idx)) + + nested |> Array.sortInPlaceWith (fun a b -> compare a.Name b.Name) + + let nested = nested |> Array.distinctBy (fun x -> x.Range, x.BodyRange, x.Name, x.Kind) + + { + Declaration = d.WithUniqueName(uniqueName d.Name idx) + Nested = nested + } + |] + + items + |> Array.sortInPlaceWith (fun a b -> compare a.Declaration.Name b.Declaration.Name) NavigationItems(items) @@ -564,8 +690,9 @@ type NavigableItemKind = | Member | EnumCase | UnionCase + override x.ToString() = sprintf "%+A" x - + [] type NavigableContainerType = | File @@ -575,77 +702,96 @@ type NavigableContainerType = | Exception type NavigableContainer = - { Type: NavigableContainerType - Name: string } - -type NavigableItem = - { Name: string - Range: range - IsSignature: bool - Kind: NavigableItemKind - Container: NavigableContainer } - + { + Type: NavigableContainerType + Name: string + } + +type NavigableItem = + { + Name: string + Range: range + IsSignature: bool + Kind: NavigableItemKind + Container: NavigableContainer + } + [] module NavigateTo = - let GetNavigableItems (parsedInput: ParsedInput) : NavigableItem [] = - let rec lastInLid (lid: LongIdent) = + let GetNavigableItems (parsedInput: ParsedInput) : NavigableItem[] = + let rec lastInLid (lid: LongIdent) = match lid with - | [x] -> Some x + | [ x ] -> Some x | _ :: xs -> lastInLid xs | _ -> None // empty lid is possible in case of broken ast - let formatLongIdent (lid: LongIdent) = lid |> List.map (fun id -> id.idText) |> String.concat "." + let formatLongIdent (lid: LongIdent) = + lid |> List.map (fun id -> id.idText) |> String.concat "." + let result = ResizeArray() - - let addIdent kind (id: Ident) (isSignature: bool) (container: NavigableContainer) = + + let addIdent kind (id: Ident) (isSignature: bool) (container: NavigableContainer) = if not (String.IsNullOrEmpty id.idText) then - let item = - { Name = id.idText - Range = id.idRange - IsSignature = isSignature - Kind = kind - Container = container } + let item = + { + Name = id.idText + Range = id.idRange + IsSignature = isSignature + Kind = kind + Container = container + } + result.Add item - - let addModule lid isSig container = + + let addModule lid isSig container = match lastInLid lid with | Some id -> addIdent NavigableItemKind.Module id isSig container | _ -> () - + let addModuleAbbreviation (id: Ident) isSig container = addIdent NavigableItemKind.ModuleAbbreviation id isSig container - - let addExceptionRepr exnRepr isSig container = - let (SynExceptionDefnRepr(_, SynUnionCase(ident=SynIdent(id,_)), _, _, _, _)) = exnRepr + + let addExceptionRepr exnRepr isSig container = + let (SynExceptionDefnRepr (_, SynUnionCase(ident = SynIdent (id, _)), _, _, _, _)) = exnRepr addIdent NavigableItemKind.Exception id isSig container - { Type = NavigableContainerType.Exception; Name = id.idText } - - let addComponentInfo containerType kind info isSig container = - let (SynComponentInfo(_, _, _, lid, _, _, _, _))= info + + { + Type = NavigableContainerType.Exception + Name = id.idText + } + + let addComponentInfo containerType kind info isSig container = + let (SynComponentInfo (_, _, _, lid, _, _, _, _)) = info + match lastInLid lid with | Some id -> addIdent kind id isSig container | _ -> () - { Type = containerType; Name = formatLongIdent lid } - - let addValSig kind synValSig isSig container = - let (SynValSig(ident=SynIdent(id,_))) = synValSig + + { + Type = containerType + Name = formatLongIdent lid + } + + let addValSig kind synValSig isSig container = + let (SynValSig(ident = SynIdent (id, _))) = synValSig addIdent kind id isSig container - - let addField synField isSig container = - let (SynField(_, _, id, _, _, _, _, _)) = synField + + let addField synField isSig container = + let (SynField (_, _, id, _, _, _, _, _)) = synField + match id with | Some id -> addIdent NavigableItemKind.Field id isSig container | _ -> () - - let addEnumCase inp isSig = - let (SynEnumCase(ident=SynIdent(id,_))) = inp + + let addEnumCase inp isSig = + let (SynEnumCase(ident = SynIdent (id, _))) = inp addIdent NavigableItemKind.EnumCase id isSig - - let addUnionCase synUnionCase isSig container = - let (SynUnionCase(ident=SynIdent(id,_))) = synUnionCase + + let addUnionCase synUnionCase isSig container = + let (SynUnionCase(ident = SynIdent (id, _))) = synUnionCase addIdent NavigableItemKind.UnionCase id isSig container - - let mapMemberKind mk = + + let mapMemberKind mk = match mk with | SynMemberKind.ClassConstructor // ? | SynMemberKind.Constructor -> NavigableItemKind.Constructor @@ -653,10 +799,11 @@ module NavigateTo = | SynMemberKind.PropertySet | SynMemberKind.PropertyGetSet -> NavigableItemKind.Property | SynMemberKind.Member -> NavigableItemKind.Member - + let addBinding synBinding itemKind container = - let (SynBinding(valData=valData; headPat=headPat)) = synBinding - let (SynValData(memberFlagsOpt, _, _)) = valData + let (SynBinding (valData = valData; headPat = headPat)) = synBinding + let (SynValData (memberFlagsOpt, _, _)) = valData + let kind = match itemKind with | Some x -> x @@ -664,152 +811,173 @@ module NavigateTo = match memberFlagsOpt with | Some mf -> mapMemberKind mf.MemberKind | _ -> NavigableItemKind.ModuleValue - + match headPat with - | SynPat.LongIdent(longDotId=SynLongIdent([_; id], _,_)) -> + | SynPat.LongIdent(longDotId = SynLongIdent ([ _; id ], _, _)) -> // instance members addIdent kind id false container - | SynPat.LongIdent(longDotId=SynLongIdent([id], _,_)) -> + | SynPat.LongIdent(longDotId = SynLongIdent ([ id ], _, _)) -> // functions addIdent kind id false container - | SynPat.Named (SynIdent(id,_), _, _, _) - | SynPat.As(_, SynPat.Named (SynIdent(id,_), _, _, _), _) -> + | SynPat.Named (SynIdent (id, _), _, _, _) + | SynPat.As (_, SynPat.Named (SynIdent (id, _), _, _, _), _) -> // values addIdent kind id false container | _ -> () - - let addMember valSig (memberFlags: SynMemberFlags) isSig container = + + let addMember valSig (memberFlags: SynMemberFlags) isSig container = let ctor = mapMemberKind memberFlags.MemberKind addValSig ctor valSig isSig container - - let rec walkSigFileInput (inp: ParsedSigFileInput) = + + let rec walkSigFileInput (inp: ParsedSigFileInput) = let (ParsedSigFileInput (fileName = fileName; modules = moduleOrNamespaceList)) = inp + for item in moduleOrNamespaceList do - walkSynModuleOrNamespaceSig item { Type = NavigableContainerType.File; Name = fileName } - + walkSynModuleOrNamespaceSig + item + { + Type = NavigableContainerType.File + Name = fileName + } + and walkSynModuleOrNamespaceSig (inp: SynModuleOrNamespaceSig) container = - let (SynModuleOrNamespaceSig(longId = lid; kind = kind; decls = decls)) = inp + let (SynModuleOrNamespaceSig (longId = lid; kind = kind; decls = decls)) = inp let isModule = kind.IsModule - if isModule then - addModule lid true container - let container = - { Type = if isModule then NavigableContainerType.Module else NavigableContainerType.Namespace - Name = formatLongIdent lid } + if isModule then addModule lid true container + + let container = + { + Type = + if isModule then + NavigableContainerType.Module + else + NavigableContainerType.Namespace + Name = formatLongIdent lid + } + for decl in decls do walkSynModuleSigDecl decl container - - and walkSynModuleSigDecl (decl: SynModuleSigDecl) container = + + and walkSynModuleSigDecl (decl: SynModuleSigDecl) container = match decl with - | SynModuleSigDecl.ModuleAbbrev(lhs, _, _range) -> - addModuleAbbreviation lhs true container - | SynModuleSigDecl.Exception(exnSig=SynExceptionSig(exnRepr=representation)) -> - addExceptionRepr representation true container |> ignore - | SynModuleSigDecl.NamespaceFragment fragment -> - walkSynModuleOrNamespaceSig fragment container - | SynModuleSigDecl.NestedModule(moduleInfo=componentInfo; moduleDecls=nestedDecls) -> + | SynModuleSigDecl.ModuleAbbrev (lhs, _, _range) -> addModuleAbbreviation lhs true container + | SynModuleSigDecl.Exception(exnSig = SynExceptionSig (exnRepr = representation)) -> addExceptionRepr representation true container |> ignore + | SynModuleSigDecl.NamespaceFragment fragment -> walkSynModuleOrNamespaceSig fragment container + | SynModuleSigDecl.NestedModule (moduleInfo = componentInfo; moduleDecls = nestedDecls) -> let container = addComponentInfo NavigableContainerType.Module NavigableItemKind.Module componentInfo true container + for decl in nestedDecls do walkSynModuleSigDecl decl container - | SynModuleSigDecl.Types(types, _) -> + | SynModuleSigDecl.Types (types, _) -> for ty in types do walkSynTypeDefnSig ty container - | SynModuleSigDecl.Val(valSig, _range) -> - addValSig NavigableItemKind.ModuleValue valSig true container + | SynModuleSigDecl.Val (valSig, _range) -> addValSig NavigableItemKind.ModuleValue valSig true container | SynModuleSigDecl.HashDirective _ | SynModuleSigDecl.Open _ -> () - - and walkSynTypeDefnSig (inp: SynTypeDefnSig) container = - let (SynTypeDefnSig(typeInfo=componentInfo; typeRepr=repr; members=members)) = inp + + and walkSynTypeDefnSig (inp: SynTypeDefnSig) container = + let (SynTypeDefnSig (typeInfo = componentInfo; typeRepr = repr; members = members)) = inp let container = addComponentInfo NavigableContainerType.Type NavigableItemKind.Type componentInfo true container + for m in members do walkSynMemberSig m container + match repr with - | SynTypeDefnSigRepr.ObjectModel(_, membersSigs, _) -> + | SynTypeDefnSigRepr.ObjectModel (_, membersSigs, _) -> for m in membersSigs do walkSynMemberSig m container - | SynTypeDefnSigRepr.Simple(repr, _) -> - walkSynTypeDefnSimpleRepr repr true container + | SynTypeDefnSigRepr.Simple (repr, _) -> walkSynTypeDefnSimpleRepr repr true container | SynTypeDefnSigRepr.Exception _ -> () - - and walkSynMemberSig (synMemberSig: SynMemberSig) container = + + and walkSynMemberSig (synMemberSig: SynMemberSig) container = match synMemberSig with - | SynMemberSig.Member(valSig, memberFlags, _) -> - addMember valSig memberFlags true container - | SynMemberSig.ValField(synField, _) -> - addField synField true container - | SynMemberSig.NestedType(synTypeDef, _) -> - walkSynTypeDefnSig synTypeDef container + | SynMemberSig.Member (valSig, memberFlags, _) -> addMember valSig memberFlags true container + | SynMemberSig.ValField (synField, _) -> addField synField true container + | SynMemberSig.NestedType (synTypeDef, _) -> walkSynTypeDefnSig synTypeDef container | SynMemberSig.Inherit _ | SynMemberSig.Interface _ -> () - - and walkImplFileInput (inp: ParsedImplFileInput) = + + and walkImplFileInput (inp: ParsedImplFileInput) = let (ParsedImplFileInput (fileName = fileName; modules = moduleOrNamespaceList)) = inp - let container = { Type = NavigableContainerType.File; Name = fileName } + + let container = + { + Type = NavigableContainerType.File + Name = fileName + } + for item in moduleOrNamespaceList do walkSynModuleOrNamespace item container - + and walkSynModuleOrNamespace inp container = - let (SynModuleOrNamespace(longId = lid; kind = kind; decls = decls)) = inp + let (SynModuleOrNamespace (longId = lid; kind = kind; decls = decls)) = inp let isModule = kind.IsModule - if isModule then - addModule lid false container - let container = - { Type = if isModule then NavigableContainerType.Module else NavigableContainerType.Namespace - Name = formatLongIdent lid } + if isModule then addModule lid false container + + let container = + { + Type = + if isModule then + NavigableContainerType.Module + else + NavigableContainerType.Namespace + Name = formatLongIdent lid + } + for decl in decls do walkSynModuleDecl decl container - - and walkSynModuleDecl(decl: SynModuleDecl) container = + + and walkSynModuleDecl (decl: SynModuleDecl) container = match decl with - | SynModuleDecl.Exception(SynExceptionDefn(repr, _, synMembers, _), _) -> + | SynModuleDecl.Exception (SynExceptionDefn (repr, _, synMembers, _), _) -> let container = addExceptionRepr repr false container + for m in synMembers do walkSynMemberDefn m container - | SynModuleDecl.Let(_, bindings, _) -> + | SynModuleDecl.Let (_, bindings, _) -> for binding in bindings do addBinding binding None container - | SynModuleDecl.ModuleAbbrev(lhs, _, _) -> - addModuleAbbreviation lhs false container - | SynModuleDecl.NamespaceFragment(fragment) -> - walkSynModuleOrNamespace fragment container - | SynModuleDecl.NestedModule(moduleInfo=componentInfo; decls=modules) -> + | SynModuleDecl.ModuleAbbrev (lhs, _, _) -> addModuleAbbreviation lhs false container + | SynModuleDecl.NamespaceFragment (fragment) -> walkSynModuleOrNamespace fragment container + | SynModuleDecl.NestedModule (moduleInfo = componentInfo; decls = modules) -> let container = addComponentInfo NavigableContainerType.Module NavigableItemKind.Module componentInfo false container + for m in modules do walkSynModuleDecl m container - | SynModuleDecl.Types(typeDefs, _range) -> + | SynModuleDecl.Types (typeDefs, _range) -> for t in typeDefs do walkSynTypeDefn t container | SynModuleDecl.Attributes _ | SynModuleDecl.Expr _ | SynModuleDecl.HashDirective _ | SynModuleDecl.Open _ -> () - - and walkSynTypeDefn inp container = - let (SynTypeDefn(typeInfo=componentInfo; typeRepr=representation; members=members)) = inp + + and walkSynTypeDefn inp container = + let (SynTypeDefn (typeInfo = componentInfo; typeRepr = representation; members = members)) = inp let container = addComponentInfo NavigableContainerType.Type NavigableItemKind.Type componentInfo false container walkSynTypeDefnRepr representation container + for m in members do walkSynMemberDefn m container - - and walkSynTypeDefnRepr(typeDefnRepr: SynTypeDefnRepr) container = + + and walkSynTypeDefnRepr (typeDefnRepr: SynTypeDefnRepr) container = match typeDefnRepr with - | SynTypeDefnRepr.ObjectModel(_, members, _) -> + | SynTypeDefnRepr.ObjectModel (_, members, _) -> for m in members do walkSynMemberDefn m container - | SynTypeDefnRepr.Simple(repr, _) -> - walkSynTypeDefnSimpleRepr repr false container + | SynTypeDefnRepr.Simple (repr, _) -> walkSynTypeDefnSimpleRepr repr false container | SynTypeDefnRepr.Exception _ -> () - - and walkSynTypeDefnSimpleRepr(repr: SynTypeDefnSimpleRepr) isSig container = + + and walkSynTypeDefnSimpleRepr (repr: SynTypeDefnSimpleRepr) isSig container = match repr with - | SynTypeDefnSimpleRepr.Enum(enumCases, _) -> + | SynTypeDefnSimpleRepr.Enum (enumCases, _) -> for c in enumCases do addEnumCase c isSig container - | SynTypeDefnSimpleRepr.Record(_, fields, _) -> + | SynTypeDefnSimpleRepr.Record (_, fields, _) -> for f in fields do // TODO: add specific case for record field? addField f isSig container - | SynTypeDefnSimpleRepr.Union(_, unionCases, _) -> + | SynTypeDefnSimpleRepr.Union (_, unionCases, _) -> for uc in unionCases do addUnionCase uc isSig container | SynTypeDefnSimpleRepr.General _ @@ -817,27 +985,23 @@ module NavigateTo = | SynTypeDefnSimpleRepr.None _ | SynTypeDefnSimpleRepr.TypeAbbrev _ | SynTypeDefnSimpleRepr.Exception _ -> () - + and walkSynMemberDefn (memberDefn: SynMemberDefn) container = match memberDefn with - | SynMemberDefn.AbstractSlot(synValSig, memberFlags, _) -> - addMember synValSig memberFlags false container - | SynMemberDefn.AutoProperty(ident=id) -> - addIdent NavigableItemKind.Property id false container - | SynMemberDefn.Interface(members=members) -> + | SynMemberDefn.AbstractSlot (synValSig, memberFlags, _) -> addMember synValSig memberFlags false container + | SynMemberDefn.AutoProperty (ident = id) -> addIdent NavigableItemKind.Property id false container + | SynMemberDefn.Interface (members = members) -> match members with | Some members -> for m in members do walkSynMemberDefn m container | None -> () - | SynMemberDefn.Member(binding, _) -> - addBinding binding None container - | SynMemberDefn.NestedType(typeDef, _, _) -> - walkSynTypeDefn typeDef container - | SynMemberDefn.ValField(field, _) -> - addField field false container - | SynMemberDefn.LetBindings (bindings, _, _, _) -> - bindings |> List.iter (fun binding -> addBinding binding (Some NavigableItemKind.Field) container) + | SynMemberDefn.Member (binding, _) -> addBinding binding None container + | SynMemberDefn.NestedType (typeDef, _, _) -> walkSynTypeDefn typeDef container + | SynMemberDefn.ValField (field, _) -> addField field false container + | SynMemberDefn.LetBindings (bindings, _, _, _) -> + bindings + |> List.iter (fun binding -> addBinding binding (Some NavigableItemKind.Field) container) | SynMemberDefn.Open _ | SynMemberDefn.ImplicitInherit _ | SynMemberDefn.Inherit _ @@ -846,6 +1010,5 @@ module NavigateTo = match parsedInput with | ParsedInput.SigFile input -> walkSigFileInput input | ParsedInput.ImplFile input -> walkImplFileInput input - - result.ToArray() + result.ToArray() diff --git a/src/Compiler/Service/ServiceParamInfoLocations.fs b/src/Compiler/Service/ServiceParamInfoLocations.fs index 99827a5394b2..35b4b777d8a8 100755 --- a/src/Compiler/Service/ServiceParamInfoLocations.fs +++ b/src/Compiler/Service/ServiceParamInfoLocations.fs @@ -8,7 +8,11 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTreeOps -type TupledArgumentLocation = { IsNamedArgument: bool; ArgumentRange: range } +type TupledArgumentLocation = + { + IsNamedArgument: bool + ArgumentRange: range + } [] type ParameterLocations @@ -16,7 +20,7 @@ type ParameterLocations longId: string list, longIdRange: range, openParenLocation: pos, - argRanges: TupledArgumentLocation list, + argRanges: TupledArgumentLocation list, tupleEndLocations: pos list, isThereACloseParen: bool, namedParamNames: string option list @@ -24,6 +28,7 @@ type ParameterLocations let tupleEndLocations = Array.ofList tupleEndLocations let namedParamNames = Array.ofList namedParamNames + let namedParamNames = if (tupleEndLocations.Length = namedParamNames.Length) then namedParamNames @@ -32,9 +37,9 @@ type ParameterLocations // this is ok, but later code in the UI layer will expect these lengths to match // so just fill in a blank named param to represent the final missing param // (compare to f( or f(42, where the parser injects a fake "AbrExpr" to represent the missing argument) - assert(tupleEndLocations.Length = namedParamNames.Length + 1) - [| yield! namedParamNames; yield None |] // None is representation of a non-named param - + assert (tupleEndLocations.Length = namedParamNames.Length + 1) + [| yield! namedParamNames; yield None |] // None is representation of a non-named param + member _.LongId = longId member _.LongIdStartLocation = longIdRange.Start @@ -66,53 +71,72 @@ module internal ParameterLocationsImpl = let rec digOutIdentFromFuncExpr synExpr = // we found it, dig out ident match synExpr with - | SynExpr.Ident id -> Some ([id.idText], id.idRange) - | SynExpr.LongIdent(_, SynLongIdent([id], [], [ Some _ ]), _, _) -> Some ([id.idText], id.idRange) - | SynExpr.LongIdent (_, SynLongIdent(lid, _, _), _, lidRange) - | SynExpr.DotGet (_, _, SynLongIdent(lid, _, _), lidRange) -> Some (pathOfLid lid, lidRange) - | SynExpr.TypeApp (synExpr, _, _synTypeList, _commas, _, _, _range) -> digOutIdentFromFuncExpr synExpr - | SynExpr.Paren(expr = expr) -> digOutIdentFromFuncExpr expr + | SynExpr.Ident id -> Some([ id.idText ], id.idRange) + | SynExpr.LongIdent (_, SynLongIdent ([ id ], [], [ Some _ ]), _, _) -> Some([ id.idText ], id.idRange) + | SynExpr.LongIdent (_, SynLongIdent (lid, _, _), _, lidRange) + | SynExpr.DotGet (_, _, SynLongIdent (lid, _, _), lidRange) -> Some(pathOfLid lid, lidRange) + | SynExpr.TypeApp (synExpr, _, _synTypeList, _commas, _, _, _range) -> digOutIdentFromFuncExpr synExpr + | SynExpr.Paren (expr = expr) -> digOutIdentFromFuncExpr expr | _ -> None - type FindResult = - | Found of openParen: pos * argRanges: TupledArgumentLocation list * commasAndCloseParen: (pos * string option) list * hasClosedParen: bool + type FindResult = + | Found of + openParen: pos * + argRanges: TupledArgumentLocation list * + commasAndCloseParen: (pos * string option) list * + hasClosedParen: bool | NotFound let digOutIdentFromStaticArg (StripParenTypes synType) = - match synType with - | SynType.StaticConstantNamed(SynType.LongIdent(SynLongIdent([id], _, _)), _, _) -> Some id.idText - | SynType.LongIdent(SynLongIdent([id], _, _)) -> Some id.idText // NOTE: again, not a static constant, but may be a prefix of a Named in incomplete code + match synType with + | SynType.StaticConstantNamed (SynType.LongIdent (SynLongIdent ([ id ], _, _)), _, _) -> Some id.idText + | SynType.LongIdent (SynLongIdent ([ id ], _, _)) -> Some id.idText // NOTE: again, not a static constant, but may be a prefix of a Named in incomplete code | _ -> None let getNamedParamName e = match e with // f(x=4) - | SynExpr.App (ExprAtomicFlag.NonAtomic, _, - SynExpr.App (ExprAtomicFlag.NonAtomic, true, - SynExpr.LongIdent(longDotId = SynLongIdent(id = [op])), - SynExpr.Ident n, - _range), - _, _) when op.idText="op_Equality" -> Some n.idText + | SynExpr.App (ExprAtomicFlag.NonAtomic, + _, + SynExpr.App (ExprAtomicFlag.NonAtomic, + true, + SynExpr.LongIdent(longDotId = SynLongIdent(id = [ op ])), + SynExpr.Ident n, + _range), + _, + _) when op.idText = "op_Equality" -> Some n.idText // f(?x=4) - | SynExpr.App (ExprAtomicFlag.NonAtomic, _, - SynExpr.App (ExprAtomicFlag.NonAtomic, true, - SynExpr.LongIdent(longDotId = SynLongIdent(id = [op])), - SynExpr.LongIdent (true, SynLongIdent([n], _, _), _ref, _lidrange), _range), - _, _) when op.idText="op_Equality" -> Some n.idText + | SynExpr.App (ExprAtomicFlag.NonAtomic, + _, + SynExpr.App (ExprAtomicFlag.NonAtomic, + true, + SynExpr.LongIdent(longDotId = SynLongIdent(id = [ op ])), + SynExpr.LongIdent (true, SynLongIdent ([ n ], _, _), _ref, _lidrange), + _range), + _, + _) when op.idText = "op_Equality" -> Some n.idText | _ -> None let getTypeName synType = match synType with - | SynType.LongIdent(SynLongIdent(ids, _, _)) -> ids |> pathOfLid - | _ -> [""] // TODO type name for other cases, see also unit test named "ParameterInfo.LocationOfParams.AfterQuicklyTyping.CallConstructorViaLongId.Bug94333" + | SynType.LongIdent (SynLongIdent (ids, _, _)) -> ids |> pathOfLid + | _ -> [ "" ] // TODO type name for other cases, see also unit test named "ParameterInfo.LocationOfParams.AfterQuicklyTyping.CallConstructorViaLongId.Bug94333" - let handleSingleArg traverseSynExpr (pos, synExpr, parenRange, rpRangeOpt : _ option) = + let handleSingleArg traverseSynExpr (pos, synExpr, parenRange, rpRangeOpt: _ option) = let inner = traverseSynExpr synExpr + match inner with | None -> if SyntaxTraversal.rangeContainsPosLeftEdgeExclusiveAndRightEdgeInclusive parenRange pos then - let argRanges = [{ IsNamedArgument = (getNamedParamName synExpr).IsSome; ArgumentRange = synExpr.Range }] - Found (parenRange.Start, argRanges, [(parenRange.End, getNamedParamName synExpr)], rpRangeOpt.IsSome), None + let argRanges = + [ + { + IsNamedArgument = (getNamedParamName synExpr).IsSome + ArgumentRange = synExpr.Range + } + ] + + Found(parenRange.Start, argRanges, [ (parenRange.End, getNamedParamName synExpr) ], rpRangeOpt.IsSome), None else NotFound, None | _ -> NotFound, None @@ -120,241 +144,349 @@ module internal ParameterLocationsImpl = // This method returns a tuple, where the second element is // Some(cache) if the implementation called 'traverseSynExpr expr', then 'cache' is the result of that call // None otherwise - // so that callers can avoid recomputing 'traverseSynExpr expr' if it's already been done. This is very important for perf, + // so that callers can avoid recomputing 'traverseSynExpr expr' if it's already been done. This is very important for perf, // see bug 345385. let rec searchSynArgExpr traverseSynExpr pos expr = - match expr with - | SynExprParen(SynExpr.Tuple (false, synExprList, commaRanges, _tupleRange) as synExpr, _lpRange, rpRangeOpt, parenRange) -> // tuple argument + match expr with + | SynExprParen (SynExpr.Tuple (false, synExprList, commaRanges, _tupleRange) as synExpr, _lpRange, rpRangeOpt, parenRange) -> // tuple argument let inner = traverseSynExpr synExpr + match inner with | None -> if SyntaxTraversal.rangeContainsPosLeftEdgeExclusiveAndRightEdgeInclusive parenRange pos then // argRange, isNamed let argRanges = synExprList - |> List.map (fun e -> { IsNamedArgument = (getNamedParamName e).IsSome; ArgumentRange = e.Range }) - let commasAndCloseParen = ((synExprList, commaRanges@[parenRange]) ||> List.map2 (fun e c -> c.End, getNamedParamName e)) - let r = Found (parenRange.Start, argRanges, commasAndCloseParen, rpRangeOpt.IsSome) + |> List.map (fun e -> + { + IsNamedArgument = (getNamedParamName e).IsSome + ArgumentRange = e.Range + }) + + let commasAndCloseParen = + ((synExprList, commaRanges @ [ parenRange ]) + ||> List.map2 (fun e c -> c.End, getNamedParamName e)) + + let r = Found(parenRange.Start, argRanges, commasAndCloseParen, rpRangeOpt.IsSome) r, None else NotFound, None | _ -> NotFound, None - | SynExprParen(SynExprParen(SynExpr.Tuple (false, _, _, _), _, _, _) as synExpr, _, rpRangeOpt, parenRange) -> // f((x, y)) is special, single tuple arg + | SynExprParen (SynExprParen (SynExpr.Tuple (false, _, _, _), _, _, _) as synExpr, _, rpRangeOpt, parenRange) -> // f((x, y)) is special, single tuple arg handleSingleArg traverseSynExpr (pos, synExpr, parenRange, rpRangeOpt) // dig into multiple parens - | SynExprParen(SynExprParen(_, _, _, _) as synExpr, _, _, _parenRange) -> + | SynExprParen (SynExprParen (_, _, _, _) as synExpr, _, _, _parenRange) -> let r, _cacheOpt = searchSynArgExpr traverseSynExpr pos synExpr r, None - | SynExprParen(synExpr, _lpRange, rpRangeOpt, parenRange) -> // single argument + | SynExprParen (synExpr, _lpRange, rpRangeOpt, parenRange) -> // single argument handleSingleArg traverseSynExpr (pos, synExpr, parenRange, rpRangeOpt) | SynExpr.ArbitraryAfterError (_debugStr, range) -> // single argument when e.g. after open paren you hit EOF if SyntaxTraversal.rangeContainsPosEdgesExclusive range pos then - let r = Found (range.Start, [], [(range.End, None)], false) + let r = Found(range.Start, [], [ (range.End, None) ], false) r, None else NotFound, None | SynExpr.Const (SynConst.Unit, unitRange) -> if SyntaxTraversal.rangeContainsPosEdgesExclusive unitRange pos then - let r = Found (unitRange.Start, [], [(unitRange.End, None)], true) + let r = Found(unitRange.Start, [], [ (unitRange.End, None) ], true) r, None else NotFound, None - | e -> + | e -> let inner = traverseSynExpr e + match inner with | None -> if SyntaxTraversal.rangeContainsPosEdgesExclusive e.Range pos then // any other expression doesn't start with parens, so if it was the target of an App, then it must be a single argument e.g. "f x" - Found (e.Range.Start, [], [ (e.Range.End, None) ], false), Some inner + Found(e.Range.Start, [], [ (e.Range.End, None) ], false), Some inner else NotFound, Some inner | _ -> NotFound, Some inner let (|StaticParameters|_|) pos (StripParenTypes synType) = match synType with - | SynType.App(StripParenTypes (SynType.LongIdent(SynLongIdent(lid, _, _) as lidwd)), Some(openm), args, commas, closemOpt, _pf, wholem) -> + | SynType.App (StripParenTypes (SynType.LongIdent (SynLongIdent (lid, _, _) as lidwd)), + Some (openm), + args, + commas, + closemOpt, + _pf, + wholem) -> let lidm = lidwd.Range let betweenTheBrackets = mkRange wholem.FileName openm.Start wholem.End - if SyntaxTraversal.rangeContainsPosEdgesExclusive betweenTheBrackets pos && args |> List.forall isStaticArg then + + if SyntaxTraversal.rangeContainsPosEdgesExclusive betweenTheBrackets pos + && args |> List.forall isStaticArg then let commasAndCloseParen = [ for c in commas -> c.End ] @ [ wholem.End ] - Some (ParameterLocations(pathOfLid lid, lidm, openm.Start, [], commasAndCloseParen, closemOpt.IsSome, args |> List.map digOutIdentFromStaticArg)) + + Some( + ParameterLocations( + pathOfLid lid, + lidm, + openm.Start, + [], + commasAndCloseParen, + closemOpt.IsSome, + args |> List.map digOutIdentFromStaticArg + ) + ) else None - | _ -> - None - - let traverseInput(pos, parseTree) = - SyntaxTraversal.Traverse(pos, parseTree, { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = - let expr = expr // fix debug locals - match expr with - - // new LID(...) and error recovery of these - | SynExpr.New (_, synType, synExpr, _) -> - let constrArgsResult, cacheOpt = searchSynArgExpr traverseSynExpr pos synExpr - match constrArgsResult, cacheOpt with - | Found(parenLoc, argRanges, commasAndCloseParen, isThereACloseParen), _ -> - let typeName = getTypeName synType - Some (ParameterLocations(typeName, synType.Range, parenLoc, argRanges, commasAndCloseParen |> List.map fst, isThereACloseParen, commasAndCloseParen |> List.map snd)) - | NotFound, Some cache -> - cache - | _ -> - match synType with - | StaticParameters pos loc -> Some loc - | _ -> traverseSynExpr synExpr - - // EXPR< = error recovery of a form of half-written TypeApp - | SynExpr.App (_, _, SynExpr.App (_, true, SynExpr.LongIdent(longDotId = SynLongIdent(id = [op])), synExpr, openm), SynExpr.ArbitraryAfterError _, wholem) when op.idText = "op_LessThan" -> - // Look in the function expression - let fResult = traverseSynExpr synExpr - match fResult with - | Some _ -> fResult - | _ -> - let typeArgsm = mkRange openm.FileName openm.Start wholem.End - if SyntaxTraversal.rangeContainsPosEdgesExclusive typeArgsm pos then - // We found it, dig out ident - match digOutIdentFromFuncExpr synExpr with - | Some(lid, lidRange) -> Some (ParameterLocations(lid, lidRange, op.idRange.Start, [], [ wholem.End ], false, [])) - | None -> None - else - None - - // EXPR EXPR2 - | SynExpr.App (_exprAtomicFlag, isInfix, synExpr, synExpr2, _range) -> - // Look in the function expression - let fResult = traverseSynExpr synExpr - match fResult with - | Some _ -> fResult - | _ -> - // Search the argument - let xResult, cacheOpt = searchSynArgExpr traverseSynExpr pos synExpr2 - match xResult, cacheOpt with - | Found(parenLoc, argRanges, commasAndCloseParen, isThereACloseParen), _ -> - // We found it, dig out ident - match digOutIdentFromFuncExpr synExpr with - | Some(lid, lidRange) -> - assert(isInfix = (posLt parenLoc lidRange.End)) - if isInfix then - // This seems to be an infix operator, since the start of the argument is a position earlier than the end of the long-id being applied to it. - // For now, we don't support infix operators. + | _ -> None + + let traverseInput (pos, parseTree) = + SyntaxTraversal.Traverse( + pos, + parseTree, + { new SyntaxVisitorBase<_>() with + member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = + let expr = expr // fix debug locals + + match expr with + + // new LID(...) and error recovery of these + | SynExpr.New (_, synType, synExpr, _) -> + let constrArgsResult, cacheOpt = searchSynArgExpr traverseSynExpr pos synExpr + + match constrArgsResult, cacheOpt with + | Found (parenLoc, argRanges, commasAndCloseParen, isThereACloseParen), _ -> + let typeName = getTypeName synType + + Some( + ParameterLocations( + typeName, + synType.Range, + parenLoc, + argRanges, + commasAndCloseParen |> List.map fst, + isThereACloseParen, + commasAndCloseParen |> List.map snd + ) + ) + | NotFound, Some cache -> cache + | _ -> + match synType with + | StaticParameters pos loc -> Some loc + | _ -> traverseSynExpr synExpr + + // EXPR< = error recovery of a form of half-written TypeApp + | SynExpr.App (_, + _, + SynExpr.App (_, true, SynExpr.LongIdent(longDotId = SynLongIdent(id = [ op ])), synExpr, openm), + SynExpr.ArbitraryAfterError _, + wholem) when op.idText = "op_LessThan" -> + // Look in the function expression + let fResult = traverseSynExpr synExpr + + match fResult with + | Some _ -> fResult + | _ -> + let typeArgsm = mkRange openm.FileName openm.Start wholem.End + + if SyntaxTraversal.rangeContainsPosEdgesExclusive typeArgsm pos then + // We found it, dig out ident + match digOutIdentFromFuncExpr synExpr with + | Some (lid, lidRange) -> + Some(ParameterLocations(lid, lidRange, op.idRange.Start, [], [ wholem.End ], false, [])) + | None -> None + else None + + // EXPR EXPR2 + | SynExpr.App (_exprAtomicFlag, isInfix, synExpr, synExpr2, _range) -> + // Look in the function expression + let fResult = traverseSynExpr synExpr + + match fResult with + | Some _ -> fResult + | _ -> + // Search the argument + let xResult, cacheOpt = searchSynArgExpr traverseSynExpr pos synExpr2 + + match xResult, cacheOpt with + | Found (parenLoc, argRanges, commasAndCloseParen, isThereACloseParen), _ -> + // We found it, dig out ident + match digOutIdentFromFuncExpr synExpr with + | Some (lid, lidRange) -> + assert (isInfix = (posLt parenLoc lidRange.End)) + + if isInfix then + // This seems to be an infix operator, since the start of the argument is a position earlier than the end of the long-id being applied to it. + // For now, we don't support infix operators. + None + else + Some( + ParameterLocations( + lid, + lidRange, + parenLoc, + argRanges, + commasAndCloseParen |> List.map fst, + isThereACloseParen, + commasAndCloseParen |> List.map snd + ) + ) + | None -> None + | NotFound, Some cache -> cache + | _ -> traverseSynExpr synExpr2 + + // ID and error recovery of these + | SynExpr.TypeApp (synExpr, openm, tyArgs, commas, closemOpt, _, wholem) -> + match traverseSynExpr synExpr with + | Some _ as r -> r + | None -> + let typeArgsm = mkRange openm.FileName openm.Start wholem.End + + if SyntaxTraversal.rangeContainsPosEdgesExclusive typeArgsm pos + && tyArgs |> List.forall isStaticArg then + let commasAndCloseParen = [ for c in commas -> c.End ] @ [ wholem.End ] + + let argRanges = + tyArgs + |> List.map (fun tyarg -> + { + IsNamedArgument = false + ArgumentRange = tyarg.Range + }) + + let r = + ParameterLocations( + [ "dummy" ], + synExpr.Range, + openm.Start, + argRanges, + commasAndCloseParen, + closemOpt.IsSome, + tyArgs |> List.map digOutIdentFromStaticArg + ) + + Some r else - Some (ParameterLocations(lid, lidRange, parenLoc, argRanges, commasAndCloseParen |> List.map fst, isThereACloseParen, commasAndCloseParen |> List.map snd)) - | None -> None - | NotFound, Some cache -> cache - | _ -> traverseSynExpr synExpr2 - - // ID and error recovery of these - | SynExpr.TypeApp (synExpr, openm, tyArgs, commas, closemOpt, _, wholem) -> - match traverseSynExpr synExpr with - | Some _ as r -> r - | None -> - let typeArgsm = mkRange openm.FileName openm.Start wholem.End - if SyntaxTraversal.rangeContainsPosEdgesExclusive typeArgsm pos && tyArgs |> List.forall isStaticArg then - let commasAndCloseParen = [ for c in commas -> c.End ] @ [ wholem.End ] - let argRanges = tyArgs |> List.map (fun tyarg -> { IsNamedArgument = false; ArgumentRange = tyarg.Range }) - let r = ParameterLocations(["dummy"], synExpr.Range, openm.Start, argRanges, commasAndCloseParen, closemOpt.IsSome, tyArgs |> List.map digOutIdentFromStaticArg) - Some r - else - None - - | _ -> defaultTraverse expr - - member _.VisitTypeAbbrev(_path, tyAbbrevRhs, _m) = - match tyAbbrevRhs with - | StaticParameters pos loc -> Some loc - | _ -> None - - member _.VisitImplicitInherit(_path, defaultTraverse, ty, expr, m) = - match defaultTraverse expr with - | Some _ as r -> r - | None -> - let inheritm = mkRange m.FileName m.Start m.End - if SyntaxTraversal.rangeContainsPosEdgesExclusive inheritm pos then - // inherit ty(expr) --- treat it like an application (constructor call) - let xResult, _cacheOpt = searchSynArgExpr defaultTraverse pos expr - match xResult with - | Found(parenLoc, argRanges, commasAndCloseParen, isThereACloseParen) -> - // we found it, dig out ident - let typeName = getTypeName ty - let r = ParameterLocations(typeName, ty.Range, parenLoc, argRanges, commasAndCloseParen |> List.map fst, isThereACloseParen, commasAndCloseParen |> List.map snd) - Some r - | NotFound -> None - else None - }) - -type ParameterLocations with + None + + | _ -> defaultTraverse expr + + member _.VisitTypeAbbrev(_path, tyAbbrevRhs, _m) = + match tyAbbrevRhs with + | StaticParameters pos loc -> Some loc + | _ -> None + + member _.VisitImplicitInherit(_path, defaultTraverse, ty, expr, m) = + match defaultTraverse expr with + | Some _ as r -> r + | None -> + let inheritm = mkRange m.FileName m.Start m.End + + if SyntaxTraversal.rangeContainsPosEdgesExclusive inheritm pos then + // inherit ty(expr) --- treat it like an application (constructor call) + let xResult, _cacheOpt = searchSynArgExpr defaultTraverse pos expr + + match xResult with + | Found (parenLoc, argRanges, commasAndCloseParen, isThereACloseParen) -> + // we found it, dig out ident + let typeName = getTypeName ty + + let r = + ParameterLocations( + typeName, + ty.Range, + parenLoc, + argRanges, + commasAndCloseParen |> List.map fst, + isThereACloseParen, + commasAndCloseParen |> List.map snd + ) + + Some r + | NotFound -> None + else + None + } + ) + +type ParameterLocations with + static member Find(pos, parseTree) = - match traverseInput(pos, parseTree) with - | Some nwpl as r -> + match traverseInput (pos, parseTree) with + | Some nwpl as r -> #if DEBUG - let ranges = nwpl.LongIdStartLocation :: nwpl.LongIdEndLocation :: nwpl.OpenParenLocation :: (nwpl.TupleEndLocations |> Array.toList) - let sorted = ranges |> List.sortWith (fun a b -> posOrder.Compare(a, b)) |> Seq.toList - assert(ranges = sorted) + let ranges = + nwpl.LongIdStartLocation + :: nwpl.LongIdEndLocation + :: nwpl.OpenParenLocation :: (nwpl.TupleEndLocations |> Array.toList) + + let sorted = + ranges |> List.sortWith (fun a b -> posOrder.Compare(a, b)) |> Seq.toList + + assert (ranges = sorted) #else ignore nwpl -#endif +#endif r | _ -> None module internal SynExprAppLocationsImpl = let rec private searchSynArgExpr traverseSynExpr expr ranges = match expr with - | SynExpr.Const(SynConst.Unit, _) -> - None, None + | SynExpr.Const (SynConst.Unit, _) -> None, None - | SynExpr.Paren(SynExpr.Tuple (_, exprs, _commas, _tupRange), _, _, _parenRange) -> + | SynExpr.Paren (SynExpr.Tuple (_, exprs, _commas, _tupRange), _, _, _parenRange) -> let rec loop (exprs: SynExpr list) ranges = match exprs with | [] -> ranges - | h::t -> - loop t (h.Range :: ranges) + | h :: t -> loop t (h.Range :: ranges) let res = loop exprs ranges Some res, None - | SynExpr.Paren(SynExpr.Paren _ as synExpr, _, _, _parenRange) -> + | SynExpr.Paren (SynExpr.Paren _ as synExpr, _, _, _parenRange) -> let r, _cacheOpt = searchSynArgExpr traverseSynExpr synExpr ranges r, None - | SynExpr.Paren(SynExpr.App (_, _isInfix, _, _, _range), _, _, parenRange) -> - Some (parenRange :: ranges), None + | SynExpr.Paren (SynExpr.App (_, _isInfix, _, _, _range), _, _, parenRange) -> Some(parenRange :: ranges), None - | e -> + | e -> let inner = traverseSynExpr e + match inner with - | None -> - Some (e.Range :: ranges), Some inner + | None -> Some(e.Range :: ranges), Some inner | _ -> None, Some inner let getAllCurriedArgsAtPosition pos parseTree = - SyntaxTraversal.Traverse(pos, parseTree, { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = - match expr with - | SynExpr.App (_exprAtomicFlag, _isInfix, funcExpr, argExpr, range) when posEq pos range.Start -> - let isInfixFuncExpr = - match funcExpr with - | SynExpr.App (_, isInfix, _, _, _) -> isInfix - | _ -> false - - if isInfixFuncExpr then - traverseSynExpr funcExpr - else - let workingRanges = - match traverseSynExpr funcExpr with - | Some ranges -> ranges - | None -> [] - - let xResult, cacheOpt = searchSynArgExpr traverseSynExpr argExpr workingRanges - match xResult, cacheOpt with - | Some ranges, _ -> Some ranges - | None, Some cache -> cache - | _ -> traverseSynExpr argExpr - | _ -> defaultTraverse expr }) + SyntaxTraversal.Traverse( + pos, + parseTree, + { new SyntaxVisitorBase<_>() with + member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = + match expr with + | SynExpr.App (_exprAtomicFlag, _isInfix, funcExpr, argExpr, range) when posEq pos range.Start -> + let isInfixFuncExpr = + match funcExpr with + | SynExpr.App (_, isInfix, _, _, _) -> isInfix + | _ -> false + + if isInfixFuncExpr then + traverseSynExpr funcExpr + else + let workingRanges = + match traverseSynExpr funcExpr with + | Some ranges -> ranges + | None -> [] + + let xResult, cacheOpt = searchSynArgExpr traverseSynExpr argExpr workingRanges + + match xResult, cacheOpt with + | Some ranges, _ -> Some ranges + | None, Some cache -> cache + | _ -> traverseSynExpr argExpr + | _ -> defaultTraverse expr + } + ) |> Option.map List.rev diff --git a/src/Compiler/Service/ServiceParseTreeWalk.fs b/src/Compiler/Service/ServiceParseTreeWalk.fs index 4fc616925e69..4cfc7c99376d 100755 --- a/src/Compiler/Service/ServiceParseTreeWalk.fs +++ b/src/Compiler/Service/ServiceParseTreeWalk.fs @@ -15,7 +15,7 @@ open FSharp.Compiler.Text.Range /// used to track route during traversal AST [] -type SyntaxNode = +type SyntaxNode = | SynPat of SynPat | SynType of SynType | SynExpr of SynExpr @@ -30,116 +30,151 @@ type SyntaxVisitorPath = SyntaxNode list [] type SyntaxVisitorBase<'T>() = - abstract VisitExpr: path: SyntaxVisitorPath * traverseSynExpr: (SynExpr -> 'T option) * defaultTraverse: (SynExpr -> 'T option) * synExpr: SynExpr -> 'T option - default _.VisitExpr(path: SyntaxVisitorPath, traverseSynExpr: SynExpr -> 'T option, defaultTraverse: SynExpr -> 'T option, synExpr: SynExpr) = + abstract VisitExpr: + path: SyntaxVisitorPath * traverseSynExpr: (SynExpr -> 'T option) * defaultTraverse: (SynExpr -> 'T option) * synExpr: SynExpr -> + 'T option + + default _.VisitExpr + ( + path: SyntaxVisitorPath, + traverseSynExpr: SynExpr -> 'T option, + defaultTraverse: SynExpr -> 'T option, + synExpr: SynExpr + ) = ignore (path, traverseSynExpr, defaultTraverse, synExpr) None /// VisitTypeAbbrev(ty,m), defaults to ignoring this leaf of the AST abstract VisitTypeAbbrev: path: SyntaxVisitorPath * synType: SynType * range: range -> 'T option + default _.VisitTypeAbbrev(path, synType, range) = ignore (path, synType, range) None /// VisitImplicitInherit(defaultTraverse,ty,expr,m), defaults to just visiting expr - abstract VisitImplicitInherit: path: SyntaxVisitorPath * defaultTraverse: (SynExpr -> 'T option) * inheritedType: SynType * synArgs: SynExpr * range: range -> 'T option + abstract VisitImplicitInherit: + path: SyntaxVisitorPath * defaultTraverse: (SynExpr -> 'T option) * inheritedType: SynType * synArgs: SynExpr * range: range -> + 'T option + default _.VisitImplicitInherit(path, defaultTraverse, inheritedType, synArgs, range) = ignore (path, inheritedType, range) defaultTraverse synArgs /// VisitModuleDecl allows overriding module declaration behavior - abstract VisitModuleDecl: path: SyntaxVisitorPath * defaultTraverse: (SynModuleDecl -> 'T option) * synModuleDecl: SynModuleDecl -> 'T option + abstract VisitModuleDecl: + path: SyntaxVisitorPath * defaultTraverse: (SynModuleDecl -> 'T option) * synModuleDecl: SynModuleDecl -> 'T option + default _.VisitModuleDecl(path, defaultTraverse, synModuleDecl) = ignore path defaultTraverse synModuleDecl /// VisitBinding allows overriding binding behavior (note: by default it would defaultTraverse expression) abstract VisitBinding: path: SyntaxVisitorPath * defaultTraverse: (SynBinding -> 'T option) * synBinding: SynBinding -> 'T option + default _.VisitBinding(path, defaultTraverse, synBinding) = ignore path defaultTraverse synBinding /// VisitMatchClause allows overriding clause behavior (note: by default it would defaultTraverse expression) - abstract VisitMatchClause: path: SyntaxVisitorPath * defaultTraverse: (SynMatchClause -> 'T option) * matchClause: SynMatchClause -> 'T option + abstract VisitMatchClause: + path: SyntaxVisitorPath * defaultTraverse: (SynMatchClause -> 'T option) * matchClause: SynMatchClause -> 'T option + default _.VisitMatchClause(path, defaultTraverse, matchClause) = ignore path defaultTraverse matchClause /// VisitInheritSynMemberDefn allows overriding inherit behavior (by default do nothing) - abstract VisitInheritSynMemberDefn: path: SyntaxVisitorPath * componentInfo: SynComponentInfo * typeDefnKind: SynTypeDefnKind * SynType * SynMemberDefns * range -> 'T option + abstract VisitInheritSynMemberDefn: + path: SyntaxVisitorPath * componentInfo: SynComponentInfo * typeDefnKind: SynTypeDefnKind * SynType * SynMemberDefns * range -> + 'T option + default _.VisitInheritSynMemberDefn(path, componentInfo, typeDefnKind, synType, members, range) = ignore (path, componentInfo, typeDefnKind, synType, members, range) None /// VisitRecordDefn allows overriding behavior when visiting record definitions (by default do nothing) abstract VisitRecordDefn: path: SyntaxVisitorPath * fields: SynField list * range -> 'T option + default _.VisitRecordDefn(path, fields, range) = ignore (path, fields, range) None /// VisitUnionDefn allows overriding behavior when visiting union definitions (by default do nothing) abstract VisitUnionDefn: path: SyntaxVisitorPath * cases: SynUnionCase list * range -> 'T option + default _.VisitUnionDefn(path, cases, range) = ignore (path, cases, range) None /// VisitEnumDefn allows overriding behavior when visiting enum definitions (by default do nothing) abstract VisitEnumDefn: path: SyntaxVisitorPath * cases: SynEnumCase list * range -> 'T option + default _.VisitEnumDefn(path, cases, range) = ignore (path, cases, range) None /// VisitInterfaceSynMemberDefnType allows overriding behavior for visiting interface member in types (by default - do nothing) abstract VisitInterfaceSynMemberDefnType: path: SyntaxVisitorPath * synType: SynType -> 'T option + default _.VisitInterfaceSynMemberDefnType(path, synType) = ignore (path, synType) None /// VisitRecordField allows overriding behavior when visiting l.h.s. of constructed record instances abstract VisitRecordField: path: SyntaxVisitorPath * copyOpt: SynExpr option * recordField: SynLongIdent option -> 'T option - default _.VisitRecordField (path, copyOpt, recordField) = + + default _.VisitRecordField(path, copyOpt, recordField) = ignore (path, copyOpt, recordField) None /// VisitHashDirective allows overriding behavior when visiting hash directives in FSX scripts, like #r, #load and #I. abstract VisitHashDirective: path: SyntaxVisitorPath * hashDirective: ParsedHashDirective * range: range -> 'T option - default _.VisitHashDirective (path, hashDirective, range) = + + default _.VisitHashDirective(path, hashDirective, range) = ignore (path, hashDirective, range) None /// VisitModuleOrNamespace allows overriding behavior when visiting module or namespaces abstract VisitModuleOrNamespace: path: SyntaxVisitorPath * synModuleOrNamespace: SynModuleOrNamespace -> 'T option - default _.VisitModuleOrNamespace (path, synModuleOrNamespace) = + + default _.VisitModuleOrNamespace(path, synModuleOrNamespace) = ignore (path, synModuleOrNamespace) None - /// VisitComponentInfo allows overriding behavior when visiting type component infos + /// VisitComponentInfo allows overriding behavior when visiting type component infos abstract VisitComponentInfo: path: SyntaxVisitorPath * synComponentInfo: SynComponentInfo -> 'T option - default _.VisitComponentInfo (path, synComponentInfo) = + + default _.VisitComponentInfo(path, synComponentInfo) = ignore (path, synComponentInfo) None /// VisitLetOrUse allows overriding behavior when visiting module or local let or use bindings - abstract VisitLetOrUse: path: SyntaxVisitorPath * isRecursive: bool * defaultTraverse: (SynBinding -> 'T option) * bindings: SynBinding list * range: range -> 'T option - default _.VisitLetOrUse (path, isRecursive, defaultTraverse, bindings, range) = + abstract VisitLetOrUse: + path: SyntaxVisitorPath * isRecursive: bool * defaultTraverse: (SynBinding -> 'T option) * bindings: SynBinding list * range: range -> + 'T option + + default _.VisitLetOrUse(path, isRecursive, defaultTraverse, bindings, range) = ignore (path, isRecursive, defaultTraverse, bindings, range) None /// VisitType allows overriding behavior when visiting simple pats abstract VisitSimplePats: path: SyntaxVisitorPath * synPats: SynSimplePat list -> 'T option - default _.VisitSimplePats (path, synPats) = + + default _.VisitSimplePats(path, synPats) = ignore (path, synPats) None /// VisitPat allows overriding behavior when visiting patterns abstract VisitPat: path: SyntaxVisitorPath * defaultTraverse: (SynPat -> 'T option) * synPat: SynPat -> 'T option - default _.VisitPat (path, defaultTraverse, synPat) = + + default _.VisitPat(path, defaultTraverse, synPat) = ignore path defaultTraverse synPat /// VisitType allows overriding behavior when visiting type hints (x: ..., etc.) abstract VisitType: path: SyntaxVisitorPath * defaultTraverse: (SynType -> 'T option) * synType: SynType -> 'T option - default _.VisitType (path, defaultTraverse, synType) = + + default _.VisitType(path, defaultTraverse, synType) = ignore path defaultTraverse synType @@ -147,128 +182,165 @@ type SyntaxVisitorBase<'T>() = module SyntaxTraversal = // treat ranges as though they are half-open: [,) - let rangeContainsPosLeftEdgeInclusive (m1:range) p = + let rangeContainsPosLeftEdgeInclusive (m1: range) p = if posEq m1.Start m1.End then // the parser doesn't produce zero-width ranges, except in one case, for e.g. a block of lets that lacks a body // we treat the range [n,n) as containing position n - posGeq p m1.Start && - posGeq m1.End p + posGeq p m1.Start && posGeq m1.End p else - posGeq p m1.Start && // [ - posGt m1.End p // ) + posGeq p m1.Start + && // [ + posGt m1.End p // ) // treat ranges as though they are fully open: (,) - let rangeContainsPosEdgesExclusive (m1:range) p = posGt p m1.Start && posGt m1.End p + let rangeContainsPosEdgesExclusive (m1: range) p = posGt p m1.Start && posGt m1.End p - let rangeContainsPosLeftEdgeExclusiveAndRightEdgeInclusive (m1:range) p = posGt p m1.Start && posGeq m1.End p + let rangeContainsPosLeftEdgeExclusiveAndRightEdgeInclusive (m1: range) p = posGt p m1.Start && posGeq m1.End p - let dive node range project = - range,(fun() -> project node) + let dive node range project = range, (fun () -> project node) - let pick pos (outerRange:range) (debugObj:obj) (diveResults: (range * _) list) = + let pick pos (outerRange: range) (debugObj: obj) (diveResults: (range * _) list) = match diveResults with | [] -> None | _ -> - let isOrdered = + let isOrdered = #if DEBUG - // ranges in a dive-and-pick group should be ordered - diveResults |> Seq.pairwise |> Seq.forall (fun ((r1,_),(r2,_)) -> posGeq r2.Start r1.End) + // ranges in a dive-and-pick group should be ordered + diveResults + |> Seq.pairwise + |> Seq.forall (fun ((r1, _), (r2, _)) -> posGeq r2.Start r1.End) #else - true + true #endif - if not isOrdered then - let s = sprintf "ServiceParseTreeWalk: not isOrdered: %A" (diveResults |> List.map (fun (r,_) -> r.ToShortString())) - ignore s + if not isOrdered then + let s = + sprintf "ServiceParseTreeWalk: not isOrdered: %A" (diveResults |> List.map (fun (r, _) -> r.ToShortString())) + + ignore s //System.Diagnostics.Debug.Assert(false, s) - let outerContainsInner = + let outerContainsInner = #if DEBUG - // ranges in a dive-and-pick group should be "under" the thing that contains them - let innerTotalRange = diveResults |> List.map fst |> List.reduce unionRanges - rangeContainsRange outerRange innerTotalRange + // ranges in a dive-and-pick group should be "under" the thing that contains them + let innerTotalRange = diveResults |> List.map fst |> List.reduce unionRanges + rangeContainsRange outerRange innerTotalRange #else - ignore(outerRange) - true + ignore (outerRange) + true #endif - if not outerContainsInner then - let s = sprintf "ServiceParseTreeWalk: not outerContainsInner: %A : %A" (outerRange.ToShortString()) (diveResults |> List.map (fun (r,_) -> r.ToShortString())) - ignore s + if not outerContainsInner then + let s = + sprintf + "ServiceParseTreeWalk: not outerContainsInner: %A : %A" + (outerRange.ToShortString()) + (diveResults |> List.map (fun (r, _) -> r.ToShortString())) + + ignore s //System.Diagnostics.Debug.Assert(false, s) - let isZeroWidth(r:range) = - posEq r.Start r.End // the parser inserts some zero-width elements to represent the completions of incomplete constructs, but we should never 'dive' into them, since they don't represent actual user code - match List.choose (fun (r,f) -> if rangeContainsPosLeftEdgeInclusive r pos && not(isZeroWidth r) then Some(f) else None) diveResults with - | [] -> - // No entity's range contained the desired position. However the ranges in the parse tree only span actual characters present in the file. - // The cursor may be at whitespace between entities or after everything, so find the nearest entity with the range left of the position. - let mutable e = diveResults.Head - for r in diveResults do - if posGt pos (fst r).Start then - e <- r - snd(e)() - | [x] -> x() - | _ -> + let isZeroWidth (r: range) = posEq r.Start r.End // the parser inserts some zero-width elements to represent the completions of incomplete constructs, but we should never 'dive' into them, since they don't represent actual user code + + match + List.choose + (fun (r, f) -> + if rangeContainsPosLeftEdgeInclusive r pos && not (isZeroWidth r) then + Some(f) + else + None) + diveResults + with + | [] -> + // No entity's range contained the desired position. However the ranges in the parse tree only span actual characters present in the file. + // The cursor may be at whitespace between entities or after everything, so find the nearest entity with the range left of the position. + let mutable e = diveResults.Head + + for r in diveResults do + if posGt pos (fst r).Start then e <- r + + snd (e) () + | [ x ] -> x () + | _ -> #if DEBUG - assert false - failwithf "multiple disjoint AST node ranges claimed to contain (%A) from %+A" pos debugObj + assert false + failwithf "multiple disjoint AST node ranges claimed to contain (%A) from %+A" pos debugObj #else - ignore debugObj - None + ignore debugObj + None #endif /// traverse an implementation file walking all the way down to SynExpr or TypeAbbrev at a particular location /// - let Traverse(pos:pos, parseTree, visitor:SyntaxVisitorBase<'T>) = + let Traverse (pos: pos, parseTree, visitor: SyntaxVisitorBase<'T>) = let pick x = pick pos x - let rec traverseSynModuleDecl origPath (decl:SynModuleDecl) = + + let rec traverseSynModuleDecl origPath (decl: SynModuleDecl) = let pick = pick decl.Range - let defaultTraverse m = + + let defaultTraverse m = let path = SyntaxNode.SynModule m :: origPath + match m with - | SynModuleDecl.ModuleAbbrev(_ident, _longIdent, _range) -> None - | SynModuleDecl.NestedModule(decls=synModuleDecls) -> synModuleDecls |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path)) |> pick decl - | SynModuleDecl.Let(isRecursive, synBindingList, range) -> + | SynModuleDecl.ModuleAbbrev (_ident, _longIdent, _range) -> None + | SynModuleDecl.NestedModule (decls = synModuleDecls) -> + synModuleDecls + |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path)) + |> pick decl + | SynModuleDecl.Let (isRecursive, synBindingList, range) -> match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with | Some x -> Some x - | None -> synBindingList |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path)) |> pick decl - | SynModuleDecl.Expr(synExpr, _range) -> traverseSynExpr path synExpr - | SynModuleDecl.Types(synTypeDefnList, _range) -> synTypeDefnList |> List.map (fun x -> dive x x.Range (traverseSynTypeDefn path)) |> pick decl - | SynModuleDecl.Exception(_synExceptionDefn, _range) -> None - | SynModuleDecl.Open(_target, _range) -> None - | SynModuleDecl.Attributes(_synAttributes, _range) -> None - | SynModuleDecl.HashDirective(parsedHashDirective, range) -> visitor.VisitHashDirective (path, parsedHashDirective, range) - | SynModuleDecl.NamespaceFragment(synModuleOrNamespace) -> traverseSynModuleOrNamespace path synModuleOrNamespace + | None -> + synBindingList + |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path)) + |> pick decl + | SynModuleDecl.Expr (synExpr, _range) -> traverseSynExpr path synExpr + | SynModuleDecl.Types (synTypeDefnList, _range) -> + synTypeDefnList + |> List.map (fun x -> dive x x.Range (traverseSynTypeDefn path)) + |> pick decl + | SynModuleDecl.Exception (_synExceptionDefn, _range) -> None + | SynModuleDecl.Open (_target, _range) -> None + | SynModuleDecl.Attributes (_synAttributes, _range) -> None + | SynModuleDecl.HashDirective (parsedHashDirective, range) -> visitor.VisitHashDirective(path, parsedHashDirective, range) + | SynModuleDecl.NamespaceFragment (synModuleOrNamespace) -> traverseSynModuleOrNamespace path synModuleOrNamespace + visitor.VisitModuleDecl(origPath, defaultTraverse, decl) - and traverseSynModuleOrNamespace origPath (SynModuleOrNamespace(decls = synModuleDecls; range = range) as mors) = + and traverseSynModuleOrNamespace origPath (SynModuleOrNamespace (decls = synModuleDecls; range = range) as mors) = match visitor.VisitModuleOrNamespace(origPath, mors) with | Some x -> Some x | None -> let path = SyntaxNode.SynModuleOrNamespace mors :: origPath - synModuleDecls |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path)) |> pick range mors - and traverseSynExpr origPath (expr:SynExpr) = + synModuleDecls + |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path)) + |> pick range mors + + and traverseSynExpr origPath (expr: SynExpr) = let pick = pick expr.Range - let defaultTraverse e = + + let defaultTraverse e = let path = SyntaxNode.SynExpr e :: origPath let traverseSynExpr = traverseSynExpr path let traverseSynType = traverseSynType path let traversePat = traversePat path + match e with | SynExpr.Paren (synExpr, _, _, _parenRange) -> traverseSynExpr synExpr - | SynExpr.Quote (_synExpr, _, synExpr2, _, _range) -> - [//dive synExpr synExpr.Range traverseSynExpr // TODO, what is this? - dive synExpr2 synExpr2.Range traverseSynExpr] + | SynExpr.Quote (_synExpr, _, synExpr2, _, _range) -> + [ //dive synExpr synExpr.Range traverseSynExpr // TODO, what is this? + dive synExpr2 synExpr2.Range traverseSynExpr + ] |> pick expr | SynExpr.Const (_synConst, _range) -> None - | SynExpr.InterpolatedString (parts, _, _) -> - [ for part in parts do - match part with - | SynInterpolatedStringPart.String _ -> () - | SynInterpolatedStringPart.FillExpr (fillExpr, _) -> - yield dive fillExpr fillExpr.Range traverseSynExpr ] + | SynExpr.InterpolatedString (parts, _, _) -> + [ + for part in parts do + match part with + | SynInterpolatedStringPart.String _ -> () + | SynInterpolatedStringPart.FillExpr (fillExpr, _) -> yield dive fillExpr fillExpr.Range traverseSynExpr + ] |> pick expr | SynExpr.Typed (synExpr, synType, _range) -> @@ -276,192 +348,221 @@ module SyntaxTraversal = | None -> traverseSynType synType | x -> x - | SynExpr.Tuple (_, synExprList, _, _range) + | SynExpr.Tuple (_, synExprList, _, _range) | SynExpr.ArrayOrList (_, synExprList, _range) -> synExprList |> List.map (fun x -> dive x x.Range traverseSynExpr) |> pick expr - - | SynExpr.AnonRecd (_isStruct, copyOpt, synExprList, _range) -> - [ match copyOpt with - | Some(expr, (withRange, _)) -> - yield dive expr expr.Range traverseSynExpr - yield dive () withRange (fun () -> - if posGeq pos withRange.End then - // special case: caret is after WITH - // { x with $ } - visitor.VisitRecordField (path, Some expr, None) - else - None - ) + + | SynExpr.AnonRecd (_isStruct, copyOpt, synExprList, _range) -> + [ + match copyOpt with + | Some (expr, (withRange, _)) -> + yield dive expr expr.Range traverseSynExpr + + yield + dive () withRange (fun () -> + if posGeq pos withRange.End then + // special case: caret is after WITH + // { x with $ } + visitor.VisitRecordField(path, Some expr, None) + else + None) | _ -> () - for _, _, x in synExprList do + for _, _, x in synExprList do yield dive x x.Range traverseSynExpr - ] |> pick expr + ] + |> pick expr - | SynExpr.Record (inheritOpt,copyOpt,fields, _range) -> - [ - let diveIntoSeparator offsideColumn scPosOpt copyOpt = + | SynExpr.Record (inheritOpt, copyOpt, fields, _range) -> + [ + let diveIntoSeparator offsideColumn scPosOpt copyOpt = match scPosOpt with - | Some scPos -> - if posGeq pos scPos then + | Some scPos -> + if posGeq pos scPos then visitor.VisitRecordField(path, copyOpt, None) // empty field after the inherits - else None - | None -> + else + None + | None -> //semicolon position is not available - use offside rule if pos.Column = offsideColumn then visitor.VisitRecordField(path, copyOpt, None) // empty field after the inherits - else None + else + None match inheritOpt with - | Some(_ty,expr, _range, sepOpt, inheritRange) -> + | Some (_ty, expr, _range, sepOpt, inheritRange) -> // dive into argument - yield dive expr expr.Range (fun expr -> - // special-case:caret is located in the offside position below inherit - // inherit A() - // $ - if not (rangeContainsPos expr.Range pos) && sepOpt.IsNone && pos.Column = inheritRange.StartColumn then - visitor.VisitRecordField(path, None, None) - else - traverseSynExpr expr - ) - match sepOpt with - | Some (sep, scPosOpt) -> - yield dive () sep (fun () -> - // special case: caret is below 'inherit' + one or more fields are already defined + yield + dive expr expr.Range (fun expr -> + // special-case:caret is located in the offside position below inherit // inherit A() // $ - // field1 = 5 - diveIntoSeparator inheritRange.StartColumn scPosOpt None - ) + if not (rangeContainsPos expr.Range pos) + && sepOpt.IsNone + && pos.Column = inheritRange.StartColumn then + visitor.VisitRecordField(path, None, None) + else + traverseSynExpr expr) + + match sepOpt with + | Some (sep, scPosOpt) -> + yield + dive () sep (fun () -> + // special case: caret is below 'inherit' + one or more fields are already defined + // inherit A() + // $ + // field1 = 5 + diveIntoSeparator inheritRange.StartColumn scPosOpt None) | None -> () | _ -> () + match copyOpt with - | Some(expr, (withRange, _)) -> - yield dive expr expr.Range traverseSynExpr - yield dive () withRange (fun () -> - if posGeq pos withRange.End then - // special case: caret is after WITH - // { x with $ } - visitor.VisitRecordField (path, Some expr, None) - else - None - ) + | Some (expr, (withRange, _)) -> + yield dive expr expr.Range traverseSynExpr + + yield + dive () withRange (fun () -> + if posGeq pos withRange.End then + // special case: caret is after WITH + // { x with $ } + visitor.VisitRecordField(path, Some expr, None) + else + None) | _ -> () + let copyOpt = Option.map fst copyOpt - for SynExprRecordField(fieldName=(field, _); expr=e; blockSeparator=sepOpt) in fields do - yield dive (path, copyOpt, Some field) field.Range (fun r -> - if rangeContainsPos field.Range pos then - visitor.VisitRecordField r - else - None - ) - let offsideColumn = + + for SynExprRecordField (fieldName = (field, _); expr = e; blockSeparator = sepOpt) in fields do + yield + dive (path, copyOpt, Some field) field.Range (fun r -> + if rangeContainsPos field.Range pos then + visitor.VisitRecordField r + else + None) + + let offsideColumn = match inheritOpt with - | Some(_,_, _, _, inheritRange) -> inheritRange.StartColumn + | Some (_, _, _, _, inheritRange) -> inheritRange.StartColumn | None -> field.Range.StartColumn match e with - | Some e -> yield dive e e.Range (fun expr -> - // special case: caret is below field binding - // field x = 5 - // $ - if not (rangeContainsPos e.Range pos) && sepOpt.IsNone && pos.Column = offsideColumn then - visitor.VisitRecordField(path, copyOpt, None) - else - traverseSynExpr expr - ) + | Some e -> + yield + dive e e.Range (fun expr -> + // special case: caret is below field binding + // field x = 5 + // $ + if not (rangeContainsPos e.Range pos) + && sepOpt.IsNone + && pos.Column = offsideColumn then + visitor.VisitRecordField(path, copyOpt, None) + else + traverseSynExpr expr) | None -> () match sepOpt with - | Some (sep, scPosOpt) -> - yield dive () sep (fun () -> - // special case: caret is between field bindings - // field1 = 5 - // $ - // field2 = 5 - diveIntoSeparator offsideColumn scPosOpt copyOpt - ) + | Some (sep, scPosOpt) -> + yield + dive () sep (fun () -> + // special case: caret is between field bindings + // field1 = 5 + // $ + // field2 = 5 + diveIntoSeparator offsideColumn scPosOpt copyOpt) | _ -> () - ] |> pick expr + ] + |> pick expr | SynExpr.New (_, _synType, synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.ObjExpr (objType=ty; argOptions=baseCallOpt; bindings=binds; members=ms; extraImpls=ifaces) -> + | SynExpr.ObjExpr (objType = ty; argOptions = baseCallOpt; bindings = binds; members = ms; extraImpls = ifaces) -> let binds = unionBindingAndMembers binds ms - let result = - ifaces - |> Seq.map (fun (SynInterfaceImpl(interfaceTy=ty)) -> ty) + + let result = + ifaces + |> Seq.map (fun (SynInterfaceImpl (interfaceTy = ty)) -> ty) |> Seq.tryPick (fun ty -> visitor.VisitInterfaceSynMemberDefnType(path, ty)) - - if result.IsSome then + + if result.IsSome then result else - [ - match baseCallOpt with - | Some(expr,_) -> - // this is like a call to 'new', so mock up a 'new' so we can recurse and use that existing logic - let newCall = SynExpr.New (false, ty, expr, unionRanges ty.Range expr.Range) - yield dive newCall newCall.Range traverseSynExpr - | _ -> () - for b in binds do - yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path) - for SynInterfaceImpl(bindings=binds) in ifaces do + [ + match baseCallOpt with + | Some (expr, _) -> + // this is like a call to 'new', so mock up a 'new' so we can recurse and use that existing logic + let newCall = SynExpr.New(false, ty, expr, unionRanges ty.Range expr.Range) + yield dive newCall newCall.Range traverseSynExpr + | _ -> () for b in binds do yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path) - ] |> pick expr + for SynInterfaceImpl (bindings = binds) in ifaces do + for b in binds do + yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path) + ] + |> pick expr - | SynExpr.While (_spWhile, synExpr, synExpr2, _range) -> - [dive synExpr synExpr.Range traverseSynExpr - dive synExpr2 synExpr2.Range traverseSynExpr] + | SynExpr.While (_spWhile, synExpr, synExpr2, _range) -> + [ + dive synExpr synExpr.Range traverseSynExpr + dive synExpr2 synExpr2.Range traverseSynExpr + ] |> pick expr - | SynExpr.For (identBody=synExpr; toBody=synExpr2; doBody=synExpr3) -> - [dive synExpr synExpr.Range traverseSynExpr - dive synExpr2 synExpr2.Range traverseSynExpr - dive synExpr3 synExpr3.Range traverseSynExpr] + | SynExpr.For (identBody = synExpr; toBody = synExpr2; doBody = synExpr3) -> + [ + dive synExpr synExpr.Range traverseSynExpr + dive synExpr2 synExpr2.Range traverseSynExpr + dive synExpr3 synExpr3.Range traverseSynExpr + ] |> pick expr | SynExpr.ForEach (_spFor, _spIn, _seqExprOnly, _isFromSource, synPat, synExpr, synExpr2, _range) -> - [dive synPat synPat.Range traversePat - dive synExpr synExpr.Range traverseSynExpr - dive synExpr2 synExpr2.Range traverseSynExpr] + [ + dive synPat synPat.Range traversePat + dive synExpr synExpr.Range traverseSynExpr + dive synExpr2 synExpr2.Range traverseSynExpr + ] |> pick expr | SynExpr.ArrayOrListComputed (_, synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.ComputationExpr (_, synExpr, _range) -> + | SynExpr.ComputationExpr (_, synExpr, _range) -> // now parser treats this syntactic expression as computation expression // { identifier } // here we detect this situation and treat ComputationExpr { Identifier } as attempt to create record // note: sequence expressions use SynExpr.ComputationExpr too - they need to be filtered out - let isPartOfArrayOrList = + let isPartOfArrayOrList = match origPath with - | SyntaxNode.SynExpr(SynExpr.ArrayOrListComputed _) :: _ -> true + | SyntaxNode.SynExpr (SynExpr.ArrayOrListComputed _) :: _ -> true | _ -> false - let ok = + + let ok = match isPartOfArrayOrList, synExpr with - | false, SynExpr.Ident ident -> visitor.VisitRecordField(path, None, Some (SynLongIdent([ident], [], [None]))) + | false, SynExpr.Ident ident -> visitor.VisitRecordField(path, None, Some(SynLongIdent([ ident ], [], [ None ]))) | false, SynExpr.LongIdent (false, lidwd, _, _) -> visitor.VisitRecordField(path, None, Some lidwd) | _ -> None - if ok.IsSome then ok - else - traverseSynExpr synExpr - | SynExpr.Lambda (args=synSimplePats; body=synExpr) -> + if ok.IsSome then ok else traverseSynExpr synExpr + + | SynExpr.Lambda (args = synSimplePats; body = synExpr) -> match synSimplePats with - | SynSimplePats.SimplePats(pats,_) -> + | SynSimplePats.SimplePats (pats, _) -> match visitor.VisitSimplePats(path, pats) with | None -> traverseSynExpr synExpr | x -> x | _ -> traverseSynExpr synExpr - | SynExpr.MatchLambda (_isExnMatch,_argm,synMatchClauseList,_spBind,_wholem) -> - synMatchClauseList + | SynExpr.MatchLambda (_isExnMatch, _argm, synMatchClauseList, _spBind, _wholem) -> + synMatchClauseList |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) |> pick expr - | SynExpr.Match (expr=synExpr; clauses=synMatchClauseList) -> - [yield dive synExpr synExpr.Range traverseSynExpr - yield! synMatchClauseList |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))] + | SynExpr.Match (expr = synExpr; clauses = synMatchClauseList) -> + [ + yield dive synExpr synExpr.Range traverseSynExpr + yield! + synMatchClauseList + |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) + ] |> pick expr | SynExpr.Do (synExpr, _range) -> traverseSynExpr synExpr @@ -473,52 +574,70 @@ module SyntaxTraversal = | SynExpr.DebugPoint (_, _, synExpr) -> traverseSynExpr synExpr | SynExpr.Dynamic _ -> None - + | SynExpr.App (_exprAtomicFlag, isInfix, synExpr, synExpr2, _range) -> if isInfix then - [dive synExpr2 synExpr2.Range traverseSynExpr - dive synExpr synExpr.Range traverseSynExpr] // reverse the args + [ + dive synExpr2 synExpr2.Range traverseSynExpr + dive synExpr synExpr.Range traverseSynExpr + ] // reverse the args |> pick expr else - [dive synExpr synExpr.Range traverseSynExpr - dive synExpr2 synExpr2.Range traverseSynExpr] + [ + dive synExpr synExpr.Range traverseSynExpr + dive synExpr2 synExpr2.Range traverseSynExpr + ] |> pick expr | SynExpr.TypeApp (synExpr, _, _synTypeList, _commas, _, _, _range) -> traverseSynExpr synExpr - | SynExpr.LetOrUse (_, isRecursive, synBindingList, synExpr, range, _) -> + | SynExpr.LetOrUse (_, isRecursive, synBindingList, synExpr, range, _) -> match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with | None -> - [yield! synBindingList |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path)) - yield dive synExpr synExpr.Range traverseSynExpr] + [ + yield! + synBindingList + |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path)) + yield dive synExpr synExpr.Range traverseSynExpr + ] |> pick expr | x -> x - | SynExpr.TryWith (tryExpr=synExpr; withCases=synMatchClauseList) -> - [yield dive synExpr synExpr.Range traverseSynExpr - yield! synMatchClauseList |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))] + | SynExpr.TryWith (tryExpr = synExpr; withCases = synMatchClauseList) -> + [ + yield dive synExpr synExpr.Range traverseSynExpr + yield! + synMatchClauseList + |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) + ] |> pick expr - | SynExpr.TryFinally (tryExpr=synExpr; finallyExpr=synExpr2) -> - [dive synExpr synExpr.Range traverseSynExpr - dive synExpr2 synExpr2.Range traverseSynExpr] + | SynExpr.TryFinally (tryExpr = synExpr; finallyExpr = synExpr2) -> + [ + dive synExpr synExpr.Range traverseSynExpr + dive synExpr2 synExpr2.Range traverseSynExpr + ] |> pick expr | SynExpr.Lazy (synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.SequentialOrImplicitYield (_sequencePointInfoForSequential, synExpr, synExpr2, _, _range) + | SynExpr.SequentialOrImplicitYield (_sequencePointInfoForSequential, synExpr, synExpr2, _, _range) - | SynExpr.Sequential (_sequencePointInfoForSequential, _, synExpr, synExpr2, _range) -> - [dive synExpr synExpr.Range traverseSynExpr - dive synExpr2 synExpr2.Range traverseSynExpr] + | SynExpr.Sequential (_sequencePointInfoForSequential, _, synExpr, synExpr2, _range) -> + [ + dive synExpr synExpr.Range traverseSynExpr + dive synExpr2 synExpr2.Range traverseSynExpr + ] |> pick expr - | SynExpr.IfThenElse (ifExpr=synExpr; thenExpr=synExpr2; elseExpr=synExprOpt) -> - [yield dive synExpr synExpr.Range traverseSynExpr - yield dive synExpr2 synExpr2.Range traverseSynExpr - match synExprOpt with - | None -> () - | Some x -> yield dive x x.Range traverseSynExpr] + | SynExpr.IfThenElse (ifExpr = synExpr; thenExpr = synExpr2; elseExpr = synExprOpt) -> + [ + yield dive synExpr synExpr.Range traverseSynExpr + yield dive synExpr2 synExpr2.Range traverseSynExpr + match synExprOpt with + | None -> () + | Some x -> yield dive x x.Range traverseSynExpr + ] |> pick expr | SynExpr.Ident _ident -> None @@ -532,43 +651,60 @@ module SyntaxTraversal = | SynExpr.Set (synExpr, synExpr2, _) | SynExpr.DotSet (synExpr, _, synExpr2, _) -> - [dive synExpr synExpr.Range traverseSynExpr - dive synExpr2 synExpr2.Range traverseSynExpr] + [ + dive synExpr synExpr.Range traverseSynExpr + dive synExpr2 synExpr2.Range traverseSynExpr + ] |> pick expr - | SynExpr.IndexRange (expr1, _, expr2, _, _, _) -> - [ match expr1 with Some e -> dive e e.Range traverseSynExpr | None -> () - match expr2 with Some e -> dive e e.Range traverseSynExpr | None -> () ] + | SynExpr.IndexRange (expr1, _, expr2, _, _, _) -> + [ + match expr1 with + | Some e -> dive e e.Range traverseSynExpr + | None -> () + match expr2 with + | Some e -> dive e e.Range traverseSynExpr + | None -> () + ] |> pick expr - | SynExpr.IndexFromEnd (e, _) -> - traverseSynExpr e + | SynExpr.IndexFromEnd (e, _) -> traverseSynExpr e - | SynExpr.DotIndexedGet (synExpr, indexArgs, _range, _range2) -> - [yield dive synExpr synExpr.Range traverseSynExpr - yield dive indexArgs indexArgs.Range traverseSynExpr] + | SynExpr.DotIndexedGet (synExpr, indexArgs, _range, _range2) -> + [ + yield dive synExpr synExpr.Range traverseSynExpr + yield dive indexArgs indexArgs.Range traverseSynExpr + ] |> pick expr - | SynExpr.DotIndexedSet (synExpr, indexArgs, synExpr2, _, _range, _range2) -> - [yield dive synExpr synExpr.Range traverseSynExpr - yield dive indexArgs indexArgs.Range traverseSynExpr - yield dive synExpr2 synExpr2.Range traverseSynExpr] + | SynExpr.DotIndexedSet (synExpr, indexArgs, synExpr2, _, _range, _range2) -> + [ + yield dive synExpr synExpr.Range traverseSynExpr + yield dive indexArgs indexArgs.Range traverseSynExpr + yield dive synExpr2 synExpr2.Range traverseSynExpr + ] |> pick expr - | SynExpr.JoinIn (synExpr1, _range, synExpr2, _range2) -> - [dive synExpr1 synExpr1.Range traverseSynExpr - dive synExpr2 synExpr2.Range traverseSynExpr] + | SynExpr.JoinIn (synExpr1, _range, synExpr2, _range2) -> + [ + dive synExpr1 synExpr1.Range traverseSynExpr + dive synExpr2 synExpr2.Range traverseSynExpr + ] |> pick expr | SynExpr.NamedIndexedPropertySet (_longIdent, synExpr, synExpr2, _range) -> - [dive synExpr synExpr.Range traverseSynExpr - dive synExpr2 synExpr2.Range traverseSynExpr] + [ + dive synExpr synExpr.Range traverseSynExpr + dive synExpr2 synExpr2.Range traverseSynExpr + ] |> pick expr - | SynExpr.DotNamedIndexedPropertySet (synExpr, _longIdent, synExpr2, synExpr3, _range) -> - [dive synExpr synExpr.Range traverseSynExpr - dive synExpr2 synExpr2.Range traverseSynExpr - dive synExpr3 synExpr3.Range traverseSynExpr] + | SynExpr.DotNamedIndexedPropertySet (synExpr, _longIdent, synExpr2, synExpr3, _range) -> + [ + dive synExpr synExpr.Range traverseSynExpr + dive synExpr2 synExpr2.Range traverseSynExpr + dive synExpr3 synExpr3.Range traverseSynExpr + ] |> pick expr | SynExpr.TypeTest (synExpr, synType, _range) @@ -576,8 +712,10 @@ module SyntaxTraversal = | SynExpr.Upcast (synExpr, synType, _range) | SynExpr.Downcast (synExpr, synType, _range) -> - [dive synExpr synExpr.Range traverseSynExpr - dive synType synType.Range traverseSynType] + [ + dive synExpr synExpr.Range traverseSynExpr + dive synType synType.Range traverseSynType + ] |> pick expr | SynExpr.InferredUpcast (synExpr, _range) -> traverseSynExpr synExpr @@ -596,21 +734,27 @@ module SyntaxTraversal = | SynExpr.YieldOrReturnFrom (_, synExpr, _range) -> traverseSynExpr synExpr - | SynExpr.LetOrUseBang(pat=synPat; rhs=synExpr; andBangs=andBangSynExprs; body=synExpr2) -> + | SynExpr.LetOrUseBang (pat = synPat; rhs = synExpr; andBangs = andBangSynExprs; body = synExpr2) -> [ yield dive synPat synPat.Range traversePat yield dive synExpr synExpr.Range traverseSynExpr yield! - [ for SynExprAndBang(pat=andBangSynPat; body=andBangSynExpr) in andBangSynExprs do - yield (dive andBangSynPat andBangSynPat.Range traversePat) - yield (dive andBangSynExpr andBangSynExpr.Range traverseSynExpr)] + [ + for SynExprAndBang (pat = andBangSynPat; body = andBangSynExpr) in andBangSynExprs do + yield (dive andBangSynPat andBangSynPat.Range traversePat) + yield (dive andBangSynExpr andBangSynExpr.Range traverseSynExpr) + ] yield dive synExpr2 synExpr2.Range traverseSynExpr ] |> pick expr - | SynExpr.MatchBang (expr=synExpr; clauses=synMatchClauseList) -> - [yield dive synExpr synExpr.Range traverseSynExpr - yield! synMatchClauseList |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))] + | SynExpr.MatchBang (expr = synExpr; clauses = synMatchClauseList) -> + [ + yield dive synExpr synExpr.Range traverseSynExpr + yield! + synMatchClauseList + |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) + ] |> pick expr | SynExpr.DoBang (synExpr, _range) -> traverseSynExpr synExpr @@ -634,6 +778,7 @@ module SyntaxTraversal = and traversePat origPath (pat: SynPat) = let defaultTraverse p = let path = SyntaxNode.SynPat p :: origPath + match p with | SynPat.Paren (p, _) -> traversePat path p | SynPat.As (p1, p2, _) @@ -642,185 +787,209 @@ module SyntaxTraversal = | SynPat.Tuple (_, ps, _) | SynPat.ArrayOrList (_, ps, _) -> ps |> List.tryPick (traversePat path) | SynPat.Attrib (p, _, _) -> traversePat path p - | SynPat.LongIdent(argPats=args) -> + | SynPat.LongIdent (argPats = args) -> match args with | SynArgPats.Pats ps -> ps |> List.tryPick (traversePat path) - | SynArgPats.NamePatPairs (ps, _) -> - ps |> List.map (fun (_, _, pat) -> pat) |> List.tryPick (traversePat path) + | SynArgPats.NamePatPairs (ps, _) -> ps |> List.map (fun (_, _, pat) -> pat) |> List.tryPick (traversePat path) | SynPat.Typed (p, ty, _) -> match traversePat path p with | None -> traverseSynType path ty | x -> x | _ -> None - - visitor.VisitPat (origPath, defaultTraverse, pat) + + visitor.VisitPat(origPath, defaultTraverse, pat) and traverseSynType origPath (StripParenTypes ty) = let defaultTraverse ty = let path = SyntaxNode.SynType ty :: origPath + match ty with | SynType.App (typeName, _, typeArgs, _, _, _, _) | SynType.LongIdentApp (typeName, _, _, typeArgs, _, _, _) -> - [ yield typeName - yield! typeArgs ] - |> List.tryPick (traverseSynType path) - | SynType.Fun (ty1, ty2, _) -> [ty1; ty2] |> List.tryPick (traverseSynType path) - | SynType.MeasurePower (ty, _, _) + [ yield typeName; yield! typeArgs ] |> List.tryPick (traverseSynType path) + | SynType.Fun (ty1, ty2, _) -> [ ty1; ty2 ] |> List.tryPick (traverseSynType path) + | SynType.MeasurePower (ty, _, _) | SynType.HashConstraint (ty, _) | SynType.WithGlobalConstraints (ty, _, _) | SynType.Array (_, ty, _) -> traverseSynType path ty | SynType.StaticConstantNamed (ty1, ty2, _) - | SynType.MeasureDivide (ty1, ty2, _) -> [ty1; ty2] |> List.tryPick (traverseSynType path) + | SynType.MeasureDivide (ty1, ty2, _) -> [ ty1; ty2 ] |> List.tryPick (traverseSynType path) | SynType.Tuple (_, tys, _) -> tys |> List.map snd |> List.tryPick (traverseSynType path) | SynType.StaticConstantExpr (expr, _) -> traverseSynExpr [] expr | SynType.Anon _ -> None | _ -> None - visitor.VisitType (origPath, defaultTraverse, ty) - - 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(memberDefn=SynBinding(headPat=SynPat.LongIdent(longDotId=lid1; extraId=Some(info1)))) as mem1 - SynMemberDefn.Member(memberDefn=SynBinding(headPat=SynPat.LongIdent(longDotId=lid2; extraId=Some(info2)))) as mem2] -> // can happen if one is a getter and one is a setter - // ensure same long id - assert( (lid1.LongIdent,lid2.LongIdent) ||> 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 ) - ) - | [] -> + visitor.VisitType(origPath, defaultTraverse, ty) + + 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(memberDefn = SynBinding(headPat = SynPat.LongIdent (longDotId = lid1; extraId = Some (info1)))) as mem1 + SynMemberDefn.Member(memberDefn = SynBinding(headPat = SynPat.LongIdent (longDotId = lid2; extraId = Some (info2)))) as mem2 ] -> // can happen if one is a getter and one is a setter + // ensure same long id + assert + ((lid1.LongIdent, lid2.LongIdent) + ||> 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 traverseSynTypeDefn origPath (SynTypeDefn(synComponentInfo, synTypeDefnRepr, synMemberDefns, _, tRange, _) as tydef) = + and traverseSynTypeDefn origPath (SynTypeDefn (synComponentInfo, synTypeDefnRepr, synMemberDefns, _, tRange, _) as tydef) = let path = SyntaxNode.SynTypeDefn tydef :: origPath - - match visitor.VisitComponentInfo (origPath, synComponentInfo) with + + match visitor.VisitComponentInfo(origPath, synComponentInfo) with | Some x -> Some x | None -> - [ - match synTypeDefnRepr with - | SynTypeDefnRepr.Exception _ -> - // This node is generated in CheckExpressions.fs, not in the AST. - // But note exception declarations are missing from this tree walk. - () - | SynTypeDefnRepr.ObjectModel(synTypeDefnKind, synMemberDefns, _oRange) -> - // traverse inherit function is used to capture type specific data required for processing Inherit part - let traverseInherit (synType: SynType, range: range) = - visitor.VisitInheritSynMemberDefn(path, synComponentInfo, synTypeDefnKind, synType, synMemberDefns, range) - yield! synMemberDefns |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path traverseInherit - | SynTypeDefnRepr.Simple(synTypeDefnSimpleRepr, _range) -> - match synTypeDefnSimpleRepr with - | SynTypeDefnSimpleRepr.Record(_synAccessOption, fields, m) -> - yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitRecordDefn(path, fields, m)) - | SynTypeDefnSimpleRepr.Union(_synAccessOption, cases, m) -> - yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitUnionDefn(path, cases, m)) - | SynTypeDefnSimpleRepr.Enum(cases, m) -> - yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitEnumDefn(path, cases, m)) - | SynTypeDefnSimpleRepr.TypeAbbrev(_, synType, m) -> - yield dive synTypeDefnRepr synTypeDefnRepr.Range (fun _ -> visitor.VisitTypeAbbrev(path, synType, m)) - | _ -> + [ + match synTypeDefnRepr with + | SynTypeDefnRepr.Exception _ -> + // This node is generated in CheckExpressions.fs, not in the AST. + // But note exception declarations are missing from this tree walk. () - yield! synMemberDefns |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None) - ] |> pick tRange tydef + | SynTypeDefnRepr.ObjectModel (synTypeDefnKind, synMemberDefns, _oRange) -> + // traverse inherit function is used to capture type specific data required for processing Inherit part + let traverseInherit (synType: SynType, range: range) = + visitor.VisitInheritSynMemberDefn(path, synComponentInfo, synTypeDefnKind, synType, synMemberDefns, range) - and traverseSynMemberDefn path traverseInherit (m:SynMemberDefn) = - let pick (debugObj:obj) = pick m.Range debugObj + yield! + synMemberDefns + |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path traverseInherit + | SynTypeDefnRepr.Simple (synTypeDefnSimpleRepr, _range) -> + match synTypeDefnSimpleRepr with + | SynTypeDefnSimpleRepr.Record (_synAccessOption, fields, m) -> + yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitRecordDefn(path, fields, m)) + | SynTypeDefnSimpleRepr.Union (_synAccessOption, cases, m) -> + yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitUnionDefn(path, cases, m)) + | SynTypeDefnSimpleRepr.Enum (cases, m) -> + yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitEnumDefn(path, cases, m)) + | SynTypeDefnSimpleRepr.TypeAbbrev (_, synType, m) -> + yield dive synTypeDefnRepr synTypeDefnRepr.Range (fun _ -> visitor.VisitTypeAbbrev(path, synType, m)) + | _ -> () + yield! + synMemberDefns + |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None) + ] + |> pick tRange tydef + + and traverseSynMemberDefn path traverseInherit (m: SynMemberDefn) = + let pick (debugObj: obj) = pick m.Range debugObj let path = SyntaxNode.SynMemberDefn m :: path + match m with - | SynMemberDefn.Open(_longIdent, _range) -> None - | SynMemberDefn.Member(synBinding, _range) -> traverseSynBinding path synBinding - | SynMemberDefn.ImplicitCtor(_synAccessOption, _synAttributes, simplePats, _identOption, _doc, _range) -> + | SynMemberDefn.Open (_longIdent, _range) -> None + | SynMemberDefn.Member (synBinding, _range) -> traverseSynBinding path synBinding + | SynMemberDefn.ImplicitCtor (_synAccessOption, _synAttributes, simplePats, _identOption, _doc, _range) -> match simplePats with - | SynSimplePats.SimplePats(simplePats, _) -> visitor.VisitSimplePats(path, simplePats) + | SynSimplePats.SimplePats (simplePats, _) -> visitor.VisitSimplePats(path, simplePats) | _ -> None - | SynMemberDefn.ImplicitInherit(synType, synExpr, _identOption, range) -> + | SynMemberDefn.ImplicitInherit (synType, synExpr, _identOption, range) -> [ - dive () synType.Range (fun () -> + dive () synType.Range (fun () -> match traverseInherit (synType, range) with | None -> visitor.VisitImplicitInherit(path, traverseSynExpr path, synType, synExpr, range) | x -> x) - dive () synExpr.Range (fun() -> - visitor.VisitImplicitInherit(path, traverseSynExpr path, synType, synExpr, range) - ) - ] |> pick m - | SynMemberDefn.AutoProperty(synExpr=synExpr) -> traverseSynExpr path synExpr - | SynMemberDefn.LetBindings(synBindingList, isRecursive, _, range) -> + dive () synExpr.Range (fun () -> visitor.VisitImplicitInherit(path, traverseSynExpr path, synType, synExpr, range)) + ] + |> pick m + | SynMemberDefn.AutoProperty (synExpr = synExpr) -> traverseSynExpr path synExpr + | SynMemberDefn.LetBindings (synBindingList, isRecursive, _, range) -> match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with | Some x -> Some x - | None -> synBindingList |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path)) |> pick m - | SynMemberDefn.AbstractSlot(_synValSig, _memberFlags, _range) -> None - | SynMemberDefn.Interface(interfaceType=synType; members=synMemberDefnsOption) -> + | None -> + synBindingList + |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path)) + |> pick m + | SynMemberDefn.AbstractSlot (_synValSig, _memberFlags, _range) -> None + | SynMemberDefn.Interface (interfaceType = synType; members = synMemberDefnsOption) -> match visitor.VisitInterfaceSynMemberDefnType(path, synType) with - | None -> - match synMemberDefnsOption with + | None -> + match synMemberDefnsOption with | None -> None - | Some(x) -> [ yield! x |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None) ] |> pick x + | 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.NestedType(synTypeDefn, _synAccessOption, _range) -> traverseSynTypeDefn path synTypeDefn + | SynMemberDefn.Inherit (synType, _identOption, range) -> traverseInherit (synType, range) + | SynMemberDefn.ValField (_synField, _range) -> None + | SynMemberDefn.NestedType (synTypeDefn, _synAccessOption, _range) -> traverseSynTypeDefn path synTypeDefn and traverseSynMatchClause origPath mc = let defaultTraverse mc = let path = SyntaxNode.SynMatchClause mc :: origPath + match mc with - | SynMatchClause(pat=synPat; whenExpr=synExprOption; resultExpr=synExpr) as all -> - [dive synPat synPat.Range (traversePat path) ] - @ - ([ + | SynMatchClause (pat = synPat; whenExpr = synExprOption; resultExpr = synExpr) as all -> + [ dive synPat synPat.Range (traversePat path) ] + @ ([ match synExprOption with | None -> () | Some guard -> yield guard yield synExpr - ] - |> List.map (fun x -> dive x x.Range (traverseSynExpr path)) - )|> pick all.Range all + ] + |> List.map (fun x -> dive x x.Range (traverseSynExpr path))) + |> pick all.Range all + visitor.VisitMatchClause(origPath, defaultTraverse, mc) and traverseSynBinding origPath b = let defaultTraverse b = let path = SyntaxNode.SynBinding b :: origPath + match b with - | SynBinding(headPat=synPat; expr=synExpr) -> + | SynBinding (headPat = synPat; expr = synExpr) -> match traversePat path synPat with | None -> traverseSynExpr path synExpr | x -> x - visitor.VisitBinding(origPath, defaultTraverse ,b) + + visitor.VisitBinding(origPath, defaultTraverse, b) match parseTree with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = l))-> + | ParsedInput.ImplFile (ParsedImplFileInput (modules = l)) -> let fileRange = #if DEBUG - match l with [] -> range0 | _ -> l |> List.map (fun x -> x.Range) |> List.reduce unionRanges + match l with + | [] -> range0 + | _ -> l |> List.map (fun x -> x.Range) |> List.reduce unionRanges #else - range0 // only used for asserting, does not matter in non-debug + 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 + l + |> List.map (fun x -> dive x x.Range (traverseSynModuleOrNamespace [])) + |> pick fileRange l | ParsedInput.SigFile _sigFile -> None diff --git a/src/Compiler/Service/ServiceParsedInputOps.fs b/src/Compiler/Service/ServiceParsedInputOps.fs index 692539a1ca3f..af213cbb375b 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -6,7 +6,7 @@ open System open System.IO open System.Collections.Generic open System.Text.RegularExpressions -open Internal.Utilities.Library +open Internal.Utilities.Library open FSharp.Compiler.Diagnostics open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming @@ -21,20 +21,22 @@ module SourceFileImpl = 0 = String.Compare(".fsi", ext, StringComparison.OrdinalIgnoreCase) /// Additional #defines that should be in place when editing a file in a file editor such as VS. - let GetImplicitConditionalDefinesForEditing(isInteractive: bool) = - if isInteractive then ["INTERACTIVE";"EDITING"] // This is still used by the foreground parse - else ["COMPILED";"EDITING"] - + let GetImplicitConditionalDefinesForEditing (isInteractive: bool) = + if isInteractive then + [ "INTERACTIVE"; "EDITING" ] // This is still used by the foreground parse + else + [ "COMPILED"; "EDITING" ] + type CompletionPath = string list * string option // plid * residue [] -type FSharpInheritanceOrigin = +type FSharpInheritanceOrigin = | Class | Interface | Unknown [] -type InheritanceContext = +type InheritanceContext = | Class | Interface | Unknown @@ -48,7 +50,7 @@ type RecordContext = | Declaration of isInIdentifier: bool [] -type CompletionContext = +type CompletionContext = /// Completion context cannot be determined due to errors | Invalid @@ -84,7 +86,11 @@ type ShortIdents = ShortIdent[] type MaybeUnresolvedIdent = { Ident: ShortIdent; Resolved: bool } -type ModuleKind = { IsAutoOpen: bool; HasModuleSuffix: bool } +type ModuleKind = + { + IsAutoOpen: bool + HasModuleSuffix: bool + } [] type EntityKind = @@ -92,14 +98,18 @@ type EntityKind = | Type | FunctionOrValue of isActivePattern: bool | Module of ModuleKind + override x.ToString() = sprintf "%A" x type InsertionContextEntity = - { FullRelativeName: string - Qualifier: string - Namespace: string option - FullDisplayName: string - LastIdent: ShortIdent } + { + FullRelativeName: string + Qualifier: string + Namespace: string option + FullDisplayName: string + LastIdent: ShortIdent + } + override x.ToString() = sprintf "%A" x type ScopeKind = @@ -108,42 +118,54 @@ type ScopeKind = | NestedModule | OpenDeclaration | HashDirective + override x.ToString() = sprintf "%A" x -type InsertionContext = - { ScopeKind: ScopeKind - Pos: pos } +type InsertionContext = { ScopeKind: ScopeKind; Pos: pos } -type FSharpModule = - { Idents: ShortIdents - Range: range } +type FSharpModule = { Idents: ShortIdents; Range: range } type OpenStatementInsertionPoint = | TopLevel | Nearest -[] +[] module Entity = let getRelativeNamespace (targetNs: ShortIdents) (sourceNs: ShortIdents) = let rec loop index = - if index > targetNs.Length - 1 then sourceNs[index..] + if index > targetNs.Length - 1 then + sourceNs[index..] // target namespace is not a full parent of source namespace, keep the source ns as is - elif index > sourceNs.Length - 1 then sourceNs - elif targetNs[index] = sourceNs[index] then loop (index + 1) - else sourceNs[index..] - if sourceNs.Length = 0 || targetNs.Length = 0 then sourceNs - else loop 0 + elif index > sourceNs.Length - 1 then + sourceNs + elif targetNs[index] = sourceNs[index] then + loop (index + 1) + else + sourceNs[index..] + + if sourceNs.Length = 0 || targetNs.Length = 0 then + sourceNs + else + loop 0 let cutAutoOpenModules (autoOpenParent: ShortIdents option) (candidateNs: ShortIdents) = - let nsCount = + let nsCount = match autoOpenParent with - | Some parent when parent.Length > 0 -> - min (parent.Length - 1) candidateNs.Length + | Some parent when parent.Length > 0 -> min (parent.Length - 1) candidateNs.Length | _ -> candidateNs.Length - candidateNs[0..nsCount - 1] - let tryCreate (targetNamespace: ShortIdents option, targetScope: ShortIdents, partiallyQualifiedName: MaybeUnresolvedIdent[], - requiresQualifiedAccessParent: ShortIdents option, autoOpenParent: ShortIdents option, candidateNamespace: ShortIdents option, candidate: ShortIdents) = + candidateNs[0 .. nsCount - 1] + + let tryCreate + ( + targetNamespace: ShortIdents option, + targetScope: ShortIdents, + partiallyQualifiedName: MaybeUnresolvedIdent[], + requiresQualifiedAccessParent: ShortIdents option, + autoOpenParent: ShortIdents option, + candidateNamespace: ShortIdents option, + candidate: ShortIdents + ) = match candidate with | [||] -> [||] | _ -> @@ -154,189 +176,208 @@ module Entity = |> Array.filter (fun x -> x |> Array.exists (fun x -> not x.Resolved)) |> Array.choose (fun parts -> let parts = parts |> Array.map (fun x -> x.Ident) - if not (candidate |> Array.endsWith parts) then None - else - let identCount = parts.Length - let fullOpenableNs, restIdents = - let openableNsCount = - match requiresQualifiedAccessParent with - | Some parent -> min parent.Length candidate.Length - | None -> candidate.Length - candidate[0..openableNsCount - 2], candidate[openableNsCount - 1..] - - let openableNs = cutAutoOpenModules autoOpenParent fullOpenableNs - - let getRelativeNs ns = - match targetNamespace, candidateNamespace with - | Some targetNs, Some candidateNs when candidateNs = targetNs -> - getRelativeNamespace targetScope ns - | None, _ -> getRelativeNamespace targetScope ns - | _ -> ns - - let relativeNs = getRelativeNs openableNs - - match relativeNs, restIdents with - | [||], [||] -> None - | [||], [|_|] -> None - | _ -> - let fullRelativeName = Array.append (getRelativeNs fullOpenableNs) restIdents - let ns = - match relativeNs with - | [||] -> None - | _ when identCount > 1 && relativeNs.Length >= identCount -> - Some (relativeNs[0..relativeNs.Length - identCount] |> String.concat ".") - | _ -> Some (relativeNs |> String.concat ".") - let qualifier = - if fullRelativeName.Length > 1 && fullRelativeName.Length >= identCount then - fullRelativeName[0..fullRelativeName.Length - identCount] - else fullRelativeName - Some - { FullRelativeName = String.concat "." fullRelativeName //.[0..fullRelativeName.Length - identCount - 1] - Qualifier = String.concat "." qualifier - Namespace = ns - FullDisplayName = match restIdents with [|_|] -> "" | _ -> String.concat "." restIdents - LastIdent = Array.tryLast restIdents |> Option.defaultValue "" }) + + if not (candidate |> Array.endsWith parts) then + None + else + let identCount = parts.Length + + let fullOpenableNs, restIdents = + let openableNsCount = + match requiresQualifiedAccessParent with + | Some parent -> min parent.Length candidate.Length + | None -> candidate.Length + + candidate[0 .. openableNsCount - 2], candidate[openableNsCount - 1 ..] + + let openableNs = cutAutoOpenModules autoOpenParent fullOpenableNs + + let getRelativeNs ns = + match targetNamespace, candidateNamespace with + | Some targetNs, Some candidateNs when candidateNs = targetNs -> getRelativeNamespace targetScope ns + | None, _ -> getRelativeNamespace targetScope ns + | _ -> ns + + let relativeNs = getRelativeNs openableNs + + match relativeNs, restIdents with + | [||], [||] -> None + | [||], [| _ |] -> None + | _ -> + let fullRelativeName = Array.append (getRelativeNs fullOpenableNs) restIdents + + let ns = + match relativeNs with + | [||] -> None + | _ when identCount > 1 && relativeNs.Length >= identCount -> + Some(relativeNs[0 .. relativeNs.Length - identCount] |> String.concat ".") + | _ -> Some(relativeNs |> String.concat ".") + + let qualifier = + if fullRelativeName.Length > 1 && fullRelativeName.Length >= identCount then + fullRelativeName[0 .. fullRelativeName.Length - identCount] + else + fullRelativeName + + Some + { + FullRelativeName = String.concat "." fullRelativeName //.[0..fullRelativeName.Length - identCount - 1] + Qualifier = String.concat "." qualifier + Namespace = ns + FullDisplayName = + match restIdents with + | [| _ |] -> "" + | _ -> String.concat "." restIdents + LastIdent = Array.tryLast restIdents |> Option.defaultValue "" + }) module ParsedInput = - + let emptyStringSet = HashSet() - let GetRangeOfExprLeftOfDot(pos: pos, parsedInput) = - let CheckLongIdent(longIdent: LongIdent) = + let GetRangeOfExprLeftOfDot (pos: pos, parsedInput) = + let CheckLongIdent (longIdent: LongIdent) = // find the longest prefix before the "pos" dot - let mutable r = (List.head longIdent).idRange + let mutable r = (List.head longIdent).idRange let mutable couldBeBeforeFront = true + for i in longIdent do if posGeq pos i.idRange.End then r <- unionRanges r i.idRange couldBeBeforeFront <- false + couldBeBeforeFront, r - SyntaxTraversal.Traverse(pos, parsedInput, { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = - let expr = expr // fix debugger locals + SyntaxTraversal.Traverse( + pos, + parsedInput, + { new SyntaxVisitorBase<_>() with + member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = + let expr = expr // fix debugger locals + + match expr with + | SynExpr.LongIdent(longDotId = SynLongIdent ([ id ], [], [ Some _ ])) -> defaultTraverse (SynExpr.Ident(id)) + | SynExpr.LongIdent (_, SynLongIdent (longIdent, _, _), _altNameRefCell, _range) -> + let _, r = CheckLongIdent longIdent + Some r + | SynExpr.LongIdentSet (SynLongIdent (longIdent, _, _), synExpr, _range) -> + if SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then + traverseSynExpr synExpr + else + let _, r = CheckLongIdent longIdent + Some r + | SynExpr.DotGet (synExpr, _dotm, SynLongIdent (longIdent, _, _), _range) -> + if SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then + traverseSynExpr synExpr + else + let inFront, r = CheckLongIdent longIdent + + if inFront then + Some synExpr.Range + else + // see comment below for SynExpr.DotSet + Some(unionRanges synExpr.Range r) + | SynExpr.Set (synExpr, synExpr2, range) -> + if SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then + traverseSynExpr synExpr + elif SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr2.Range pos then + traverseSynExpr synExpr2 + else + Some range + | SynExpr.DotSet (synExpr, SynLongIdent (longIdent, _, _), synExpr2, _range) -> + if SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then + traverseSynExpr synExpr + elif SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr2.Range pos then + traverseSynExpr synExpr2 + else + let inFront, r = CheckLongIdent longIdent + + if inFront then + Some synExpr.Range + else + // f(0).X.Y.Z + // ^ + // - r has this value + // ---- synExpr.Range has this value + // ------ we want this value + Some(unionRanges synExpr.Range r) + | SynExpr.DotNamedIndexedPropertySet (synExpr, SynLongIdent (longIdent, _, _), synExpr2, synExpr3, _range) -> + if SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then + traverseSynExpr synExpr + elif SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr2.Range pos then + traverseSynExpr synExpr2 + elif SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr3.Range pos then + traverseSynExpr synExpr3 + else + let inFront, r = CheckLongIdent longIdent + + if inFront then + Some synExpr.Range + else + Some(unionRanges synExpr.Range r) + | SynExpr.DiscardAfterMissingQualificationAfterDot (synExpr, _range) -> // get this for e.g. "bar()." + if SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then + traverseSynExpr synExpr + else + Some synExpr.Range + | SynExpr.FromParseError (synExpr, range) -> + if SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then + traverseSynExpr synExpr + else + Some range + | SynExpr.App (ExprAtomicFlag.NonAtomic, true, SynExpr.LongIdent(longDotId = SynLongIdent(id = [ ident ])), rhs, _) when + ident.idText = "op_ArrayLookup" + && not (SyntaxTraversal.rangeContainsPosLeftEdgeInclusive rhs.Range pos) + -> + match defaultTraverse expr with + | None -> + // (expr).(expr) is an ML-deprecated array lookup, but we want intellisense on the dot + // also want it for e.g. [|arr|].(0) + Some expr.Range + | x -> x // we found the answer deeper somewhere in the lhs + | SynExpr.Const (SynConst.Double _, range) -> Some range + | _ -> defaultTraverse expr + } + ) + + /// searches for the expression island suitable for the evaluation by the debugger + let TryFindExpressionIslandInPosition (pos: pos, parsedInput) = + let getLidParts (lid: LongIdent) = + lid + |> Seq.takeWhile (fun i -> posGeq pos i.idRange.Start) + |> Seq.map (fun i -> i.idText) + |> Seq.toList + + // tries to locate simple expression island + // foundCandidate = false means that we are looking for the candidate expression + // foundCandidate = true - we found candidate (DotGet) and now drill down to the left part + let rec TryGetExpression foundCandidate expr = match expr with - | SynExpr.LongIdent(longDotId = SynLongIdent([id], [], [Some _])) -> - defaultTraverse (SynExpr.Ident(id)) - | SynExpr.LongIdent (_, SynLongIdent(longIdent, _, _), _altNameRefCell, _range) -> - let _, r = CheckLongIdent longIdent - Some r - | SynExpr.LongIdentSet (SynLongIdent(longIdent, _, _), synExpr, _range) -> - if SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then - traverseSynExpr synExpr - else - let _, r = CheckLongIdent longIdent - Some r - | SynExpr.DotGet (synExpr, _dotm, SynLongIdent(longIdent, _, _), _range) -> - if SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then - traverseSynExpr synExpr - else - let inFront, r = CheckLongIdent longIdent - if inFront then - Some synExpr.Range - else - // see comment below for SynExpr.DotSet - Some (unionRanges synExpr.Range r) - | SynExpr.Set (synExpr, synExpr2, range) -> - if SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then - traverseSynExpr synExpr - elif SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr2.Range pos then - traverseSynExpr synExpr2 - else - Some range - | SynExpr.DotSet (synExpr, SynLongIdent(longIdent, _, _), synExpr2, _range) -> - if SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then - traverseSynExpr synExpr - elif SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr2.Range pos then - traverseSynExpr synExpr2 - else - let inFront, r = CheckLongIdent longIdent - if inFront then - Some synExpr.Range - else - // f(0).X.Y.Z - // ^ - // - r has this value - // ---- synExpr.Range has this value - // ------ we want this value - Some (unionRanges synExpr.Range r) - | SynExpr.DotNamedIndexedPropertySet (synExpr, SynLongIdent(longIdent, _, _), synExpr2, synExpr3, _range) -> - if SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then - traverseSynExpr synExpr - elif SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr2.Range pos then - traverseSynExpr synExpr2 - elif SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr3.Range pos then - traverseSynExpr synExpr3 - else - let inFront, r = CheckLongIdent longIdent - if inFront then - Some synExpr.Range + | SynExpr.Paren (e, _, _, _) when foundCandidate -> TryGetExpression foundCandidate e + | SynExpr.LongIdent (_isOptional, SynLongIdent (lid, _, _), _altNameRefCell, _m) -> getLidParts lid |> Some + | SynExpr.DotGet (leftPart, _, SynLongIdent (lid, _, _), _) when (rangeContainsPos (rangeOfLid lid) pos) || foundCandidate -> + // requested position is at the lid part of the DotGet + // process left part and append result to the result of processing lid + let leftPartResult = TryGetExpression true leftPart + + match leftPartResult with + | Some leftPartResult -> [ yield! leftPartResult; yield! getLidParts lid ] |> Some + | None -> None + | SynExpr.FromParseError (synExpr, _range) -> TryGetExpression foundCandidate synExpr + | _ -> None + + let rec walker = + { new SyntaxVisitorBase<_>() with + member _.VisitExpr(_path, _traverseSynExpr, defaultTraverse, expr) = + if rangeContainsPos expr.Range pos then + match TryGetExpression false expr with + | Some parts -> parts |> String.concat "." |> Some + | _ -> defaultTraverse expr else - Some (unionRanges synExpr.Range r) - | SynExpr.DiscardAfterMissingQualificationAfterDot (synExpr, _range) -> // get this for e.g. "bar()." - if SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then - traverseSynExpr synExpr - else - Some synExpr.Range - | SynExpr.FromParseError (synExpr, range) -> - if SyntaxTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then - traverseSynExpr synExpr - else - Some range - | SynExpr.App (ExprAtomicFlag.NonAtomic, true, SynExpr.LongIdent(longDotId = SynLongIdent(id = [ident])), rhs, _) - when ident.idText = "op_ArrayLookup" - && not(SyntaxTraversal.rangeContainsPosLeftEdgeInclusive rhs.Range pos) -> - match defaultTraverse expr with - | None -> - // (expr).(expr) is an ML-deprecated array lookup, but we want intellisense on the dot - // also want it for e.g. [|arr|].(0) - Some expr.Range - | x -> x // we found the answer deeper somewhere in the lhs - | SynExpr.Const (SynConst.Double _, range) -> Some range - | _ -> defaultTraverse expr - }) - - /// searches for the expression island suitable for the evaluation by the debugger - let TryFindExpressionIslandInPosition(pos: pos, parsedInput) = - let getLidParts (lid : LongIdent) = - lid - |> Seq.takeWhile (fun i -> posGeq pos i.idRange.Start) - |> Seq.map (fun i -> i.idText) - |> Seq.toList - - // tries to locate simple expression island - // foundCandidate = false means that we are looking for the candidate expression - // foundCandidate = true - we found candidate (DotGet) and now drill down to the left part - let rec TryGetExpression foundCandidate expr = - match expr with - | SynExpr.Paren (e, _, _, _) when foundCandidate -> - TryGetExpression foundCandidate e - | SynExpr.LongIdent (_isOptional, SynLongIdent(lid, _, _), _altNameRefCell, _m) -> - getLidParts lid |> Some - | SynExpr.DotGet (leftPart, _, SynLongIdent(lid, _, _), _) when (rangeContainsPos (rangeOfLid lid) pos) || foundCandidate -> - // requested position is at the lid part of the DotGet - // process left part and append result to the result of processing lid - let leftPartResult = TryGetExpression true leftPart - match leftPartResult with - | Some leftPartResult -> - [ - yield! leftPartResult - yield! getLidParts lid - ] |> Some - | None -> None - | SynExpr.FromParseError (synExpr, _range) -> TryGetExpression foundCandidate synExpr - | _ -> None + None + } - let rec walker = - { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_path, _traverseSynExpr, defaultTraverse, expr) = - if rangeContainsPos expr.Range pos then - match TryGetExpression false expr with - | Some parts -> parts |> String.concat "." |> Some - | _ -> defaultTraverse expr - else - None } - SyntaxTraversal.Traverse(pos, parsedInput, walker) + SyntaxTraversal.Traverse(pos, parsedInput, walker) // Given a cursor position here: // f(x) . ident @@ -350,294 +391,349 @@ module ParsedInput = // ^ // would return None // TODO would be great to unify this with GetRangeOfExprLeftOfDot above, if possible, as they are similar - let TryFindExpressionASTLeftOfDotLeftOfCursor(pos, parsedInput) = + let TryFindExpressionASTLeftOfDotLeftOfCursor (pos, parsedInput) = let dive x = SyntaxTraversal.dive x let pick x = SyntaxTraversal.pick pos x - let walker = + + let walker = { new SyntaxVisitorBase<_>() with member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = let pick = pick expr.Range - let traverseSynExpr, defaultTraverse, expr = traverseSynExpr, defaultTraverse, expr // for debugging: debugger does not get object expression params as local vars - if not(rangeContainsPos expr.Range pos) then + let traverseSynExpr, defaultTraverse, expr = traverseSynExpr, defaultTraverse, expr // for debugging: debugger does not get object expression params as local vars + + if not (rangeContainsPos expr.Range pos) then match expr with | SynExpr.DiscardAfterMissingQualificationAfterDot (e, _m) -> // This happens with e.g. "f(x) . $" when you bring up a completion list a few spaces after a dot. The cursor is not 'in the parse tree', // but the dive algorithm will dive down into this node, and this is the one case where we do want to give a result despite the cursor // not properly being in a node. match traverseSynExpr e with - | None -> Some (e.Range.End, false) + | None -> Some(e.Range.End, false) | r -> r - | _ -> - // This happens for e.g. "System.Console.[]$", where the ".[]" token is thrown away by the parser and we dive into the System.Console longId + | _ -> + // This happens for e.g. "System.Console.[]$", where the ".[]" token is thrown away by the parser and we dive into the System.Console longId // even though the cursor/dot is not in there. In those cases we want to return None, because there is not really a dot completion before // the cursor location. None else - let rec traverseLidOrElse (optExprIfLeftOfLongId : SynExpr option) (SynLongIdent(lid, dots, _) as lidwd) = + let rec traverseLidOrElse (optExprIfLeftOfLongId: SynExpr option) (SynLongIdent (lid, dots, _) as lidwd) = let resultIfLeftOfLongId = match optExprIfLeftOfLongId with | None -> None - | Some e -> Some (e.Range.End, posGeq lidwd.Range.Start pos) - match dots |> List.mapi (fun i x -> i, x) |> List.rev |> List.tryFind (fun (_, m) -> posGt pos m.Start) with + | Some e -> Some(e.Range.End, posGeq lidwd.Range.Start pos) + + match dots + |> List.mapi (fun i x -> i, x) + |> List.rev + |> List.tryFind (fun (_, m) -> posGt pos m.Start) + with | None -> resultIfLeftOfLongId - | Some (n, _) -> Some ((List.item n lid).idRange.End, (List.length lid = n+1) // foo.$ - || (posGeq (List.item (n+1) lid).idRange.Start pos)) // foo.$bar + | Some (n, _) -> + Some( + (List.item n lid).idRange.End, + (List.length lid = n + 1) // foo.$ + || (posGeq (List.item (n + 1) lid).idRange.Start pos) + ) // foo.$bar + match expr with - | SynExpr.LongIdent (longDotId = SynLongIdent([id], [], [Some _])) -> - defaultTraverse (SynExpr.Ident(id)) - | SynExpr.LongIdent (_isOptional, lidwd, _altNameRefCell, _m) -> - traverseLidOrElse None lidwd + | SynExpr.LongIdent(longDotId = SynLongIdent ([ id ], [], [ Some _ ])) -> defaultTraverse (SynExpr.Ident(id)) + | SynExpr.LongIdent (_isOptional, lidwd, _altNameRefCell, _m) -> traverseLidOrElse None lidwd | SynExpr.LongIdentSet (lidwd, exprRhs, _m) -> - [ dive lidwd lidwd.Range (traverseLidOrElse None) - dive exprRhs exprRhs.Range traverseSynExpr - ] |> pick expr + [ + dive lidwd lidwd.Range (traverseLidOrElse None) + dive exprRhs exprRhs.Range traverseSynExpr + ] + |> pick expr | SynExpr.DotGet (exprLeft, dotm, lidwd, _m) -> - let afterDotBeforeLid = mkRange dotm.FileName dotm.End lidwd.Range.Start - [ dive exprLeft exprLeft.Range traverseSynExpr - dive exprLeft afterDotBeforeLid (fun e -> Some (e.Range.End, true)) - dive lidwd lidwd.Range (traverseLidOrElse (Some exprLeft)) - ] |> pick expr + let afterDotBeforeLid = mkRange dotm.FileName dotm.End lidwd.Range.Start + + [ + dive exprLeft exprLeft.Range traverseSynExpr + dive exprLeft afterDotBeforeLid (fun e -> Some(e.Range.End, true)) + dive lidwd lidwd.Range (traverseLidOrElse (Some exprLeft)) + ] + |> pick expr | SynExpr.DotSet (exprLeft, lidwd, exprRhs, _m) -> - [ dive exprLeft exprLeft.Range traverseSynExpr - dive lidwd lidwd.Range (traverseLidOrElse(Some exprLeft)) - dive exprRhs exprRhs.Range traverseSynExpr - ] |> pick expr + [ + dive exprLeft exprLeft.Range traverseSynExpr + dive lidwd lidwd.Range (traverseLidOrElse (Some exprLeft)) + dive exprRhs exprRhs.Range traverseSynExpr + ] + |> pick expr | SynExpr.Set (exprLeft, exprRhs, _m) -> - [ dive exprLeft exprLeft.Range traverseSynExpr - dive exprRhs exprRhs.Range traverseSynExpr - ] |> pick expr + [ + dive exprLeft exprLeft.Range traverseSynExpr + dive exprRhs exprRhs.Range traverseSynExpr + ] + |> pick expr | SynExpr.NamedIndexedPropertySet (lidwd, exprIndexer, exprRhs, _m) -> - [ dive lidwd lidwd.Range (traverseLidOrElse None) - dive exprIndexer exprIndexer.Range traverseSynExpr - dive exprRhs exprRhs.Range traverseSynExpr - ] |> pick expr + [ + dive lidwd lidwd.Range (traverseLidOrElse None) + dive exprIndexer exprIndexer.Range traverseSynExpr + dive exprRhs exprRhs.Range traverseSynExpr + ] + |> pick expr | SynExpr.DotNamedIndexedPropertySet (exprLeft, lidwd, exprIndexer, exprRhs, _m) -> - [ dive exprLeft exprLeft.Range traverseSynExpr - dive lidwd lidwd.Range (traverseLidOrElse(Some exprLeft)) - dive exprIndexer exprIndexer.Range traverseSynExpr - dive exprRhs exprRhs.Range traverseSynExpr - ] |> pick expr + [ + dive exprLeft exprLeft.Range traverseSynExpr + dive lidwd lidwd.Range (traverseLidOrElse (Some exprLeft)) + dive exprIndexer exprIndexer.Range traverseSynExpr + dive exprRhs exprRhs.Range traverseSynExpr + ] + |> pick expr | SynExpr.Const (SynConst.Double _, m) -> if posEq m.End pos then // the cursor is at the dot - Some (m.End, false) + Some(m.End, false) else // the cursor is left of the dot None | SynExpr.DiscardAfterMissingQualificationAfterDot (e, m) -> match traverseSynExpr e with - | None -> + | None -> if posEq m.End pos then // the cursor is at the dot - Some (e.Range.End, false) + Some(e.Range.End, false) else // the cursor is left of the dot None | r -> r - | SynExpr.App (ExprAtomicFlag.NonAtomic, true, SynExpr.LongIdent(longDotId = SynLongIdent(id = [ident])), lhs, _m) - when ident.idText = "op_ArrayLookup" - && not(SyntaxTraversal.rangeContainsPosLeftEdgeInclusive lhs.Range pos) -> + | SynExpr.App (ExprAtomicFlag.NonAtomic, true, SynExpr.LongIdent(longDotId = SynLongIdent(id = [ ident ])), lhs, _m) when + ident.idText = "op_ArrayLookup" + && not (SyntaxTraversal.rangeContainsPosLeftEdgeInclusive lhs.Range pos) + -> match defaultTraverse expr with | None -> // (expr).(expr) is an ML-deprecated array lookup, but we want intellisense on the dot // also want it for e.g. [|arr|].(0) - Some (lhs.Range.End, false) - | x -> x // we found the answer deeper somewhere in the lhs - | _ -> defaultTraverse expr } + Some(lhs.Range.End, false) + | x -> x // we found the answer deeper somewhere in the lhs + | _ -> defaultTraverse expr + } + SyntaxTraversal.Traverse(pos, parsedInput, walker) - + let GetEntityKind (pos: pos, parsedInput: ParsedInput) : EntityKind option = - let (|ConstructorPats|) = function + let (|ConstructorPats|) = + function | SynArgPats.Pats ps -> ps - | SynArgPats.NamePatPairs(xs, _) -> List.map (fun (_, _, pat) -> pat) xs + | SynArgPats.NamePatPairs (xs, _) -> List.map (fun (_, _, pat) -> pat) 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] + let rec (|Sequentials|_|) = + function + | SynExpr.Sequential (_, _, e, Sequentials es, _) -> Some(e :: es) + | SynExpr.Sequential (_, _, e1, e2, _) -> Some [ e1; e2 ] | _ -> None let inline isPosInRange range = rangeContainsPos range pos let inline ifPosInRange range f = - if isPosInRange range then f() - else None + if isPosInRange range then f () else None - let rec walkImplFileInput (ParsedImplFileInput (modules = moduleOrNamespaceList)) = + let rec walkImplFileInput (ParsedImplFileInput (modules = moduleOrNamespaceList)) = List.tryPick (walkSynModuleOrNamespace true) moduleOrNamespaceList - and walkSynModuleOrNamespace isTopLevel (SynModuleOrNamespace(decls = decls; attribs = Attributes attrs; range = r)) = + and walkSynModuleOrNamespace isTopLevel (SynModuleOrNamespace (decls = decls; attribs = Attributes attrs; range = r)) = List.tryPick walkAttribute attrs |> Option.orElseWith (fun () -> ifPosInRange r (fun _ -> List.tryPick (walkSynModuleDecl isTopLevel) decls)) - and walkAttribute (attr: SynAttribute) = - if isPosInRange attr.Range then Some EntityKind.Attribute else None + and walkAttribute (attr: SynAttribute) = + if isPosInRange attr.Range then + Some EntityKind.Attribute + else + None |> Option.orElseWith (fun () -> walkExprWithKind (Some EntityKind.Type) attr.ArgExpr) - and walkTypar (SynTypar (ident, _, _)) = ifPosInRange ident.idRange (fun _ -> Some EntityKind.Type) + and walkTypar (SynTypar (ident, _, _)) = + ifPosInRange ident.idRange (fun _ -> Some EntityKind.Type) - and walkTyparDecl (SynTyparDecl.SynTyparDecl (Attributes attrs, typar)) = + and walkTyparDecl (SynTyparDecl.SynTyparDecl (Attributes attrs, typar)) = List.tryPick walkAttribute attrs |> Option.orElseWith (fun () -> walkTypar typar) - + and walkTypeConstraint cx = match cx with | SynTypeConstraint.WhereTyparDefaultsToType (t1, t2, _) -> walkTypar t1 |> Option.orElseWith (fun () -> walkType t2) - | SynTypeConstraint.WhereTyparIsValueType(t, _) -> walkTypar t - | SynTypeConstraint.WhereTyparIsReferenceType(t, _) -> walkTypar t - | SynTypeConstraint.WhereTyparIsUnmanaged(t, _) -> walkTypar t + | 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.orElseWith (fun () -> walkType ty) - | SynTypeConstraint.WhereTyparSupportsMember(ts, sign, _) -> + | SynTypeConstraint.WhereTyparIsComparable (t, _) -> walkTypar t + | SynTypeConstraint.WhereTyparIsEquatable (t, _) -> walkTypar t + | SynTypeConstraint.WhereTyparSubtypeOfType (t, ty, _) -> walkTypar t |> Option.orElseWith (fun () -> walkType ty) + | SynTypeConstraint.WhereTyparSupportsMember (ts, sign, _) -> List.tryPick walkType ts |> Option.orElseWith (fun () -> walkMemberSig sign) - | SynTypeConstraint.WhereTyparIsEnum(t, ts, _) -> walkTypar t |> Option.orElseWith (fun () -> List.tryPick walkType ts) - | SynTypeConstraint.WhereTyparIsDelegate(t, ts, _) -> walkTypar t |> Option.orElseWith (fun () -> List.tryPick walkType ts) + | SynTypeConstraint.WhereTyparIsEnum (t, ts, _) -> walkTypar t |> Option.orElseWith (fun () -> List.tryPick walkType ts) + | SynTypeConstraint.WhereTyparIsDelegate (t, ts, _) -> walkTypar t |> Option.orElseWith (fun () -> List.tryPick walkType ts) and walkPatWithKind (kind: EntityKind option) pat = - match pat with + match pat with | SynPat.Ands (pats, _) -> List.tryPick walkPat pats - | SynPat.As (pat1, pat2, _) -> List.tryPick walkPat [pat1; pat2] - | SynPat.Typed(pat, t, _) -> walkPat pat |> Option.orElseWith (fun () -> walkType t) - | SynPat.Attrib(pat, Attributes attrs, _) -> walkPat pat |> Option.orElseWith (fun () -> List.tryPick walkAttribute attrs) - | SynPat.Or(pat1, pat2, _, _) -> List.tryPick walkPat [pat1; pat2] - | SynPat.LongIdent(typarDecls=typars; argPats=ConstructorPats pats; range=r) -> + | SynPat.As (pat1, pat2, _) -> List.tryPick walkPat [ pat1; pat2 ] + | SynPat.Typed (pat, t, _) -> walkPat pat |> Option.orElseWith (fun () -> walkType t) + | SynPat.Attrib (pat, Attributes attrs, _) -> walkPat pat |> Option.orElseWith (fun () -> List.tryPick walkAttribute attrs) + | SynPat.Or (pat1, pat2, _, _) -> List.tryPick walkPat [ pat1; pat2 ] + | SynPat.LongIdent (typarDecls = typars; argPats = ConstructorPats pats; range = r) -> ifPosInRange r (fun _ -> kind) - |> Option.orElseWith (fun () -> - typars - |> Option.bind (fun (ValTyparDecls (typars, constraints, _)) -> + |> Option.orElseWith (fun () -> + typars + |> Option.bind (fun (ValTyparDecls (typars, constraints, _)) -> List.tryPick walkTyparDecl typars |> Option.orElseWith (fun () -> List.tryPick walkTypeConstraint constraints))) |> Option.orElseWith (fun () -> 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 + | 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 bind = - let (SynBinding(attributes=Attributes attrs; headPat=pat; returnInfo=returnInfo; expr=e)) = bind + let (SynBinding (attributes = Attributes attrs; headPat = pat; returnInfo = returnInfo; expr = e)) = + bind + List.tryPick walkAttribute attrs |> Option.orElseWith (fun () -> walkPat pat) |> Option.orElseWith (fun () -> walkExpr e) - |> Option.orElseWith (fun () -> + |> Option.orElseWith (fun () -> match returnInfo with | Some (SynBindingReturnInfo (t, _, _)) -> walkType t | None -> None) - and walkInterfaceImpl (SynInterfaceImpl(bindings=bindings)) = - List.tryPick walkBinding bindings + and walkInterfaceImpl (SynInterfaceImpl (bindings = bindings)) = List.tryPick walkBinding bindings and walkType ty = match ty with - | SynType.LongIdent ident -> + | SynType.LongIdent ident -> // we protect it with try..with because System.Exception : rangeOfLidwd may raise // at FSharp.Compiler.Syntax.LongIdentWithDots.get_Range() in D:\j\workspace\release_ci_pa---3f142ccc\src\ast.fs: line 156 - try ifPosInRange ident.Range (fun _ -> Some EntityKind.Type) with _ -> None - | SynType.App(ty, _, types, _, _, _, _) -> - walkType ty |> Option.orElseWith (fun () -> 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.orElseWith (fun () -> walkType t2) - | SynType.WithGlobalConstraints(t, _, _) -> walkType t - | SynType.HashConstraint(t, _) -> walkType t - | SynType.MeasureDivide(t1, t2, _) -> walkType t1 |> Option.orElseWith (fun () -> walkType t2) - | SynType.MeasurePower(t, _, _) -> walkType t - | SynType.Paren(t, _) -> walkType t + try + ifPosInRange ident.Range (fun _ -> Some EntityKind.Type) + with _ -> + None + | SynType.App (ty, _, types, _, _, _, _) -> walkType ty |> Option.orElseWith (fun () -> 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.orElseWith (fun () -> walkType t2) + | SynType.WithGlobalConstraints (t, _, _) -> walkType t + | SynType.HashConstraint (t, _) -> walkType t + | SynType.MeasureDivide (t1, t2, _) -> walkType t1 |> Option.orElseWith (fun () -> walkType t2) + | SynType.MeasurePower (t, _, _) -> walkType t + | SynType.Paren (t, _) -> walkType t | _ -> None - and walkClause (SynMatchClause(pat=pat; whenExpr=e1; resultExpr=e2)) = - walkPatWithKind (Some EntityKind.Type) pat + and walkClause (SynMatchClause (pat = pat; whenExpr = e1; resultExpr = e2)) = + walkPatWithKind (Some EntityKind.Type) pat |> Option.orElseWith (fun () -> walkExpr e2) |> Option.orElseWith (fun () -> Option.bind walkExpr e1) and walkExprWithKind (parentKind: EntityKind option) expr = match expr with - | SynExpr.LongIdent(_, SynLongIdent([ident], _, [ Some _]), _, _) -> - ifPosInRange ident.idRange (fun _ -> Some (EntityKind.FunctionOrValue false)) - | SynExpr.LongIdent (_, SynLongIdent(_, dotRanges, _), _, r) -> + | SynExpr.LongIdent (_, SynLongIdent ([ ident ], _, [ Some _ ]), _, _) -> + ifPosInRange ident.idRange (fun _ -> Some(EntityKind.FunctionOrValue false)) + | SynExpr.LongIdent (_, SynLongIdent (_, dotRanges, _), _, r) -> match dotRanges with - | [] when isPosInRange r -> parentKind |> Option.orElseWith (fun () -> Some (EntityKind.FunctionOrValue false)) - | firstDotRange :: _ -> - let firstPartRange = + | [] when isPosInRange r -> + parentKind + |> Option.orElseWith (fun () -> Some(EntityKind.FunctionOrValue false)) + | firstDotRange :: _ -> + let firstPartRange = mkRange "" r.Start (mkPos firstDotRange.StartLine (firstDotRange.StartColumn - 1)) + if isPosInRange firstPartRange then - parentKind |> Option.orElseWith (fun () -> Some (EntityKind.FunctionOrValue false)) - else None + parentKind + |> Option.orElseWith (fun () -> 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) -> + | SynExpr.Record (_, _, fields, r) -> ifPosInRange r (fun _ -> - fields |> List.tryPick (fun (SynExprRecordField(expr=e)) -> e |> Option.bind (walkExprWithKind parentKind))) + fields + |> List.tryPick (fun (SynExprRecordField (expr = e)) -> e |> Option.bind (walkExprWithKind parentKind))) | SynExpr.New (_, t, e, _) -> walkExprWithKind parentKind e |> Option.orElseWith (fun () -> walkType t) - | SynExpr.ObjExpr (objType=ty; bindings=bindings; members=ms; extraImpls=ifaces) -> + | SynExpr.ObjExpr (objType = ty; bindings = bindings; members = ms; extraImpls = ifaces) -> let bindings = unionBindingAndMembers bindings ms + walkType ty |> Option.orElseWith (fun () -> List.tryPick walkBinding bindings) |> Option.orElseWith (fun () -> List.tryPick walkInterfaceImpl ifaces) - | SynExpr.While (_, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] - | SynExpr.For (identBody=e1; toBody=e2; doBody=e3) -> List.tryPick (walkExprWithKind parentKind) [e1; e2; e3] - | SynExpr.ForEach (_, _, _, _, _, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.While (_, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [ e1; e2 ] + | SynExpr.For (identBody = e1; toBody = e2; doBody = e3) -> List.tryPick (walkExprWithKind parentKind) [ e1; e2; e3 ] + | SynExpr.ForEach (_, _, _, _, _, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [ e1; e2 ] | SynExpr.ArrayOrListComputed (_, e, _) -> walkExprWithKind parentKind e | SynExpr.ComputationExpr (_, e, _) -> walkExprWithKind parentKind e | SynExpr.Lambda (body = e) -> walkExprWithKind parentKind e - | SynExpr.MatchLambda (_, _, synMatchClauseList, _, _) -> - List.tryPick walkClause synMatchClauseList - | SynExpr.Match (expr=e; clauses=synMatchClauseList) -> - walkExprWithKind parentKind e |> Option.orElseWith (fun () -> List.tryPick walkClause synMatchClauseList) + | SynExpr.MatchLambda (_, _, synMatchClauseList, _, _) -> List.tryPick walkClause synMatchClauseList + | SynExpr.Match (expr = e; clauses = synMatchClauseList) -> + walkExprWithKind parentKind e + |> Option.orElseWith (fun () -> 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.orElseWith (fun () -> List.tryPick walkType tys) - | SynExpr.LetOrUse (bindings=bindings; body=e) -> List.tryPick walkBinding bindings |> Option.orElseWith (fun () -> walkExprWithKind parentKind e) - | SynExpr.TryWith (tryExpr=e; withCases=clauses) -> walkExprWithKind parentKind e |> Option.orElseWith (fun () -> List.tryPick walkClause clauses) - | SynExpr.TryFinally (tryExpr=e1; finallyExpr=e2) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] + | SynExpr.App (_, _, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [ e1; e2 ] + | SynExpr.TypeApp (e, _, tys, _, _, _, _) -> + walkExprWithKind (Some EntityKind.Type) e + |> Option.orElseWith (fun () -> List.tryPick walkType tys) + | SynExpr.LetOrUse (bindings = bindings; body = e) -> + List.tryPick walkBinding bindings + |> Option.orElseWith (fun () -> walkExprWithKind parentKind e) + | SynExpr.TryWith (tryExpr = e; withCases = clauses) -> + walkExprWithKind parentKind e + |> Option.orElseWith (fun () -> List.tryPick walkClause clauses) + | SynExpr.TryFinally (tryExpr = e1; finallyExpr = e2) -> List.tryPick (walkExprWithKind parentKind) [ e1; e2 ] | SynExpr.Lazy (e, _) -> walkExprWithKind parentKind e | Sequentials es -> List.tryPick (walkExprWithKind parentKind) es - | SynExpr.IfThenElse (ifExpr=e1; thenExpr=e2; elseExpr=e3) -> - List.tryPick (walkExprWithKind parentKind) [e1; e2] |> Option.orElseWith (fun () -> match e3 with None -> None | Some e -> walkExprWithKind parentKind e) - | SynExpr.Ident ident -> ifPosInRange ident.idRange (fun _ -> Some (EntityKind.FunctionOrValue false)) + | SynExpr.IfThenElse (ifExpr = e1; thenExpr = e2; elseExpr = e3) -> + List.tryPick (walkExprWithKind parentKind) [ e1; e2 ] + |> Option.orElseWith (fun () -> + 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.Set (e, _, _) -> walkExprWithKind parentKind e - | SynExpr.DotIndexedGet (e, args, _, _) -> walkExprWithKind parentKind e |> Option.orElseWith (fun () -> walkExprWithKind parentKind args) - | SynExpr.DotIndexedSet (e, args, _, _, _, _) -> walkExprWithKind parentKind e |> Option.orElseWith (fun () -> walkExprWithKind parentKind args) - | SynExpr.NamedIndexedPropertySet (_, e1, e2, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2] - | SynExpr.DotNamedIndexedPropertySet (e1, _, e2, e3, _) -> List.tryPick (walkExprWithKind parentKind) [e1; e2; e3] + | SynExpr.DotIndexedGet (e, args, _, _) -> + walkExprWithKind parentKind e + |> Option.orElseWith (fun () -> walkExprWithKind parentKind args) + | SynExpr.DotIndexedSet (e, args, _, _, _, _) -> + walkExprWithKind parentKind e + |> Option.orElseWith (fun () -> walkExprWithKind parentKind 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.orElseWith (fun () -> walkType t) | SynExpr.Upcast (e, t, _) -> walkExprWithKind parentKind e |> Option.orElseWith (fun () -> walkType t) | SynExpr.Downcast (e, t, _) -> walkExprWithKind parentKind e |> Option.orElseWith (fun () -> 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.JoinIn (e1, _, e2, _) -> List.tryPick (walkExprWithKind parentKind) [ e1; e2 ] | SynExpr.YieldOrReturn (_, e, _) -> walkExprWithKind parentKind e | SynExpr.YieldOrReturnFrom (_, e, _) -> walkExprWithKind parentKind e - | SynExpr.Match (expr=e; clauses=synMatchClauseList) - | SynExpr.MatchBang (expr=e; clauses=synMatchClauseList) -> - walkExprWithKind parentKind e |> Option.orElseWith (fun () -> List.tryPick walkClause synMatchClauseList) - | SynExpr.LetOrUseBang(rhs=e1; andBangs=es; body=e2) -> + | SynExpr.Match (expr = e; clauses = synMatchClauseList) + | SynExpr.MatchBang (expr = e; clauses = synMatchClauseList) -> + walkExprWithKind parentKind e + |> Option.orElseWith (fun () -> List.tryPick walkClause synMatchClauseList) + | SynExpr.LetOrUseBang (rhs = e1; andBangs = es; body = e2) -> [ yield e1 - for SynExprAndBang(body=eAndBang) in es do + for SynExprAndBang (body = eAndBang) in es do yield eAndBang yield e2 ] - |> List.tryPick (walkExprWithKind parentKind) + |> List.tryPick (walkExprWithKind parentKind) | SynExpr.DoBang (e, _) -> walkExprWithKind parentKind e | SynExpr.TraitCall (ts, sign, e, _) -> - List.tryPick walkTypar ts + List.tryPick walkTypar ts |> Option.orElseWith (fun () -> walkMemberSig sign) |> Option.orElseWith (fun () -> walkExprWithKind parentKind e) | _ -> None @@ -647,23 +743,24 @@ module ParsedInput = and walkSimplePat pat = match pat with | SynSimplePat.Attrib (pat, Attributes attrs, _) -> - walkSimplePat pat |> Option.orElseWith (fun () -> List.tryPick walkAttribute attrs) - | SynSimplePat.Typed(pat, t, _) -> walkSimplePat pat |> Option.orElseWith (fun () -> walkType t) + walkSimplePat pat + |> Option.orElseWith (fun () -> List.tryPick walkAttribute attrs) + | SynSimplePat.Typed (pat, t, _) -> walkSimplePat pat |> Option.orElseWith (fun () -> walkType t) | _ -> None - and walkField (SynField(Attributes attrs, _, _, t, _, _, _, _)) = + and walkField (SynField (Attributes attrs, _, _, t, _, _, _, _)) = List.tryPick walkAttribute attrs |> Option.orElseWith (fun () -> walkType t) - and walkValSig (SynValSig(attributes=Attributes attrs; synType=t)) = + and walkValSig (SynValSig (attributes = Attributes attrs; synType = t)) = List.tryPick walkAttribute attrs |> Option.orElseWith (fun () -> walkType t) and walkMemberSig membSig = match membSig with | SynMemberSig.Inherit (t, _) -> walkType t - | SynMemberSig.Member(vs, _, _) -> walkValSig vs - | SynMemberSig.Interface(t, _) -> walkType t - | SynMemberSig.ValField(f, _) -> walkField f - | SynMemberSig.NestedType(nestedType=SynTypeDefnSig.SynTypeDefnSig (typeInfo=info; typeRepr=repr; members=memberSigs)) -> + | SynMemberSig.Member (vs, _, _) -> walkValSig vs + | SynMemberSig.Interface (t, _) -> walkType t + | SynMemberSig.ValField (f, _) -> walkField f + | SynMemberSig.NestedType(nestedType = SynTypeDefnSig.SynTypeDefnSig (typeInfo = info; typeRepr = repr; members = memberSigs)) -> walkComponentInfo false info |> Option.orElseWith (fun () -> walkTypeDefnSigRepr repr) |> Option.orElseWith (fun () -> List.tryPick walkMemberSig memberSigs) @@ -671,17 +768,19 @@ module ParsedInput = and walkMember memb = match memb with | SynMemberDefn.AbstractSlot (valSig, _, _) -> walkValSig valSig - | SynMemberDefn.Member(binding, _) -> walkBinding binding - | SynMemberDefn.ImplicitCtor(_, Attributes attrs, SynSimplePats.SimplePats(simplePats, _), _, _, _) -> - List.tryPick walkAttribute attrs |> Option.orElseWith (fun () -> List.tryPick walkSimplePat simplePats) - | SynMemberDefn.ImplicitInherit(t, e, _, _) -> walkType t |> Option.orElseWith (fun () -> walkExpr e) - | SynMemberDefn.LetBindings(bindings, _, _, _) -> List.tryPick walkBinding bindings - | SynMemberDefn.Interface(interfaceType=t; members=members) -> - walkType t |> Option.orElseWith (fun () -> members |> Option.bind (List.tryPick walkMember)) - | SynMemberDefn.Inherit(t, _, _) -> walkType t - | SynMemberDefn.ValField(field, _) -> walkField field - | SynMemberDefn.NestedType(tdef, _, _) -> walkTypeDefn tdef - | SynMemberDefn.AutoProperty(attributes=Attributes attrs; typeOpt=t; synExpr=e) -> + | SynMemberDefn.Member (binding, _) -> walkBinding binding + | SynMemberDefn.ImplicitCtor (_, Attributes attrs, SynSimplePats.SimplePats (simplePats, _), _, _, _) -> + List.tryPick walkAttribute attrs + |> Option.orElseWith (fun () -> List.tryPick walkSimplePat simplePats) + | SynMemberDefn.ImplicitInherit (t, e, _, _) -> walkType t |> Option.orElseWith (fun () -> walkExpr e) + | SynMemberDefn.LetBindings (bindings, _, _, _) -> List.tryPick walkBinding bindings + | SynMemberDefn.Interface (interfaceType = t; members = members) -> + walkType t + |> Option.orElseWith (fun () -> members |> Option.bind (List.tryPick walkMember)) + | SynMemberDefn.Inherit (t, _, _) -> walkType t + | SynMemberDefn.ValField (field, _) -> walkField field + | SynMemberDefn.NestedType (tdef, _, _) -> walkTypeDefn tdef + | SynMemberDefn.AutoProperty (attributes = Attributes attrs; typeOpt = t; synExpr = e) -> List.tryPick walkAttribute attrs |> Option.orElseWith (fun () -> Option.bind walkType t) |> Option.orElseWith (fun () -> walkExpr e) @@ -689,39 +788,48 @@ module ParsedInput = and walkEnumCase (SynEnumCase(attributes = Attributes attrs)) = List.tryPick walkAttribute attrs - and walkUnionCaseType = function + and walkUnionCaseType = + function | SynUnionCaseKind.Fields fields -> List.tryPick walkField fields - | SynUnionCaseKind.FullType(t, _) -> walkType t + | SynUnionCaseKind.FullType (t, _) -> walkType t - and walkUnionCase (SynUnionCase(attributes=Attributes attrs; caseType=t)) = - List.tryPick walkAttribute attrs |> Option.orElseWith (fun () -> walkUnionCaseType t) + and walkUnionCase (SynUnionCase (attributes = Attributes attrs; caseType = t)) = + List.tryPick walkAttribute attrs + |> Option.orElseWith (fun () -> walkUnionCaseType t) - and walkTypeDefnSimple = function + 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 + | SynTypeDefnSimpleRepr.Union (_, cases, _) -> List.tryPick walkUnionCase cases + | SynTypeDefnSimpleRepr.Record (_, fields, _) -> List.tryPick walkField fields + | SynTypeDefnSimpleRepr.TypeAbbrev (_, t, _) -> walkType t | _ -> None - and walkComponentInfo isModule (SynComponentInfo(Attributes attrs, TyparsAndConstraints (typars, cs1), cs2, _, _, _, _, r)) = + and walkComponentInfo isModule (SynComponentInfo (Attributes attrs, TyparsAndConstraints (typars, cs1), cs2, _, _, _, _, r)) = let constraints = cs1 @ cs2 - if isModule then None else ifPosInRange r (fun _ -> Some EntityKind.Type) - |> Option.orElseWith (fun () -> + + if isModule then + None + else + ifPosInRange r (fun _ -> Some EntityKind.Type) + |> Option.orElseWith (fun () -> List.tryPick walkAttribute attrs |> Option.orElseWith (fun () -> List.tryPick walkTyparDecl typars) |> Option.orElseWith (fun () -> List.tryPick walkTypeConstraint constraints)) - and walkTypeDefnRepr = function + and walkTypeDefnRepr = + function | SynTypeDefnRepr.ObjectModel (_, defns, _) -> List.tryPick walkMember defns - | SynTypeDefnRepr.Simple(defn, _) -> walkTypeDefnSimple defn + | SynTypeDefnRepr.Simple (defn, _) -> walkTypeDefnSimple defn | SynTypeDefnRepr.Exception _ -> None - and walkTypeDefnSigRepr = function + and walkTypeDefnSigRepr = + function | SynTypeDefnSigRepr.ObjectModel (_, defns, _) -> List.tryPick walkMemberSig defns - | SynTypeDefnSigRepr.Simple(defn, _) -> walkTypeDefnSimple defn + | SynTypeDefnSigRepr.Simple (defn, _) -> walkTypeDefnSimple defn | SynTypeDefnSigRepr.Exception _ -> None - and walkTypeDefn (SynTypeDefn (typeInfo=info; typeRepr=repr; members=members)) = + and walkTypeDefn (SynTypeDefn (typeInfo = info; typeRepr = repr; members = members)) = walkComponentInfo false info |> Option.orElseWith (fun () -> walkTypeDefnRepr repr) |> Option.orElseWith (fun () -> List.tryPick walkMember members) @@ -729,7 +837,7 @@ module ParsedInput = and walkSynModuleDecl isTopLevel (decl: SynModuleDecl) = match decl with | SynModuleDecl.NamespaceFragment fragment -> walkSynModuleOrNamespace isTopLevel fragment - | SynModuleDecl.NestedModule(moduleInfo=info; decls=modules; range=range) -> + | SynModuleDecl.NestedModule (moduleInfo = info; decls = modules; range = range) -> walkComponentInfo true info |> Option.orElseWith (fun () -> ifPosInRange range (fun _ -> List.tryPick (walkSynModuleDecl false) modules)) | SynModuleDecl.Open _ -> None @@ -738,209 +846,233 @@ module ParsedInput = | SynModuleDecl.Types (types, _) -> List.tryPick walkTypeDefn types | _ -> None - match parsedInput with + match parsedInput with | ParsedInput.SigFile _ -> None | ParsedInput.ImplFile input -> walkImplFileInput input /// Matches the most nested [< and >] pair. - let insideAttributeApplicationRegex = Regex(@"(?<=\[\<)(?(.*?))(?=\>\])", RegexOptions.Compiled ||| RegexOptions.ExplicitCapture) + let insideAttributeApplicationRegex = + Regex(@"(?<=\[\<)(?(.*?))(?=\>\])", RegexOptions.Compiled ||| RegexOptions.ExplicitCapture) /// Try to determine completion context for the given pair (row, columns) - let TryGetCompletionContext (pos, parsedInput: ParsedInput, lineStr: string) : CompletionContext option = + let TryGetCompletionContext (pos, parsedInput: ParsedInput, lineStr: string) : CompletionContext option = match GetEntityKind(pos, parsedInput) with | Some EntityKind.Attribute -> Some CompletionContext.AttributeApplication | _ -> - - let parseLid (SynLongIdent(lid, dots, _)) = - let rec collect plid (parts : Ident list) (dots : range list) = - match parts, dots with - | [], _ -> Some (plid, None) - | x :: xs, ds -> - if rangeContainsPos x.idRange pos then - // pos lies with the range of current identifier - let s = x.idText.Substring(0, pos.Column - x.idRange.Start.Column) - let residue = if s.Length <> 0 then Some s else None - Some (plid, residue) - elif posGt x.idRange.Start pos then - // can happen if caret is placed after dot but before the existing identifier A. $ B - // return accumulated plid with no residue - Some (plid, None) - else - match ds with - | [] -> - // pos lies after the id and no dots found - return accumulated plid and current id as residue - Some (plid, Some x.idText) - | d :: ds -> - if posGeq pos d.End then - // pos lies after the dot - proceed to the next identifier - collect (x.idText :: plid) xs ds - else - // pos after the id but before the dot - // A $.B - return nothing - None - match collect [] lid dots with - | Some (parts, residue) -> - Some ((List.rev parts), residue) - | None -> None - - let (|Class|Interface|Struct|Unknown|Invalid|) synAttributes = - let (|SynAttr|_|) name (attr : SynAttribute) = - match attr with - | {TypeName = SynLongIdent([x], _, _)} when x.idText = name -> Some () - | _ -> None - - let rec getKind isClass isInterface isStruct = - function - | [] -> isClass, isInterface, isStruct - | SynAttr "Class" :: xs -> getKind true isInterface isStruct xs - | SynAttr "AbstractClass" :: xs -> getKind true isInterface isStruct xs - | SynAttr "Interface" :: xs -> getKind isClass true isStruct xs - | SynAttr "Struct" :: xs -> getKind isClass isInterface true xs - | _ :: xs -> getKind isClass isInterface isStruct xs - - match getKind false false false synAttributes with - | false, false, false -> Unknown - | true, false, false -> Class - | false, true, false -> Interface - | false, false, true -> Struct - | _ -> Invalid - - let GetCompletionContextForInheritSynMember (SynComponentInfo(Attributes synAttributes, _, _, _, _, _, _, _), typeDefnKind : SynTypeDefnKind, completionPath) = - - let success k = Some (CompletionContext.Inherit (k, completionPath)) - - // if kind is specified - take it - // if kind is non-specified - // - try to obtain it from attribute - // - if no attributes present - infer kind from members - match typeDefnKind with - | SynTypeDefnKind.Class -> - match synAttributes with - | Class | Unknown -> success InheritanceContext.Class - | _ -> Some CompletionContext.Invalid // non-matching attributes - | SynTypeDefnKind.Interface -> - match synAttributes with - | Interface | Unknown -> success InheritanceContext.Interface - | _ -> Some CompletionContext.Invalid // non-matching attributes - | SynTypeDefnKind.Struct -> - // display nothing for structs - Some CompletionContext.Invalid - | SynTypeDefnKind.Unspecified -> - match synAttributes with - | Class -> success InheritanceContext.Class - | Interface -> success InheritanceContext.Interface - | Unknown -> - // user do not specify kind explicitly or via attributes - success InheritanceContext.Unknown - | _ -> - // unable to uniquely detect kind from the attributes - return invalid context + let parseLid (SynLongIdent (lid, dots, _)) = + let rec collect plid (parts: Ident list) (dots: range list) = + match parts, dots with + | [], _ -> Some(plid, None) + | x :: xs, ds -> + if rangeContainsPos x.idRange pos then + // pos lies with the range of current identifier + let s = x.idText.Substring(0, pos.Column - x.idRange.Start.Column) + let residue = if s.Length <> 0 then Some s else None + Some(plid, residue) + elif posGt x.idRange.Start pos then + // can happen if caret is placed after dot but before the existing identifier A. $ B + // return accumulated plid with no residue + Some(plid, None) + else + match ds with + | [] -> + // pos lies after the id and no dots found - return accumulated plid and current id as residue + Some(plid, Some x.idText) + | d :: ds -> + if posGeq pos d.End then + // pos lies after the dot - proceed to the next identifier + collect (x.idText :: plid) xs ds + else + // pos after the id but before the dot + // A $.B - return nothing + None + + match collect [] lid dots with + | Some (parts, residue) -> Some((List.rev parts), residue) + | None -> None + + let (|Class|Interface|Struct|Unknown|Invalid|) synAttributes = + let (|SynAttr|_|) name (attr: SynAttribute) = + match attr with + | { + TypeName = SynLongIdent ([ x ], _, _) + } when x.idText = name -> Some() + | _ -> None + + let rec getKind isClass isInterface isStruct = + function + | [] -> isClass, isInterface, isStruct + | SynAttr "Class" :: xs -> getKind true isInterface isStruct xs + | SynAttr "AbstractClass" :: xs -> getKind true isInterface isStruct xs + | SynAttr "Interface" :: xs -> getKind isClass true isStruct xs + | SynAttr "Struct" :: xs -> getKind isClass isInterface true xs + | _ :: xs -> getKind isClass isInterface isStruct xs + + match getKind false false false synAttributes with + | false, false, false -> Unknown + | true, false, false -> Class + | false, true, false -> Interface + | false, false, true -> Struct + | _ -> Invalid + + let GetCompletionContextForInheritSynMember + ( + SynComponentInfo (Attributes synAttributes, _, _, _, _, _, _, _), + typeDefnKind: SynTypeDefnKind, + completionPath + ) = + + let success k = + Some(CompletionContext.Inherit(k, completionPath)) + + // if kind is specified - take it + // if kind is non-specified + // - try to obtain it from attribute + // - if no attributes present - infer kind from members + match typeDefnKind with + | SynTypeDefnKind.Class -> + match synAttributes with + | Class + | Unknown -> success InheritanceContext.Class + | _ -> Some CompletionContext.Invalid // non-matching attributes + | SynTypeDefnKind.Interface -> + match synAttributes with + | Interface + | Unknown -> success InheritanceContext.Interface + | _ -> Some CompletionContext.Invalid // non-matching attributes + | SynTypeDefnKind.Struct -> + // display nothing for structs Some CompletionContext.Invalid - | _ -> None + | SynTypeDefnKind.Unspecified -> + match synAttributes with + | Class -> success InheritanceContext.Class + | Interface -> success InheritanceContext.Interface + | Unknown -> + // user do not specify kind explicitly or via attributes + success InheritanceContext.Unknown + | _ -> + // unable to uniquely detect kind from the attributes - return invalid context + Some CompletionContext.Invalid + | _ -> None - let (|Operator|_|) name e = - match e with - | SynExpr.App (ExprAtomicFlag.NonAtomic, false, SynExpr.App (ExprAtomicFlag.NonAtomic, true, SynExpr.LongIdent(longDotId = SynLongIdent(id = [ident])), lhs, _), rhs, _) - when ident.idText = name -> Some (lhs, rhs) - | _ -> None + let (|Operator|_|) name e = + match e with + | SynExpr.App (ExprAtomicFlag.NonAtomic, + false, + SynExpr.App (ExprAtomicFlag.NonAtomic, + true, + SynExpr.LongIdent(longDotId = SynLongIdent(id = [ ident ])), + lhs, + _), + rhs, + _) when ident.idText = name -> Some(lhs, rhs) + | _ -> None - // checks if we are in a range operator - let isAtRangeOp (p : SyntaxVisitorPath) = - match p with - | SyntaxNode.SynExpr(SynExpr.IndexRange _) :: _ -> true - | _ -> false + // checks if we are in a range operator + let isAtRangeOp (p: SyntaxVisitorPath) = + match p with + | SyntaxNode.SynExpr (SynExpr.IndexRange _) :: _ -> true + | _ -> false - let (|Setter|_|) e = - match e with - | Operator "op_Equality" (SynExpr.Ident id , _) -> Some id - | _ -> None + let (|Setter|_|) e = + match e with + | Operator "op_Equality" (SynExpr.Ident id, _) -> Some id + | _ -> None - let findSetters argList = - match argList with - | SynExpr.Paren (SynExpr.Tuple (false, parameters, _, _), _, _, _) -> - let setters = HashSet() - for p in parameters do - match p with - | Setter id -> ignore(setters.Add id.idText) - | _ -> () - setters - | _ -> emptyStringSet - - let endOfLastIdent (lid: SynLongIdent) = - let last = List.last lid.LongIdent - last.idRange.End - - let endOfClosingTokenOrLastIdent (mClosing: range option) (lid : SynLongIdent) = - match mClosing with - | Some m -> m.End - | None -> endOfLastIdent lid - - let endOfClosingTokenOrIdent (mClosing: range option) (id : Ident) = - match mClosing with - | Some m -> m.End - | None -> id.idRange.End - - let (|NewObjectOrMethodCall|_|) e = - match e with - | SynExpr.New (_, SynType.LongIdent typeName, arg, _) -> - // new A() - Some (endOfLastIdent typeName, findSetters arg) - | SynExpr.New (_, SynType.App(StripParenTypes (SynType.LongIdent typeName), _, _, _, mGreaterThan, _, _), arg, _) -> - // new A<_>() - Some (endOfClosingTokenOrLastIdent mGreaterThan typeName, findSetters arg) - | SynExpr.App (_, false, SynExpr.Ident id, arg, _) -> - // A() - Some (id.idRange.End, findSetters arg) - | SynExpr.App (_, false, SynExpr.TypeApp (SynExpr.Ident id, _, _, _, mGreaterThan, _, _), arg, _) -> - // A<_>() - Some (endOfClosingTokenOrIdent mGreaterThan id, findSetters arg) - | SynExpr.App (_, false, SynExpr.LongIdent (_, lid, _, _), arg, _) -> - // A.B() - Some (endOfLastIdent lid, findSetters arg) - | SynExpr.App (_, false, SynExpr.TypeApp (SynExpr.LongIdent (_, lid, _, _), _, _, _, mGreaterThan, _, _), arg, _) -> - // A.B<_>() - Some (endOfClosingTokenOrLastIdent mGreaterThan lid, findSetters arg) - | _ -> None - - let isOnTheRightOfComma (elements: SynExpr list) (commas: range list) current = - let rec loop elements (commas: range list) = - match elements with - | x :: xs -> - match commas with - | c :: cs -> - if x === current then posLt c.End pos || posEq c.End pos - else loop xs cs + let findSetters argList = + match argList with + | SynExpr.Paren (SynExpr.Tuple (false, parameters, _, _), _, _, _) -> + let setters = HashSet() + + for p in parameters do + match p with + | Setter id -> ignore (setters.Add id.idText) + | _ -> () + + setters + | _ -> emptyStringSet + + let endOfLastIdent (lid: SynLongIdent) = + let last = List.last lid.LongIdent + last.idRange.End + + let endOfClosingTokenOrLastIdent (mClosing: range option) (lid: SynLongIdent) = + match mClosing with + | Some m -> m.End + | None -> endOfLastIdent lid + + let endOfClosingTokenOrIdent (mClosing: range option) (id: Ident) = + match mClosing with + | Some m -> m.End + | None -> id.idRange.End + + let (|NewObjectOrMethodCall|_|) e = + match e with + | SynExpr.New (_, SynType.LongIdent typeName, arg, _) -> + // new A() + Some(endOfLastIdent typeName, findSetters arg) + | SynExpr.New (_, SynType.App (StripParenTypes (SynType.LongIdent typeName), _, _, _, mGreaterThan, _, _), arg, _) -> + // new A<_>() + Some(endOfClosingTokenOrLastIdent mGreaterThan typeName, findSetters arg) + | SynExpr.App (_, false, SynExpr.Ident id, arg, _) -> + // A() + Some(id.idRange.End, findSetters arg) + | SynExpr.App (_, false, SynExpr.TypeApp (SynExpr.Ident id, _, _, _, mGreaterThan, _, _), arg, _) -> + // A<_>() + Some(endOfClosingTokenOrIdent mGreaterThan id, findSetters arg) + | SynExpr.App (_, false, SynExpr.LongIdent (_, lid, _, _), arg, _) -> + // A.B() + Some(endOfLastIdent lid, findSetters arg) + | SynExpr.App (_, false, SynExpr.TypeApp (SynExpr.LongIdent (_, lid, _, _), _, _, _, mGreaterThan, _, _), arg, _) -> + // A.B<_>() + Some(endOfClosingTokenOrLastIdent mGreaterThan lid, findSetters arg) + | _ -> None + + let isOnTheRightOfComma (elements: SynExpr list) (commas: range list) current = + let rec loop elements (commas: range list) = + match elements with + | x :: xs -> + match commas with + | c :: cs -> + if x === current then + posLt c.End pos || posEq c.End pos + else + loop xs cs + | _ -> false | _ -> false - | _ -> false - loop elements commas - - let (|PartOfParameterList|_|) precedingArgument path = - match path with - | SyntaxNode.SynExpr(SynExpr.Paren _) :: SyntaxNode.SynExpr(NewObjectOrMethodCall args) :: _ -> - if Option.isSome precedingArgument then None else Some args - | SyntaxNode.SynExpr(SynExpr.Tuple (false, elements, commas, _)) :: SyntaxNode.SynExpr(SynExpr.Paren _) :: SyntaxNode.SynExpr(NewObjectOrMethodCall args) :: _ -> - match precedingArgument with - | None -> Some args - | Some e -> - // if expression is passed then - // 1. find it in among elements of the tuple - // 2. find corresponding comma - // 3. check that current position is past the comma - // this is used for cases like (a = something-here.) if the cursor is after . - // in this case this is not object initializer completion context - if isOnTheRightOfComma elements commas e then Some args else None - | _ -> None - let (|SkipFromParseErrorPat|) pat = - match pat with - | SynPat.FromParseError(pat, _) -> pat - | _ -> pat + loop elements commas + + let (|PartOfParameterList|_|) precedingArgument path = + match path with + | SyntaxNode.SynExpr (SynExpr.Paren _) :: SyntaxNode.SynExpr (NewObjectOrMethodCall args) :: _ -> + if Option.isSome precedingArgument then None else Some args + | SyntaxNode.SynExpr (SynExpr.Tuple (false, elements, commas, _)) :: SyntaxNode.SynExpr (SynExpr.Paren _) :: SyntaxNode.SynExpr (NewObjectOrMethodCall args) :: _ -> + match precedingArgument with + | None -> Some args + | Some e -> + // if expression is passed then + // 1. find it in among elements of the tuple + // 2. find corresponding comma + // 3. check that current position is past the comma + // this is used for cases like (a = something-here.) if the cursor is after . + // in this case this is not object initializer completion context + if isOnTheRightOfComma elements commas e then + Some args + else + None + | _ -> None - let walker = - { - new SyntaxVisitorBase<_>() with - member _.VisitExpr(path, _, defaultTraverse, expr) = + let (|SkipFromParseErrorPat|) pat = + match pat with + | SynPat.FromParseError (pat, _) -> pat + | _ -> pat + + let walker = + { new SyntaxVisitorBase<_>() with + member _.VisitExpr(path, _, defaultTraverse, expr) = if isAtRangeOp path then match defaultTraverse expr with @@ -951,156 +1083,160 @@ module ParsedInput = // new A($) | SynExpr.Const (SynConst.Unit, m) when rangeContainsPos m pos -> match path with - | SyntaxNode.SynExpr(NewObjectOrMethodCall args) :: _ -> - Some (CompletionContext.ParameterList args) - | _ -> - defaultTraverse expr + | SyntaxNode.SynExpr (NewObjectOrMethodCall args) :: _ -> Some(CompletionContext.ParameterList args) + | _ -> defaultTraverse expr // new (... A$) | SynExpr.Ident id - | SynExpr.LongIdent(longDotId = SynLongIdent([id], [], [ Some _ ])) when id.idRange.End = pos -> + | SynExpr.LongIdent(longDotId = SynLongIdent ([ id ], [], [ Some _ ])) when id.idRange.End = pos -> match path with - | PartOfParameterList None args -> - Some (CompletionContext.ParameterList args) - | _ -> - defaultTraverse expr + | PartOfParameterList None args -> Some(CompletionContext.ParameterList args) + | _ -> defaultTraverse expr // new (A$ = 1) // new (A = 1, $) | Setter id when id.idRange.End = pos || rangeBeforePos expr.Range pos -> let precedingArgument = if id.idRange.End = pos then None else Some expr + match path with - | PartOfParameterList precedingArgument args-> - Some (CompletionContext.ParameterList args) - | _ -> - defaultTraverse expr - | SynExpr.Record(None, None, [], _) -> - Some(CompletionContext.RecordField RecordContext.Empty) + | PartOfParameterList precedingArgument args -> Some(CompletionContext.ParameterList args) + | _ -> defaultTraverse expr + | SynExpr.Record (None, None, [], _) -> Some(CompletionContext.RecordField RecordContext.Empty) // Unchecked.defaultof - | SynExpr.TypeApp (typeArgsRange = range) when rangeContainsPos range pos -> - Some CompletionContext.PatternType + | SynExpr.TypeApp (typeArgsRange = range) when rangeContainsPos range pos -> Some CompletionContext.PatternType | _ -> defaultTraverse expr - member _.VisitRecordField(path, copyOpt, field) = - let contextFromTreePath completionPath = + member _.VisitRecordField(path, copyOpt, field) = + let contextFromTreePath completionPath = // detect records usage in constructor match path with - | SyntaxNode.SynExpr _ :: SyntaxNode.SynBinding _ :: SyntaxNode.SynMemberDefn _ :: SyntaxNode.SynTypeDefn(SynTypeDefn(typeInfo=SynComponentInfo(longId=[id]))) :: _ -> + | SyntaxNode.SynExpr _ :: SyntaxNode.SynBinding _ :: SyntaxNode.SynMemberDefn _ :: SyntaxNode.SynTypeDefn (SynTypeDefn(typeInfo = SynComponentInfo(longId = [ id ]))) :: _ -> RecordContext.Constructor(id.idText) - | SyntaxNode.SynExpr(SynExpr.Record(None, _, fields, _)) :: _ -> - let isFirstField = + | SyntaxNode.SynExpr (SynExpr.Record (None, _, fields, _)) :: _ -> + let isFirstField = match field, fields with | Some contextLid, SynExprRecordField(fieldName = lid, _) :: _ -> contextLid.Range = lid.Range | _ -> false RecordContext.New(completionPath, isFirstField) - // Unfinished `{ xxx }` expression considered a record field by the tree walker. - | SyntaxNode.SynExpr(SynExpr.ComputationExpr _) :: _ -> - RecordContext.New(completionPath, true) + // Unfinished `{ xxx }` expression considered a record field by the tree walker. + | SyntaxNode.SynExpr (SynExpr.ComputationExpr _) :: _ -> RecordContext.New(completionPath, true) - | _ -> - RecordContext.New(completionPath, false) + | _ -> RecordContext.New(completionPath, false) match field with - | Some field -> + | Some field -> match parseLid field with | Some completionPath -> - let recordContext = + let recordContext = match copyOpt with - | Some (s : SynExpr) -> RecordContext.CopyOnUpdate(s.Range, completionPath) + | Some (s: SynExpr) -> RecordContext.CopyOnUpdate(s.Range, completionPath) | None -> contextFromTreePath completionPath - Some (CompletionContext.RecordField recordContext) + + Some(CompletionContext.RecordField recordContext) | None -> None | None -> - let recordContext = + let recordContext = match copyOpt with | Some s -> RecordContext.CopyOnUpdate(s.Range, ([], None)) | None -> contextFromTreePath ([], None) - Some (CompletionContext.RecordField recordContext) - - member _.VisitInheritSynMemberDefn(_path, componentInfo, typeDefnKind, synType, _members, _range) = + + Some(CompletionContext.RecordField recordContext) + + member _.VisitInheritSynMemberDefn(_path, componentInfo, typeDefnKind, synType, _members, _range) = match synType with - | SynType.LongIdent lidwd -> + | SynType.LongIdent lidwd -> match parseLid lidwd with - | Some completionPath -> GetCompletionContextForInheritSynMember (componentInfo, typeDefnKind, completionPath) + | Some completionPath -> GetCompletionContextForInheritSynMember(componentInfo, typeDefnKind, completionPath) | None -> Some CompletionContext.Invalid // A $ .B -> no completion list - | _ -> None - - member _.VisitBinding(_path, defaultTraverse, (SynBinding(headPat = headPat) as synBinding)) = - + | _ -> None + + member _.VisitBinding(_path, defaultTraverse, (SynBinding (headPat = headPat) as synBinding)) = + let visitParam (SkipFromParseErrorPat pat) = match pat with | SynPat.Named (range = range) - | SynPat.As (_, SynPat.Named (range = range), _) when rangeContainsPos range pos -> + | SynPat.As (_, SynPat.Named (range = range), _) when rangeContainsPos range pos -> // parameter without type hint, no completion - Some CompletionContext.Invalid - | SynPat.Typed(SynPat.Named(_, _, _, range), _, _) when rangeContainsPos range pos -> + Some CompletionContext.Invalid + | SynPat.Typed (SynPat.Named (_, _, _, range), _, _) when rangeContainsPos range pos -> // parameter with type hint, but we are on its name, no completion Some CompletionContext.Invalid | _ -> defaultTraverse synBinding match headPat with - | SynPat.LongIdent(longDotId = lidwd) when rangeContainsPos lidwd.Range pos -> + | SynPat.LongIdent (longDotId = lidwd) when rangeContainsPos lidwd.Range pos -> // let fo|o x = () Some CompletionContext.Invalid - | SynPat.LongIdent(argPats=ctorArgs) -> + | SynPat.LongIdent (argPats = ctorArgs) -> match ctorArgs with | SynArgPats.Pats pats -> - pats |> List.tryPick (fun (SkipFromParseErrorPat pat) -> + pats + |> List.tryPick (fun (SkipFromParseErrorPat pat) -> match pat with - | SynPat.Paren(pat, _) -> + | SynPat.Paren (pat, _) -> match pat with - | SynPat.Tuple(_, pats, _) -> - pats |> List.tryPick visitParam + | SynPat.Tuple (_, pats, _) -> pats |> List.tryPick visitParam | _ -> visitParam pat - | SynPat.Wild range | SynPat.FromParseError (SynPat.Named _, range) when rangeContainsPos range pos -> + | SynPat.Wild range + | SynPat.FromParseError (SynPat.Named _, range) when rangeContainsPos range pos -> // let foo (x| Some CompletionContext.Invalid - | _ -> visitParam pat - ) + | _ -> visitParam pat) | _ -> defaultTraverse synBinding - | SynPat.Named(range = range) + | SynPat.Named (range = range) | SynPat.As (_, SynPat.Named (range = range), _) when rangeContainsPos range pos -> // let fo|o = 1 Some CompletionContext.Invalid - | _ -> defaultTraverse synBinding - - member _.VisitHashDirective (_path, _directive, range) = + | _ -> defaultTraverse synBinding + + member _.VisitHashDirective(_path, _directive, range) = // No completions in a directive - if rangeContainsPos range pos then Some CompletionContext.Invalid - else None - - member _.VisitModuleOrNamespace(_path, SynModuleOrNamespace(longId = idents)) = + if rangeContainsPos range pos then + Some CompletionContext.Invalid + else + None + + member _.VisitModuleOrNamespace(_path, SynModuleOrNamespace (longId = idents)) = match List.tryLast idents with - | Some lastIdent when pos.Line = lastIdent.idRange.EndLine && lastIdent.idRange.EndColumn >= 0 && pos.Column <= lineStr.Length -> - let stringBetweenModuleNameAndPos = lineStr[lastIdent.idRange.EndColumn..pos.Column - 1] + | Some lastIdent when + pos.Line = lastIdent.idRange.EndLine + && lastIdent.idRange.EndColumn >= 0 + && pos.Column <= lineStr.Length + -> + let stringBetweenModuleNameAndPos = + lineStr[lastIdent.idRange.EndColumn .. pos.Column - 1] + if stringBetweenModuleNameAndPos |> Seq.forall (fun x -> x = ' ' || x = '.') then // No completions in a top level a module or namespace identifier Some CompletionContext.Invalid - else None - | _ -> None + else + None + | _ -> None - member _.VisitComponentInfo(_path, SynComponentInfo(range = range)) = + member _.VisitComponentInfo(_path, SynComponentInfo (range = range)) = // No completions in component info (unless it's within an attribute) // /// XmlDo| // type R = class end - if rangeContainsPos range pos then Some CompletionContext.Invalid - else None + if rangeContainsPos range pos then + Some CompletionContext.Invalid + else + None member _.VisitLetOrUse(_path, _, _, bindings, range) = match bindings with | [] when range.StartLine = pos.Line -> Some CompletionContext.Invalid | _ -> None - member _.VisitSimplePats (_path, pats) = - pats |> List.tryPick (fun pat -> + member _.VisitSimplePats(_path, pats) = + pats + |> List.tryPick (fun pat -> // No completions in an identifier in a pattern match pat with // fun x| -> - | SynSimplePat.Id(range = range) when rangeContainsPos range pos -> - Some CompletionContext.Invalid - | SynSimplePat.Typed(SynSimplePat.Id(range = idRange), synType, _) -> + | SynSimplePat.Id (range = range) when rangeContainsPos range pos -> Some CompletionContext.Invalid + | SynSimplePat.Typed (SynSimplePat.Id (range = idRange), synType, _) -> // fun (x|: int) -> if rangeContainsPos idRange pos then Some CompletionContext.Invalid @@ -1111,15 +1247,14 @@ module ParsedInput = None | _ -> None) - member _.VisitPat (_, defaultTraverse, pat) = + member _.VisitPat(_, defaultTraverse, pat) = match pat with - | SynPat.IsInst (_, range) when rangeContainsPos range pos -> - Some CompletionContext.PatternType + | SynPat.IsInst (_, range) when rangeContainsPos range pos -> Some CompletionContext.PatternType | _ -> defaultTraverse pat member _.VisitModuleDecl(_path, defaultTraverse, decl) = match decl with - | SynModuleDecl.Open(target, m) -> + | SynModuleDecl.Open (target, m) -> // in theory, this means we're "in an open" // in practice, because the parse tree/walkers do not handle attributes well yet, need extra check below to ensure not e.g. $here$ // open System @@ -1127,162 +1262,191 @@ module ParsedInput = // let f() = () // inside an attribute on the next item let pos = mkPos pos.Line (pos.Column - 1) // -1 because for e.g. "open System." the dot does not show up in the parse tree + if rangeContainsPos m pos then let isOpenType = match target with | SynOpenDeclTarget.Type _ -> true | SynOpenDeclTarget.ModuleOrNamespace _ -> false - Some (CompletionContext.OpenDeclaration isOpenType) + + Some(CompletionContext.OpenDeclaration isOpenType) else None | _ -> defaultTraverse decl member _.VisitType(_path, defaultTraverse, ty) = match ty with - | SynType.LongIdent _ when rangeContainsPos ty.Range pos -> - Some CompletionContext.PatternType + | SynType.LongIdent _ when rangeContainsPos ty.Range pos -> Some CompletionContext.PatternType | _ -> defaultTraverse ty member _.VisitRecordDefn(_path, fields, range) = fields |> List.tryPick (fun (SynField (idOpt = idOpt; range = fieldRange)) -> match idOpt with - | Some id when rangeContainsPos id.idRange pos -> Some(CompletionContext.RecordField(RecordContext.Declaration true)) + | Some id when rangeContainsPos id.idRange pos -> + Some(CompletionContext.RecordField(RecordContext.Declaration true)) | _ when rangeContainsPos fieldRange pos -> Some(CompletionContext.RecordField(RecordContext.Declaration false)) | _ -> None) // No completions in a record outside of all fields - |> Option.orElseWith (fun () -> if rangeContainsPos range pos then Some CompletionContext.Invalid else None) + |> Option.orElseWith (fun () -> + if rangeContainsPos range pos then + Some CompletionContext.Invalid + else + None) member _.VisitUnionDefn(_path, cases, _range) = - cases |> List.tryPick (fun (SynUnionCase (ident = SynIdent(id,_); caseType = caseType)) -> + cases + |> List.tryPick (fun (SynUnionCase (ident = SynIdent (id, _); caseType = caseType)) -> if rangeContainsPos id.idRange pos then // No completions in a union case identifier Some CompletionContext.Invalid else match caseType with | SynUnionCaseKind.Fields fieldCases -> - fieldCases |> List.tryPick (fun (SynField (idOpt = fieldIdOpt; range = fieldRange)) -> + fieldCases + |> List.tryPick (fun (SynField (idOpt = fieldIdOpt; range = fieldRange)) -> match fieldIdOpt with // No completions in a union case field identifier | Some id when rangeContainsPos id.idRange pos -> Some CompletionContext.Invalid - | _ -> if rangeContainsPos fieldRange pos then Some CompletionContext.UnionCaseFieldsDeclaration else None) + | _ -> + if rangeContainsPos fieldRange pos then + Some CompletionContext.UnionCaseFieldsDeclaration + else + None) | _ -> None) member _.VisitEnumDefn(_path, _, range) = // No completions anywhere in an enum - if rangeContainsPos range pos then Some CompletionContext.Invalid else None + if rangeContainsPos range pos then + Some CompletionContext.Invalid + else + None member _.VisitTypeAbbrev(_path, _, range) = - if rangeContainsPos range pos then Some CompletionContext.TypeAbbreviationOrSingleCaseUnion else None - } + if rangeContainsPos range pos then + Some CompletionContext.TypeAbbreviationOrSingleCaseUnion + else + None + } - SyntaxTraversal.Traverse(pos, parsedInput, walker) - // Uncompleted attribute applications are not presented in the AST in any way. So, we have to parse source string. - |> Option.orElseWith (fun _ -> - let cutLeadingAttributes (str: string) = - // cut off leading attributes, i.e. we cut "[]" to " >]" - match str.LastIndexOf ';' with - | -1 -> str - | idx when idx < str.Length -> str[idx + 1..].TrimStart() - | _ -> "" - - let isLongIdent = Seq.forall (fun c -> IsIdentifierPartCharacter c || c = '.' || c = ':') // ':' may occur in "[]" - - // match the most nested paired [< and >] first - let matches = - insideAttributeApplicationRegex.Matches lineStr - |> Seq.cast - |> Seq.filter (fun m -> m.Index <= pos.Column && m.Index + m.Length >= pos.Column) - |> Seq.toArray - - if not (Array.isEmpty matches) then - matches - |> Seq.tryPick (fun m -> - let g = m.Groups["attribute"] - let col = pos.Column - g.Index - if col >= 0 && col < g.Length then - let str = g.Value.Substring(0, col).TrimStart() // cut other rhs attributes - let str = cutLeadingAttributes str - if isLongIdent str then - Some CompletionContext.AttributeApplication - else None - else None) - else - // Paired [< and >] were not found, try to determine that we are after [< without closing >] - match lineStr.LastIndexOf("[<", StringComparison.Ordinal) with - | -1 -> None - | openParenIndex when pos.Column >= openParenIndex + 2 -> - let str = lineStr[openParenIndex + 2..pos.Column - 1].TrimStart() - let str = cutLeadingAttributes str - if isLongIdent str then - Some CompletionContext.AttributeApplication - else None - | _ -> None) + SyntaxTraversal.Traverse(pos, parsedInput, walker) + // Uncompleted attribute applications are not presented in the AST in any way. So, we have to parse source string. + |> Option.orElseWith (fun _ -> + let cutLeadingAttributes (str: string) = + // cut off leading attributes, i.e. we cut "[]" to " >]" + match str.LastIndexOf ';' with + | -1 -> str + | idx when idx < str.Length -> str[ idx + 1 .. ].TrimStart() + | _ -> "" + + let isLongIdent = + Seq.forall (fun c -> IsIdentifierPartCharacter c || c = '.' || c = ':') // ':' may occur in "[]" + + // match the most nested paired [< and >] first + let matches = + insideAttributeApplicationRegex.Matches lineStr + |> Seq.cast + |> Seq.filter (fun m -> m.Index <= pos.Column && m.Index + m.Length >= pos.Column) + |> Seq.toArray + + if not (Array.isEmpty matches) then + matches + |> Seq.tryPick (fun m -> + let g = m.Groups["attribute"] + let col = pos.Column - g.Index + + if col >= 0 && col < g.Length then + let str = g.Value.Substring(0, col).TrimStart() // cut other rhs attributes + let str = cutLeadingAttributes str + + if isLongIdent str then + Some CompletionContext.AttributeApplication + else + None + else + None) + else + // Paired [< and >] were not found, try to determine that we are after [< without closing >] + match lineStr.LastIndexOf("[<", StringComparison.Ordinal) with + | -1 -> None + | openParenIndex when pos.Column >= openParenIndex + 2 -> + let str = lineStr[ openParenIndex + 2 .. pos.Column - 1 ].TrimStart() + let str = cutLeadingAttributes str + + if isLongIdent str then + Some CompletionContext.AttributeApplication + else + None + | _ -> None) /// Check if we are at an "open" declaration - let GetFullNameOfSmallestModuleOrNamespaceAtPoint (pos: pos, parsedInput: ParsedInput) = + let GetFullNameOfSmallestModuleOrNamespaceAtPoint (pos: pos, parsedInput: ParsedInput) = let mutable path = [] - let visitor = + + let visitor = { new SyntaxVisitorBase() with - override this.VisitExpr(_path, _traverseSynExpr, defaultTraverse, expr) = + override this.VisitExpr(_path, _traverseSynExpr, defaultTraverse, expr) = // don't need to keep going, namespaces and modules never appear inside Exprs - None - override this.VisitModuleOrNamespace(_path, SynModuleOrNamespace(longId = longId; range = range)) = - if rangeContainsPos range pos then - path <- path @ longId - None // we should traverse the rest of the AST to find the smallest module + None + + override this.VisitModuleOrNamespace(_path, SynModuleOrNamespace (longId = longId; range = range)) = + if rangeContainsPos range pos then path <- path @ longId + None // we should traverse the rest of the AST to find the smallest module } + SyntaxTraversal.Traverse(pos, parsedInput, visitor) |> ignore path |> List.map (fun x -> x.idText) |> List.toArray /// 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] + let rec (|Sequentials|_|) = + function + | SynExpr.Sequential (_, _, e, Sequentials es, _) -> Some(e :: es) + | SynExpr.Sequential (_, _, e1, e2, _) -> Some [ e1; e2 ] | _ -> None - let (|ConstructorPats|) = function + let (|ConstructorPats|) = + function | SynArgPats.Pats ps -> ps - | SynArgPats.NamePatPairs(xs, _) -> List.map (fun (_, _, pat) -> pat) xs + | SynArgPats.NamePatPairs (xs, _) -> List.map (fun (_, _, pat) -> pat) xs /// Returns all `Ident`s and `LongIdent`s found in an untyped AST. let getLongIdents (parsedInput: ParsedInput) : IDictionary = let identsByEndPos = Dictionary() - + let addLongIdent (longIdent: LongIdent) = for ident in longIdent do identsByEndPos[ident.idRange.End] <- longIdent - + let addLongIdentWithDots (SynLongIdent (longIdent, lids, _) as value) = match longIdent with | [] -> () - | [_] as idents -> identsByEndPos[value.Range.End] <- idents + | [ _ ] as idents -> identsByEndPos[value.Range.End] <- idents | idents -> for dotRange in lids do identsByEndPos[mkPos dotRange.EndLine (dotRange.EndColumn - 1)] <- idents + identsByEndPos[value.Range.End] <- idents - + let addIdent (ident: Ident) = - identsByEndPos[ident.idRange.End] <- [ident] - + identsByEndPos[ident.idRange.End] <- [ ident ] + let rec walkImplFileInput (ParsedImplFileInput (modules = moduleOrNamespaceList)) = List.iter walkSynModuleOrNamespace moduleOrNamespaceList - - and walkSynModuleOrNamespace (SynModuleOrNamespace(decls = decls; attribs = Attributes attrs)) = + + and walkSynModuleOrNamespace (SynModuleOrNamespace (decls = decls; attribs = Attributes attrs)) = List.iter walkAttribute attrs List.iter walkSynModuleDecl decls - + and walkAttribute (attr: SynAttribute) = addLongIdentWithDots attr.TypeName walkExpr attr.ArgExpr - + and walkTyparDecl (SynTyparDecl.SynTyparDecl (Attributes attrs, typar)) = List.iter walkAttribute attrs walkTypar typar - - and walkTypeConstraint = function + + and walkTypeConstraint = + function | SynTypeConstraint.WhereTyparIsValueType (t, _) | SynTypeConstraint.WhereTyparIsReferenceType (t, _) | SynTypeConstraint.WhereTyparIsUnmanaged (t, _) @@ -1290,16 +1454,23 @@ module ParsedInput = | SynTypeConstraint.WhereTyparIsComparable (t, _) | SynTypeConstraint.WhereTyparIsEquatable (t, _) -> walkTypar t | SynTypeConstraint.WhereTyparDefaultsToType (t, ty, _) - | SynTypeConstraint.WhereTyparSubtypeOfType (t, ty, _) -> walkTypar t; walkType ty + | SynTypeConstraint.WhereTyparSubtypeOfType (t, ty, _) -> + walkTypar t + walkType ty | SynTypeConstraint.WhereTyparIsEnum (t, ts, _) - | SynTypeConstraint.WhereTyparIsDelegate (t, ts, _) -> walkTypar t; List.iter walkType ts - | SynTypeConstraint.WhereTyparSupportsMember (ts, sign, _) -> List.iter walkType ts; walkMemberSig sign - - and walkPat = function - | SynPat.Tuple (_,pats, _) + | SynTypeConstraint.WhereTyparIsDelegate (t, ts, _) -> + walkTypar t + List.iter walkType ts + | SynTypeConstraint.WhereTyparSupportsMember (ts, sign, _) -> + List.iter walkType ts + walkMemberSig sign + + and walkPat = + function + | SynPat.Tuple (_, pats, _) | SynPat.ArrayOrList (_, pats, _) | SynPat.Ands (pats, _) -> List.iter walkPat pats - | SynPat.Named (SynIdent(ident,_), _, _, _) -> addIdent ident + | SynPat.Named (SynIdent (ident, _), _, _, _) -> addIdent ident | SynPat.Typed (pat, t, _) -> walkPat pat walkType t @@ -1307,56 +1478,66 @@ module ParsedInput = walkPat pat List.iter walkAttribute attrs | SynPat.As (pat1, pat2, _) - | SynPat.Or (pat1, pat2, _, _) -> List.iter walkPat [pat1; pat2] - | SynPat.LongIdent (longDotId=ident; typarDecls=typars; argPats=ConstructorPats pats) -> + | SynPat.Or (pat1, pat2, _, _) -> List.iter walkPat [ pat1; pat2 ] + | SynPat.LongIdent (longDotId = ident; typarDecls = typars; argPats = ConstructorPats pats) -> addLongIdentWithDots ident + typars |> Option.iter (fun (ValTyparDecls (typars, constraints, _)) -> - List.iter walkTyparDecl typars - List.iter walkTypeConstraint constraints) + List.iter walkTyparDecl typars + List.iter walkTypeConstraint constraints) + List.iter walkPat pats | SynPat.Paren (pat, _) -> walkPat pat | SynPat.IsInst (t, _) -> walkType t - | SynPat.QuoteExpr(e, _) -> walkExpr e + | SynPat.QuoteExpr (e, _) -> walkExpr e | _ -> () - + and walkTypar (SynTypar _) = () - - and walkBinding (SynBinding(attributes=Attributes attrs; headPat=pat; returnInfo=returnInfo; expr=e)) = + + and walkBinding (SynBinding (attributes = Attributes attrs; headPat = pat; returnInfo = returnInfo; expr = e)) = List.iter walkAttribute attrs walkPat pat walkExpr e returnInfo |> Option.iter (fun (SynBindingReturnInfo (t, _, _)) -> walkType t) - - and walkInterfaceImpl (SynInterfaceImpl(bindings=bindings)) = List.iter walkBinding bindings - - and walkType = function + + and walkInterfaceImpl (SynInterfaceImpl (bindings = bindings)) = List.iter walkBinding bindings + + and walkType = + function | SynType.Array (_, t, _) | SynType.HashConstraint (t, _) | SynType.MeasurePower (t, _, _) | SynType.Paren (t, _) -> walkType t | SynType.Fun (t1, t2, _) - | SynType.MeasureDivide (t1, t2, _) -> walkType t1; walkType t2 + | SynType.MeasureDivide (t1, t2, _) -> + walkType t1 + walkType t2 | SynType.LongIdent ident -> addLongIdentWithDots ident - | SynType.App (ty, _, types, _, _, _, _) -> walkType ty; List.iter walkType types + | SynType.App (ty, _, types, _, _, _, _) -> + walkType ty + List.iter walkType types | SynType.LongIdentApp (_, _, _, types, _, _, _) -> List.iter walkType types | SynType.Tuple (_, ts, _) -> ts |> List.iter (fun (_, t) -> walkType t) | SynType.WithGlobalConstraints (t, typeConstraints, _) -> - walkType t; List.iter walkTypeConstraint typeConstraints + walkType t + List.iter walkTypeConstraint typeConstraints | _ -> () - - and walkClause (SynMatchClause (pat=pat; whenExpr=e1; resultExpr=e2)) = + + and walkClause (SynMatchClause (pat = pat; whenExpr = e1; resultExpr = e2)) = walkPat pat walkExpr e2 e1 |> Option.iter walkExpr - - and walkSimplePats = function + + and walkSimplePats = + function | SynSimplePats.SimplePats (pats, _) -> List.iter walkSimplePat pats - | SynSimplePats.Typed (pats, ty, _) -> + | SynSimplePats.Typed (pats, ty, _) -> walkSimplePats pats walkType ty - - and walkExpr = function + + and walkExpr = + function | SynExpr.Paren (e, _, _, _) | SynExpr.Quote (_, _, e, _, _) | SynExpr.Typed (e, _, _) @@ -1371,52 +1552,60 @@ module ParsedInput = | SynExpr.Assert (e, _) | SynExpr.Lazy (e, _) | SynExpr.YieldOrReturnFrom (_, e, _) -> walkExpr e - | SynExpr.Lambda (args=pats; body=e) -> + | SynExpr.Lambda (args = pats; body = e) -> walkSimplePats pats walkExpr e | SynExpr.New (_, t, e, _) | SynExpr.TypeTest (e, t, _) | SynExpr.Upcast (e, t, _) - | SynExpr.Downcast (e, t, _) -> walkExpr e; walkType t + | SynExpr.Downcast (e, t, _) -> + walkExpr e + walkType t | SynExpr.Tuple (_, es, _, _) | Sequentials es | SynExpr.ArrayOrList (_, es, _) -> List.iter walkExpr es | SynExpr.App (_, _, e1, e2, _) - | SynExpr.TryFinally (tryExpr=e1; finallyExpr=e2) - | SynExpr.While (_, e1, e2, _) -> List.iter walkExpr [e1; e2] + | SynExpr.TryFinally (tryExpr = e1; finallyExpr = e2) + | SynExpr.While (_, e1, e2, _) -> List.iter walkExpr [ e1; e2 ] | SynExpr.Record (_, _, fields, _) -> - fields |> List.iter (fun (SynExprRecordField(fieldName=(ident, _); expr=e)) -> - addLongIdentWithDots ident - e |> Option.iter walkExpr) + fields + |> List.iter (fun (SynExprRecordField (fieldName = (ident, _); expr = e)) -> + addLongIdentWithDots ident + e |> Option.iter walkExpr) | SynExpr.Ident ident -> addIdent ident - | SynExpr.ObjExpr (objType=ty; argOptions=argOpt; bindings=bindings; members=ms; extraImpls=ifaces) -> + | SynExpr.ObjExpr (objType = ty; argOptions = argOpt; bindings = bindings; members = ms; extraImpls = ifaces) -> let bindings = unionBindingAndMembers bindings ms - argOpt |> Option.iter (fun (e, ident) -> + + argOpt + |> Option.iter (fun (e, ident) -> walkExpr e ident |> Option.iter addIdent) + walkType ty List.iter walkBinding bindings List.iter walkInterfaceImpl ifaces | SynExpr.LongIdent (_, ident, _, _) -> addLongIdentWithDots ident - | SynExpr.For (ident=ident; identBody=e1; toBody=e2; doBody=e3) -> + | SynExpr.For (ident = ident; identBody = e1; toBody = e2; doBody = e3) -> addIdent ident - List.iter walkExpr [e1; e2; e3] + List.iter walkExpr [ e1; e2; e3 ] | SynExpr.ForEach (_, _, _, _, pat, e1, e2, _) -> walkPat pat - List.iter walkExpr [e1; e2] - | SynExpr.MatchLambda (_, _, synMatchClauseList, _, _) -> - List.iter walkClause synMatchClauseList - | SynExpr.Match (expr=e; clauses=synMatchClauseList) -> + List.iter walkExpr [ e1; e2 ] + | SynExpr.MatchLambda (_, _, synMatchClauseList, _, _) -> List.iter walkClause synMatchClauseList + | SynExpr.Match (expr = e; clauses = synMatchClauseList) -> walkExpr e List.iter walkClause synMatchClauseList | SynExpr.TypeApp (e, _, tys, _, _, _, _) -> - List.iter walkType tys; walkExpr e - | SynExpr.LetOrUse (bindings=bindings; body=e) -> - List.iter walkBinding bindings; walkExpr e - | SynExpr.TryWith (tryExpr=e; withCases=clauses) -> - List.iter walkClause clauses; walkExpr e - | SynExpr.IfThenElse (ifExpr=e1; thenExpr=e2; elseExpr=e3) -> - List.iter walkExpr [e1; e2] + List.iter walkType tys + walkExpr e + | SynExpr.LetOrUse (bindings = bindings; body = e) -> + List.iter walkBinding bindings + walkExpr e + | SynExpr.TryWith (tryExpr = e; withCases = clauses) -> + List.iter walkClause clauses + walkExpr e + | SynExpr.IfThenElse (ifExpr = e1; thenExpr = e2; elseExpr = e3) -> + List.iter walkExpr [ e1; e2 ] e3 |> Option.iter walkExpr | SynExpr.LongIdentSet (ident, e, _) | SynExpr.DotGet (e, _, ident, _) -> @@ -1429,11 +1618,15 @@ module ParsedInput = | SynExpr.Set (e1, e2, _) -> walkExpr e1 walkExpr e2 - | SynExpr.IndexRange (expr1, _, expr2, _, _, _) -> - match expr1 with Some e -> walkExpr e | None -> () - match expr2 with Some e -> walkExpr e | None -> () - | SynExpr.IndexFromEnd (e, _) -> - walkExpr e + | SynExpr.IndexRange (expr1, _, expr2, _, _, _) -> + match expr1 with + | Some e -> walkExpr e + | None -> () + + match expr2 with + | Some e -> walkExpr e + | None -> () + | SynExpr.IndexFromEnd (e, _) -> walkExpr e | SynExpr.DotIndexedGet (e, args, _, _) -> walkExpr e walkExpr args @@ -1443,144 +1636,162 @@ module ParsedInput = walkExpr e2 | SynExpr.NamedIndexedPropertySet (ident, e1, e2, _) -> addLongIdentWithDots ident - List.iter walkExpr [e1; e2] + List.iter walkExpr [ e1; e2 ] | SynExpr.DotNamedIndexedPropertySet (e1, ident, e2, e3, _) -> addLongIdentWithDots ident - List.iter walkExpr [e1; e2; e3] - | SynExpr.JoinIn (e1, _, e2, _) -> List.iter walkExpr [e1; e2] - | SynExpr.LetOrUseBang (pat=pat; rhs=e1; andBangs=es; body=e2) -> + List.iter walkExpr [ e1; e2; e3 ] + | SynExpr.JoinIn (e1, _, e2, _) -> List.iter walkExpr [ e1; e2 ] + | SynExpr.LetOrUseBang (pat = pat; rhs = e1; andBangs = es; body = e2) -> walkPat pat walkExpr e1 - for SynExprAndBang(pat = patAndBang; body = eAndBang) in es do + + for SynExprAndBang (pat = patAndBang; body = eAndBang) in es do walkPat patAndBang walkExpr eAndBang + walkExpr e2 | SynExpr.TraitCall (ts, sign, e, _) -> List.iter walkTypar ts walkMemberSig sign walkExpr e - | SynExpr.Const (SynConst.Measure(_, _, m), _) -> walkMeasure m + | SynExpr.Const (SynConst.Measure (_, _, m), _) -> walkMeasure m | _ -> () - - and walkMeasure = function + + and walkMeasure = + function | SynMeasure.Product (m1, m2, _) - | SynMeasure.Divide (m1, m2, _) -> walkMeasure m1; walkMeasure m2 + | SynMeasure.Divide (m1, m2, _) -> + walkMeasure m1 + walkMeasure m2 | SynMeasure.Named (longIdent, _) -> addLongIdent longIdent | SynMeasure.Seq (ms, _) -> List.iter walkMeasure ms - | SynMeasure.Paren(m, _) + | SynMeasure.Paren (m, _) | SynMeasure.Power (m, _, _) -> walkMeasure m | SynMeasure.Var (ty, _) -> walkTypar ty | SynMeasure.One | SynMeasure.Anon _ -> () - - and walkSimplePat = function + + and walkSimplePat = + function | SynSimplePat.Attrib (pat, Attributes attrs, _) -> walkSimplePat pat List.iter walkAttribute attrs - | SynSimplePat.Typed(pat, t, _) -> + | SynSimplePat.Typed (pat, t, _) -> walkSimplePat pat walkType t | _ -> () - - and walkField (SynField(Attributes attrs, _, _, t, _, _, _, _)) = + + and walkField (SynField (Attributes attrs, _, _, t, _, _, _, _)) = List.iter walkAttribute attrs walkType t - - and walkValSig (SynValSig(attributes=Attributes attrs; synType=t; arity=SynValInfo(argInfos, argInfo))) = + + and walkValSig (SynValSig (attributes = Attributes attrs; synType = t; arity = SynValInfo (argInfos, argInfo))) = List.iter walkAttribute attrs walkType t + argInfo :: (argInfos |> List.concat) - |> List.collect (fun (SynArgInfo(Attributes attrs, _, _)) -> attrs) + |> List.collect (fun (SynArgInfo (Attributes attrs, _, _)) -> attrs) |> List.iter walkAttribute - - and walkMemberSig = function + + and walkMemberSig = + function | SynMemberSig.Inherit (t, _) - | SynMemberSig.Interface(t, _) -> walkType t - | SynMemberSig.Member(vs, _, _) -> walkValSig vs - | SynMemberSig.ValField(f, _) -> walkField f - | SynMemberSig.NestedType(nestedType=SynTypeDefnSig.SynTypeDefnSig (typeInfo=info; typeRepr=repr; members=memberSigs)) -> + | SynMemberSig.Interface (t, _) -> walkType t + | SynMemberSig.Member (vs, _, _) -> walkValSig vs + | SynMemberSig.ValField (f, _) -> walkField f + | SynMemberSig.NestedType(nestedType = SynTypeDefnSig.SynTypeDefnSig (typeInfo = info; typeRepr = repr; members = memberSigs)) -> let isTypeExtensionOrAlias = match repr with - | SynTypeDefnSigRepr.Simple(SynTypeDefnSimpleRepr.TypeAbbrev _, _) - | SynTypeDefnSigRepr.ObjectModel(SynTypeDefnKind.Abbrev, _, _) - | SynTypeDefnSigRepr.ObjectModel(kind=SynTypeDefnKind.Augmentation _) -> true + | SynTypeDefnSigRepr.Simple (SynTypeDefnSimpleRepr.TypeAbbrev _, _) + | SynTypeDefnSigRepr.ObjectModel (SynTypeDefnKind.Abbrev, _, _) + | SynTypeDefnSigRepr.ObjectModel(kind = SynTypeDefnKind.Augmentation _) -> true | _ -> false + walkComponentInfo isTypeExtensionOrAlias info walkTypeDefnSigRepr repr List.iter walkMemberSig memberSigs - + and walkMember memb = match memb with | SynMemberDefn.AbstractSlot (valSig, _, _) -> walkValSig valSig | SynMemberDefn.Member (binding, _) -> walkBinding binding - | SynMemberDefn.ImplicitCtor (_, Attributes attrs, SynSimplePats.SimplePats(simplePats, _), _, _, _) -> + | SynMemberDefn.ImplicitCtor (_, Attributes attrs, SynSimplePats.SimplePats (simplePats, _), _, _, _) -> List.iter walkAttribute attrs List.iter walkSimplePat simplePats - | SynMemberDefn.ImplicitInherit (t, e, _, _) -> walkType t; walkExpr e + | SynMemberDefn.ImplicitInherit (t, e, _, _) -> + walkType t + walkExpr e | SynMemberDefn.LetBindings (bindings, _, _, _) -> List.iter walkBinding bindings - | SynMemberDefn.Interface (interfaceType=t; members=members) -> + | SynMemberDefn.Interface (interfaceType = t; members = members) -> walkType t members |> Option.iter (List.iter walkMember) | SynMemberDefn.Inherit (t, _, _) -> walkType t | SynMemberDefn.ValField (field, _) -> walkField field | SynMemberDefn.NestedType (tdef, _, _) -> walkTypeDefn tdef - | SynMemberDefn.AutoProperty (attributes=Attributes attrs; typeOpt=t; synExpr=e) -> + | SynMemberDefn.AutoProperty (attributes = Attributes attrs; typeOpt = t; synExpr = e) -> List.iter walkAttribute attrs Option.iter walkType t walkExpr e | _ -> () - - and walkEnumCase (SynEnumCase(attributes=Attributes attrs)) = List.iter walkAttribute attrs - - and walkUnionCaseType = function + + and walkEnumCase (SynEnumCase(attributes = Attributes attrs)) = List.iter walkAttribute attrs + + and walkUnionCaseType = + function | SynUnionCaseKind.Fields fields -> List.iter walkField fields | SynUnionCaseKind.FullType (t, _) -> walkType t - - and walkUnionCase (SynUnionCase(attributes=Attributes attrs; caseType=t)) = + + and walkUnionCase (SynUnionCase (attributes = Attributes attrs; caseType = t)) = List.iter walkAttribute attrs walkUnionCaseType t - - and walkTypeDefnSimple = function + + and walkTypeDefnSimple = + function | SynTypeDefnSimpleRepr.Enum (cases, _) -> List.iter walkEnumCase cases | SynTypeDefnSimpleRepr.Union (_, cases, _) -> List.iter walkUnionCase cases | SynTypeDefnSimpleRepr.Record (_, fields, _) -> List.iter walkField fields | SynTypeDefnSimpleRepr.TypeAbbrev (_, t, _) -> walkType t | _ -> () - - and walkComponentInfo isTypeExtensionOrAlias (SynComponentInfo(Attributes attrs, TyparsAndConstraints (typars, cs1), cs2, longIdent, _, _, _, _)) = + + and walkComponentInfo + isTypeExtensionOrAlias + (SynComponentInfo (Attributes attrs, TyparsAndConstraints (typars, cs1), cs2, longIdent, _, _, _, _)) + = let constraints = cs1 @ cs2 List.iter walkAttribute attrs List.iter walkTyparDecl typars List.iter walkTypeConstraint constraints - if isTypeExtensionOrAlias then - addLongIdent longIdent - - and walkTypeDefnRepr = function + if isTypeExtensionOrAlias then addLongIdent longIdent + + and walkTypeDefnRepr = + function | SynTypeDefnRepr.ObjectModel (_, defns, _) -> List.iter walkMember defns - | SynTypeDefnRepr.Simple(defn, _) -> walkTypeDefnSimple defn + | SynTypeDefnRepr.Simple (defn, _) -> walkTypeDefnSimple defn | SynTypeDefnRepr.Exception _ -> () - - and walkTypeDefnSigRepr = function + + and walkTypeDefnSigRepr = + function | SynTypeDefnSigRepr.ObjectModel (_, defns, _) -> List.iter walkMemberSig defns - | SynTypeDefnSigRepr.Simple(defn, _) -> walkTypeDefnSimple defn + | SynTypeDefnSigRepr.Simple (defn, _) -> walkTypeDefnSimple defn | SynTypeDefnSigRepr.Exception _ -> () - - and walkTypeDefn (SynTypeDefn (typeInfo=info; typeRepr=repr; members=members; implicitConstructor=implicitCtor)) = + + and walkTypeDefn (SynTypeDefn (typeInfo = info; typeRepr = repr; members = members; implicitConstructor = implicitCtor)) = let isTypeExtensionOrAlias = match repr with - | SynTypeDefnRepr.ObjectModel (kind=SynTypeDefnKind.Augmentation _) + | SynTypeDefnRepr.ObjectModel(kind = SynTypeDefnKind.Augmentation _) | SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Abbrev, _, _) | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.TypeAbbrev _, _) -> true | _ -> false + walkComponentInfo isTypeExtensionOrAlias info walkTypeDefnRepr repr List.iter walkMember members Option.iter walkMember implicitCtor - + and walkSynModuleDecl (decl: SynModuleDecl) = match decl with | SynModuleDecl.NamespaceFragment fragment -> walkSynModuleOrNamespace fragment - | SynModuleDecl.NestedModule (moduleInfo=info; decls=modules) -> + | SynModuleDecl.NestedModule (moduleInfo = info; decls = modules) -> walkComponentInfo false info List.iter walkSynModuleDecl modules | SynModuleDecl.Let (_, bindings, _) -> List.iter walkBinding bindings @@ -1588,98 +1799,118 @@ module ParsedInput = | SynModuleDecl.Types (types, _) -> List.iter walkTypeDefn types | SynModuleDecl.Attributes (Attributes attrs, _) -> List.iter walkAttribute attrs | _ -> () - + match parsedInput with - | ParsedInput.ImplFile input -> - walkImplFileInput input + | ParsedInput.ImplFile input -> walkImplFileInput input | _ -> () //debug "%A" idents upcast identsByEndPos - + let GetLongIdentAt parsedInput pos = let idents = getLongIdents parsedInput + match idents.TryGetValue pos with | true, idents -> Some idents | _ -> None type Scope = - { ShortIdents: ShortIdents - Kind: ScopeKind } + { + ShortIdents: ShortIdents + Kind: ScopeKind + } - let tryFindNearestPointAndModules (currentLine: int) (ast: ParsedInput) (insertionPoint: OpenStatementInsertionPoint) = + let tryFindNearestPointAndModules (currentLine: int) (ast: ParsedInput) (insertionPoint: OpenStatementInsertionPoint) = // We ignore all diagnostics during this operation // // Based on an initial review, no diagnostics should be generated. However the code should be checked more closely. - use _ignoreAllDiagnostics = new DiagnosticsScope() + use _ignoreAllDiagnostics = new DiagnosticsScope() let mutable result = None let mutable ns = None - let modules = ResizeArray() + let modules = ResizeArray() let inline longIdentToIdents ident = ident |> Seq.map string |> Seq.toArray - + let addModule (longIdent: LongIdent, range: range) = - modules.Add - { Idents = longIdentToIdents longIdent - Range = range } + modules.Add + { + Idents = longIdentToIdents longIdent + Range = range + } let doRange kind (scope: LongIdent) line col = if line <= currentLine then match result, insertionPoint with - | None, _ -> - result <- Some ({ ShortIdents = longIdentToIdents scope; Kind = kind }, mkPos line col, false) + | None, _ -> + result <- + Some( + { + ShortIdents = longIdentToIdents scope + Kind = kind + }, + mkPos line col, + false + ) | Some (_, _, true), _ -> () | Some (oldScope, oldPos, false), OpenStatementInsertionPoint.TopLevel when kind <> OpenDeclaration -> - result <- Some (oldScope, oldPos, true) + result <- Some(oldScope, oldPos, true) | Some (oldScope, oldPos, _), _ -> match kind, oldScope.Kind with - | (Namespace | NestedModule | TopModule), OpenDeclaration + | (Namespace + | NestedModule + | TopModule), + OpenDeclaration | _ when oldPos.Line <= line -> result <- - Some ({ ShortIdents = - match scope with - | [] -> oldScope.ShortIdents + Some( + { + ShortIdents = + match scope with + | [] -> oldScope.ShortIdents | _ -> longIdentToIdents scope - Kind = kind }, - mkPos line col, - false) + Kind = kind + }, + mkPos line col, + false + ) | _ -> () let getMinColumn decls = match decls with | [] -> None - | firstDecl :: _ -> + | firstDecl :: _ -> match firstDecl with - | SynModuleDecl.NestedModule (range=r) - | SynModuleDecl.Let (range=r) - | SynModuleDecl.Expr (range=r) - | SynModuleDecl.Types (range=r) - | SynModuleDecl.Exception (range=r) - | SynModuleDecl.Open (range=r) - | SynModuleDecl.HashDirective (range=r) -> Some r + | SynModuleDecl.NestedModule (range = r) + | SynModuleDecl.Let (range = r) + | SynModuleDecl.Expr (range = r) + | SynModuleDecl.Types (range = r) + | SynModuleDecl.Exception (range = r) + | SynModuleDecl.Open (range = r) + | SynModuleDecl.HashDirective (range = r) -> Some r | _ -> None |> Option.map (fun r -> r.StartColumn) - - let rec walkImplFileInput (ParsedImplFileInput (modules = moduleOrNamespaceList)) = + let rec walkImplFileInput (ParsedImplFileInput (modules = moduleOrNamespaceList)) = List.iter (walkSynModuleOrNamespace []) moduleOrNamespaceList - and walkSynModuleOrNamespace (parent: LongIdent) (SynModuleOrNamespace(longId = ident; kind = kind; decls = decls; range = range)) = + and walkSynModuleOrNamespace + (parent: LongIdent) + (SynModuleOrNamespace (longId = ident; kind = kind; decls = decls; range = range)) + = if range.EndLine >= currentLine then let isModule = kind.IsModule + match isModule, parent, ident with - | false, _, _ -> ns <- Some (longIdentToIdents ident) + | false, _, _ -> ns <- Some(longIdentToIdents ident) // top level module with "inlined" namespace like Ns1.Ns2.TopModule - | true, [], _f :: _s :: _ -> + | true, [], _f :: _s :: _ -> let ident = longIdentToIdents ident - ns <- Some ident[0..ident.Length - 2] + ns <- Some ident[0 .. ident.Length - 2] | _ -> () - + let fullIdent = parent @ ident - let startLine = - if isModule then range.StartLine - else range.StartLine - 1 + let startLine = if isModule then range.StartLine else range.StartLine - 1 let scopeKind = match isModule, parent with @@ -1694,18 +1925,21 @@ module ParsedInput = and walkSynModuleDecl (parent: LongIdent) (decl: SynModuleDecl) = match decl with | SynModuleDecl.NamespaceFragment fragment -> walkSynModuleOrNamespace parent fragment - | SynModuleDecl.NestedModule(moduleInfo=SynComponentInfo(longId=ident); decls=decls; range=range) -> + | SynModuleDecl.NestedModule (moduleInfo = SynComponentInfo (longId = ident); decls = decls; range = range) -> let fullIdent = parent @ ident addModule (fullIdent, range) + if range.EndLine >= currentLine then - let moduleBodyIndentation = getMinColumn decls |> Option.defaultValue (range.StartColumn + 4) + let moduleBodyIndentation = + getMinColumn decls |> Option.defaultValue (range.StartColumn + 4) + doRange NestedModule fullIdent range.StartLine moduleBodyIndentation List.iter (walkSynModuleDecl fullIdent) decls | SynModuleDecl.Open (_, range) -> doRange OpenDeclaration [] range.EndLine (range.StartColumn - 5) | SynModuleDecl.HashDirective (_, range) -> doRange HashDirective [] range.EndLine range.StartColumn | _ -> () - match ast with + match ast with | ParsedInput.SigFile _ -> () | ParsedInput.ImplFile input -> walkImplFileInput input @@ -1714,9 +1948,9 @@ module ParsedInput = |> Option.map (fun (scope, pos, _) -> let ns = ns |> Option.map longIdentToIdents scope, ns, mkPos (pos.Line + 1) pos.Column) - - let modules = - modules + + let modules = + modules |> Seq.filter (fun x -> x.Range.EndLine < currentLine) |> Seq.sortBy (fun x -> -x.Idents.Length) |> Seq.toList @@ -1732,52 +1966,80 @@ module ParsedInput = match scope.Kind with | TopModule -> NestedModule | x -> x - { ScopeKind = scopeKind - Pos = mkPos (Line.fromZ m.Range.EndLine) m.Range.StartColumn } - let TryFindInsertionContext (currentLine: int) (parsedInput: ParsedInput) (partiallyQualifiedName: MaybeUnresolvedIdent[]) (insertionPoint: OpenStatementInsertionPoint) = - let res, modules = tryFindNearestPointAndModules currentLine parsedInput insertionPoint - fun (requiresQualifiedAccessParent: ShortIdents option, autoOpenParent: ShortIdents option, entityNamespace: ShortIdents option, entity: ShortIdents) -> + { + ScopeKind = scopeKind + Pos = mkPos (Line.fromZ m.Range.EndLine) m.Range.StartColumn + } + + let TryFindInsertionContext + (currentLine: int) + (parsedInput: ParsedInput) + (partiallyQualifiedName: MaybeUnresolvedIdent[]) + (insertionPoint: OpenStatementInsertionPoint) + = + let res, modules = + tryFindNearestPointAndModules currentLine parsedInput insertionPoint + + fun (requiresQualifiedAccessParent: ShortIdents option, + autoOpenParent: ShortIdents option, + entityNamespace: ShortIdents option, + entity: ShortIdents) -> // We ignore all diagnostics during this operation // // Based on an initial review, no diagnostics should be generated. However the code should be checked more closely. - use _ignoreAllDiagnostics = new DiagnosticsScope() + use _ignoreAllDiagnostics = new DiagnosticsScope() + match res with | None -> [||] - | Some (scope, ns, pos) -> - Entity.tryCreate(ns, scope.ShortIdents, partiallyQualifiedName, requiresQualifiedAccessParent, autoOpenParent, entityNamespace, entity) + | Some (scope, ns, pos) -> + Entity.tryCreate ( + ns, + scope.ShortIdents, + partiallyQualifiedName, + requiresQualifiedAccessParent, + autoOpenParent, + entityNamespace, + entity + ) |> Array.map (fun e -> e, findBestPositionToInsertOpenDeclaration modules scope pos entity) /// Corrects insertion line number based on kind of scope and text surrounding the insertion point. - let AdjustInsertionPoint (getLineStr: int -> string) ctx = + let AdjustInsertionPoint (getLineStr: int -> string) ctx = let line = match ctx.ScopeKind with | ScopeKind.TopModule -> if ctx.Pos.Line > 1 then - // it's an implicit module without any open declarations + // it's an implicit module without any open declarations let line = getLineStr (ctx.Pos.Line - 2) + let isImplicitTopLevelModule = not (line.StartsWithOrdinal("module") && not (line.EndsWithOrdinal("="))) + if isImplicitTopLevelModule then 1 else ctx.Pos.Line - else 1 + else + 1 | ScopeKind.Namespace -> // For namespaces the start line is start line of the first nested entity - // If we are not on the first line, try to find opening namespace, and return line after it (in F# format) + // If we are not on the first line, try to find opening namespace, and return line after it (in F# format) if ctx.Pos.Line > 1 then - [0..ctx.Pos.Line - 1] + [ 0 .. ctx.Pos.Line - 1 ] |> List.mapi (fun i line -> i, getLineStr line) - |> List.tryPick (fun (i, lineStr) -> - if lineStr.StartsWithOrdinal("namespace") then Some i - else None) + |> List.tryPick (fun (i, lineStr) -> + if lineStr.StartsWithOrdinal("namespace") then + Some i + else + None) |> function // move to the next line below "namespace" and convert it to F# 1-based line number - | Some line -> line + 2 + | Some line -> line + 2 | None -> ctx.Pos.Line // If we are on 1st line in the namespace ctx, this line _should_ be the namespace declaration, check it and return next line. // Otherwise, return first line (which theoretically should not happen). else let lineStr = getLineStr (ctx.Pos.Line - 1) + if lineStr.StartsWithOrdinal("namespace") then ctx.Pos.Line + 1 else @@ -1785,12 +2047,18 @@ module ParsedInput = | _ -> ctx.Pos.Line mkPos line ctx.Pos.Column - - let FindNearestPointToInsertOpenDeclaration (currentLine: int) (parsedInput: ParsedInput) (entity: ShortIdents) (insertionPoint: OpenStatementInsertionPoint) = + + let FindNearestPointToInsertOpenDeclaration + (currentLine: int) + (parsedInput: ParsedInput) + (entity: ShortIdents) + (insertionPoint: OpenStatementInsertionPoint) + = match tryFindNearestPointAndModules currentLine parsedInput insertionPoint with - | Some (scope, _, point), modules -> - findBestPositionToInsertOpenDeclaration modules scope point entity + | Some (scope, _, point), modules -> findBestPositionToInsertOpenDeclaration modules scope point entity | _ -> - // we failed to find insertion point because ast is empty for some reason, return top left point in this case - { ScopeKind = ScopeKind.TopModule - Pos = mkPos 1 0 } + // we failed to find insertion point because ast is empty for some reason, return top left point in this case + { + ScopeKind = ScopeKind.TopModule + Pos = mkPos 1 0 + } diff --git a/src/Compiler/Service/ServiceStructure.fs b/src/Compiler/Service/ServiceStructure.fs index bc9f5255c3ee..50d996c88507 100644 --- a/src/Compiler/Service/ServiceStructure.fs +++ b/src/Compiler/Service/ServiceStructure.fs @@ -17,42 +17,46 @@ module Structure = module Range = /// Create a range starting at the end of r1 and finishing at the end of r2 - let endToEnd (r1: range) (r2: range) = mkFileIndexRange r1.FileIndex r1.End r2.End + let endToEnd (r1: range) (r2: range) = + mkFileIndexRange r1.FileIndex r1.End r2.End /// Create a range starting at the end of r1 and finishing at the start of r2 - let endToStart (r1: range) (r2: range) = mkFileIndexRange r1.FileIndex r1.End r2.Start + let endToStart (r1: range) (r2: range) = + mkFileIndexRange r1.FileIndex r1.End r2.Start /// Create a range beginning at the start of r1 and finishing at the end of r2 - let startToEnd (r1: range) (r2: range) = mkFileIndexRange r1.FileIndex r1.Start r2.End + let startToEnd (r1: range) (r2: range) = + mkFileIndexRange r1.FileIndex r1.Start r2.End /// Create a range beginning at the start of r1 and finishing at the start of r2 - let startToStart (r1: range) (r2: range) = mkFileIndexRange r1.FileIndex r1.Start r2.Start + let startToStart (r1: range) (r2: range) = + mkFileIndexRange r1.FileIndex r1.Start r2.Start /// Create a new range from r by shifting the starting column by m - let modStart (m:int) (r: range) = - let modstart = mkPos r.StartLine (r.StartColumn+m) + let modStart (m: int) (r: range) = + let modstart = mkPos r.StartLine (r.StartColumn + m) mkFileIndexRange r.FileIndex modstart r.End /// Create a new range from r by shifting the ending column by m - let modEnd (m:int) (r: range) = - let modend = mkPos r.EndLine (r.EndColumn+m) + let modEnd (m: int) (r: range) = + let modend = mkPos r.EndLine (r.EndColumn + m) mkFileIndexRange r.FileIndex r.Start modend /// Produce a new range by adding modStart to the StartColumn of `r` /// and subtracting modEnd from the EndColumn of `r` - let modBoth modStart modEnd (r:range) = - let rStart = mkPos r.StartLine (r.StartColumn+modStart) - let rEnd = mkPos r.EndLine (r.EndColumn - modEnd) + let modBoth modStart modEnd (r: range) = + let rStart = mkPos r.StartLine (r.StartColumn + modStart) + let rEnd = mkPos r.EndLine (r.EndColumn - modEnd) mkFileIndexRange r.FileIndex rStart rEnd - let longIdentRange (longId:LongIdent) = - match longId with + let longIdentRange (longId: LongIdent) = + match longId with | [] -> range0 | head :: _ -> Range.startToEnd head.idRange (List.last longId).idRange - /// Calculate the range of the provided type arguments (<'a, ..., 'z>) + /// Calculate the range of the provided type arguments (<'a, ..., 'z>) /// or return the range `other` when `typeArgs` = [] - let rangeOfTypeArgsElse other (typeArgs:SynTyparDecl list) = + let rangeOfTypeArgsElse other (typeArgs: SynTyparDecl list) = match typeArgs with | [] -> other | ls -> @@ -60,16 +64,16 @@ module Structure = |> List.map (fun (SynTyparDecl (_, typarg)) -> typarg.Range) |> List.reduce unionRanges - let rangeOfSynPatsElse other (synPats:SynSimplePat list) = + let rangeOfSynPatsElse other (synPats: SynSimplePat list) = match synPats with | [] -> other | ls -> - ls + ls |> List.map (fun x -> - match x with - | SynSimplePat.Attrib(range = r) - | SynSimplePat.Id(range = r) - | SynSimplePat.Typed(range = r) -> r) + match x with + | SynSimplePat.Attrib (range = r) + | SynSimplePat.Id (range = r) + | SynSimplePat.Typed (range = r) -> r) |> List.reduce unionRanges /// Collapse indicates the way a range/snapshot should be collapsed. `Same` is for a scope inside @@ -130,92 +134,105 @@ module Structure = | Comment | XmlDocComment - override self.ToString() = + override self.ToString() = match self with - | Open -> "Open" - | Namespace -> "Namespace" - | Module -> "Module" - | Type -> "Type" - | Member -> "Member" - | LetOrUse -> "LetOrUse" - | Val -> "Val" - | ComputationExpr -> "ComputationExpr" - | IfThenElse -> "IfThenElse" - | ThenInIfThenElse -> "ThenInIfThenElse" - | ElseInIfThenElse -> "ElseInIfThenElse" - | TryWith -> "TryWith" - | TryInTryWith -> "TryInTryWith" - | WithInTryWith -> "WithInTryWith" - | TryFinally -> "TryFinally" - | TryInTryFinally -> "TryInTryFinally" + | Open -> "Open" + | Namespace -> "Namespace" + | Module -> "Module" + | Type -> "Type" + | Member -> "Member" + | LetOrUse -> "LetOrUse" + | Val -> "Val" + | ComputationExpr -> "ComputationExpr" + | IfThenElse -> "IfThenElse" + | ThenInIfThenElse -> "ThenInIfThenElse" + | ElseInIfThenElse -> "ElseInIfThenElse" + | TryWith -> "TryWith" + | TryInTryWith -> "TryInTryWith" + | WithInTryWith -> "WithInTryWith" + | TryFinally -> "TryFinally" + | TryInTryFinally -> "TryInTryFinally" | FinallyInTryFinally -> "FinallyInTryFinally" - | ArrayOrList -> "ArrayOrList" - | ObjExpr -> "ObjExpr" - | For -> "For" - | While -> "While" - | Match -> "Match" - | MatchBang -> "MatchBang" - | MatchLambda -> "MatchLambda" - | MatchClause -> "MatchClause" - | Lambda -> "Lambda" - | Quote -> "Quote" - | Record -> "Record" - | SpecialFunc -> "SpecialFunc" - | Do -> "Do" - | New -> "New" - | Attribute -> "Attribute" - | Interface -> "Interface" - | HashDirective -> "HashDirective" - | LetOrUseBang -> "LetOrUseBang" - | TypeExtension -> "TypeExtension" - | YieldOrReturn -> "YieldOrReturn" - | YieldOrReturnBang -> "YieldOrReturnBang" - | Tuple -> "Tuple" - | UnionCase -> "UnionCase" - | EnumCase -> "EnumCase" - | RecordField -> "RecordField" - | RecordDefn -> "RecordDefn" - | UnionDefn -> "UnionDefn" - | Comment -> "Comment" - | XmlDocComment -> "XmlDocComment" + | ArrayOrList -> "ArrayOrList" + | ObjExpr -> "ObjExpr" + | For -> "For" + | While -> "While" + | Match -> "Match" + | MatchBang -> "MatchBang" + | MatchLambda -> "MatchLambda" + | MatchClause -> "MatchClause" + | Lambda -> "Lambda" + | Quote -> "Quote" + | Record -> "Record" + | SpecialFunc -> "SpecialFunc" + | Do -> "Do" + | New -> "New" + | Attribute -> "Attribute" + | Interface -> "Interface" + | HashDirective -> "HashDirective" + | LetOrUseBang -> "LetOrUseBang" + | TypeExtension -> "TypeExtension" + | YieldOrReturn -> "YieldOrReturn" + | YieldOrReturnBang -> "YieldOrReturnBang" + | Tuple -> "Tuple" + | UnionCase -> "UnionCase" + | EnumCase -> "EnumCase" + | RecordField -> "RecordField" + | RecordDefn -> "RecordDefn" + | UnionDefn -> "UnionDefn" + | Comment -> "Comment" + | XmlDocComment -> "XmlDocComment" /// Stores the range for a construct, the sub-range that should be collapsed for outlining, /// a tag for the construct type, and a tag for the collapse style [] - type ScopeRange = - { Scope: Scope - Collapse: Collapse - /// HintSpan in BlockSpan - Range: range - /// TextSpan in BlockSpan - CollapseRange: range } + type ScopeRange = + { + Scope: Scope + Collapse: Collapse + /// HintSpan in BlockSpan + Range: range + /// TextSpan in BlockSpan + CollapseRange: range + } type LineNumber = int type LineStr = string - type CommentType = SingleLine | XmlDoc + + type CommentType = + | SingleLine + | XmlDoc [] type CommentList = - { Lines: ResizeArray - Type: CommentType } + { + Lines: ResizeArray + Type: CommentType + } + static member New ty lineStr = - { Type = ty - Lines = ResizeArray [lineStr] } + { + Type = ty + Lines = ResizeArray [ lineStr ] + } - /// Returns outlining ranges for given parsed input. + /// Returns outlining ranges for given parsed input. let getOutliningRanges (sourceLines: string[]) (parsedInput: ParsedInput) = let acc = ResizeArray() /// Validation function to ensure that ranges yielded for outlining span 2 or more lines - let inline rcheck scope collapse (fullRange: range) (collapseRange: range) = - if fullRange.StartLine <> fullRange.EndLine then - acc.Add { Scope = scope - Collapse = collapse - Range = fullRange - CollapseRange = collapseRange } - - //============================================// - // Implementation File AST Traversal // + let inline rcheck scope collapse (fullRange: range) (collapseRange: range) = + if fullRange.StartLine <> fullRange.EndLine then + acc.Add + { + Scope = scope + Collapse = collapse + Range = fullRange + CollapseRange = collapseRange + } + + //============================================// + // Implementation File AST Traversal // //============================================// let rec parseExpr expr = @@ -228,11 +245,10 @@ module Structure = | SynExpr.DotGet (e, _, _, _) | SynExpr.Do (e, _) | SynExpr.Typed (e, _, _) - | SynExpr.DotIndexedGet (e, _, _, _) -> - parseExpr e + | SynExpr.DotIndexedGet (e, _, _, _) -> parseExpr e | SynExpr.Set (e1, e2, _) | SynExpr.DotSet (e1, _, e2, _) - | SynExpr.DotIndexedSet (e1, _, e2, _, _, _) -> + | SynExpr.DotIndexedSet (e1, _, e2, _, _, _) -> parseExpr e1 parseExpr e2 | SynExpr.New (_, _, expr, r) -> @@ -247,10 +263,10 @@ module Structure = | SynExpr.DoBang (e, r) -> rcheck Scope.Do Collapse.Below r <| Range.modStart 3 r parseExpr e - | SynExpr.LetOrUseBang (pat=pat; rhs=eLet; andBangs=es; body=eBody) -> + | SynExpr.LetOrUseBang (pat = pat; rhs = eLet; andBangs = es; body = eBody) -> [ yield eLet - for SynExprAndBang(body = eAndBang) in es do + for SynExprAndBang (body = eAndBang) in es do yield eAndBang ] |> List.iter (fun e -> @@ -260,57 +276,78 @@ module Structure = // tooltip creation let r = Range.endToEnd pat.Range e.Range rcheck Scope.LetOrUseBang Collapse.Below r r - parseExpr e - ) + parseExpr e) + parseExpr eBody - | SynExpr.For (doBody=e; range=r) + | SynExpr.For (doBody = e; range = r) | SynExpr.ForEach (_, _, _, _, _, _, e, r) -> rcheck Scope.For Collapse.Below r r parseExpr e - | SynExpr.LetOrUse (bindings=bindings; body=body) -> + | SynExpr.LetOrUse (bindings = bindings; body = body) -> parseBindings bindings parseExpr body - | SynExpr.Match (matchDebugPoint=seqPointAtBinding; clauses=clauses; range=r) - | SynExpr.MatchBang (matchDebugPoint=seqPointAtBinding; clauses=clauses; range=r) -> + | SynExpr.Match (matchDebugPoint = seqPointAtBinding; clauses = clauses; range = r) + | SynExpr.MatchBang (matchDebugPoint = seqPointAtBinding; clauses = clauses; range = r) -> match seqPointAtBinding with | DebugPointAtBinding.Yes sr -> let collapse = Range.endToEnd sr r rcheck Scope.Match Collapse.Same r collapse | _ -> () + List.iter parseMatchClause clauses | SynExpr.MatchLambda (_, caseRange, clauses, matchSeqPoint, r) -> let caseRange = match matchSeqPoint with | DebugPointAtBinding.Yes r -> r | _ -> caseRange + let collapse = Range.endToEnd caseRange r rcheck Scope.MatchLambda Collapse.Same r collapse List.iter parseMatchClause clauses | SynExpr.App (atomicFlag, isInfix, funcExpr, argExpr, r) -> // seq exprs, custom operators, etc - if ExprAtomicFlag.NonAtomic=atomicFlag && (not isInfix) - && (function SynExpr.Ident _ -> true | _ -> false) funcExpr - && (function SynExpr.ComputationExpr _ -> false | _ -> true ) argExpr then - // if the argExpr is a computation expression another match will handle the outlining - // these cases must be removed to prevent creating unnecessary tags for the same scope + if ExprAtomicFlag.NonAtomic = atomicFlag + && (not isInfix) + && (function + | SynExpr.Ident _ -> true + | _ -> false) + funcExpr + && (function + | SynExpr.ComputationExpr _ -> false + | _ -> true) + argExpr then + // if the argExpr is a computation expression another match will handle the outlining + // these cases must be removed to prevent creating unnecessary tags for the same scope let collapse = Range.endToEnd funcExpr.Range r rcheck Scope.SpecialFunc Collapse.Below r collapse - elif ExprAtomicFlag.NonAtomic=atomicFlag && (not isInfix) - && (function SynExpr.ComputationExpr _ -> true | _ -> false) argExpr then - let collapse = Range.startToEnd argExpr.Range r - rcheck Scope.ComputationExpr Collapse.Same r <| Range.modBoth 1 1 collapse + elif ExprAtomicFlag.NonAtomic = atomicFlag + && (not isInfix) + && (function + | SynExpr.ComputationExpr _ -> true + | _ -> false) + argExpr then + let collapse = Range.startToEnd argExpr.Range r + rcheck Scope.ComputationExpr Collapse.Same r <| Range.modBoth 1 1 collapse + parseExpr argExpr parseExpr funcExpr | SynExpr.Sequential (_, _, e1, e2, _) -> parseExpr e1 parseExpr e2 | SynExpr.ArrayOrListComputed (isArray, e, r) -> - rcheck Scope.ArrayOrList Collapse.Same r <| Range.modBoth (if isArray then 2 else 1) (if isArray then 2 else 1) r - parseExpr e - | SynExpr.ComputationExpr (_, e, _r) as _c -> + rcheck Scope.ArrayOrList Collapse.Same r + <| Range.modBoth (if isArray then 2 else 1) (if isArray then 2 else 1) r + parseExpr e - | SynExpr.ObjExpr (argOptions=argOpt; bindings=bindings; members=ms; extraImpls=extraImpls; newExprRange=newRange; range=wholeRange) as _objExpr -> + | SynExpr.ComputationExpr (_, e, _r) as _c -> parseExpr e + | SynExpr.ObjExpr (argOptions = argOpt + bindings = bindings + members = ms + extraImpls = extraImpls + newExprRange = newRange + range = wholeRange) as _objExpr -> let bindings = unionBindingAndMembers bindings ms + match argOpt with | Some (args, _) -> let collapse = Range.endToEnd args.Range wholeRange @@ -318,11 +355,12 @@ module Structure = | None -> let collapse = Range.endToEnd newRange wholeRange rcheck Scope.ObjExpr Collapse.Below wholeRange collapse + parseBindings bindings parseExprInterfaces extraImpls | SynExpr.TryWith (e, matchClauses, wholeRange, tryPoint, withPoint, _trivia) -> match tryPoint, withPoint with - | DebugPointAtTry.Yes tryRange, DebugPointAtWith.Yes withRange -> + | DebugPointAtTry.Yes tryRange, DebugPointAtWith.Yes withRange -> let fullrange = Range.startToEnd tryRange wholeRange let collapse = Range.endToEnd tryRange wholeRange let collapseTry = Range.endToStart tryRange withRange @@ -333,6 +371,7 @@ module Structure = rcheck Scope.TryInTryWith Collapse.Below fullrangeTry collapseTry rcheck Scope.WithInTryWith Collapse.Below fullrangeWith collapseWith | _ -> () + parseExpr e List.iter parseMatchClause matchClauses | SynExpr.TryFinally (tryExpr, finallyExpr, r, tryPoint, finallyPoint, _trivia) -> @@ -343,29 +382,36 @@ module Structure = let collapseFinally = Range.endToEnd finallyRange r let fullrangeFinally = Range.startToEnd finallyRange r rcheck Scope.TryFinally Collapse.Below fullrange collapse - rcheck Scope.FinallyInTryFinally Collapse.Below fullrangeFinally collapseFinally + rcheck Scope.FinallyInTryFinally Collapse.Below fullrangeFinally collapseFinally | _ -> () + parseExpr tryExpr parseExpr finallyExpr - | SynExpr.IfThenElse (ifExpr=ifExpr; thenExpr=thenExpr; elseExpr=elseExprOpt; spIfToThen=spIfToThen; range=r; trivia=trivia) -> + | SynExpr.IfThenElse (ifExpr = ifExpr + thenExpr = thenExpr + elseExpr = elseExprOpt + spIfToThen = spIfToThen + range = r + trivia = trivia) -> match spIfToThen with | DebugPointAtBinding.Yes rt -> // Outline the entire IfThenElse let fullrange = Range.startToEnd rt r - let collapse = Range.endToEnd ifExpr.Range r + let collapse = Range.endToEnd ifExpr.Range r rcheck Scope.IfThenElse Collapse.Below fullrange collapse // Outline the `then` scope - let thenRange = Range.endToEnd (Range.modEnd -4 trivia.IfToThenRange) thenExpr.Range + let thenRange = Range.endToEnd (Range.modEnd -4 trivia.IfToThenRange) thenExpr.Range let thenCollapse = Range.endToEnd trivia.IfToThenRange thenExpr.Range rcheck Scope.ThenInIfThenElse Collapse.Below thenRange thenCollapse | _ -> () + parseExpr ifExpr parseExpr thenExpr + match elseExprOpt with | Some elseExpr -> match elseExpr with // prevent double collapsing on elifs - | SynExpr.IfThenElse _ -> - parseExpr elseExpr + | SynExpr.IfThenElse _ -> parseExpr elseExpr | _ -> // This is not the best way to establish the position of `else` // the AST doesn't provide an easy way to find the position of the keyword @@ -376,11 +422,11 @@ module Structure = | SynExpr.While (_, _, e, r) -> rcheck Scope.While Collapse.Below r r parseExpr e - | SynExpr.Lambda (args=pats; body=e; range=r) -> + | SynExpr.Lambda (args = pats; body = e; range = r) -> match pats with | SynSimplePats.SimplePats (_, pr) - | SynSimplePats.Typed (_, _, pr) -> - rcheck Scope.Lambda Collapse.Below r (Range.endToEnd pr r) + | SynSimplePats.Typed (_, _, pr) -> rcheck Scope.Lambda Collapse.Below r (Range.endToEnd pr r) + parseExpr e | SynExpr.Lazy (e, r) -> rcheck Scope.SpecialFunc Collapse.Below r r @@ -392,72 +438,82 @@ module Structure = | SynExpr.Tuple (_, es, _, r) -> rcheck Scope.Tuple Collapse.Same r r List.iter parseExpr es - | SynExpr.Paren (e, _, _, _) -> - parseExpr e + | SynExpr.Paren (e, _, _, _) -> parseExpr e | SynExpr.Record (recCtor, recCopy, recordFields, r) -> match recCtor with | Some (_, ctorArgs, _, _, _) -> parseExpr ctorArgs | _ -> () + match recCopy with | Some (e, _) -> parseExpr e | _ -> () - recordFields |> List.choose (fun (SynExprRecordField(expr=e)) -> e) |> List.iter parseExpr + + recordFields + |> List.choose (fun (SynExprRecordField (expr = e)) -> e) + |> List.iter parseExpr // exclude the opening `{` and closing `}` of the record from collapsing rcheck Scope.Record Collapse.Same r <| Range.modBoth 1 1 r | _ -> () - and parseMatchClause (SynMatchClause(pat=synPat; resultExpr=e) as clause) = - let rec getLastPat = function - | SynPat.Or(rhsPat=pat) -> getLastPat pat + and parseMatchClause (SynMatchClause (pat = synPat; resultExpr = e) as clause) = + let rec getLastPat = + function + | SynPat.Or (rhsPat = pat) -> getLastPat pat | x -> x let synPat = getLastPat synPat - let collapse = Range.endToEnd synPat.Range clause.Range // Collapse the scope starting with `->` + let collapse = Range.endToEnd synPat.Range clause.Range // Collapse the scope starting with `->` rcheck Scope.MatchClause Collapse.Same e.Range collapse parseExpr e and parseAttributes (Attributes attrs) = - let attrListRange() = + let attrListRange () = if not (List.isEmpty attrs) then - let range = Range.startToEnd attrs[0].Range attrs[attrs.Length-1].ArgExpr.Range + let range = Range.startToEnd attrs[0].Range attrs[attrs.Length - 1].ArgExpr.Range rcheck Scope.Attribute Collapse.Same range range - match attrs with + match attrs with | [] -> () - | [_] -> attrListRange() + | [ _ ] -> attrListRange () | head :: tail -> - attrListRange() + attrListRange () parseExpr head.ArgExpr // If there are more than 2 attributes only add tags to the 2nd and beyond, to avoid double collapsing on the first attribute for attr in tail do let range = Range.startToEnd attr.Range attr.ArgExpr.Range rcheck Scope.Attribute Collapse.Same range range - + // visit the expressions inside each attribute for attr in attrs do parseExpr attr.ArgExpr - and parseBinding (SynBinding(kind=kind; attributes=attrs; valData=SynValData(memberFlags=memberFlags); expr=expr; range=br) as binding) = + and parseBinding + (SynBinding (kind = kind; attributes = attrs; valData = SynValData (memberFlags = memberFlags); expr = expr; range = br) as binding) + = match kind with | SynBindingKind.Normal -> - let collapse = Range.endToEnd binding.RangeOfBindingWithoutRhs binding.RangeOfBindingWithRhs + let collapse = + Range.endToEnd binding.RangeOfBindingWithoutRhs binding.RangeOfBindingWithRhs + match memberFlags with - | Some {MemberKind=SynMemberKind.Constructor} -> - rcheck Scope.New Collapse.Below binding.RangeOfBindingWithRhs collapse - | Some _ -> - rcheck Scope.Member Collapse.Below binding.RangeOfBindingWithRhs collapse - | None -> - rcheck Scope.LetOrUse Collapse.Below binding.RangeOfBindingWithRhs collapse + | Some { + MemberKind = SynMemberKind.Constructor + } -> rcheck Scope.New Collapse.Below binding.RangeOfBindingWithRhs collapse + | Some _ -> rcheck Scope.Member Collapse.Below binding.RangeOfBindingWithRhs collapse + | None -> rcheck Scope.LetOrUse Collapse.Below binding.RangeOfBindingWithRhs collapse | SynBindingKind.Do -> let r = Range.modStart 2 br rcheck Scope.Do Collapse.Below br r | _ -> () + parseAttributes attrs parseExpr expr - and parseBindings sqs = for bind in sqs do parseBinding bind + and parseBindings sqs = + for bind in sqs do + parseBinding bind - and parseExprInterface (SynInterfaceImpl(interfaceTy=synType; bindings=bindings; range=range)) = + and parseExprInterface (SynInterfaceImpl (interfaceTy = synType; bindings = bindings; range = range)) = let collapse = Range.endToEnd synType.Range range |> Range.modEnd -1 rcheck Scope.Interface Collapse.Below range collapse parseBindings bindings @@ -466,42 +522,47 @@ module Structure = and parseSynMemberDefn (objectModelRange: range) d = match d with - | SynMemberDefn.Member(SynBinding.SynBinding (attributes=attrs; valData=valData; headPat=synPat; range=bindingRange) as binding, _) -> - match valData with - | SynValData (Some { MemberKind=SynMemberKind.Constructor }, _, _) -> - let collapse = Range.endToEnd synPat.Range d.Range - rcheck Scope.New Collapse.Below d.Range collapse - | SynValData (Some { MemberKind=SynMemberKind.PropertyGet | SynMemberKind.PropertySet }, _, _) -> - let range = - mkRange - d.Range.FileName - (mkPos d.Range.StartLine objectModelRange.StartColumn) - d.Range.End - - let collapse = - match synPat with - | SynPat.LongIdent(longDotId=longIdent) -> - Range.endToEnd longIdent.Range d.Range - | _ -> Range.endToEnd bindingRange d.Range - - rcheck Scope.Member Collapse.Below range collapse - | _ -> - let collapse = Range.endToEnd bindingRange d.Range - rcheck Scope.Member Collapse.Below d.Range collapse - parseAttributes attrs - parseBinding binding - | SynMemberDefn.LetBindings (bindings, _, _, _) -> - parseBindings bindings - | SynMemberDefn.Interface (interfaceType=tp; members=iMembers; range=r) -> + | SynMemberDefn.Member (SynBinding.SynBinding (attributes = attrs; valData = valData; headPat = synPat; range = bindingRange) as binding, + _) -> + match valData with + | SynValData (Some { + MemberKind = SynMemberKind.Constructor + }, + _, + _) -> + let collapse = Range.endToEnd synPat.Range d.Range + rcheck Scope.New Collapse.Below d.Range collapse + | SynValData (Some { + MemberKind = SynMemberKind.PropertyGet | SynMemberKind.PropertySet + }, + _, + _) -> + let range = + mkRange d.Range.FileName (mkPos d.Range.StartLine objectModelRange.StartColumn) d.Range.End + + let collapse = + match synPat with + | SynPat.LongIdent (longDotId = longIdent) -> Range.endToEnd longIdent.Range d.Range + | _ -> Range.endToEnd bindingRange d.Range + + rcheck Scope.Member Collapse.Below range collapse + | _ -> + let collapse = Range.endToEnd bindingRange d.Range + rcheck Scope.Member Collapse.Below d.Range collapse + + parseAttributes attrs + parseBinding binding + | SynMemberDefn.LetBindings (bindings, _, _, _) -> parseBindings bindings + | SynMemberDefn.Interface (interfaceType = tp; members = iMembers; range = r) -> rcheck Scope.Interface Collapse.Below d.Range (Range.endToEnd tp.Range d.Range) + match iMembers with | Some members -> List.iter (parseSynMemberDefn r) members | None -> () - | SynMemberDefn.NestedType (td, _, _) -> - parseTypeDefn td - | SynMemberDefn.AbstractSlot (SynValSig(synType=synt), _, r) -> + | SynMemberDefn.NestedType (td, _, _) -> parseTypeDefn td + | SynMemberDefn.AbstractSlot (SynValSig (synType = synt), _, r) -> rcheck Scope.Member Collapse.Below d.Range (Range.startToEnd synt.Range r) - | SynMemberDefn.AutoProperty (synExpr=e; range=r) -> + | SynMemberDefn.AutoProperty (synExpr = e; range = r) -> rcheck Scope.Member Collapse.Below d.Range r parseExpr e | _ -> () @@ -519,39 +580,46 @@ module Structure = and parseSimpleRepr simple = match simple with | SynTypeDefnSimpleRepr.Enum (cases, _er) -> - for SynEnumCase (attributes=attrs; range=cr) in cases do + for SynEnumCase (attributes = attrs; range = cr) in cases do rcheck Scope.EnumCase Collapse.Below cr cr parseAttributes attrs | SynTypeDefnSimpleRepr.Record (_, fields, rr) -> - rcheck Scope.RecordDefn Collapse.Same rr rr + rcheck Scope.RecordDefn Collapse.Same rr rr + for SynField (attrs, _, _, _, _, _, _, fr) in fields do rcheck Scope.RecordField Collapse.Below fr fr parseAttributes attrs | SynTypeDefnSimpleRepr.Union (_, cases, ur) -> rcheck Scope.UnionDefn Collapse.Same ur ur - for SynUnionCase (attributes=attrs; range=cr) in cases do + + for SynUnionCase (attributes = attrs; range = cr) in cases do rcheck Scope.UnionCase Collapse.Below cr cr parseAttributes attrs | _ -> () - and parseTypeDefn (SynTypeDefn(typeInfo=SynComponentInfo(typeParams=TyparDecls typeArgs; range=r); typeRepr=objectModel; members=members; range=fullrange)) = - let typeArgsRange = rangeOfTypeArgsElse r typeArgs - let collapse = Range.endToEnd (Range.modEnd 1 typeArgsRange) fullrange - match objectModel with - | SynTypeDefnRepr.ObjectModel (defnKind, objMembers, r) -> - match defnKind with - | SynTypeDefnKind.Augmentation _ -> - rcheck Scope.TypeExtension Collapse.Below fullrange collapse - | _ -> - rcheck Scope.Type Collapse.Below fullrange collapse - List.iter (parseSynMemberDefn r) objMembers - // visit the members of a type extension - List.iter (parseSynMemberDefn r) members - | SynTypeDefnRepr.Simple (simpleRepr, r) -> - rcheck Scope.Type Collapse.Below fullrange collapse - parseSimpleRepr simpleRepr - List.iter (parseSynMemberDefn r) members - | SynTypeDefnRepr.Exception _ -> () + and parseTypeDefn + (SynTypeDefn (typeInfo = SynComponentInfo (typeParams = TyparDecls typeArgs; range = r) + typeRepr = objectModel + members = members + range = fullrange)) + = + let typeArgsRange = rangeOfTypeArgsElse r typeArgs + let collapse = Range.endToEnd (Range.modEnd 1 typeArgsRange) fullrange + + match objectModel with + | SynTypeDefnRepr.ObjectModel (defnKind, objMembers, r) -> + match defnKind with + | SynTypeDefnKind.Augmentation _ -> rcheck Scope.TypeExtension Collapse.Below fullrange collapse + | _ -> rcheck Scope.Type Collapse.Below fullrange collapse + + List.iter (parseSynMemberDefn r) objMembers + // visit the members of a type extension + List.iter (parseSynMemberDefn r) members + | SynTypeDefnRepr.Simple (simpleRepr, r) -> + rcheck Scope.Type Collapse.Below fullrange collapse + parseSimpleRepr simpleRepr + List.iter (parseSynMemberDefn r) members + | SynTypeDefnRepr.Exception _ -> () let getConsecutiveModuleDecls (predicate: SynModuleDecl -> range option) (scope: Scope) (decls: SynModuleDecl list) = let groupConsecutiveDecls input = @@ -559,41 +627,64 @@ module Structure = match input, currentBulk with | [], [] -> List.rev res | [], _ -> List.rev (currentBulk :: res) - | r :: rest, [] -> loop rest res [r] - | r :: rest, last :: _ - when r.StartLine = last.EndLine + 1 || - sourceLines[last.EndLine..r.StartLine - 2] |> Array.forall System.String.IsNullOrWhiteSpace -> + | r :: rest, [] -> loop rest res [ r ] + | r :: rest, last :: _ when + r.StartLine = last.EndLine + 1 + || sourceLines[last.EndLine .. r.StartLine - 2] + |> Array.forall System.String.IsNullOrWhiteSpace + -> loop rest res (r :: currentBulk) - | r :: rest, _ -> loop rest (currentBulk :: res) [r] + | r :: rest, _ -> loop rest (currentBulk :: res) [ r ] + loop input [] [] let selectRanges (ranges: range list) = match ranges with | [] -> None - | [r] when r.StartLine = r.EndLine -> None - | [r] -> + | [ r ] when r.StartLine = r.EndLine -> None + | [ r ] -> let range = mkRange "" r.Start r.End - Some { Scope = scope; Collapse = Collapse.Same; Range = range ; CollapseRange = range } + + Some + { + Scope = scope + Collapse = Collapse.Same + Range = range + CollapseRange = range + } | lastRange :: rest -> let firstRange = Seq.last rest let range = mkRange "" firstRange.Start lastRange.End - Some { Scope = scope; Collapse = Collapse.Same; Range = range; CollapseRange = range } - decls - |> List.choose predicate - |> groupConsecutiveDecls + Some + { + Scope = scope + Collapse = Collapse.Same + Range = range + CollapseRange = range + } + + decls + |> List.choose predicate + |> groupConsecutiveDecls |> List.choose selectRanges |> acc.AddRange - let collectOpens = getConsecutiveModuleDecls (function SynModuleDecl.Open (_, r) -> Some r | _ -> None) Scope.Open + let collectOpens = + getConsecutiveModuleDecls + (function + | SynModuleDecl.Open (_, r) -> Some r + | _ -> None) + Scope.Open let collectHashDirectives = - getConsecutiveModuleDecls( - function + getConsecutiveModuleDecls + (function | SynModuleDecl.HashDirective (ParsedHashDirective (directive, _, _), r) -> let prefixLength = "#".Length + directive.Length + " ".Length - Some (mkRange "" (mkPos r.StartLine prefixLength) r.End) - | _ -> None) Scope.HashDirective + Some(mkRange "" (mkPos r.StartLine prefixLength) r.End) + | _ -> None) + Scope.HashDirective let rec parseDeclaration (decl: SynModuleDecl) = match decl with @@ -601,6 +692,7 @@ module Structure = for binding in bindings do let collapse = Range.endToEnd binding.RangeOfBindingWithoutRhs r rcheck Scope.LetOrUse Collapse.Below r collapse + parseBindings bindings | SynModuleDecl.Types (types, _r) -> @@ -608,7 +700,7 @@ module Structure = parseTypeDefn t // Fold the attributes above a module - | SynModuleDecl.NestedModule (moduleInfo=SynComponentInfo (attributes=attrs; range=cmpRange); decls=decls) -> + | SynModuleDecl.NestedModule (moduleInfo = SynComponentInfo (attributes = attrs; range = cmpRange); decls = decls) -> // Outline the full scope of the module let r = Range.endToEnd cmpRange decl.Range rcheck Scope.Module Collapse.Below decl.Range r @@ -617,20 +709,18 @@ module Structure = collectOpens decls List.iter parseDeclaration decls - | SynModuleDecl.Expr (e, _) -> - parseExpr e + | SynModuleDecl.Expr (e, _) -> parseExpr e - | SynModuleDecl.Attributes (attrs, _) -> - parseAttributes attrs + | SynModuleDecl.Attributes (attrs, _) -> parseAttributes attrs | _ -> () let parseModuleOrNamespace (SynModuleOrNamespace (longId, _, kind, decls, _, attribs, _, r, _)) = parseAttributes attribs let idRange = longIdentRange longId - let fullrange = Range.startToEnd idRange r - let collapse = Range.endToEnd idRange r - + let fullrange = Range.startToEnd idRange r + let collapse = Range.endToEnd idRange r + // do not return range for top level implicit module in scripts if kind = SynModuleOrNamespaceKind.NamedModule then rcheck Scope.Module Collapse.Below fullrange collapse @@ -652,23 +742,24 @@ module Structure = | lineStr :: rest -> match lineStr.TrimStart(), currentComment with | Comment commentType, Some comment -> - loop( - if comment.Type = commentType && lineNum = lastLineNum + 1 then - comment.Lines.Add (lineNum, lineStr) - lineNum, currentComment, result - else lineNum, Some (CommentList.New commentType (lineNum, lineStr)), comment :: result) rest (lineNum + 1) + loop + (if comment.Type = commentType && lineNum = lastLineNum + 1 then + comment.Lines.Add(lineNum, lineStr) + lineNum, currentComment, result + else + lineNum, Some(CommentList.New commentType (lineNum, lineStr)), comment :: result) + rest + (lineNum + 1) | Comment commentType, None -> - loop(lineNum, Some (CommentList.New commentType (lineNum, lineStr)), result) rest (lineNum + 1) - | _, Some comment -> - loop(lineNum, None, comment :: result) rest (lineNum + 1) - | _ -> loop(lineNum, None, result) rest (lineNum + 1) + loop (lineNum, Some(CommentList.New commentType (lineNum, lineStr)), result) rest (lineNum + 1) + | _, Some comment -> loop (lineNum, None, comment :: result) rest (lineNum + 1) + | _ -> loop (lineNum, None, result) rest (lineNum + 1) let comments: CommentList list = loop (-1, None, []) (List.ofArray lines) 0 |> fun (_, lastComment, comments) -> match lastComment with - | Some comment -> - comment :: comments + | Some comment -> comment :: comments | _ -> comments |> List.rev @@ -688,19 +779,20 @@ module Structure = let range = mkRange "" (mkPos (startLine + 1) startCol) (mkPos (endLine + 1) endCol) - { Scope = scopeType - Collapse = Collapse.Same - Range = range - CollapseRange = range }) + { + Scope = scopeType + Collapse = Collapse.Same + Range = range + CollapseRange = range + }) |> acc.AddRange - - //=======================================// - // Signature File AST Traversal // + //=======================================// + // Signature File AST Traversal // //=======================================// (* - The following helper functions are necessary due to a bug in the Parsed UAST within a + The following helper functions are necessary due to a bug in the Parsed UAST within a signature file that causes the scopes to extend past the end of the construct and overlap with the following construct. This necessitates inspecting the children of the construct and finding the end of the last child's range to use instead. @@ -713,46 +805,49 @@ module Structure = | [] -> r | ls -> match List.last ls with - | SynMemberSig.Inherit (range=r) - | SynMemberSig.Interface (range=r) - | SynMemberSig.Member (range=r) - | SynMemberSig.NestedType (range=r) - | SynMemberSig.ValField (range=r) -> r + | SynMemberSig.Inherit (range = r) + | SynMemberSig.Interface (range = r) + | SynMemberSig.Member (range = r) + | SynMemberSig.NestedType (range = r) + | SynMemberSig.ValField (range = r) -> r - let lastTypeDefnSigRangeElse range (typeSigs:SynTypeDefnSig list) = + let lastTypeDefnSigRangeElse range (typeSigs: SynTypeDefnSig list) = match typeSigs with | [] -> range | ls -> - let (SynTypeDefnSig(members=memberSigs; range=r)) = List.last ls + let (SynTypeDefnSig (members = memberSigs; range = r)) = List.last ls lastMemberSigRangeElse r memberSigs - let lastModuleSigDeclRangeElse range (sigDecls:SynModuleSigDecl list) = + let lastModuleSigDeclRangeElse range (sigDecls: SynModuleSigDecl list) = match sigDecls with | [] -> range - | ls -> + | ls -> match List.last ls with | SynModuleSigDecl.Types (typeSigs, r) -> lastTypeDefnSigRangeElse r typeSigs - | SynModuleSigDecl.Val (SynValSig(range=r), _) -> r - | SynModuleSigDecl.Exception(_, r) -> r - | SynModuleSigDecl.Open(_, r) -> r - | SynModuleSigDecl.ModuleAbbrev(_, _, r) -> r + | SynModuleSigDecl.Val (SynValSig (range = r), _) -> r + | SynModuleSigDecl.Exception (_, r) -> r + | SynModuleSigDecl.Open (_, r) -> r + | SynModuleSigDecl.ModuleAbbrev (_, _, r) -> r | _ -> range - let rec parseSynMemberDefnSig = function - | SynMemberSig.Member(valSigs, _, r) -> + let rec parseSynMemberDefnSig = + function + | SynMemberSig.Member (valSigs, _, r) -> let collapse = Range.endToEnd valSigs.RangeOfId r rcheck Scope.Member Collapse.Below r collapse - | SynMemberSig.ValField(SynField(attrs, _, _, _, _, _, _, fr), fullrange) -> + | SynMemberSig.ValField (SynField (attrs, _, _, _, _, _, _, fr), fullrange) -> let collapse = Range.endToEnd fr fullrange rcheck Scope.Val Collapse.Below fullrange collapse parseAttributes attrs - | SynMemberSig.Interface(tp, r) -> - rcheck Scope.Interface Collapse.Below r (Range.endToEnd tp.Range r) - | SynMemberSig.NestedType (typeDefSig, _r) -> - parseTypeDefnSig typeDefSig + | SynMemberSig.Interface (tp, r) -> rcheck Scope.Interface Collapse.Below r (Range.endToEnd tp.Range r) + | SynMemberSig.NestedType (typeDefSig, _r) -> parseTypeDefnSig typeDefSig | _ -> () - and parseTypeDefnSig (SynTypeDefnSig (typeInfo=SynComponentInfo(attributes=attribs; typeParams=TyparDecls typeArgs; longId=longId; range=r); typeRepr=objectModel; members=memberSigs)) = + and parseTypeDefnSig + (SynTypeDefnSig (typeInfo = SynComponentInfo (attributes = attribs; typeParams = TyparDecls typeArgs; longId = longId; range = r) + typeRepr = objectModel + members = memberSigs)) + = parseAttributes attribs let makeRanges memberSigs = @@ -766,77 +861,97 @@ module Structure = match objectModel with // matches against a type declaration with <'T, ...> and (args, ...) - | SynTypeDefnSigRepr.ObjectModel - (SynTypeDefnKind.Unspecified, objMembers, _) -> - List.iter parseSynMemberDefnSig objMembers - let fullrange, collapse = makeRanges objMembers - rcheck Scope.Type Collapse.Below fullrange collapse - | SynTypeDefnSigRepr.ObjectModel (kind=SynTypeDefnKind.Augmentation _; memberSigs=objMembers) -> - let fullrange, collapse = makeRanges objMembers - rcheck Scope.TypeExtension Collapse.Below fullrange collapse - List.iter parseSynMemberDefnSig objMembers + | SynTypeDefnSigRepr.ObjectModel (SynTypeDefnKind.Unspecified, objMembers, _) -> + List.iter parseSynMemberDefnSig objMembers + let fullrange, collapse = makeRanges objMembers + rcheck Scope.Type Collapse.Below fullrange collapse + | SynTypeDefnSigRepr.ObjectModel (kind = SynTypeDefnKind.Augmentation _; memberSigs = objMembers) -> + let fullrange, collapse = makeRanges objMembers + rcheck Scope.TypeExtension Collapse.Below fullrange collapse + List.iter parseSynMemberDefnSig objMembers | SynTypeDefnSigRepr.ObjectModel (_, objMembers, _) -> - let fullrange, collapse = makeRanges objMembers - rcheck Scope.Type Collapse.Below fullrange collapse - List.iter parseSynMemberDefnSig objMembers - // visit the members of a type extension + let fullrange, collapse = makeRanges objMembers + rcheck Scope.Type Collapse.Below fullrange collapse + List.iter parseSynMemberDefnSig objMembers + // visit the members of a type extension | SynTypeDefnSigRepr.Simple (simpleRepr, _) -> let fullrange, collapse = makeRanges memberSigs rcheck Scope.Type Collapse.Below fullrange collapse parseSimpleRepr simpleRepr | SynTypeDefnSigRepr.Exception _ -> () - let getConsecutiveSigModuleDecls (predicate: SynModuleSigDecl -> range option) (scope:Scope) (decls: SynModuleSigDecl list) = + let getConsecutiveSigModuleDecls (predicate: SynModuleSigDecl -> range option) (scope: Scope) (decls: SynModuleSigDecl list) = let groupConsecutiveSigDecls input = let rec loop (input: range list) (res: range list list) currentBulk = match input, currentBulk with | [], [] -> List.rev res | [], _ -> List.rev (currentBulk :: res) - | r :: rest, [] -> loop rest res [r] - | r :: rest, last :: _ when r.StartLine = last.EndLine + 1 -> - loop rest res (r :: currentBulk) - | r :: rest, _ -> loop rest (currentBulk :: res) [r] + | r :: rest, [] -> loop rest res [ r ] + | r :: rest, last :: _ when r.StartLine = last.EndLine + 1 -> loop rest res (r :: currentBulk) + | r :: rest, _ -> loop rest (currentBulk :: res) [ r ] + loop input [] [] let selectSigRanges (ranges: range list) = match ranges with | [] -> None - | [r] when r.StartLine = r.EndLine -> None - | [r] -> + | [ r ] when r.StartLine = r.EndLine -> None + | [ r ] -> let range = mkRange "" r.Start r.End - Some { Scope = scope; Collapse = Collapse.Same; Range = range ; CollapseRange = range } + + Some + { + Scope = scope + Collapse = Collapse.Same + Range = range + CollapseRange = range + } | lastRange :: rest -> let firstRange = Seq.last rest let range = mkRange "" firstRange.Start lastRange.End - Some { Scope = scope; Collapse = Collapse.Same; Range = range; CollapseRange = range } - decls - |> List.choose predicate - |> groupConsecutiveSigDecls + Some + { + Scope = scope + Collapse = Collapse.Same + Range = range + CollapseRange = range + } + + decls + |> List.choose predicate + |> groupConsecutiveSigDecls |> List.choose selectSigRanges |> acc.AddRange let collectSigHashDirectives (decls: SynModuleSigDecl list) = decls - |> getConsecutiveSigModuleDecls( - function + |> getConsecutiveSigModuleDecls + (function | SynModuleSigDecl.HashDirective (ParsedHashDirective (directive, _, _), r) -> let prefixLength = "#".Length + directive.Length + " ".Length - Some (mkRange "" (mkPos r.StartLine prefixLength) r.End) - | _ -> None) Scope.HashDirective + Some(mkRange "" (mkPos r.StartLine prefixLength) r.End) + | _ -> None) + Scope.HashDirective - let collectSigOpens = getConsecutiveSigModuleDecls (function SynModuleSigDecl.Open (_, r) -> Some r | _ -> None) Scope.Open + let collectSigOpens = + getConsecutiveSigModuleDecls + (function + | SynModuleSigDecl.Open (_, r) -> Some r + | _ -> None) + Scope.Open let rec parseModuleSigDeclaration (decl: SynModuleSigDecl) = match decl with - | SynModuleSigDecl.Val (SynValSig(attributes=attrs; ident=SynIdent(ident,_); range=valrange), r) -> + | SynModuleSigDecl.Val (SynValSig (attributes = attrs; ident = SynIdent (ident, _); range = valrange), r) -> let collapse = Range.endToEnd ident.idRange valrange rcheck Scope.Val Collapse.Below r collapse parseAttributes attrs - | SynModuleSigDecl.Types (typeSigs, _) -> - List.iter parseTypeDefnSig typeSigs + | SynModuleSigDecl.Types (typeSigs, _) -> List.iter parseTypeDefnSig typeSigs // Fold the attributes above a module - | SynModuleSigDecl.NestedModule (moduleInfo=SynComponentInfo (attributes=attrs; range=cmpRange); moduleDecls=decls; range=moduleRange) -> + | SynModuleSigDecl.NestedModule (moduleInfo = SynComponentInfo (attributes = attrs; range = cmpRange) + moduleDecls = decls + range = moduleRange) -> let rangeEnd = lastModuleSigDeclRangeElse moduleRange decls // Outline the full scope of the module let collapse = Range.endToEnd cmpRange rangeEnd @@ -848,13 +963,13 @@ module Structure = List.iter parseModuleSigDeclaration decls | _ -> () - let parseModuleOrNamespaceSigs (SynModuleOrNamespaceSig(longId, _, kind, decls, _, attribs, _, r, _)) = + let parseModuleOrNamespaceSigs (SynModuleOrNamespaceSig (longId, _, kind, decls, _, attribs, _, r, _)) = parseAttributes attribs let rangeEnd = lastModuleSigDeclRangeElse r decls let idrange = longIdentRange longId let fullrange = Range.startToEnd idrange rangeEnd let collapse = Range.endToEnd idrange rangeEnd - + if kind.IsModule then rcheck Scope.Module Collapse.Below fullrange collapse @@ -869,5 +984,5 @@ module Structure = | ParsedInput.SigFile (ParsedSigFileInput (modules = moduleSigs)) -> List.iter parseModuleOrNamespaceSigs moduleSigs getCommentRanges sourceLines - + acc :> seq<_> diff --git a/src/Compiler/Service/ServiceUntypedParse.fs b/src/Compiler/Service/ServiceUntypedParse.fs index 74dc6eb245f0..4d5ca136e40d 100755 --- a/src/Compiler/Service/ServiceUntypedParse.fs +++ b/src/Compiler/Service/ServiceUntypedParse.fs @@ -12,8 +12,8 @@ open System.IO open System.Collections.Generic open System.Diagnostics open System.Text.RegularExpressions - -open FSharp.Compiler.AbstractIL.Internal.Library + +open FSharp.Compiler.AbstractIL.Internal.Library open FSharp.Compiler.CompilerConfig open FSharp.Compiler.Lib open FSharp.Compiler.PrettyNaming @@ -25,7 +25,8 @@ open FSharp.Compiler.SyntaxTreeOps module SourceFile = /// Source file extensions - let private compilableExtensions = FSharpSigFileSuffixes @ FSharpImplFileSuffixes @ FSharpScriptFileSuffixes + let private compilableExtensions = + FSharpSigFileSuffixes @ FSharpImplFileSuffixes @ FSharpScriptFileSuffixes /// Single file projects extensions let private singleFileProjectExtensions = FSharpScriptFileSuffixes @@ -33,12 +34,16 @@ module SourceFile = /// Whether or not this file is compilable let IsCompilable file = let ext = Path.GetExtension file - compilableExtensions |> List.exists(fun e->0 = String.Compare(e, ext, StringComparison.OrdinalIgnoreCase)) + + compilableExtensions + |> List.exists (fun e -> 0 = String.Compare(e, ext, StringComparison.OrdinalIgnoreCase)) /// Whether or not this file should be a single-file project let MustBeSingleFileProject file = let ext = Path.GetExtension file - singleFileProjectExtensions |> List.exists(fun e-> 0 = String.Compare(e, ext, StringComparison.OrdinalIgnoreCase)) + + singleFileProjectExtensions + |> List.exists (fun e -> 0 = String.Compare(e, ext, StringComparison.OrdinalIgnoreCase)) module SourceFileImpl = let IsInterfaceFile file = @@ -46,20 +51,22 @@ module SourceFileImpl = 0 = String.Compare(".fsi", ext, StringComparison.OrdinalIgnoreCase) /// Additional #defines that should be in place when editing a file in a file editor such as VS. - let AdditionalDefinesForUseInEditor(isInteractive: bool) = - if isInteractive then ["INTERACTIVE";"EDITING"] // This is still used by the foreground parse - else ["COMPILED";"EDITING"] - + let AdditionalDefinesForUseInEditor (isInteractive: bool) = + if isInteractive then + [ "INTERACTIVE"; "EDITING" ] // This is still used by the foreground parse + else + [ "COMPILED"; "EDITING" ] + type CompletionPath = string list * string option // plid * residue [] -type InheritanceOrigin = +type InheritanceOrigin = | Class | Interface | Unknown [] -type InheritanceContext = +type InheritanceContext = | Class | Interface | Unknown @@ -71,7 +78,7 @@ type RecordContext = | New of CompletionPath [] -type CompletionContext = +type CompletionContext = // completion context cannot be determined due to errors | Invalid // completing something after the inherit keyword @@ -92,7 +99,7 @@ type CompletionContext = //---------------------------------------------------------------------------- [] -type FSharpParseFileResults(errors: FSharpErrorInfo[], input: ParsedInput option, parseHadErrors: bool, dependencyFiles: string[]) = +type FSharpParseFileResults(errors: FSharpErrorInfo[], input: ParsedInput option, parseHadErrors: bool, dependencyFiles: string[]) = member scope.Errors = errors @@ -100,7 +107,7 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: ParsedInput option member scope.ParseTree = input - member scope.FindNoteworthyParamInfoLocations pos = + member scope.FindNoteworthyParamInfoLocations pos = match input with | Some input -> FSharpNoteworthyParamInfoLocations.Find(pos, input) | _ -> None @@ -114,31 +121,33 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: ParsedInput option match input with | Some parseTree -> let res = - AstTraversal.Traverse(pos, parseTree, { new AstTraversal.AstVisitorBase<_>() with - member _.VisitExpr(_path, _traverseSynExpr, defaultTraverse, expr) = - match expr with - | SynExpr.Typed (_expr, _typeExpr, range) when posEq range.Start pos -> - Some range - | _ -> defaultTraverse expr + AstTraversal.Traverse( + pos, + parseTree, + { new AstTraversal.AstVisitorBase<_>() with + member _.VisitExpr(_path, _traverseSynExpr, defaultTraverse, expr) = + match expr with + | SynExpr.Typed (_expr, _typeExpr, range) when posEq range.Start pos -> Some range + | _ -> defaultTraverse expr - override _.VisitSimplePats(pats) = - match pats with - | [] -> None - | _ -> - let exprFunc pat = - match pat with - | SynSimplePat.Typed (_pat, _targetExpr, range) when posEq range.Start pos -> - Some range - | _ -> - None + override _.VisitSimplePats(pats) = + match pats with + | [] -> None + | _ -> + let exprFunc pat = + match pat with + | SynSimplePat.Typed (_pat, _targetExpr, range) when posEq range.Start pos -> Some range + | _ -> None - pats |> List.tryPick exprFunc + pats |> List.tryPick exprFunc + + override _.VisitPat(defaultTraverse, pat) = + match pat with + | SynPat.Typed (_pat, _targetType, range) when posEq range.Start pos -> Some range + | _ -> defaultTraverse pat + } + ) - override _.VisitPat(defaultTraverse, pat) = - match pat with - | SynPat.Typed (_pat, _targetType, range) when posEq range.Start pos -> - Some range - | _ -> defaultTraverse pat }) res.IsSome | None -> false @@ -146,71 +155,130 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: ParsedInput option match input with | Some parseTree -> let res = - AstTraversal.Traverse(pos, parseTree, { new AstTraversal.AstVisitorBase<_>() with - member _.VisitExpr(_path, _traverseSynExpr, defaultTraverse, expr) = - defaultTraverse expr + AstTraversal.Traverse( + pos, + parseTree, + { new AstTraversal.AstVisitorBase<_>() with + member _.VisitExpr(_path, _traverseSynExpr, defaultTraverse, expr) = defaultTraverse expr + + override _.VisitBinding(defaultTraverse, binding) = + match binding with + | SynBinding.Binding (_, _, _, _, _, _, _, _, _, expr, range, _) when posEq range.Start pos -> + match expr with + | SynExpr.Lambda _ -> Some range + | _ -> None + | _ -> defaultTraverse binding + } + ) - override _.VisitBinding(defaultTraverse, binding) = - match binding with - | SynBinding.Binding(_, _, _, _, _, _, _, _, _, expr, range, _) when posEq range.Start pos -> - match expr with - | SynExpr.Lambda _ -> Some range - | _ -> None - | _ -> defaultTraverse binding }) res.IsSome | None -> false - + /// Get declared items and the selected item at the specified location member private scope.GetNavigationItemsImpl() = - ErrorScope.Protect range0 - (fun () -> + ErrorScope.Protect + range0 + (fun () -> match input with - | Some (ParsedInput.ImplFile _ as p) -> - FSharpNavigation.getNavigation p - | Some (ParsedInput.SigFile _) -> - FSharpNavigation.empty - | _ -> - FSharpNavigation.empty) - (fun err -> + | Some (ParsedInput.ImplFile _ as p) -> FSharpNavigation.getNavigation p + | Some (ParsedInput.SigFile _) -> FSharpNavigation.empty + | _ -> FSharpNavigation.empty) + (fun err -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetNavigationItemsImpl: '%s'" err) FSharpNavigation.empty) - + member private scope.ValidateBreakpointLocationImpl pos = - let isMatchRange m = rangeContainsPos m pos || m.StartLine = pos.Line + let isMatchRange m = + rangeContainsPos m pos || m.StartLine = pos.Line // Process let-binding - let findBreakPoints () = - let checkRange m = [ if isMatchRange m then yield m ] - let walkBindSeqPt sp = [ match sp with DebugPointAtBinding m -> yield! checkRange m | _ -> () ] - let walkForSeqPt sp = [ match sp with DebugPointAtFor.Yes m -> yield! checkRange m | _ -> () ] - let walkWhileSeqPt sp = [ match sp with DebugPointAtWhile.Yes m -> yield! checkRange m | _ -> () ] - let walkTrySeqPt sp = [ match sp with DebugPointAtTry.Yes m -> yield! checkRange m | _ -> () ] - let walkWithSeqPt sp = [ match sp with DebugPointAtWith.Yes m -> yield! checkRange m | _ -> () ] - let walkFinallySeqPt sp = [ match sp with DebugPointAtFinally.Yes m -> yield! checkRange m | _ -> () ] - - let rec walkBind (Binding(_, _, _, _, _, _, SynValData(memFlagsOpt, _, _), synPat, _, synExpr, _, spInfo)) = - [ // Don't yield the binding sequence point if there are any arguments, i.e. we're defining a function or a method - let isFunction = - Option.isSome memFlagsOpt || - match synPat with - | SynPat.LongIdent (_, _, _, SynArgPats.Pats args, _, _) when not (List.isEmpty args) -> true - | _ -> false - if not isFunction then - yield! walkBindSeqPt spInfo + let findBreakPoints () = + let checkRange m = + [ + if isMatchRange m then yield m + ] + + let walkBindSeqPt sp = + [ + match sp with + | DebugPointAtBinding m -> yield! checkRange m + | _ -> () + ] - yield! walkExpr (isFunction || (match spInfo with DebugPointAtBinding _ -> false | _-> true)) synExpr ] + let walkForSeqPt sp = + [ + match sp with + | DebugPointAtFor.Yes m -> yield! checkRange m + | _ -> () + ] + + let walkWhileSeqPt sp = + [ + match sp with + | DebugPointAtWhile.Yes m -> yield! checkRange m + | _ -> () + ] + + let walkTrySeqPt sp = + [ + match sp with + | DebugPointAtTry.Yes m -> yield! checkRange m + | _ -> () + ] + + let walkWithSeqPt sp = + [ + match sp with + | DebugPointAtWith.Yes m -> yield! checkRange m + | _ -> () + ] + + let walkFinallySeqPt sp = + [ + match sp with + | DebugPointAtFinally.Yes m -> yield! checkRange m + | _ -> () + ] + + let rec walkBind (Binding (_, _, _, _, _, _, SynValData (memFlagsOpt, _, _), synPat, _, synExpr, _, spInfo)) = + [ // Don't yield the binding sequence point if there are any arguments, i.e. we're defining a function or a method + let isFunction = + Option.isSome memFlagsOpt + || match synPat with + | SynPat.LongIdent (_, _, _, SynArgPats.Pats args, _, _) when not (List.isEmpty args) -> true + | _ -> false + + if not isFunction then yield! walkBindSeqPt spInfo + + yield! + walkExpr + (isFunction + || (match spInfo with + | DebugPointAtBinding _ -> false + | _ -> true)) + synExpr + ] and walkExprs es = List.collect (walkExpr false) es and walkBinds es = List.collect walkBind es - and walkMatchClauses cl = - [ for (Clause(_, whenExpr, e, _, _)) in cl do - match whenExpr with - | Some e -> yield! walkExpr false e + + and walkMatchClauses cl = + [ + for (Clause (_, whenExpr, e, _, _)) in cl do + match whenExpr with + | Some e -> yield! walkExpr false e + | _ -> () + + yield! walkExpr true e + ] + + and walkExprOpt (spAlways: bool) eOpt = + [ + match eOpt with + | Some e -> yield! walkExpr spAlways e | _ -> () - yield! walkExpr true e ] + ] - and walkExprOpt (spAlways: bool) eOpt = [ match eOpt with Some e -> yield! walkExpr spAlways e | _ -> () ] - and IsBreakableExpression e = match e with | SynExpr.Match _ @@ -222,250 +290,307 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: ParsedInput option // Determine the breakpoint locations for an expression. spAlways indicates we always // emit a breakpoint location for the expression unless it is a syntactic control flow construct - and walkExpr (spAlways: bool) e = + and walkExpr (spAlways: bool) e = let m = e.Range - if not (isMatchRange m) then [] else - [ if spAlways && IsBreakableExpression e then - yield! checkRange m - - match e with - | SynExpr.ArbitraryAfterError _ - | SynExpr.LongIdent _ - | SynExpr.LibraryOnlyILAssembly _ - | SynExpr.LibraryOnlyStaticOptimization _ - | SynExpr.Null _ - | SynExpr.Ident _ - | SynExpr.ImplicitZero _ - | SynExpr.Const _ -> - () - - | SynExpr.Quote (_, _, e, _, _) - | SynExpr.TypeTest (e, _, _) - | SynExpr.Upcast (e, _, _) - | SynExpr.AddressOf (_, e, _, _) - | SynExpr.CompExpr (_, _, e, _) - | SynExpr.ArrayOrListOfSeqExpr (_, e, _) - | SynExpr.Typed (e, _, _) - | SynExpr.FromParseError (e, _) - | SynExpr.DiscardAfterMissingQualificationAfterDot (e, _) - | SynExpr.Do (e, _) - | SynExpr.Assert (e, _) - | SynExpr.Fixed (e, _) - | SynExpr.DotGet (e, _, _, _) - | SynExpr.LongIdentSet (_, e, _) - | SynExpr.New (_, _, e, _) - | SynExpr.TypeApp (e, _, _, _, _, _, _) - | SynExpr.LibraryOnlyUnionCaseFieldGet (e, _, _, _) - | SynExpr.Downcast (e, _, _) - | SynExpr.InferredUpcast (e, _) - | SynExpr.InferredDowncast (e, _) - | SynExpr.Lazy (e, _) - | SynExpr.TraitCall (_, _, e, _) - | SynExpr.Paren (e, _, _, _) -> - yield! walkExpr false e - - | SynExpr.InterpolatedString (parts, _) -> - yield! walkExprs [ for part in parts do - match part with + + if not (isMatchRange m) then + [] + else + [ + if spAlways && IsBreakableExpression e then + yield! checkRange m + + match e with + | SynExpr.ArbitraryAfterError _ + | SynExpr.LongIdent _ + | SynExpr.LibraryOnlyILAssembly _ + | SynExpr.LibraryOnlyStaticOptimization _ + | SynExpr.Null _ + | SynExpr.Ident _ + | SynExpr.ImplicitZero _ + | SynExpr.Const _ -> () + + | SynExpr.Quote (_, _, e, _, _) + | SynExpr.TypeTest (e, _, _) + | SynExpr.Upcast (e, _, _) + | SynExpr.AddressOf (_, e, _, _) + | SynExpr.CompExpr (_, _, e, _) + | SynExpr.ArrayOrListOfSeqExpr (_, e, _) + | SynExpr.Typed (e, _, _) + | SynExpr.FromParseError (e, _) + | SynExpr.DiscardAfterMissingQualificationAfterDot (e, _) + | SynExpr.Do (e, _) + | SynExpr.Assert (e, _) + | SynExpr.Fixed (e, _) + | SynExpr.DotGet (e, _, _, _) + | SynExpr.LongIdentSet (_, e, _) + | SynExpr.New (_, _, e, _) + | SynExpr.TypeApp (e, _, _, _, _, _, _) + | SynExpr.LibraryOnlyUnionCaseFieldGet (e, _, _, _) + | SynExpr.Downcast (e, _, _) + | SynExpr.InferredUpcast (e, _) + | SynExpr.InferredDowncast (e, _) + | SynExpr.Lazy (e, _) + | SynExpr.TraitCall (_, _, e, _) + | SynExpr.Paren (e, _, _, _) -> yield! walkExpr false e + + | SynExpr.InterpolatedString (parts, _) -> + yield! + walkExprs + [ + for part in parts do + match part with | SynInterpolatedStringPart.String _ -> () - | SynInterpolatedStringPart.FillExpr (fillExpr, _) -> yield fillExpr ] - - | SynExpr.YieldOrReturn (_, e, _) - | SynExpr.YieldOrReturnFrom (_, e, _) - | SynExpr.DoBang (e, _) -> - yield! checkRange e.Range - yield! walkExpr false e - - | SynExpr.NamedIndexedPropertySet (_, e1, e2, _) - | SynExpr.DotSet (e1, _, e2, _) - | SynExpr.Set (e1, e2, _) - | SynExpr.LibraryOnlyUnionCaseFieldSet (e1, _, _, e2, _) - | SynExpr.App (_, _, e1, e2, _) -> - yield! walkExpr false e1 - yield! walkExpr false e2 - - | SynExpr.ArrayOrList (_, es, _) - | SynExpr.Tuple (_, es, _, _) -> - yield! walkExprs es - - | SynExpr.Record (_, copyExprOpt, fs, _) -> - match copyExprOpt with - | Some (e, _) -> yield! walkExpr true e - | None -> () - yield! walkExprs (fs |> List.choose p23) - - | SynExpr.AnonRecd (_isStruct, copyExprOpt, fs, _) -> - match copyExprOpt with - | Some (e, _) -> yield! walkExpr true e - | None -> () - yield! walkExprs (fs |> List.map snd) - - | SynExpr.ObjExpr (_, args, bs, is, _, _) -> - match args with - | None -> () - | Some (arg, _) -> yield! walkExpr false arg - yield! walkBinds bs - for (InterfaceImpl(_, bs, _)) in is do yield! walkBinds bs - - | SynExpr.While (spWhile, e1, e2, _) -> - yield! walkWhileSeqPt spWhile - yield! walkExpr false e1 - yield! walkExpr true e2 - - | SynExpr.JoinIn (e1, _range, e2, _range2) -> - yield! walkExpr false e1 - yield! walkExpr false e2 - - | SynExpr.For (spFor, _, e1, _, e2, e3, _) -> - yield! walkForSeqPt spFor - yield! walkExpr false e1 - yield! walkExpr true e2 - yield! walkExpr true e3 - - | SynExpr.ForEach (spFor, _, _, _, e1, e2, _) -> - yield! walkForSeqPt spFor - yield! walkExpr false e1 - yield! walkExpr true e2 - - | SynExpr.MatchLambda (_isExnMatch, _argm, cl, spBind, _wholem) -> - yield! walkBindSeqPt spBind - for (Clause(_, whenExpr, e, _, _)) in cl do - yield! walkExprOpt false whenExpr - yield! walkExpr true e - - | SynExpr.Lambda (_, _, _, e, _, _) -> - yield! walkExpr true e - - | SynExpr.Match (spBind, e, cl, _) -> - yield! walkBindSeqPt spBind - yield! walkExpr false e - for (Clause(_, whenExpr, e, _, _)) in cl do - yield! walkExprOpt false whenExpr - yield! walkExpr true e - - | SynExpr.LetOrUse (_, _, bs, e, _) -> - yield! walkBinds bs - yield! walkExpr true e - - | SynExpr.TryWith (e, _, cl, _, _, spTry, spWith) -> - yield! walkTrySeqPt spTry - yield! walkWithSeqPt spWith - yield! walkExpr true e - yield! walkMatchClauses cl - - | SynExpr.TryFinally (e1, e2, _, spTry, spFinally) -> - yield! walkExpr true e1 - yield! walkExpr true e2 - yield! walkTrySeqPt spTry - yield! walkFinallySeqPt spFinally - - | SynExpr.SequentialOrImplicitYield (spSeq, e1, e2, _, _) - | SynExpr.Sequential (spSeq, _, e1, e2, _) -> - yield! walkExpr (match spSeq with DebugPointAtSequential.ExprOnly -> false | _ -> true) e1 - yield! walkExpr (match spSeq with DebugPointAtSequential.StmtOnly -> false | _ -> true) e2 - - | SynExpr.IfThenElse (e1, e2, e3opt, spBind, _, _, _) -> - yield! walkBindSeqPt spBind - yield! walkExpr false e1 - yield! walkExpr true e2 - yield! walkExprOpt true e3opt - - | SynExpr.DotIndexedGet (e1, es, _, _) -> - yield! walkExpr false e1 - yield! walkExprs [ for e in es do yield! e.Exprs ] - - | SynExpr.DotIndexedSet (e1, es, e2, _, _, _) -> - yield! walkExpr false e1 - yield! walkExprs [ for e in es do yield! e.Exprs ] - yield! walkExpr false e2 - - | SynExpr.DotNamedIndexedPropertySet (e1, _, e2, e3, _) -> - yield! walkExpr false e1 - yield! walkExpr false e2 - yield! walkExpr false e3 - - | SynExpr.LetOrUseBang (spBind, _, _, _, e1, es, e2, _) -> - yield! walkBindSeqPt spBind - yield! walkExpr true e1 - for (andBangSpBind,_,_,_,eAndBang,_) in es do - yield! walkBindSeqPt andBangSpBind - yield! walkExpr true eAndBang - yield! walkExpr true e2 - - | SynExpr.MatchBang (spBind, e, cl, _) -> - yield! walkBindSeqPt spBind - yield! walkExpr false e - for (Clause(_, whenExpr, e, _, _)) in cl do - yield! walkExprOpt false whenExpr - yield! walkExpr true e ] - + | SynInterpolatedStringPart.FillExpr (fillExpr, _) -> yield fillExpr + ] + + | SynExpr.YieldOrReturn (_, e, _) + | SynExpr.YieldOrReturnFrom (_, e, _) + | SynExpr.DoBang (e, _) -> + yield! checkRange e.Range + yield! walkExpr false e + + | SynExpr.NamedIndexedPropertySet (_, e1, e2, _) + | SynExpr.DotSet (e1, _, e2, _) + | SynExpr.Set (e1, e2, _) + | SynExpr.LibraryOnlyUnionCaseFieldSet (e1, _, _, e2, _) + | SynExpr.App (_, _, e1, e2, _) -> + yield! walkExpr false e1 + yield! walkExpr false e2 + + | SynExpr.ArrayOrList (_, es, _) + | SynExpr.Tuple (_, es, _, _) -> yield! walkExprs es + + | SynExpr.Record (_, copyExprOpt, fs, _) -> + match copyExprOpt with + | Some (e, _) -> yield! walkExpr true e + | None -> () + + yield! walkExprs (fs |> List.choose p23) + + | SynExpr.AnonRecd (_isStruct, copyExprOpt, fs, _) -> + match copyExprOpt with + | Some (e, _) -> yield! walkExpr true e + | None -> () + + yield! walkExprs (fs |> List.map snd) + + | SynExpr.ObjExpr (_, args, bs, is, _, _) -> + match args with + | None -> () + | Some (arg, _) -> yield! walkExpr false arg + + yield! walkBinds bs + + for (InterfaceImpl (_, bs, _)) in is do + yield! walkBinds bs + + | SynExpr.While (spWhile, e1, e2, _) -> + yield! walkWhileSeqPt spWhile + yield! walkExpr false e1 + yield! walkExpr true e2 + + | SynExpr.JoinIn (e1, _range, e2, _range2) -> + yield! walkExpr false e1 + yield! walkExpr false e2 + + | SynExpr.For (spFor, _, e1, _, e2, e3, _) -> + yield! walkForSeqPt spFor + yield! walkExpr false e1 + yield! walkExpr true e2 + yield! walkExpr true e3 + + | SynExpr.ForEach (spFor, _, _, _, e1, e2, _) -> + yield! walkForSeqPt spFor + yield! walkExpr false e1 + yield! walkExpr true e2 + + | SynExpr.MatchLambda (_isExnMatch, _argm, cl, spBind, _wholem) -> + yield! walkBindSeqPt spBind + + for (Clause (_, whenExpr, e, _, _)) in cl do + yield! walkExprOpt false whenExpr + yield! walkExpr true e + + | SynExpr.Lambda (_, _, _, e, _, _) -> yield! walkExpr true e + + | SynExpr.Match (spBind, e, cl, _) -> + yield! walkBindSeqPt spBind + yield! walkExpr false e + + for (Clause (_, whenExpr, e, _, _)) in cl do + yield! walkExprOpt false whenExpr + yield! walkExpr true e + + | SynExpr.LetOrUse (_, _, bs, e, _) -> + yield! walkBinds bs + yield! walkExpr true e + + | SynExpr.TryWith (e, _, cl, _, _, spTry, spWith) -> + yield! walkTrySeqPt spTry + yield! walkWithSeqPt spWith + yield! walkExpr true e + yield! walkMatchClauses cl + + | SynExpr.TryFinally (e1, e2, _, spTry, spFinally) -> + yield! walkExpr true e1 + yield! walkExpr true e2 + yield! walkTrySeqPt spTry + yield! walkFinallySeqPt spFinally + + | SynExpr.SequentialOrImplicitYield (spSeq, e1, e2, _, _) + | SynExpr.Sequential (spSeq, _, e1, e2, _) -> + yield! + walkExpr + (match spSeq with + | DebugPointAtSequential.ExprOnly -> false + | _ -> true) + e1 + + yield! + walkExpr + (match spSeq with + | DebugPointAtSequential.StmtOnly -> false + | _ -> true) + e2 + + | SynExpr.IfThenElse (e1, e2, e3opt, spBind, _, _, _) -> + yield! walkBindSeqPt spBind + yield! walkExpr false e1 + yield! walkExpr true e2 + yield! walkExprOpt true e3opt + + | SynExpr.DotIndexedGet (e1, es, _, _) -> + yield! walkExpr false e1 + + yield! + walkExprs + [ + for e in es do + yield! e.Exprs + ] + + | SynExpr.DotIndexedSet (e1, es, e2, _, _, _) -> + yield! walkExpr false e1 + + yield! + walkExprs + [ + for e in es do + yield! e.Exprs + ] + + yield! walkExpr false e2 + + | SynExpr.DotNamedIndexedPropertySet (e1, _, e2, e3, _) -> + yield! walkExpr false e1 + yield! walkExpr false e2 + yield! walkExpr false e3 + + | SynExpr.LetOrUseBang (spBind, _, _, _, e1, es, e2, _) -> + yield! walkBindSeqPt spBind + yield! walkExpr true e1 + + for (andBangSpBind, _, _, _, eAndBang, _) in es do + yield! walkBindSeqPt andBangSpBind + yield! walkExpr true eAndBang + + yield! walkExpr true e2 + + | SynExpr.MatchBang (spBind, e, cl, _) -> + yield! walkBindSeqPt spBind + yield! walkExpr false e + + for (Clause (_, whenExpr, e, _, _)) in cl do + yield! walkExprOpt false whenExpr + yield! walkExpr true e + ] + // Process a class declaration or F# type declaration - let rec walkTycon (TypeDefn(ComponentInfo(_, _, _, _, _, _, _, _), repr, membDefns, m)) = - if not (isMatchRange m) then [] else - [ for memb in membDefns do yield! walkMember memb - match repr with - | SynTypeDefnRepr.ObjectModel(_, membDefns, _) -> - for memb in membDefns do yield! walkMember memb - | _ -> () ] - - // Returns class-members for the right dropdown + let rec walkTycon (TypeDefn (ComponentInfo (_, _, _, _, _, _, _, _), repr, membDefns, m)) = + if not (isMatchRange m) then + [] + else + [ + for memb in membDefns do + yield! walkMember memb + match repr with + | SynTypeDefnRepr.ObjectModel (_, membDefns, _) -> + for memb in membDefns do + yield! walkMember memb + | _ -> () + ] + + // Returns class-members for the right dropdown and walkMember memb = - if not (rangeContainsPos memb.Range pos) then [] else - [ match memb with - | SynMemberDefn.LetBindings(binds, _, _, _) -> yield! walkBinds binds - | SynMemberDefn.AutoProperty(_attribs, _isStatic, _id, _tyOpt, _propKind, _, _xmlDoc, _access, synExpr, _, _) -> yield! walkExpr true synExpr - | SynMemberDefn.ImplicitCtor(_, _, _, _, _, m) -> yield! checkRange m - | SynMemberDefn.Member(bind, _) -> yield! walkBind bind - | SynMemberDefn.Interface(_, Some membs, _) -> for m in membs do yield! walkMember m - | SynMemberDefn.Inherit(_, _, m) -> - // can break on the "inherit" clause - yield! checkRange m - | SynMemberDefn.ImplicitInherit(_, arg, _, m) -> - // can break on the "inherit" clause - yield! checkRange m - yield! walkExpr true arg - | _ -> () ] + if not (rangeContainsPos memb.Range pos) then + [] + else + [ + match memb with + | SynMemberDefn.LetBindings (binds, _, _, _) -> yield! walkBinds binds + | SynMemberDefn.AutoProperty (_attribs, _isStatic, _id, _tyOpt, _propKind, _, _xmlDoc, _access, synExpr, _, _) -> + yield! walkExpr true synExpr + | SynMemberDefn.ImplicitCtor (_, _, _, _, _, m) -> yield! checkRange m + | SynMemberDefn.Member (bind, _) -> yield! walkBind bind + | SynMemberDefn.Interface (_, Some membs, _) -> + for m in membs do + yield! walkMember m + | SynMemberDefn.Inherit (_, _, m) -> + // can break on the "inherit" clause + yield! checkRange m + | SynMemberDefn.ImplicitInherit (_, arg, _, m) -> + // can break on the "inherit" clause + yield! checkRange m + yield! walkExpr true arg + | _ -> () + ] // Process declarations nested in a module that should be displayed in the left dropdown - // (such as type declarations, nested modules etc.) - let rec walkDecl decl = - [ match decl with - | SynModuleDecl.Let(_, binds, m) when isMatchRange m -> - yield! walkBinds binds - | SynModuleDecl.DoExpr(spExpr, expr, m) when isMatchRange m -> - yield! walkBindSeqPt spExpr - yield! walkExpr false expr - | SynModuleDecl.ModuleAbbrev _ -> () - | SynModuleDecl.NestedModule(_, _isRec, decls, _, m) when isMatchRange m -> - for d in decls do yield! walkDecl d - | SynModuleDecl.Types(tydefs, m) when isMatchRange m -> - for d in tydefs do yield! walkTycon d - | SynModuleDecl.Exception(SynExceptionDefn(SynExceptionDefnRepr(_, _, _, _, _, _), membDefns, _), m) - when isMatchRange m -> - for m in membDefns do yield! walkMember m - | _ -> () ] - - // Collect all the items in a module - let walkModule (SynModuleOrNamespace(_, _, _, decls, _, _, _, m)) = - if isMatchRange m then - List.collect walkDecl decls - else - [] - - /// Get information for implementation file + // (such as type declarations, nested modules etc.) + let rec walkDecl decl = + [ + match decl with + | SynModuleDecl.Let (_, binds, m) when isMatchRange m -> yield! walkBinds binds + | SynModuleDecl.DoExpr (spExpr, expr, m) when isMatchRange m -> + yield! walkBindSeqPt spExpr + yield! walkExpr false expr + | SynModuleDecl.ModuleAbbrev _ -> () + | SynModuleDecl.NestedModule (_, _isRec, decls, _, m) when isMatchRange m -> + for d in decls do + yield! walkDecl d + | SynModuleDecl.Types (tydefs, m) when isMatchRange m -> + for d in tydefs do + yield! walkTycon d + | SynModuleDecl.Exception (SynExceptionDefn (SynExceptionDefnRepr (_, _, _, _, _, _), membDefns, _), m) when + isMatchRange m + -> + for m in membDefns do + yield! walkMember m + | _ -> () + ] + + // Collect all the items in a module + let walkModule (SynModuleOrNamespace (_, _, _, decls, _, _, _, m)) = + if isMatchRange m then List.collect walkDecl decls else [] + + /// Get information for implementation file let walkImplFile (modules: SynModuleOrNamespace list) = List.collect walkModule modules - + match input with - | Some (ParsedInput.ImplFile (ParsedImplFileInput (modules = modules))) -> walkImplFile modules + | Some (ParsedInput.ImplFile (ParsedImplFileInput (modules = modules))) -> walkImplFile modules | _ -> [] - - ErrorScope.Protect range0 - (fun () -> - let locations = findBreakPoints() - + + ErrorScope.Protect + range0 + (fun () -> + let locations = findBreakPoints () + if pos.Column = 0 then // we have a breakpoint that was set with mouse at line start - match locations |> List.filter (fun m -> m.StartLine = m.EndLine && pos.Line = m.StartLine) with + match locations + |> List.filter (fun m -> m.StartLine = m.EndLine && pos.Line = m.StartLine) + with | [] -> match locations |> List.filter (fun m -> rangeContainsPos m pos) with | [] -> @@ -481,20 +606,20 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: ParsedInput option | [] -> Seq.tryHead locations | locationsAfterPos -> Seq.tryHead locationsAfterPos | coveringLocations -> Seq.tryLast coveringLocations) - (fun msg -> + (fun msg -> Trace.TraceInformation(sprintf "FCS: recovering from error in ValidateBreakpointLocationImpl: '%s'" msg) None) - + /// When these files appear or disappear the configuration for the current project is invalidated. member scope.DependencyFiles = dependencyFiles member scope.FileName = - match input with - | Some (ParsedInput.ImplFile (ParsedImplFileInput (fileName = modname))) - | Some (ParsedInput.SigFile (ParsedSigFileInput (fileName = modname))) -> modname - | _ -> "" - - // Get items for the navigation drop down bar + match input with + | Some (ParsedInput.ImplFile (ParsedImplFileInput (fileName = modname))) + | Some (ParsedInput.SigFile (ParsedSigFileInput (fileName = modname))) -> modname + | _ -> "" + + // Get items for the navigation drop down bar member scope.GetNavigationItems() = // This does not need to be run on the background thread scope.GetNavigationItemsImpl() @@ -503,7 +628,11 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: ParsedInput option // This does not need to be run on the background thread scope.ValidateBreakpointLocationImpl pos -type ModuleKind = { IsAutoOpen: bool; HasModuleSuffix: bool } +type ModuleKind = + { + IsAutoOpen: bool + HasModuleSuffix: bool + } [] type EntityKind = @@ -511,115 +640,131 @@ type EntityKind = | Type | FunctionOrValue of isActivePattern: bool | Module of ModuleKind + override x.ToString() = sprintf "%A" x module UntypedParseImpl = - + let emptyStringSet = HashSet() - let GetRangeOfExprLeftOfDot(pos: pos, parseTreeOpt) = - match parseTreeOpt with - | None -> None + let GetRangeOfExprLeftOfDot (pos: pos, parseTreeOpt) = + match parseTreeOpt with + | None -> None | Some parseTree -> - let CheckLongIdent(longIdent: LongIdent) = - // find the longest prefix before the "pos" dot - let mutable r = (List.head longIdent).idRange - let mutable couldBeBeforeFront = true - for i in longIdent do - if posGeq pos i.idRange.End then - r <- unionRanges r i.idRange - couldBeBeforeFront <- false - couldBeBeforeFront, r - - AstTraversal.Traverse(pos, parseTree, { new AstTraversal.AstVisitorBase<_>() with - member this.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = - let expr = expr // fix debugger locals - match expr with - | SynExpr.LongIdent (_, LongIdentWithDots(longIdent, _), _altNameRefCell, _range) -> - let _, r = CheckLongIdent longIdent - Some r - | SynExpr.LongIdentSet (LongIdentWithDots(longIdent, _), synExpr, _range) -> - if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then - traverseSynExpr synExpr - else - let _, r = CheckLongIdent longIdent - Some r - | SynExpr.DotGet (synExpr, _dotm, LongIdentWithDots(longIdent, _), _range) -> - if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then - traverseSynExpr synExpr - else - let inFront, r = CheckLongIdent longIdent - if inFront then - Some (synExpr.Range) - else - // see comment below for SynExpr.DotSet - Some ((unionRanges synExpr.Range r)) - | SynExpr.Set (synExpr, synExpr2, range) -> - if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then - traverseSynExpr synExpr - elif AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr2.Range pos then - traverseSynExpr synExpr2 - else - Some range - | SynExpr.DotSet (synExpr, LongIdentWithDots(longIdent, _), synExpr2, _range) -> - if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then - traverseSynExpr synExpr - elif AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr2.Range pos then - traverseSynExpr synExpr2 - else - let inFront, r = CheckLongIdent longIdent - if inFront then - Some (synExpr.Range) - else - // f(0).X.Y.Z - // ^ - // - r has this value - // ---- synExpr.Range has this value - // ------ we want this value - Some ((unionRanges synExpr.Range r)) - | SynExpr.DotNamedIndexedPropertySet (synExpr, LongIdentWithDots(longIdent, _), synExpr2, synExpr3, _range) -> - if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then - traverseSynExpr synExpr - elif AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr2.Range pos then - traverseSynExpr synExpr2 - elif AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr3.Range pos then - traverseSynExpr synExpr3 - else - let inFront, r = CheckLongIdent longIdent - if inFront then - Some (synExpr.Range) - else - Some ((unionRanges synExpr.Range r)) - | SynExpr.DiscardAfterMissingQualificationAfterDot (synExpr, _range) -> // get this for e.g. "bar()." - if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then - traverseSynExpr synExpr - else - Some (synExpr.Range) - | SynExpr.FromParseError (synExpr, range) -> - if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then - traverseSynExpr synExpr - else - Some range - | SynExpr.App (ExprAtomicFlag.NonAtomic, true, (SynExpr.LongIdent(longDotId = SynLongIdent([ident], _, _))), rhs, _) - when ident.idText = "op_ArrayLookup" - && not(AstTraversal.rangeContainsPosLeftEdgeInclusive rhs.Range pos) -> - match defaultTraverse expr with - | None -> - // (expr).(expr) is an ML-deprecated array lookup, but we want intellisense on the dot - // also want it for e.g. [|arr|].(0) - Some (expr.Range) - | x -> x // we found the answer deeper somewhere in the lhs - | SynExpr.Const (SynConst.Double(_), range) -> Some range - | _ -> defaultTraverse expr - }) - + let CheckLongIdent (longIdent: LongIdent) = + // find the longest prefix before the "pos" dot + let mutable r = (List.head longIdent).idRange + let mutable couldBeBeforeFront = true + + for i in longIdent do + if posGeq pos i.idRange.End then + r <- unionRanges r i.idRange + couldBeBeforeFront <- false + + couldBeBeforeFront, r + + AstTraversal.Traverse( + pos, + parseTree, + { new AstTraversal.AstVisitorBase<_>() with + member this.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = + let expr = expr // fix debugger locals + + match expr with + | SynExpr.LongIdent (_, LongIdentWithDots (longIdent, _), _altNameRefCell, _range) -> + let _, r = CheckLongIdent longIdent + Some r + | SynExpr.LongIdentSet (LongIdentWithDots (longIdent, _), synExpr, _range) -> + if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then + traverseSynExpr synExpr + else + let _, r = CheckLongIdent longIdent + Some r + | SynExpr.DotGet (synExpr, _dotm, LongIdentWithDots (longIdent, _), _range) -> + if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then + traverseSynExpr synExpr + else + let inFront, r = CheckLongIdent longIdent + + if inFront then + Some(synExpr.Range) + else + // see comment below for SynExpr.DotSet + Some((unionRanges synExpr.Range r)) + | SynExpr.Set (synExpr, synExpr2, range) -> + if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then + traverseSynExpr synExpr + elif AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr2.Range pos then + traverseSynExpr synExpr2 + else + Some range + | SynExpr.DotSet (synExpr, LongIdentWithDots (longIdent, _), synExpr2, _range) -> + if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then + traverseSynExpr synExpr + elif AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr2.Range pos then + traverseSynExpr synExpr2 + else + let inFront, r = CheckLongIdent longIdent + + if inFront then + Some(synExpr.Range) + else + // f(0).X.Y.Z + // ^ + // - r has this value + // ---- synExpr.Range has this value + // ------ we want this value + Some((unionRanges synExpr.Range r)) + | SynExpr.DotNamedIndexedPropertySet (synExpr, LongIdentWithDots (longIdent, _), synExpr2, synExpr3, _range) -> + if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then + traverseSynExpr synExpr + elif AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr2.Range pos then + traverseSynExpr synExpr2 + elif AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr3.Range pos then + traverseSynExpr synExpr3 + else + let inFront, r = CheckLongIdent longIdent + + if inFront then + Some(synExpr.Range) + else + Some((unionRanges synExpr.Range r)) + | SynExpr.DiscardAfterMissingQualificationAfterDot (synExpr, _range) -> // get this for e.g. "bar()." + if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then + traverseSynExpr synExpr + else + Some(synExpr.Range) + | SynExpr.FromParseError (synExpr, range) -> + if AstTraversal.rangeContainsPosLeftEdgeInclusive synExpr.Range pos then + traverseSynExpr synExpr + else + Some range + | SynExpr.App (ExprAtomicFlag.NonAtomic, + true, + (SynExpr.LongIdent(longDotId = SynLongIdent ([ ident ], _, _))), + rhs, + _) when + ident.idText = "op_ArrayLookup" + && not (AstTraversal.rangeContainsPosLeftEdgeInclusive rhs.Range pos) + -> + match defaultTraverse expr with + | None -> + // (expr).(expr) is an ML-deprecated array lookup, but we want intellisense on the dot + // also want it for e.g. [|arr|].(0) + Some(expr.Range) + | x -> x // we found the answer deeper somewhere in the lhs + | SynExpr.Const (SynConst.Double (_), range) -> Some range + | _ -> defaultTraverse expr + } + ) + /// searches for the expression island suitable for the evaluation by the debugger - let TryFindExpressionIslandInPosition(pos: pos, parseTreeOpt) = - match parseTreeOpt with - | None -> None + let TryFindExpressionIslandInPosition (pos: pos, parseTreeOpt) = + match parseTreeOpt with + | None -> None | Some parseTree -> - let getLidParts (lid : LongIdent) = - lid + let getLidParts (lid: LongIdent) = + lid |> Seq.takeWhile (fun i -> posGeq pos i.idRange.Start) |> Seq.map (fun i -> i.idText) |> Seq.toList @@ -627,27 +772,22 @@ module UntypedParseImpl = // tries to locate simple expression island // foundCandidate = false means that we are looking for the candidate expression // foundCandidate = true - we found candidate (DotGet) and now drill down to the left part - let rec TryGetExpression foundCandidate expr = + let rec TryGetExpression foundCandidate expr = match expr with - | SynExpr.Paren (e, _, _, _) when foundCandidate -> - TryGetExpression foundCandidate e - | SynExpr.LongIdent (_isOptional, LongIdentWithDots(lid, _), _altNameRefCell, _m) -> - getLidParts lid |> Some - | SynExpr.DotGet (leftPart, _, LongIdentWithDots(lid, _), _) when (rangeContainsPos (rangeOfLid lid) pos) || foundCandidate -> + | SynExpr.Paren (e, _, _, _) when foundCandidate -> TryGetExpression foundCandidate e + | SynExpr.LongIdent (_isOptional, LongIdentWithDots (lid, _), _altNameRefCell, _m) -> getLidParts lid |> Some + | SynExpr.DotGet (leftPart, _, LongIdentWithDots (lid, _), _) when (rangeContainsPos (rangeOfLid lid) pos) || foundCandidate -> // requested position is at the lid part of the DotGet // process left part and append result to the result of processing lid let leftPartResult = TryGetExpression true leftPart - match leftPartResult with - | Some leftPartResult -> - [ - yield! leftPartResult - yield! getLidParts lid - ] |> Some + + match leftPartResult with + | Some leftPartResult -> [ yield! leftPartResult; yield! getLidParts lid ] |> Some | None -> None | SynExpr.FromParseError (synExpr, _range) -> TryGetExpression foundCandidate synExpr | _ -> None - let rec walker = + let rec walker = { new AstTraversal.AstVisitorBase<_>() with member this.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = if rangeContainsPos expr.Range pos then @@ -655,7 +795,9 @@ module UntypedParseImpl = | (Some parts) -> parts |> String.concat "." |> Some | _ -> defaultTraverse expr else - None } + None + } + AstTraversal.Traverse(pos, parseTree, walker) // Given a cursor position here: @@ -670,371 +812,438 @@ module UntypedParseImpl = // ^ // would return None // TODO would be great to unify this with GetRangeOfExprLeftOfDot above, if possible, as they are similar - let TryFindExpressionASTLeftOfDotLeftOfCursor(pos, parseTreeOpt) = - match parseTreeOpt with - | None -> None + let TryFindExpressionASTLeftOfDotLeftOfCursor (pos, parseTreeOpt) = + match parseTreeOpt with + | None -> None | Some parseTree -> - let dive x = AstTraversal.dive x - let pick x = AstTraversal.pick pos x - let walker = - { new AstTraversal.AstVisitorBase<_>() with - member this.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = - let pick = pick expr.Range - let traverseSynExpr, defaultTraverse, expr = traverseSynExpr, defaultTraverse, expr // for debugging: debugger does not get object expression params as local vars - if not(rangeContainsPos expr.Range pos) then - match expr with - | SynExpr.DiscardAfterMissingQualificationAfterDot (e, _m) -> - // This happens with e.g. "f(x) . $" when you bring up a completion list a few spaces after a dot. The cursor is not 'in the parse tree', - // but the dive algorithm will dive down into this node, and this is the one case where we do want to give a result despite the cursor - // not properly being in a node. - match traverseSynExpr e with - | None -> Some (e.Range.End, false) - | r -> r - | _ -> - // This happens for e.g. "System.Console.[]$", where the ".[]" token is thrown away by the parser and we dive into the System.Console longId - // even though the cursor/dot is not in there. In those cases we want to return None, because there is not really a dot completion before - // the cursor location. - None - else - let rec traverseLidOrElse (optExprIfLeftOfLongId : SynExpr option) (LongIdentWithDots(lid, dots) as lidwd) = - let resultIfLeftOfLongId = - match optExprIfLeftOfLongId with - | None -> None - | Some e -> Some (e.Range.End, posGeq lidwd.Range.Start pos) - match dots |> List.mapi (fun i x -> i, x) |> List.rev |> List.tryFind (fun (_, m) -> posGt pos m.Start) with - | None -> resultIfLeftOfLongId - | Some (n, _) -> Some ((List.item n lid).idRange.End, (List.length lid = n+1) // foo.$ - || (posGeq (List.item (n+1) lid).idRange.Start pos)) // foo.$bar - match expr with - | SynExpr.LongIdent (_isOptional, lidwd, _altNameRefCell, _m) -> - traverseLidOrElse None lidwd - | SynExpr.LongIdentSet (lidwd, exprRhs, _m) -> - [ dive lidwd lidwd.Range (traverseLidOrElse None) - dive exprRhs exprRhs.Range traverseSynExpr - ] |> pick expr - | SynExpr.DotGet (exprLeft, dotm, lidwd, _m) -> - let afterDotBeforeLid = mkRange dotm.FileName dotm.End lidwd.Range.Start - [ dive exprLeft exprLeft.Range traverseSynExpr - dive exprLeft afterDotBeforeLid (fun e -> Some (e.Range.End, true)) - dive lidwd lidwd.Range (traverseLidOrElse (Some exprLeft)) - ] |> pick expr - | SynExpr.DotSet (exprLeft, lidwd, exprRhs, _m) -> - [ dive exprLeft exprLeft.Range traverseSynExpr - dive lidwd lidwd.Range (traverseLidOrElse(Some exprLeft)) - dive exprRhs exprRhs.Range traverseSynExpr - ] |> pick expr - | SynExpr.Set (exprLeft, exprRhs, _m) -> - [ dive exprLeft exprLeft.Range traverseSynExpr - dive exprRhs exprRhs.Range traverseSynExpr - ] |> pick expr - | SynExpr.NamedIndexedPropertySet (lidwd, exprIndexer, exprRhs, _m) -> - [ dive lidwd lidwd.Range (traverseLidOrElse None) - dive exprIndexer exprIndexer.Range traverseSynExpr - dive exprRhs exprRhs.Range traverseSynExpr - ] |> pick expr - | SynExpr.DotNamedIndexedPropertySet (exprLeft, lidwd, exprIndexer, exprRhs, _m) -> - [ dive exprLeft exprLeft.Range traverseSynExpr - dive lidwd lidwd.Range (traverseLidOrElse(Some exprLeft)) - dive exprIndexer exprIndexer.Range traverseSynExpr - dive exprRhs exprRhs.Range traverseSynExpr - ] |> pick expr - | SynExpr.Const (SynConst.Double(_), m) -> - if posEq m.End pos then - // the cursor is at the dot - Some (m.End, false) - else - // the cursor is left of the dot + let dive x = AstTraversal.dive x + let pick x = AstTraversal.pick pos x + + let walker = + { new AstTraversal.AstVisitorBase<_>() with + member this.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = + let pick = pick expr.Range + let traverseSynExpr, defaultTraverse, expr = traverseSynExpr, defaultTraverse, expr // for debugging: debugger does not get object expression params as local vars + + if not (rangeContainsPos expr.Range pos) then + match expr with + | SynExpr.DiscardAfterMissingQualificationAfterDot (e, _m) -> + // This happens with e.g. "f(x) . $" when you bring up a completion list a few spaces after a dot. The cursor is not 'in the parse tree', + // but the dive algorithm will dive down into this node, and this is the one case where we do want to give a result despite the cursor + // not properly being in a node. + match traverseSynExpr e with + | None -> Some(e.Range.End, false) + | r -> r + | _ -> + // This happens for e.g. "System.Console.[]$", where the ".[]" token is thrown away by the parser and we dive into the System.Console longId + // even though the cursor/dot is not in there. In those cases we want to return None, because there is not really a dot completion before + // the cursor location. None - | SynExpr.DiscardAfterMissingQualificationAfterDot (e, m) -> - match traverseSynExpr e with - | None -> + else + let rec traverseLidOrElse (optExprIfLeftOfLongId: SynExpr option) (LongIdentWithDots (lid, dots) as lidwd) = + let resultIfLeftOfLongId = + match optExprIfLeftOfLongId with + | None -> None + | Some e -> Some(e.Range.End, posGeq lidwd.Range.Start pos) + + match dots + |> List.mapi (fun i x -> i, x) + |> List.rev + |> List.tryFind (fun (_, m) -> posGt pos m.Start) + with + | None -> resultIfLeftOfLongId + | Some (n, _) -> + Some( + (List.item n lid).idRange.End, + (List.length lid = n + 1) // foo.$ + || (posGeq (List.item (n + 1) lid).idRange.Start pos) + ) // foo.$bar + + match expr with + | SynExpr.LongIdent (_isOptional, lidwd, _altNameRefCell, _m) -> traverseLidOrElse None lidwd + | SynExpr.LongIdentSet (lidwd, exprRhs, _m) -> + [ + dive lidwd lidwd.Range (traverseLidOrElse None) + dive exprRhs exprRhs.Range traverseSynExpr + ] + |> pick expr + | SynExpr.DotGet (exprLeft, dotm, lidwd, _m) -> + let afterDotBeforeLid = mkRange dotm.FileName dotm.End lidwd.Range.Start + + [ + dive exprLeft exprLeft.Range traverseSynExpr + dive exprLeft afterDotBeforeLid (fun e -> Some(e.Range.End, true)) + dive lidwd lidwd.Range (traverseLidOrElse (Some exprLeft)) + ] + |> pick expr + | SynExpr.DotSet (exprLeft, lidwd, exprRhs, _m) -> + [ + dive exprLeft exprLeft.Range traverseSynExpr + dive lidwd lidwd.Range (traverseLidOrElse (Some exprLeft)) + dive exprRhs exprRhs.Range traverseSynExpr + ] + |> pick expr + | SynExpr.Set (exprLeft, exprRhs, _m) -> + [ + dive exprLeft exprLeft.Range traverseSynExpr + dive exprRhs exprRhs.Range traverseSynExpr + ] + |> pick expr + | SynExpr.NamedIndexedPropertySet (lidwd, exprIndexer, exprRhs, _m) -> + [ + dive lidwd lidwd.Range (traverseLidOrElse None) + dive exprIndexer exprIndexer.Range traverseSynExpr + dive exprRhs exprRhs.Range traverseSynExpr + ] + |> pick expr + | SynExpr.DotNamedIndexedPropertySet (exprLeft, lidwd, exprIndexer, exprRhs, _m) -> + [ + dive exprLeft exprLeft.Range traverseSynExpr + dive lidwd lidwd.Range (traverseLidOrElse (Some exprLeft)) + dive exprIndexer exprIndexer.Range traverseSynExpr + dive exprRhs exprRhs.Range traverseSynExpr + ] + |> pick expr + | SynExpr.Const (SynConst.Double (_), m) -> if posEq m.End pos then // the cursor is at the dot - Some (e.Range.End, false) + Some(m.End, false) else // the cursor is left of the dot None - | r -> r - | SynExpr.App (ExprAtomicFlag.NonAtomic, true, (SynExpr.LongIdent(longDotId = SynLongIdent([ident], _, _))), lhs, _m) - when ident.idText = "op_ArrayLookup" - && not(AstTraversal.rangeContainsPosLeftEdgeInclusive lhs.Range pos) -> - match defaultTraverse expr with - | None -> - // (expr).(expr) is an ML-deprecated array lookup, but we want intellisense on the dot - // also want it for e.g. [|arr|].(0) - Some (lhs.Range.End, false) - | x -> x // we found the answer deeper somewhere in the lhs - | _ -> defaultTraverse expr } - AstTraversal.Traverse(pos, parseTree, walker) - + | SynExpr.DiscardAfterMissingQualificationAfterDot (e, m) -> + match traverseSynExpr e with + | None -> + if posEq m.End pos then + // the cursor is at the dot + Some(e.Range.End, false) + else + // the cursor is left of the dot + None + | r -> r + | SynExpr.App (ExprAtomicFlag.NonAtomic, + true, + (SynExpr.LongIdent(longDotId = SynLongIdent ([ ident ], _, _))), + lhs, + _m) when + ident.idText = "op_ArrayLookup" + && not (AstTraversal.rangeContainsPosLeftEdgeInclusive lhs.Range pos) + -> + match defaultTraverse expr with + | None -> + // (expr).(expr) is an ML-deprecated array lookup, but we want intellisense on the dot + // also want it for e.g. [|arr|].(0) + Some(lhs.Range.End, false) + | x -> x // we found the answer deeper somewhere in the lhs + | _ -> defaultTraverse expr + } + + AstTraversal.Traverse(pos, parseTree, walker) + let GetEntityKind (pos: pos, input: ParsedInput) : EntityKind option = - let (|ConstructorPats|) = function + let (|ConstructorPats|) = + function | Pats ps -> ps - | NamePatPairs(xs, _) -> List.map snd xs + | 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] + let rec (|Sequentials|_|) = + function + | SynExpr.Sequential (_, _, e, Sequentials es, _) -> Some(e :: es) + | SynExpr.Sequential (_, _, e1, e2, _) -> Some [ e1; e2 ] | _ -> None let inline isPosInRange range = rangeContainsPos range pos let inline ifPosInRange range f = - if isPosInRange range then f() - else None + if isPosInRange range then f () else None - let rec walkImplFileInput (ParsedImplFileInput (modules = moduleOrNamespaceList)) = + let rec walkImplFileInput (ParsedImplFileInput (modules = moduleOrNamespaceList)) = List.tryPick (walkSynModuleOrNamespace true) moduleOrNamespaceList - and walkSynModuleOrNamespace isTopLevel (SynModuleOrNamespace(_, _, _, decls, _, Attributes attrs, _, r)) = + and walkSynModuleOrNamespace isTopLevel (SynModuleOrNamespace (_, _, _, decls, _, Attributes attrs, _, r)) = 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 + 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 walkTypar (Typar (ident, _, _)) = + ifPosInRange ident.idRange (fun _ -> Some EntityKind.Type) - and walkTyparDecl (SynTyparDecl.TyparDecl (Attributes attrs, typar)) = - List.tryPick walkAttribute attrs - |> Option.orElse (walkTypar typar) - - and walkTypeConstraint = function + and walkTyparDecl (SynTyparDecl.TyparDecl (Attributes 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.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 + | 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, Attributes attrs, _) -> walkPat pat |> Option.orElse (List.tryPick walkAttribute attrs) - | SynPat.Or(pat1, pat2, _) -> List.tryPick walkPat [pat1; pat2] - | SynPat.LongIdent(_, _, typars, ConstructorPats pats, _, r) -> + | 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, Attributes 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)) -> + typars + |> Option.bind (fun (SynValTyparDecls (typars, _, constraints)) -> List.tryPick walkTyparDecl typars - |> Option.orElse (List.tryPick walkTypeConstraint constraints))) + |> 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 + | 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(_, _, _, _, Attributes attrs, _, _, pat, returnInfo, e, _, _)) = + and walkBinding (SynBinding.Binding (_, _, _, _, Attributes 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) + | None -> None + ) - and walkInterfaceImpl (InterfaceImpl(_, bindings, _)) = - List.tryPick walkBinding bindings + and walkInterfaceImpl (InterfaceImpl (_, bindings, _)) = List.tryPick walkBinding bindings - and walkIndexerArg = function + and walkIndexerArg = + function | SynIndexerArg.One (e, _, _) -> walkExpr e - | SynIndexerArg.Two(e1, _, e2, _, _, _) -> List.tryPick walkExpr [e1; e2] + | SynIndexerArg.Two (e1, _, e2, _, _, _) -> List.tryPick walkExpr [ e1; e2 ] - and walkType = function - | SynType.LongIdent ident -> + and walkType = + function + | SynType.LongIdent ident -> // we protect it with try..with because System.Exception : rangeOfLidwd may raise // at FSharp.Compiler.SyntaxTree.LongIdentWithDots.get_Range() in D:\j\workspace\release_ci_pa---3f142ccc\src\ast.fs: line 156 - try ifPosInRange ident.Range (fun _ -> Some EntityKind.Type) with _ -> None - | 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 - | SynType.Paren(t, _) -> walkType t + try + ifPosInRange ident.Range (fun _ -> Some EntityKind.Type) + with _ -> + None + | 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 + | SynType.Paren (t, _) -> walkType t | _ -> None - and walkClause (Clause(pat, e1, e2, _, _)) = - walkPatWithKind (Some EntityKind.Type) pat + 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) -> + 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 = + | [] when isPosInRange r -> parentKind |> Option.orElse (Some(EntityKind.FunctionOrValue false)) + | firstDotRange :: _ -> + let firstPartRange = mkRange "" r.Start (mkPos firstDotRange.StartLine (firstDotRange.StartColumn - 1)) + if isPosInRange firstPartRange then - parentKind |> Option.orElse (Some (EntityKind.FunctionOrValue false)) - else None + 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) -> + | SynExpr.Record (_, _, fields, r) -> ifPosInRange r (fun _ -> - fields |> List.tryPick (fun (_, e, _) -> e |> Option.bind (walkExprWithKind parentKind))) + 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, _, _) -> + | 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.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.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.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.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.Set (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.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.JoinIn (e1, _, e2, _) -> List.tryPick (walkExprWithKind parentKind) [ e1; e2 ] | SynExpr.YieldOrReturn (_, e, _) -> walkExprWithKind parentKind e | SynExpr.YieldOrReturnFrom (_, e, _) -> walkExprWithKind parentKind e | SynExpr.Match (_, e, synMatchClauseList, _) - | SynExpr.MatchBang (_, e, synMatchClauseList, _) -> - walkExprWithKind parentKind e |> Option.orElse (List.tryPick walkClause synMatchClauseList) - | SynExpr.LetOrUseBang(_, _, _, _, e1, es, e2, _) -> + | SynExpr.MatchBang (_, e, synMatchClauseList, _) -> + walkExprWithKind parentKind e + |> Option.orElse (List.tryPick walkClause synMatchClauseList) + | SynExpr.LetOrUseBang (_, _, _, _, e1, es, e2, _) -> [ yield e1 - for (_,_,_,_,eAndBang,_) in es do + for (_, _, _, _, eAndBang, _) in es do yield eAndBang yield e2 ] - |> List.tryPick (walkExprWithKind parentKind) + |> List.tryPick (walkExprWithKind parentKind) | SynExpr.DoBang (e, _) -> walkExprWithKind parentKind e | SynExpr.TraitCall (ts, sign, e, _) -> - List.tryPick walkTypar ts + List.tryPick walkTypar ts |> Option.orElse (walkMemberSig sign) |> Option.orElse (walkExprWithKind parentKind e) | _ -> None and walkExpr = walkExprWithKind None - and walkSimplePat = function - | SynSimplePat.Attrib (pat, Attributes attrs, _) -> - walkSimplePat pat |> Option.orElse (List.tryPick walkAttribute attrs) - | SynSimplePat.Typed(pat, t, _) -> walkSimplePat pat |> Option.orElse (walkType t) + and walkSimplePat = + function + | SynSimplePat.Attrib (pat, Attributes attrs, _) -> walkSimplePat pat |> Option.orElse (List.tryPick walkAttribute attrs) + | SynSimplePat.Typed (pat, t, _) -> walkSimplePat pat |> Option.orElse (walkType t) | _ -> None - and walkField (SynField.Field(Attributes attrs, _, _, t, _, _, _, _)) = + and walkField (SynField.Field (Attributes attrs, _, _, t, _, _, _, _)) = List.tryPick walkAttribute attrs |> Option.orElse (walkType t) - and walkValSig (SynValSig.ValSpfn(Attributes attrs, _, _, t, _, _, _, _, _, _, _)) = + and walkValSig (SynValSig.ValSpfn (Attributes attrs, _, _, t, _, _, _, _, _, _, _)) = List.tryPick walkAttribute attrs |> Option.orElse (walkType t) - and walkMemberSig = function + 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, _), _) -> + | 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 + and walkMember = + function | SynMemberDefn.AbstractSlot (valSig, _, _) -> walkValSig valSig - | SynMemberDefn.Member(binding, _) -> walkBinding binding - | SynMemberDefn.ImplicitCtor(_, Attributes attrs, SynSimplePats.SimplePats(simplePats, _), _, _, _) -> - List.tryPick walkAttribute attrs |> Option.orElse (List.tryPick walkSimplePat simplePats) - | 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(Attributes attrs, _, _, t, _, _, _, _, e, _, _) -> + | SynMemberDefn.Member (binding, _) -> walkBinding binding + | SynMemberDefn.ImplicitCtor (_, Attributes attrs, SynSimplePats.SimplePats (simplePats, _), _, _, _) -> + List.tryPick walkAttribute attrs + |> Option.orElse (List.tryPick walkSimplePat simplePats) + | 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 (Attributes attrs, _, _, t, _, _, _, _, e, _, _) -> List.tryPick walkAttribute attrs |> Option.orElse (Option.bind walkType t) |> Option.orElse (walkExpr e) | _ -> None - and walkEnumCase (EnumCase(Attributes attrs, _, _, _, _)) = List.tryPick walkAttribute attrs + and walkEnumCase (EnumCase (Attributes attrs, _, _, _, _)) = List.tryPick walkAttribute attrs - and walkUnionCaseType = function + and walkUnionCaseType = + function | SynUnionCaseType.UnionCaseFields fields -> List.tryPick walkField fields - | SynUnionCaseType.UnionCaseFullType(t, _) -> walkType t + | SynUnionCaseType.UnionCaseFullType (t, _) -> walkType t - and walkUnionCase (UnionCase(Attributes attrs, _, t, _, _, _)) = + and walkUnionCase (UnionCase (Attributes attrs, _, t, _, _, _)) = List.tryPick walkAttribute attrs |> Option.orElse (walkUnionCaseType t) - and walkTypeDefnSimple = function + 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 + | SynTypeDefnSimpleRepr.Union (_, cases, _) -> List.tryPick walkUnionCase cases + | SynTypeDefnSimpleRepr.Record (_, fields, _) -> List.tryPick walkField fields + | SynTypeDefnSimpleRepr.TypeAbbrev (_, t, _) -> walkType t | _ -> None - and walkComponentInfo isModule (ComponentInfo(Attributes attrs, typars, constraints, _, _, _, _, r)) = - if isModule then None else ifPosInRange r (fun _ -> Some EntityKind.Type) + and walkComponentInfo isModule (ComponentInfo (Attributes 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)) + |> Option.orElse (List.tryPick walkTypeConstraint constraints) + ) - and walkTypeDefnRepr = function + and walkTypeDefnRepr = + function | SynTypeDefnRepr.ObjectModel (_, defns, _) -> List.tryPick walkMember defns - | SynTypeDefnRepr.Simple(defn, _) -> walkTypeDefnSimple defn - | SynTypeDefnRepr.Exception(_) -> None + | SynTypeDefnRepr.Simple (defn, _) -> walkTypeDefnSimple defn + | SynTypeDefnRepr.Exception (_) -> None - and walkTypeDefnSigRepr = function + and walkTypeDefnSigRepr = + function | SynTypeDefnSigRepr.ObjectModel (_, defns, _) -> List.tryPick walkMemberSig defns - | SynTypeDefnSigRepr.Simple(defn, _) -> walkTypeDefnSimple defn - | SynTypeDefnSigRepr.Exception(_) -> None + | SynTypeDefnSigRepr.Simple (defn, _) -> walkTypeDefnSimple defn + | SynTypeDefnSigRepr.Exception (_) -> None and walkTypeDefn (TypeDefn (info, repr, members, _)) = walkComponentInfo false info @@ -1044,7 +1253,7 @@ module UntypedParseImpl = and walkSynModuleDecl isTopLevel (decl: SynModuleDecl) = match decl with | SynModuleDecl.NamespaceFragment fragment -> walkSynModuleOrNamespace isTopLevel fragment - | SynModuleDecl.NestedModule(info, _, modules, _, range) -> + | SynModuleDecl.NestedModule (info, _, modules, _, range) -> walkComponentInfo true info |> Option.orElse (ifPosInRange range (fun _ -> List.tryPick (walkSynModuleDecl false) modules)) | SynModuleDecl.Open _ -> None @@ -1053,205 +1262,226 @@ module UntypedParseImpl = | SynModuleDecl.Types (types, _) -> List.tryPick walkTypeDefn types | _ -> None - match input with + match input with | ParsedInput.SigFile _ -> None | ParsedInput.ImplFile input -> walkImplFileInput input type internal TS = AstTraversal.TraverseStep + /// Matches the most nested [< and >] pair. - let insideAttributeApplicationRegex = Regex(@"(?<=\[\<)(?(.*?))(?=\>\])", RegexOptions.Compiled ||| RegexOptions.ExplicitCapture) + let insideAttributeApplicationRegex = + Regex(@"(?<=\[\<)(?(.*?))(?=\>\])", RegexOptions.Compiled ||| RegexOptions.ExplicitCapture) /// Try to determine completion context for the given pair (row, columns) - let TryGetCompletionContext (pos, parsedInput: ParsedInput, lineStr: string) : CompletionContext option = + let TryGetCompletionContext (pos, parsedInput: ParsedInput, lineStr: string) : CompletionContext option = match GetEntityKind(pos, parsedInput) with | Some EntityKind.Attribute -> Some CompletionContext.AttributeApplication | _ -> - - let parseLid (LongIdentWithDots(lid, dots)) = - let rec collect plid (parts : Ident list) (dots : range list) = - match parts, dots with - | [], _ -> Some (plid, None) - | x :: xs, ds -> - if rangeContainsPos x.idRange pos then - // pos lies with the range of current identifier - let s = x.idText.Substring(0, pos.Column - x.idRange.Start.Column) - let residue = if s.Length <> 0 then Some s else None - Some (plid, residue) - elif posGt x.idRange.Start pos then - // can happen if caret is placed after dot but before the existing identifier A. $ B - // return accumulated plid with no residue - Some (plid, None) - else - match ds with - | [] -> - // pos lies after the id and no dots found - return accumulated plid and current id as residue - Some (plid, Some (x.idText)) - | d :: ds -> - if posGeq pos d.End then - // pos lies after the dot - proceed to the next identifier - collect ((x.idText) :: plid) xs ds - else - // pos after the id but before the dot - // A $.B - return nothing - None - match collect [] lid dots with - | Some (parts, residue) -> - Some ((List.rev parts), residue) - | None -> None - - let (|Class|Interface|Struct|Unknown|Invalid|) synAttributes = - let (|SynAttr|_|) name (attr : SynAttribute) = - match attr with - | {TypeName = LongIdentWithDots([x], _)} when x.idText = name -> Some () - | _ -> None - - let rec getKind isClass isInterface isStruct = - function - | [] -> isClass, isInterface, isStruct - | (SynAttr "Class") :: xs -> getKind true isInterface isStruct xs - | (SynAttr "AbstractClass") :: xs -> getKind true isInterface isStruct xs - | (SynAttr "Interface") :: xs -> getKind isClass true isStruct xs - | (SynAttr "Struct") :: xs -> getKind isClass isInterface true xs - | _ :: xs -> getKind isClass isInterface isStruct xs - - match getKind false false false synAttributes with - | false, false, false -> Unknown - | true, false, false -> Class - | false, true, false -> Interface - | false, false, true -> Struct - | _ -> Invalid - - let GetCompletionContextForInheritSynMember ((ComponentInfo(Attributes synAttributes, _, _, _, _, _, _, _)), typeDefnKind : SynTypeDefnKind, completionPath) = - - let success k = Some (CompletionContext.Inherit (k, completionPath)) - - // if kind is specified - take it - // if kind is non-specified - // - try to obtain it from attribute - // - if no attributes present - infer kind from members - match typeDefnKind with - | TyconClass -> - match synAttributes with - | Class | Unknown -> success InheritanceContext.Class - | _ -> Some CompletionContext.Invalid // non-matching attributes - | TyconInterface -> - match synAttributes with - | Interface | Unknown -> success InheritanceContext.Interface - | _ -> Some CompletionContext.Invalid // non-matching attributes - | TyconStruct -> - // display nothing for structs - Some CompletionContext.Invalid - | TyconUnspecified -> - match synAttributes with - | Class -> success InheritanceContext.Class - | Interface -> success InheritanceContext.Interface - | Unknown -> - // user do not specify kind explicitly or via attributes - success InheritanceContext.Unknown - | _ -> - // unable to uniquely detect kind from the attributes - return invalid context + let parseLid (LongIdentWithDots (lid, dots)) = + let rec collect plid (parts: Ident list) (dots: range list) = + match parts, dots with + | [], _ -> Some(plid, None) + | x :: xs, ds -> + if rangeContainsPos x.idRange pos then + // pos lies with the range of current identifier + let s = x.idText.Substring(0, pos.Column - x.idRange.Start.Column) + let residue = if s.Length <> 0 then Some s else None + Some(plid, residue) + elif posGt x.idRange.Start pos then + // can happen if caret is placed after dot but before the existing identifier A. $ B + // return accumulated plid with no residue + Some(plid, None) + else + match ds with + | [] -> + // pos lies after the id and no dots found - return accumulated plid and current id as residue + Some(plid, Some(x.idText)) + | d :: ds -> + if posGeq pos d.End then + // pos lies after the dot - proceed to the next identifier + collect ((x.idText) :: plid) xs ds + else + // pos after the id but before the dot + // A $.B - return nothing + None + + match collect [] lid dots with + | Some (parts, residue) -> Some((List.rev parts), residue) + | None -> None + + let (|Class|Interface|Struct|Unknown|Invalid|) synAttributes = + let (|SynAttr|_|) name (attr: SynAttribute) = + match attr with + | { + TypeName = LongIdentWithDots ([ x ], _) + } when x.idText = name -> Some() + | _ -> None + + let rec getKind isClass isInterface isStruct = + function + | [] -> isClass, isInterface, isStruct + | (SynAttr "Class") :: xs -> getKind true isInterface isStruct xs + | (SynAttr "AbstractClass") :: xs -> getKind true isInterface isStruct xs + | (SynAttr "Interface") :: xs -> getKind isClass true isStruct xs + | (SynAttr "Struct") :: xs -> getKind isClass isInterface true xs + | _ :: xs -> getKind isClass isInterface isStruct xs + + match getKind false false false synAttributes with + | false, false, false -> Unknown + | true, false, false -> Class + | false, true, false -> Interface + | false, false, true -> Struct + | _ -> Invalid + + let GetCompletionContextForInheritSynMember + ( + (ComponentInfo (Attributes synAttributes, _, _, _, _, _, _, _)), + typeDefnKind: SynTypeDefnKind, + completionPath + ) = + + let success k = + Some(CompletionContext.Inherit(k, completionPath)) + + // if kind is specified - take it + // if kind is non-specified + // - try to obtain it from attribute + // - if no attributes present - infer kind from members + match typeDefnKind with + | TyconClass -> + match synAttributes with + | Class + | Unknown -> success InheritanceContext.Class + | _ -> Some CompletionContext.Invalid // non-matching attributes + | TyconInterface -> + match synAttributes with + | Interface + | Unknown -> success InheritanceContext.Interface + | _ -> Some CompletionContext.Invalid // non-matching attributes + | TyconStruct -> + // display nothing for structs Some CompletionContext.Invalid - | _ -> None + | TyconUnspecified -> + match synAttributes with + | Class -> success InheritanceContext.Class + | Interface -> success InheritanceContext.Interface + | Unknown -> + // user do not specify kind explicitly or via attributes + success InheritanceContext.Unknown + | _ -> + // unable to uniquely detect kind from the attributes - return invalid context + Some CompletionContext.Invalid + | _ -> None - let (|Operator|_|) name e = - match e with - | SynExpr.App (ExprAtomicFlag.NonAtomic, false, SynExpr.App (ExprAtomicFlag.NonAtomic, true, SynExpr.Ident ident, lhs, _), rhs, _) - when ident.idText = name -> Some (lhs, rhs) - | _ -> None + let (|Operator|_|) name e = + match e with + | SynExpr.App (ExprAtomicFlag.NonAtomic, + false, + SynExpr.App (ExprAtomicFlag.NonAtomic, true, SynExpr.Ident ident, lhs, _), + rhs, + _) when ident.idText = name -> Some(lhs, rhs) + | _ -> None - // checks if we are in rhs of the range operator - let isInRhsOfRangeOp (p : AstTraversal.TraversePath) = - match p with - | TS.Expr(Operator "op_Range" _) :: _ -> true - | _ -> false + // checks if we are in rhs of the range operator + let isInRhsOfRangeOp (p: AstTraversal.TraversePath) = + match p with + | TS.Expr (Operator "op_Range" _) :: _ -> true + | _ -> false - let (|Setter|_|) e = - match e with - | Operator "op_Equality" (SynExpr.Ident id, _) -> Some id - | _ -> None + let (|Setter|_|) e = + match e with + | Operator "op_Equality" (SynExpr.Ident id, _) -> Some id + | _ -> None - let findSetters argList = - match argList with - | SynExpr.Paren (SynExpr.Tuple (false, parameters, _, _), _, _, _) -> - let setters = HashSet() - for p in parameters do - match p with - | Setter id -> ignore(setters.Add id.idText) - | _ -> () - setters - | _ -> emptyStringSet - - let endOfLastIdent (lid: LongIdentWithDots) = - let last = List.last lid.Lid - last.idRange.End - - let endOfClosingTokenOrLastIdent (mClosing: range option) (lid : LongIdentWithDots) = - match mClosing with - | Some m -> m.End - | None -> endOfLastIdent lid - - let endOfClosingTokenOrIdent (mClosing: range option) (id : Ident) = - match mClosing with - | Some m -> m.End - | None -> id.idRange.End - - let (|NewObjectOrMethodCall|_|) e = - match e with - | (SynExpr.New (_, SynType.LongIdent typeName, arg, _)) -> - // new A() - Some (endOfLastIdent typeName, findSetters arg) - | (SynExpr.New (_, SynType.App(StripParenTypes (SynType.LongIdent typeName), _, _, _, mGreaterThan, _, _), arg, _)) -> - // new A<_>() - Some (endOfClosingTokenOrLastIdent mGreaterThan typeName, findSetters arg) - | (SynExpr.App (_, false, SynExpr.Ident id, arg, _)) -> - // A() - Some (id.idRange.End, findSetters arg) - | (SynExpr.App (_, false, SynExpr.TypeApp (SynExpr.Ident id, _, _, _, mGreaterThan, _, _), arg, _)) -> - // A<_>() - Some (endOfClosingTokenOrIdent mGreaterThan id, findSetters arg) - | (SynExpr.App (_, false, SynExpr.LongIdent (_, lid, _, _), arg, _)) -> - // A.B() - Some (endOfLastIdent lid, findSetters arg) - | (SynExpr.App (_, false, SynExpr.TypeApp (SynExpr.LongIdent (_, lid, _, _), _, _, _, mGreaterThan, _, _), arg, _)) -> - // A.B<_>() - Some (endOfClosingTokenOrLastIdent mGreaterThan lid, findSetters arg) - | _ -> None - - let isOnTheRightOfComma (elements: SynExpr list) (commas: range list) current = - let rec loop elements (commas: range list) = - match elements with - | x :: xs -> - match commas with - | c :: cs -> - if x === current then posLt c.End pos || posEq c.End pos - else loop xs cs + let findSetters argList = + match argList with + | SynExpr.Paren (SynExpr.Tuple (false, parameters, _, _), _, _, _) -> + let setters = HashSet() + + for p in parameters do + match p with + | Setter id -> ignore (setters.Add id.idText) + | _ -> () + + setters + | _ -> emptyStringSet + + let endOfLastIdent (lid: LongIdentWithDots) = + let last = List.last lid.Lid + last.idRange.End + + let endOfClosingTokenOrLastIdent (mClosing: range option) (lid: LongIdentWithDots) = + match mClosing with + | Some m -> m.End + | None -> endOfLastIdent lid + + let endOfClosingTokenOrIdent (mClosing: range option) (id: Ident) = + match mClosing with + | Some m -> m.End + | None -> id.idRange.End + + let (|NewObjectOrMethodCall|_|) e = + match e with + | (SynExpr.New (_, SynType.LongIdent typeName, arg, _)) -> + // new A() + Some(endOfLastIdent typeName, findSetters arg) + | (SynExpr.New (_, SynType.App (StripParenTypes (SynType.LongIdent typeName), _, _, _, mGreaterThan, _, _), arg, _)) -> + // new A<_>() + Some(endOfClosingTokenOrLastIdent mGreaterThan typeName, findSetters arg) + | (SynExpr.App (_, false, SynExpr.Ident id, arg, _)) -> + // A() + Some(id.idRange.End, findSetters arg) + | (SynExpr.App (_, false, SynExpr.TypeApp (SynExpr.Ident id, _, _, _, mGreaterThan, _, _), arg, _)) -> + // A<_>() + Some(endOfClosingTokenOrIdent mGreaterThan id, findSetters arg) + | (SynExpr.App (_, false, SynExpr.LongIdent (_, lid, _, _), arg, _)) -> + // A.B() + Some(endOfLastIdent lid, findSetters arg) + | (SynExpr.App (_, false, SynExpr.TypeApp (SynExpr.LongIdent (_, lid, _, _), _, _, _, mGreaterThan, _, _), arg, _)) -> + // A.B<_>() + Some(endOfClosingTokenOrLastIdent mGreaterThan lid, findSetters arg) + | _ -> None + + let isOnTheRightOfComma (elements: SynExpr list) (commas: range list) current = + let rec loop elements (commas: range list) = + match elements with + | x :: xs -> + match commas with + | c :: cs -> + if x === current then + posLt c.End pos || posEq c.End pos + else + loop xs cs + | _ -> false | _ -> false - | _ -> false - loop elements commas - - let (|PartOfParameterList|_|) precedingArgument path = - match path with - | TS.Expr(SynExpr.Paren _) :: TS.Expr(NewObjectOrMethodCall args) :: _ -> - if Option.isSome precedingArgument then None else Some args - | TS.Expr(SynExpr.Tuple (false, elements, commas, _)) :: TS.Expr(SynExpr.Paren _) :: TS.Expr(NewObjectOrMethodCall args) :: _ -> - match precedingArgument with - | None -> Some args - | Some e -> - // if expression is passed then - // 1. find it in among elements of the tuple - // 2. find corresponding comma - // 3. check that current position is past the comma - // this is used for cases like (a = something-here.) if the cursor is after . - // in this case this is not object initializer completion context - if isOnTheRightOfComma elements commas e then Some args else None - | _ -> None - let walker = - { - new AstTraversal.AstVisitorBase<_>() with - member __.VisitExpr(path, _, defaultTraverse, expr) = + loop elements commas + + let (|PartOfParameterList|_|) precedingArgument path = + match path with + | TS.Expr (SynExpr.Paren _) :: TS.Expr (NewObjectOrMethodCall args) :: _ -> + if Option.isSome precedingArgument then None else Some args + | TS.Expr (SynExpr.Tuple (false, elements, commas, _)) :: TS.Expr (SynExpr.Paren _) :: TS.Expr (NewObjectOrMethodCall args) :: _ -> + match precedingArgument with + | None -> Some args + | Some e -> + // if expression is passed then + // 1. find it in among elements of the tuple + // 2. find corresponding comma + // 3. check that current position is past the comma + // this is used for cases like (a = something-here.) if the cursor is after . + // in this case this is not object initializer completion context + if isOnTheRightOfComma elements commas e then + Some args + else + None + | _ -> None + + let walker = + { new AstTraversal.AstVisitorBase<_>() with + member __.VisitExpr(path, _, defaultTraverse, expr) = if isInRhsOfRangeOp path then match defaultTraverse expr with @@ -1262,114 +1492,133 @@ module UntypedParseImpl = // new A($) | SynExpr.Const (SynConst.Unit, m) when rangeContainsPos m pos -> match path with - | TS.Expr(NewObjectOrMethodCall args) :: _ -> - Some (CompletionContext.ParameterList args) - | _ -> - defaultTraverse expr + | TS.Expr (NewObjectOrMethodCall args) :: _ -> Some(CompletionContext.ParameterList args) + | _ -> defaultTraverse expr // new (... A$) | SynExpr.Ident id when id.idRange.End = pos -> match path with - | PartOfParameterList None args -> - Some (CompletionContext.ParameterList args) - | _ -> - defaultTraverse expr + | PartOfParameterList None args -> Some(CompletionContext.ParameterList args) + | _ -> defaultTraverse expr // new (A$ = 1) // new (A = 1, $) | Setter id when id.idRange.End = pos || rangeBeforePos expr.Range pos -> let precedingArgument = if id.idRange.End = pos then None else Some expr + match path with - | PartOfParameterList precedingArgument args-> - Some (CompletionContext.ParameterList args) - | _ -> - defaultTraverse expr - + | PartOfParameterList precedingArgument args -> Some(CompletionContext.ParameterList args) + | _ -> defaultTraverse expr + | _ -> defaultTraverse expr - member __.VisitRecordField(path, copyOpt, field) = - let contextFromTreePath completionPath = + member __.VisitRecordField(path, copyOpt, field) = + let contextFromTreePath completionPath = // detect records usage in constructor match path with - | TS.Expr(_) :: TS.Binding(_) :: TS.MemberDefn(_) :: TS.TypeDefn(SynTypeDefn.TypeDefn(ComponentInfo(_, _, _, [id], _, _, _, _), _, _, _)) :: _ -> + | TS.Expr (_) :: TS.Binding (_) :: TS.MemberDefn (_) :: TS.TypeDefn (SynTypeDefn.TypeDefn (ComponentInfo (_, + _, + _, + [ id ], + _, + _, + _, + _), + _, + _, + _)) :: _ -> RecordContext.Constructor(id.idText) | _ -> RecordContext.New completionPath + match field with - | Some field -> + | Some field -> match parseLid field with | Some completionPath -> - let recordContext = + let recordContext = match copyOpt with - | Some (s : SynExpr) -> RecordContext.CopyOnUpdate(s.Range, completionPath) + | Some (s: SynExpr) -> RecordContext.CopyOnUpdate(s.Range, completionPath) | None -> contextFromTreePath completionPath - Some (CompletionContext.RecordField recordContext) + + Some(CompletionContext.RecordField recordContext) | None -> None | None -> - let recordContext = + let recordContext = match copyOpt with | Some s -> RecordContext.CopyOnUpdate(s.Range, ([], None)) | None -> contextFromTreePath ([], None) - Some (CompletionContext.RecordField recordContext) - - member __.VisitInheritSynMemberDefn(componentInfo, typeDefnKind, synType, _members, _range) = + + Some(CompletionContext.RecordField recordContext) + + member __.VisitInheritSynMemberDefn(componentInfo, typeDefnKind, synType, _members, _range) = match synType with - | SynType.LongIdent lidwd -> + | SynType.LongIdent lidwd -> match parseLid lidwd with - | Some completionPath -> GetCompletionContextForInheritSynMember (componentInfo, typeDefnKind, completionPath) - | None -> Some (CompletionContext.Invalid) // A $ .B -> no completion list - - | _ -> None - - member __.VisitBinding(defaultTraverse, (Binding(headPat = headPat) as synBinding)) = - - let visitParam = function - | SynPat.Named (range = range) when rangeContainsPos range pos -> + | Some completionPath -> GetCompletionContextForInheritSynMember(componentInfo, typeDefnKind, completionPath) + | None -> Some(CompletionContext.Invalid) // A $ .B -> no completion list + + | _ -> None + + member __.VisitBinding(defaultTraverse, (Binding (headPat = headPat) as synBinding)) = + + let visitParam = + function + | SynPat.Named (range = range) when rangeContainsPos range pos -> // parameter without type hint, no completion - Some CompletionContext.Invalid - | SynPat.Typed(SynPat.Named(SynPat.Wild range, _, _, _, _), _, _) when rangeContainsPos range pos -> + Some CompletionContext.Invalid + | SynPat.Typed (SynPat.Named (SynPat.Wild range, _, _, _, _), _, _) when rangeContainsPos range pos -> // parameter with type hint, but we are on its name, no completion Some CompletionContext.Invalid | _ -> defaultTraverse synBinding match headPat with - | SynPat.LongIdent(longDotId = lidwd) when rangeContainsPos lidwd.Range pos -> + | SynPat.LongIdent (longDotId = lidwd) when rangeContainsPos lidwd.Range pos -> // let fo|o x = () Some CompletionContext.Invalid - | SynPat.LongIdent(_, _, _, ctorArgs, _, _) -> + | SynPat.LongIdent (_, _, _, ctorArgs, _, _) -> match ctorArgs with | SynArgPats.Pats pats -> - pats |> List.tryPick (fun pat -> + pats + |> List.tryPick (fun pat -> match pat with - | SynPat.Paren(pat, _) -> + | SynPat.Paren (pat, _) -> match pat with - | SynPat.Tuple(_, pats, _) -> - pats |> List.tryPick visitParam + | SynPat.Tuple (_, pats, _) -> pats |> List.tryPick visitParam | _ -> visitParam pat - | SynPat.Wild range when rangeContainsPos range pos -> + | SynPat.Wild range when rangeContainsPos range pos -> // let foo (x| Some CompletionContext.Invalid - | _ -> visitParam pat - ) + | _ -> visitParam pat) | _ -> defaultTraverse synBinding - | SynPat.Named(range = range) when rangeContainsPos range pos -> + | SynPat.Named (range = range) when rangeContainsPos range pos -> // let fo|o = 1 Some CompletionContext.Invalid - | _ -> defaultTraverse synBinding - - member __.VisitHashDirective range = - if rangeContainsPos range pos then Some CompletionContext.Invalid - else None - - member __.VisitModuleOrNamespace(SynModuleOrNamespace(longId = idents)) = + | _ -> defaultTraverse synBinding + + member __.VisitHashDirective range = + if rangeContainsPos range pos then + Some CompletionContext.Invalid + else + None + + member __.VisitModuleOrNamespace(SynModuleOrNamespace (longId = idents)) = match List.tryLast idents with - | Some lastIdent when pos.Line = lastIdent.idRange.EndLine && lastIdent.idRange.EndColumn >= 0 && pos.Column <= lineStr.Length -> - let stringBetweenModuleNameAndPos = lineStr.[lastIdent.idRange.EndColumn..pos.Column - 1] + | Some lastIdent when + pos.Line = lastIdent.idRange.EndLine + && lastIdent.idRange.EndColumn >= 0 + && pos.Column <= lineStr.Length + -> + let stringBetweenModuleNameAndPos = + lineStr.[lastIdent.idRange.EndColumn .. pos.Column - 1] + if stringBetweenModuleNameAndPos |> Seq.forall (fun x -> x = ' ' || x = '.') then Some CompletionContext.Invalid - else None - | _ -> None + else + None + | _ -> None - member __.VisitComponentInfo(ComponentInfo(range = range)) = - if rangeContainsPos range pos then Some CompletionContext.Invalid - else None + member __.VisitComponentInfo(ComponentInfo (range = range)) = + if rangeContainsPos range pos then + Some CompletionContext.Invalid + else + None member __.VisitLetOrUse(_, _, bindings, range) = match bindings with @@ -1377,16 +1626,17 @@ module UntypedParseImpl = | _ -> None member __.VisitSimplePats pats = - pats |> List.tryPick (fun pat -> + pats + |> List.tryPick (fun pat -> match pat with - | SynSimplePat.Id(range = range) - | SynSimplePat.Typed(SynSimplePat.Id(range = range), _, _) when rangeContainsPos range pos -> + | SynSimplePat.Id (range = range) + | SynSimplePat.Typed (SynSimplePat.Id (range = range), _, _) when rangeContainsPos range pos -> Some CompletionContext.Invalid | _ -> None) member __.VisitModuleDecl(defaultTraverse, decl) = match decl with - | SynModuleDecl.Open(target, m) -> + | SynModuleDecl.Open (target, m) -> // in theory, this means we're "in an open" // in practice, because the parse tree/walkers do not handle attributes well yet, need extra check below to ensure not e.g. $here$ // open System @@ -1394,78 +1644,88 @@ module UntypedParseImpl = // let f() = () // inside an attribute on the next item let pos = mkPos pos.Line (pos.Column - 1) // -1 because for e.g. "open System." the dot does not show up in the parse tree + if rangeContainsPos m pos then let isOpenType = match target with | SynOpenDeclTarget.Type _ -> true | SynOpenDeclTarget.ModuleOrNamespace _ -> false - Some (CompletionContext.OpenDeclaration isOpenType) + + Some(CompletionContext.OpenDeclaration isOpenType) else None | _ -> defaultTraverse decl member __.VisitType(defaultTraverse, ty) = match ty with - | SynType.LongIdent _ when rangeContainsPos ty.Range pos -> - Some CompletionContext.PatternType + | SynType.LongIdent _ when rangeContainsPos ty.Range pos -> Some CompletionContext.PatternType | _ -> defaultTraverse ty - } - - AstTraversal.Traverse(pos, parsedInput, walker) - // Uncompleted attribute applications are not presented in the AST in any way. So, we have to parse source string. - |> Option.orElseWith (fun _ -> - let cutLeadingAttributes (str: string) = - // cut off leading attributes, i.e. we cut "[]" to " >]" - match str.LastIndexOf ';' with - | -1 -> str - | idx when idx < str.Length -> str.[idx + 1..].TrimStart() - | _ -> "" - - let isLongIdent = Seq.forall (fun c -> IsIdentifierPartCharacter c || c = '.' || c = ':') // ':' may occur in "[]" - - // match the most nested paired [< and >] first - let matches = - insideAttributeApplicationRegex.Matches lineStr - |> Seq.cast - |> Seq.filter (fun m -> m.Index <= pos.Column && m.Index + m.Length >= pos.Column) - |> Seq.toArray - - if not (Array.isEmpty matches) then - matches - |> Seq.tryPick (fun m -> - let g = m.Groups.["attribute"] - let col = pos.Column - g.Index - if col >= 0 && col < g.Length then - let str = g.Value.Substring(0, col).TrimStart() // cut other rhs attributes - let str = cutLeadingAttributes str - if isLongIdent str then - Some CompletionContext.AttributeApplication - else None - else None) - else - // Paired [< and >] were not found, try to determine that we are after [< without closing >] - match lineStr.LastIndexOf("[<", StringComparison.Ordinal) with - | -1 -> None - | openParenIndex when pos.Column >= openParenIndex + 2 -> - let str = lineStr.[openParenIndex + 2..pos.Column - 1].TrimStart() - let str = cutLeadingAttributes str - if isLongIdent str then - Some CompletionContext.AttributeApplication - else None - | _ -> None) + } + + AstTraversal.Traverse(pos, parsedInput, walker) + // Uncompleted attribute applications are not presented in the AST in any way. So, we have to parse source string. + |> Option.orElseWith (fun _ -> + let cutLeadingAttributes (str: string) = + // cut off leading attributes, i.e. we cut "[]" to " >]" + match str.LastIndexOf ';' with + | -1 -> str + | idx when idx < str.Length -> str.[idx + 1 ..].TrimStart() + | _ -> "" + + let isLongIdent = + Seq.forall (fun c -> IsIdentifierPartCharacter c || c = '.' || c = ':') // ':' may occur in "[]" + + // match the most nested paired [< and >] first + let matches = + insideAttributeApplicationRegex.Matches lineStr + |> Seq.cast + |> Seq.filter (fun m -> m.Index <= pos.Column && m.Index + m.Length >= pos.Column) + |> Seq.toArray + + if not (Array.isEmpty matches) then + matches + |> Seq.tryPick (fun m -> + let g = m.Groups.["attribute"] + let col = pos.Column - g.Index + + if col >= 0 && col < g.Length then + let str = g.Value.Substring(0, col).TrimStart() // cut other rhs attributes + let str = cutLeadingAttributes str + + if isLongIdent str then + Some CompletionContext.AttributeApplication + else + None + else + None) + else + // Paired [< and >] were not found, try to determine that we are after [< without closing >] + match lineStr.LastIndexOf("[<", StringComparison.Ordinal) with + | -1 -> None + | openParenIndex when pos.Column >= openParenIndex + 2 -> + let str = lineStr.[openParenIndex + 2 .. pos.Column - 1].TrimStart() + let str = cutLeadingAttributes str + + if isLongIdent str then + Some CompletionContext.AttributeApplication + else + None + | _ -> None) /// Check if we are at an "open" declaration - let GetFullNameOfSmallestModuleOrNamespaceAtPoint (parsedInput: ParsedInput, pos: pos) = + let GetFullNameOfSmallestModuleOrNamespaceAtPoint (parsedInput: ParsedInput, pos: pos) = let mutable path = [] - let visitor = + + let visitor = { new AstTraversal.AstVisitorBase() with - override this.VisitExpr(_path, _traverseSynExpr, defaultTraverse, expr) = + override this.VisitExpr(_path, _traverseSynExpr, defaultTraverse, expr) = // don't need to keep going, namespaces and modules never appear inside Exprs - None - override this.VisitModuleOrNamespace(SynModuleOrNamespace(longId = longId; range = range)) = - if rangeContainsPos range pos then - path <- path @ longId - None // we should traverse the rest of the AST to find the smallest module + None + + override this.VisitModuleOrNamespace(SynModuleOrNamespace (longId = longId; range = range)) = + if rangeContainsPos range pos then path <- path @ longId + None // we should traverse the rest of the AST to find the smallest module } + AstTraversal.Traverse(pos, parsedInput, visitor) |> ignore path |> List.map (fun x -> x.idText) |> List.toArray diff --git a/src/Compiler/Service/ServiceXmlDocParser.fs b/src/Compiler/Service/ServiceXmlDocParser.fs index f76fcb160114..ed6c138c2c5a 100644 --- a/src/Compiler/Service/ServiceXmlDocParser.fs +++ b/src/Compiler/Service/ServiceXmlDocParser.fs @@ -9,31 +9,30 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.Xml /// Represent an Xml documentation block in source code -type XmlDocable = - | XmlDocable of line:int * indent:int * paramNames:string list +type XmlDocable = XmlDocable of line: int * indent: int * paramNames: string list module XmlDocParsing = - - let (|ConstructorPats|) = function + + let (|ConstructorPats|) = + function | SynArgPats.Pats ps -> ps - | SynArgPats.NamePatPairs(pats=xs) -> List.map (fun (_, _, pat) -> pat) xs + | SynArgPats.NamePatPairs (pats = xs) -> List.map (fun (_, _, pat) -> pat) xs let rec digNamesFrom pat = match pat with - | SynPat.As (_, SynPat.Named(SynIdent(id,_),_isTheThisVar,_access,_range), _) - | SynPat.Named (SynIdent(id,_),_isTheThisVar,_access,_range) -> [id.idText] - | SynPat.Typed(pat,_type,_range) -> digNamesFrom pat - | SynPat.Attrib(pat,_attrs,_range) -> digNamesFrom pat - | SynPat.LongIdent(argPats=ConstructorPats pats) -> - pats |> List.collect digNamesFrom - | SynPat.Tuple(_,pats,_range) -> pats |> List.collect digNamesFrom - | SynPat.Paren(pat,_range) -> digNamesFrom pat - | SynPat.OptionalVal (id, _) -> [id.idText] - | SynPat.As _ // no one uses as in fun decls - | SynPat.Or _ // no one uses ors in fun decls - | SynPat.Ands _ // no one uses ands in fun decls - | SynPat.ArrayOrList _ // no one uses this in fun decls - | SynPat.Record _ // no one uses this in fun decls + | SynPat.As (_, SynPat.Named (SynIdent (id, _), _isTheThisVar, _access, _range), _) + | SynPat.Named (SynIdent (id, _), _isTheThisVar, _access, _range) -> [ id.idText ] + | SynPat.Typed (pat, _type, _range) -> digNamesFrom pat + | SynPat.Attrib (pat, _attrs, _range) -> digNamesFrom pat + | SynPat.LongIdent(argPats = ConstructorPats pats) -> pats |> List.collect digNamesFrom + | SynPat.Tuple (_, pats, _range) -> pats |> List.collect digNamesFrom + | SynPat.Paren (pat, _range) -> digNamesFrom pat + | SynPat.OptionalVal (id, _) -> [ id.idText ] + | SynPat.As _ // no one uses as in fun decls + | SynPat.Or _ // no one uses ors in fun decls + | SynPat.Ands _ // no one uses ands in fun decls + | SynPat.ArrayOrList _ // no one uses this in fun decls + | SynPat.Record _ // no one uses this in fun decls | SynPat.Null _ | SynPat.Const _ | SynPat.Wild _ @@ -43,51 +42,59 @@ module XmlDocParsing = | SynPat.InstanceMember _ | SynPat.FromParseError _ -> [] - let getXmlDocablesImpl(sourceText: ISourceText, input: ParsedInput) = + let getXmlDocablesImpl (sourceText: ISourceText, input: ParsedInput) = let indentOf (lineNum: int) = let mutable i = 0 - let line = sourceText.GetLineString(lineNum-1) // -1 because lineNum reported by xmldocs are 1-based, but array is 0-based + let line = sourceText.GetLineString(lineNum - 1) // -1 because lineNum reported by xmldocs are 1-based, but array is 0-based + while i < line.Length && line.Chars(i) = ' ' do i <- i + 1 + i - let isEmptyXmlDoc (preXmlDoc: PreXmlDoc) = - preXmlDoc.ToXmlDoc(false, None).IsEmpty + let isEmptyXmlDoc (preXmlDoc: PreXmlDoc) = preXmlDoc.ToXmlDoc(false, None).IsEmpty let rec getXmlDocablesSynModuleDecl decl = - match decl with - | SynModuleDecl.NestedModule(decls=synModuleDecls) -> - (synModuleDecls |> List.collect getXmlDocablesSynModuleDecl) - | SynModuleDecl.Let(_, synBindingList, range) -> - let anyXmlDoc = - synBindingList |> List.exists (fun (SynBinding(xmlDoc=preXmlDoc)) -> - not <| isEmptyXmlDoc preXmlDoc) - if anyXmlDoc then [] else - let synAttributes = - synBindingList |> List.collect (fun (SynBinding(attributes=a)) -> a) - let fullRange = synAttributes |> List.fold (fun r a -> unionRanges r a.Range) range - let line = fullRange.StartLine - let indent = indentOf line - [ for SynBinding(valData=synValData; headPat=synPat) in synBindingList do - match synValData with - | SynValData(_memberFlagsOpt, SynValInfo(args, _), _) when not (List.isEmpty args) -> - let parameters = - args - |> List.collect ( - List.collect (fun (SynArgInfo(_, _, ident)) -> - match ident with - | Some ident -> [ident.idText] - | None -> [])) - match parameters with - | [] -> - let paramNames = digNamesFrom synPat - yield! paramNames - | _ :: _ -> - yield! parameters - | _ -> () ] - |> fun paramNames -> [ XmlDocable(line,indent,paramNames) ] - | SynModuleDecl.Types(synTypeDefnList, _) -> (synTypeDefnList |> List.collect getXmlDocablesSynTypeDefn) - | SynModuleDecl.NamespaceFragment(synModuleOrNamespace) -> getXmlDocablesSynModuleOrNamespace synModuleOrNamespace + match decl with + | SynModuleDecl.NestedModule (decls = synModuleDecls) -> (synModuleDecls |> List.collect getXmlDocablesSynModuleDecl) + | SynModuleDecl.Let (_, synBindingList, range) -> + let anyXmlDoc = + synBindingList + |> List.exists (fun (SynBinding (xmlDoc = preXmlDoc)) -> not <| isEmptyXmlDoc preXmlDoc) + + if anyXmlDoc then + [] + else + let synAttributes = + synBindingList |> List.collect (fun (SynBinding (attributes = a)) -> a) + + let fullRange = synAttributes |> List.fold (fun r a -> unionRanges r a.Range) range + let line = fullRange.StartLine + let indent = indentOf line + + [ + for SynBinding (valData = synValData; headPat = synPat) in synBindingList do + match synValData with + | SynValData (_memberFlagsOpt, SynValInfo (args, _), _) when not (List.isEmpty args) -> + let parameters = + args + |> List.collect ( + List.collect (fun (SynArgInfo (_, _, ident)) -> + match ident with + | Some ident -> [ ident.idText ] + | None -> []) + ) + + match parameters with + | [] -> + let paramNames = digNamesFrom synPat + yield! paramNames + | _ :: _ -> yield! parameters + | _ -> () + ] + |> fun paramNames -> [ XmlDocable(line, indent, paramNames) ] + | SynModuleDecl.Types (synTypeDefnList, _) -> (synTypeDefnList |> List.collect getXmlDocablesSynTypeDefn) + | SynModuleDecl.NamespaceFragment (synModuleOrNamespace) -> getXmlDocablesSynModuleOrNamespace synModuleOrNamespace | SynModuleDecl.ModuleAbbrev _ | SynModuleDecl.Expr _ | SynModuleDecl.Exception _ @@ -95,51 +102,68 @@ module XmlDocParsing = | SynModuleDecl.Attributes _ | SynModuleDecl.HashDirective _ -> [] - and getXmlDocablesSynModuleOrNamespace (SynModuleOrNamespace(decls = synModuleDecls)) = + and getXmlDocablesSynModuleOrNamespace (SynModuleOrNamespace (decls = synModuleDecls)) = (synModuleDecls |> List.collect getXmlDocablesSynModuleDecl) - and getXmlDocablesSynTypeDefn (SynTypeDefn(typeInfo=SynComponentInfo(attributes=synAttributes; xmlDoc=preXmlDoc; range=compRange); typeRepr=synTypeDefnRepr; members=synMemberDefns; range=tRange)) = - let stuff = + and getXmlDocablesSynTypeDefn + (SynTypeDefn (typeInfo = SynComponentInfo (attributes = synAttributes; xmlDoc = preXmlDoc; range = compRange) + typeRepr = synTypeDefnRepr + members = synMemberDefns + range = tRange)) + = + let stuff = match synTypeDefnRepr with - | SynTypeDefnRepr.ObjectModel(_, synMemberDefns, _) -> (synMemberDefns |> List.collect getXmlDocablesSynMemberDefn) - | SynTypeDefnRepr.Simple(_synTypeDefnSimpleRepr, _range) -> [] + | SynTypeDefnRepr.ObjectModel (_, synMemberDefns, _) -> (synMemberDefns |> List.collect getXmlDocablesSynMemberDefn) + | SynTypeDefnRepr.Simple (_synTypeDefnSimpleRepr, _range) -> [] | SynTypeDefnRepr.Exception _ -> [] - let docForTypeDefn = + + let docForTypeDefn = if isEmptyXmlDoc preXmlDoc then - let fullRange = synAttributes |> List.fold (fun r a -> unionRanges r a.Range) (unionRanges compRange tRange) - let line = fullRange.StartLine + let fullRange = + synAttributes + |> List.fold (fun r a -> unionRanges r a.Range) (unionRanges compRange tRange) + + let line = fullRange.StartLine let indent = indentOf line - [XmlDocable(line,indent,[])] - else [] - docForTypeDefn @ stuff @ (synMemberDefns |> List.collect getXmlDocablesSynMemberDefn) + [ XmlDocable(line, indent, []) ] + else + [] - and getXmlDocablesSynMemberDefn = function - | SynMemberDefn.Member(SynBinding(attributes=synAttributes; xmlDoc=preXmlDoc; headPat=synPat), memRange) -> + docForTypeDefn + @ stuff @ (synMemberDefns |> List.collect getXmlDocablesSynMemberDefn) + + and getXmlDocablesSynMemberDefn = + function + | SynMemberDefn.Member (SynBinding (attributes = synAttributes; xmlDoc = preXmlDoc; headPat = synPat), memRange) -> if isEmptyXmlDoc preXmlDoc then - let fullRange = synAttributes |> List.fold (fun r a -> unionRanges r a.Range) memRange - let line = fullRange.StartLine + let fullRange = + synAttributes |> List.fold (fun r a -> unionRanges r a.Range) memRange + + let line = fullRange.StartLine let indent = indentOf line - let paramNames = digNamesFrom synPat - [XmlDocable(line,indent,paramNames)] - else [] - | SynMemberDefn.AbstractSlot(SynValSig(attributes=synAttributes; arity=synValInfo; xmlDoc=preXmlDoc), _, range) -> + let paramNames = digNamesFrom synPat + [ XmlDocable(line, indent, paramNames) ] + else + [] + | SynMemberDefn.AbstractSlot (SynValSig (attributes = synAttributes; arity = synValInfo; xmlDoc = preXmlDoc), _, range) -> if isEmptyXmlDoc preXmlDoc then let fullRange = synAttributes |> List.fold (fun r a -> unionRanges r a.Range) range - let line = fullRange.StartLine + let line = fullRange.StartLine let indent = indentOf line let paramNames = synValInfo.ArgNames - [XmlDocable(line,indent,paramNames)] - else [] - | SynMemberDefn.Interface(members=synMemberDefnsOption) -> - match synMemberDefnsOption with - | None -> [] - | Some(x) -> x |> List.collect getXmlDocablesSynMemberDefn - | SynMemberDefn.NestedType(synTypeDefn, _, _) -> getXmlDocablesSynTypeDefn synTypeDefn - | SynMemberDefn.AutoProperty(attributes=synAttributes; range=range) -> + [ XmlDocable(line, indent, paramNames) ] + else + [] + | SynMemberDefn.Interface (members = synMemberDefnsOption) -> + match synMemberDefnsOption with + | None -> [] + | Some (x) -> x |> List.collect getXmlDocablesSynMemberDefn + | SynMemberDefn.NestedType (synTypeDefn, _, _) -> getXmlDocablesSynTypeDefn synTypeDefn + | SynMemberDefn.AutoProperty (attributes = synAttributes; range = range) -> let fullRange = synAttributes |> List.fold (fun r a -> unionRanges r a.Range) range - let line = fullRange.StartLine + let line = fullRange.StartLine let indent = indentOf line - [XmlDocable(line, indent, [])] + [ XmlDocable(line, indent, []) ] | SynMemberDefn.Open _ | SynMemberDefn.ImplicitCtor _ | SynMemberDefn.ImplicitInherit _ @@ -149,7 +173,7 @@ module XmlDocParsing = and getXmlDocablesInput input = match input with - | ParsedInput.ImplFile (ParsedImplFileInput (modules = symModules))-> + | ParsedInput.ImplFile (ParsedImplFileInput (modules = symModules)) -> symModules |> List.collect getXmlDocablesSynModuleOrNamespace | ParsedInput.SigFile _ -> [] @@ -157,24 +181,24 @@ module XmlDocParsing = getXmlDocablesInput input module XmlDocComment = - let ws (s: string, pos) = + let ws (s: string, pos) = let res = s.TrimStart() - Some (res, pos + (s.Length - res.Length)) + Some(res, pos + (s.Length - res.Length)) let str (prefix: string) (s: string, pos) = match s.StartsWithOrdinal(prefix) with - | true -> + | true -> let res = s.Substring prefix.Length - Some (res, pos + (s.Length - res.Length)) + Some(res, pos + (s.Length - res.Length)) | _ -> None - let eol (s: string, pos) = + let eol (s: string, pos) = match s with - | "" -> Some ("", pos) + | "" -> Some("", pos) | _ -> None let (>=>) f g = f >> Option.bind g - + // if it's a blank XML comment with trailing "<", returns Some (index of the "<"), otherwise returns None let IsBlank (s: string) = let parser = ws >=> str "///" >=> ws >=> str "<" >=> eol @@ -185,4 +209,4 @@ module XmlDocParser = /// Get the list of Xml documentation from current source code let GetXmlDocables (sourceText: ISourceText, input) = - XmlDocParsing.getXmlDocablesImpl (sourceText, input) \ No newline at end of file + XmlDocParsing.getXmlDocablesImpl (sourceText, input) diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index c9efa398a7a1..023c0ddfe2af 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -11,7 +11,7 @@ open System.Threading open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras -open FSharp.Compiler +open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader @@ -33,7 +33,7 @@ open FSharp.Compiler.Syntax open FSharp.Compiler.Tokenization open FSharp.Compiler.Text open FSharp.Compiler.Text.Range -open FSharp.Compiler.TcGlobals +open FSharp.Compiler.TcGlobals open FSharp.Compiler.BuildGraph [] @@ -42,110 +42,164 @@ module EnvMisc = let parseFileCacheSize = GetEnvInteger "FCS_ParseFileCacheSize" 2 let checkFileInProjectCacheSize = GetEnvInteger "FCS_CheckFileInProjectCacheSize" 10 - let projectCacheSizeDefault = GetEnvInteger "FCS_ProjectCacheSizeDefault" 3 + let projectCacheSizeDefault = GetEnvInteger "FCS_ProjectCacheSizeDefault" 3 let frameworkTcImportsCacheStrongSize = GetEnvInteger "FCS_frameworkTcImportsCacheStrongSizeDefault" 8 //---------------------------------------------------------------------------- // BackgroundCompiler // -/// Callback that indicates whether a requested result has become obsolete. -[] -type IsResultObsolete = - | IsResultObsolete of (unit->bool) - +/// Callback that indicates whether a requested result has become obsolete. +[] +type IsResultObsolete = IsResultObsolete of (unit -> bool) [] -module Helpers = +module Helpers = /// Determine whether two (fileName,options) keys are identical w.r.t. affect on checking - let AreSameForChecking2((fileName1: string, options1: FSharpProjectOptions), (fileName2, options2)) = - (fileName1 = fileName2) - && FSharpProjectOptions.AreSameForChecking(options1,options2) - - /// Determine whether two (fileName,options) keys should be identical w.r.t. resource usage - let AreSubsumable2((fileName1:string,o1:FSharpProjectOptions),(fileName2:string,o2:FSharpProjectOptions)) = + let AreSameForChecking2 ((fileName1: string, options1: FSharpProjectOptions), (fileName2, options2)) = (fileName1 = fileName2) - && FSharpProjectOptions.UseSameProject(o1,o2) + && FSharpProjectOptions.AreSameForChecking(options1, options2) + + /// Determine whether two (fileName,options) keys should be identical w.r.t. resource usage + let AreSubsumable2 ((fileName1: string, o1: FSharpProjectOptions), (fileName2: string, o2: FSharpProjectOptions)) = + (fileName1 = fileName2) && FSharpProjectOptions.UseSameProject(o1, o2) /// Determine whether two (fileName,sourceText,options) keys should be identical w.r.t. parsing - let AreSameForParsing((fileName1: string, source1Hash: int64, options1), (fileName2, source2Hash, options2)) = + let AreSameForParsing ((fileName1: string, source1Hash: int64, options1), (fileName2, source2Hash, options2)) = fileName1 = fileName2 && options1 = options2 && source1Hash = source2Hash - let AreSimilarForParsing((fileName1, _, _), (fileName2, _, _)) = - fileName1 = fileName2 - + let AreSimilarForParsing ((fileName1, _, _), (fileName2, _, _)) = fileName1 = fileName2 + /// Determine whether two (fileName,sourceText,options) keys should be identical w.r.t. checking - let AreSameForChecking3((fileName1: string, source1Hash: int64, options1: FSharpProjectOptions), (fileName2, source2Hash, options2)) = - (fileName1 = fileName2) - && FSharpProjectOptions.AreSameForChecking(options1,options2) + let AreSameForChecking3 ((fileName1: string, source1Hash: int64, options1: FSharpProjectOptions), (fileName2, source2Hash, options2)) = + (fileName1 = fileName2) + && FSharpProjectOptions.AreSameForChecking(options1, options2) && source1Hash = source2Hash /// Determine whether two (fileName,sourceText,options) keys should be identical w.r.t. resource usage - let AreSubsumable3((fileName1:string,_,o1:FSharpProjectOptions),(fileName2:string,_,o2:FSharpProjectOptions)) = - (fileName1 = fileName2) - && FSharpProjectOptions.UseSameProject(o1,o2) + let AreSubsumable3 ((fileName1: string, _, o1: FSharpProjectOptions), (fileName2: string, _, o2: FSharpProjectOptions)) = + (fileName1 = fileName2) && FSharpProjectOptions.UseSameProject(o1, o2) module CompileHelpers = - let mkCompilationDiagnosticsHandlers() = + let mkCompilationDiagnosticsHandlers () = let diagnostics = ResizeArray<_>() - let diagnosticSink isError exn = + let diagnosticSink isError exn = let main, related = SplitRelatedDiagnostics exn - let oneDiagnostic e = diagnostics.Add(FSharpDiagnostic.CreateFromException (e, isError, range0, true)) // Suggest names for errors + + let oneDiagnostic e = + diagnostics.Add(FSharpDiagnostic.CreateFromException(e, isError, range0, true)) // Suggest names for errors + oneDiagnostic main List.iter oneDiagnostic related - let diagnosticsLogger = - { new DiagnosticsLogger("CompileAPI") with - + let diagnosticsLogger = + { new DiagnosticsLogger("CompileAPI") with + member _.DiagnosticSink(exn, isError) = diagnosticSink isError exn member _.ErrorCount = diagnostics |> Seq.filter (fun diagnostic -> diagnostic.Severity = FSharpDiagnosticSeverity.Error) - |> Seq.length } + |> Seq.length + } + + let loggerProvider = + { new DiagnosticsLoggerProvider() with + member _.CreateDiagnosticsLoggerUpToMaxErrors(_tcConfigBuilder, _exiter) = diagnosticsLogger + } - let loggerProvider = - { new DiagnosticsLoggerProvider() with - member _.CreateDiagnosticsLoggerUpToMaxErrors(_tcConfigBuilder, _exiter) = diagnosticsLogger } diagnostics, diagnosticsLogger, loggerProvider - let tryCompile diagnosticsLogger f = - use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use unwindEL_2 = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> diagnosticsLogger) - let exiter = { new Exiter with member x.Exit n = raise StopProcessing } - try + let tryCompile diagnosticsLogger f = + use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use unwindEL_2 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> diagnosticsLogger) + + let exiter = + { new Exiter with + member x.Exit n = raise StopProcessing + } + + try f exiter 0 - with e -> + with e -> stopProcessingRecovery e range0 1 - /// Compile using the given flags. Source files names are resolved via the FileSystem API. The output file must be given by a -o flag. - let compileFromArgs (ctok, argv: string[], legacyReferenceResolver, tcImportsCapture, dynamicAssemblyCreator) = - - let diagnostics, diagnosticsLogger, loggerProvider = mkCompilationDiagnosticsHandlers() - let result = - tryCompile diagnosticsLogger (fun exiter -> - CompileFromCommandLineArguments (ctok, argv, legacyReferenceResolver, true, ReduceMemoryFlag.Yes, CopyFSharpCoreFlag.No, exiter, loggerProvider, tcImportsCapture, dynamicAssemblyCreator) ) - + /// Compile using the given flags. Source files names are resolved via the FileSystem API. The output file must be given by a -o flag. + let compileFromArgs (ctok, argv: string[], legacyReferenceResolver, tcImportsCapture, dynamicAssemblyCreator) = + + let diagnostics, diagnosticsLogger, loggerProvider = mkCompilationDiagnosticsHandlers () + + let result = + tryCompile diagnosticsLogger (fun exiter -> + CompileFromCommandLineArguments( + ctok, + argv, + legacyReferenceResolver, + true, + ReduceMemoryFlag.Yes, + CopyFSharpCoreFlag.No, + exiter, + loggerProvider, + tcImportsCapture, + dynamicAssemblyCreator + )) + diagnostics.ToArray(), result - let compileFromAsts (ctok, legacyReferenceResolver, asts, assemblyName, outFile, dependencies, noframework, pdbFile, executable, tcImportsCapture, dynamicAssemblyCreator) = + let compileFromAsts + ( + ctok, + legacyReferenceResolver, + asts, + assemblyName, + outFile, + dependencies, + noframework, + pdbFile, + executable, + tcImportsCapture, + dynamicAssemblyCreator + ) = + + let diagnostics, diagnosticsLogger, loggerProvider = mkCompilationDiagnosticsHandlers () - let diagnostics, diagnosticsLogger, loggerProvider = mkCompilationDiagnosticsHandlers() - let executable = defaultArg executable true - let target = if executable then CompilerTarget.ConsoleExe else CompilerTarget.Dll - - let result = - tryCompile diagnosticsLogger (fun exiter -> - CompileFromSyntaxTrees (ctok, legacyReferenceResolver, ReduceMemoryFlag.Yes, assemblyName, target, outFile, pdbFile, dependencies, noframework, exiter, loggerProvider, asts, tcImportsCapture, dynamicAssemblyCreator)) + + let target = + if executable then + CompilerTarget.ConsoleExe + else + CompilerTarget.Dll + + let result = + tryCompile diagnosticsLogger (fun exiter -> + CompileFromSyntaxTrees( + ctok, + legacyReferenceResolver, + ReduceMemoryFlag.Yes, + assemblyName, + target, + outFile, + pdbFile, + dependencies, + noframework, + exiter, + loggerProvider, + asts, + tcImportsCapture, + dynamicAssemblyCreator + )) diagnostics.ToArray(), result - let createDynamicAssembly (debugInfo: bool, tcImportsRef: TcImports option ref, execute: bool, assemblyBuilderRef: _ option ref) (tcConfig: TcConfig, tcGlobals:TcGlobals, outfile, ilxMainModule) = + let createDynamicAssembly + (debugInfo: bool, tcImportsRef: TcImports option ref, execute: bool, assemblyBuilderRef: _ option ref) + (tcConfig: TcConfig, tcGlobals: TcGlobals, outfile, ilxMainModule) + = // Create an assembly builder let assemblyName = AssemblyName(Path.GetFileNameWithoutExtension outfile) @@ -156,123 +210,154 @@ module CompileHelpers = #else let assemblyBuilder = AppDomain.CurrentDomain.DefineDynamicAssembly(assemblyName, flags) let moduleBuilder = assemblyBuilder.DefineDynamicModule("IncrementalModule", debugInfo) -#endif - // Omit resources in dynamic assemblies, because the module builder is constructed without a file name the module +#endif + // Omit resources in dynamic assemblies, because the module builder is constructed without a file name the module // is tagged as transient and as such DefineManifestResource will throw an invalid operation if resources are present. - // + // // Also, the dynamic assembly creator can't currently handle types called "" from statically linked assemblies. - let ilxMainModule = - { ilxMainModule with - TypeDefs = ilxMainModule.TypeDefs.AsList() |> List.filter (fun td -> not (isTypeNameForGlobalFunctions td.Name)) |> mkILTypeDefs - Resources=mkILResources [] } + let ilxMainModule = + { ilxMainModule with + TypeDefs = + ilxMainModule.TypeDefs.AsList() + |> List.filter (fun td -> not (isTypeNameForGlobalFunctions td.Name)) + |> mkILTypeDefs + Resources = mkILResources [] + } // The function used to resolve types while emitting the code - let assemblyResolver s = - match tcImportsRef.Value.Value.TryFindExistingFullyQualifiedPathByExactAssemblyRef s with - | Some res -> Some (Choice1Of2 res) + let assemblyResolver s = + match tcImportsRef.Value.Value.TryFindExistingFullyQualifiedPathByExactAssemblyRef s with + | Some res -> Some(Choice1Of2 res) | None -> None // Emit the code - let _emEnv,execs = EmitDynamicAssemblyFragment(tcGlobals.ilg, tcConfig.emitTailcalls, emEnv0, assemblyBuilder, moduleBuilder, ilxMainModule, debugInfo, assemblyResolver, tcGlobals.TryFindSysILTypeRef) + let _emEnv, execs = + EmitDynamicAssemblyFragment( + tcGlobals.ilg, + tcConfig.emitTailcalls, + emEnv0, + assemblyBuilder, + moduleBuilder, + ilxMainModule, + debugInfo, + assemblyResolver, + tcGlobals.TryFindSysILTypeRef + ) // Execute the top-level initialization, if requested - if execute then - for exec in execs do - match exec() with + if execute then + for exec in execs do + match exec () with | None -> () - | Some exn -> + | Some exn -> PreserveStackTrace exn raise exn // Register the reflected definitions for the dynamically generated assembly - for resource in ilxMainModule.Resources.AsList() do - if IsReflectedDefinitionsResource resource then - Quotations.Expr.RegisterReflectedDefinitions (assemblyBuilder, moduleBuilder.Name, resource.GetBytes().ToArray()) + for resource in ilxMainModule.Resources.AsList() do + if IsReflectedDefinitionsResource resource then + Quotations.Expr.RegisterReflectedDefinitions(assemblyBuilder, moduleBuilder.Name, resource.GetBytes().ToArray()) // Save the result assemblyBuilderRef.Value <- Some assemblyBuilder - - let setOutputStreams execute = + + let setOutputStreams execute = // Set the output streams, if requested match execute with - | Some (writer,error) -> + | Some (writer, error) -> Console.SetOut writer Console.SetError error | None -> () type SourceTextHash = int64 type CacheStamp = int64 -type FileName = string +type FileName = string type FilePath = string type ProjectPath = string type FileVersion = int -type ParseCacheLockToken() = interface LockToken -type ScriptClosureCacheToken() = interface LockToken +type ParseCacheLockToken() = + interface LockToken + +type ScriptClosureCacheToken() = + interface LockToken type CheckFileCacheKey = FileName * SourceTextHash * FSharpProjectOptions type CheckFileCacheValue = FSharpParseFileResults * FSharpCheckFileResults * SourceTextHash * DateTime // There is only one instance of this type, held in FSharpChecker -type BackgroundCompiler( - legacyReferenceResolver, - projectCacheSize, - keepAssemblyContents, - keepAllBackgroundResolutions, - tryGetMetadataSnapshot, - suggestNamesForErrors, - keepAllBackgroundSymbolUses, - enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking) as self = +type BackgroundCompiler + ( + legacyReferenceResolver, + projectCacheSize, + keepAssemblyContents, + keepAllBackgroundResolutions, + tryGetMetadataSnapshot, + suggestNamesForErrors, + keepAllBackgroundSymbolUses, + enableBackgroundItemKeyStoreAndSemanticClassification, + enablePartialTypeChecking + ) as self = let beforeFileChecked = Event() let fileParsed = Event() let fileChecked = Event() let projectChecked = Event() - // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.backgroundCompiler.scriptClosureCache + // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.backgroundCompiler.scriptClosureCache /// Information about the derived script closure. - let scriptClosureCache = - MruCache(projectCacheSize, - areSame=FSharpProjectOptions.AreSameForChecking, - areSimilar=FSharpProjectOptions.UseSameProject) + let scriptClosureCache = + MruCache( + projectCacheSize, + areSame = FSharpProjectOptions.AreSameForChecking, + areSimilar = FSharpProjectOptions.UseSameProject + ) let frameworkTcImportsCache = FrameworkImportsCache(frameworkTcImportsCacheStrongSize) // We currently share one global dependency provider for all scripts for the FSharpChecker. // For projects, one is used per project. - // + // // Sharing one for all scripts is necessary for good performance from GetProjectOptionsFromScript, // which requires a dependency provider to process through the project options prior to working out // if the cached incremental builder can be used for the project. let dependencyProviderForScripts = new DependencyProvider() - let getProjectReferences (options: FSharpProjectOptions) userOpName = - [ for r in options.ReferencedProjects do - - match r with - | FSharpReferencedProject.FSharpReference(nm,opts) -> - // Don't use cross-project references for FSharp.Core, since various bits of code - // require a concrete FSharp.Core to exist on-disk. The only solutions that have - // these cross-project references to FSharp.Core are VisualFSharp.sln and FSharp.sln. The ramification - // of this is that you need to build FSharp.Core to get intellisense in those projects. - - if (try Path.GetFileNameWithoutExtension(nm) with _ -> "") <> GetFSharpCoreLibraryName() then - { new IProjectReference with - member x.EvaluateRawContents() = - node { - Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "GetAssemblyData", nm) - return! self.GetAssemblyData(opts, userOpName + ".CheckReferencedProject("+nm+")") - } - member x.TryGetLogicalTimeStamp(cache) = + let getProjectReferences (options: FSharpProjectOptions) userOpName = + [ + for r in options.ReferencedProjects do + + match r with + | FSharpReferencedProject.FSharpReference (nm, opts) -> + // Don't use cross-project references for FSharp.Core, since various bits of code + // require a concrete FSharp.Core to exist on-disk. The only solutions that have + // these cross-project references to FSharp.Core are VisualFSharp.sln and FSharp.sln. The ramification + // of this is that you need to build FSharp.Core to get intellisense in those projects. + + if (try + Path.GetFileNameWithoutExtension(nm) + with _ -> + "") + <> GetFSharpCoreLibraryName() then + { new IProjectReference with + member x.EvaluateRawContents() = + node { + Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "GetAssemblyData", nm) + return! self.GetAssemblyData(opts, userOpName + ".CheckReferencedProject(" + nm + ")") + } + + member x.TryGetLogicalTimeStamp(cache) = self.TryGetLogicalTimeStampForProject(cache, opts) - member x.FileName = nm } - - | FSharpReferencedProject.PEReference(nm,getStamp,delayedReader) -> - { new IProjectReference with - member x.EvaluateRawContents() = - node { + + member x.FileName = nm + } + + | FSharpReferencedProject.PEReference (nm, getStamp, delayedReader) -> + { new IProjectReference with + member x.EvaluateRawContents() = + node { let! ilReaderOpt = delayedReader.TryGetILModuleReader() |> NodeCode.FromCancellable + match ilReaderOpt with | Some ilReader -> let ilModuleDef, ilAsmRefs = ilReader.ILModuleDef, ilReader.ILAssemblyRefs @@ -282,43 +367,52 @@ type BackgroundCompiler( // Note 'false' - if a PEReference doesn't find an ILModuleReader then we don't // continue to try to use an on-disk DLL return ProjectAssemblyDataResult.Unavailable false - } - member x.TryGetLogicalTimeStamp _ = getStamp() |> Some - member x.FileName = nm } - - | FSharpReferencedProject.ILModuleReference(nm,getStamp,getReader) -> - { new IProjectReference with - member x.EvaluateRawContents() = - node { - let ilReader = getReader() + } + + member x.TryGetLogicalTimeStamp _ = getStamp () |> Some + member x.FileName = nm + } + + | FSharpReferencedProject.ILModuleReference (nm, getStamp, getReader) -> + { new IProjectReference with + member x.EvaluateRawContents() = + node { + let ilReader = getReader () let ilModuleDef, ilAsmRefs = ilReader.ILModuleDef, ilReader.ILAssemblyRefs let data = RawFSharpAssemblyData(ilModuleDef, ilAsmRefs) :> IRawFSharpAssemblyData return ProjectAssemblyDataResult.Available data - } - member x.TryGetLogicalTimeStamp _ = getStamp() |> Some - member x.FileName = nm } - ] + } + + member x.TryGetLogicalTimeStamp _ = getStamp () |> Some + member x.FileName = nm + } + ] + /// CreateOneIncrementalBuilder (for background type checking). Note that fsc.fs also /// creates an incremental builder used by the command line compiler. - let CreateOneIncrementalBuilder (options:FSharpProjectOptions, userOpName) = + let CreateOneIncrementalBuilder (options: FSharpProjectOptions, userOpName) = node { Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "CreateOneIncrementalBuilder", options.ProjectFileName) let projectReferences = getProjectReferences options userOpName let loadClosure = scriptClosureCache.TryGet(AnyCallerThread, options) - - let dependencyProvider = if options.UseScriptResolutionRules then Some dependencyProviderForScripts else None - let! builderOpt, diagnostics = - IncrementalBuilder.TryCreateIncrementalBuilderForProjectOptions ( + let dependencyProvider = + if options.UseScriptResolutionRules then + Some dependencyProviderForScripts + else + None + + let! builderOpt, diagnostics = + IncrementalBuilder.TryCreateIncrementalBuilderForProjectOptions( legacyReferenceResolver, FSharpCheckerResultsSettings.defaultFSharpBinariesDir, frameworkTcImportsCache, loadClosure, - Array.toList options.SourceFiles, + Array.toList options.SourceFiles, Array.toList options.OtherOptions, projectReferences, - options.ProjectDirectory, + options.ProjectDirectory, options.UseScriptResolutionRules, keepAssemblyContents, keepAllBackgroundResolutions, @@ -327,11 +421,12 @@ type BackgroundCompiler( keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, enablePartialTypeChecking, - dependencyProvider) + dependencyProvider + ) - match builderOpt with + match builderOpt with | None -> () - | Some builder -> + | Some builder -> #if !NO_TYPEPROVIDERS // Register the behaviour that responds to CCUs being invalidated because of type @@ -342,20 +437,21 @@ type BackgroundCompiler( // Register the callback called just before a file is typechecked by the background builder (without recording // errors or intellisense information). // - // This indicates to the UI that the file type check state is dirty. If the file is open and visible then + // This indicates to the UI that the file type check state is dirty. If the file is open and visible then // the UI will sooner or later request a typecheck of the file, recording errors and intellisense information. - builder.BeforeFileChecked.Add (fun file -> beforeFileChecked.Trigger(file, options)) - builder.FileParsed.Add (fun file -> fileParsed.Trigger(file, options)) - builder.FileChecked.Add (fun file -> fileChecked.Trigger(file, options)) - builder.ProjectChecked.Add (fun () -> projectChecked.Trigger options) + builder.BeforeFileChecked.Add(fun file -> beforeFileChecked.Trigger(file, options)) + builder.FileParsed.Add(fun file -> fileParsed.Trigger(file, options)) + builder.FileChecked.Add(fun file -> fileChecked.Trigger(file, options)) + builder.ProjectChecked.Add(fun () -> projectChecked.Trigger options) return (builderOpt, diagnostics) } let parseCacheLock = Lock() - + // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.parseFileInProjectCache. Most recently used cache for parsing files. - let parseFileCache = MruCache(parseFileCacheSize, areSimilar = AreSimilarForParsing, areSame = AreSameForParsing) + let parseFileCache = + MruCache(parseFileCacheSize, areSimilar = AreSimilarForParsing, areSame = AreSameForParsing) // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.checkFileInProjectCache // @@ -366,36 +462,39 @@ type BackgroundCompiler( // Also keyed on source. This can only be out of date if the antecedent is out of date let checkFileInProjectCache = - MruCache> - (keepStrongly=checkFileInProjectCacheSize, - areSame=AreSameForChecking3, - areSimilar=AreSubsumable3) + MruCache>( + keepStrongly = checkFileInProjectCacheSize, + areSame = AreSameForChecking3, + areSimilar = AreSubsumable3 + ) - // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.backgroundCompiler.incrementalBuildersCache. This root typically holds more + // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.backgroundCompiler.incrementalBuildersCache. This root typically holds more // live information than anything else in the F# Language Service, since it holds up to 3 (projectCacheStrongSize) background project builds // strongly. - // - /// Cache of builds keyed by options. - let gate = obj() - let incrementalBuildersCache = - MruCache> - (keepStrongly=projectCacheSize, keepMax=projectCacheSize, - areSame = FSharpProjectOptions.AreSameForChecking, - areSimilar = FSharpProjectOptions.UseSameProject) + // + /// Cache of builds keyed by options. + let gate = obj () + + let incrementalBuildersCache = + MruCache>( + keepStrongly = projectCacheSize, + keepMax = projectCacheSize, + areSame = FSharpProjectOptions.AreSameForChecking, + areSimilar = FSharpProjectOptions.UseSameProject + ) let tryGetBuilderNode options = - incrementalBuildersCache.TryGet (AnyCallerThread, options) + incrementalBuildersCache.TryGet(AnyCallerThread, options) let tryGetBuilder options : NodeCode option = - tryGetBuilderNode options - |> Option.map (fun x -> x.GetOrComputeValue()) + tryGetBuilderNode options |> Option.map (fun x -> x.GetOrComputeValue()) let tryGetSimilarBuilder options : NodeCode option = - incrementalBuildersCache.TryGetSimilar (AnyCallerThread, options) + incrementalBuildersCache.TryGetSimilar(AnyCallerThread, options) |> Option.map (fun x -> x.GetOrComputeValue()) let tryGetAnyBuilder options : NodeCode option = - incrementalBuildersCache.TryGetAny (AnyCallerThread, options) + incrementalBuildersCache.TryGetAny(AnyCallerThread, options) |> Option.map (fun x -> x.GetOrComputeValue()) let createBuilderNode (options, userOpName, ct: CancellationToken) = @@ -403,11 +502,9 @@ type BackgroundCompiler( if ct.IsCancellationRequested then GraphNode(node.Return(None, [||])) else - let getBuilderNode = - GraphNode(CreateOneIncrementalBuilder(options, userOpName)) - incrementalBuildersCache.Set (AnyCallerThread, options, getBuilderNode) - getBuilderNode - ) + let getBuilderNode = GraphNode(CreateOneIncrementalBuilder(options, userOpName)) + incrementalBuildersCache.Set(AnyCallerThread, options, getBuilderNode) + getBuilderNode) let createAndGetBuilder (options, userOpName) = node { @@ -418,28 +515,26 @@ type BackgroundCompiler( let getOrCreateBuilder (options, userOpName) : NodeCode = match tryGetBuilder options with - | Some getBuilder -> + | Some getBuilder -> node { match! getBuilder with - | builderOpt, creationDiags when builderOpt.IsNone || not builderOpt.Value.IsReferencesInvalidated -> + | builderOpt, creationDiags when builderOpt.IsNone || not builderOpt.Value.IsReferencesInvalidated -> Logger.Log LogCompilerFunctionId.Service_IncrementalBuildersCache_GettingCache - return builderOpt,creationDiags + return builderOpt, creationDiags | _ -> // The builder could be re-created, // clear the check file caches that are associated with it. // We must do this in order to not return stale results when references // in the project get changed/added/removed. - parseCacheLock.AcquireLock(fun ltok -> + parseCacheLock.AcquireLock(fun ltok -> options.SourceFiles |> Array.iter (fun sourceFile -> let key = (sourceFile, 0L, options) - checkFileInProjectCache.RemoveAnySimilar(ltok, key) - ) - ) + checkFileInProjectCache.RemoveAnySimilar(ltok, key))) + return! createAndGetBuilder (options, userOpName) } - | _ -> - createAndGetBuilder (options, userOpName) + | _ -> createAndGetBuilder (options, userOpName) let getSimilarOrCreateBuilder (options, userOpName) = match tryGetSimilarBuilder options with @@ -455,82 +550,85 @@ type BackgroundCompiler( let getAnyBuilder (options, userOpName) = match tryGetAnyBuilder options with - | Some getBuilder -> + | Some getBuilder -> Logger.Log LogCompilerFunctionId.Service_IncrementalBuildersCache_GettingCache getBuilder - | _ -> - getOrCreateBuilder (options, userOpName) + | _ -> getOrCreateBuilder (options, userOpName) static let mutable actualParseFileCount = 0 static let mutable actualCheckFileCount = 0 /// Should be a fast operation. Ensures that we have only one async lazy object per file and its hash. - let getCheckFileNode (parseResults, - sourceText, - fileName, - options, - _fileVersion, - builder, - tcPrior, - tcInfo, - creationDiags) = + let getCheckFileNode (parseResults, sourceText, fileName, options, _fileVersion, builder, tcPrior, tcInfo, creationDiags) = // Here we lock for the creation of the node, not its execution - parseCacheLock.AcquireLock (fun ltok -> + parseCacheLock.AcquireLock(fun ltok -> let key = (fileName, sourceText.GetHashCode() |> int64, options) + match checkFileInProjectCache.TryGet(ltok, key) with | Some res -> res | _ -> let res = - GraphNode(node { - let! res = - self.CheckOneFileImplAux( - parseResults, - sourceText, - fileName, - options, - builder, - tcPrior, - tcInfo, - creationDiags) - Interlocked.Increment(&actualCheckFileCount) |> ignore - return res - }) + GraphNode( + node { + let! res = self.CheckOneFileImplAux(parseResults, sourceText, fileName, options, builder, tcPrior, tcInfo, creationDiags) + Interlocked.Increment(&actualCheckFileCount) |> ignore + return res + } + ) + checkFileInProjectCache.Set(ltok, key, res) - res - ) + res) member _.ParseFile(fileName: string, sourceText: ISourceText, options: FSharpParsingOptions, cache: bool, userOpName: string) = async { - if cache then - let hash = sourceText.GetHashCode() |> int64 - match parseCacheLock.AcquireLock(fun ltok -> parseFileCache.TryGet(ltok, (fileName, hash, options))) with - | Some res -> return res - | None -> - Interlocked.Increment(&actualParseFileCount) |> ignore - let parseDiagnostics, parseTree, anyErrors = ParseAndCheckFile.parseFile(sourceText, fileName, options, userOpName, suggestNamesForErrors) - let res = FSharpParseFileResults(parseDiagnostics, parseTree, anyErrors, options.SourceFiles) - parseCacheLock.AcquireLock(fun ltok -> parseFileCache.Set(ltok, (fileName, hash, options), res)) - return res - else - let parseDiagnostics, parseTree, anyErrors = ParseAndCheckFile.parseFile(sourceText, fileName, options, userOpName, false) - return FSharpParseFileResults(parseDiagnostics, parseTree, anyErrors, options.SourceFiles) + if cache then + let hash = sourceText.GetHashCode() |> int64 + + match parseCacheLock.AcquireLock(fun ltok -> parseFileCache.TryGet(ltok, (fileName, hash, options))) with + | Some res -> return res + | None -> + Interlocked.Increment(&actualParseFileCount) |> ignore + + let parseDiagnostics, parseTree, anyErrors = + ParseAndCheckFile.parseFile (sourceText, fileName, options, userOpName, suggestNamesForErrors) + + let res = FSharpParseFileResults(parseDiagnostics, parseTree, anyErrors, options.SourceFiles) + parseCacheLock.AcquireLock(fun ltok -> parseFileCache.Set(ltok, (fileName, hash, options), res)) + return res + else + let parseDiagnostics, parseTree, anyErrors = + ParseAndCheckFile.parseFile (sourceText, fileName, options, userOpName, false) + + return FSharpParseFileResults(parseDiagnostics, parseTree, anyErrors, options.SourceFiles) } /// Fetch the parse information from the background compiler (which checks w.r.t. the FileSystem API) member _.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) = node { let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) + match builderOpt with | None -> let parseTree = EmptyParsedInput(fileName, (false, false)) - return FSharpParseFileResults(creationDiags, parseTree, true, [| |]) - | Some builder -> - let parseTree,_,_,parseDiagnostics = builder.GetParseResultsForFile fileName - let parseDiagnostics = DiagnosticHelpers.CreateDiagnostics (builder.TcConfig.diagnosticsOptions, false, fileName, parseDiagnostics, suggestNamesForErrors) + return FSharpParseFileResults(creationDiags, parseTree, true, [||]) + | Some builder -> + let parseTree, _, _, parseDiagnostics = builder.GetParseResultsForFile fileName + + let parseDiagnostics = + DiagnosticHelpers.CreateDiagnostics(builder.TcConfig.diagnosticsOptions, false, fileName, parseDiagnostics, suggestNamesForErrors) + let diagnostics = [| yield! creationDiags; yield! parseDiagnostics |] - let parseResults = FSharpParseFileResults(diagnostics = diagnostics, input = parseTree, parseHadErrors = false, dependencyFiles = builder.AllDependenciesDeprecated) + + let parseResults = + FSharpParseFileResults( + diagnostics = diagnostics, + input = parseTree, + parseHadErrors = false, + dependencyFiles = builder.AllDependenciesDeprecated + ) + return parseResults } @@ -543,30 +641,31 @@ type BackgroundCompiler( match cachedResultsOpt with | Some cachedResults -> match! cachedResults.GetOrComputeValue() with - | parseResults, checkResults,_,priorTimeStamp - when - (match builder.GetCheckResultsBeforeFileInProjectEvenIfStale fileName with - | None -> false - | Some(tcPrior) -> - tcPrior.ProjectTimeStamp = priorTimeStamp && - builder.AreCheckResultsBeforeFileInProjectReady(fileName)) -> - return Some (parseResults,checkResults) + | parseResults, checkResults, _, priorTimeStamp when + (match builder.GetCheckResultsBeforeFileInProjectEvenIfStale fileName with + | None -> false + | Some (tcPrior) -> + tcPrior.ProjectTimeStamp = priorTimeStamp + && builder.AreCheckResultsBeforeFileInProjectReady(fileName)) + -> + return Some(parseResults, checkResults) | _ -> parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.RemoveAnySimilar(ltok, key)) return None - | _ -> - return None + | _ -> return None } member private _.CheckOneFileImplAux - (parseResults: FSharpParseFileResults, - sourceText: ISourceText, - fileName: string, - options: FSharpProjectOptions, - builder: IncrementalBuilder, - tcPrior: PartialCheckResults, - tcInfo: TcInfo, - creationDiags: FSharpDiagnostic[]) : NodeCode = + ( + parseResults: FSharpParseFileResults, + sourceText: ISourceText, + fileName: string, + options: FSharpProjectOptions, + builder: IncrementalBuilder, + tcPrior: PartialCheckResults, + tcInfo: TcInfo, + creationDiags: FSharpDiagnostic[] + ) : NodeCode = node { // Get additional script #load closure information if applicable. @@ -574,94 +673,107 @@ type BackgroundCompiler( let tcConfig = tcPrior.TcConfig let loadClosure = scriptClosureCache.TryGet(AnyCallerThread, options) - let! checkAnswer = - FSharpCheckFileResults.CheckOneFile ( + let! checkAnswer = + FSharpCheckFileResults.CheckOneFile( parseResults, sourceText, fileName, - options.ProjectFileName, + options.ProjectFileName, tcConfig, tcPrior.TcGlobals, - tcPrior.TcImports, + tcPrior.TcImports, tcInfo.tcState, tcInfo.moduleNamesDict, loadClosure, tcInfo.TcDiagnostics, - options.IsIncompleteTypeCheckEnvironment, - options, - builder, - Array.ofList tcInfo.tcDependencyFiles, - creationDiags, - parseResults.Diagnostics, + options.IsIncompleteTypeCheckEnvironment, + options, + builder, + Array.ofList tcInfo.tcDependencyFiles, + creationDiags, + parseResults.Diagnostics, keepAssemblyContents, - suggestNamesForErrors) + suggestNamesForErrors + ) |> NodeCode.FromCancellable + GraphNode.SetPreferredUILang tcConfig.preferredUiLang return (parseResults, checkAnswer, sourceText.GetHashCode() |> int64, tcPrior.ProjectTimeStamp) } - member private bc.CheckOneFileImpl - (parseResults: FSharpParseFileResults, - sourceText: ISourceText, - fileName: string, - options: FSharpProjectOptions, - fileVersion: int, - builder: IncrementalBuilder, - tcPrior: PartialCheckResults, - tcInfo: TcInfo, - creationDiags: FSharpDiagnostic[]) = - - node { + ( + parseResults: FSharpParseFileResults, + sourceText: ISourceText, + fileName: string, + options: FSharpProjectOptions, + fileVersion: int, + builder: IncrementalBuilder, + tcPrior: PartialCheckResults, + tcInfo: TcInfo, + creationDiags: FSharpDiagnostic[] + ) = + + node { match! bc.GetCachedCheckFileResult(builder, fileName, sourceText, options) with | Some (_, results) -> return FSharpCheckFileAnswer.Succeeded results | _ -> let lazyCheckFile = - getCheckFileNode - (parseResults, sourceText, fileName, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) + getCheckFileNode (parseResults, sourceText, fileName, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) let! _, results, _, _ = lazyCheckFile.GetOrComputeValue() return FSharpCheckFileAnswer.Succeeded results - } + } - /// Type-check the result obtained by parsing, but only if the antecedent type checking context is available. - member bc.CheckFileInProjectAllowingStaleCachedResults(parseResults: FSharpParseFileResults, fileName, fileVersion, sourceText: ISourceText, options, userOpName) = + /// Type-check the result obtained by parsing, but only if the antecedent type checking context is available. + member bc.CheckFileInProjectAllowingStaleCachedResults + ( + parseResults: FSharpParseFileResults, + fileName, + fileVersion, + sourceText: ISourceText, + options, + userOpName + ) = node { - let! cachedResults = + let! cachedResults = node { - let! builderOpt, creationDiags = getAnyBuilder (options, userOpName) + let! builderOpt, creationDiags = getAnyBuilder (options, userOpName) match builderOpt with | Some builder -> match! bc.GetCachedCheckFileResult(builder, fileName, sourceText, options) with - | Some (_, checkResults) -> return Some (builder, creationDiags, Some (FSharpCheckFileAnswer.Succeeded checkResults)) - | _ -> return Some (builder, creationDiags, None) + | Some (_, checkResults) -> return Some(builder, creationDiags, Some(FSharpCheckFileAnswer.Succeeded checkResults)) + | _ -> return Some(builder, creationDiags, None) | _ -> return None // the builder wasn't ready } - + match cachedResults with | None -> return None | Some (_, _, Some x) -> return Some x | Some (builder, creationDiags, None) -> Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "CheckFileInProjectAllowingStaleCachedResults.CacheMiss", fileName) + match builder.GetCheckResultsBeforeFileInProjectEvenIfStale fileName with - | Some tcPrior -> + | Some tcPrior -> match tcPrior.TryPeekTcInfo() with - | Some tcInfo -> - let! checkResults = bc.CheckOneFileImpl(parseResults, sourceText, fileName, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) + | Some tcInfo -> + let! checkResults = + bc.CheckOneFileImpl(parseResults, sourceText, fileName, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) + return Some checkResults - | None -> - return None - | None -> return None // the incremental builder was not up to date + | None -> return None + | None -> return None // the incremental builder was not up to date } /// Type-check the result obtained by parsing. Force the evaluation of the antecedent type checking context if needed. member bc.CheckFileInProject(parseResults: FSharpParseFileResults, fileName, fileVersion, sourceText: ISourceText, options, userOpName) = node { - let! builderOpt,creationDiags = getOrCreateBuilder (options, userOpName) + let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) + match builderOpt with - | None -> return FSharpCheckFileAnswer.Succeeded (FSharpCheckFileResults.MakeEmpty(fileName, creationDiags, keepAssemblyContents)) - | Some builder -> + | None -> return FSharpCheckFileAnswer.Succeeded(FSharpCheckFileResults.MakeEmpty(fileName, creationDiags, keepAssemblyContents)) + | Some builder -> // Check the cache. We can only use cached results when there is no work to do to bring the background builder up-to-date let! cachedResults = bc.GetCachedCheckFileResult(builder, fileName, sourceText, options) @@ -674,25 +786,26 @@ type BackgroundCompiler( } /// Parses and checks the source file and returns untyped AST and check results. - member bc.ParseAndCheckFileInProject (fileName:string, fileVersion, sourceText: ISourceText, options:FSharpProjectOptions, userOpName) = + member bc.ParseAndCheckFileInProject(fileName: string, fileVersion, sourceText: ISourceText, options: FSharpProjectOptions, userOpName) = node { let strGuid = "_ProjectId=" + (options.ProjectId |> Option.defaultValue "null") Logger.LogBlockMessageStart (fileName + strGuid) LogCompilerFunctionId.Service_ParseAndCheckFileInProject - let! builderOpt,creationDiags = getOrCreateBuilder (options, userOpName) + let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) + match builderOpt with - | None -> + | None -> Logger.LogBlockMessageStop (fileName + strGuid + "-Failed_Aborted") LogCompilerFunctionId.Service_ParseAndCheckFileInProject let parseTree = EmptyParsedInput(fileName, (false, false)) - let parseResults = FSharpParseFileResults(creationDiags, parseTree, true, [| |]) + let parseResults = FSharpParseFileResults(creationDiags, parseTree, true, [||]) return (parseResults, FSharpCheckFileAnswer.Aborted) - | Some builder -> + | Some builder -> let! cachedResults = bc.GetCachedCheckFileResult(builder, fileName, sourceText, options) - match cachedResults with - | Some (parseResults, checkResults) -> + match cachedResults with + | Some (parseResults, checkResults) -> Logger.LogBlockMessageStop (fileName + strGuid + "-Successful_Cached") LogCompilerFunctionId.Service_ParseAndCheckFileInProject return (parseResults, FSharpCheckFileAnswer.Succeeded checkResults) @@ -700,11 +813,19 @@ type BackgroundCompiler( let! tcPrior = builder.GetCheckResultsBeforeFileInProject fileName let! tcInfo = tcPrior.GetOrComputeTcInfo() // Do the parsing. - let parsingOptions = FSharpParsingOptions.FromTcConfig(builder.TcConfig, Array.ofList builder.SourceFiles, options.UseScriptResolutionRules) + let parsingOptions = + FSharpParsingOptions.FromTcConfig(builder.TcConfig, Array.ofList builder.SourceFiles, options.UseScriptResolutionRules) + GraphNode.SetPreferredUILang tcPrior.TcConfig.preferredUiLang - let parseDiagnostics, parseTree, anyErrors = ParseAndCheckFile.parseFile (sourceText, fileName, parsingOptions, userOpName, suggestNamesForErrors) - let parseResults = FSharpParseFileResults(parseDiagnostics, parseTree, anyErrors, builder.AllDependenciesDeprecated) - let! checkResults = bc.CheckOneFileImpl(parseResults, sourceText, fileName, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) + + let parseDiagnostics, parseTree, anyErrors = + ParseAndCheckFile.parseFile (sourceText, fileName, parsingOptions, userOpName, suggestNamesForErrors) + + let parseResults = + FSharpParseFileResults(parseDiagnostics, parseTree, anyErrors, builder.AllDependenciesDeprecated) + + let! checkResults = + bc.CheckOneFileImpl(parseResults, sourceText, fileName, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) Logger.LogBlockMessageStop (fileName + strGuid + "-Successful") LogCompilerFunctionId.Service_ParseAndCheckFileInProject @@ -715,13 +836,14 @@ type BackgroundCompiler( member _.GetBackgroundCheckResultsForFileInProject(fileName, options, userOpName) = node { let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) + match builderOpt with | None -> let parseTree = EmptyParsedInput(fileName, (false, false)) - let parseResults = FSharpParseFileResults(creationDiags, parseTree, true, [| |]) + let parseResults = FSharpParseFileResults(creationDiags, parseTree, true, [||]) let typedResults = FSharpCheckFileResults.MakeEmpty(fileName, creationDiags, true) return (parseResults, typedResults) - | Some builder -> + | Some builder -> let parseTree, _, _, parseDiagnostics = builder.GetParseResultsForFile fileName let! tcProj = builder.GetFullCheckResultsAfterFileInProject fileName @@ -737,48 +859,74 @@ type BackgroundCompiler( let tcDependencyFiles = tcInfo.tcDependencyFiles let tcDiagnostics = tcInfo.TcDiagnostics let diagnosticsOptions = builder.TcConfig.diagnosticsOptions - let parseDiagnostics = DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, false, fileName, parseDiagnostics, suggestNamesForErrors) + + let parseDiagnostics = + DiagnosticHelpers.CreateDiagnostics(diagnosticsOptions, false, fileName, parseDiagnostics, suggestNamesForErrors) + let parseDiagnostics = [| yield! creationDiags; yield! parseDiagnostics |] - let tcDiagnostics = DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, false, fileName, tcDiagnostics, suggestNamesForErrors) + + let tcDiagnostics = + DiagnosticHelpers.CreateDiagnostics(diagnosticsOptions, false, fileName, tcDiagnostics, suggestNamesForErrors) + let tcDiagnostics = [| yield! creationDiags; yield! tcDiagnostics |] - let parseResults = FSharpParseFileResults(diagnostics=parseDiagnostics, input=parseTree, parseHadErrors=false, dependencyFiles=builder.AllDependenciesDeprecated) + + let parseResults = + FSharpParseFileResults( + diagnostics = parseDiagnostics, + input = parseTree, + parseHadErrors = false, + dependencyFiles = builder.AllDependenciesDeprecated + ) + let loadClosure = scriptClosureCache.TryGet(AnyCallerThread, options) - let typedResults = - FSharpCheckFileResults.Make - (fileName, - options.ProjectFileName, - tcProj.TcConfig, - tcProj.TcGlobals, - options.IsIncompleteTypeCheckEnvironment, - builder, - options, - Array.ofList tcDependencyFiles, - creationDiags, - parseResults.Diagnostics, - tcDiagnostics, - keepAssemblyContents, - Option.get latestCcuSigForFile, - tcState.Ccu, - tcProj.TcImports, - tcEnvAtEnd.AccessRights, - tcResolutions, - tcSymbolUses, - tcEnvAtEnd.NameEnv, - loadClosure, - latestImplementationFile, - tcOpenDeclarations) + + let typedResults = + FSharpCheckFileResults.Make( + fileName, + options.ProjectFileName, + tcProj.TcConfig, + tcProj.TcGlobals, + options.IsIncompleteTypeCheckEnvironment, + builder, + options, + Array.ofList tcDependencyFiles, + creationDiags, + parseResults.Diagnostics, + tcDiagnostics, + keepAssemblyContents, + Option.get latestCcuSigForFile, + tcState.Ccu, + tcProj.TcImports, + tcEnvAtEnd.AccessRights, + tcResolutions, + tcSymbolUses, + tcEnvAtEnd.NameEnv, + loadClosure, + latestImplementationFile, + tcOpenDeclarations + ) + return (parseResults, typedResults) - } + } - member _.FindReferencesInFile(fileName: string, options: FSharpProjectOptions, symbol: FSharpSymbol, canInvalidateProject: bool, userOpName: string) = + member _.FindReferencesInFile + ( + fileName: string, + options: FSharpProjectOptions, + symbol: FSharpSymbol, + canInvalidateProject: bool, + userOpName: string + ) = node { let! builderOpt, _ = getOrCreateBuilderWithInvalidationFlag (options, canInvalidateProject, userOpName) + match builderOpt with | None -> return Seq.empty - | Some builder -> + | Some builder -> if builder.ContainsFile fileName then let! checkResults = builder.GetFullCheckResultsAfterFileInProject fileName let! keyStoreOpt = checkResults.GetOrComputeItemKeyStoreIfEnabled() + match keyStoreOpt with | None -> return Seq.empty | Some reader -> return reader.FindAll symbol.Item @@ -786,94 +934,100 @@ type BackgroundCompiler( return Seq.empty } - member _.GetSemanticClassificationForFile(fileName: string, options: FSharpProjectOptions, userOpName: string) = node { let! builderOpt, _ = getOrCreateBuilder (options, userOpName) + match builderOpt with | None -> return None - | Some builder -> + | Some builder -> let! checkResults = builder.GetFullCheckResultsAfterFileInProject fileName let! scopt = checkResults.GetOrComputeSemanticClassificationIfEnabled() + match scopt with | None -> return None - | Some sc -> return Some (sc.GetView ()) + | Some sc -> return Some(sc.GetView()) } - /// Try to get recent approximate type check results for a file. - member _.TryGetRecentCheckResultsForFile(fileName: string, options:FSharpProjectOptions, sourceText: ISourceText option, _userOpName: string) = - match sourceText with - | Some sourceText -> + /// Try to get recent approximate type check results for a file. + member _.TryGetRecentCheckResultsForFile(fileName: string, options: FSharpProjectOptions, sourceText: ISourceText option, _userOpName: string) = + match sourceText with + | Some sourceText -> let hash = sourceText.GetHashCode() |> int64 - let resOpt = parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.TryGet(ltok,(fileName,hash,options))) + + let resOpt = + parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.TryGet(ltok, (fileName, hash, options))) + match resOpt with | Some res -> match res.TryPeekValue() with - | ValueSome(a,b,c,_) -> - Some(a,b,c) - | ValueNone -> - None - | None -> - None - | None -> - None + | ValueSome (a, b, c, _) -> Some(a, b, c) + | ValueNone -> None + | None -> None + | None -> None /// Parse and typecheck the whole project (the implementation, called recursively as project graph is evaluated) member private _.ParseAndCheckProjectImpl(options, userOpName) = - node { - let! builderOpt,creationDiags = getOrCreateBuilder (options, userOpName) - match builderOpt with - | None -> - let emptyResults = FSharpCheckProjectResults (options.ProjectFileName, None, keepAssemblyContents, creationDiags, None) - return emptyResults - | Some builder -> - let! tcProj, ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt = builder.GetFullCheckResultsAndImplementationsForProject() - let diagnosticsOptions = tcProj.TcConfig.diagnosticsOptions - let fileName = DummyFileNameForRangesWithoutASpecificLocation - - // Although we do not use 'tcInfoExtras', computing it will make sure we get an extra info. - let! tcInfo, _tcInfoExtras = tcProj.GetOrComputeTcInfoWithExtras() - - let topAttribs = tcInfo.topAttribs - let tcState = tcInfo.tcState - let tcEnvAtEnd = tcInfo.tcEnvAtEndOfFile - let tcDiagnostics = tcInfo.TcDiagnostics - let tcDependencyFiles = tcInfo.tcDependencyFiles - let tcDiagnostics = DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, true, fileName, tcDiagnostics, suggestNamesForErrors) - let diagnostics = - [| yield! creationDiags - yield! tcDiagnostics |] - - let getAssemblyData() = - match tcAssemblyDataOpt with - | ProjectAssemblyDataResult.Available data -> Some data - | _ -> None - - let details = - (tcProj.TcGlobals, tcProj.TcImports, tcState.Ccu, tcState.CcuSig, - Choice1Of2 builder, topAttribs, getAssemblyData, ilAssemRef, - tcEnvAtEnd.AccessRights, tcAssemblyExprOpt, - Array.ofList tcDependencyFiles, - options) - - let results = - FSharpCheckProjectResults( - options.ProjectFileName, - Some tcProj.TcConfig, - keepAssemblyContents, - diagnostics, - Some details - ) - return results - } + node { + let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) + + match builderOpt with + | None -> + let emptyResults = + FSharpCheckProjectResults(options.ProjectFileName, None, keepAssemblyContents, creationDiags, None) + + return emptyResults + | Some builder -> + let! tcProj, ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt = builder.GetFullCheckResultsAndImplementationsForProject() + let diagnosticsOptions = tcProj.TcConfig.diagnosticsOptions + let fileName = DummyFileNameForRangesWithoutASpecificLocation + + // Although we do not use 'tcInfoExtras', computing it will make sure we get an extra info. + let! tcInfo, _tcInfoExtras = tcProj.GetOrComputeTcInfoWithExtras() + + let topAttribs = tcInfo.topAttribs + let tcState = tcInfo.tcState + let tcEnvAtEnd = tcInfo.tcEnvAtEndOfFile + let tcDiagnostics = tcInfo.TcDiagnostics + let tcDependencyFiles = tcInfo.tcDependencyFiles + + let tcDiagnostics = + DiagnosticHelpers.CreateDiagnostics(diagnosticsOptions, true, fileName, tcDiagnostics, suggestNamesForErrors) + + let diagnostics = [| yield! creationDiags; yield! tcDiagnostics |] + + let getAssemblyData () = + match tcAssemblyDataOpt with + | ProjectAssemblyDataResult.Available data -> Some data + | _ -> None + + let details = + (tcProj.TcGlobals, + tcProj.TcImports, + tcState.Ccu, + tcState.CcuSig, + Choice1Of2 builder, + topAttribs, + getAssemblyData, + ilAssemRef, + tcEnvAtEnd.AccessRights, + tcAssemblyExprOpt, + Array.ofList tcDependencyFiles, + options) + + let results = + FSharpCheckProjectResults(options.ProjectFileName, Some tcProj.TcConfig, keepAssemblyContents, diagnostics, Some details) + + return results + } member _.GetAssemblyData(options, userOpName) = node { - let! builderOpt,_ = getOrCreateBuilder (options, userOpName) - match builderOpt with - | None -> - return ProjectAssemblyDataResult.Unavailable true - | Some builder -> + let! builderOpt, _ = getOrCreateBuilder (options, userOpName) + + match builderOpt with + | None -> return ProjectAssemblyDataResult.Unavailable true + | Some builder -> let! _, _, tcAssemblyDataOpt, _ = builder.GetCheckResultsAndImplementationsForProject() return tcAssemblyDataOpt } @@ -881,104 +1035,138 @@ type BackgroundCompiler( /// Get the timestamp that would be on the output if fully built immediately member private _.TryGetLogicalTimeStampForProject(cache, options) = match tryGetBuilderNode options with - | Some lazyWork -> + | Some lazyWork -> match lazyWork.TryPeekValue() with - | ValueSome (Some builder, _) -> - Some(builder.GetLogicalTimeStampForProject(cache)) - | _ -> - None - | _ -> - None + | ValueSome (Some builder, _) -> Some(builder.GetLogicalTimeStampForProject(cache)) + | _ -> None + | _ -> None /// Parse and typecheck the whole project. member bc.ParseAndCheckProject(options, userOpName) = bc.ParseAndCheckProjectImpl(options, userOpName) - member _.GetProjectOptionsFromScript(fileName, sourceText, previewEnabled, loadedTimeStamp, otherFlags, useFsiAuxLib: bool option, useSdkRefs: bool option, sdkDirOverride: string option, assumeDotNetFramework: bool option, optionsStamp: int64 option, _userOpName) = - cancellable { + member _.GetProjectOptionsFromScript + ( + fileName, + sourceText, + previewEnabled, + loadedTimeStamp, + otherFlags, + useFsiAuxLib: bool option, + useSdkRefs: bool option, + sdkDirOverride: string option, + assumeDotNetFramework: bool option, + optionsStamp: int64 option, + _userOpName + ) = + cancellable { use diagnostics = new DiagnosticsScope() // Do we add a reference to FSharp.Compiler.Interactive.Settings by default? let useFsiAuxLib = defaultArg useFsiAuxLib true - let useSdkRefs = defaultArg useSdkRefs true + let useSdkRefs = defaultArg useSdkRefs true let reduceMemoryUsage = ReduceMemoryFlag.Yes let previewEnabled = defaultArg previewEnabled false // Do we assume .NET Framework references for scripts? let assumeDotNetFramework = defaultArg assumeDotNetFramework true + let extraFlags = if previewEnabled then [| "--langversion:preview" |] else [||] + let otherFlags = defaultArg otherFlags extraFlags - let useSimpleResolution = + + let useSimpleResolution = #if ENABLE_MONO_SUPPORT runningOnMono || otherFlags |> Array.exists (fun x -> x = "--simpleresolution") #else true #endif let loadedTimeStamp = defaultArg loadedTimeStamp DateTime.MaxValue // Not 'now', we don't want to force reloading - let applyCompilerOptions tcConfigB = - let fsiCompilerOptions = GetCoreFsiCompilerOptions tcConfigB - ParseCompilerOptions (ignore, fsiCompilerOptions, Array.toList otherFlags) + + let applyCompilerOptions tcConfigB = + let fsiCompilerOptions = GetCoreFsiCompilerOptions tcConfigB + ParseCompilerOptions(ignore, fsiCompilerOptions, Array.toList otherFlags) let loadClosure = - LoadClosure.ComputeClosureOfScriptText(legacyReferenceResolver, - FSharpCheckerResultsSettings.defaultFSharpBinariesDir, fileName, sourceText, - CodeContext.Editing, useSimpleResolution, useFsiAuxLib, useSdkRefs, sdkDirOverride, Lexhelp.LexResourceManager(), - applyCompilerOptions, assumeDotNetFramework, - tryGetMetadataSnapshot, reduceMemoryUsage, dependencyProviderForScripts) - - let otherFlags = - [| yield "--noframework"; yield "--warn:3"; - yield! otherFlags - for r in loadClosure.References do yield "-r:" + fst r - for code,_ in loadClosure.NoWarns do yield "--nowarn:" + code + LoadClosure.ComputeClosureOfScriptText( + legacyReferenceResolver, + FSharpCheckerResultsSettings.defaultFSharpBinariesDir, + fileName, + sourceText, + CodeContext.Editing, + useSimpleResolution, + useFsiAuxLib, + useSdkRefs, + sdkDirOverride, + Lexhelp.LexResourceManager(), + applyCompilerOptions, + assumeDotNetFramework, + tryGetMetadataSnapshot, + reduceMemoryUsage, + dependencyProviderForScripts + ) + + let otherFlags = + [| + yield "--noframework" + yield "--warn:3" + yield! otherFlags + for r in loadClosure.References do + yield "-r:" + fst r + for code, _ in loadClosure.NoWarns do + yield "--nowarn:" + code |] - let options = + let options = { ProjectFileName = fileName + ".fsproj" // Make a name that is unique in this directory. ProjectId = None SourceFiles = loadClosure.SourceFiles |> List.map fst |> List.toArray - OtherOptions = otherFlags - ReferencedProjects= [| |] + OtherOptions = otherFlags + ReferencedProjects = [||] IsIncompleteTypeCheckEnvironment = false - UseScriptResolutionRules = true + UseScriptResolutionRules = true LoadTime = loadedTimeStamp - UnresolvedReferences = Some (FSharpUnresolvedReferencesSet(loadClosure.UnresolvedReferences)) + UnresolvedReferences = Some(FSharpUnresolvedReferencesSet(loadClosure.UnresolvedReferences)) OriginalLoadReferences = loadClosure.OriginalLoadReferences Stamp = optionsStamp } + scriptClosureCache.Set(AnyCallerThread, options, loadClosure) // Save the full load closure for later correlation. - let diags = loadClosure.LoadClosureRootFileDiagnostics |> List.map (fun (exn, isError) -> FSharpDiagnostic.CreateFromException(exn, isError, range.Zero, false)) + + let diags = + loadClosure.LoadClosureRootFileDiagnostics + |> List.map (fun (exn, isError) -> FSharpDiagnostic.CreateFromException(exn, isError, range.Zero, false)) + return options, (diags @ diagnostics.Diagnostics) - } - |> Cancellable.toAsync - + } + |> Cancellable.toAsync + member bc.InvalidateConfiguration(options: FSharpProjectOptions, userOpName) = - if incrementalBuildersCache.ContainsSimilarKey (AnyCallerThread, options) then - parseCacheLock.AcquireLock(fun ltok -> + if incrementalBuildersCache.ContainsSimilarKey(AnyCallerThread, options) then + parseCacheLock.AcquireLock(fun ltok -> for sourceFile in options.SourceFiles do - checkFileInProjectCache.RemoveAnySimilar(ltok, (sourceFile, 0L, options)) - ) + checkFileInProjectCache.RemoveAnySimilar(ltok, (sourceFile, 0L, options))) + let _ = createBuilderNode (options, userOpName, CancellationToken.None) () member bc.ClearCache(options: seq, _userOpName) = lock gate (fun () -> options - |> Seq.iter (fun options -> incrementalBuildersCache.RemoveAnySimilar(AnyCallerThread, options)) - ) + |> Seq.iter (fun options -> incrementalBuildersCache.RemoveAnySimilar(AnyCallerThread, options))) - member _.NotifyProjectCleaned (options: FSharpProjectOptions, userOpName) = + member _.NotifyProjectCleaned(options: FSharpProjectOptions, userOpName) = async { let! ct = Async.CancellationToken - // If there was a similar entry (as there normally will have been) then re-establish an empty builder . This - // is a somewhat arbitrary choice - it will have the effect of releasing memory associated with the previous + // If there was a similar entry (as there normally will have been) then re-establish an empty builder . This + // is a somewhat arbitrary choice - it will have the effect of releasing memory associated with the previous // builder, but costs some time. - if incrementalBuildersCache.ContainsSimilarKey (AnyCallerThread, options) then + if incrementalBuildersCache.ContainsSimilarKey(AnyCallerThread, options) then let _ = createBuilderNode (options, userOpName, ct) () } @@ -993,42 +1181,44 @@ type BackgroundCompiler( member _.ClearCaches() = lock gate (fun () -> - parseCacheLock.AcquireLock (fun ltok -> + parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.Clear(ltok) parseFileCache.Clear(ltok)) + incrementalBuildersCache.Clear(AnyCallerThread) frameworkTcImportsCache.Clear() - scriptClosureCache.Clear AnyCallerThread - ) + scriptClosureCache.Clear AnyCallerThread) member _.DownsizeCaches() = lock gate (fun () -> - parseCacheLock.AcquireLock (fun ltok -> - checkFileInProjectCache.Resize(ltok, newKeepStrongly=1) - parseFileCache.Resize(ltok, newKeepStrongly=1)) - incrementalBuildersCache.Resize(AnyCallerThread, newKeepStrongly=1, newKeepMax=1) + parseCacheLock.AcquireLock(fun ltok -> + checkFileInProjectCache.Resize(ltok, newKeepStrongly = 1) + parseFileCache.Resize(ltok, newKeepStrongly = 1)) + + incrementalBuildersCache.Resize(AnyCallerThread, newKeepStrongly = 1, newKeepMax = 1) frameworkTcImportsCache.Downsize() - scriptClosureCache.Resize(AnyCallerThread,newKeepStrongly=1, newKeepMax=1) - ) - + scriptClosureCache.Resize(AnyCallerThread, newKeepStrongly = 1, newKeepMax = 1)) + member _.FrameworkImportsCache = frameworkTcImportsCache static member ActualParseFileCount = actualParseFileCount static member ActualCheckFileCount = actualCheckFileCount - [] // There is typically only one instance of this type in an IDE process. -type FSharpChecker(legacyReferenceResolver, - projectCacheSize, - keepAssemblyContents, - keepAllBackgroundResolutions, - tryGetMetadataSnapshot, - suggestNamesForErrors, - keepAllBackgroundSymbolUses, - enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking) = +type FSharpChecker + ( + legacyReferenceResolver, + projectCacheSize, + keepAssemblyContents, + keepAllBackgroundResolutions, + tryGetMetadataSnapshot, + suggestNamesForErrors, + keepAllBackgroundSymbolUses, + enableBackgroundItemKeyStoreAndSemanticClassification, + enablePartialTypeChecking + ) = let backgroundCompiler = BackgroundCompiler( @@ -1040,32 +1230,36 @@ type FSharpChecker(legacyReferenceResolver, suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking) + enablePartialTypeChecking + ) static let globalInstance = lazy FSharpChecker.Create() - + // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.braceMatchCache. Most recently used cache for brace matching. Accessed on the // background UI thread, not on the compiler thread. // // This cache is safe for concurrent access. - let braceMatchCache = MruCache(braceMatchCacheSize, areSimilar = AreSimilarForParsing, areSame = AreSameForParsing) - - /// Instantiate an interactive checker. - static member Create( - ?projectCacheSize, - ?keepAssemblyContents, - ?keepAllBackgroundResolutions, - ?legacyReferenceResolver, - ?tryGetMetadataSnapshot, - ?suggestNamesForErrors, - ?keepAllBackgroundSymbolUses, - ?enableBackgroundItemKeyStoreAndSemanticClassification, - ?enablePartialTypeChecking) = - - let legacyReferenceResolver = + let braceMatchCache = + MruCache(braceMatchCacheSize, areSimilar = AreSimilarForParsing, areSame = AreSameForParsing) + + /// Instantiate an interactive checker. + static member Create + ( + ?projectCacheSize, + ?keepAssemblyContents, + ?keepAllBackgroundResolutions, + ?legacyReferenceResolver, + ?tryGetMetadataSnapshot, + ?suggestNamesForErrors, + ?keepAllBackgroundSymbolUses, + ?enableBackgroundItemKeyStoreAndSemanticClassification, + ?enablePartialTypeChecking + ) = + + let legacyReferenceResolver = match legacyReferenceResolver with | Some rr -> rr - | None -> SimulatedMSBuildReferenceResolver.getResolver() + | None -> SimulatedMSBuildReferenceResolver.getResolver () let keepAssemblyContents = defaultArg keepAssemblyContents false let keepAllBackgroundResolutions = defaultArg keepAllBackgroundResolutions true @@ -1073,13 +1267,17 @@ type FSharpChecker(legacyReferenceResolver, let tryGetMetadataSnapshot = defaultArg tryGetMetadataSnapshot (fun _ -> None) let suggestNamesForErrors = defaultArg suggestNamesForErrors false let keepAllBackgroundSymbolUses = defaultArg keepAllBackgroundSymbolUses true - let enableBackgroundItemKeyStoreAndSemanticClassification = defaultArg enableBackgroundItemKeyStoreAndSemanticClassification false + + let enableBackgroundItemKeyStoreAndSemanticClassification = + defaultArg enableBackgroundItemKeyStoreAndSemanticClassification false + let enablePartialTypeChecking = defaultArg enablePartialTypeChecking false if keepAssemblyContents && enablePartialTypeChecking then invalidArg "enablePartialTypeChecking" "'keepAssemblyContents' and 'enablePartialTypeChecking' cannot be both enabled." - FSharpChecker(legacyReferenceResolver, + FSharpChecker( + legacyReferenceResolver, projectCacheSizeReal, keepAssemblyContents, keepAllBackgroundResolutions, @@ -1087,18 +1285,22 @@ type FSharpChecker(legacyReferenceResolver, suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking) + enablePartialTypeChecking + ) member _.ReferenceResolver = legacyReferenceResolver member _.MatchBraces(fileName, sourceText: ISourceText, options: FSharpParsingOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" let hash = sourceText.GetHashCode() |> int64 + async { match braceMatchCache.TryGet(AnyCallerThread, (fileName, hash, options)) with | Some res -> return res | None -> - let res = ParseAndCheckFile.matchBraces(sourceText, fileName, options, userOpName, suggestNamesForErrors) + let res = + ParseAndCheckFile.matchBraces (sourceText, fileName, options, userOpName, suggestNamesForErrors) + braceMatchCache.Set(AnyCallerThread, (fileName, hash, options), res) return res } @@ -1108,7 +1310,7 @@ type FSharpChecker(legacyReferenceResolver, let parsingOptions, _ = ic.GetParsingOptionsFromProjectOptions(options) ic.MatchBraces(fileName, SourceText.ofString source, parsingOptions, userOpName) - member ic.GetParsingOptionsFromProjectOptions(options): FSharpParsingOptions * _ = + member ic.GetParsingOptionsFromProjectOptions(options) : FSharpParsingOptions * _ = let sourceFiles = List.ofArray options.SourceFiles let argv = List.ofArray options.OtherOptions ic.GetParsingOptionsFromCommandLineArgs(sourceFiles, argv, options.UseScriptResolutionRules) @@ -1120,103 +1322,163 @@ type FSharpChecker(legacyReferenceResolver, member ic.ParseFileInProject(fileName, source: string, options, ?cache: bool, ?userOpName: string) = let parsingOptions, _ = ic.GetParsingOptionsFromProjectOptions(options) - ic.ParseFile(fileName, SourceText.ofString source, parsingOptions, ?cache=cache, ?userOpName=userOpName) + ic.ParseFile(fileName, SourceText.ofString source, parsingOptions, ?cache = cache, ?userOpName = userOpName) - member _.GetBackgroundParseResultsForFileInProject (fileName,options, ?userOpName: string) = + member _.GetBackgroundParseResultsForFileInProject(fileName, options, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" + backgroundCompiler.GetBackgroundParseResultsForFileInProject(fileName, options, userOpName) |> Async.AwaitNodeCode - - member _.GetBackgroundCheckResultsForFileInProject (fileName,options, ?userOpName: string) = + + member _.GetBackgroundCheckResultsForFileInProject(fileName, options, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.GetBackgroundCheckResultsForFileInProject(fileName,options, userOpName) + + backgroundCompiler.GetBackgroundCheckResultsForFileInProject(fileName, options, userOpName) |> Async.AwaitNodeCode - - /// Try to get recent approximate type check results for a file. - member _.TryGetRecentCheckResultsForFile(fileName: string, options:FSharpProjectOptions, ?sourceText, ?userOpName: string) = + + /// Try to get recent approximate type check results for a file. + member _.TryGetRecentCheckResultsForFile(fileName: string, options: FSharpProjectOptions, ?sourceText, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.TryGetRecentCheckResultsForFile(fileName,options,sourceText,userOpName) + backgroundCompiler.TryGetRecentCheckResultsForFile(fileName, options, sourceText, userOpName) member _.Compile(argv: string[], ?userOpName: string) = let _userOpName = defaultArg userOpName "Unknown" + async { let ctok = CompilationThreadToken() return CompileHelpers.compileFromArgs (ctok, argv, legacyReferenceResolver, None, None) } - member _.Compile (ast:ParsedInput list, assemblyName:string, outFile:string, dependencies:string list, ?pdbFile:string, ?executable:bool, ?noframework:bool, ?userOpName: string) = - let _userOpName = defaultArg userOpName "Unknown" - async { - let ctok = CompilationThreadToken() - let noframework = defaultArg noframework false - return CompileHelpers.compileFromAsts (ctok, legacyReferenceResolver, ast, assemblyName, outFile, dependencies, noframework, pdbFile, executable, None, None) - } - - member _.CompileToDynamicAssembly (otherFlags: string[], execute: (TextWriter * TextWriter) option, ?userOpName: string) = - let _userOpName = defaultArg userOpName "Unknown" - async { - let ctok = CompilationThreadToken() - CompileHelpers.setOutputStreams execute - - // References used to capture the results of compilation - let tcImportsRef = ref None - let assemblyBuilderRef = ref None - let tcImportsCapture = Some (fun tcImports -> tcImportsRef.Value <- Some tcImports) - - // Function to generate and store the results of compilation - let debugInfo = otherFlags |> Array.exists (fun arg -> arg = "-g" || arg = "--debug:+" || arg = "/debug:+") - let dynamicAssemblyCreator = Some (CompileHelpers.createDynamicAssembly (debugInfo, tcImportsRef, execute.IsSome, assemblyBuilderRef)) - - // Perform the compilation, given the above capturing function. - let diagnostics, result = CompileHelpers.compileFromArgs (ctok, otherFlags, legacyReferenceResolver, tcImportsCapture, dynamicAssemblyCreator) - - // Retrieve and return the results - let assemblyOpt = - match assemblyBuilderRef.Value with - | None -> None - | Some a -> Some (a :> Assembly) + member _.Compile + ( + ast: ParsedInput list, + assemblyName: string, + outFile: string, + dependencies: string list, + ?pdbFile: string, + ?executable: bool, + ?noframework: bool, + ?userOpName: string + ) = + let _userOpName = defaultArg userOpName "Unknown" + + async { + let ctok = CompilationThreadToken() + let noframework = defaultArg noframework false - return diagnostics, result, assemblyOpt - } + return + CompileHelpers.compileFromAsts ( + ctok, + legacyReferenceResolver, + ast, + assemblyName, + outFile, + dependencies, + noframework, + pdbFile, + executable, + None, + None + ) + } - member _.CompileToDynamicAssembly (ast:ParsedInput list, assemblyName:string, dependencies:string list, execute: (TextWriter * TextWriter) option, ?debug:bool, ?noframework:bool, ?userOpName: string) = - let _userOpName = defaultArg userOpName "Unknown" - async { - let ctok = CompilationThreadToken() - CompileHelpers.setOutputStreams execute + member _.CompileToDynamicAssembly(otherFlags: string[], execute: (TextWriter * TextWriter) option, ?userOpName: string) = + let _userOpName = defaultArg userOpName "Unknown" - // References used to capture the results of compilation - let tcImportsRef = ref (None: TcImports option) - let assemblyBuilderRef = ref None - let tcImportsCapture = Some (fun tcImports -> tcImportsRef.Value <- Some tcImports) + async { + let ctok = CompilationThreadToken() + CompileHelpers.setOutputStreams execute - let debugInfo = defaultArg debug false - let noframework = defaultArg noframework false - let location = Path.Combine(FileSystem.GetTempPathShim(),"test"+string(hash assemblyName)) - try Directory.CreateDirectory(location) |> ignore with _ -> () + // References used to capture the results of compilation + let tcImportsRef = ref None + let assemblyBuilderRef = ref None + let tcImportsCapture = Some(fun tcImports -> tcImportsRef.Value <- Some tcImports) - let outFile = Path.Combine(location, assemblyName + ".dll") + // Function to generate and store the results of compilation + let debugInfo = + otherFlags + |> Array.exists (fun arg -> arg = "-g" || arg = "--debug:+" || arg = "/debug:+") - // Function to generate and store the results of compilation - let dynamicAssemblyCreator = Some (CompileHelpers.createDynamicAssembly (debugInfo, tcImportsRef, execute.IsSome, assemblyBuilderRef)) + let dynamicAssemblyCreator = + Some(CompileHelpers.createDynamicAssembly (debugInfo, tcImportsRef, execute.IsSome, assemblyBuilderRef)) - // Perform the compilation, given the above capturing function. - let diagnostics, result = - CompileHelpers.compileFromAsts (ctok, legacyReferenceResolver, ast, assemblyName, outFile, dependencies, noframework, None, Some execute.IsSome, tcImportsCapture, dynamicAssemblyCreator) + // Perform the compilation, given the above capturing function. + let diagnostics, result = + CompileHelpers.compileFromArgs (ctok, otherFlags, legacyReferenceResolver, tcImportsCapture, dynamicAssemblyCreator) - // Retrieve and return the results - let assemblyOpt = - match assemblyBuilderRef.Value with - | None -> None - | Some a -> Some (a :> Assembly) + // Retrieve and return the results + let assemblyOpt = + match assemblyBuilderRef.Value with + | None -> None + | Some a -> Some(a :> Assembly) + + return diagnostics, result, assemblyOpt + } + + member _.CompileToDynamicAssembly + ( + ast: ParsedInput list, + assemblyName: string, + dependencies: string list, + execute: (TextWriter * TextWriter) option, + ?debug: bool, + ?noframework: bool, + ?userOpName: string + ) = + let _userOpName = defaultArg userOpName "Unknown" + + async { + let ctok = CompilationThreadToken() + CompileHelpers.setOutputStreams execute + + // References used to capture the results of compilation + let tcImportsRef = ref (None: TcImports option) + let assemblyBuilderRef = ref None + let tcImportsCapture = Some(fun tcImports -> tcImportsRef.Value <- Some tcImports) - return diagnostics, result, assemblyOpt - } + let debugInfo = defaultArg debug false + let noframework = defaultArg noframework false + let location = Path.Combine(FileSystem.GetTempPathShim(), "test" + string (hash assemblyName)) + + try + Directory.CreateDirectory(location) |> ignore + with _ -> + () + + let outFile = Path.Combine(location, assemblyName + ".dll") + + // Function to generate and store the results of compilation + let dynamicAssemblyCreator = + Some(CompileHelpers.createDynamicAssembly (debugInfo, tcImportsRef, execute.IsSome, assemblyBuilderRef)) + + // Perform the compilation, given the above capturing function. + let diagnostics, result = + CompileHelpers.compileFromAsts ( + ctok, + legacyReferenceResolver, + ast, + assemblyName, + outFile, + dependencies, + noframework, + None, + Some execute.IsSome, + tcImportsCapture, + dynamicAssemblyCreator + ) + + // Retrieve and return the results + let assemblyOpt = + match assemblyBuilderRef.Value with + | None -> None + | Some a -> Some(a :> Assembly) + + return diagnostics, result, assemblyOpt + } /// This function is called when the entire environment is known to have changed for reasons not encoded in the ProjectOptions of any project/compilation. /// For example, the type provider approvals file may have changed. - member ic.InvalidateAll() = - ic.ClearCaches() + member ic.InvalidateAll() = ic.ClearCaches() member ic.ClearCaches() = let utok = AnyCallerThread @@ -1228,9 +1490,9 @@ type FSharpChecker(legacyReferenceResolver, member ic.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() = ic.ClearCaches() GC.Collect() - GC.WaitForPendingFinalizers() + GC.WaitForPendingFinalizers() FxResolver.ClearStaticCaches() - + /// This function is called when the configuration is known to have changed for reasons not encoded in the ProjectOptions. /// For example, dependent references may have been deleted or created. member _.InvalidateConfiguration(options: FSharpProjectOptions, ?userOpName: string) = @@ -1245,136 +1507,232 @@ type FSharpChecker(legacyReferenceResolver, /// This function is called when a project has been cleaned, and thus type providers should be refreshed. member _.NotifyProjectCleaned(options: FSharpProjectOptions, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.NotifyProjectCleaned (options, userOpName) - - /// Typecheck a source code file, returning a handle to the results of the + backgroundCompiler.NotifyProjectCleaned(options, userOpName) + + /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. - member _.CheckFileInProjectAllowingStaleCachedResults(parseResults:FSharpParseFileResults, fileName:string, fileVersion:int, source:string, options:FSharpProjectOptions, ?userOpName: string) = + member _.CheckFileInProjectAllowingStaleCachedResults + ( + parseResults: FSharpParseFileResults, + fileName: string, + fileVersion: int, + source: string, + options: FSharpProjectOptions, + ?userOpName: string + ) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.CheckFileInProjectAllowingStaleCachedResults(parseResults,fileName,fileVersion,SourceText.ofString source,options,userOpName) + + backgroundCompiler.CheckFileInProjectAllowingStaleCachedResults( + parseResults, + fileName, + fileVersion, + SourceText.ofString source, + options, + userOpName + ) |> Async.AwaitNodeCode - /// Typecheck a source code file, returning a handle to the results of the + /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. - member _.CheckFileInProject(parseResults:FSharpParseFileResults, fileName:string, fileVersion:int, sourceText:ISourceText, options:FSharpProjectOptions, ?userOpName: string) = + member _.CheckFileInProject + ( + parseResults: FSharpParseFileResults, + fileName: string, + fileVersion: int, + sourceText: ISourceText, + options: FSharpProjectOptions, + ?userOpName: string + ) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.CheckFileInProject(parseResults,fileName,fileVersion,sourceText,options,userOpName) + + backgroundCompiler.CheckFileInProject(parseResults, fileName, fileVersion, sourceText, options, userOpName) |> Async.AwaitNodeCode - /// Typecheck a source code file, returning a handle to the results of the + /// Typecheck a source code file, returning a handle to the results of the /// parse including the reconstructed types in the file. - member _.ParseAndCheckFileInProject(fileName:string, fileVersion:int, sourceText:ISourceText, options:FSharpProjectOptions, ?userOpName: string) = + member _.ParseAndCheckFileInProject + ( + fileName: string, + fileVersion: int, + sourceText: ISourceText, + options: FSharpProjectOptions, + ?userOpName: string + ) = let userOpName = defaultArg userOpName "Unknown" + backgroundCompiler.ParseAndCheckFileInProject(fileName, fileVersion, sourceText, options, userOpName) |> Async.AwaitNodeCode - + member _.ParseAndCheckProject(options, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" + backgroundCompiler.ParseAndCheckProject(options, userOpName) |> Async.AwaitNodeCode - member _.FindBackgroundReferencesInFile(fileName:string, options: FSharpProjectOptions, symbol: FSharpSymbol, ?canInvalidateProject: bool, ?userOpName: string) = + member _.FindBackgroundReferencesInFile + ( + fileName: string, + options: FSharpProjectOptions, + symbol: FSharpSymbol, + ?canInvalidateProject: bool, + ?userOpName: string + ) = let canInvalidateProject = defaultArg canInvalidateProject true let userOpName = defaultArg userOpName "Unknown" + backgroundCompiler.FindReferencesInFile(fileName, options, symbol, canInvalidateProject, userOpName) |> Async.AwaitNodeCode - member _.GetBackgroundSemanticClassificationForFile(fileName:string, options: FSharpProjectOptions, ?userOpName) = + member _.GetBackgroundSemanticClassificationForFile(fileName: string, options: FSharpProjectOptions, ?userOpName) = let userOpName = defaultArg userOpName "Unknown" + backgroundCompiler.GetSemanticClassificationForFile(fileName, options, userOpName) |> Async.AwaitNodeCode /// For a given script file, get the ProjectOptions implied by the #load closure - member _.GetProjectOptionsFromScript(fileName, source, ?previewEnabled, ?loadedTimeStamp, ?otherFlags, ?useFsiAuxLib, ?useSdkRefs, ?assumeDotNetFramework, ?sdkDirOverride, ?optionsStamp: int64, ?userOpName: string) = + member _.GetProjectOptionsFromScript + ( + fileName, + source, + ?previewEnabled, + ?loadedTimeStamp, + ?otherFlags, + ?useFsiAuxLib, + ?useSdkRefs, + ?assumeDotNetFramework, + ?sdkDirOverride, + ?optionsStamp: int64, + ?userOpName: string + ) = let userOpName = defaultArg userOpName "Unknown" - backgroundCompiler.GetProjectOptionsFromScript(fileName, source, previewEnabled, loadedTimeStamp, otherFlags, useFsiAuxLib, useSdkRefs, sdkDirOverride, assumeDotNetFramework, optionsStamp, userOpName) - member _.GetProjectOptionsFromCommandLineArgs(projectFileName, argv, ?loadedTimeStamp, ?isInteractive, ?isEditing) = + backgroundCompiler.GetProjectOptionsFromScript( + fileName, + source, + previewEnabled, + loadedTimeStamp, + otherFlags, + useFsiAuxLib, + useSdkRefs, + sdkDirOverride, + assumeDotNetFramework, + optionsStamp, + userOpName + ) + + member _.GetProjectOptionsFromCommandLineArgs(projectFileName, argv, ?loadedTimeStamp, ?isInteractive, ?isEditing) = let isEditing = defaultArg isEditing false let isInteractive = defaultArg isInteractive false let loadedTimeStamp = defaultArg loadedTimeStamp DateTime.MaxValue // Not 'now', we don't want to force reloading - let argv = - let define = if isInteractive then "--define:INTERACTIVE" else "--define:COMPILED" + + let argv = + let define = + if isInteractive then + "--define:INTERACTIVE" + else + "--define:COMPILED" + Array.append argv [| define |] - let argv = - if isEditing then Array.append argv [| "--define:EDITING" |] else argv - { ProjectFileName = projectFileName - ProjectId = None - SourceFiles = [| |] // the project file names will be inferred from the ProjectOptions - OtherOptions = argv - ReferencedProjects= [| |] - IsIncompleteTypeCheckEnvironment = false - UseScriptResolutionRules = false - LoadTime = loadedTimeStamp - UnresolvedReferences = None - OriginalLoadReferences=[] - Stamp = None } + + let argv = + if isEditing then + Array.append argv [| "--define:EDITING" |] + else + argv + + { + ProjectFileName = projectFileName + ProjectId = None + SourceFiles = [||] // the project file names will be inferred from the ProjectOptions + OtherOptions = argv + ReferencedProjects = [||] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false + LoadTime = loadedTimeStamp + UnresolvedReferences = None + OriginalLoadReferences = [] + Stamp = None + } member _.GetParsingOptionsFromCommandLineArgs(sourceFiles, argv, ?isInteractive, ?isEditing) = let isEditing = defaultArg isEditing false let isInteractive = defaultArg isInteractive false use errorScope = new DiagnosticsScope() - let tcConfigB = - TcConfigBuilder.CreateNew(legacyReferenceResolver, - defaultFSharpBinariesDir=FSharpCheckerResultsSettings.defaultFSharpBinariesDir, - reduceMemoryUsage=ReduceMemoryFlag.Yes, - implicitIncludeDir="", - isInteractive=isInteractive, - isInvalidationSupported=false, - defaultCopyFSharpCore=CopyFSharpCoreFlag.No, - tryGetMetadataSnapshot=tryGetMetadataSnapshot, - sdkDirOverride=None, - rangeForErrors=range0) + + let tcConfigB = + TcConfigBuilder.CreateNew( + legacyReferenceResolver, + defaultFSharpBinariesDir = FSharpCheckerResultsSettings.defaultFSharpBinariesDir, + reduceMemoryUsage = ReduceMemoryFlag.Yes, + implicitIncludeDir = "", + isInteractive = isInteractive, + isInvalidationSupported = false, + defaultCopyFSharpCore = CopyFSharpCoreFlag.No, + tryGetMetadataSnapshot = tryGetMetadataSnapshot, + sdkDirOverride = None, + rangeForErrors = range0 + ) // These defines are implied by the F# compiler - tcConfigB.conditionalDefines <- + tcConfigB.conditionalDefines <- let define = if isInteractive then "INTERACTIVE" else "COMPILED" define :: tcConfigB.conditionalDefines - if isEditing then - tcConfigB.conditionalDefines <- "EDITING":: tcConfigB.conditionalDefines + + if isEditing then + tcConfigB.conditionalDefines <- "EDITING" :: tcConfigB.conditionalDefines // Apply command-line arguments and collect more source files if they are in the arguments let sourceFilesNew = ApplyCommandLineArgs(tcConfigB, sourceFiles, argv) FSharpParsingOptions.FromTcConfigBuilder(tcConfigB, Array.ofList sourceFilesNew, isInteractive), errorScope.Diagnostics member ic.GetParsingOptionsFromCommandLineArgs(argv, ?isInteractive: bool, ?isEditing) = - ic.GetParsingOptionsFromCommandLineArgs([], argv, ?isInteractive=isInteractive, ?isEditing=isEditing) + ic.GetParsingOptionsFromCommandLineArgs([], argv, ?isInteractive = isInteractive, ?isEditing = isEditing) - member _.BeforeBackgroundFileCheck = backgroundCompiler.BeforeBackgroundFileCheck + member _.BeforeBackgroundFileCheck = backgroundCompiler.BeforeBackgroundFileCheck - member _.FileParsed = backgroundCompiler.FileParsed + member _.FileParsed = backgroundCompiler.FileParsed - member _.FileChecked = backgroundCompiler.FileChecked + member _.FileChecked = backgroundCompiler.FileChecked member _.ProjectChecked = backgroundCompiler.ProjectChecked static member ActualParseFileCount = BackgroundCompiler.ActualParseFileCount static member ActualCheckFileCount = BackgroundCompiler.ActualCheckFileCount - - static member Instance with get() = globalInstance.Force() + + static member Instance = globalInstance.Force() member internal _.FrameworkImportsCache = backgroundCompiler.FrameworkImportsCache /// Tokenize a single line, returning token information and a tokenization state represented by an integer - member _.TokenizeLine (line: string, state: FSharpTokenizerLexState) = + member _.TokenizeLine(line: string, state: FSharpTokenizerLexState) = let tokenizer = FSharpSourceTokenizer([], None) let lineTokenizer = tokenizer.CreateLineTokenizer line let mutable state = (None, state) - let tokens = - [| while (state <- lineTokenizer.ScanToken (snd state); (fst state).IsSome) do - yield (fst state).Value |] - tokens, snd state + + let tokens = + [| + while (state <- lineTokenizer.ScanToken(snd state) + (fst state).IsSome) do + yield (fst state).Value + |] + + tokens, snd state /// Tokenize an entire file, line by line - member x.TokenizeFile (source: string) : FSharpTokenInfo[][] = + member x.TokenizeFile(source: string) : FSharpTokenInfo[][] = let lines = source.Split('\n') - let tokens = - [| let mutable state = FSharpTokenizerLexState.Initial - for line in lines do - let tokens, n = x.TokenizeLine(line, state) - state <- n - yield tokens |] + + let tokens = + [| + let mutable state = FSharpTokenizerLexState.Initial + + for line in lines do + let tokens, n = x.TokenizeLine(line, state) + state <- n + yield tokens + |] + tokens namespace FSharp.Compiler @@ -1401,17 +1759,27 @@ type CompilerEnvironment() = // Legacy entry point, no longer used by FSharp.Editor static member DefaultReferencesForOrphanSources assumeDotNetFramework = let currentDirectory = Directory.GetCurrentDirectory() - let fxResolver = FxResolver(assumeDotNetFramework, currentDirectory, rangeForErrors=range0, useSdkRefs=true, isInteractive=false, sdkDirOverride=None) - let references, _ = fxResolver.GetDefaultReferences (useFsiAuxLib=false) + + let fxResolver = + FxResolver( + assumeDotNetFramework, + currentDirectory, + rangeForErrors = range0, + useSdkRefs = true, + isInteractive = false, + sdkDirOverride = None + ) + + let references, _ = fxResolver.GetDefaultReferences(useFsiAuxLib = false) references - + /// Publish compiler-flags parsing logic. Must be fast because its used by the colorizer. - static member GetConditionalDefinesForEditing (parsingOptions: FSharpParsingOptions) = - SourceFileImpl.GetImplicitConditionalDefinesForEditing(parsingOptions.IsInteractive) @ - parsingOptions.ConditionalDefines - + static member GetConditionalDefinesForEditing(parsingOptions: FSharpParsingOptions) = + SourceFileImpl.GetImplicitConditionalDefinesForEditing(parsingOptions.IsInteractive) + @ parsingOptions.ConditionalDefines + /// Return true if this is a subcategory of error or warning message that the language service can emit - static member IsCheckerSupportedSubcategory(subcategory:string) = + static member IsCheckerSupportedSubcategory(subcategory: string) = // Beware: This code logic is duplicated in DocumentTask.cs in the language service PhasedDiagnostic.IsSubcategoryOfCompile(subcategory) @@ -1419,15 +1787,19 @@ type CompilerEnvironment() = /// debugger will use. static member GetDebuggerLanguageID() = Guid(0xAB4F38C9u, 0xB6E6us, 0x43baus, 0xBEuy, 0x3Buy, 0x58uy, 0x08uy, 0x0Buy, 0x2Cuy, 0xCCuy, 0xE3uy) - - static member IsScriptFile (fileName: string) = ParseAndCheckInputs.IsScript fileName + + static member IsScriptFile(fileName: string) = ParseAndCheckInputs.IsScript fileName /// Whether or not this file is compilable static member IsCompilable file = let ext = Path.GetExtension file - compilableExtensions |> List.exists(fun e->0 = String.Compare(e, ext, StringComparison.OrdinalIgnoreCase)) + + compilableExtensions + |> List.exists (fun e -> 0 = String.Compare(e, ext, StringComparison.OrdinalIgnoreCase)) /// Whether or not this file should be a single-file project static member MustBeSingleFileProject file = let ext = Path.GetExtension file - singleFileProjectExtensions |> List.exists(fun e-> 0 = String.Compare(e, ext, StringComparison.OrdinalIgnoreCase)) \ No newline at end of file + + singleFileProjectExtensions + |> List.exists (fun e -> 0 = String.Compare(e, ext, StringComparison.OrdinalIgnoreCase))