Skip to content

Better classification: such colors, much wow #9511

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
cartermp merged 16 commits into from
Jun 23, 2020
Merged

Better classification: such colors, much wow #9511

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
16 commits
Select commit Hold shift + click to select a range
6f870cc
First go at updated classifications
cartermp Jun 19, 2020
8331b39
More complete classification
cartermp Jun 19, 2020
83e706e
More accurate classification that roughly matches glyph computations
cartermp Jun 19, 2020
f5600d7
Proper measure classification and tests
cartermp Jun 19, 2020
682e5b6
remove ze comments
cartermp Jun 19, 2020
dc0507d
Add clarifying comment
cartermp Jun 19, 2020
f2dfd9a
Distinguish property setter args from named argument labels
cartermp Jun 19, 2020
f326cee
Color local values, don't color properties and property-like things t…
cartermp Jun 20, 2020
eab3c6f
Dont't do the dumb
cartermp Jun 20, 2020
2a09305
We can't distinguish between params and locals right now
cartermp Jun 20, 2020
890767d
Updates per feedback from myself
cartermp Jun 21, 2020
540fe2e
do discards right
cartermp Jun 22, 2020
6a014df
Accessible colors for disposables + some fixes
cartermp Jun 22, 2020
a0fafc4
Remove exports for things we don't do anymore
cartermp Jun 22, 2020
9f55d34
Softer green
cartermp Jun 22, 2020
f79767c
Reduce diff
cartermp Jun 23, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
262 changes: 213 additions & 49 deletions src/fsharp/service/SemanticClassification.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,6 @@ open FSharp.Compiler
open FSharp.Compiler.AbstractIL.Internal.Library
open FSharp.Compiler.Infos
open FSharp.Compiler.ErrorLogger
open FSharp.Compiler.Lib
open FSharp.Compiler.NameResolution
open FSharp.Compiler.PrettyNaming
open FSharp.Compiler.Range
Expand All @@ -24,30 +23,47 @@ type SemanticClassificationType =
| ReferenceType
| ValueType
| UnionCase
| UnionCaseField
| Function
| Property
| MutableVar
| Module
| NameSpace
| Printf
| ComputationExpression
| IntrinsicFunction
| Enumeration
| Interface
| TypeArgument
| Operator
| Disposable
| DisposableType
| DisposableValue
| Method
| ExtensionMethod
| ConstructorForReferenceType
| ConstructorForValueType
| Literal
| RecordField
| MutableRecordField
| RecordFieldAsFunction
| Exception
| Field
| Event
| Delegate
| NamedArgument
| Value
| LocalValue
| Type
| TypeDef

[<AutoOpen>]
module TcResolutionsExtensions =

let (|CNR|) (cnr:CapturedNameResolution) =
(cnr.Item, cnr.ItemOccurence, cnr.DisplayEnv, cnr.NameResolutionEnv, cnr.AccessorDomain, cnr.Range)

type TcResolutions with

member sResolutions.GetSemanticClassification(g: TcGlobals, amap: Import.ImportMap, formatSpecifierLocations: (range * int) [], range: range option) : struct(range * SemanticClassificationType) [] =
ErrorScope.Protect Range.range0
(fun () ->
ErrorScope.Protect Range.range0 (fun () ->
let (|LegitTypeOccurence|_|) = function
| ItemOccurence.UseInType
| ItemOccurence.UseInAttribute
Expand All @@ -56,18 +72,13 @@ module TcResolutionsExtensions =
| 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()
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) =
Expand All @@ -87,7 +98,15 @@ module TcResolutionsExtensions =
sResolutions.CapturedNameResolutions :> seq<_>

let isDisposableTy (ty: TType) =
not (typeEquiv g ty g.system_IDisposable_ty) &&
protectAssemblyExplorationNoReraise false false (fun () -> Infos.ExistsHeadTypeInEntireHierarchy g amap range0 ty g.tcref_System_IDisposable)

let isDiscard (str: string) = str.StartsWith("_")

let isValRefDisposable (vref: ValRef) =
not (isDiscard vref.DisplayName) &&
// For values, we actually do want to color things if they literally are IDisposables
protectAssemblyExplorationNoReraise false false (fun () -> Infos.ExistsHeadTypeInEntireHierarchy g amap range0 vref.Type g.tcref_System_IDisposable)

let isStructTyconRef (tyconRef: TyconRef) =
let ty = generalizedTyconRef tyconRef
Expand Down Expand Up @@ -116,61 +135,206 @@ module TcResolutionsExtensions =
// '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 vref.IsMember then
add m SemanticClassificationType.Method
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.Value vref), _, _, _, _, m ->
if isValRefDisposable vref then
add m SemanticClassificationType.DisposableValue
elif Option.isSome vref.LiteralValue then
add m SemanticClassificationType.Literal
elif not vref.IsCompiledAsTopLevel && not(isDiscard vref.DisplayName) then
add m SemanticClassificationType.LocalValue
else
add m SemanticClassificationType.Value

