textDocument/references, and an unused var lint

src/fennel-ls/compiler.fnl

@@ -11,8 +11,10 @@ later by fennel-ls.language to answer requests from the client."
 ;; because fennel doesn't allow 'require in a runtime file
 (local -require- (sym :require))
 (local -fn- (sym :fn))
-(local -λ- (sym :λ))
+
-(local -lambda- (sym :lambda))
+(λ ast->macro-ast [ast]
+  [(fennel.list (sym :eval-compiler)
+                ((or table.unpack _G.unpack) ast))])
 
 (λ multisym? [t]
   ;; check if t is a symbol with multiple parts, eg. foo.bar.baz
@@ -54,9 +56,16 @@ later by fennel-ls.language to answer requests from the client."
       ;; Add a reference to the references
       (assert (sym? ast))
       ;; find reference
-      (let [name (string.match (tostring ast) "[^%.:]+")
+      (let [name (string.match (tostring ast) "[^%.:]+")]
-            target (find-definition (tostring name) scope)]
+        (case (find-definition (tostring name) scope)
-        (tset references ast target)))
+          target
+          (do
+            (tset references ast target)
+            (table.insert target.referenced-by ast)))))
+
+    (λ symbol-to-expression [ast scope ?reference?]
+      (if ?reference?
+        (reference ast scope)))
 
     (λ define [?definition binding scope]
       ;; Add a definition to the definitions
@@ -68,6 +77,7 @@ later by fennel-ls.language to answer requests from the client."
             (let [definition
                   {: binding
                    :definition ?definition
+                   :referenced-by (or (?. definitions binding :referenced-by) [])
                    :keys (if (< 0 (length keys))
                            (fcollect [i 1 (length keys)]
                              (. keys i)))}]
@@ -80,15 +90,24 @@ later by fennel-ls.language to answer requests from the client."
               (table.remove keys))))
       (recurse binding []))
 
