diff --git a/analysis/src/SemanticTokens.ml b/analysis/src/SemanticTokens.ml index bb1f0d822..7c64836ce 100644 --- a/analysis/src/SemanticTokens.ml +++ b/analysis/src/SemanticTokens.ml @@ -28,6 +28,7 @@ module Token = struct | EnumMember (** variant A or poly variant #A *) | Property (** {x:...} *) | JsxLowercase (** div in
*) + | Function let tokenTypeToString = function | Operator -> "0" @@ -38,6 +39,7 @@ module Token = struct | EnumMember -> "5" | Property -> "6" | JsxLowercase -> "7" + | Function -> "8" let tokenTypeDebug = function | Operator -> "Operator" @@ -48,21 +50,26 @@ module Token = struct | EnumMember -> "EnumMember" | Property -> "Property" | JsxLowercase -> "JsxLowercase" + | Function -> "Function" let tokenModifiersString = "0" (* None at the moment *) - type token = int * int * int * tokenType - type emitter = { - mutable tokens: token list; + mutable tokens: (int * int * tokenType, int) Hashtbl.t; mutable lastLine: int; mutable lastChar: int; } - let createEmitter () = {tokens = []; lastLine = 0; lastChar = 0} + let createEmitter () = + {tokens = Hashtbl.create 10; lastLine = 0; lastChar = 0} let add ~line ~char ~length ~type_ e = - e.tokens <- (line, char, length, type_) :: e.tokens + match type_ with + | Variable -> ( + match Hashtbl.find_opt e.tokens (line, char, Function) with + | Some _ -> () + | None -> Hashtbl.add e.tokens (line, char, type_) length) + | _ -> Hashtbl.add e.tokens (line, char, type_) length let emitToken buf (line, char, length, type_) e = let deltaLine = line - e.lastLine in @@ -80,8 +87,14 @@ module Token = struct ^ tokenModifiersString) let emit e = + let list = + Hashtbl.fold + (fun (line, char, token) length acc -> + (line, char, length, token) :: acc) + e.tokens [] + in let sortedTokens = - e.tokens + list |> List.sort (fun (l1, c1, _, _) (l2, c2, _, _) -> if l1 = l2 then compare c1 c2 else compare l1 l2) in @@ -115,8 +128,8 @@ let emitFromLoc ~loc ~type_ emitter = let emitLongident ?(backwards = false) ?(jsx = false) ?(lowerCaseToken = if jsx then Token.JsxLowercase else Token.Variable) - ?(upperCaseToken = Token.Namespace) ?(lastToken = None) ?(posEnd = None) ~pos - ~lid ~debug emitter = + ?(upperCaseToken = Token.Namespace) ?(lastToken = None) ?(posEnd = None) + ~pos ~lid ~debug emitter = let rec flatten acc lid = match lid with | Longident.Lident txt -> txt :: acc @@ -307,6 +320,17 @@ let command ~debug ~emitter ~path = Printf.printf "Binary operator %s %s\n" op (Loc.toString loc); emitter |> emitFromLoc ~loc ~type_:Operator; Ast_iterator.default_iterator.expr iterator e + | Pexp_apply ({pexp_desc = Pexp_ident {txt = lid; loc}}, _) + when Longident.Lident "|." <> lid -> + emitter + |> emitLongident ~pos:(Loc.start loc) ~lid ~lowerCaseToken:Function ~debug; + Ast_iterator.default_iterator.expr iterator e + | Pexp_apply + ( {pexp_desc = Pexp_ident {txt = Lident "|."}}, + [_; (_, {pexp_desc = Pexp_ident {txt = lid; loc}})] ) -> + emitter + |> emitLongident ~pos:(Loc.start loc) ~lid ~lowerCaseToken:Function ~debug; + Ast_iterator.default_iterator.expr iterator e | Pexp_record (cases, _) -> cases |> List.iter (fun (label, _) -> emitter |> emitRecordLabel ~label ~debug); diff --git a/analysis/tests/src/Highlight.res b/analysis/tests/src/Highlight.res index 3baebefbd..0192f59d1 100644 --- a/analysis/tests/src/Highlight.res +++ b/analysis/tests/src/Highlight.res @@ -132,3 +132,11 @@ let _ = 3 == 3 || 3 === 3 let _ = (~_type_ as _) => () let _ = {"abc": 34} + +let _ = Js.log("Hello") + +"Hello"->Js.log + +"Hello"->Js.String2.concat("World")->Js.log + +[1, 2, 3]->Js.Array2.forEach(i => i->Js.log) \ No newline at end of file diff --git a/analysis/tests/src/expected/Highlight.res.txt b/analysis/tests/src/expected/Highlight.res.txt index 23362420d..9b27864c1 100644 --- a/analysis/tests/src/expected/Highlight.res.txt +++ b/analysis/tests/src/expected/Highlight.res.txt @@ -1,5 +1,5 @@ Highlight src/Highlight.res -structure items:38 diagnostics:0 +structure items:42 diagnostics:0 Lident: M 0:7 Namespace Lident: C 1:9 Namespace Lident: Component 1:13 Namespace @@ -20,6 +20,8 @@ Lident: div 16:4 JsxLowercase JsxTag >: 11:6 JsxTag >: 16:7 Ldot: React 12:5 Namespace +Lident: string 12:11 Function +Ldot: React 12:5 Namespace Lident: string 12:11 Variable JsxTag <: 13:4 Lident: div 13:5 JsxLowercase @@ -27,10 +29,16 @@ Lident: div 13:34 JsxLowercase JsxTag >: 13:8 JsxTag >: 13:37 Ldot: React 13:11 Namespace +Lident: string 13:17 Function +Ldot: React 13:11 Namespace Lident: string 13:17 Variable Ldot: React 14:5 Namespace +Lident: string 14:11 Function +Ldot: React 14:5 Namespace Lident: string 14:11 Variable Ldot: React 15:5 Namespace +Lident: string 15:11 Function +Ldot: React 15:5 Namespace Lident: string 15:11 Variable Lident: pair 18:5 Type Lident: looooooooooooooooooooooooooooooooooooooong_int 20:5 Type @@ -45,6 +53,7 @@ TypeArg: [26:4->26:50] TypeArg: [27:4->27:53] Lident: looooooooooooooooooooooooooooooooooooooong_int 26:4 Type Lident: looooooooooooooooooooooooooooooooooooooong_string 27:4 Type +Lident: not 31:8 Function Binary operator < [31:12->31:13] Binary operator > [31:22->31:23] Lident: MT 33:12 Type @@ -81,6 +90,7 @@ Variable: x [69:21->69:22] Variable: world [69:24->69:30] Lident: x 69:35 Variable Lident: world 69:39 Variable +Lident: add 71:21 Function Lident: add 71:21 Variable JsxTag <: 73:8 Lident: div 73:9 JsxLowercase @@ -107,6 +117,7 @@ Variable: toAs [90:4->90:8] Variable: x [90:19->90:20] Lident: x 90:25 Variable Variable: _toEquals [91:4->91:13] +Lident: toAs 91:16 Function Lident: toAs 91:16 Variable Variable: to [93:4->93:6] Lident: to 94:9 Variable @@ -117,6 +128,8 @@ Lident: ToAsProp 98:7 Namespace Variable: make [100:6->100:10] Variable: to [100:14->100:17] Ldot: React 101:8 Namespace +Lident: int 101:14 Function +Ldot: React 101:8 Namespace Lident: int 101:14 Variable Lident: to 101:18 Variable JsxTag <: 104:8 @@ -140,4 +153,34 @@ Lident: x 124:9 Variable Ldot: QQ 126:8 Namespace Lident: somePolyEnumType 126:11 Type Lident: abc 133:9->133:14 Property +Ldot: Js 135:8 Namespace +Lident: log 135:11 Function +Ldot: Js 135:8 Namespace +Lident: log 135:11 Variable +Ldot: Js 137:9 Namespace +Lident: log 137:12 Function +Ldot: Js 137:9 Namespace +Lident: log 137:12 Variable +Ldot: Js 139:37 Namespace +Lident: log 139:40 Function +Ldot: Js 139:9 Namespace +Ldot: String2 139:12 Namespace +Lident: concat 139:20 Function +Ldot: Js 139:9 Namespace +Ldot: String2 139:12 Namespace +Lident: concat 139:20 Variable +Ldot: Js 139:37 Namespace +Lident: log 139:40 Variable +Ldot: Js 141:11 Namespace +Ldot: Array2 141:14 Namespace +Lident: forEach 141:21 Function +Ldot: Js 141:11 Namespace +Ldot: Array2 141:14 Namespace +Lident: forEach 141:21 Variable +Variable: i [141:29->141:30] +Ldot: Js 141:37 Namespace +Lident: log 141:40 Function +Lident: i 141:34 Variable +Ldot: Js 141:37 Namespace +Lident: log 141:40 Variable diff --git a/server/src/server.ts b/server/src/server.ts index 98ec1779f..6aa462fc8 100644 --- a/server/src/server.ts +++ b/server/src/server.ts @@ -1131,7 +1131,8 @@ function onMessage(msg: p.Message) { "namespace", "enumMember", "property", - "interface", // emit jsxlowercase, div in
as interface + "interface", // emit jsxlowercase, div in
as interface, + "function" ], tokenModifiers: [], },