diff --git a/src/fennel-ls/compiler.fnl b/src/fennel-ls/compiler.fnl index a422995..915ef09 100644 --- a/src/fennel-ls/compiler.fnl +++ b/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) "[^%.:]+") - target (find-definition (tostring name) scope)] - (tset references ast target))) + (let [name (string.match (tostring ast) "[^%.:]+")] + (case (find-definition (tostring name) scope) + 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,48 +186,72 @@ 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 - [macro-file? (= (: file.text :sub 1 24) ";; fennel-ls: macro-file") - plugin - {:name "fennel-ls" - :versions ["1.3.1"] - :symbol-to-expression reference - : 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 ok2 ast parser &until (not (and ok ok2))] ast) - _compile-output (icollect [_i form (ipairs - (if macro-file? [(fennel.list (sym :eval-compiler) - ((or table.unpack _G.unpack) ast))] - ast))] - (match (pcall fennel.compile form opts) - (where (nil err) (not= err "__NOT_AN_ERROR")) - (table.insert diagnostics - {:range (message.pos->range 0 0 0 0) - :message err})))] - + (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 + :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\n?$"))) + (error (.. "\nyou 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} diff --git a/src/fennel-ls/formatter.fnl b/src/fennel-ls/formatter.fnl index 64b53e7..110ae2b 100644 --- a/src/fennel-ls/formatter.fnl +++ b/src/fennel-ls/formatter.fnl @@ -18,12 +18,13 @@ user code." (local width 80) (fn fn-format [special name args docstring] - (.. (code-block (.. "(fn" - (if name (.. " " (tostring name)) "") - (.. " " (view args - {:one-line? true - :prefer-colon? true})) - " ...)")) + (.. (code-block (.. "(" + (tostring special) + (if name (.. " " (tostring name)) "") + (.. " " (view args + {:one-line? true + :prefer-colon? true})) + " ...)")) (if docstring (.. "\n" docstring) ""))) @@ -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)) diff --git a/src/fennel-ls/handlers.fnl b/src/fennel-ls/handlers.fnl index c70c972..3fff364 100644 --- a/src/fennel-ls/handlers.fnl +++ b/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 - (let [parent (. parents 1)] - (if (. file.require-calls parent) - (language.search self file parent [] {:stop-early? true}))) - nil - (language.search-main self file symbol {:stop-early? true} byte)) + ;; TODO unruin this match-try + (let [parent (. parents 1)] + (if (. file.require-calls parent) + (language.search self file parent [] {:stop-early? true}) + (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,8 +150,8 @@ 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)] - {:label k}) + (_str :string) (icollect [k v (pairs string)] + {:label k}) (tbl :table) (icollect [k v (pairs tbl)] (if (= (type k) :string) {:label k}))) @@ -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)) diff --git a/src/fennel-ls/language.fnl b/src/fennel-ls/language.fnl index 5929a5d..1ba121d 100644 --- a/src/fennel-ls/language.fnl +++ b/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) diff --git a/test/init-macros.fnl b/test/init-macros.fnl index 7266941..e15c1e6 100644 --- a/test/init-macros.fnl +++ b/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 diff --git a/test/is.fnl b/test/is.fnl index 2650492..b95d1bb 100644 --- a/test/is.fnl +++ b/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) - :same #((. (expect $1) :to :equal) $2) - :nil #((. (expect $1) :to_not :exist)) - :not {:nil #((. (expect $1) :to :exist))} - :truthy #((. (expect $1) :to :be :truthy))} - {:__call #((. (expect $2) :to :be :truthy))}) +(setmetatable {:equal #(do ((. (expect $1) :to :be) $2) true) + :same #(do ((. (expect $1) :to :equal) $2) true) + :nil #(do ((. (expect $1) :to_not :exist)) true) + :not {:nil #(do ((. (expect $1) :to :exist)) true)} + :truthy #(do ((. (expect $1) :to :be :truthy)) true)} + {:__call #(do ((. (expect $2) :to :be :truthy)) true)}) diff --git a/test/lust.lua b/test/lust.lua index e753d1d..566bcc1 100644 --- a/test/lust.lua +++ b/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 diff --git a/test/misc-test.fnl b/test/misc-test.fnl index 2c71dff..e9ecb63 100644 --- a/test/misc-test.fnl +++ b/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")))) diff --git a/test/mock-client.fnl b/test/mock-client.fnl index d5ffd0d..810a040 100644 --- a/test/mock-client.fnl +++ b/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! diff --git a/test/references-test.fnl b/test/references-test.fnl index 647b3ad..dcc3fff 100644 --- a/test/references-test.fnl +++ b/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") - ; (it "finds a reference from let" - ; (check-references "(let [x 10] x)" 0 1))) +(describe "references" + (it "finds a reference from let" + (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)}]))) diff --git a/test/test-project/crash-files/test.fnl b/test/test-project/crash-files/test.fnl new file mode 100644 index 0000000..32e0962 --- /dev/null +++ b/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}