From 8975468656f7b59e846302cd167814a16318401d Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 23 Jan 2020 12:58:28 -0800 Subject: [PATCH 01/24] Added ItemKey.fsi/fsi. Added blank SemanticClassification.fs/fsi. --- .../FSharp.Compiler.Private.fsproj | 12 + src/fsharp/service/ItemKey.fs | 373 ++++++++++++++++++ src/fsharp/service/ItemKey.fsi | 0 src/fsharp/service/SemanticClassification.fs | 0 src/fsharp/service/SemanticClassification.fsi | 0 5 files changed, 385 insertions(+) create mode 100644 src/fsharp/service/ItemKey.fs create mode 100644 src/fsharp/service/ItemKey.fsi create mode 100644 src/fsharp/service/SemanticClassification.fs create mode 100644 src/fsharp/service/SemanticClassification.fsi diff --git a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj index e226bcbe98b..d9d27fbdefa 100644 --- a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj +++ b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj @@ -579,6 +579,18 @@ + + Service/ItemKey.fsi + + + Service/ItemKey.fs + + + Service/SemanticClassification.fsi + + + Service/SemanticClassification.fs + Service/IncrementalBuild.fsi diff --git a/src/fsharp/service/ItemKey.fs b/src/fsharp/service/ItemKey.fs new file mode 100644 index 00000000000..9caebe906ae --- /dev/null +++ b/src/fsharp/service/ItemKey.fs @@ -0,0 +1,373 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.SourceCodeServices + +open System +open System.Text +open System.IO +open System.IO.MemoryMappedFiles +open System.Reflection.Metadata +open System.Collections.Immutable +open FSharp.NativeInterop +open FSharp.Compiler +open FSharp.Compiler.Range +open FSharp.Compiler.Tast +open FSharp.Compiler.Infos +open FSharp.Compiler.NameResolution +open FSharp.Compiler.AbstractIL.IL + +#nowarn "9" + +[] +type ItemKeyReader(mmf: MemoryMappedFile, length, hold: IDisposable) = + + let mutable isDisposed = false + let checkDispose() = + if isDisposed then + invalidOp "FSharpSymbolKeyReader already disposed" + + let viewAccessor = mmf.CreateViewAccessor() + + // This has to be mutable because BlobReader is a struct and we have to mutate its contents. + let mutable reader = BlobReader(viewAccessor.SafeMemoryMappedViewHandle.DangerousGetHandle() |> NativePtr.ofNativeInt, int length) + + let readRange () = + let startLine = reader.ReadInt32() + let startColumn = reader.ReadInt32() + let endLine = reader.ReadInt32() + let endColumn = reader.ReadInt32() + let fileIndex = reader.ReadInt32() + + let posStart = mkPos startLine startColumn + let posEnd = mkPos endLine endColumn + mkFileIndexRange fileIndex posStart posEnd + + let readKeyString () = + let size = reader.ReadInt32() + reader.ReadUTF16 size + + member _.Hold = hold + + member _.ReadSingleKeyInfo() = + checkDispose () + + struct(readRange (), readKeyString ()) + + member this.FindAll(item: Item) = + checkDispose () + + let builder = ItemKeyBuilder() + builder.Write(Range.range0, item) + match builder.TryBuildAndReset() with + | None -> Seq.empty + | Some(singleReader : ItemKeyReader) -> + let struct(_, keyString1) = singleReader.ReadSingleKeyInfo() + (singleReader :> IDisposable).Dispose() + + let results = ResizeArray() + + reader.Offset <- 0 + while reader.Offset < reader.Length do + let m = readRange() + let keyString2 = readKeyString() + if keyString1 = keyString2 then + results.Add m + + results :> range seq + + interface IDisposable with + + member _.Dispose() = + isDisposed <- true + viewAccessor.Dispose() + hold.Dispose() + +and [] ItemKeyBuilder() = + + let b = BlobBuilder() + + let writeChar (c: char) = + b.WriteUInt16(uint16 c) + + let writeUInt16 (i: uint16) = + b.WriteUInt16 i + + let writeInt32 (i: int) = + b.WriteInt32 i + + let writeInt64 (i: int64) = + b.WriteInt64 i + + let writeString (str: string) = + b.WriteUTF16 str + + let writeRange (m: Range.range) = + b.WriteInt32(m.StartLine) + b.WriteInt32(m.StartColumn) + b.WriteInt32(m.EndLine) + b.WriteInt32(m.EndColumn) + b.WriteInt32(m.FileIndex) + + let writeEntityRef (eref: EntityRef) = + writeString "#E#" + writeString eref.CompiledName + eref.CompilationPath.MangledPath + |> List.iter (fun str -> writeString str) + + let rec writeILType (ilty: ILType) = + match ilty with + | ILType.TypeVar n -> writeString "!"; writeUInt16 n + | ILType.Modified (_, _, ty2) -> writeILType ty2 + | ILType.Array (ILArrayShape s, ty) -> + writeILType ty + writeString "[" + writeInt32 (s.Length-1) + writeString "]" + | ILType.Value tr + | ILType.Boxed tr -> + tr.TypeRef.Enclosing + |> List.iter (fun x -> + writeString x + writeChar '.') + writeChar '.' + writeString tr.TypeRef.Name + | ILType.Void -> + writeString "void" + | ILType.Ptr ty -> + writeString "ptr<" + writeILType ty + writeChar '>' + | ILType.Byref ty -> + writeString "byref<" + writeILType ty + writeChar '>' + | ILType.FunctionPointer mref -> + mref.ArgTypes + |> List.iter (fun x -> + writeILType x) + writeILType mref.ReturnType + + let rec writeType (ty: TType) = + match ty with + | TType_forall (_, ty) -> + writeType ty + | TType_app (tcref, _) -> + writeEntityRef tcref + | TType_tuple (_, tinst) -> + writeString "#T#" + tinst |> List.iter writeType + | TType_anon (anonInfo, tinst) -> + writeString "#N#" + writeString anonInfo.ILTypeRef.BasicQualifiedName + tinst |> List.iter writeType + | TType_fun (d, r) -> + writeString "#F#" + writeType d + writeType r + | TType_measure ms -> + writeString "#M#" + writeMeasure ms + | TType_var tp -> + writeTypar tp + | TType_ucase (uc, _) -> + match uc with + | UnionCaseRef.UCRef(tcref, nm) -> + writeString "#U#" + writeEntityRef tcref + writeString nm + + and writeMeasure (ms: Measure) = + match ms with + | Measure.Var typar -> + writeString "#p#" + writeTypar typar + | Measure.Con tcref -> + writeString "#c#" + writeEntityRef tcref + | Measure.Prod(ms1, ms2) -> + writeString "#r#" + writeMeasure ms1 + writeMeasure ms2 + | Measure.Inv ms -> + writeString "#i#" + writeMeasure ms + | Measure.One -> + writeString "#1#" + | Measure.RationalPower _ -> + writeString "#z#" + + and writeTypar (typar: Typar) = + match typar.Solution with + | Some ty -> writeType ty + | _ -> writeInt64 typar.Stamp + + let writeValRef (vref: ValRef) = + match vref.MemberInfo with + | Some memberInfo -> + writeString "m$" + writeEntityRef memberInfo.ApparentEnclosingEntity + writeString vref.LogicalName + writeType vref.Type + | _ -> + writeString "v$" + writeString vref.LogicalName + writeType vref.Type + match vref.DeclaringEntity with + | ParentNone -> writeChar '%' + | Parent eref -> writeEntityRef eref + + member _.Write (m: Range.range, item: Item) = + writeRange m + + let fixup = b.ReserveBytes 4 |> BlobWriter + + let preCount = b.Count + + match item with + | Item.Value vref -> + match vref.MemberInfo with + | Some memberInfo -> + writeString "m$" + writeEntityRef memberInfo.ApparentEnclosingEntity + writeString vref.LogicalName + writeType vref.Type + | _ -> + writeString "v$" + writeValRef vref + + | Item.UnionCase(info, _) -> + writeString "u$" + writeEntityRef info.TyconRef + + | Item.ActivePatternResult(info, ty, _, _) -> + writeString "r$" + info.ActiveTagsWithRanges + |> List.iter (fun (nm, _) -> + writeString nm) + writeType ty + + | Item.ActivePatternCase elemRef -> + writeString "c$" + writeValRef elemRef.ActivePatternVal + elemRef.ActivePatternInfo.ActiveTagsWithRanges + |> List.iter (fun (nm, _) -> writeString nm) + + | Item.ExnCase tcref -> + writeString "e$" + writeEntityRef tcref + + | Item.RecdField info -> + writeString "d$" + writeEntityRef info.TyconRef + writeType info.FieldType + + | Item.AnonRecdField(info, tys, i, _) -> + writeString "a$" + writeString info.ILTypeRef.BasicQualifiedName + tys |> List.iter writeType + writeInt32 i + + | Item.NewDef ident -> + writeString "n$" + writeString ident.idText + + | Item.ILField info -> + writeString "l$" + writeString info.ILTypeRef.BasicQualifiedName + writeString info.FieldName + + | Item.Event info -> + writeString "t$" + writeString info.EventName + writeEntityRef info.DeclaringTyconRef + + | Item.Property(nm, infos) -> + writeString "p$" + writeString nm + infos + |> List.iter (fun info -> writeEntityRef info.DeclaringTyconRef) + + | Item.TypeVar(nm, typar) -> + writeString "y$" + writeString nm + writeTypar typar + + | Item.Types(_, [ty]) -> + writeType ty + + | Item.UnqualifiedType [tcref] -> + writeEntityRef tcref + + | Item.MethodGroup(_, [info], _) + | Item.CtorGroup(_, [info]) -> + match info with + | FSMeth(_, _, vref, _) -> + writeValRef vref + | ILMeth(_, info, _) -> + info.ILMethodRef.ArgTypes + |> List.iter writeILType + writeILType info.ILMethodRef.ReturnType + writeString info.ILName + writeType info.ApparentEnclosingType + | _ -> + writeString "m$" + writeEntityRef info.DeclaringTyconRef + writeString info.LogicalName + + | Item.ModuleOrNamespaces [x] -> + writeString "o$" + x.CompilationPath.DemangledPath + |> List.iter (fun x -> + writeString x + writeString ".") + writeString x.LogicalName + + | Item.DelegateCtor ty -> + writeString "g$" + writeType ty + + | Item.MethodGroup _ -> () + | Item.CtorGroup _ -> () + | Item.FakeInterfaceCtor _ -> () + | Item.Types _ -> () + | Item.CustomOperation _ -> () + | Item.CustomBuilder _ -> () + | Item.ModuleOrNamespaces _ -> () + | Item.ImplicitOp _ -> () + | Item.ArgName _ -> () + | Item.SetterArg _ -> () + | Item.UnqualifiedType _ -> () + + let postCount = b.Count + + fixup.WriteInt32(postCount - preCount) + + member _.TryBuildAndReset() = + if b.Count > 0 then + let length = int64 b.Count + let mmf = + let mmf = + MemoryMappedFile.CreateNew( + null, + length, + MemoryMappedFileAccess.ReadWrite, + MemoryMappedFileOptions.None, + HandleInheritability.None) + use stream = mmf.CreateViewStream(0L, length, MemoryMappedFileAccess.ReadWrite) + b.WriteContentTo stream + mmf + + b.Clear() + + let safeHolder = + { new obj() with + override x.Finalize() = + (x :?> IDisposable).Dispose() + interface IDisposable with + member x.Dispose() = + GC.SuppressFinalize x + mmf.Dispose() } + + Some(new ItemKeyReader(mmf, length, safeHolder)) + else + None \ No newline at end of file diff --git a/src/fsharp/service/ItemKey.fsi b/src/fsharp/service/ItemKey.fsi new file mode 100644 index 00000000000..e69de29bb2d diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs new file mode 100644 index 00000000000..e69de29bb2d diff --git a/src/fsharp/service/SemanticClassification.fsi b/src/fsharp/service/SemanticClassification.fsi new file mode 100644 index 00000000000..e69de29bb2d From 6fc6bda4f04c1871d8912d3205678a2cbe431c2c Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 23 Jan 2020 13:00:11 -0800 Subject: [PATCH 02/24] Raise disposed exception --- src/fsharp/service/ItemKey.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fsharp/service/ItemKey.fs b/src/fsharp/service/ItemKey.fs index 9caebe906ae..7c2042df266 100644 --- a/src/fsharp/service/ItemKey.fs +++ b/src/fsharp/service/ItemKey.fs @@ -24,7 +24,7 @@ type ItemKeyReader(mmf: MemoryMappedFile, length, hold: IDisposable) = let mutable isDisposed = false let checkDispose() = if isDisposed then - invalidOp "FSharpSymbolKeyReader already disposed" + raise (ObjectDisposedException("ItemKeyReader")) let viewAccessor = mmf.CreateViewAccessor() @@ -53,7 +53,7 @@ type ItemKeyReader(mmf: MemoryMappedFile, length, hold: IDisposable) = struct(readRange (), readKeyString ()) - member this.FindAll(item: Item) = + member _.FindAll(item: Item) = checkDispose () let builder = ItemKeyBuilder() From 8212e37a3dd3f4136a4835fb22fc27cb82ea9f96 Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 23 Jan 2020 13:22:50 -0800 Subject: [PATCH 03/24] Re-worked semantic classification. Renamed ItemKeyReader to ItemKeyStore. Exposing ItemKeyStore/Builder --- src/fsharp/service/FSharpCheckerResults.fs | 149 +------------- src/fsharp/service/FSharpCheckerResults.fsi | 20 +- src/fsharp/service/ItemKey.fs | 30 +-- src/fsharp/service/ItemKey.fsi | 22 +++ src/fsharp/service/SemanticClassification.fs | 183 ++++++++++++++++++ src/fsharp/service/SemanticClassification.fsi | 36 ++++ 6 files changed, 253 insertions(+), 187 deletions(-) diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 76585ba9d58..98ad0523129 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -109,24 +109,6 @@ type GetPreciseCompletionListFromExprTypingsResult = | Some of (ItemWithInst list * DisplayEnv * range) * TType type Names = string list - -[] -type SemanticClassificationType = - | ReferenceType - | ValueType - | UnionCase - | Function - | Property - | MutableVar - | Module - | Printf - | ComputationExpression - | IntrinsicFunction - | Enumeration - | Interface - | TypeArgument - | Operator - | Disposable /// A TypeCheckInfo represents everything we get back from the typecheck of a file. /// It acts like an in-memory database about the file. @@ -155,8 +137,6 @@ type internal TypeCheckInfo openDeclarations: OpenDeclaration[]) = let textSnapshotInfo = defaultArg textSnapshotInfo null - let (|CNR|) (cnr:CapturedNameResolution) = - (cnr.Pos, cnr.Item, cnr.ItemOccurence, cnr.DisplayEnv, cnr.NameResolutionEnv, cnr.AccessorDomain, cnr.Range) // 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. @@ -1262,133 +1242,8 @@ type internal TypeCheckInfo member __.GetFormatSpecifierLocationsAndArity() = sSymbolUses.GetFormatSpecifierLocationsAndArity() - member __.GetSemanticClassification(range: range option) : (range * SemanticClassificationType) [] = - ErrorScope.Protect Range.range0 - (fun () -> - let (|LegitTypeOccurence|_|) = function - | ItemOccurence.UseInType - | ItemOccurence.UseInAttribute - | ItemOccurence.Use _ - | ItemOccurence.Binding _ - | ItemOccurence.Pattern _ -> Some() - | _ -> None - - let (|OptionalArgumentAttribute|_|) ttype = - match ttype with - | TType.TType_app(tref, _) when tref.Stamp = g.attrib_OptionalArgumentAttribute.TyconRef.Stamp -> 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 - | TTyconEnum -> Some () - | _ -> None - | _ -> None - - let resolutions = - match range with - | Some range -> - sResolutions.CapturedNameResolutions - |> Seq.filter (fun cnr -> rangeContainsPos range cnr.Range.Start || rangeContainsPos range cnr.Range.End) - | None -> - sResolutions.CapturedNameResolutions :> seq<_> - - let isDisposableTy (ty: TType) = - protectAssemblyExplorationNoReraise false false (fun () -> Infos.ExistsHeadTypeInEntireHierarchy g amap range0 ty g.tcref_System_IDisposable) - - let isStructTyconRef (tyconRef: TyconRef) = - let ty = generalizedTyconRef 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 - || Tastops.isRefCellTy g vref.Type - || (Tastops.isByrefTy g vref.Type && not (Tastops.isInByrefTy g vref.Type)) - - let isRecdFieldMutable (rfinfo: RecdFieldInfo) = - (rfinfo.RecdField.IsMutable && rfinfo.LiteralValue.IsNone) - || Tastops.isRefCellTy g rfinfo.RecdField.FormalType - - resolutions - |> Seq.choose (fun cnr -> - match cnr with - // 'seq' in 'seq { ... }' gets colored as keywords - | CNR(_, (Item.Value vref), ItemOccurence.Use, _, _, _, m) when valRefEq g g.seq_vref vref -> - Some (m, SemanticClassificationType.ComputationExpression) - | CNR(_, (Item.Value vref), _, _, _, _, m) when isValRefMutable vref -> - Some (m, SemanticClassificationType.MutableVar) - | CNR(_, Item.Value KeywordIntrinsicValue, ItemOccurence.Use, _, _, _, m) -> - Some (m, SemanticClassificationType.IntrinsicFunction) - | CNR(_, (Item.Value vref), _, _, _, _, m) when isFunction g vref.Type -> - if valRefEq g g.range_op_vref vref || valRefEq g g.range_step_op_vref vref then - None - elif vref.IsPropertyGetterMethod || vref.IsPropertySetterMethod then - Some (m, SemanticClassificationType.Property) - elif IsOperatorName vref.DisplayName then - Some (m, SemanticClassificationType.Operator) - else - Some (m, SemanticClassificationType.Function) - | CNR(_, Item.RecdField rfinfo, _, _, _, _, m) when isRecdFieldMutable rfinfo -> - Some (m, SemanticClassificationType.MutableVar) - | CNR(_, Item.RecdField rfinfo, _, _, _, _, m) when isFunction g rfinfo.FieldType -> - Some (m, SemanticClassificationType.Function) - | CNR(_, Item.RecdField EnumCaseFieldInfo, _, _, _, _, m) -> - Some (m, SemanticClassificationType.Enumeration) - | CNR(_, Item.MethodGroup _, _, _, _, _, m) -> - Some (m, SemanticClassificationType.Function) - // custom builders, custom operations get colored as keywords - | CNR(_, (Item.CustomBuilder _ | Item.CustomOperation _), ItemOccurence.Use, _, _, _, m) -> - Some (m, SemanticClassificationType.ComputationExpression) - // types get colored as types when they occur in syntactic types or custom attributes - // type variables get colored as types when they occur in syntactic types custom builders, custom operations get colored as keywords - | CNR(_, Item.Types (_, [OptionalArgumentAttribute]), LegitTypeOccurence, _, _, _, _) -> None - | CNR(_, Item.CtorGroup(_, [MethInfo.FSMeth(_, OptionalArgumentAttribute, _, _)]), LegitTypeOccurence, _, _, _, _) -> None - | CNR(_, Item.Types(_, types), LegitTypeOccurence, _, _, _, m) when types |> List.exists (isInterfaceTy g) -> - Some (m, SemanticClassificationType.Interface) - | CNR(_, Item.Types(_, types), LegitTypeOccurence, _, _, _, m) when types |> List.exists (isStructTy g) -> - Some (m, SemanticClassificationType.ValueType) - | CNR(_, Item.Types(_, TType_app(tyconRef, TType_measure _ :: _) :: _), LegitTypeOccurence, _, _, _, m) when isStructTyconRef tyconRef -> - Some (m, SemanticClassificationType.ValueType) - | CNR(_, Item.Types(_, types), LegitTypeOccurence, _, _, _, m) when types |> List.exists isDisposableTy -> - Some (m, SemanticClassificationType.Disposable) - | CNR(_, Item.Types _, LegitTypeOccurence, _, _, _, m) -> - Some (m, SemanticClassificationType.ReferenceType) - | CNR(_, (Item.TypeVar _ ), LegitTypeOccurence, _, _, _, m) -> - Some (m, SemanticClassificationType.TypeArgument) - | CNR(_, Item.UnqualifiedType tyconRefs, LegitTypeOccurence, _, _, _, m) -> - if tyconRefs |> List.exists (fun tyconRef -> tyconRef.Deref.IsStructOrEnumTycon) then - Some (m, SemanticClassificationType.ValueType) - else Some (m, SemanticClassificationType.ReferenceType) - | CNR(_, Item.CtorGroup(_, minfos), LegitTypeOccurence, _, _, _, m) -> - if minfos |> List.exists (fun minfo -> isStructTy g minfo.ApparentEnclosingType) then - Some (m, SemanticClassificationType.ValueType) - else Some (m, SemanticClassificationType.ReferenceType) - | CNR(_, Item.ExnCase _, LegitTypeOccurence, _, _, _, m) -> - Some (m, SemanticClassificationType.ReferenceType) - | CNR(_, Item.ModuleOrNamespaces refs, LegitTypeOccurence, _, _, _, m) when refs |> List.exists (fun x -> x.IsModule) -> - Some (m, SemanticClassificationType.Module) - | CNR(_, (Item.ActivePatternCase _ | Item.UnionCase _ | Item.ActivePatternResult _), _, _, _, _, m) -> - Some (m, SemanticClassificationType.UnionCase) - | _ -> None) - |> Seq.toArray - |> Array.append (sSymbolUses.GetFormatSpecifierLocationsAndArity() |> Array.map (fun m -> fst m, SemanticClassificationType.Printf)) - ) - (fun msg -> - Trace.TraceInformation(sprintf "FCS: recovering from error in GetSemanticClassification: '%s'" msg) - Array.empty) + member __.GetSemanticClassification(range: range option) : struct (range * SemanticClassificationType) [] = + sResolutions.GetSemanticClassification(g, amap, sSymbolUses.GetFormatSpecifierLocationsAndArity(), range) /// The resolutions in the file member __.ScopeResolutions = sResolutions diff --git a/src/fsharp/service/FSharpCheckerResults.fsi b/src/fsharp/service/FSharpCheckerResults.fsi index 13496225bfb..29b3e4dd2c2 100644 --- a/src/fsharp/service/FSharpCheckerResults.fsi +++ b/src/fsharp/service/FSharpCheckerResults.fsi @@ -56,24 +56,6 @@ type public FSharpProjectContext = /// Get the accessibility rights for this project context w.r.t. InternalsVisibleTo attributes granting access to other assemblies member AccessibilityRights : FSharpAccessibilityRights -[] -type public SemanticClassificationType = - | ReferenceType - | ValueType - | UnionCase - | Function - | Property - | MutableVar - | Module - | Printf - | ComputationExpression - | IntrinsicFunction - | Enumeration - | Interface - | TypeArgument - | Operator - | Disposable - /// Options used to determine active --define conditionals and other options relevant to parsing files in a project type public FSharpParsingOptions = { @@ -234,7 +216,7 @@ type public FSharpCheckFileResults = member GetSymbolUseAtLocation : line:int * colAtEndOfNames:int * lineText:string * names:string list * ?userOpName: string -> Async /// Get any extra colorization info that is available after the typecheck - member GetSemanticClassification : range option -> (range * SemanticClassificationType)[] + member GetSemanticClassification : range option -> struct (range * SemanticClassificationType)[] /// Get the locations of format specifiers [] diff --git a/src/fsharp/service/ItemKey.fs b/src/fsharp/service/ItemKey.fs index 7c2042df266..c7f6514d350 100644 --- a/src/fsharp/service/ItemKey.fs +++ b/src/fsharp/service/ItemKey.fs @@ -3,11 +3,9 @@ namespace FSharp.Compiler.SourceCodeServices open System -open System.Text open System.IO open System.IO.MemoryMappedFiles open System.Reflection.Metadata -open System.Collections.Immutable open FSharp.NativeInterop open FSharp.Compiler open FSharp.Compiler.Range @@ -19,7 +17,7 @@ open FSharp.Compiler.AbstractIL.IL #nowarn "9" [] -type ItemKeyReader(mmf: MemoryMappedFile, length, hold: IDisposable) = +type ItemKeyStore(mmf: MemoryMappedFile, length) = let mutable isDisposed = false let checkDispose() = @@ -46,8 +44,6 @@ type ItemKeyReader(mmf: MemoryMappedFile, length, hold: IDisposable) = let size = reader.ReadInt32() reader.ReadUTF16 size - member _.Hold = hold - member _.ReadSingleKeyInfo() = checkDispose () @@ -56,13 +52,13 @@ type ItemKeyReader(mmf: MemoryMappedFile, length, hold: IDisposable) = member _.FindAll(item: Item) = checkDispose () - let builder = ItemKeyBuilder() + let builder = ItemKeyStoreBuilder() builder.Write(Range.range0, item) match builder.TryBuildAndReset() with | None -> Seq.empty - | Some(singleReader : ItemKeyReader) -> - let struct(_, keyString1) = singleReader.ReadSingleKeyInfo() - (singleReader :> IDisposable).Dispose() + | Some(singleStore : ItemKeyStore) -> + let struct(_, keyString1) = singleStore.ReadSingleKeyInfo() + (singleStore :> IDisposable).Dispose() let results = ResizeArray() @@ -80,9 +76,9 @@ type ItemKeyReader(mmf: MemoryMappedFile, length, hold: IDisposable) = member _.Dispose() = isDisposed <- true viewAccessor.Dispose() - hold.Dispose() + mmf.Dispose() -and [] ItemKeyBuilder() = +and [] ItemKeyStoreBuilder() = let b = BlobBuilder() @@ -359,15 +355,7 @@ and [] ItemKeyBuilder() = b.Clear() - let safeHolder = - { new obj() with - override x.Finalize() = - (x :?> IDisposable).Dispose() - interface IDisposable with - member x.Dispose() = - GC.SuppressFinalize x - mmf.Dispose() } - - Some(new ItemKeyReader(mmf, length, safeHolder)) + Some(new ItemKeyStore(mmf, length)) else + b.Clear() None \ No newline at end of file diff --git a/src/fsharp/service/ItemKey.fsi b/src/fsharp/service/ItemKey.fsi index e69de29bb2d..a33507f7450 100644 --- a/src/fsharp/service/ItemKey.fsi +++ b/src/fsharp/service/ItemKey.fsi @@ -0,0 +1,22 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.SourceCodeServices + +open System +open FSharp.Compiler.Range +open FSharp.Compiler.NameResolution + +[] +type internal ItemKeyStore = + interface IDisposable + + member FindAll: Item -> range seq + +[] +type internal ItemKeyStoreBuilder = + + new: unit -> ItemKeyStoreBuilder + + member Write: range * Item -> unit + + member TryBuildAndReset: unit -> ItemKeyStore option \ No newline at end of file diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index e69de29bb2d..fc42f98ce99 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -0,0 +1,183 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.SourceCodeServices + +[] +type SemanticClassificationType = + | ReferenceType + | ValueType + | UnionCase + | Function + | Property + | MutableVar + | Module + | Printf + | ComputationExpression + | IntrinsicFunction + | Enumeration + | Interface + | TypeArgument + | Operator + | Disposable + +[] +module TcResolutionsExtensions = + open System.Diagnostics + open System.Collections.Generic + open System.Collections.Immutable + + open FSharp.Core.Printf + open FSharp.Compiler.AbstractIL.Internal.Library + + open FSharp.Compiler + open FSharp.Compiler.Range + open FSharp.Compiler.Tast + open FSharp.Compiler.Infos + open FSharp.Compiler.NameResolution + open FSharp.Compiler.ErrorLogger + open FSharp.Compiler.Lib + open FSharp.Compiler.PrettyNaming + open FSharp.Compiler.Tastops + open FSharp.Compiler.TcGlobals + open FSharp.Compiler.SourceCodeServices.SymbolHelpers + + let (|CNR|) (cnr:CapturedNameResolution) = + (cnr.Pos, cnr.Item, cnr.ItemOccurence, cnr.DisplayEnv, cnr.NameResolutionEnv, cnr.AccessorDomain, cnr.Range) + + type TcResolutions with + + member sResolutions.GetSemanticClassification(g: TcGlobals, amap: Import.ImportMap, formatSpecifierLocations: (range * int) [], range: range option) : struct(range * SemanticClassificationType) [] = + ErrorScope.Protect Range.range0 + (fun () -> + let (|LegitTypeOccurence|_|) = function + | ItemOccurence.UseInType + | ItemOccurence.UseInAttribute + | ItemOccurence.Use _ + | ItemOccurence.Binding _ + | ItemOccurence.Pattern _ -> Some() + | _ -> None + + let (|OptionalArgumentAttribute|_|) ttype = + match ttype with + | TType.TType_app(tref, _) when tref.Stamp = g.attrib_OptionalArgumentAttribute.TyconRef.Stamp -> 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 + | TTyconEnum -> Some () + | _ -> None + | _ -> None + + let resolutions = + match range with + | Some range -> + sResolutions.CapturedNameResolutions + |> Seq.filter (fun cnr -> rangeContainsPos range cnr.Range.Start || rangeContainsPos range cnr.Range.End) + | None -> + sResolutions.CapturedNameResolutions :> seq<_> + + let isDisposableTy (ty: TType) = + protectAssemblyExplorationNoReraise false false (fun () -> Infos.ExistsHeadTypeInEntireHierarchy g amap range0 ty g.tcref_System_IDisposable) + + let isStructTyconRef (tyconRef: TyconRef) = + let ty = generalizedTyconRef 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 + || Tastops.isRefCellTy g vref.Type + || (Tastops.isByrefTy g vref.Type && not (Tastops.isInByrefTy g vref.Type)) + + let isRecdFieldMutable (rfinfo: RecdFieldInfo) = + (rfinfo.RecdField.IsMutable && rfinfo.LiteralValue.IsNone) + || Tastops.isRefCellTy g rfinfo.RecdField.FormalType + + let duplicates = HashSet({ new IEqualityComparer with + member _.Equals(x1, x2) = Range.equals x1 x2 + member _.GetHashCode o = o.GetHashCode() }) + + let results = ImmutableArray.CreateBuilder() + let inline add m typ = + if duplicates.Add m then + results.Add struct(m, typ) + resolutions + |> Seq.iter (fun cnr -> + match cnr.Pos, cnr.Item, cnr.ItemOccurence, cnr.DisplayEnv, cnr.NameResolutionEnv, cnr.AccessorDomain, cnr.Range with + // 'seq' in 'seq { ... }' gets colored as keywords + | _, (Item.Value vref), ItemOccurence.Use, _, _, _, m when valRefEq g g.seq_vref vref -> + 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 isFunction g vref.Type -> + if valRefEq g g.range_op_vref vref || valRefEq g g.range_step_op_vref vref then + () + elif vref.IsPropertyGetterMethod || vref.IsPropertySetterMethod then + add m SemanticClassificationType.Property + elif IsOperatorName vref.DisplayName then + add m SemanticClassificationType.Operator + else + add m SemanticClassificationType.Function + | _, Item.RecdField rfinfo, _, _, _, _, m when isRecdFieldMutable rfinfo -> + add m SemanticClassificationType.MutableVar + | _, Item.RecdField rfinfo, _, _, _, _, m when isFunction g rfinfo.FieldType -> + add m SemanticClassificationType.Function + | _, Item.RecdField EnumCaseFieldInfo, _, _, _, _, m -> + add m SemanticClassificationType.Enumeration + | _, Item.MethodGroup _, _, _, _, _, m -> + add m SemanticClassificationType.Function + // custom builders, custom operations get colored as keywords + | _, (Item.CustomBuilder _ | Item.CustomOperation _), ItemOccurence.Use, _, _, _, m -> + add m SemanticClassificationType.ComputationExpression + // types get colored as types when they occur in syntactic types or custom attributes + // type variables get colored as types when they occur in syntactic types custom builders, custom operations get colored as keywords + | _, Item.Types (_, [OptionalArgumentAttribute]), LegitTypeOccurence, _, _, _, _ -> () + | _, Item.CtorGroup(_, [MethInfo.FSMeth(_, OptionalArgumentAttribute, _, _)]), LegitTypeOccurence, _, _, _, _ -> () + | _, Item.Types(_, types), LegitTypeOccurence, _, _, _, m when types |> List.exists (isInterfaceTy g) -> + add m SemanticClassificationType.Interface + | _, Item.Types(_, types), LegitTypeOccurence, _, _, _, m when types |> List.exists (isStructTy g) -> + add m SemanticClassificationType.ValueType + | _, Item.Types(_, TType_app(tyconRef, TType_measure _ :: _) :: _), LegitTypeOccurence, _, _, _, m when isStructTyconRef tyconRef -> + add m SemanticClassificationType.ValueType + | _, Item.Types(_, types), LegitTypeOccurence, _, _, _, m when types |> List.exists isDisposableTy -> + add m SemanticClassificationType.Disposable + | _, Item.Types _, LegitTypeOccurence, _, _, _, m -> + add m SemanticClassificationType.ReferenceType + | _, (Item.TypeVar _ ), LegitTypeOccurence, _, _, _, m -> + add m SemanticClassificationType.TypeArgument + | _, Item.UnqualifiedType tyconRefs, LegitTypeOccurence, _, _, _, m -> + if tyconRefs |> List.exists (fun tyconRef -> tyconRef.Deref.IsStructOrEnumTycon) then + add m SemanticClassificationType.ValueType + else add m SemanticClassificationType.ReferenceType + | _, Item.CtorGroup(_, minfos), LegitTypeOccurence, _, _, _, m -> + if minfos |> List.exists (fun minfo -> isStructTy g minfo.ApparentEnclosingType) then + add m SemanticClassificationType.ValueType + else add m SemanticClassificationType.ReferenceType + | _, Item.ExnCase _, LegitTypeOccurence, _, _, _, m -> + add m SemanticClassificationType.ReferenceType + | _, Item.ModuleOrNamespaces refs, LegitTypeOccurence, _, _, _, m when refs |> List.exists (fun x -> x.IsModule) -> + add m SemanticClassificationType.Module + | _, (Item.ActivePatternCase _ | Item.UnionCase _ | Item.ActivePatternResult _), _, _, _, _, m -> + add m SemanticClassificationType.UnionCase + | _ -> ()) + results.AddRange(formatSpecifierLocations |> Array.map (fun (m, _) -> struct(m, SemanticClassificationType.Printf))) + results.ToArray() + ) + (fun msg -> + Trace.TraceInformation(sprintf "FCS: recovering from error in GetSemanticClassification: '%s'" msg) + Array.empty) \ No newline at end of file diff --git a/src/fsharp/service/SemanticClassification.fsi b/src/fsharp/service/SemanticClassification.fsi index e69de29bb2d..8bae68aabb5 100644 --- a/src/fsharp/service/SemanticClassification.fsi +++ b/src/fsharp/service/SemanticClassification.fsi @@ -0,0 +1,36 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.SourceCodeServices + +[] +type SemanticClassificationType = + | ReferenceType + | ValueType + | UnionCase + | Function + | Property + | MutableVar + | Module + | Printf + | ComputationExpression + | IntrinsicFunction + | Enumeration + | Interface + | TypeArgument + | Operator + | Disposable + +[] +module internal TcResolutionsExtensions = + open FSharp.Compiler + open FSharp.Compiler.AccessibilityLogic + open FSharp.Compiler.Tastops + open FSharp.Compiler.Range + open FSharp.Compiler.NameResolution + open FSharp.Compiler.TcGlobals + + val (|CNR|) : cnr: CapturedNameResolution -> (pos * Item * ItemOccurence * DisplayEnv * NameResolutionEnv * AccessorDomain * range) + + type TcResolutions with + + member GetSemanticClassification: g: TcGlobals * amap: Import.ImportMap * formatSpecifierLocations: (range * int) [] * range: range option -> struct(range * SemanticClassificationType) [] \ No newline at end of file From 9e6d8f500dde2339528855aa99ea77a5161a4ca2 Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 23 Jan 2020 14:14:26 -0800 Subject: [PATCH 04/24] Fixing build --- .../FSharp.Compiler.Service.fsproj | 12 +++++ .../FSharp.Compiler.Private.fsproj | 12 ++--- src/fsharp/service/IncrementalBuild.fs | 51 +++++++++++++++---- src/fsharp/service/IncrementalBuild.fsi | 10 +++- src/fsharp/service/service.fs | 47 ++++++++++++++--- src/fsharp/service/service.fsi | 23 ++++++++- .../Classification/ClassificationService.fs | 3 +- .../src/FSharp.LanguageService/Colorize.fs | 6 +-- .../SemanticColorizationServiceTests.fs | 6 +-- 9 files changed, 138 insertions(+), 32 deletions(-) diff --git a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index 4ba9a9b2c32..5a93fe35899 100644 --- a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -573,6 +573,18 @@ Service/Reactor.fs + + Service/SemanticClassification.fsi + + + Service/SemanticClassification.fs + + + Service/ItemKey.fsi + + + Service/ItemKey.fs + Service/IncrementalBuild.fsi diff --git a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj index d9d27fbdefa..c21ec74332e 100644 --- a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj +++ b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj @@ -579,18 +579,18 @@ - - Service/ItemKey.fsi - - - Service/ItemKey.fs - Service/SemanticClassification.fsi Service/SemanticClassification.fs + + Service/ItemKey.fsi + + + Service/ItemKey.fs + Service/IncrementalBuild.fsi diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 5e36f94b558..c4f7572b8bb 100755 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -1047,7 +1047,13 @@ type TypeCheckAccumulator = tcModuleNamesDict: ModuleNamesDict /// Accumulated errors, last file first - tcErrorsRev:(PhasedDiagnostic * FSharpErrorSeverity)[] list } + tcErrorsRev:(PhasedDiagnostic * FSharpErrorSeverity)[] list + + /// If enabled, stores a linear list of ranges and strings that identify an Item(symbol) in a file. Used for background find all references. + itemKeyStore: ItemKeyStore option + + /// If enabled, holds semantic classification information for Item(symbol)s in a file. + semanticClassification: struct (range * SemanticClassificationType) [] } /// Global service state @@ -1140,7 +1146,11 @@ type PartialCheckResults = LatestImplementationFile: TypedImplFile option - LatestCcuSigForFile: ModuleOrNamespaceType option } + LatestCcuSigForFile: ModuleOrNamespaceType option + + ItemKeyStore: ItemKeyStore option + + SemanticClassification: struct (range * SemanticClassificationType) [] } member x.TcErrors = Array.concat (List.rev x.TcErrorsRev) member x.TcSymbolUses = List.rev x.TcSymbolUsesRev @@ -1160,7 +1170,9 @@ type PartialCheckResults = ModuleNamesDict = tcAcc.tcModuleNamesDict TimeStamp = timestamp LatestImplementationFile = tcAcc.latestImplFile - LatestCcuSigForFile = tcAcc.latestCcuSigForFile } + LatestCcuSigForFile = tcAcc.latestCcuSigForFile + ItemKeyStore = None + SemanticClassification = [||] } [] @@ -1208,7 +1220,7 @@ type RawFSharpAssemblyDataBackedByLanguageService (tcConfig, tcGlobals, tcState: type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInputs, nonFrameworkResolutions, unresolvedReferences, tcConfig: TcConfig, projectDirectory, outfile, assemblyName, niceNameGen: NiceNameGenerator, lexResourceManager, sourceFiles, loadClosureOpt: LoadClosure option, - keepAssemblyContents, keepAllBackgroundResolutions, maxTimeShareMilliseconds, keepAllBackgroundSymbolUses) = + keepAssemblyContents, keepAllBackgroundResolutions, maxTimeShareMilliseconds, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification) = let tcConfigP = TcConfigProvider.Constant tcConfig let fileParsed = new Event() @@ -1351,7 +1363,9 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput latestCcuSigForFile=None tcDependencyFiles=basicDependencies tcErrorsRev = [ initialErrors ] - tcModuleNamesDict = Map.empty } + tcModuleNamesDict = Map.empty + itemKeyStore = None + semanticClassification = [||] } return tcAcc } /// This is a build task function that gets placed into the build rules as the computation for a Vector.ScanLeft @@ -1386,7 +1400,24 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput let implFile = if keepAssemblyContents then implFile else None let tcResolutions = if keepAllBackgroundResolutions then sink.GetResolutions() else TcResolutions.Empty let tcEnvAtEndOfFile = (if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls) - let tcSymbolUses = if keepAllBackgroundSymbolUses then sink.GetSymbolUses() else TcSymbolUses.Empty + let tcSymbolUses = if keepAllBackgroundSymbolUses then sink.GetSymbolUses() else TcSymbolUses.Empty + + // Build symbol keys + let itemKeyStore = + if enableBackgroundItemKeyStoreAndSemanticClassification then + let builder = ItemKeyStoreBuilder() + let preventDuplicates = HashSet({ new IEqualityComparer with + member _.Equals((s1, e1): struct(pos * pos), (s2, e2): struct(pos * pos)) = Range.posEq s1 s2 && Range.posEq e1 e2 + member _.GetHashCode o = o.GetHashCode() }) + sink.GetResolutions().CapturedNameResolutions + |> Seq.iter (fun cnr -> + let r = cnr.Range + if preventDuplicates.Add struct(r.Start, r.End) then + builder.Write(cnr.Range, cnr.Item)) + + builder.TryBuildAndReset() + else + None RequireCompilationThread ctok // Note: events get raised on the CompilationThread @@ -1402,7 +1433,8 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput tcOpenDeclarationsRev = sink.GetOpenDeclarations() :: tcAcc.tcOpenDeclarationsRev tcErrorsRev = newErrors :: tcAcc.tcErrorsRev tcModuleNamesDict = moduleNamesDict - tcDependencyFiles = filename :: tcAcc.tcDependencyFiles } + tcDependencyFiles = filename :: tcAcc.tcDependencyFiles + itemKeyStore = itemKeyStore } } // Run part of the Eventually<_> computation until a timeout is reached. If not complete, @@ -1700,7 +1732,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput projectReferences, projectDirectory, useScriptResolutionRules, keepAssemblyContents, keepAllBackgroundResolutions, maxTimeShareMilliseconds, - tryGetMetadataSnapshot, suggestNamesForErrors, keepAllBackgroundSymbolUses) = + tryGetMetadataSnapshot, suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification) = let useSimpleResolutionSwitch = "--simpleresolution" cancellable { @@ -1821,7 +1853,8 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput keepAssemblyContents=keepAssemblyContents, keepAllBackgroundResolutions=keepAllBackgroundResolutions, maxTimeShareMilliseconds=maxTimeShareMilliseconds, - keepAllBackgroundSymbolUses=keepAllBackgroundSymbolUses) + keepAllBackgroundSymbolUses=keepAllBackgroundSymbolUses, + enableBackgroundItemKeyStoreAndSemanticClassification=enableBackgroundItemKeyStoreAndSemanticClassification) return Some builder with e -> errorRecoveryNoRange e diff --git a/src/fsharp/service/IncrementalBuild.fsi b/src/fsharp/service/IncrementalBuild.fsi index d775c92fcce..33f51ba4776 100755 --- a/src/fsharp/service/IncrementalBuild.fsi +++ b/src/fsharp/service/IncrementalBuild.fsi @@ -70,7 +70,13 @@ type internal PartialCheckResults = LatestImplementationFile: TypedImplFile option /// Represents latest inferred signature contents. - LatestCcuSigForFile: ModuleOrNamespaceType option} + LatestCcuSigForFile: ModuleOrNamespaceType option + + /// If enabled, stores a linear list of ranges and strings that identify an Item(symbol) in a file. Used for background find all references. + ItemKeyStore: ItemKeyStore option + + /// If enabled, holds semantic classification information for Item(symbol)s in a file. + SemanticClassification: struct (range * SemanticClassificationType) [] } member TcErrors: (PhasedDiagnostic * FSharpErrorSeverity)[] @@ -161,7 +167,7 @@ type internal IncrementalBuilder = /// This may be a marginally long-running operation (parses are relatively quick, only one file needs to be parsed) member GetParseResultsForFile : CompilationThreadToken * filename:string -> Cancellable - static member TryCreateBackgroundBuilderForProjectOptions : CompilationThreadToken * ReferenceResolver.Resolver * defaultFSharpBinariesDir: string * FrameworkImportsCache * scriptClosureOptions:LoadClosure option * sourceFiles:string list * commandLineArgs:string list * projectReferences: IProjectReference list * projectDirectory:string * useScriptResolutionRules:bool * keepAssemblyContents: bool * keepAllBackgroundResolutions: bool * maxTimeShareMilliseconds: int64 * tryGetMetadataSnapshot: ILBinaryReader.ILReaderTryGetMetadataSnapshot * suggestNamesForErrors: bool * keepAllBackgroundSymbolUses: bool -> Cancellable + static member TryCreateBackgroundBuilderForProjectOptions : CompilationThreadToken * ReferenceResolver.Resolver * defaultFSharpBinariesDir: string * FrameworkImportsCache * scriptClosureOptions:LoadClosure option * sourceFiles:string list * commandLineArgs:string list * projectReferences: IProjectReference list * projectDirectory:string * useScriptResolutionRules:bool * keepAssemblyContents: bool * keepAllBackgroundResolutions: bool * maxTimeShareMilliseconds: int64 * tryGetMetadataSnapshot: ILBinaryReader.ILReaderTryGetMetadataSnapshot * suggestNamesForErrors: bool * keepAllBackgroundSymbolUses: bool * enableBackgroundItemKeyStoreAndSemanticClassification: bool -> Cancellable /// Generalized Incremental Builder. This is exposed only for unit testing purposes. module internal IncrementalBuild = diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index 978d6cd087f..29acdb6e910 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -249,7 +249,7 @@ type ScriptClosureCacheToken() = interface LockToken // There is only one instance of this type, held in FSharpChecker -type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyContents, keepAllBackgroundResolutions, tryGetMetadataSnapshot, suggestNamesForErrors, keepAllBackgroundSymbolUses) as self = +type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyContents, keepAllBackgroundResolutions, tryGetMetadataSnapshot, suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification) as self = // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.backgroundCompiler.reactor: The one and only Reactor let reactor = Reactor.Singleton let beforeFileChecked = Event() @@ -306,7 +306,7 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC (ctok, legacyReferenceResolver, FSharpCheckerResultsSettings.defaultFSharpBinariesDir, frameworkTcImportsCache, loadClosure, Array.toList options.SourceFiles, Array.toList options.OtherOptions, projectReferences, options.ProjectDirectory, options.UseScriptResolutionRules, keepAssemblyContents, keepAllBackgroundResolutions, FSharpCheckerResultsSettings.maxTimeShareMilliseconds, - tryGetMetadataSnapshot, suggestNamesForErrors, keepAllBackgroundSymbolUses) + tryGetMetadataSnapshot, suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification) match builderOpt with | None -> () @@ -699,6 +699,29 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC return (parseResults, typedResults) }) + member __.FindReferencesInFile(filename: string, options: FSharpProjectOptions, symbol: FSharpSymbol, userOpName: string) = + reactor.EnqueueAndAwaitOpAsync(userOpName, "FindReferencesInFile", filename, fun ctok -> + cancellable { + let! builderOpt, _ = getOrCreateBuilder (ctok, options, userOpName) + match builderOpt with + | None -> return Seq.empty + | Some builder -> + let! checkResults = builder.GetCheckResultsAfterFileInProject (ctok, filename) + return + match checkResults.ItemKeyStore with + | None -> Seq.empty + | Some reader -> reader.FindAll symbol.Item }) + + member __.GetSemanticClassificationForFile(filename: string, options: FSharpProjectOptions, userOpName: string) = + reactor.EnqueueAndAwaitOpAsync(userOpName, "GetSemanticClassificationForFile", filename, fun ctok -> + cancellable { + let! builderOpt, _ = getOrCreateBuilder (ctok, options, userOpName) + match builderOpt with + | None -> return [||] + | Some builder -> + let! checkResults = builder.GetCheckResultsAfterFileInProject (ctok, filename) + return checkResults.SemanticClassification }) + /// Try to get recent approximate type check results for a file. member __.TryGetRecentCheckResultsForFile(filename: string, options:FSharpProjectOptions, sourceText: ISourceText option, _userOpName: string) = @@ -906,9 +929,10 @@ type FSharpChecker(legacyReferenceResolver, keepAllBackgroundResolutions, tryGetMetadataSnapshot, suggestNamesForErrors, - keepAllBackgroundSymbolUses) = + keepAllBackgroundSymbolUses, + enableBackgroundItemKeyStoreAndSemanticClassification) = - let backgroundCompiler = BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyContents, keepAllBackgroundResolutions, tryGetMetadataSnapshot, suggestNamesForErrors, keepAllBackgroundSymbolUses) + let backgroundCompiler = BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyContents, keepAllBackgroundResolutions, tryGetMetadataSnapshot, suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification) static let globalInstance = lazy FSharpChecker.Create() @@ -925,7 +949,7 @@ type FSharpChecker(legacyReferenceResolver, let maxMemEvent = new Event() /// Instantiate an interactive checker. - static member Create(?projectCacheSize, ?keepAssemblyContents, ?keepAllBackgroundResolutions, ?legacyReferenceResolver, ?tryGetMetadataSnapshot, ?suggestNamesForErrors, ?keepAllBackgroundSymbolUses) = + static member Create(?projectCacheSize, ?keepAssemblyContents, ?keepAllBackgroundResolutions, ?legacyReferenceResolver, ?tryGetMetadataSnapshot, ?suggestNamesForErrors, ?keepAllBackgroundSymbolUses, ?enableBackgroundItemKeyStoreAndSemanticClassification) = let legacyReferenceResolver = match legacyReferenceResolver with @@ -938,7 +962,8 @@ type FSharpChecker(legacyReferenceResolver, let tryGetMetadataSnapshot = defaultArg tryGetMetadataSnapshot (fun _ -> None) let suggestNamesForErrors = defaultArg suggestNamesForErrors false let keepAllBackgroundSymbolUses = defaultArg keepAllBackgroundSymbolUses true - new FSharpChecker(legacyReferenceResolver, projectCacheSizeReal,keepAssemblyContents, keepAllBackgroundResolutions, tryGetMetadataSnapshot, suggestNamesForErrors, keepAllBackgroundSymbolUses) + let enableBackgroundItemKeyStoreAndSemanticClassification = defaultArg enableBackgroundItemKeyStoreAndSemanticClassification false + new FSharpChecker(legacyReferenceResolver, projectCacheSizeReal,keepAssemblyContents, keepAllBackgroundResolutions, tryGetMetadataSnapshot, suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification) member __.ReferenceResolver = legacyReferenceResolver @@ -1141,6 +1166,16 @@ type FSharpChecker(legacyReferenceResolver, ic.CheckMaxMemoryReached() backgroundCompiler.ParseAndCheckProject(options, userOpName) + member ic.FindBackgroundReferencesInFile(filename:string, options: FSharpProjectOptions, symbol: FSharpSymbol, ?userOpName: string) = + let userOpName = defaultArg userOpName "Unknown" + ic.CheckMaxMemoryReached() + backgroundCompiler.FindReferencesInFile(filename, options, symbol, userOpName) + + member ic.GetBackgroundSemanticClassificationForFile(filename:string, options: FSharpProjectOptions, ?userOpName) = + let userOpName = defaultArg userOpName "Unknown" + ic.CheckMaxMemoryReached() + backgroundCompiler.GetSemanticClassificationForFile(filename, options, userOpName) + /// For a given script file, get the ProjectOptions implied by the #load closure member __.GetProjectOptionsFromScript(filename, source, ?loadedTimeStamp, ?otherFlags, ?useFsiAuxLib, ?useSdkRefs, ?assumeDotNetFramework, ?extraProjectInfo: obj, ?optionsStamp: int64, ?userOpName: string) = let userOpName = defaultArg userOpName "Unknown" diff --git a/src/fsharp/service/service.fsi b/src/fsharp/service/service.fsi index c463f2a2eef..ea43cf7292a 100755 --- a/src/fsharp/service/service.fsi +++ b/src/fsharp/service/service.fsi @@ -77,7 +77,7 @@ type public FSharpChecker = /// If false, do not keep full intermediate checking results from background checking suitable for returning from GetBackgroundCheckResultsForFileInProject. This reduces memory usage. /// An optional resolver for non-file references, for legacy purposes /// An optional resolver to access the contents of .NET binaries in a memory-efficient way - static member Create : ?projectCacheSize: int * ?keepAssemblyContents: bool * ?keepAllBackgroundResolutions: bool * ?legacyReferenceResolver: ReferenceResolver.Resolver * ?tryGetMetadataSnapshot: ILReaderTryGetMetadataSnapshot * ?suggestNamesForErrors: bool * ?keepAllBackgroundSymbolUses: bool -> FSharpChecker + static member Create : ?projectCacheSize: int * ?keepAssemblyContents: bool * ?keepAllBackgroundResolutions: bool * ?legacyReferenceResolver: ReferenceResolver.Resolver * ?tryGetMetadataSnapshot: ILReaderTryGetMetadataSnapshot * ?suggestNamesForErrors: bool * ?keepAllBackgroundSymbolUses: bool * ?enableBackgroundItemKeyStoreAndSemanticClassification: bool -> FSharpChecker /// /// Parse a source code file, returning information about brace matching in the file. @@ -283,6 +283,27 @@ type public FSharpChecker = /// An optional string used for tracing compiler operations associated with this request. member GetBackgroundCheckResultsForFileInProject : filename : string * options : FSharpProjectOptions * ?userOpName: string -> Async + /// + /// Optimized find references for a given symbol in a file of project. + /// All files are read from the FileSystem API, including the file being checked. + /// + /// + /// The filename for the file. + /// The options for the project or script, used to determine active --define conditionals and other options relevant to parsing. + /// The symbol to find all uses in the file. + /// An optional string used for tracing compiler operations associated with this request. + member FindBackgroundReferencesInFile : filename : string * options : FSharpProjectOptions * symbol: FSharpSymbol * ?userOpName: string -> Async + + /// + /// Get semantic classification for a file. + /// All files are read from the FileSystem API, including the file being checked. + /// + /// + /// The filename for the file. + /// The options for the project or script, used to determine active --define conditionals and other options relevant to parsing. + /// An optional string used for tracing compiler operations associated with this request. + member GetBackgroundSemanticClassificationForFile : filename : string * options : FSharpProjectOptions * ?userOpName: string -> Async + /// /// Compile using the given flags. Source files names are resolved via the FileSystem API. /// The output file must be given by a -o flag. diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs index d950a0abbf5..34d94d1d34c 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs @@ -51,9 +51,8 @@ type internal FSharpClassificationService let! _, _, projectOptions = projectInfoManager.TryGetOptionsForDocumentOrProject(document, cancellationToken) let! sourceText = document.GetTextAsync(cancellationToken) let! _, _, checkResults = checkerProvider.Checker.ParseAndCheckDocument(document, projectOptions, sourceText = sourceText, allowStaleResults = false, userOpName=userOpName) - // it's crucial to not return duplicated or overlapping `ClassifiedSpan`s because Find Usages service crashes. let targetRange = RoslynHelpers.TextSpanToFSharpRange(document.FilePath, textSpan, sourceText) - let classificationData = checkResults.GetSemanticClassification (Some targetRange) |> Array.distinctBy fst + let classificationData = checkResults.GetSemanticClassification (Some targetRange) for (range, classificationType) in classificationData do match RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, range) with diff --git a/vsintegration/src/FSharp.LanguageService/Colorize.fs b/vsintegration/src/FSharp.LanguageService/Colorize.fs index 65fe7bbd5a4..235e52b98cc 100644 --- a/vsintegration/src/FSharp.LanguageService/Colorize.fs +++ b/vsintegration/src/FSharp.LanguageService/Colorize.fs @@ -87,7 +87,7 @@ module internal ColorStateLookup_DEPRECATED = type internal FSharpScanner_DEPRECATED(makeLineTokenizer : string -> FSharpLineTokenizer) = let mutable lineTokenizer = makeLineTokenizer "" - let mutable extraColorizations : IDictionary option = None + let mutable extraColorizations : IDictionary option = None /// Decode compiler FSharpTokenColorKind into VS TokenColor. let lookupTokenColor colorKind = @@ -148,11 +148,11 @@ type internal FSharpScanner_DEPRECATED(makeLineTokenizer : string -> FSharpLineT lineTokenizer <- makeLineTokenizer lineText /// Adjust the set of extra colorizations and return a sorted list of affected lines. - member __.SetExtraColorizations (tokens: (Range.range * SemanticClassificationType)[]) = + member __.SetExtraColorizations (tokens: struct (Range.range * SemanticClassificationType)[]) = if tokens.Length = 0 && extraColorizations.IsNone then [| |] else - let newExtraColorizationsKeyed = dict (tokens |> Array.groupBy (fun (r, _) -> Range.Line.toZ r.StartLine)) + let newExtraColorizationsKeyed = dict (tokens |> Array.groupBy (fun struct (r, _) -> Range.Line.toZ r.StartLine)) let oldExtraColorizationsKeyedOpt = extraColorizations extraColorizations <- Some newExtraColorizationsKeyed let changedLines = diff --git a/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs b/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs index f2674593574..46c2f265680 100644 --- a/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs +++ b/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs @@ -30,7 +30,7 @@ type SemanticClassificationServiceTests() = let checker = FSharpChecker.Create() let perfOptions = { LanguageServicePerformanceOptions.Default with AllowStaleCompletionResults = false } - let getRanges (source: string) : (Range.range * SemanticClassificationType) list = + let getRanges (source: string) : struct (Range.range * SemanticClassificationType) list = asyncMaybe { let! _, _, checkFileResults = checker.ParseAndCheckDocument(filePath, 0, SourceText.From(source), projectOptions, perfOptions, "") @@ -45,7 +45,7 @@ type SemanticClassificationServiceTests() = let ranges = getRanges fileContents let line = text.Lines.GetLinePosition (fileContents.IndexOf(marker) + marker.Length - 1) let markerPos = Range.mkPos (Range.Line.fromZ line.Line) (line.Character + marker.Length - 1) - match ranges |> List.tryFind (fun (range, _) -> Range.rangeContainsPos range markerPos) with + match ranges |> List.tryFind (fun struct (range, _) -> Range.rangeContainsPos range markerPos) with | None -> Assert.Fail("Cannot find colorization data for end of marker") | Some(_, ty) -> Assert.AreEqual(classificationType, FSharpClassificationTypes.getClassificationTypeName ty, "Classification data doesn't match for end of marker") @@ -54,7 +54,7 @@ type SemanticClassificationServiceTests() = let ranges = getRanges fileContents let line = text.Lines.GetLinePosition (fileContents.IndexOf(marker) + marker.Length - 1) let markerPos = Range.mkPos (Range.Line.fromZ line.Line) (line.Character + marker.Length - 1) - let anyData = ranges |> List.exists (fun (range, sct) -> Range.rangeContainsPos range markerPos && ((FSharpClassificationTypes.getClassificationTypeName sct) = classificationType)) + let anyData = ranges |> List.exists (fun struct (range, sct) -> Range.rangeContainsPos range markerPos && ((FSharpClassificationTypes.getClassificationTypeName sct) = classificationType)) Assert.False(anyData, "Classification data was found when it wasn't expected.") [] From d619e66ab3d74c9028c736a946a67b9bc1c57b39 Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 23 Jan 2020 15:46:16 -0800 Subject: [PATCH 05/24] Storing semantic classification --- src/fsharp/NameResolution.fs | 3 +++ src/fsharp/NameResolution.fsi | 3 +++ src/fsharp/service/IncrementalBuild.fs | 12 +++++++----- 3 files changed, 13 insertions(+), 5 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index a63c8e6e138..25452e477dc 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1757,6 +1757,9 @@ type TcResultsSinkImpl(g, ?sourceText: ISourceText) = member this.GetOpenDeclarations() = capturedOpenDeclarations |> Seq.distinctBy (fun x -> x.Range, x.AppliedScope, x.IsOwnNamespace) |> Seq.toArray + member this.GetFormatSpecifierLocations() = + capturedFormatSpecifierLocations.ToArray() + interface ITypecheckResultsSink with member sink.NotifyEnvWithScope(m, nenv, ad) = if allowedRange m then diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index c0121ce153e..05c6cc9c36e 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -438,6 +438,9 @@ type internal TcResultsSinkImpl = /// Get all open declarations reported to the sink member GetOpenDeclarations : unit -> OpenDeclaration[] + /// Get the format specifier locations + member GetFormatSpecifierLocations : unit -> (range * int)[] + interface ITypecheckResultsSink /// An abstract type for reporting the results of name resolution and type checking, and which allows diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index c4f7572b8bb..2153dc9a4ce 100755 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -1403,21 +1403,22 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput let tcSymbolUses = if keepAllBackgroundSymbolUses then sink.GetSymbolUses() else TcSymbolUses.Empty // Build symbol keys - let itemKeyStore = + let itemKeyStore, semanticClassification = if enableBackgroundItemKeyStoreAndSemanticClassification then + let sResolutions = sink.GetResolutions() let builder = ItemKeyStoreBuilder() let preventDuplicates = HashSet({ new IEqualityComparer with member _.Equals((s1, e1): struct(pos * pos), (s2, e2): struct(pos * pos)) = Range.posEq s1 s2 && Range.posEq e1 e2 member _.GetHashCode o = o.GetHashCode() }) - sink.GetResolutions().CapturedNameResolutions + sResolutions.CapturedNameResolutions |> Seq.iter (fun cnr -> let r = cnr.Range if preventDuplicates.Add struct(r.Start, r.End) then builder.Write(cnr.Range, cnr.Item)) - builder.TryBuildAndReset() + builder.TryBuildAndReset(), sResolutions.GetSemanticClassification(tcAcc.tcGlobals, tcAcc.tcImports.GetImportMap(), sink.GetFormatSpecifierLocations(), None) else - None + None, [||] RequireCompilationThread ctok // Note: events get raised on the CompilationThread @@ -1434,7 +1435,8 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput tcErrorsRev = newErrors :: tcAcc.tcErrorsRev tcModuleNamesDict = moduleNamesDict tcDependencyFiles = filename :: tcAcc.tcDependencyFiles - itemKeyStore = itemKeyStore } + itemKeyStore = itemKeyStore + semanticClassification = semanticClassification } } // Run part of the Eventually<_> computation until a timeout is reached. If not complete, From 7c460fee7e166e8e9412666e49b92bdb078541de Mon Sep 17 00:00:00 2001 From: TIHan Date: Fri, 24 Jan 2020 16:18:52 -0800 Subject: [PATCH 06/24] Caching semantic classification --- .../Classification/ClassificationService.fs | 98 ++++++++++++++++--- .../LanguageService/FSharpCheckerProvider.fs | 4 +- 2 files changed, 88 insertions(+), 14 deletions(-) diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs index 34d94d1d34c..faa4ad34030 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs @@ -7,6 +7,7 @@ open System.Composition open System.Collections.Generic open System.Diagnostics open System.Threading +open System.Runtime.Caching open Microsoft.CodeAnalysis open Microsoft.CodeAnalysis.Classification @@ -22,6 +23,37 @@ open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Classification open FSharp.Compiler.SourceCodeServices +type SemanticClassificationData = (struct(FSharp.Compiler.Range.range * SemanticClassificationType)[]) +type SemanticClassificationLookup = IReadOnlyDictionary> + +[] +type DocumentCache<'Value when 'Value : not struct>() = + let cache = new MemoryCache("fsharp-cache") + let policy = CacheItemPolicy(SlidingExpiration = TimeSpan.FromSeconds 2.) + + member _.TryGetValueAsync(doc: Document) = async { + let! ct = Async.CancellationToken + let! currentVersion = doc.GetTextVersionAsync ct |> Async.AwaitTask + + match cache.Get(doc.Id.ToString()) with + | null -> return ValueNone + | :? (Microsoft.CodeAnalysis.VersionStamp * 'Value) as value -> + if fst value = currentVersion then + return ValueSome(snd value) + else + return ValueNone + | _ -> + return ValueNone } + + member _.SetAsync(doc: Document, value: 'Value) = async { + let! ct = Async.CancellationToken + let! currentVersion = doc.GetTextVersionAsync ct |> Async.AwaitTask + cache.Set(doc.Id.ToString(), (currentVersion, value), policy) } + + interface IDisposable with + + member _.Dispose() = cache.Dispose() + [)>] type internal FSharpClassificationService [] @@ -31,6 +63,41 @@ type internal FSharpClassificationService ) = static let userOpName = "SemanticColorization" + static let addSemanticClassification sourceText (targetSpan: TextSpan) items (outputResult: List) = + for struct(range, classificationType) in items do + match RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, range) with + | None -> () + | Some span -> + let span = + match classificationType with + | SemanticClassificationType.Printf -> span + | _ -> Tokenizer.fixupSpan(sourceText, span) + if targetSpan.Contains span then + outputResult.Add(ClassifiedSpan(span, FSharpClassificationTypes.getClassificationTypeName(classificationType))) + + static let addSemanticClassificationByLookup sourceText (targetSpan: TextSpan) (lookup: SemanticClassificationLookup) (outputResult: List) = + let r = RoslynHelpers.TextSpanToFSharpRange("", targetSpan, sourceText) + for i = r.StartLine to r.EndLine do + match lookup.TryGetValue i with + | true, items -> addSemanticClassification sourceText targetSpan items outputResult + | _ -> () + + static let toSemanticClassificationLookup (data: SemanticClassificationData) = + let lookup = System.Collections.Generic.Dictionary>() + for i = 0 to data.Length - 1 do + let (struct(r, _) as dataItem) = data.[i] + let items = + match lookup.TryGetValue r.StartLine with + | true, items -> items + | _ -> + let items = ResizeArray() + lookup.[r.StartLine] <- items + items + items.Add dataItem + System.Collections.ObjectModel.ReadOnlyDictionary lookup :> IReadOnlyDictionary<_, _> + + let semanticClassificationCache = new DocumentCache() + interface IFSharpClassificationService with // Do not perform classification if we don't have project options (#defines matter) member __.AddLexicalClassifications(_: SourceText, _: TextSpan, _: List, _: CancellationToken) = () @@ -50,19 +117,24 @@ type internal FSharpClassificationService let! _, _, projectOptions = projectInfoManager.TryGetOptionsForDocumentOrProject(document, cancellationToken) let! sourceText = document.GetTextAsync(cancellationToken) - let! _, _, checkResults = checkerProvider.Checker.ParseAndCheckDocument(document, projectOptions, sourceText = sourceText, allowStaleResults = false, userOpName=userOpName) - let targetRange = RoslynHelpers.TextSpanToFSharpRange(document.FilePath, textSpan, sourceText) - let classificationData = checkResults.GetSemanticClassification (Some targetRange) - - for (range, classificationType) in classificationData do - match RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, range) with - | None -> () - | Some span -> - let span = - match classificationType with - | SemanticClassificationType.Printf -> span - | _ -> Tokenizer.fixupSpan(sourceText, span) - result.Add(ClassifiedSpan(span, FSharpClassificationTypes.getClassificationTypeName(classificationType))) + + // If we are trying to get semantic classification for a document that is not open, get the results from the background and cache it. + // We do this for find all references when it is populating results. + // We cache it temporarily so we do not have to continously call into the checker and perform a background operation. + if not (document.Project.Solution.Workspace.IsDocumentOpen document.Id) then + match! semanticClassificationCache.TryGetValueAsync document |> liftAsync with + | ValueSome classificationDataLookup -> + addSemanticClassificationByLookup sourceText textSpan classificationDataLookup result + | _ -> + let! classificationData = checkerProvider.Checker.GetBackgroundSemanticClassificationForFile(document.FilePath, projectOptions, userOpName=userOpName) |> liftAsync + let classificationDataLookup = toSemanticClassificationLookup classificationData + do! semanticClassificationCache.SetAsync(document, classificationDataLookup) |> liftAsync + addSemanticClassificationByLookup sourceText textSpan classificationDataLookup result + else + let! _, _, checkResults = checkerProvider.Checker.ParseAndCheckDocument(document, projectOptions, sourceText = sourceText, allowStaleResults = false, userOpName=userOpName) + let targetRange = RoslynHelpers.TextSpanToFSharpRange(document.FilePath, textSpan, sourceText) + let classificationData = checkResults.GetSemanticClassification (Some targetRange) + addSemanticClassification sourceText textSpan classificationData result } |> Async.Ignore |> RoslynHelpers.StartAsyncUnitAsTask cancellationToken diff --git a/vsintegration/src/FSharp.Editor/LanguageService/FSharpCheckerProvider.fs b/vsintegration/src/FSharp.Editor/LanguageService/FSharpCheckerProvider.fs index 8397825d71a..176e0f8ccbd 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/FSharpCheckerProvider.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/FSharpCheckerProvider.fs @@ -58,7 +58,9 @@ type internal FSharpCheckerProvider // Enabling this would mean that if devenv.exe goes above 2.3GB we do a one-off downsize of the F# Compiler Service caches (* , MaxMemory = 2300 *) legacyReferenceResolver=LegacyMSBuildReferenceResolver.getResolver(), - tryGetMetadataSnapshot = tryGetMetadataSnapshot) + tryGetMetadataSnapshot = tryGetMetadataSnapshot, + keepAllBackgroundSymbolUses = false, + enableBackgroundItemKeyStoreAndSemanticClassification = true) // This is one half of the bridge between the F# background builder and the Roslyn analysis engine. // When the F# background builder refreshes the background semantic build context for a file, From 3fb228eddfe0ab6a507c4f8a19da72660cb0ad73 Mon Sep 17 00:00:00 2001 From: TIHan Date: Mon, 27 Jan 2020 16:13:13 -0800 Subject: [PATCH 07/24] Wiring it up --- src/fsharp/service/IncrementalBuild.fs | 4 +- .../Classification/ClassificationService.fs | 10 ++- .../InlineRename/InlineRenameService.fs | 2 +- .../LanguageService/SymbolHelpers.fs | 57 ++++++++-------- .../Navigation/FindUsagesService.fs | 67 ++++++++++--------- 5 files changed, 74 insertions(+), 66 deletions(-) diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 2153dc9a4ce..383a4627f0f 100755 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -1171,8 +1171,8 @@ type PartialCheckResults = TimeStamp = timestamp LatestImplementationFile = tcAcc.latestImplFile LatestCcuSigForFile = tcAcc.latestCcuSigForFile - ItemKeyStore = None - SemanticClassification = [||] } + ItemKeyStore = tcAcc.itemKeyStore + SemanticClassification = tcAcc.semanticClassification } [] diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs index faa4ad34030..5d9f42345cd 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs @@ -108,7 +108,15 @@ type internal FSharpClassificationService let defines = projectInfoManager.GetCompilationDefinesForEditingDocument(document) let! sourceText = document.GetTextAsync(cancellationToken) |> Async.AwaitTask - result.AddRange(Tokenizer.getClassifiedSpans(document.Id, sourceText, textSpan, Some(document.FilePath), defines, cancellationToken)) + + // For closed documents, only get classification for the text within the span. + // This may be inaccurate for multi-line tokens such as string literals, but this is ok for now + // as it's better than having to tokenize a big part of a file. + // This is to handle syntactic classification for find all references. + if not (document.Project.Solution.Workspace.IsDocumentOpen document.Id) then + result.AddRange(Tokenizer.getClassifiedSpans(document.Id, sourceText.GetSubText(textSpan), TextSpan(0, textSpan.Length), None, defines, cancellationToken)) + else + result.AddRange(Tokenizer.getClassifiedSpans(document.Id, sourceText, textSpan, Some(document.FilePath), defines, cancellationToken)) } |> RoslynHelpers.StartAsyncUnitAsTask cancellationToken member __.AddSemanticClassificationsAsync(document: Document, textSpan: TextSpan, result: List, cancellationToken: CancellationToken) = diff --git a/vsintegration/src/FSharp.Editor/InlineRename/InlineRenameService.fs b/vsintegration/src/FSharp.Editor/InlineRename/InlineRenameService.fs index 8791c558896..92778109d04 100644 --- a/vsintegration/src/FSharp.Editor/InlineRename/InlineRenameService.fs +++ b/vsintegration/src/FSharp.Editor/InlineRename/InlineRenameService.fs @@ -125,7 +125,7 @@ type internal InlineRenameInfo let! sourceText = document.GetTextAsync(cancellationToken) |> Async.AwaitTask return [| for symbolUse in symbolUses do - match RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, symbolUse.RangeAlternate) with + match RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, symbolUse) with | Some span -> let textSpan = Tokenizer.fixupSpan(sourceText, span) yield FSharpInlineRenameLocation(document, textSpan) diff --git a/vsintegration/src/FSharp.Editor/LanguageService/SymbolHelpers.fs b/vsintegration/src/FSharp.Editor/LanguageService/SymbolHelpers.fs index 5b85dc49aa4..a2db43e3b19 100644 --- a/vsintegration/src/FSharp.Editor/LanguageService/SymbolHelpers.fs +++ b/vsintegration/src/FSharp.Editor/LanguageService/SymbolHelpers.fs @@ -35,43 +35,24 @@ module internal SymbolHelpers = return symbolUses } - let getSymbolUsesInProjects (symbol: FSharpSymbol, projectInfoManager: FSharpProjectOptionsManager, checker: FSharpChecker, projects: Project list, userOpName) = + let getSymbolUsesInProjects (symbol: FSharpSymbol, projectInfoManager: FSharpProjectOptionsManager, checker: FSharpChecker, projects: Project list, onFound: range -> Async, userOpName) = projects |> Seq.map (fun project -> async { match! projectInfoManager.TryGetOptionsByProject(project, CancellationToken.None) with | Some (_parsingOptions, projectOptions) -> - let! projectCheckResults = checker.ParseAndCheckProject(projectOptions, userOpName = userOpName) - let! uses = projectCheckResults.GetUsesOfSymbol(symbol) - let distinctUses = uses |> Array.distinctBy (fun symbolUse -> symbolUse.RangeAlternate) - return distinctUses - | None -> return [||] + for filePath in projectOptions.SourceFiles do + let! symbolUses = checker.FindBackgroundReferencesInFile(filePath, projectOptions, symbol, userOpName = userOpName) + for symbolUse in symbolUses do + do! onFound symbolUse + | _ -> () }) - |> Async.Parallel - |> Async.map Array.concat - // FCS may return several `FSharpSymbolUse`s for same range, which have different `ItemOccurrence`s (Use, UseInAttribute, UseInType, etc.) - // We don't care about the occurrence type here, so we distinct by range. - |> Async.map (Array.distinctBy (fun x -> x.RangeAlternate)) + |> Async.Sequential let getSymbolUsesInSolution (symbol: FSharpSymbol, declLoc: SymbolDeclarationLocation, checkFileResults: FSharpCheckFileResults, projectInfoManager: FSharpProjectOptionsManager, checker: FSharpChecker, solution: Solution, userOpName) = async { - let! symbolUses = - match declLoc with - | SymbolDeclarationLocation.CurrentDocument -> - checkFileResults.GetUsesOfSymbolInFile(symbol) - | SymbolDeclarationLocation.Projects (projects, isInternalToProject) -> - let projects = - if isInternalToProject then projects - else - [ for project in projects do - yield project - yield! project.GetDependentProjects() ] - |> List.distinctBy (fun x -> x.Id) - - getSymbolUsesInProjects (symbol, projectInfoManager, checker, projects, userOpName) - - return + let toDict (symbolUses: range seq) = (symbolUses |> Seq.collect (fun symbolUse -> solution.GetDocumentIdsWithFilePath(symbolUse.FileName) |> Seq.map (fun id -> id, symbolUse)) @@ -79,7 +60,25 @@ module internal SymbolHelpers = ).ToImmutableDictionary( (fun (id, _) -> id), fun (_, xs) -> xs |> Seq.map snd |> Seq.toArray) - } + + match declLoc with + | SymbolDeclarationLocation.CurrentDocument -> + let! symbolUses = checkFileResults.GetUsesOfSymbolInFile(symbol) + return toDict (symbolUses |> Seq.map (fun symbolUse -> symbolUse.RangeAlternate)) + | SymbolDeclarationLocation.Projects (projects, isInternalToProject) -> + let symbolUses = ResizeArray() + + let projects = + if isInternalToProject then projects + else + [ for project in projects do + yield project + yield! project.GetDependentProjects() ] + |> List.distinctBy (fun x -> x.Id) + + let! _ = getSymbolUsesInProjects (symbol, projectInfoManager, checker, projects, (fun symbolUse -> async { symbolUses.Add symbolUse }), userOpName) + + return toDict symbolUses } type OriginalText = string @@ -123,7 +122,7 @@ module internal SymbolHelpers = let! sourceText = document.GetTextAsync(cancellationToken) |> Async.AwaitTask let mutable sourceText = sourceText for symbolUse in symbolUses do - match RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, symbolUse.RangeAlternate) with + match RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, symbolUse) with | None -> () | Some span -> let textSpan = Tokenizer.fixupSpan(sourceText, span) diff --git a/vsintegration/src/FSharp.Editor/Navigation/FindUsagesService.fs b/vsintegration/src/FSharp.Editor/Navigation/FindUsagesService.fs index f33d23b3291..0295a25c265 100644 --- a/vsintegration/src/FSharp.Editor/Navigation/FindUsagesService.fs +++ b/vsintegration/src/FSharp.Editor/Navigation/FindUsagesService.fs @@ -89,41 +89,42 @@ type internal FSharpFindUsagesService for definitionItem in definitionItems do do! context.OnDefinitionFoundAsync(definitionItem) |> Async.AwaitTask |> liftAsync - let! symbolUses = - match symbolUse.GetDeclarationLocation document with - | Some SymbolDeclarationLocation.CurrentDocument -> - checkFileResults.GetUsesOfSymbolInFile(symbolUse.Symbol) |> liftAsync - | scope -> - let projectsToCheck = - match scope with - | Some (SymbolDeclarationLocation.Projects (declProjects, false)) -> - [ for declProject in declProjects do - yield declProject - yield! declProject.GetDependentProjects() ] - |> List.distinct - | Some (SymbolDeclarationLocation.Projects (declProjects, true)) -> declProjects - // The symbol is declared in .NET framework, an external assembly or in a C# project within the solution. - // In order to find all its usages we have to check all F# projects. - | _ -> Seq.toList document.Project.Solution.Projects - - SymbolHelpers.getSymbolUsesInProjects (symbolUse.Symbol, projectInfoManager, checker, projectsToCheck, userOpName) |> liftAsync - - for symbolUse in symbolUses do - match declarationRange with - | Some declRange when declRange = symbolUse.RangeAlternate -> () - | _ -> - // report a reference if we're interested in all _or_ if we're looking at an implementation - if allReferences || symbolUse.IsFromDispatchSlotImplementation then - let! referenceDocSpans = rangeToDocumentSpans(document.Project.Solution, symbolUse.RangeAlternate) |> liftAsync - match referenceDocSpans with - | [] -> () + let onFound = + fun (symbolUse: range) -> + async { + match declarationRange with + | Some declRange when FSharp.Compiler.Range.equals declRange symbolUse -> () | _ -> - for referenceDocSpan in referenceDocSpans do - for definitionItem in definitionItems do - let referenceItem = FSharpSourceReferenceItem(definitionItem, referenceDocSpan) - do! context.OnReferenceFoundAsync(referenceItem) |> Async.AwaitTask |> liftAsync + if allReferences then + let! referenceDocSpans = rangeToDocumentSpans(document.Project.Solution, symbolUse) + match referenceDocSpans with + | [] -> () + | _ -> + for referenceDocSpan in referenceDocSpans do + for definitionItem in definitionItems do + let referenceItem = FSharpSourceReferenceItem(definitionItem, referenceDocSpan) + do! context.OnReferenceFoundAsync(referenceItem) |> Async.AwaitTask } - () + match symbolUse.GetDeclarationLocation document with + | Some SymbolDeclarationLocation.CurrentDocument -> + let! symbolUses = checkFileResults.GetUsesOfSymbolInFile(symbolUse.Symbol) |> liftAsync + for symbolUse in symbolUses do + do! onFound symbolUse.RangeAlternate |> liftAsync + | scope -> + let projectsToCheck = + match scope with + | Some (SymbolDeclarationLocation.Projects (declProjects, false)) -> + [ for declProject in declProjects do + yield declProject + yield! declProject.GetDependentProjects() ] + |> List.distinct + | Some (SymbolDeclarationLocation.Projects (declProjects, true)) -> declProjects + // The symbol is declared in .NET framework, an external assembly or in a C# project within the solution. + // In order to find all its usages we have to check all F# projects. + | _ -> Seq.toList document.Project.Solution.Projects + + let! _ = SymbolHelpers.getSymbolUsesInProjects (symbolUse.Symbol, projectInfoManager, checker, projectsToCheck, onFound, userOpName) |> liftAsync + () } |> Async.Ignore interface IFSharpFindUsagesService with From a488eaf3aa3c0fbbd9ecb3d6e86802acf362d122 Mon Sep 17 00:00:00 2001 From: TIHan Date: Wed, 29 Jan 2020 11:27:26 -0800 Subject: [PATCH 08/24] Need to fix lexing --- .../Classification/ClassificationService.fs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs index 5d9f42345cd..9caad878da7 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs @@ -114,7 +114,14 @@ type internal FSharpClassificationService // as it's better than having to tokenize a big part of a file. // This is to handle syntactic classification for find all references. if not (document.Project.Solution.Workspace.IsDocumentOpen document.Id) then - result.AddRange(Tokenizer.getClassifiedSpans(document.Id, sourceText.GetSubText(textSpan), TextSpan(0, textSpan.Length), None, defines, cancellationToken)) + let tokenizer = FSharpSourceTokenizer(defines, Some document.FilePath) + let tokenizer = tokenizer.CreateLineTokenizer(sourceText.ToFSharpSourceText()) + let rec scan (state) = + match tokenizer.ScanToken state with + | Some info, state -> + + while + tokenizer.ScanToken(FSharpTokenizerLexState.Initial) else result.AddRange(Tokenizer.getClassifiedSpans(document.Id, sourceText, textSpan, Some(document.FilePath), defines, cancellationToken)) } |> RoslynHelpers.StartAsyncUnitAsTask cancellationToken From b2c87643299984c8c454a6ff9c4964180483d168 Mon Sep 17 00:00:00 2001 From: TIHan Date: Mon, 3 Feb 2020 14:30:56 -0800 Subject: [PATCH 09/24] Added experimental lexing API to handle find all refs syntactic classification from allocating a lot --- src/fsharp/service/ServiceLexing.fs | 621 ++++++++++++++++++ src/fsharp/service/ServiceLexing.fsi | 238 +++++++ .../Classification/ClassificationService.fs | 44 +- 3 files changed, 893 insertions(+), 10 deletions(-) diff --git a/src/fsharp/service/ServiceLexing.fs b/src/fsharp/service/ServiceLexing.fs index e0792c9d2a8..e5f3d336e30 100644 --- a/src/fsharp/service/ServiceLexing.fs +++ b/src/fsharp/service/ServiceLexing.fs @@ -795,3 +795,624 @@ module Keywords = let NormalizeIdentifierBackticks s = NormalizeIdentifierBackticks s let KeywordsWithDescription = keywordsWithDescription +module Lexer = + + open System.Threading + open FSharp.Compiler.UnicodeLexing + open FSharp.Compiler.Range + open FSharp.Compiler.Ast + open FSharp.Compiler.Text + open FSharp.Compiler.Features + open FSharp.Compiler.Parser + open FSharp.Compiler.Lexhelp + open Internal.Utilities + + [] + type FSharpLexerFlags = + | Default = 0x11011 + | LightSyntaxOn = 0x00001 + | Compiling = 0x00010 + | CompilingFSharpCore = 0x00110 + | SkipTrivia = 0x01000 + | UseLexFilter = 0x10000 + + [] + type FSharpSyntaxTokenKind = + | None + | HashIf + | HashElse + | HashEndIf + | CommentTrivia + | WhitespaceTrivia + | HashLine + | HashLight + | InactiveCode + | LineCommentTrivia + | StringText + | Fixed + | OffsideInterfaceMember + | OffsideBlockEnd + | OffsideRightBlockEnd + | OffsideDeclEnd + | OffsideEnd + | OffsideBlockSep + | OffsideBlockBegin + | OffsideReset + | OffsideFun + | OffsideFunction + | OffsideWith + | OffsideElse + | OffsideThen + | OffsideDoBang + | OffsideDo + | OffsideBinder + | OffsideLet + | HighPrecedenceTypeApp + | HighPrecedenceParenthesisApp + | HighPrecedenceBracketApp + | Extern + | Void + | Public + | Private + | Internal + | Global + | Static + | Member + | Class + | Abstract + | Override + | Default + | Constructor + | Inherit + | GreaterRightBracket + | Struct + | Sig + | Bar + | RightBracket + | RightBrace + | Minus + | Dollar + | BarRightBracket + | BarRightBrace + | Underscore + | Semicolon + | SemicolonSemicolon + | LeftArrow + | Equals + | LeftBracket + | LeftBracketBar + | LeftBraceBar + | LeftBracketLess + | LeftBrace + | QuestionMark + | QuestionMarkQuestionMark + | Dot + | Colon + | ColonColon + | ColonGreater + | ColonQuestionMark + | ColonQuestionMarkGreater + | ColonEquals + | When + | While + | With + | Hash + | Ampersand + | AmpersandAmpersand + | Quote + | LeftParenthesis + | RightParenthesis + | Star + | Comma + | RightArrow + | GreaterBarRightBracket + | LeftParenthesisStarRightParenthesis + | Open + | Or + | Rec + | Then + | To + | True + | Try + | Type + | Val + | Inline + | Interface + | Instance + | Const + | Lazy + | OffsideLazy + | Match + | MatchBang + | Mutable + | New + | Of + | Exception + | False + | For + | Fun + | Function + | If + | In + | JoinIn + | Finally + | DoBang + | And + | As + | Assert + | OffsideAssert + | Begin + | Do + | Done + | DownTo + | Else + | Elif + | End + | DotDot + | DotDotHat + | BarBar + | Upcast + | Downcast + | Null + | Reserved + | Module + | Namespace + | Delegate + | Constraint + | Base + | LeftQuote + | RightQuote + | RightQuoteDot + | PercentOperator + | Binder + | Less + | Greater + | Let + | Yield + | YieldBang + | BigNumber + | Decimal + | Char + | Ieee64 + | Ieee32 + | NativeInt + | UNativeInt + | UInt64 + | UInt32 + | UInt16 + | UInt8 + | Int64 + | Int32 + | Int32DotDot + | Int16 + | Int8 + | FunkyOperatorName + | AdjacentPrefixOperator + | PlusMinusOperator + | InfixAmpersandOperator + | InfixStarDivideModuloOperator + | PrefixOperator + | InfixBarOperator + | InfixAtHatOperator + | InfixCompareOperator + | InfixStarStarOperator + | Identifier + | KeywordString + | String + | ByteArray + | Asr + | InfixAsr + | InfixLand + | InfixLor + | InfixLsl + | InfixLsr + | InfixLxor + | InfixMod + + [] + type FSharpSyntaxToken = + + val private tok: Parser.token + val private tokRange: range + + new (tok, tokRange) = { tok = tok; tokRange = tokRange } + + member this.Range = this.tokRange + + member this.Kind = + match this.tok with + | ASR -> FSharpSyntaxTokenKind.Asr + | INFIX_STAR_STAR_OP "asr" -> FSharpSyntaxTokenKind.Asr + | INFIX_STAR_DIV_MOD_OP "land" -> FSharpSyntaxTokenKind.InfixLand + | INFIX_STAR_DIV_MOD_OP "lor" -> FSharpSyntaxTokenKind.InfixLor + | INFIX_STAR_STAR_OP "lsl" -> FSharpSyntaxTokenKind.InfixLsl + | INFIX_STAR_STAR_OP "lsr" -> FSharpSyntaxTokenKind.InfixLsr + | INFIX_STAR_DIV_MOD_OP "lxor" -> FSharpSyntaxTokenKind.InfixLxor + | INFIX_STAR_DIV_MOD_OP "mod" -> FSharpSyntaxTokenKind.InfixMod + | HASH_IF _ -> FSharpSyntaxTokenKind.HashIf + | HASH_ELSE _ -> FSharpSyntaxTokenKind.HashElse + | HASH_ENDIF _ -> FSharpSyntaxTokenKind.HashEndIf + | COMMENT _ -> FSharpSyntaxTokenKind.CommentTrivia + | WHITESPACE _ -> FSharpSyntaxTokenKind.WhitespaceTrivia + | HASH_LINE _ -> FSharpSyntaxTokenKind.HashLine + | HASH_LIGHT _ -> FSharpSyntaxTokenKind.HashLight + | INACTIVECODE _ -> FSharpSyntaxTokenKind.InactiveCode + | LINE_COMMENT _ -> FSharpSyntaxTokenKind.LineCommentTrivia + | STRING_TEXT _ -> FSharpSyntaxTokenKind.StringText + | FIXED -> FSharpSyntaxTokenKind.Fixed + | OINTERFACE_MEMBER -> FSharpSyntaxTokenKind.OffsideInterfaceMember + | OBLOCKEND -> FSharpSyntaxTokenKind.OffsideBlockEnd + | ORIGHT_BLOCK_END -> FSharpSyntaxTokenKind.OffsideRightBlockEnd + | ODECLEND -> FSharpSyntaxTokenKind.OffsideDeclEnd + | OEND -> FSharpSyntaxTokenKind.OffsideEnd + | OBLOCKSEP -> FSharpSyntaxTokenKind.OffsideBlockSep + | OBLOCKBEGIN -> FSharpSyntaxTokenKind.OffsideBlockBegin + | ORESET -> FSharpSyntaxTokenKind.OffsideReset + | OFUN -> FSharpSyntaxTokenKind.OffsideFun + | OFUNCTION -> FSharpSyntaxTokenKind.OffsideFunction + | OWITH -> FSharpSyntaxTokenKind.OffsideWith + | OELSE -> FSharpSyntaxTokenKind.OffsideElse + | OTHEN -> FSharpSyntaxTokenKind.OffsideThen + | ODO_BANG -> FSharpSyntaxTokenKind.OffsideDoBang + | ODO -> FSharpSyntaxTokenKind.OffsideDo + | OBINDER _ -> FSharpSyntaxTokenKind.OffsideBinder + | OLET _ -> FSharpSyntaxTokenKind.OffsideLet + | HIGH_PRECEDENCE_TYAPP -> FSharpSyntaxTokenKind.HighPrecedenceTypeApp + | HIGH_PRECEDENCE_PAREN_APP -> FSharpSyntaxTokenKind.HighPrecedenceParenthesisApp + | HIGH_PRECEDENCE_BRACK_APP -> FSharpSyntaxTokenKind.HighPrecedenceBracketApp + | EXTERN -> FSharpSyntaxTokenKind.Extern + | VOID -> FSharpSyntaxTokenKind.Void + | PUBLIC -> FSharpSyntaxTokenKind.Public + | PRIVATE -> FSharpSyntaxTokenKind.Private + | INTERNAL -> FSharpSyntaxTokenKind.Internal + | GLOBAL -> FSharpSyntaxTokenKind.Global + | STATIC -> FSharpSyntaxTokenKind.Static + | MEMBER -> FSharpSyntaxTokenKind.Member + | CLASS -> FSharpSyntaxTokenKind.Class + | ABSTRACT -> FSharpSyntaxTokenKind.Abstract + | OVERRIDE -> FSharpSyntaxTokenKind.Override + | DEFAULT -> FSharpSyntaxTokenKind.Default + | CONSTRUCTOR -> FSharpSyntaxTokenKind.Constructor + | INHERIT -> FSharpSyntaxTokenKind.Inherit + | GREATER_RBRACK -> FSharpSyntaxTokenKind.GreaterRightBracket + | STRUCT -> FSharpSyntaxTokenKind.Struct + | SIG -> FSharpSyntaxTokenKind.Sig + | BAR -> FSharpSyntaxTokenKind.Bar + | RBRACK -> FSharpSyntaxTokenKind.RightBracket + | RBRACE -> FSharpSyntaxTokenKind.RightBrace + | MINUS -> FSharpSyntaxTokenKind.Minus + | DOLLAR -> FSharpSyntaxTokenKind.Dollar + | BAR_RBRACK -> FSharpSyntaxTokenKind.BarRightBracket + | BAR_RBRACE -> FSharpSyntaxTokenKind.BarRightBrace + | UNDERSCORE -> FSharpSyntaxTokenKind.Underscore + | SEMICOLON_SEMICOLON -> FSharpSyntaxTokenKind.SemicolonSemicolon + | LARROW -> FSharpSyntaxTokenKind.LeftArrow + | EQUALS -> FSharpSyntaxTokenKind.Equals + | LBRACK -> FSharpSyntaxTokenKind.LeftBracket + | LBRACK_BAR -> FSharpSyntaxTokenKind.LeftBracketBar + | LBRACE_BAR -> FSharpSyntaxTokenKind.LeftBraceBar + | LBRACK_LESS -> FSharpSyntaxTokenKind.LeftBracketLess + | LBRACE -> FSharpSyntaxTokenKind.LeftBrace + | QMARK -> FSharpSyntaxTokenKind.QuestionMark + | QMARK_QMARK -> FSharpSyntaxTokenKind.QuestionMarkQuestionMark + | DOT -> FSharpSyntaxTokenKind.Dot + | COLON -> FSharpSyntaxTokenKind.Colon + | COLON_COLON -> FSharpSyntaxTokenKind.ColonColon + | COLON_GREATER -> FSharpSyntaxTokenKind.ColonGreater + | COLON_QMARK_GREATER -> FSharpSyntaxTokenKind.ColonQuestionMarkGreater + | COLON_QMARK -> FSharpSyntaxTokenKind.ColonQuestionMark + | COLON_EQUALS -> FSharpSyntaxTokenKind.ColonEquals + | SEMICOLON -> FSharpSyntaxTokenKind.SemicolonSemicolon + | WHEN -> FSharpSyntaxTokenKind.When + | WHILE -> FSharpSyntaxTokenKind.While + | WITH -> FSharpSyntaxTokenKind.With + | HASH -> FSharpSyntaxTokenKind.Hash + | AMP -> FSharpSyntaxTokenKind.Ampersand + | AMP_AMP -> FSharpSyntaxTokenKind.AmpersandAmpersand + | QUOTE -> FSharpSyntaxTokenKind.RightQuote + | LPAREN -> FSharpSyntaxTokenKind.LeftParenthesis + | RPAREN -> FSharpSyntaxTokenKind.RightParenthesis + | STAR -> FSharpSyntaxTokenKind.Star + | COMMA -> FSharpSyntaxTokenKind.Comma + | RARROW -> FSharpSyntaxTokenKind.RightArrow + | GREATER_BAR_RBRACK -> FSharpSyntaxTokenKind.GreaterBarRightBracket + | LPAREN_STAR_RPAREN -> FSharpSyntaxTokenKind.LeftParenthesisStarRightParenthesis + | OPEN -> FSharpSyntaxTokenKind.Open + | OR -> FSharpSyntaxTokenKind.Or + | REC -> FSharpSyntaxTokenKind.Rec + | THEN -> FSharpSyntaxTokenKind.Then + | TO -> FSharpSyntaxTokenKind.To + | TRUE -> FSharpSyntaxTokenKind.True + | TRY -> FSharpSyntaxTokenKind.Try + | TYPE -> FSharpSyntaxTokenKind.Type + | VAL -> FSharpSyntaxTokenKind.Val + | INLINE -> FSharpSyntaxTokenKind.Inline + | INTERFACE -> FSharpSyntaxTokenKind.Interface + | INSTANCE -> FSharpSyntaxTokenKind.Instance + | CONST -> FSharpSyntaxTokenKind.Const + | LAZY -> FSharpSyntaxTokenKind.Lazy + | OLAZY -> FSharpSyntaxTokenKind.OffsideLazy + | MATCH -> FSharpSyntaxTokenKind.Match + | MATCH_BANG -> FSharpSyntaxTokenKind.MatchBang + | MUTABLE -> FSharpSyntaxTokenKind.Mutable + | NEW -> FSharpSyntaxTokenKind.New + | OF -> FSharpSyntaxTokenKind.Of + | EXCEPTION -> FSharpSyntaxTokenKind.Exception + | FALSE -> FSharpSyntaxTokenKind.False + | FOR -> FSharpSyntaxTokenKind.For + | FUN -> FSharpSyntaxTokenKind.Fun + | FUNCTION -> FSharpSyntaxTokenKind.Function + | IF -> FSharpSyntaxTokenKind.If + | IN -> FSharpSyntaxTokenKind.In + | JOIN_IN -> FSharpSyntaxTokenKind.JoinIn + | FINALLY -> FSharpSyntaxTokenKind.Finally + | DO_BANG -> FSharpSyntaxTokenKind.DoBang + | AND -> FSharpSyntaxTokenKind.And + | AS -> FSharpSyntaxTokenKind.As + | ASSERT -> FSharpSyntaxTokenKind.Assert + | OASSERT -> FSharpSyntaxTokenKind.OffsideAssert + | BEGIN -> FSharpSyntaxTokenKind.Begin + | DO -> FSharpSyntaxTokenKind.Do + | DONE -> FSharpSyntaxTokenKind.Done + | DOWNTO -> FSharpSyntaxTokenKind.DownTo + | ELSE -> FSharpSyntaxTokenKind.Else + | ELIF -> FSharpSyntaxTokenKind.Elif + | END -> FSharpSyntaxTokenKind.End + | DOT_DOT -> FSharpSyntaxTokenKind.DotDot + | DOT_DOT_HAT -> FSharpSyntaxTokenKind.DotDotHat + | BAR_BAR -> FSharpSyntaxTokenKind.BarBar + | UPCAST -> FSharpSyntaxTokenKind.Upcast + | DOWNCAST -> FSharpSyntaxTokenKind.Downcast + | NULL -> FSharpSyntaxTokenKind.Null + | RESERVED -> FSharpSyntaxTokenKind.Reserved + | MODULE -> FSharpSyntaxTokenKind.Module + | NAMESPACE -> FSharpSyntaxTokenKind.Namespace + | DELEGATE -> FSharpSyntaxTokenKind.Delegate + | CONSTRAINT -> FSharpSyntaxTokenKind.Constraint + | BASE -> FSharpSyntaxTokenKind.Base + | LQUOTE _ -> FSharpSyntaxTokenKind.LeftQuote + | RQUOTE _ -> FSharpSyntaxTokenKind.RightQuote + | RQUOTE_DOT _ -> FSharpSyntaxTokenKind.RightQuoteDot + | PERCENT_OP _ -> FSharpSyntaxTokenKind.PercentOperator + | BINDER _ -> FSharpSyntaxTokenKind.Binder + | LESS _ -> FSharpSyntaxTokenKind.Less + | GREATER _ -> FSharpSyntaxTokenKind.Greater + | LET _ -> FSharpSyntaxTokenKind.Let + | YIELD _ -> FSharpSyntaxTokenKind.Yield + | YIELD_BANG _ -> FSharpSyntaxTokenKind.YieldBang + | BIGNUM _ -> FSharpSyntaxTokenKind.BigNumber + | DECIMAL _ -> FSharpSyntaxTokenKind.Decimal + | CHAR _ -> FSharpSyntaxTokenKind.Char + | IEEE64 _ -> FSharpSyntaxTokenKind.Ieee64 + | IEEE32 _ -> FSharpSyntaxTokenKind.Ieee32 + | NATIVEINT _ -> FSharpSyntaxTokenKind.NativeInt + | UNATIVEINT _ -> FSharpSyntaxTokenKind.UNativeInt + | UINT64 _ -> FSharpSyntaxTokenKind.UInt64 + | UINT32 _ -> FSharpSyntaxTokenKind.UInt32 + | UINT16 _ -> FSharpSyntaxTokenKind.UInt16 + | UINT8 _ -> FSharpSyntaxTokenKind.UInt8 + | INT64 _ -> FSharpSyntaxTokenKind.UInt64 + | INT32 _ -> FSharpSyntaxTokenKind.Int32 + | INT32_DOT_DOT _ -> FSharpSyntaxTokenKind.Int32DotDot + | INT16 _ -> FSharpSyntaxTokenKind.Int16 + | INT8 _ -> FSharpSyntaxTokenKind.Int8 + | FUNKY_OPERATOR_NAME _ -> FSharpSyntaxTokenKind.FunkyOperatorName + | ADJACENT_PREFIX_OP _ -> FSharpSyntaxTokenKind.AdjacentPrefixOperator + | PLUS_MINUS_OP _ -> FSharpSyntaxTokenKind.PlusMinusOperator + | INFIX_AMP_OP _ -> FSharpSyntaxTokenKind.InfixAmpersandOperator + | INFIX_STAR_DIV_MOD_OP _ -> FSharpSyntaxTokenKind.InfixStarDivideModuloOperator + | PREFIX_OP _ -> FSharpSyntaxTokenKind.PrefixOperator + | INFIX_BAR_OP _ -> FSharpSyntaxTokenKind.InfixBarOperator + | INFIX_AT_HAT_OP _ -> FSharpSyntaxTokenKind.InfixAtHatOperator + | INFIX_COMPARE_OP _ -> FSharpSyntaxTokenKind.InfixCompareOperator + | INFIX_STAR_STAR_OP _ -> FSharpSyntaxTokenKind.InfixStarStarOperator + | IDENT _ -> FSharpSyntaxTokenKind.Identifier + | KEYWORD_STRING _ -> FSharpSyntaxTokenKind.KeywordString + | STRING _ -> FSharpSyntaxTokenKind.String + | BYTEARRAY _ -> FSharpSyntaxTokenKind.ByteArray + | _ -> FSharpSyntaxTokenKind.None + + member this.IsKeyword = + match this.Kind with + | FSharpSyntaxTokenKind.Abstract + | FSharpSyntaxTokenKind.And + | FSharpSyntaxTokenKind.As + | FSharpSyntaxTokenKind.Assert + | FSharpSyntaxTokenKind.OffsideAssert + | FSharpSyntaxTokenKind.Base + | FSharpSyntaxTokenKind.Begin + | FSharpSyntaxTokenKind.Class + | FSharpSyntaxTokenKind.Default + | FSharpSyntaxTokenKind.Delegate + | FSharpSyntaxTokenKind.Do + | FSharpSyntaxTokenKind.OffsideDo + | FSharpSyntaxTokenKind.Done + | FSharpSyntaxTokenKind.Downcast + | FSharpSyntaxTokenKind.DownTo + | FSharpSyntaxTokenKind.Elif + | FSharpSyntaxTokenKind.Else + | FSharpSyntaxTokenKind.OffsideElse + | FSharpSyntaxTokenKind.End + | FSharpSyntaxTokenKind.OffsideEnd + | FSharpSyntaxTokenKind.Exception + | FSharpSyntaxTokenKind.Extern + | FSharpSyntaxTokenKind.False + | FSharpSyntaxTokenKind.Finally + | FSharpSyntaxTokenKind.Fixed + | FSharpSyntaxTokenKind.For + | FSharpSyntaxTokenKind.Fun + | FSharpSyntaxTokenKind.OffsideFun + | FSharpSyntaxTokenKind.Function + | FSharpSyntaxTokenKind.OffsideFunction + | FSharpSyntaxTokenKind.Global + | FSharpSyntaxTokenKind.If + | FSharpSyntaxTokenKind.In + | FSharpSyntaxTokenKind.Inherit + | FSharpSyntaxTokenKind.Inline + | FSharpSyntaxTokenKind.Interface + | FSharpSyntaxTokenKind.OffsideInterfaceMember + | FSharpSyntaxTokenKind.Internal + | FSharpSyntaxTokenKind.Lazy + | FSharpSyntaxTokenKind.OffsideLazy + | FSharpSyntaxTokenKind.Let // "let" and "use" + | FSharpSyntaxTokenKind.OffsideLet + | FSharpSyntaxTokenKind.DoBang // "let!", "use!" and "do!" + | FSharpSyntaxTokenKind.OffsideDoBang + | FSharpSyntaxTokenKind.Match + | FSharpSyntaxTokenKind.MatchBang + | FSharpSyntaxTokenKind.Member + | FSharpSyntaxTokenKind.Module + | FSharpSyntaxTokenKind.Mutable + | FSharpSyntaxTokenKind.Namespace + | FSharpSyntaxTokenKind.New + // | FSharpSyntaxTokenKind.Not // Not actually a keyword. However, not struct in combination is used as a generic parameter constraint. + | FSharpSyntaxTokenKind.Null + | FSharpSyntaxTokenKind.Of + | FSharpSyntaxTokenKind.Open + | FSharpSyntaxTokenKind.Or + | FSharpSyntaxTokenKind.Override + | FSharpSyntaxTokenKind.Private + | FSharpSyntaxTokenKind.Public + | FSharpSyntaxTokenKind.Rec + | FSharpSyntaxTokenKind.Yield // "yield" and "return" + | FSharpSyntaxTokenKind.YieldBang // "yield!" and "return!" + | FSharpSyntaxTokenKind.Static + | FSharpSyntaxTokenKind.Struct + | FSharpSyntaxTokenKind.Then + | FSharpSyntaxTokenKind.To + | FSharpSyntaxTokenKind.True + | FSharpSyntaxTokenKind.Try + | FSharpSyntaxTokenKind.Type + | FSharpSyntaxTokenKind.Upcast + | FSharpSyntaxTokenKind.Val + | FSharpSyntaxTokenKind.Void + | FSharpSyntaxTokenKind.When + | FSharpSyntaxTokenKind.While + | FSharpSyntaxTokenKind.With + | FSharpSyntaxTokenKind.OffsideWith + + // * Reserved - from OCAML * + | FSharpSyntaxTokenKind.Asr + | FSharpSyntaxTokenKind.InfixAsr + | FSharpSyntaxTokenKind.InfixLand + | FSharpSyntaxTokenKind.InfixLor + | FSharpSyntaxTokenKind.InfixLsl + | FSharpSyntaxTokenKind.InfixLsr + | FSharpSyntaxTokenKind.InfixLxor + | FSharpSyntaxTokenKind.InfixMod + | FSharpSyntaxTokenKind.Sig + + // * Reserved - for future * + // atomic + // break + // checked + // component + // const + // constraint + // constructor + // continue + // eager + // event + // external + // functor + // include + // method + // mixin + // object + // parallel + // process + // protected + // pure + // sealed + // tailcall + // trait + // virtual + // volatile + | FSharpSyntaxTokenKind.Reserved + | FSharpSyntaxTokenKind.KeywordString -> true + | _ -> false + + member this.IsIdentifier = + match this.Kind with + | FSharpSyntaxTokenKind.Identifier -> true + | _ -> false + + member this.IsStringLiteral = + match this.Kind with + | FSharpSyntaxTokenKind.String -> true + | _ -> false + + member this.IsNumericLiteral = + match this.Kind with + | FSharpSyntaxTokenKind.UInt8 + | FSharpSyntaxTokenKind.UInt16 + | FSharpSyntaxTokenKind.UInt64 + | FSharpSyntaxTokenKind.Int8 + | FSharpSyntaxTokenKind.Int16 + | FSharpSyntaxTokenKind.Int32 + | FSharpSyntaxTokenKind.Int64 + | FSharpSyntaxTokenKind.Ieee32 + | FSharpSyntaxTokenKind.Ieee64 + | FSharpSyntaxTokenKind.BigNumber -> true + | _ -> false + + member this.IsCommentTrivia = + match this.Kind with + | FSharpSyntaxTokenKind.CommentTrivia + | FSharpSyntaxTokenKind.LineCommentTrivia -> true + | _ -> false + + let lexWithErrorLogger (text: ISourceText) (filePath: string) conditionalCompilationDefines (flags: FSharpLexerFlags) supportsFeature errorLogger 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(supportsFeature, text) + let lightSyntaxStatus = LightSyntaxStatus(isLightSyntaxOn, true) + let lexargs = mkLexargs (filePath, conditionalCompilationDefines, lightSyntaxStatus, Lexhelp.LexResourceManager(), [], errorLogger, pathMap) + let lexargs = { lexargs with applyLineDirectives = isCompiling } + + let getNextToken = + let lexer = Lexer.token lexargs canSkipTrivia + + if canUseLexFilter then + LexFilter.LexFilter(lexargs.lightSyntaxStatus, isCompilingFSharpCore, lexer, lexbuf).Lexer + else + lexer + + usingLexbufForParsing (lexbuf, filePath) (fun lexbuf -> + while not lexbuf.IsPastEndOfStream do + ct.ThrowIfCancellationRequested () + onToken (getNextToken lexbuf) lexbuf.LexemeRange) + + let lex text filePath conditionalCompilationDefines flags supportsFeature lexCallback pathMap ct = + let errorLogger = CompilationErrorLogger("Lexer", ErrorLogger.FSharpErrorSeverityOptions.Default) + lexWithErrorLogger text filePath conditionalCompilationDefines flags supportsFeature errorLogger lexCallback pathMap ct + + [] + type FSharpLexer = + + static member Lex(text: ISourceText, tokenCallback, ?langVersion, ?filePath, ?conditionalCompilationDefines, ?flags, ?pathMap, ?ct) = + let langVersion = defaultArg langVersion "latestmajor" + let flags = defaultArg flags FSharpLexerFlags.Default + let filePath = defaultArg filePath String.Empty + let conditionalCompilationDefines = defaultArg conditionalCompilationDefines [] + let pathMap = defaultArg pathMap Map.Empty + let ct = defaultArg ct CancellationToken.None + + let supportsFeature = (LanguageVersion langVersion).SupportsFeature + + let pathMap = + (PathMap.empty, pathMap) + ||> Seq.fold (fun state pair -> state |> PathMap.addMapping pair.Key pair.Value) + + let onToken = + fun tok m -> + let fsTok = FSharpSyntaxToken(tok, m) + match fsTok.Kind with + | FSharpSyntaxTokenKind.None -> () + | _ -> tokenCallback fsTok + + lex text filePath conditionalCompilationDefines flags supportsFeature onToken pathMap ct \ No newline at end of file diff --git a/src/fsharp/service/ServiceLexing.fsi b/src/fsharp/service/ServiceLexing.fsi index b4f24866b9c..d2db4147262 100755 --- a/src/fsharp/service/ServiceLexing.fsi +++ b/src/fsharp/service/ServiceLexing.fsi @@ -4,6 +4,8 @@ namespace FSharp.Compiler.SourceCodeServices open FSharp.Compiler +#nowarn "57" + type Position = int * int type Range = Position * Position @@ -256,3 +258,239 @@ module Keywords = /// Keywords paired with their descriptions. Used in completion and quick info. val KeywordsWithDescription : (string * string) list + +[] +module public Lexer = + + open System + open System.Threading + open FSharp.Compiler.Text + open FSharp.Compiler.Range + + [] + type public FSharpLexerFlags = + | Default = 0x11011 + | LightSyntaxOn = 0x00001 + | Compiling = 0x00010 + | CompilingFSharpCore = 0x00110 + | SkipTrivia = 0x01000 + | UseLexFilter = 0x10000 + + [] + type public FSharpSyntaxTokenKind = + | None + | HashIf + | HashElse + | HashEndIf + | CommentTrivia + | WhitespaceTrivia + | HashLine + | HashLight + | InactiveCode + | LineCommentTrivia + | StringText + | Fixed + | OffsideInterfaceMember + | OffsideBlockEnd + | OffsideRightBlockEnd + | OffsideDeclEnd + | OffsideEnd + | OffsideBlockSep + | OffsideBlockBegin + | OffsideReset + | OffsideFun + | OffsideFunction + | OffsideWith + | OffsideElse + | OffsideThen + | OffsideDoBang + | OffsideDo + | OffsideBinder + | OffsideLet + | HighPrecedenceTypeApp + | HighPrecedenceParenthesisApp + | HighPrecedenceBracketApp + | Extern + | Void + | Public + | Private + | Internal + | Global + | Static + | Member + | Class + | Abstract + | Override + | Default + | Constructor + | Inherit + | GreaterRightBracket + | Struct + | Sig + | Bar + | RightBracket + | RightBrace + | Minus + | Dollar + | BarRightBracket + | BarRightBrace + | Underscore + | Semicolon + | SemicolonSemicolon + | LeftArrow + | Equals + | LeftBracket + | LeftBracketBar + | LeftBraceBar + | LeftBracketLess + | LeftBrace + | QuestionMark + | QuestionMarkQuestionMark + | Dot + | Colon + | ColonColon + | ColonGreater + | ColonQuestionMark + | ColonQuestionMarkGreater + | ColonEquals + | When + | While + | With + | Hash + | Ampersand + | AmpersandAmpersand + | Quote + | LeftParenthesis + | RightParenthesis + | Star + | Comma + | RightArrow + | GreaterBarRightBracket + | LeftParenthesisStarRightParenthesis + | Open + | Or + | Rec + | Then + | To + | True + | Try + | Type + | Val + | Inline + | Interface + | Instance + | Const + | Lazy + | OffsideLazy + | Match + | MatchBang + | Mutable + | New + | Of + | Exception + | False + | For + | Fun + | Function + | If + | In + | JoinIn + | Finally + | DoBang + | And + | As + | Assert + | OffsideAssert + | Begin + | Do + | Done + | DownTo + | Else + | Elif + | End + | DotDot + | DotDotHat + | BarBar + | Upcast + | Downcast + | Null + | Reserved + | Module + | Namespace + | Delegate + | Constraint + | Base + | LeftQuote + | RightQuote + | RightQuoteDot + | PercentOperator + | Binder + | Less + | Greater + | Let + | Yield + | YieldBang + | BigNumber + | Decimal + | Char + | Ieee64 + | Ieee32 + | NativeInt + | UNativeInt + | UInt64 + | UInt32 + | UInt16 + | UInt8 + | Int64 + | Int32 + | Int32DotDot + | Int16 + | Int8 + | FunkyOperatorName + | AdjacentPrefixOperator + | PlusMinusOperator + | InfixAmpersandOperator + | InfixStarDivideModuloOperator + | PrefixOperator + | InfixBarOperator + | InfixAtHatOperator + | InfixCompareOperator + | InfixStarStarOperator + | Identifier + | KeywordString + | String + | ByteArray + | Asr + | InfixAsr + | InfixLand + | InfixLor + | InfixLsl + | InfixLsr + | InfixLxor + | InfixMod + + [] + type public FSharpSyntaxToken = + + val private tok: Parser.token + val private tokRange: range + + member Range: range + + member Kind: FSharpSyntaxTokenKind + + member IsIdentifier: bool + + member IsKeyword: bool + + member IsStringLiteral: bool + + member IsNumericLiteral: bool + + member IsCommentTrivia: bool + + [] + type public FSharpLexer = + + [] + static member Lex: text: ISourceText * tokenCallback: (FSharpSyntaxToken -> unit) * ?langVersion: string * ?filePath: string * ?conditionalCompilationDefines: string list * ?flags: FSharpLexerFlags * ?pathMap: Map * ?ct: CancellationToken -> unit \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs index 9caad878da7..d794a94c5af 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs @@ -5,6 +5,7 @@ namespace Microsoft.VisualStudio.FSharp.Editor open System open System.Composition open System.Collections.Generic +open System.Collections.Immutable open System.Diagnostics open System.Threading open System.Runtime.Caching @@ -21,7 +22,11 @@ open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Classification // IVT, we'll maintain the status quo. #nowarn "44" +#nowarn "57" + +open FSharp.Compiler.Range open FSharp.Compiler.SourceCodeServices +open FSharp.Compiler.SourceCodeServices.Lexer type SemanticClassificationData = (struct(FSharp.Compiler.Range.range * SemanticClassificationType)[]) type SemanticClassificationLookup = IReadOnlyDictionary> @@ -63,6 +68,33 @@ type internal FSharpClassificationService ) = static let userOpName = "SemanticColorization" + static let getLexicalClassifications(filePath: string, defines, text: SourceText, textSpan: TextSpan, ct) = + let result = ImmutableArray.CreateBuilder() + let tokenCallback = + let textRange = RoslynHelpers.TextSpanToFSharpRange(filePath, textSpan, text) + fun (tok: FSharpSyntaxToken) -> + if rangeContainsRange textRange tok.Range then + let spanKind = + if tok.IsKeyword then + ClassificationTypeNames.Keyword + elif tok.IsNumericLiteral then + ClassificationTypeNames.NumericLiteral + elif tok.IsCommentTrivia then + ClassificationTypeNames.Comment + elif tok.IsStringLiteral then + ClassificationTypeNames.StringLiteral + else + ClassificationTypeNames.Text + + match RoslynHelpers.TryFSharpRangeToTextSpan(text, tok.Range) with + | Some span -> result.Add(ClassifiedSpan(spanKind, span)) + | _ -> () + + let flags = FSharpLexerFlags.Default &&& ~~~FSharpLexerFlags.Compiling + FSharpLexer.Lex(text.ToFSharpSourceText(), tokenCallback, langVersion = "preview", filePath = filePath, conditionalCompilationDefines = defines, flags = flags, ct = ct) + + result.ToImmutable() + static let addSemanticClassification sourceText (targetSpan: TextSpan) items (outputResult: List) = for struct(range, classificationType) in items do match RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, range) with @@ -111,17 +143,9 @@ type internal FSharpClassificationService // For closed documents, only get classification for the text within the span. // This may be inaccurate for multi-line tokens such as string literals, but this is ok for now - // as it's better than having to tokenize a big part of a file. - // This is to handle syntactic classification for find all references. + // as it's better than having to tokenize a big part of a file which in return will allocate a lot and hurt find all references performance. if not (document.Project.Solution.Workspace.IsDocumentOpen document.Id) then - let tokenizer = FSharpSourceTokenizer(defines, Some document.FilePath) - let tokenizer = tokenizer.CreateLineTokenizer(sourceText.ToFSharpSourceText()) - let rec scan (state) = - match tokenizer.ScanToken state with - | Some info, state -> - - while - tokenizer.ScanToken(FSharpTokenizerLexState.Initial) + result.AddRange(getLexicalClassifications(document.FilePath, defines, sourceText, textSpan, cancellationToken)) else result.AddRange(Tokenizer.getClassifiedSpans(document.Id, sourceText, textSpan, Some(document.FilePath), defines, cancellationToken)) } |> RoslynHelpers.StartAsyncUnitAsTask cancellationToken From add45b56758f091113abe7b4e7f70f5db4a6508e Mon Sep 17 00:00:00 2001 From: TIHan Date: Mon, 3 Feb 2020 15:01:07 -0800 Subject: [PATCH 10/24] Added System.Memory --- eng/Versions.props | 1 + .../FSharp.Compiler.Service.fsproj | 1 + .../FSharp.Compiler.Private.fsproj | 2 ++ .../FSharp.Compiler.Private.netcore.nuspec | 1 + .../Microsoft.FSharp.Compiler.nuspec | 1 + src/fsharp/service/ServiceLexing.fs | 4 ++- vsintegration/Directory.Build.targets | 1 + .../Classification/ClassificationService.fs | 33 +++++++++---------- 8 files changed, 25 insertions(+), 19 deletions(-) diff --git a/eng/Versions.props b/eng/Versions.props index 1ee1522072d..313a270960f 100644 --- a/eng/Versions.props +++ b/eng/Versions.props @@ -96,6 +96,7 @@ 4.3.0 4.5.0 4.5.0 + 4.5.3 $(RoslynVersion) $(RoslynVersion) diff --git a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index 5a93fe35899..afb14ac2f5b 100644 --- a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -693,6 +693,7 @@ + diff --git a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj index c21ec74332e..90b4b5932d8 100644 --- a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj +++ b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.fsproj @@ -28,6 +28,7 @@ + @@ -757,6 +758,7 @@ + diff --git a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.netcore.nuspec b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.netcore.nuspec index 8f148cf1d7d..110d6781705 100644 --- a/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.netcore.nuspec +++ b/src/fsharp/FSharp.Compiler.Private/FSharp.Compiler.Private.netcore.nuspec @@ -34,6 +34,7 @@ + diff --git a/src/fsharp/FSharp.Compiler.nuget/Microsoft.FSharp.Compiler.nuspec b/src/fsharp/FSharp.Compiler.nuget/Microsoft.FSharp.Compiler.nuspec index c124bcffc21..0bf1fffd894 100644 --- a/src/fsharp/FSharp.Compiler.nuget/Microsoft.FSharp.Compiler.nuspec +++ b/src/fsharp/FSharp.Compiler.nuget/Microsoft.FSharp.Compiler.nuspec @@ -23,6 +23,7 @@ + diff --git a/src/fsharp/service/ServiceLexing.fs b/src/fsharp/service/ServiceLexing.fs index e5f3d336e30..24ca97afb07 100644 --- a/src/fsharp/service/ServiceLexing.fs +++ b/src/fsharp/service/ServiceLexing.fs @@ -1329,7 +1329,9 @@ module Lexer = // virtual // volatile | FSharpSyntaxTokenKind.Reserved - | FSharpSyntaxTokenKind.KeywordString -> true + | FSharpSyntaxTokenKind.KeywordString + | FSharpSyntaxTokenKind.Binder + | FSharpSyntaxTokenKind.OffsideBinder -> true | _ -> false member this.IsIdentifier = diff --git a/vsintegration/Directory.Build.targets b/vsintegration/Directory.Build.targets index cd83837f798..3eb8d6a5df3 100644 --- a/vsintegration/Directory.Build.targets +++ b/vsintegration/Directory.Build.targets @@ -19,6 +19,7 @@ + diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs index d794a94c5af..f6a8e3c4ede 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs @@ -71,27 +71,24 @@ type internal FSharpClassificationService static let getLexicalClassifications(filePath: string, defines, text: SourceText, textSpan: TextSpan, ct) = let result = ImmutableArray.CreateBuilder() let tokenCallback = - let textRange = RoslynHelpers.TextSpanToFSharpRange(filePath, textSpan, text) fun (tok: FSharpSyntaxToken) -> - if rangeContainsRange textRange tok.Range then - let spanKind = - if tok.IsKeyword then - ClassificationTypeNames.Keyword - elif tok.IsNumericLiteral then - ClassificationTypeNames.NumericLiteral - elif tok.IsCommentTrivia then - ClassificationTypeNames.Comment - elif tok.IsStringLiteral then - ClassificationTypeNames.StringLiteral - else - ClassificationTypeNames.Text - - match RoslynHelpers.TryFSharpRangeToTextSpan(text, tok.Range) with - | Some span -> result.Add(ClassifiedSpan(spanKind, span)) - | _ -> () + let spanKind = + if tok.IsKeyword then + ClassificationTypeNames.Keyword + elif tok.IsNumericLiteral then + ClassificationTypeNames.NumericLiteral + elif tok.IsCommentTrivia then + ClassificationTypeNames.Comment + elif tok.IsStringLiteral then + ClassificationTypeNames.StringLiteral + else + ClassificationTypeNames.Text + match RoslynHelpers.TryFSharpRangeToTextSpan(text, tok.Range) with + | Some span -> result.Add(ClassifiedSpan(TextSpan(textSpan.Start + span.Start, span.Length), spanKind)) + | _ -> () let flags = FSharpLexerFlags.Default &&& ~~~FSharpLexerFlags.Compiling - FSharpLexer.Lex(text.ToFSharpSourceText(), tokenCallback, langVersion = "preview", filePath = filePath, conditionalCompilationDefines = defines, flags = flags, ct = ct) + FSharpLexer.Lex(text.GetSubText(textSpan).ToFSharpSourceText(), tokenCallback, langVersion = "preview", filePath = filePath, conditionalCompilationDefines = defines, flags = flags, ct = ct) result.ToImmutable() From 123f652dcde60fb91c8c7b66607ba83606790e2f Mon Sep 17 00:00:00 2001 From: TIHan Date: Mon, 3 Feb 2020 15:46:29 -0800 Subject: [PATCH 11/24] Using Span to check equality without allocating --- src/fsharp/service/ItemKey.fs | 27 +++++++++++++-------------- src/fsharp/service/ServiceLexing.fs | 3 +++ 2 files changed, 16 insertions(+), 14 deletions(-) diff --git a/src/fsharp/service/ItemKey.fs b/src/fsharp/service/ItemKey.fs index c7f6514d350..5263a02ba83 100644 --- a/src/fsharp/service/ItemKey.fs +++ b/src/fsharp/service/ItemKey.fs @@ -29,7 +29,7 @@ type ItemKeyStore(mmf: MemoryMappedFile, length) = // This has to be mutable because BlobReader is a struct and we have to mutate its contents. let mutable reader = BlobReader(viewAccessor.SafeMemoryMappedViewHandle.DangerousGetHandle() |> NativePtr.ofNativeInt, int length) - let readRange () = + member _.ReadRange() = let startLine = reader.ReadInt32() let startColumn = reader.ReadInt32() let endLine = reader.ReadInt32() @@ -40,16 +40,13 @@ type ItemKeyStore(mmf: MemoryMappedFile, length) = let posEnd = mkPos endLine endColumn mkFileIndexRange fileIndex posStart posEnd - let readKeyString () = + member _.ReadKeyString() = let size = reader.ReadInt32() - reader.ReadUTF16 size + let keyString = ReadOnlySpan(reader.CurrentPointer |> NativePtr.toVoidPtr, size) + reader.Offset <- reader.Offset + size + keyString - member _.ReadSingleKeyInfo() = - checkDispose () - - struct(readRange (), readKeyString ()) - - member _.FindAll(item: Item) = + member this.FindAll(item: Item) = checkDispose () let builder = ItemKeyStoreBuilder() @@ -57,18 +54,20 @@ type ItemKeyStore(mmf: MemoryMappedFile, length) = match builder.TryBuildAndReset() with | None -> Seq.empty | Some(singleStore : ItemKeyStore) -> - let struct(_, keyString1) = singleStore.ReadSingleKeyInfo() - (singleStore :> IDisposable).Dispose() + singleStore.ReadRange() |> ignore + let keyString1 = singleStore.ReadKeyString() let results = ResizeArray() reader.Offset <- 0 while reader.Offset < reader.Length do - let m = readRange() - let keyString2 = readKeyString() - if keyString1 = keyString2 then + let m = this.ReadRange() + let keyString2 = this.ReadKeyString() + if keyString1.SequenceEqual keyString2 then results.Add m + (singleStore :> IDisposable).Dispose() + results :> range seq interface IDisposable with diff --git a/src/fsharp/service/ServiceLexing.fs b/src/fsharp/service/ServiceLexing.fs index 24ca97afb07..2f6f5e5b2fd 100644 --- a/src/fsharp/service/ServiceLexing.fs +++ b/src/fsharp/service/ServiceLexing.fs @@ -1384,6 +1384,9 @@ module Lexer = else lexer + use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse + use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) + usingLexbufForParsing (lexbuf, filePath) (fun lexbuf -> while not lexbuf.IsPastEndOfStream do ct.ThrowIfCancellationRequested () From 86fad2bfa6eeb6dd90196ba6d14afefa42c2ba22 Mon Sep 17 00:00:00 2001 From: TIHan Date: Mon, 3 Feb 2020 16:28:03 -0800 Subject: [PATCH 12/24] Allocate less --- src/fsharp/lexhelp.fs | 4 ++-- src/fsharp/lexhelp.fsi | 2 +- src/fsharp/service/ServiceLexing.fs | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/fsharp/lexhelp.fs b/src/fsharp/lexhelp.fs index 6201ec8a41e..b906d534329 100644 --- a/src/fsharp/lexhelp.fs +++ b/src/fsharp/lexhelp.fs @@ -36,8 +36,8 @@ type LightSyntaxStatus(initial:bool,warn:bool) = /// Manage lexer resources (string interning) [] -type LexResourceManager() = - let strings = new System.Collections.Generic.Dictionary(1024) +type LexResourceManager(?capacity: int) = + let strings = new System.Collections.Generic.Dictionary(defaultArg capacity 1024) member x.InternIdentifierToken(s) = match strings.TryGetValue s with | true, res -> res diff --git a/src/fsharp/lexhelp.fsi b/src/fsharp/lexhelp.fsi index bcc1bc3dc8a..330ad564586 100644 --- a/src/fsharp/lexhelp.fsi +++ b/src/fsharp/lexhelp.fsi @@ -25,7 +25,7 @@ type LightSyntaxStatus = [] type LexResourceManager = - new : unit -> LexResourceManager + new : ?capacity: int -> LexResourceManager type lexargs = { defines: string list diff --git a/src/fsharp/service/ServiceLexing.fs b/src/fsharp/service/ServiceLexing.fs index 2f6f5e5b2fd..24dffef2d89 100644 --- a/src/fsharp/service/ServiceLexing.fs +++ b/src/fsharp/service/ServiceLexing.fs @@ -1373,7 +1373,7 @@ module Lexer = let lexbuf = UnicodeLexing.SourceTextAsLexbuf(supportsFeature, text) let lightSyntaxStatus = LightSyntaxStatus(isLightSyntaxOn, true) - let lexargs = mkLexargs (filePath, conditionalCompilationDefines, lightSyntaxStatus, Lexhelp.LexResourceManager(), [], errorLogger, pathMap) + let lexargs = mkLexargs (filePath, conditionalCompilationDefines, lightSyntaxStatus, Lexhelp.LexResourceManager(0), [], errorLogger, pathMap) let lexargs = { lexargs with applyLineDirectives = isCompiling } let getNextToken = From cc3d0710f52cdce8ad8c687db9f6a07250062978 Mon Sep 17 00:00:00 2001 From: TIHan Date: Tue, 4 Feb 2020 12:59:25 -0800 Subject: [PATCH 13/24] Fixing build. Reducing more allocations and not using lex filter on lexing tokens. --- tests/fsharp/core/span/common-pre.fsx | 2 +- .../src/FSharp.Editor/Classification/ClassificationService.fs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/fsharp/core/span/common-pre.fsx b/tests/fsharp/core/span/common-pre.fsx index c6f05de3a5b..184040a556d 100644 --- a/tests/fsharp/core/span/common-pre.fsx +++ b/tests/fsharp/core/span/common-pre.fsx @@ -1,4 +1,4 @@ open System open System.IO -File.WriteAllText("refs.generated.fsx", sprintf @"#r @""%s\.nuget\packages\System.Memory\4.5.2\lib\netstandard2.0\System.Memory.dll""" (Environment.GetEnvironmentVariable("USERPROFILE"))) +File.WriteAllText("refs.generated.fsx", sprintf @"#r @""%s\.nuget\packages\System.Memory\4.5.3\lib\netstandard2.0\System.Memory.dll""" (Environment.GetEnvironmentVariable("USERPROFILE"))) diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs index f6a8e3c4ede..4c8a02c97e1 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs @@ -87,7 +87,7 @@ type internal FSharpClassificationService | Some span -> result.Add(ClassifiedSpan(TextSpan(textSpan.Start + span.Start, span.Length), spanKind)) | _ -> () - let flags = FSharpLexerFlags.Default &&& ~~~FSharpLexerFlags.Compiling + let flags = FSharpLexerFlags.Default &&& ~~~FSharpLexerFlags.Compiling &&& ~~~FSharpLexerFlags.UseLexFilter FSharpLexer.Lex(text.GetSubText(textSpan).ToFSharpSourceText(), tokenCallback, langVersion = "preview", filePath = filePath, conditionalCompilationDefines = defines, flags = flags, ct = ct) result.ToImmutable() From 98453e3dfe5b02afed63fc3e057c7956e7a254c0 Mon Sep 17 00:00:00 2001 From: TIHan Date: Tue, 4 Feb 2020 13:01:25 -0800 Subject: [PATCH 14/24] Remove langversion --- .../src/FSharp.Editor/Classification/ClassificationService.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs index 4c8a02c97e1..7db16e631a3 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs @@ -88,7 +88,7 @@ type internal FSharpClassificationService | _ -> () let flags = FSharpLexerFlags.Default &&& ~~~FSharpLexerFlags.Compiling &&& ~~~FSharpLexerFlags.UseLexFilter - FSharpLexer.Lex(text.GetSubText(textSpan).ToFSharpSourceText(), tokenCallback, langVersion = "preview", filePath = filePath, conditionalCompilationDefines = defines, flags = flags, ct = ct) + FSharpLexer.Lex(text.GetSubText(textSpan).ToFSharpSourceText(), tokenCallback, filePath = filePath, conditionalCompilationDefines = defines, flags = flags, ct = ct) result.ToImmutable() From da7550ba5ef6970c042db5e956837ed778048924 Mon Sep 17 00:00:00 2001 From: TIHan Date: Tue, 4 Feb 2020 13:45:07 -0800 Subject: [PATCH 15/24] Fixed record find all refs --- src/fsharp/service/ItemKey.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/fsharp/service/ItemKey.fs b/src/fsharp/service/ItemKey.fs index 5263a02ba83..6527f72dcad 100644 --- a/src/fsharp/service/ItemKey.fs +++ b/src/fsharp/service/ItemKey.fs @@ -254,6 +254,7 @@ and [] ItemKeyStoreBuilder() = | Item.RecdField info -> writeString "d$" writeEntityRef info.TyconRef + writeString info.Name writeType info.FieldType | Item.AnonRecdField(info, tys, i, _) -> From fb9d5e09bdc569248d149bc1a873509a52d73525 Mon Sep 17 00:00:00 2001 From: TIHan Date: Tue, 4 Feb 2020 15:09:10 -0800 Subject: [PATCH 16/24] Fixing test --- tests/fsharp/typecheck/sigs/neg107-pre.fsx | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/fsharp/typecheck/sigs/neg107-pre.fsx b/tests/fsharp/typecheck/sigs/neg107-pre.fsx index dbe73fd7e5f..c3630f8f452 100644 --- a/tests/fsharp/typecheck/sigs/neg107-pre.fsx +++ b/tests/fsharp/typecheck/sigs/neg107-pre.fsx @@ -1,4 +1,4 @@ open System open System.IO -File.WriteAllText("neg107.generated.fsx", sprintf @"#r @""%s\.nuget\packages\System.Memory\4.5.2\lib\netstandard2.0\System.Memory.dll""" (Environment.GetEnvironmentVariable("USERPROFILE"))) +File.WriteAllText("neg107.generated.fsx", sprintf @"#r @""%s\.nuget\packages\System.Memory\4.5.3\lib\netstandard2.0\System.Memory.dll""" (Environment.GetEnvironmentVariable("USERPROFILE"))) From 03f53047d2e42053f9d8d2a4b4d333d29de69f59 Mon Sep 17 00:00:00 2001 From: TIHan Date: Tue, 4 Feb 2020 16:38:41 -0800 Subject: [PATCH 17/24] Partial match for active pattern --- src/fsharp/service/ItemKey.fs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/fsharp/service/ItemKey.fs b/src/fsharp/service/ItemKey.fs index 6527f72dcad..6cfa8d7b5c9 100644 --- a/src/fsharp/service/ItemKey.fs +++ b/src/fsharp/service/ItemKey.fs @@ -234,16 +234,14 @@ and [] ItemKeyStoreBuilder() = writeString "u$" writeEntityRef info.TyconRef - | Item.ActivePatternResult(info, ty, _, _) -> + | Item.ActivePatternResult(info, _, _, _) -> writeString "r$" info.ActiveTagsWithRanges |> List.iter (fun (nm, _) -> writeString nm) - writeType ty | Item.ActivePatternCase elemRef -> - writeString "c$" - writeValRef elemRef.ActivePatternVal + writeString "r$" elemRef.ActivePatternInfo.ActiveTagsWithRanges |> List.iter (fun (nm, _) -> writeString nm) From 3b6a47f33e7e724740a665f7146af09e998b277a Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 6 Feb 2020 11:00:01 -0800 Subject: [PATCH 18/24] Feedback changes --- src/fsharp/service/ItemKey.fs | 138 ++++++++++++++++++++++++++------- src/fsharp/service/ItemKey.fsi | 2 + 2 files changed, 112 insertions(+), 28 deletions(-) diff --git a/src/fsharp/service/ItemKey.fs b/src/fsharp/service/ItemKey.fs index 6cfa8d7b5c9..e3f2413232d 100644 --- a/src/fsharp/service/ItemKey.fs +++ b/src/fsharp/service/ItemKey.fs @@ -16,13 +16,95 @@ open FSharp.Compiler.AbstractIL.IL #nowarn "9" +/// These tags are used to create unique item key strings to decrease possible key string collisions when the Items are actually completely different. +[] +module ItemKeyTags = + + [] + let entityRef = "#E#" + + [] + let typeTuple = "#T#" + + [] + let typeAnonymousRecord = "#N#" + + [] + let typeFunction = "#F#" + + [] + let typeMeasure = "#M#" + + [] + let typeUnionCase = "#U#" + + [] + let typeMeasureVar = "#p#" + + [] + let typeMeasureCon = "#c#" + + [] + let typeMeasureProd = "#r#" + + [] + let typeMeasureInv = "#i#" + + [] + let typeMeasureOne = "#1#" + + [] + let typeMeasureRationalPower = "#z#" + + [] + let itemValueMember = "m$" + + [] + let itemValue = "v$" + + [] + let itemUnionCase = "u$" + + [] + let itemActivePattern = "r$" + + [] + let itemExnCase = "e$" + + [] + let itemRecordField = "d$" + + [] + let itemAnonymousRecordField = "a$" + + [] + let itemNewDef = "n$" + + [] + let itemILField = "l$" + + [] + let itemEvent = "t$" + + [] + let itemProperty = "p$" + + [] + let itemTypeVar = "y$" + + [] + let itemModuleOrNamespace = "o$" + + [] + let itemDelegateCtor = "g$" + [] type ItemKeyStore(mmf: MemoryMappedFile, length) = let mutable isDisposed = false let checkDispose() = if isDisposed then - raise (ObjectDisposedException("ItemKeyReader")) + raise (ObjectDisposedException("ItemKeyStore")) let viewAccessor = mmf.CreateViewAccessor() @@ -104,7 +186,7 @@ and [] ItemKeyStoreBuilder() = b.WriteInt32(m.FileIndex) let writeEntityRef (eref: EntityRef) = - writeString "#E#" + writeString ItemKeyTags.entityRef writeString eref.CompiledName eref.CompilationPath.MangledPath |> List.iter (fun str -> writeString str) @@ -149,47 +231,47 @@ and [] ItemKeyStoreBuilder() = | TType_app (tcref, _) -> writeEntityRef tcref | TType_tuple (_, tinst) -> - writeString "#T#" + writeString ItemKeyTags.typeTuple tinst |> List.iter writeType | TType_anon (anonInfo, tinst) -> - writeString "#N#" + writeString ItemKeyTags.typeAnonymousRecord writeString anonInfo.ILTypeRef.BasicQualifiedName tinst |> List.iter writeType | TType_fun (d, r) -> - writeString "#F#" + writeString ItemKeyTags.typeFunction writeType d writeType r | TType_measure ms -> - writeString "#M#" + writeString ItemKeyTags.typeMeasure writeMeasure ms | TType_var tp -> writeTypar tp | TType_ucase (uc, _) -> match uc with | UnionCaseRef.UCRef(tcref, nm) -> - writeString "#U#" + writeString ItemKeyTags.typeUnionCase writeEntityRef tcref writeString nm and writeMeasure (ms: Measure) = match ms with | Measure.Var typar -> - writeString "#p#" + writeString ItemKeyTags.typeMeasureVar writeTypar typar | Measure.Con tcref -> - writeString "#c#" + writeString ItemKeyTags.typeMeasureCon writeEntityRef tcref | Measure.Prod(ms1, ms2) -> - writeString "#r#" + writeString ItemKeyTags.typeMeasureProd writeMeasure ms1 writeMeasure ms2 | Measure.Inv ms -> - writeString "#i#" + writeString ItemKeyTags.typeMeasureInv writeMeasure ms | Measure.One -> - writeString "#1#" + writeString ItemKeyTags.typeMeasureOne | Measure.RationalPower _ -> - writeString "#z#" + writeString ItemKeyTags.typeMeasureRationalPower and writeTypar (typar: Typar) = match typar.Solution with @@ -222,67 +304,67 @@ and [] ItemKeyStoreBuilder() = | Item.Value vref -> match vref.MemberInfo with | Some memberInfo -> - writeString "m$" + writeString ItemKeyTags.itemValueMember writeEntityRef memberInfo.ApparentEnclosingEntity writeString vref.LogicalName writeType vref.Type | _ -> - writeString "v$" + writeString ItemKeyTags.itemValue writeValRef vref | Item.UnionCase(info, _) -> - writeString "u$" + writeString ItemKeyTags.typeUnionCase writeEntityRef info.TyconRef | Item.ActivePatternResult(info, _, _, _) -> - writeString "r$" + writeString ItemKeyTags.itemActivePattern info.ActiveTagsWithRanges |> List.iter (fun (nm, _) -> writeString nm) | Item.ActivePatternCase elemRef -> - writeString "r$" + writeString ItemKeyTags.itemActivePattern elemRef.ActivePatternInfo.ActiveTagsWithRanges |> List.iter (fun (nm, _) -> writeString nm) | Item.ExnCase tcref -> - writeString "e$" + writeString ItemKeyTags.itemExnCase writeEntityRef tcref | Item.RecdField info -> - writeString "d$" + writeString ItemKeyTags.itemRecordField writeEntityRef info.TyconRef writeString info.Name writeType info.FieldType | Item.AnonRecdField(info, tys, i, _) -> - writeString "a$" + writeString ItemKeyTags.itemAnonymousRecordField writeString info.ILTypeRef.BasicQualifiedName tys |> List.iter writeType writeInt32 i | Item.NewDef ident -> - writeString "n$" + writeString ItemKeyTags.itemNewDef writeString ident.idText | Item.ILField info -> - writeString "l$" + writeString ItemKeyTags.itemILField writeString info.ILTypeRef.BasicQualifiedName writeString info.FieldName | Item.Event info -> - writeString "t$" + writeString ItemKeyTags.itemEvent writeString info.EventName writeEntityRef info.DeclaringTyconRef | Item.Property(nm, infos) -> - writeString "p$" + writeString ItemKeyTags.itemProperty writeString nm infos |> List.iter (fun info -> writeEntityRef info.DeclaringTyconRef) | Item.TypeVar(nm, typar) -> - writeString "y$" + writeString ItemKeyTags.itemTypeVar writeString nm writeTypar typar @@ -309,7 +391,7 @@ and [] ItemKeyStoreBuilder() = writeString info.LogicalName | Item.ModuleOrNamespaces [x] -> - writeString "o$" + writeString ItemKeyTags.itemModuleOrNamespace x.CompilationPath.DemangledPath |> List.iter (fun x -> writeString x @@ -317,7 +399,7 @@ and [] ItemKeyStoreBuilder() = writeString x.LogicalName | Item.DelegateCtor ty -> - writeString "g$" + writeString ItemKeyTags.itemDelegateCtor writeType ty | Item.MethodGroup _ -> () diff --git a/src/fsharp/service/ItemKey.fsi b/src/fsharp/service/ItemKey.fsi index a33507f7450..be800170cfa 100644 --- a/src/fsharp/service/ItemKey.fsi +++ b/src/fsharp/service/ItemKey.fsi @@ -6,12 +6,14 @@ open System open FSharp.Compiler.Range open FSharp.Compiler.NameResolution +/// Stores a list of item key strings and their ranges in a memory mapped file. [] type internal ItemKeyStore = interface IDisposable member FindAll: Item -> range seq +/// A builder that will build an item key store based on the written Item and its associated range. [] type internal ItemKeyStoreBuilder = From 8291454d11c7e5dc24877f4ea399aeec93806aef Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 6 Feb 2020 13:24:45 -0800 Subject: [PATCH 19/24] Added comment on TcResolutionsExtensions --- src/fsharp/service/SemanticClassification.fsi | 1 + 1 file changed, 1 insertion(+) diff --git a/src/fsharp/service/SemanticClassification.fsi b/src/fsharp/service/SemanticClassification.fsi index 8bae68aabb5..e9dcad0081b 100644 --- a/src/fsharp/service/SemanticClassification.fsi +++ b/src/fsharp/service/SemanticClassification.fsi @@ -20,6 +20,7 @@ type SemanticClassificationType = | Operator | Disposable +/// Extension methods for the TcResolutions type. [] module internal TcResolutionsExtensions = open FSharp.Compiler From eefd1f0b69093b8d8174f2bf166c55cba8ef35b0 Mon Sep 17 00:00:00 2001 From: TIHan Date: Wed, 12 Feb 2020 12:57:22 -0800 Subject: [PATCH 20/24] Creating view accessor when needed in ItemKey. Fixed UnionCase find all refs. --- src/fsharp/service/ItemKey.fs | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/src/fsharp/service/ItemKey.fs b/src/fsharp/service/ItemKey.fs index e3f2413232d..177baacba94 100644 --- a/src/fsharp/service/ItemKey.fs +++ b/src/fsharp/service/ItemKey.fs @@ -106,12 +106,7 @@ type ItemKeyStore(mmf: MemoryMappedFile, length) = if isDisposed then raise (ObjectDisposedException("ItemKeyStore")) - let viewAccessor = mmf.CreateViewAccessor() - - // This has to be mutable because BlobReader is a struct and we have to mutate its contents. - let mutable reader = BlobReader(viewAccessor.SafeMemoryMappedViewHandle.DangerousGetHandle() |> NativePtr.ofNativeInt, int length) - - member _.ReadRange() = + member _.ReadRange(reader: byref) = let startLine = reader.ReadInt32() let startColumn = reader.ReadInt32() let endLine = reader.ReadInt32() @@ -122,12 +117,19 @@ type ItemKeyStore(mmf: MemoryMappedFile, length) = let posEnd = mkPos endLine endColumn mkFileIndexRange fileIndex posStart posEnd - member _.ReadKeyString() = + member _.ReadKeyString(reader: byref) = let size = reader.ReadInt32() 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) + this.ReadRange &reader |> ignore + let bytes = (this.ReadKeyString &reader).ToArray() + ReadOnlySpan.op_Implicit bytes + member this.FindAll(item: Item) = checkDispose () @@ -136,27 +138,27 @@ type ItemKeyStore(mmf: MemoryMappedFile, length) = match builder.TryBuildAndReset() with | None -> Seq.empty | Some(singleStore : ItemKeyStore) -> - singleStore.ReadRange() |> ignore - let keyString1 = singleStore.ReadKeyString() + 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) + reader.Offset <- 0 while reader.Offset < reader.Length do - let m = this.ReadRange() - let keyString2 = this.ReadKeyString() + let m = this.ReadRange &reader + let keyString2 = this.ReadKeyString &reader if keyString1.SequenceEqual keyString2 then results.Add m - (singleStore :> IDisposable).Dispose() - results :> range seq interface IDisposable with member _.Dispose() = isDisposed <- true - viewAccessor.Dispose() mmf.Dispose() and [] ItemKeyStoreBuilder() = @@ -315,6 +317,7 @@ and [] ItemKeyStoreBuilder() = | Item.UnionCase(info, _) -> writeString ItemKeyTags.typeUnionCase writeEntityRef info.TyconRef + writeString info.Name | Item.ActivePatternResult(info, _, _, _) -> writeString ItemKeyTags.itemActivePattern From 851a06108d2236d615de7c8abe02de6a33b20621 Mon Sep 17 00:00:00 2001 From: TIHan Date: Wed, 12 Feb 2020 14:52:50 -0800 Subject: [PATCH 21/24] Added comment on warning --- src/fsharp/service/ServiceLexing.fsi | 1 + 1 file changed, 1 insertion(+) diff --git a/src/fsharp/service/ServiceLexing.fsi b/src/fsharp/service/ServiceLexing.fsi index d2db4147262..5a4504970f8 100755 --- a/src/fsharp/service/ServiceLexing.fsi +++ b/src/fsharp/service/ServiceLexing.fsi @@ -4,6 +4,7 @@ namespace FSharp.Compiler.SourceCodeServices open FSharp.Compiler +// Prevents warnings of experimental APIs within the signature file itself. #nowarn "57" type Position = int * int From c88398c822067a2d7dc045e609d04ec38c918955 Mon Sep 17 00:00:00 2001 From: TIHan Date: Wed, 12 Feb 2020 14:59:09 -0800 Subject: [PATCH 22/24] Added Range.comparer. Moving opens to top of file --- src/fsharp/range.fs | 6 +++ src/fsharp/range.fsi | 3 ++ src/fsharp/service/SemanticClassification.fs | 41 +++++++++---------- src/fsharp/service/SemanticClassification.fsi | 13 +++--- 4 files changed, 36 insertions(+), 27 deletions(-) diff --git a/src/fsharp/range.fs b/src/fsharp/range.fs index 2de5498d551..afc5686ac21 100755 --- a/src/fsharp/range.fs +++ b/src/fsharp/range.fs @@ -5,6 +5,7 @@ module FSharp.Compiler.Range open System open System.IO +open System.Collections.Generic open System.Collections.Concurrent open Microsoft.FSharp.Core.Printf open FSharp.Compiler.AbstractIL.Internal.Library @@ -380,4 +381,9 @@ module Range = let toFileZ (m:range) = m.FileName, toZ m + let comparer = + { new IEqualityComparer with + member _.Equals(x1, x2) = equals x1 x2 + member _.GetHashCode o = o.GetHashCode() } + diff --git a/src/fsharp/range.fsi b/src/fsharp/range.fsi index fdb63ec2a29..172ad32c103 100755 --- a/src/fsharp/range.fsi +++ b/src/fsharp/range.fsi @@ -200,3 +200,6 @@ module Range = /// Convert a range from one-based line counting (used internally in the F# compiler and in F# error messages) to zero-based line counting (used by Visual Studio) val toFileZ : range -> string * Range01 + + /// Equality comparer for range. + val comparer : IEqualityComparer diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index fc42f98ce99..69b010de8f2 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -2,6 +2,25 @@ namespace FSharp.Compiler.SourceCodeServices +open System.Diagnostics +open System.Collections.Generic +open System.Collections.Immutable + +open FSharp.Core.Printf +open FSharp.Compiler.AbstractIL.Internal.Library + +open FSharp.Compiler +open FSharp.Compiler.Range +open FSharp.Compiler.Tast +open FSharp.Compiler.Infos +open FSharp.Compiler.NameResolution +open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Lib +open FSharp.Compiler.PrettyNaming +open FSharp.Compiler.Tastops +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.SourceCodeServices.SymbolHelpers + [] type SemanticClassificationType = | ReferenceType @@ -22,24 +41,6 @@ type SemanticClassificationType = [] module TcResolutionsExtensions = - open System.Diagnostics - open System.Collections.Generic - open System.Collections.Immutable - - open FSharp.Core.Printf - open FSharp.Compiler.AbstractIL.Internal.Library - - open FSharp.Compiler - open FSharp.Compiler.Range - open FSharp.Compiler.Tast - open FSharp.Compiler.Infos - open FSharp.Compiler.NameResolution - open FSharp.Compiler.ErrorLogger - open FSharp.Compiler.Lib - open FSharp.Compiler.PrettyNaming - open FSharp.Compiler.Tastops - open FSharp.Compiler.TcGlobals - open FSharp.Compiler.SourceCodeServices.SymbolHelpers let (|CNR|) (cnr:CapturedNameResolution) = (cnr.Pos, cnr.Item, cnr.ItemOccurence, cnr.DisplayEnv, cnr.NameResolutionEnv, cnr.AccessorDomain, cnr.Range) @@ -106,9 +107,7 @@ module TcResolutionsExtensions = (rfinfo.RecdField.IsMutable && rfinfo.LiteralValue.IsNone) || Tastops.isRefCellTy g rfinfo.RecdField.FormalType - let duplicates = HashSet({ new IEqualityComparer with - member _.Equals(x1, x2) = Range.equals x1 x2 - member _.GetHashCode o = o.GetHashCode() }) + let duplicates = HashSet(Range.comparer) let results = ImmutableArray.CreateBuilder() let inline add m typ = diff --git a/src/fsharp/service/SemanticClassification.fsi b/src/fsharp/service/SemanticClassification.fsi index e9dcad0081b..620b7f0b7b6 100644 --- a/src/fsharp/service/SemanticClassification.fsi +++ b/src/fsharp/service/SemanticClassification.fsi @@ -2,6 +2,13 @@ namespace FSharp.Compiler.SourceCodeServices +open FSharp.Compiler +open FSharp.Compiler.AccessibilityLogic +open FSharp.Compiler.Tastops +open FSharp.Compiler.Range +open FSharp.Compiler.NameResolution +open FSharp.Compiler.TcGlobals + [] type SemanticClassificationType = | ReferenceType @@ -23,12 +30,6 @@ type SemanticClassificationType = /// Extension methods for the TcResolutions type. [] module internal TcResolutionsExtensions = - open FSharp.Compiler - open FSharp.Compiler.AccessibilityLogic - open FSharp.Compiler.Tastops - open FSharp.Compiler.Range - open FSharp.Compiler.NameResolution - open FSharp.Compiler.TcGlobals val (|CNR|) : cnr: CapturedNameResolution -> (pos * Item * ItemOccurence * DisplayEnv * NameResolutionEnv * AccessorDomain * range) From 277e3dbcfc9cc89a36a6516654027b6d97fbed0f Mon Sep 17 00:00:00 2001 From: TIHan Date: Wed, 12 Feb 2020 15:32:22 -0800 Subject: [PATCH 23/24] More feedback changes --- src/fsharp/service/SemanticClassification.fs | 3 +-- src/fsharp/service/SemanticClassification.fsi | 1 + .../FSharp.Editor/Classification/ClassificationService.fs | 5 +++-- 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index 69b010de8f2..519a95ffb8e 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -69,8 +69,7 @@ module TcResolutionsExtensions = 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() + valRefEq g g.nameof_vref vref then Some() else None let (|EnumCaseFieldInfo|_|) (rfinfo : RecdFieldInfo) = diff --git a/src/fsharp/service/SemanticClassification.fsi b/src/fsharp/service/SemanticClassification.fsi index 620b7f0b7b6..068b2059112 100644 --- a/src/fsharp/service/SemanticClassification.fsi +++ b/src/fsharp/service/SemanticClassification.fsi @@ -9,6 +9,7 @@ open FSharp.Compiler.Range open FSharp.Compiler.NameResolution open FSharp.Compiler.TcGlobals +/// A kind that determines what range in a source's text is semantically classified as after type-checking. [] type SemanticClassificationType = | ReferenceType diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs index 7db16e631a3..40d30dfc85a 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs @@ -24,12 +24,13 @@ open Microsoft.CodeAnalysis.ExternalAccess.FSharp.Classification #nowarn "57" +open Microsoft.CodeAnalysis open FSharp.Compiler.Range open FSharp.Compiler.SourceCodeServices open FSharp.Compiler.SourceCodeServices.Lexer type SemanticClassificationData = (struct(FSharp.Compiler.Range.range * SemanticClassificationType)[]) -type SemanticClassificationLookup = IReadOnlyDictionary> +type SemanticClassificationLookup = IReadOnlyDictionary> [] type DocumentCache<'Value when 'Value : not struct>() = @@ -42,7 +43,7 @@ type DocumentCache<'Value when 'Value : not struct>() = match cache.Get(doc.Id.ToString()) with | null -> return ValueNone - | :? (Microsoft.CodeAnalysis.VersionStamp * 'Value) as value -> + | :? (VersionStamp * 'Value) as value -> if fst value = currentVersion then return ValueSome(snd value) else From c0cf59aa048ab5161586d158de45c97c4eca313d Mon Sep 17 00:00:00 2001 From: TIHan Date: Thu, 13 Feb 2020 12:42:31 -0800 Subject: [PATCH 24/24] Added comment on sliding expiration --- .../FSharp.Editor/Classification/ClassificationService.fs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs index 40d30dfc85a..61f297fed7d 100644 --- a/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs +++ b/vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs @@ -34,8 +34,13 @@ type SemanticClassificationLookup = IReadOnlyDictionary] type DocumentCache<'Value when 'Value : not struct>() = + /// Anything under two seconds, the caching stops working, meaning it won't actually cache the item. + /// Two seconds is just enough to keep the data around long enough to handle a flood of a requests asking for the same data + /// in a short period of time. + [] + let slidingExpirationSeconds = 2. let cache = new MemoryCache("fsharp-cache") - let policy = CacheItemPolicy(SlidingExpiration = TimeSpan.FromSeconds 2.) + let policy = CacheItemPolicy(SlidingExpiration = TimeSpan.FromSeconds slidingExpirationSeconds) member _.TryGetValueAsync(doc: Document) = async { let! ct = Async.CancellationToken