| Item.RecdField rfinfo, _, _, _, _, m ->
match rfinfo with
| EnumCaseFieldInfo ->
add m SemanticClassificationType.Enumeration
| _ ->
if isRecdFieldMutable rfinfo then
add m SemanticClassificationType.MutableRecordField
elif isFunTy g rfinfo.FieldType then
add m SemanticClassificationType.RecordFieldAsFunction
else
add m SemanticClassificationType.RecordField

| Item.AnonRecdField(_, tys, idx, m), _, _, _, _, _ ->
let ty = tys.[idx]

// It's not currently possible for anon record fields to be mutable, but they can be ref cells
if isRefCellTy g ty then
add m SemanticClassificationType.MutableRecordField
elif isFunTy g ty then
add m SemanticClassificationType.RecordFieldAsFunction
else
add m SemanticClassificationType.RecordField

| Item.Property (_, pinfo :: _), _, _, _, _, m ->
if not pinfo.IsIndexer then
add m SemanticClassificationType.Property

| Item.CtorGroup (_, minfos), _, _, _, _, m ->
if minfos |> List.forall (fun minfo -> isDisposableTy minfo.ApparentEnclosingType) then
add m SemanticClassificationType.DisposableType
elif minfos |> List.forall (fun minfo -> isStructTy g minfo.ApparentEnclosingType) then
add m SemanticClassificationType.ConstructorForValueType
else
add m SemanticClassificationType.ConstructorForReferenceType

| (Item.DelegateCtor _ | Item.FakeInterfaceCtor _), _, _, _, _, m ->
add m SemanticClassificationType.ConstructorForReferenceType

| Item.MethodGroup (_, minfos, _), _, _, _, _, m ->
if minfos |> List.forall (fun minfo -> minfo.IsExtensionMember || minfo.IsCSharpStyleExtensionMember) then
add m SemanticClassificationType.ExtensionMethod
else
add m SemanticClassificationType.Method

