Skip to content

Commit 4456e0a

Browse files
cartermpcartermp
authored
Better classification: such colors, much wow (#9511)
* First go at updated classifications * More complete classification * More accurate classification that roughly matches glyph computations * Proper measure classification and tests * remove ze comments * Add clarifying comment * Distinguish property setter args from named argument labels * Color local values, don't color properties and property-like things that way * Dont't do the dumb * We can't distinguish between params and locals right now * Updates per feedback from myself * do discards right * Accessible colors for disposables + some fixes * Remove exports for things we don't do anymore * Softer green * Reduce diff
1 parent 3a067f4 commit 4456e0a

4 files changed

Lines changed: 286 additions & 136 deletions

File tree

‎src/fsharp/service/SemanticClassification.fs‎

Lines changed: 213 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,6 @@ open FSharp.Compiler
1010
open FSharp.Compiler.AbstractIL.Internal.Library
1111
open FSharp.Compiler.Infos
1212
open FSharp.Compiler.ErrorLogger
13-
open FSharp.Compiler.Lib
1413
open FSharp.Compiler.NameResolution
1514
open FSharp.Compiler.PrettyNaming
1615
open FSharp.Compiler.Range
@@ -24,30 +23,47 @@ type SemanticClassificationType =
2423
| ReferenceType
2524
| ValueType
2625
| UnionCase
26+
| UnionCaseField
2727
| Function
2828
| Property
2929
| MutableVar
3030
| Module
31+
| NameSpace
3132
| Printf
3233
| ComputationExpression
3334
| IntrinsicFunction
3435
| Enumeration
3536
| Interface
3637
| TypeArgument
3738
| Operator
38-
| Disposable
39+
| DisposableType
40+
| DisposableValue
41+
| Method
42+
| ExtensionMethod
43+
| ConstructorForReferenceType
44+
| ConstructorForValueType
45+
| Literal
46+
| RecordField
47+
| MutableRecordField
48+
| RecordFieldAsFunction
49+
| Exception
50+
| Field
51+
| Event
52+
| Delegate
53+
| NamedArgument
54+
| Value
55+
| LocalValue
56+
| Type
57+
| TypeDef
3958

4059
[<AutoOpen>]
4160
module TcResolutionsExtensions =
42-
4361
let (|CNR|) (cnr:CapturedNameResolution) =
4462
(cnr.Item, cnr.ItemOccurence, cnr.DisplayEnv, cnr.NameResolutionEnv, cnr.AccessorDomain, cnr.Range)
4563

4664
type TcResolutions with
47-
4865
member sResolutions.GetSemanticClassification(g: TcGlobals, amap: Import.ImportMap, formatSpecifierLocations: (range * int) [], range: range option) : struct(range * SemanticClassificationType) [] =
49-
ErrorScope.Protect Range.range0
50-
(fun () ->
66+
ErrorScope.Protect Range.range0 (fun () ->
5167
let (|LegitTypeOccurence|_|) = function
5268
| ItemOccurence.UseInType
5369
| ItemOccurence.UseInAttribute
@@ -56,18 +72,13 @@ module TcResolutionsExtensions =
5672
| ItemOccurence.Pattern _ -> Some()
5773
| _ -> None
5874

59-
let (|OptionalArgumentAttribute|_|) ttype =
60-
match ttype with
61-
| TType.TType_app(tref, _) when tref.Stamp = g.attrib_OptionalArgumentAttribute.TyconRef.Stamp -> Some()
62-
| _ -> None
63-
6475
let (|KeywordIntrinsicValue|_|) (vref: ValRef) =
6576
if valRefEq g g.raise_vref vref ||
66-
valRefEq g g.reraise_vref vref ||
67-
valRefEq g g.typeof_vref vref ||
68-
valRefEq g g.typedefof_vref vref ||
69-
valRefEq g g.sizeof_vref vref ||
70-
valRefEq g g.nameof_vref vref then Some()
77+
valRefEq g g.reraise_vref vref ||
78+
valRefEq g g.typeof_vref vref ||
79+
valRefEq g g.typedefof_vref vref ||
80+
valRefEq g g.sizeof_vref vref ||
81+
valRefEq g g.nameof_vref vref then Some()
7182
else None
7283

7384
let (|EnumCaseFieldInfo|_|) (rfinfo : RecdFieldInfo) =
@@ -87,7 +98,15 @@ module TcResolutionsExtensions =
8798
sResolutions.CapturedNameResolutions :> seq<_>
8899

89100
let isDisposableTy (ty: TType) =
101+
not (typeEquiv g ty g.system_IDisposable_ty) &&
90102
protectAssemblyExplorationNoReraise false false (fun () -> Infos.ExistsHeadTypeInEntireHierarchy g amap range0 ty g.tcref_System_IDisposable)
103+
104+
let isDiscard (str: string) = str.StartsWith("_")
105+
106+
let isValRefDisposable (vref: ValRef) =
107+
not (isDiscard vref.DisplayName) &&
108+
// For values, we actually do want to color things if they literally are IDisposables
109+
protectAssemblyExplorationNoReraise false false (fun () -> Infos.ExistsHeadTypeInEntireHierarchy g amap range0 vref.Type g.tcref_System_IDisposable)
91110

92111
let isStructTyconRef (tyconRef: TyconRef) =
93112
let ty = generalizedTyconRef tyconRef
@@ -116,61 +135,206 @@ module TcResolutionsExtensions =
116135
// 'seq' in 'seq { ... }' gets colored as keywords
117136
| (Item.Value vref), ItemOccurence.Use, _, _, _, m when valRefEq g g.seq_vref vref ->
118137
add m SemanticClassificationType.ComputationExpression
138+
119139
| (Item.Value vref), _, _, _, _, m when isValRefMutable vref ->
120140
add m SemanticClassificationType.MutableVar
141+
121142
| Item.Value KeywordIntrinsicValue, ItemOccurence.Use, _, _, _, m ->
122143
add m SemanticClassificationType.IntrinsicFunction
144+
123145
| (Item.Value vref), _, _, _, _, m when isFunction g vref.Type ->
124146
if valRefEq g g.range_op_vref vref || valRefEq g g.range_step_op_vref vref then
125147
()
126148
elif vref.IsPropertyGetterMethod || vref.IsPropertySetterMethod then
127149
add m SemanticClassificationType.Property
150+
elif vref.IsMember then
151+
add m SemanticClassificationType.Method
128152
elif IsOperatorName vref.DisplayName then
129153
add m SemanticClassificationType.Operator
130154
else
131155
add m SemanticClassificationType.Function
132-
| Item.RecdField rfinfo, _, _, _, _, m when isRecdFieldMutable rfinfo ->
133-
add m SemanticClassificationType.MutableVar
134-
| Item.RecdField rfinfo, _, _, _, _, m when isFunction g rfinfo.FieldType ->
135-
add m SemanticClassificationType.Function
136-
| Item.RecdField EnumCaseFieldInfo, _, _, _, _, m ->
137-
add m SemanticClassificationType.Enumeration
138-
| Item.MethodGroup _, _, _, _, _, m ->
139-
add m SemanticClassificationType.Function
140-
// custom builders, custom operations get colored as keywords
156+
157+
| (Item.Value vref), _, _, _, _, m ->
158+
if isValRefDisposable vref then
159+
add m SemanticClassificationType.DisposableValue
160+
elif Option.isSome vref.LiteralValue then
161+
add m SemanticClassificationType.Literal
162+
elif not vref.IsCompiledAsTopLevel && not(isDiscard vref.DisplayName) then
163+
add m SemanticClassificationType.LocalValue
164+
else
165+
add m SemanticClassificationType.Value
166+
167+
| Item.RecdField rfinfo, _, _, _, _, m ->
168+
match rfinfo with
169+
| EnumCaseFieldInfo ->
170+
add m SemanticClassificationType.Enumeration
171+
| _ ->
172+
if isRecdFieldMutable rfinfo then
173+
add m SemanticClassificationType.MutableRecordField
174+
elif isFunTy g rfinfo.FieldType then
175+
add m SemanticClassificationType.RecordFieldAsFunction
176+
else
177+
add m SemanticClassificationType.RecordField
178+
179+
| Item.AnonRecdField(_, tys, idx, m), _, _, _, _, _ ->
180+
let ty = tys.[idx]
181+
182+
// It's not currently possible for anon record fields to be mutable, but they can be ref cells
183+
if isRefCellTy g ty then
184+
add m SemanticClassificationType.MutableRecordField
185+
elif isFunTy g ty then
186+
add m SemanticClassificationType.RecordFieldAsFunction
187+
else
188+
add m SemanticClassificationType.RecordField
189+
190+
| Item.Property (_, pinfo :: _), _, _, _, _, m ->
191+
if not pinfo.IsIndexer then
192+
add m SemanticClassificationType.Property
193+
194+
| Item.CtorGroup (_, minfos), _, _, _, _, m ->
195+
if minfos |> List.forall (fun minfo -> isDisposableTy minfo.ApparentEnclosingType) then
196+
add m SemanticClassificationType.DisposableType
197+
elif minfos |> List.forall (fun minfo -> isStructTy g minfo.ApparentEnclosingType) then
198+
add m SemanticClassificationType.ConstructorForValueType
199+
else
200+
add m SemanticClassificationType.ConstructorForReferenceType
201+
202+
| (Item.DelegateCtor _ | Item.FakeInterfaceCtor _), _, _, _, _, m ->
203+
add m SemanticClassificationType.ConstructorForReferenceType
204+
205+
| Item.MethodGroup (_, minfos, _), _, _, _, _, m ->
206+
if minfos |> List.forall (fun minfo -> minfo.IsExtensionMember || minfo.IsCSharpStyleExtensionMember) then
207+
add m SemanticClassificationType.ExtensionMethod
208+
else
209+
add m SemanticClassificationType.Method
210+
141211
| (Item.CustomBuilder _ | Item.CustomOperation _), ItemOccurence.Use, _, _, _, m ->
142212
add m SemanticClassificationType.ComputationExpression
143-
// types get colored as types when they occur in syntactic types or custom attributes
144-
// type variables get colored as types when they occur in syntactic types custom builders, custom operations get colored as keywords
145-
| Item.Types (_, [OptionalArgumentAttribute]), LegitTypeOccurence, _, _, _, _ -> ()
146-
| Item.CtorGroup(_, [MethInfo.FSMeth(_, OptionalArgumentAttribute, _, _)]), LegitTypeOccurence, _, _, _, _ -> ()
147-
| Item.Types(_, types), LegitTypeOccurence, _, _, _, m when types |> List.exists (isInterfaceTy g) ->
148-
add m SemanticClassificationType.Interface
149-
| Item.Types(_, types), LegitTypeOccurence, _, _, _, m when types |> List.exists (isStructTy g) ->
150-
add m SemanticClassificationType.ValueType
213+
214+
// Special case measures for struct types
151215
| Item.Types(_, TType_app(tyconRef, TType_measure _ :: _) :: _), LegitTypeOccurence, _, _, _, m when isStructTyconRef tyconRef ->
152216
add m SemanticClassificationType.ValueType
153-
| Item.Types(_, types), LegitTypeOccurence, _, _, _, m when types |> List.exists isDisposableTy ->
154-
add m SemanticClassificationType.Disposable
155-
| Item.Types _, LegitTypeOccurence, _, _, _, m ->
156-
add m SemanticClassificationType.ReferenceType
217+
218+
| Item.Types (_, ty :: _), LegitTypeOccurence, _, _, _, m ->
219+
let reprToClassificationType repr tcref =
220+
match repr with
221+
| TFSharpObjectRepr om ->
222+
match om.fsobjmodel_kind with
223+
| TTyconClass -> SemanticClassificationType.ReferenceType
224+
| TTyconInterface -> SemanticClassificationType.Interface
225+
| TTyconStruct -> SemanticClassificationType.ValueType
226+
| TTyconDelegate _ -> SemanticClassificationType.Delegate
227+
| TTyconEnum _ -> SemanticClassificationType.Enumeration
228+
| TRecdRepr _
229+
| TUnionRepr _ ->
230+
if isStructTyconRef tcref then
231+
SemanticClassificationType.ValueType
232+
else
233+
SemanticClassificationType.Type
234+
| TILObjectRepr (TILObjectReprData (_, _, td)) ->
235+
if td.IsClass then
236+
SemanticClassificationType.ReferenceType
237+
elif td.IsStruct then
238+
SemanticClassificationType.ValueType
239+
elif td.IsInterface then
240+
SemanticClassificationType.Interface
241+
elif td.IsEnum then
242+
SemanticClassificationType.Enumeration
243+
else
244+
SemanticClassificationType.Delegate
245+
| TAsmRepr _ -> SemanticClassificationType.TypeDef
246+
| TMeasureableRepr _-> SemanticClassificationType.TypeDef
247+
#if !NO_EXTENSIONTYPING
248+
| TProvidedTypeExtensionPoint _-> SemanticClassificationType.TypeDef
249+
| TProvidedNamespaceExtensionPoint _-> SemanticClassificationType.TypeDef
250+
#endif
251+
| TNoRepr -> SemanticClassificationType.ReferenceType
252+
253+
let ty = stripTyEqns g ty
254+
if isDisposableTy ty then
255+
add m SemanticClassificationType.DisposableType
256+
else
257+
match tryTcrefOfAppTy g ty with
258+
| ValueSome tcref ->
259+
add m (reprToClassificationType tcref.TypeReprInfo tcref)
260+
| ValueNone ->
261+
if isStructTupleTy g ty then
262+
add m SemanticClassificationType.ValueType
263+
elif isRefTupleTy g ty then
264+
add m SemanticClassificationType.ReferenceType
265+
elif isFunction g ty then
266+
add m SemanticClassificationType.Function
267+
elif isTyparTy g ty then
268+
add m SemanticClassificationType.ValueType
269+
else
270+
add m SemanticClassificationType.TypeDef
271+
157272
| (Item.TypeVar _ ), LegitTypeOccurence, _, _, _, m ->
158273
add m SemanticClassificationType.TypeArgument
159-
| Item.UnqualifiedType tyconRefs, LegitTypeOccurence, _, _, _, m ->
160-
if tyconRefs |> List.exists (fun tyconRef -> tyconRef.Deref.IsStructOrEnumTycon) then
161-
add m SemanticClassificationType.ValueType
162-
else add m SemanticClassificationType.ReferenceType
163-
| Item.CtorGroup(_, minfos), LegitTypeOccurence, _, _, _, m ->
164-
if minfos |> List.exists (fun minfo -> isStructTy g minfo.ApparentEnclosingType) then
165-
add m SemanticClassificationType.ValueType
166-
else add m SemanticClassificationType.ReferenceType
274+
167275
| Item.ExnCase _, LegitTypeOccurence, _, _, _, m ->
168-
add m SemanticClassificationType.ReferenceType
169-
| Item.ModuleOrNamespaces refs, LegitTypeOccurence, _, _, _, m when refs |> List.exists (fun x -> x.IsModule) ->
170-
add m SemanticClassificationType.Module
276+
add m SemanticClassificationType.Exception
277+
278+
| Item.ModuleOrNamespaces (modref :: _), LegitTypeOccurence, _, _, _, m ->
279+
if modref.IsNamespace then
280+
add m SemanticClassificationType.NameSpace
281+
else
282+
add m SemanticClassificationType.Module
283+
171284
| (Item.ActivePatternCase _ | Item.UnionCase _ | Item.ActivePatternResult _), _, _, _, _, m ->
172285
add m SemanticClassificationType.UnionCase
173-
| _ -> ())
286+
287+
| Item.UnionCaseField _, _, _, _, _, m ->
288+
add m SemanticClassificationType.UnionCaseField
289+
290+
| Item.ILField _, _, _, _, _, m ->
291+
add m SemanticClassificationType.Field
292+
293+
| Item.Event _, _, _, _, _, m ->
294+
add m SemanticClassificationType.Event
295+
296+
| (Item.ArgName _ | Item.SetterArg _), _, _, _, _, m ->
297+
add m SemanticClassificationType.NamedArgument
298+
299+
| Item.SetterArg _, _, _, _, _, m ->
300+
add m SemanticClassificationType.Property
301+
302+
| Item.UnqualifiedType (tcref :: _), LegitTypeOccurence, _, _, _, m ->
303+
if tcref.IsEnumTycon || tcref.IsILEnumTycon then
304+
add m SemanticClassificationType.Enumeration
305+
elif tcref.IsExceptionDecl then
306+
add m SemanticClassificationType.Exception
307+
elif tcref.IsFSharpDelegateTycon then
308+
add m SemanticClassificationType.Delegate
309+
elif tcref.IsFSharpInterfaceTycon then
310+
add m SemanticClassificationType.Interface
311+
elif tcref.IsFSharpStructOrEnumTycon then
312+
add m SemanticClassificationType.ValueType
313+
elif tcref.IsModule then
314+
add m SemanticClassificationType.Module
315+
elif tcref.IsNamespace then
316+
add m SemanticClassificationType.NameSpace
317+
elif tcref.IsUnionTycon || tcref.IsRecordTycon then
318+
if isStructTyconRef tcref then
319+
add m SemanticClassificationType.ValueType
320+
else
321+
add m SemanticClassificationType.UnionCase
322+
elif tcref.IsILTycon then
323+
let (TILObjectReprData (_, _, tydef)) = tcref.ILTyconInfo
324+
325+
if tydef.IsInterface then
326+
add m SemanticClassificationType.Interface
327+
elif tydef.IsDelegate then
328+
add m SemanticClassificationType.Delegate
329+
elif tydef.IsEnum then
330+
add m SemanticClassificationType.Enumeration
331+
elif tydef.IsStruct then
332+
add m SemanticClassificationType.ValueType
333+
else
334+
add m SemanticClassificationType.ReferenceType
335+
336+
| _ ->
337+
())
174338
results.AddRange(formatSpecifierLocations |> Array.map (fun (m, _) -> struct(m, SemanticClassificationType.Printf)))
175339
results.ToArray()
176340
)

0 commit comments

Comments
 (0)