feat(method): make semantic token method runs concurrently

Author: 6cdh

doc.rkt

@@ -349,9 +349,9 @@
 ;;
 ;; for the first token, its previous token is defined as a zero length fake token which
 ;; has line number 0 and character position 0.
-(define (token-encoding doc token prev-pos)
-  (define-values (line ch) (doc-line/ch doc (SemanticToken-start token)))
-  (define-values (prev-line prev-ch) (doc-line/ch doc prev-pos))
+(define (token-encoding editor token prev-pos)
+  (match-define (list line ch) (send editor pos->line/char (SemanticToken-start token)))
+  (match-define (list prev-line prev-ch) (send editor pos->line/char prev-pos))
   (define delta-line (- line prev-line))
   (define delta-start
     (if (= line prev-line)
@@ -366,8 +366,8 @@
 ;; the tokens whose range intersects the given range is included.
 ;; the previous token of the first token in the result is defined as a zero length fake token which
 ;; has line number 0 and character position 0.
-(define (doc-range-tokens doc path pos-start pos-end)
-  (define tokens (collect-semantic-tokens (Doc-text doc) (uri->path path)))
+(define (doc-range-tokens editor uri pos-start pos-end)
+  (define tokens (collect-semantic-tokens editor (uri->path uri)))
   (define tokens-in-range
     (filter-not (λ (tok) (or (<= (SemanticToken-end tok) pos-start)
                              (>= (SemanticToken-start tok) pos-end)))
@@ -377,11 +377,12 @@
              #:result (flatten (reverse result)))
             ([token tokens-in-range])
     (define-values (delta-line delta-start len type modifier)
-      (token-encoding doc token prev-pos))
+      (token-encoding editor token prev-pos))
     (values (cons (list delta-line delta-start len type modifier) result)
             (SemanticToken-start token))))
 
-(provide Doc-trace
+(provide Doc-text
+         Doc-trace
          new-doc
          doc-checked?
          doc-update!

methods.rkt

@@ -31,7 +31,15 @@
                  ['method (? string? method)])
      (define params (hash-ref msg 'params hasheq))
      (define response (process-request id method params))
-     (display-message/flush response)]
+     ;; the result can be a response or a procedure which returns
+     ;; a response. If it's a procedure, then it's expected to run
+     ;; concurrently.
+     (thread (λ ()
+               (display-message/flush
+                 (if (procedure? response)
+                     (response)
+                     response))))
+     (void)]
     ;; Notification
     [(hash-table ['method (? string? method)])
      (define params (hash-ref msg 'params hasheq))

text-document.rkt

@@ -482,20 +482,27 @@
   (match params
     [(hash-table ['textDocument (DocIdentifier #:uri uri)])
      (define this-doc (hash-ref open-docs (string->symbol uri)))
-     (success-response id (hash 'data (doc-range-tokens this-doc uri 0 (doc-endpos this-doc))))]
+     (semantic-tokens uri id 0 (doc-endpos this-doc))]
     [_ (error-response id INVALID-PARAMS "textDocument/semanticTokens/full failed")]))
 
 (define (range-semantic-tokens id params)
   (match params
     [(hash-table ['textDocument (DocIdentifier #:uri uri)]
                  ['range (Range #:start (Pos #:line st-ln #:char st-ch)
-                           #:end (Pos #:line ed-ln #:char ed-ch))])
+                                #:end (Pos #:line ed-ln #:char ed-ch))])
      (define this-doc (hash-ref open-docs (string->symbol uri)))
      (define start-pos (doc-pos this-doc st-ln st-ch))
      (define end-pos (doc-pos this-doc ed-ln ed-ch))
-     (success-response id (hash 'data (doc-range-tokens this-doc uri start-pos end-pos)))]
+     (semantic-tokens uri id start-pos end-pos)]
     [_ (error-response id INVALID-PARAMS "textDocument/semanticTokens/range failed")]))
 
+(define (semantic-tokens uri id start-pos end-pos)
+  (define this-doc (hash-ref open-docs (string->symbol uri)))
+  (define new-editor (send (Doc-text this-doc) copy))
+  (λ ()
+    (define tokens (doc-range-tokens new-editor uri start-pos end-pos))
+    (success-response id (hash 'data tokens))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (provide
@@ -517,6 +524,6 @@
   [formatting! (exact-nonnegative-integer? jsexpr? . -> . jsexpr?)]
   [range-formatting! (exact-nonnegative-integer? jsexpr? . -> . jsexpr?)]
   [on-type-formatting! (exact-nonnegative-integer? jsexpr? . -> . jsexpr?)]
-  [full-semantic-tokens (exact-nonnegative-integer? jsexpr? . -> . jsexpr?)]
-  [range-semantic-tokens (exact-nonnegative-integer? jsexpr? . -> . jsexpr?)]))
+  [full-semantic-tokens (exact-nonnegative-integer? jsexpr? . -> . (or/c jsexpr? (-> jsexpr?)))]
+  [range-semantic-tokens (exact-nonnegative-integer? jsexpr? . -> . (or/c jsexpr? (-> jsexpr?)))]))