| (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

// Special case measures for struct types
| 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.Types (_, ty :: _), LegitTypeOccurence, _, _, _, m ->
let reprToClassificationType repr tcref =
match repr with
| TFSharpObjectRepr om ->
match om.fsobjmodel_kind with
| TTyconClass -> SemanticClassificationType.ReferenceType
| TTyconInterface -> SemanticClassificationType.Interface
| TTyconStruct -> SemanticClassificationType.ValueType
| TTyconDelegate _ -> SemanticClassificationType.Delegate
| TTyconEnum _ -> SemanticClassificationType.Enumeration
| TRecdRepr _
| TUnionRepr _ ->
if isStructTyconRef tcref then
SemanticClassificationType.ValueType
else
SemanticClassificationType.Type
| TILObjectRepr (TILObjectReprData (_, _, td)) ->
if td.IsClass then
SemanticClassificationType.ReferenceType
elif td.IsStruct then
SemanticClassificationType.ValueType
elif td.IsInterface then
SemanticClassificationType.Interface
elif td.IsEnum then
SemanticClassificationType.Enumeration
else
SemanticClassificationType.Delegate
| TAsmRepr _ -> SemanticClassificationType.TypeDef
| TMeasureableRepr _-> SemanticClassificationType.TypeDef
#if !NO_EXTENSIONTYPING
| TProvidedTypeExtensionPoint _-> SemanticClassificationType.TypeDef
| TProvidedNamespaceExtensionPoint _-> SemanticClassificationType.TypeDef
#endif
| TNoRepr -> SemanticClassificationType.ReferenceType

let ty = stripTyEqns g ty
if isDisposableTy ty then
add m SemanticClassificationType.DisposableType
else
match tryTcrefOfAppTy g ty with
| ValueSome tcref ->
add m (reprToClassificationType tcref.TypeReprInfo tcref)
| ValueNone ->
if isStructTupleTy g ty then
add m SemanticClassificationType.ValueType
elif isRefTupleTy g ty then
add m SemanticClassificationType.ReferenceType
elif isFunction g ty then
add m SemanticClassificationType.Function
elif isTyparTy g ty then
add m SemanticClassificationType.ValueType
else
add m SemanticClassificationType.TypeDef

| (Item.TypeVar _ ), LegitTypeOccurence, _, _, _, m ->
add m SemanticClassificationType.TypeArgument
| Item.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
add m SemanticClassificationType.Exception

| Item.ModuleOrNamespaces (modref :: _), LegitTypeOccurence, _, _, _, m ->
if modref.IsNamespace then
add m SemanticClassificationType.NameSpace
else
add m SemanticClassificationType.Module

| (Item.ActivePatternCase _ | Item.UnionCase _ | Item.ActivePatternResult _), _, _, _, _, m ->
add m SemanticClassificationType.UnionCase
| _ -> ())

| Item.UnionCaseField _, _, _, _, _, m ->
add m SemanticClassificationType.UnionCaseField

| Item.ILField _, _, _, _, _, m ->
add m SemanticClassificationType.Field

| Item.Event _, _, _, _, _, m ->
add m SemanticClassificationType.Event

| (Item.ArgName _ | Item.SetterArg _), _, _, _, _, m ->
add m SemanticClassificationType.NamedArgument

| Item.SetterArg _, _, _, _, _, m ->
add m SemanticClassificationType.Property

| Item.UnqualifiedType (tcref :: _), LegitTypeOccurence, _, _, _, m ->
if tcref.IsEnumTycon || tcref.IsILEnumTycon then
add m SemanticClassificationType.Enumeration
elif tcref.IsExceptionDecl then
add m SemanticClassificationType.Exception
elif tcref.IsFSharpDelegateTycon then
add m SemanticClassificationType.Delegate
elif tcref.IsFSharpInterfaceTycon then
add m SemanticClassificationType.Interface
elif tcref.IsFSharpStructOrEnumTycon then
add m SemanticClassificationType.ValueType
elif tcref.IsModule then
add m SemanticClassificationType.Module
elif tcref.IsNamespace then
add m SemanticClassificationType.NameSpace
elif tcref.IsUnionTycon || tcref.IsRecordTycon then
if isStructTyconRef tcref then
add m SemanticClassificationType.ValueType
else
add m SemanticClassificationType.UnionCase
elif tcref.IsILTycon then
let (TILObjectReprData (_, _, tydef)) = tcref.ILTyconInfo

if tydef.IsInterface then
add m SemanticClassificationType.Interface
elif tydef.IsDelegate then
add m SemanticClassificationType.Delegate
elif tydef.IsEnum then
add m SemanticClassificationType.Enumeration
elif tydef.IsStruct then
add m SemanticClassificationType.ValueType
else
add m SemanticClassificationType.ReferenceType

| _ ->
())
results.AddRange(formatSpecifierLocations |> Array.map (fun (m, _) -> struct(m, SemanticClassificationType.Printf)))
results.ToArray()
)
Expand Down
Loading