+    (λ destructure [to from scope {:declaration ?declaration?}]
+      ;; I really don't understand symtype
+      ;; I think I need an explanation
+      (if ?declaration?
+        (define to from scope)))
+
     (λ define-function-name [ast scope]
       ;; add a function definition to the definitions
-      (match ast
+      (case ast
         (where [_fn name args]
           (and (sym? name)
                (sequence? args)))
-        (let [def {:binding name :definition ast}]
+        (let [def {:binding name
+                   :definition ast
+                   ;; referenced-by inherits from all other symbols
+                   :referenced-by (or (?. definitions name :referenced-by) [])}]
           (if (multisym? name)
-            (match (utils.multi-sym-split name)
+            (case (utils.multi-sym-split name)
               [ref field nil] ;; TODO more powerful function name metadata
               (let [target (find-definition ref scope)]
                 (set target.fields (or target.fields {}))
@@ -101,7 +120,7 @@ later by fennel-ls.language to answer requests from the client."
     (λ define-function-args [ast scope]
       ;; add the definitions of function arguments to the definitions
       (local args
-        (match ast
+        (case ast
           (where [_fn args] (fennel.sequence? args)) args
           (where [_fn _name args] (fennel.sequence? args)) args))
       (each [_ argument (ipairs args)]
@@ -121,13 +140,13 @@ later by fennel-ls.language to answer requests from the client."
     (λ call [ast scope]
       (tset scopes ast scope)
       ;; Most calls aren't interesting, but here's the list of the ones that are:
-      (match ast
+      (case ast
         ;; This cannot be done through the :fn feature of the compiler plugin system
         ;; because it needs to be called *before* the body of the function is processed.
         ;; TODO check if hashfn needs to be here
-        [-fn-]
+        (where [(= -fn-)])
         (define-function ast scope)
-        [-require- modname]
+        (where [(= -require-) _modname])
         (tset require-calls ast true)))
 
     (λ recoverable? [msg]
@@ -167,18 +186,19 @@ later by fennel-ls.language to answer requests from the client."
         true
         (error "__NOT_AN_ERROR")))
 
-    (local allowed-globals (icollect [k v (pairs _G)] k))
+    (local allowed-globals
+      (icollect [k v (pairs _G)]
+        k))
     (table.insert allowed-globals :vim)
 
     ;; TODO clean up this code. It's awful now that there is error handling
-    (let
+    (let [macro-file? (= (: file.text :sub 1 24) ";; fennel-ls: macro-file")
-      [macro-file? (= (: file.text :sub 1 24) ";; fennel-ls: macro-file")
           plugin
           {:name "fennel-ls"
            :versions ["1.3.1"]
-        :symbol-to-expression reference
+           : symbol-to-expression
            : call
-        :destructure define
+           : destructure
            :assert-compile on-compile-error
            :parse-error on-parse-error
            :customhook-early-do compile-do
@@ -190,25 +210,48 @@ later by fennel-ls.language to answer requests from the client."
                 :requireAsInclude false
                 : scope}
           parser (partial pcall (fennel.parser file.text file.uri opts))
-       ast (icollect [ok ok2 ast parser &until (not (and ok ok2))] ast)
+          ast (icollect [ok ok-2 ast parser &until (not (and ok ok-2))] ast)]
-       _compile-output (icollect [_i form (ipairs
+      ;; compile
-                                            (if macro-file? [(fennel.list (sym :eval-compiler)
+      (each [_i form (ipairs (if macro-file? (ast->macro-ast ast) ast))]
-                                                                          ((or table.unpack _G.unpack) ast))]
+        (case (pcall fennel.compile form opts)
-                                              ast))]
+          (where (or (nil err) (false err)) (not (err:find "__NOT_AN_ERROR\n?$")))
-                         (match (pcall fennel.compile form opts)
+          (error (.. "\nyou have crashed the compiler with the message:" err
-                           (where (nil err) (not= err "__NOT_AN_ERROR"))
+                     "\nI am considering supressing this error if I get a lot of false alarms"))))
-                           (table.insert diagnostics
+          ; (table.insert diagnostics
-                             {:range (message.pos->range 0 0 0 0)
+          ;   {:range (message.pos->range 0 0 0 0)
-                              :message err})))]
+          ;    :message (.. "unrecoverable compiler error: " err)})
-
 
+      ;; analyze more things
       ;; write things back to the file object
+      (local deep-references {})
+
+      ; (each [sym target (pairs references)]
+      ;   (if
+      ;     (sym? target)
+      ;     (list? target)
+      ;     (= :table (type target))))
+      ;     ;; base case???
+
+      (each [sym definition (pairs definitions)]
+          (let [range (message.ast->range sym file)]
+            (if (and (= 0 (length definition.referenced-by))
+                     (not= "_" (: (tostring sym) :sub 1 1)))
+              (table.insert diagnostics
+                {:range range
+                 :message (.. "unused definition: " (tostring sym))
+                 :severity message.severity.WARN
+                 :code 301
+                 :codeDescription "warning error"}))))
+
+
       (set file.ast ast)
       (set file.scope scope)
       (set file.scopes scopes)
       (set file.definitions definitions)
       (set file.diagnostics diagnostics)
       (set file.references references)
+      (set file.deep-references references)
       (set file.require-calls require-calls)
       (set file.allowed-globals allowed-globals))))
+
 {: compile}

src/fennel-ls/formatter.fnl

@@ -18,7 +18,8 @@ user code."
 
 (local width 80)
 (fn fn-format [special name args docstring]
-  (.. (code-block (.. "(fn"
+  (.. (code-block (.. "("
+                      (tostring special)
                       (if name (.. " " (tostring name)) "")
                       (.. " " (view args
                                 {:one-line? true
@@ -38,14 +39,14 @@ user code."
   "Format code that will appear when the user hovers over a symbol"
   (match result.definition
     ;; name + docstring
-    (where [special name args docstring body]
+    (where [special name args docstring _body]
       (fn? special)
       (sym? name)
       (type= args :table)
       (type= docstring :string))
     (fn-format special name args docstring)
     ;; docstring
-    (where [special args docstring body]
+    (where [special args docstring _body]
       (fn? special)
       (type= args :table)
       (type= docstring :string))

src/fennel-ls/handlers.fnl

@@ -30,7 +30,7 @@ Every time the client sends a message, it gets handled by a function in the corr
    :definitionProvider {:workDoneProgress false}
    ;; :typeDefinitionProvider nil
    ;; :implementationProvider nil
-   ;; :referencesProvider nil
+   :referencesProvider {:workDoneProgress false}
    ;; :documentHighlightProvider nil
    ;; :documentSymbolProvider nil
    ;; :codeActionProvider nil
@@ -69,20 +69,42 @@ Every time the client sends a message, it gets handled by a function in the corr
 (λ requests.textDocument/definition [self send {: position :textDocument {: uri}}]
   (let [file (state.get-by-uri self uri)
         byte (pos->byte file.text position.line position.character)]
-    (match-try (language.find-symbol file.ast byte)
+    (case-try (language.find-symbol file.ast byte)
       (symbol parents)
-      (match-try
+      ;; TODO unruin this match-try
       (let [parent (. parents 1)]
         (if (. file.require-calls parent)
-            (language.search self file parent [] {:stop-early? true})))
+          (language.search self file parent [] {:stop-early? true})
-        nil
+          (language.search-main self file symbol {:stop-early? true} byte)))
-        (language.search-main self file symbol {:stop-early? true} byte))
       (result result-file)
       (message.range-and-uri
         (or result.binding result.definition)
         result-file)
       (catch _ nil))))
 
+(λ requests.textDocument/references [self send {:position {: line : character}
+                                                :textDocument {: uri}
+                                                :context {:includeDeclaration ?include-declaration?}}]
+  (let [file (state.get-by-uri self uri)
+        byte (pos->byte file.text line character)]
+    (case-try (language.find-symbol file.ast byte)
+      symbol
+      (if (. file.definitions symbol)
+        (values (. file.definitions symbol) file)
+        (language.search-main self file symbol {:stop-early? true} byte))
+      (definition result-file)
+      (let [result
+            (icollect [_ symbol (ipairs definition.referenced-by)]
+              ;; TODO we currently assume all references are in the same file
+              (message.range-and-uri symbol result-file))]
+        (if ?include-declaration?
+          (table.insert result
+                (message.range-and-uri definition.binding result-file)))
+
+        ;; TODO if the request says not to include duplicates, don't include duplicates
+        result)
+      (catch _ nil))))
+
 (λ requests.textDocument/hover [self send {: position :textDocument {: uri}}]
   (let [file (state.get-by-uri self uri)
         byte (pos->byte file.text position.line position.character)]
@@ -128,7 +150,7 @@ Every time the client sends a message, it gets handled by a function in the corr
       (match-try (language.search-assignment self file ref stack {})
         {: definition}
         (match (values definition (type definition))
-          (str :string) (icollect [k v (pairs string)]
+          (_str :string) (icollect [k v (pairs string)]
                            {:label k})
           (tbl :table) (icollect [k v (pairs tbl)]
                          (if (= (type k) :string)
@@ -141,7 +163,7 @@ Every time the client sends a message, it gets handled by a function in the corr
         (?symbol parents) (language.find-symbol file.ast byte)]
     (match (-?> ?symbol utils.multi-sym-split)
       (where (or nil [_ nil])) (scope-completion file byte ?symbol parents)
-      [a b &as split] (field-completion self file ?symbol split))))
+      [_a _b &as split] (field-completion self file ?symbol split))))
 
 (λ notifications.textDocument/didChange [self send {: contentChanges :textDocument {: uri}}]
   (local file (state.get-by-uri self uri))

src/fennel-ls/language.fnl

@@ -18,7 +18,7 @@ the data provided by compiler.fnl."
 (var search nil) ;; all of the search functions are mutually recursive
 
 (λ search-assignment [self file assignment stack opts]
-  (let [{: binding
+  (let [{:binding _
          :definition ?definition
          :keys ?keys
          :fields ?fields} assignment]
@@ -37,7 +37,7 @@ the data provided by compiler.fnl."
 (λ search-symbol [self file symbol stack opts]
   (if (= symbol -nil-)
     (values {:definition symbol} file) ;; BASE CASE !!
-    (match (. file.references symbol)
+    (case (. file.references symbol)
       to (search-assignment self file to
            (let [split (utils.multi-sym-split symbol)]
              (fcollect [i (length split) 2 -1 &into stack]
@@ -95,7 +95,7 @@ the data provided by compiler.fnl."
     (let [split (utils.multi-sym-split symbol (if ?byte (+ 1 (- ?byte symbol.bytestart))))]
       (fcollect [i (length split) 2 -1]
         (. split i))))
-  (match (values (. file.references symbol) (. file.definitions symbol))
+  (case (values (. file.references symbol) (. file.definitions symbol))
     (ref _)
     (search-assignment self file ref stack opts)
     (_ def)

test/init-macros.fnl

@@ -34,7 +34,7 @@
             (fennel#.view ?otherwise#))
           "\ndid not match pattern:\n"
           ,(view pattern)
-          (and ,?msg (.. "\n" ,?msg))))))
+          ,(and ?msg `(.. "\n" ,?msg))))))
 
 {: it
  : describe

test/is.fnl

@@ -2,9 +2,9 @@
 (local {: view} (require :fennel))
 (local {: expect} (require :test.lust))
 ;; lust uses weird terminology, but equal is by __eq, same is by recursively having the same contents
-(setmetatable {:equal  #((. (expect $1) :to :be) $2)
+(setmetatable {:equal  #(do ((. (expect $1) :to :be) $2) true)
-               :same  #((. (expect $1) :to :equal) $2)
+               :same  #(do ((. (expect $1) :to :equal) $2) true)
-               :nil #((. (expect $1) :to_not :exist))
+               :nil #(do ((. (expect $1) :to_not :exist)) true)
-               :not {:nil #((. (expect $1) :to :exist))}
+               :not {:nil #(do ((. (expect $1) :to :exist)) true)}
-               :truthy #((. (expect $1) :to :be :truthy))}
+               :truthy #(do ((. (expect $1) :to :be :truthy)) true)}
-              {:__call #((. (expect $2) :to :be :truthy))})
+              {:__call #(do ((. (expect $2) :to :be :truthy)) true)})

test/lust.lua

@@ -3,6 +3,7 @@
 -- MIT LICENSE
 
 local lust = {}
+local tostring = require("fennel.view")
 lust.level = 0
 lust.passes = 0
 lust.errors = 0

test/misc-test.fnl

@@ -51,3 +51,8 @@
       (is-matching
         parents [[1 2 [:sym-one]] [[:match] [1 2 4] [1 2 [:sym-one]] [:sym-one]]]
         "bad parents"))))
+(describe "failure"
+  (it "doesn't crash"
+    (let [self (create-client)
+          state (require :fennel-ls.state)]
+      (state.get-by-module self.server "test.test-project.crash-files.test"))))

test/mock-client.fnl

@@ -70,7 +70,7 @@
     (message.create-request (next-id! self) :textDocument/references
      {:position {: line : character}
       :textDocument {:uri file}
-      :context {:includeDeclaration ?includeDeclaration}})))
+      :context {:includeDeclaration (not (not ?includeDeclaration))}})))
 
 (set mt.__index
      {: open-file!

test/references-test.fnl

@@ -1,5 +1,6 @@
 (import-macros {: is-matching : describe : it : before-each} :test)
 (local is (require :test.is))
+(local message (require :fennel-ls.message))
 
 (local {: view} (require :fennel))
 (local {: ROOT-URI
@@ -11,8 +12,16 @@
   (let [client (doto (create-client)
                  (: :open-file! filename body))
         response (client:references filename line col)]
-    (is.same response [])))
+    (is-matching response
+      (where [{:jsonrpc "2.0" :id client.prev-id
+               : result}]
+        (is.same result expected)))))
 
-(describe "references")
+(describe "references"
-  ; (it "finds a reference from let"
+  (it "finds a reference from let"
-  ;   (check-references "(let [x 10] x)" 0 1))) 
+    (check-references "(let [x 10] x)" 0 12
+      [{:uri filename :range (message.pos->range 0 12 0 13)}]))
+
+  (it "finds a reference from let"
+    (check-references "(let [x 10] x)" 0 6
+      [{:uri filename :range (message.pos->range 0 12 0 13)}])))

test/test-project/crash-files/test.fnl

@@ -0,0 +1,155 @@
+      (case ast
+          (and (sym? name)
+               (sequence? args))
+        (let [def {:binding name
+                   :definition ast
+                   :referenced-by []}]
+          (if (multisym? name)
+            (case (utils.multi-sym-split name)
+              [ref field nil] ;; TODO more powerful function name metadata
+              (let [target (find-definition ref scope)]
+                (set target.fields (or target.fields {}))
+                (tset target.fields field def)))
+
+            (tset (. definitions-by-scope scope)
+                  (tostring name)
+                  def))))
+
+    (λ define-function-args [ast scope]
+      ;; add the definitions of function arguments to the definitions
+      (local args
+        (case ast
+          (where [_fn args] (fennel.sequence? args)) args
+          (where [_fn _name args] (fennel.sequence? args)) args))
+      (each [_ argument (ipairs args)]
+        (define (sym :nil) argument scope))) ;; we say function arguments are set to nil
+
+    (λ define-function [ast scope]
+      ;; handle the definitions of a function
+      (define-function-name ast scope))
+
+    (λ compile-fn [ast scope]
+      (tset scopes ast scope)
+      (define-function-args ast scope))
+
+    (λ compile-do [ast scope]
+      (tset scopes ast scope))
+
+    (λ call [ast scope]
+      (tset scopes ast scope)
+      ;; Most calls aren't interesting, but here's the list of the ones that are:
+      (case ast
+        ;; This cannot be done through the :fn feature of the compiler plugin system
+        ;; because it needs to be called *before* the body of the function is processed.
+        ;; TODO check if hashfn needs to be here
+        (where [(= -fn-)])
+        (define-function ast scope)
+        (where [(= -require-) modname])
+        (tset require-calls ast true)))
+
+    (λ recoverable? [msg]
+      (or (= 1 (msg:find "unknown identifier"))
+          (= 1 (msg:find "expected closing delimiter"))
+          (= 1 (msg:find "expected body expression"))
+          (= 1 (msg:find "expected whitespace before opening delimiter"))
+          (= 1 (msg:find "malformed multisym"))
+          (= 1 (msg:find "expected at least one pattern/body pair"))))
+
+    (λ on-compile-error [_ msg ast call-me-to-reset-the-compiler]
+      (let [range (or (message.ast->range ast file)
+                      (message.pos->range 0 0 0 0))]
+        (table.insert diagnostics
+          {:range range
+           :message msg
+           :severity message.severity.ERROR
+           :code 201
+           :codeDescription "compiler error"}))
+      (if (recoverable? msg)
+        true
+        (do
+          (call-me-to-reset-the-compiler)
+          (error "__NOT_AN_ERROR"))))
+
+    (λ on-parse-error [msg file line byte]
+      ;; assume byte and char count is the same, ie no UTF-8
+      (let [line (- line 1)
+            range (message.pos->range line byte line byte)]
+        (table.insert diagnostics
+          {:range range
+           :message msg
+           :severity message.severity.ERROR
+           :code 101
+           :codeDescription "parse error"}))
+      (if (recoverable? msg)
+        true
+        (error "__NOT_AN_ERROR")))
+
+    (local allowed-globals
+      (icollect [k v (pairs _G)]
+        k))
+    (table.insert allowed-globals :vim)
+
+    ;; TODO clean up this code. It's awful now that there is error handling
+    (let [macro-file? (= (: file.text :sub 1 24) ";; fennel-ls: macro-file")
+          plugin
+          {:name "fennel-ls"
+           :versions ["1.3.1"]
+           : symbol-to-expression
+           : call
+           :destructure define
+           :assert-compile on-compile-error
+           :parse-error on-parse-error
+           :customhook-early-do compile-do
+           :customhook-early-fn compile-fn}
+          scope (fennel.scope)
+          opts {:filename file.uri
+                :plugins [plugin]
+                :allowedGlobals allowed-globals
+                :requireAsInclude false
+                : scope}
+          parser (partial pcall (fennel.parser file.text file.uri opts))
+          ast (icollect [ok ok-2 ast parser &until (not (and ok ok-2))] ast)]
+      ;; compile
+      (each [_i form (ipairs (if macro-file? (ast->macro-ast ast) ast))]
+        (case (pcall fennel.compile form opts)
+          (where (or (nil err) (false err)) (not (err:find "__NOT_AN_ERROR$")))
+          (error (.. "you have crashed the compiler with the message:" err
+                     "\nI am considering supressing this error if I get a lot of false alarms"))))
+          ; (table.insert diagnostics
+          ;   {:range (message.pos->range 0 0 0 0)
+          ;    :message (.. "unrecoverable compiler error: " err)})
+
+      ;; analyze more things
+      ;; write things back to the file object
+      (local deep-references {})
+
+      ; (each [sym target (pairs references)]
+      ;   (if
+      ;     (sym? target)
+      ;     (list? target)
+      ;     (= :table (type target))))
+      ;     ;; base case???
+
+      (each [sym definition (pairs definitions)]
+          (let [range (message.ast->range sym file)]
+            (if (and (= 0 (length definition.referenced-by))
+                     (not= "_" (: (tostring sym) :sub 1 1)))
+              (table.insert diagnostics
+                {:range range
+                 :message (.. "unused definition: " (tostring sym))
+                 :severity message.severity.WARN
+                 :code 301
+                 :codeDescription "warning error"}))))
+
+
+      (set file.ast ast)
+      (set file.scope scope)
+      (set file.scopes scopes)
+      (set file.definitions definitions)
+      (set file.diagnostics diagnostics)
+      (set file.references references)
+      (set file.deep-references references)
+      (set file.require-calls require-calls)
+      (set file.allowed-globals allowed-globals))
+
+{: compile}