Merge jerboa-lsp: LSP server built by jerboa's make, tables auto-derived
ober
60db048e83d91e06141decaae2cf3d5bf45a7b2a
--- a/.gitignore +++ b/.gitignore @@ -46,6 +46,13 @@ /jmcp /jmcp-* +# `make jlsp` / `make jlsp-portable` outputs (self-contained LSP binary) and +# its generated completion tables. completion-tables.ss is derived from +# data/api-signatures.sexp by `make lsp-gen`, so it is regenerable, not source. +/jlsp +/jlsp-* +/lsp/analysis/completion-tables.ss + # `make native-cross` outputs (per-target Rust dylibs) /lib-cross/ --- a/Makefile +++ b/Makefile @@ -67,6 +67,15 @@ help: @echo " jmcp-portable Build jmcp for {macOS,Linux,FreeBSD} x {amd64,arm64}" @echo " mcp-test-binary Run protocol tests against the built ./jmcp" @echo "" + @echo "LSP server (jerboa-lsp + jlsp binary):" + @echo " lsp Compile-check the LSP server (lsp/main.ss)" + @echo " lsp-gen Regenerate completion tables from data/api-signatures.sexp" + @echo " lsp-run Run the LSP server from source over stdio" + @echo " lsp-test Run LSP unit + e2e tests" + @echo " jlsp Build self-contained ./jlsp (installs as ~/.local/bin/jerboa-lsp)" + @echo " jlsp-install Build ./jlsp and copy it to ~/.local/bin/jerboa-lsp" + @echo " jlsp-portable Build jlsp for host + Linux/FreeBSD amd64" + @echo "" @echo "Test (core):" @echo " test Run core test suite (reader, stdlib, ffi, regex)" @echo " test-reader Reader tests" @@ -478,6 +487,83 @@ jmcp-freebsd-arm64: chez build mcp-check # All six: host (macOS arm64) + the five cross targets. jmcp-portable: jmcp jmcp-macos-amd64 jmcp-linux-amd64 jmcp-linux-arm64 jmcp-freebsd-amd64 jmcp-freebsd-arm64 +# ── LSP server (jerboa-lsp) + jlsp self-contained binary ───────────────────── +# lsp/ is the pure-Scheme Jerboa language server. Its completion tables +# (lsp/analysis/completion-tables.ss) are GENERATED by `make lsp-gen` from +# data/api-signatures.sexp — the same API map the MCP serves — so completions +# track the live standard library. Every LSP target regenerates them first, so +# the tables can never go stale; the file itself is not committed (.gitignore). +# The host binary is ./jlsp; it installs as ~/.local/bin/jerboa-lsp (the name +# LSP clients already expect), with all boot files + program embedded. +LSP_ENTRY = lsp/main.ss +LSP_GEN = lsp/gen-completion-tables.ss +LSP_UNIT_TEST = lsp/test/unit-test.ss +LSP_E2E_TEST = lsp/test/e2e-test.py +LSP_BIN = $(HOME)/.local/bin/jerboa-lsp +# Cross builds compile lsp/ + std/ against the host libdirs; boot files come +# from jerboa's own cross prefixes (.chez-cross-<m>). +LSP_XC_LIBDIRS = $(JERBOA_HOME):$(JERBOA_HOME)/lib:$(JERBOA_HOME)/.chez-cross-ta6le/lib:$(JERBOA_HOME)/.chez-cross-ta6fb/lib +.PHONY: lsp lsp-gen lsp-run lsp-test lsp-test-unit lsp-test-e2e \ + jlsp jlsp-install jlsp-linux-amd64 jlsp-freebsd-amd64 jlsp-portable + +# Regenerate the completion tables from the live API map (data/api-signatures.sexp). +lsp-gen: chez + @JERBOA_HOME=$(JERBOA_HOME) $(SCHEME) --script $(LSP_GEN) + +# Compile-check the whole server from source (imports the full cascade). +lsp: chez lsp-gen + @JERBOA_HOME=$(JERBOA_HOME) JERBOA_LSP_DIR=$(JERBOA_HOME) \ + $(SCHEME) -q --script $(LSP_ENTRY) -- --version + @echo "lsp: server compile-check OK" + +# Run the LSP server from source over stdio. +lsp-run: lsp-gen + @JERBOA_HOME=$(JERBOA_HOME) JERBOA_LSP_DIR=$(JERBOA_HOME) \ + $(SCHEME) -q --script $(LSP_ENTRY) -- --stdio + +lsp-test: lsp-test-unit lsp-test-e2e + +lsp-test-unit: chez lsp-gen + @JERBOA_HOME=$(JERBOA_HOME) JERBOA_LSP_DIR=$(JERBOA_HOME) \ + $(SCHEME) -q --script $(LSP_UNIT_TEST) + +# e2e launches lsp/main.ss from source; JERBOA_LSP_DIR must be the dir holding +# lsp/ (the repo root) or (lsp ...) imports double-nest. +lsp-test-e2e: chez lsp-gen + @echo "=== LSP e2e test (source) ===" + @JERBOA_HOME=$(JERBOA_HOME) JERBOA_LSP_DIR=$(JERBOA_HOME) SCHEME=$(SCHEME) \ + python3 $(LSP_E2E_TEST) + +# Native self-contained binary for the host (./jlsp). +jlsp: chez build lsp-gen + @echo "=== Building native ./jlsp (host) ===" + @JERBOA_HOME=$(JERBOA_HOME) JERBOA_LSP_DIR=$(JERBOA_HOME) \ + $(SCHEME) -q --libdirs $(JERBOA_HOME) --script lsp/build-binary.ss + +jlsp-install: jlsp + @mkdir -p $(HOME)/.local/bin + cp jlsp $(LSP_BIN) + @echo "Installed ./jlsp -> $(LSP_BIN)" + +jlsp-linux-amd64: chez build lsp-gen + @command -v x86_64-linux-musl-gcc >/dev/null 2>&1 || { echo "ERROR: x86_64-linux-musl-gcc not on PATH" >&2; exit 1; } + @test -d "$(JERBOA_HOME)/.chez-cross-ta6le" || { echo "ERROR: .chez-cross-ta6le not found (make chez-cross CHEZ_TARGET_MACHINE=ta6le CROSS_CC=x86_64-linux-musl-gcc)" >&2; exit 1; } + @test -f "$(CHEZ_BUILD_DIR)/xc-ta6le/s/xpatch" || { echo "ERROR: ta6le xpatch not found" >&2; exit 1; } + @echo "=== Cross-building jlsp-linux-amd64 ===" + @JERBOA_HOME=$(JERBOA_HOME) CROSS_CC=x86_64-linux-musl-gcc \ + $(SCHEME) -q --libdirs '$(LSP_XC_LIBDIRS)' --script lsp/build-jlsp-cross.ss + +jlsp-freebsd-amd64: chez build lsp-gen + @test -x "$(JERBOA_HOME)/support/cross-cc-freebsd-amd64" || { echo "ERROR: support/cross-cc-freebsd-amd64 not found/executable" >&2; exit 1; } + @test -d "$(JERBOA_HOME)/.chez-cross-ta6fb" || { echo "ERROR: .chez-cross-ta6fb not found (make chez-cross CHEZ_TARGET_MACHINE=ta6fb CROSS_CC=...)" >&2; exit 1; } + @test -f "$(CHEZ_BUILD_DIR)/xc-ta6fb/s/xpatch" || { echo "ERROR: ta6fb xpatch not found" >&2; exit 1; } + @echo "=== Cross-building jlsp-freebsd-amd64 ===" + @JERBOA_HOME=$(JERBOA_HOME) CROSS_CC="$(JERBOA_HOME)/support/cross-cc-freebsd-amd64" \ + $(SCHEME) -q --libdirs '$(LSP_XC_LIBDIRS)' --script lsp/build-jlsp-freebsd-cross.ss + +# Host + the two cross targets. +jlsp-portable: jlsp jlsp-linux-amd64 jlsp-freebsd-amd64 + test: test-reader test-core test-runtime test-stdlib test-ffi test-modules test-expanded test-regex-all test-contract test-ergo test-limits-primitives test-typed-parser test-typed-checker test-pure-audit typecheck: new file mode 100644 --- /dev/null +++ b/lsp/README.md @@ -0,0 +1 @@ +# jerboa-lsp new file mode 100644 --- /dev/null +++ b/lsp/analysis/background-diagnostics.ss @@ -0,0 +1,84 @@ +#!chezscheme +;;; lsp/analysis/background-diagnostics -- Debounced background diagnostics +;;; +;;; Runs diagnostics in a background thread with debouncing to avoid +;;; redundant work on rapid edits. + +(library (lsp analysis background-diagnostics) + (export start-background-diagnostics! request-diagnostics! stop-background-diagnostics!) + (import (chezscheme) + (lsp util log)) + + ;; Debounce state + (define *diag-mutex* (make-mutex)) + (define *diag-condition* (make-condition)) + (define *diag-queue* '()) ;; list of (uri . timestamp) + (define *diag-running* #f) + (define *diag-delay-ms* 1500) ;; debounce delay in milliseconds + + ;; Start the background diagnostics thread + ;; diag-fn: (lambda (uri) ...) — function that runs diagnostics for a URI + (define (start-background-diagnostics! diag-fn) + (set! *diag-running* #t) + (fork-thread + (lambda () + (lsp-debug "Background diagnostics thread started") + (let loop () + (when *diag-running* + ;; Wait for work + (with-mutex *diag-mutex* + (when (null? *diag-queue*) + (condition-wait *diag-condition* *diag-mutex*))) + + ;; Sleep for debounce delay + (let* ([total-ns (* *diag-delay-ms* 1000000)] + [secs (div total-ns 1000000000)] + [ns (mod total-ns 1000000000)] + [delay (make-time 'time-duration ns secs)]) + (sleep delay)) + + ;; Drain queue and process only latest per-URI + (let ([work '()]) + (with-mutex *diag-mutex* + (set! work (deduplicate-queue *diag-queue*)) + (set! *diag-queue* '())) + + ;; Run diagnostics for each unique URI + (for-each + (lambda (uri) + (guard (e [#t + (lsp-error "Background diagnostics failed for" + uri ":" (condition-message e))]) + (diag-fn uri))) + work)) + + (loop)))))) + + ;; Request diagnostics for a URI (debounced) + (define (request-diagnostics! uri) + (with-mutex *diag-mutex* + (set! *diag-queue* + (cons (cons uri (current-time)) + *diag-queue*)) + (condition-signal *diag-condition*))) + + ;; Stop the background thread + (define (stop-background-diagnostics!) + (set! *diag-running* #f) + (with-mutex *diag-mutex* + (condition-signal *diag-condition*))) + + ;; Keep only the latest entry per URI + (define (deduplicate-queue queue) + (let ([seen (make-hashtable string-hash string=?)] + [result '()]) + (for-each + (lambda (entry) + (let ([uri (car entry)]) + (unless (hashtable-ref seen uri #f) + (hashtable-set! seen uri #t) + (set! result (cons uri result))))) + queue) + (reverse result))) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/lsp/analysis/cache.ss @@ -0,0 +1,212 @@ +#!chezscheme +;;; lsp/analysis/cache -- Persistent cache for symbol index data +;;; +;;; Stores symbol index data and file modification times in a +;;; .jerboa-lsp-cache/ directory inside the workspace root so the +;;; server does not have to re-index everything on restart. + +(library (lsp analysis cache) + (export cache-init! cache-save-symbols! cache-load-symbols + cache-file-changed? cache-update-mtime! cache-clear!) + (import (chezscheme) + (lsp util log) + (lsp util string)) + + ;; Character constants used in URI encoding (avoids reader issues + ;; with character literals inside nested forms). + (define char-slash #\/) + (define char-percent #\%) + + ;; Name of the cache directory created inside the workspace root. + (define cache-dir-name ".jerboa-lsp-cache") + + ;; Name of the file that stores mtime data. + (define mtimes-file-name "mtimes.dat") + + ;; Subdirectory for per-file symbol data. + (define symbols-dir-name "symbols") + + ;; Current cache root (set by cache-init!). + (define *cache-root* #f) + + ;; In-memory mtime table: uri -> (seconds . nanoseconds) + (define *mtimes* (make-hashtable string-hash string=?)) + + ;; ------------------------------------------------------------------ + ;; Internal helpers + ;; ------------------------------------------------------------------ + + (define (cache-root) + (or *cache-root* + (error 'cache "cache not initialized -- call cache-init! first"))) + + (define (mtimes-path) + (string-append (cache-root) "/" mtimes-file-name)) + + (define (symbols-dir) + (string-append (cache-root) "/" symbols-dir-name)) + + (define (ensure-directory path) + (unless (file-directory? path) + (guard (exn [#t (void)]) ;; ignore EEXIST races + (mkdir path #o755)))) + + ;; Encode a URI into a safe file name. Replace "/" with "_" and + ;; percent-encode any characters that are not alphanumeric, "-", ".", + ;; or "_". + (define (uri->cache-key uri) + (let ([len (string-length uri)]) + (let loop ([i 0] [chars '()]) + (if (= i len) + (list->string (reverse chars)) + (let ([ch (string-ref uri i)]) + (cond + [(or (char-alphabetic? ch) + (char-numeric? ch) + (char=? ch #\-) + (char=? ch #\.)) + (loop (+ i 1) (cons ch chars))] + [(char=? ch char-slash) + (loop (+ i 1) (cons #\_ chars))] + [else + ;; Percent-encode as %XX + (let* ([n (char->integer ch)] + [hi (string-ref "0123456789ABCDEF" (fxsrl n 4))] + [lo (string-ref "0123456789ABCDEF" (fxand n 15))]) + (loop (+ i 1) + (cons lo (cons hi (cons char-percent chars)))))])))))) + + (define (symbol-cache-path uri) + (string-append (symbols-dir) "/" (uri->cache-key uri) ".dat")) + + ;; ------------------------------------------------------------------ + ;; Mtime persistence + ;; ------------------------------------------------------------------ + + (define (save-mtimes!) + (guard (exn + [#t (lsp-warn "cache: failed to save mtimes" exn)]) + (let ([path (mtimes-path)] + [keys (vector->list (hashtable-keys *mtimes*))]) + (call-with-output-file path + (lambda (port) + (for-each + (lambda (uri) + (let ([mt (hashtable-ref *mtimes* uri #f)]) + (when mt + (write (list uri (car mt) (cdr mt)) port) + (newline port)))) + keys)) + 'replace)))) + + (define (load-mtimes!) + (let ([path (mtimes-path)]) + (when (file-exists? path) + (guard (exn + [#t (lsp-warn "cache: failed to load mtimes" exn)]) + (call-with-input-file path + (lambda (port) + (let loop () + (let ([datum (read port)]) + (unless (eof-object? datum) + (when (and (list? datum) (= (length datum) 3)) + (let ([uri (car datum)] + [sec (cadr datum)] + [nsec (caddr datum)]) + (hashtable-set! *mtimes* uri (cons sec nsec)))) + (loop)))))))))) + + ;; ------------------------------------------------------------------ + ;; Public API + ;; ------------------------------------------------------------------ + + ;; Initialize the cache for a given workspace root. Creates the + ;; cache directory structure and loads saved mtimes. + (define (cache-init! workspace-root) + (let ([root (string-append workspace-root "/" cache-dir-name)]) + (set! *cache-root* root) + (set! *mtimes* (make-hashtable string-hash string=?)) + (ensure-directory root) + (ensure-directory (symbols-dir)) + (load-mtimes!) + (lsp-info "cache: initialized at" root))) + + ;; Save symbol data for a single URI. `symbols` should be a list + ;; of s-expression-serialisable symbol info records. + (define (cache-save-symbols! uri symbols) + (guard (exn + [#t (lsp-warn "cache: failed to save symbols for" uri exn)]) + (let ([path (symbol-cache-path uri)]) + (call-with-output-file path + (lambda (port) + (write symbols port) + (newline port)) + 'replace)) + (lsp-debug "cache: saved symbols for" uri))) + + ;; Load previously cached symbols for a URI. Returns a list of + ;; symbol data or #f if no cache entry exists. + (define (cache-load-symbols uri) + (let ([path (symbol-cache-path uri)]) + (if (file-exists? path) + (guard (exn + [#t (lsp-warn "cache: failed to load symbols for" uri exn) + #f]) + (call-with-input-file path read)) + #f))) + + ;; Check whether a file (identified by URI) has changed since the + ;; last recorded mtime. Returns #t when re-indexing is needed: + ;; - file has no cached mtime + ;; - file's current mtime differs from cached + ;; - file does not exist (returns #t so caller can clean up) + (define (cache-file-changed? uri file-path) + (let ([cached (hashtable-ref *mtimes* uri #f)]) + (cond + [(not cached) #t] + [(not (file-exists? file-path)) #t] + [else + (let* ([mt (file-modification-time file-path)] + [sec (time-second mt)] + [nsec (time-nanosecond mt)]) + (not (and (= sec (car cached)) + (= nsec (cdr cached)))))]))) + + ;; Record the current mtime for a file. Call this after + ;; successfully indexing a file. Persists the full mtime table + ;; to disk. + (define (cache-update-mtime! uri file-path) + (when (file-exists? file-path) + (let* ([mt (file-modification-time file-path)] + [sec (time-second mt)] + [nsec (time-nanosecond mt)]) + (hashtable-set! *mtimes* uri (cons sec nsec)) + (save-mtimes!)))) + + ;; Remove all cached data and the cache directory. + (define (cache-clear!) + (when *cache-root* + (guard (exn + [#t (lsp-warn "cache: error during clear" exn)]) + ;; Remove symbol files + (let ([sdir (symbols-dir)]) + (when (file-directory? sdir) + (for-each + (lambda (name) + (let ([p (string-append sdir "/" name)]) + (when (file-exists? p) + (delete-file p)))) + (directory-list sdir)) + (delete-directory sdir))) + ;; Remove mtimes file + (let ([mp (mtimes-path)]) + (when (file-exists? mp) + (delete-file mp))) + ;; Remove cache root + (when (file-directory? (cache-root)) + (delete-directory (cache-root)))) + (set! *mtimes* (make-hashtable string-hash string=?)) + (set! *cache-root* #f) + (lsp-info "cache: cleared"))) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/lsp/analysis/completion-data.ss @@ -0,0 +1,173 @@ +#!chezscheme +;;; lsp/analysis/completion-data -- Completion candidate generation + +(library (lsp analysis completion-data) + (export completion-candidates jerboa-keywords + builtin-completions) + (import (chezscheme) + (lsp types) + (lsp jsonrpc) + (lsp state) + (lsp util string) + (lsp util position) + (lsp analysis symbols) + ;; jerboa-keywords / builtin-completions / common-modules are + ;; generated by `make lsp-gen` from data/api-signatures.sexp. + (lsp analysis completion-tables)) + + + ;; Detect context at cursor position + ;; Returns: 'string, 'comment, 'import, 'head, 'normal + (define (detect-context text line col) + (let ([lines (string-split-lines text)]) + (if (>= line (length lines)) + 'normal + (let ([ln (list-ref lines line)]) + (cond + ;; In comment + [(in-comment? ln col) 'comment] + ;; In string + [(in-string? ln col) 'string] + ;; In import form + [(in-import-context? ln) 'import] + ;; Head position (right after open paren) + [(in-head-position? ln col) 'head] + [else 'normal]))))) + + (define (in-comment? line col) + (let ([len (string-length line)]) + (let loop ([i 0] [in-str? #f]) + (cond + [(>= i (min col len)) #f] + [(and (not in-str?) (char=? (string-ref line i) #\;)) #t] + [(char=? (string-ref line i) #\") + (loop (+ i 1) (not in-str?))] + [(and in-str? (char=? (string-ref line i) #\\)) + (loop (+ i 2) in-str?)] + [else (loop (+ i 1) in-str?)])))) + + (define (in-string? line col) + (let ([len (string-length line)]) + (let loop ([i 0] [in-str? #f]) + (cond + [(>= i (min col len)) in-str?] + [(and in-str? (char=? (string-ref line i) #\\)) + (loop (+ i 2) in-str?)] + [(char=? (string-ref line i) #\") + (loop (+ i 1) (not in-str?))] + [else (loop (+ i 1) in-str?)])))) + + (define (in-import-context? line) + (or (string-contains line "(import") + (string-contains line "(only") + (string-contains line "(except") + (string-contains line "(prefix"))) + + (define (in-head-position? line col) + ;; If the character before prefix is ( or [, we're in head position + (and (> col 0) + (< col (string-length line)) + (let loop ([i (- col 1)]) + (cond + [(< i 0) #f] + [(char-whitespace? (string-ref line i)) (loop (- i 1))] + [(memv (string-ref line i) '(#\( #\[)) #t] + [else #f])))) + + + ;; Build completion candidates from workspace + keywords + locals + (define (completion-candidates state uri text line col) + (let* ([prefix (extract-word-before text line col)] + [prefix-lower (string-downcase prefix)] + [context (detect-context text line col)] + [results '()]) + + ;; Suppress completions in strings and comments + (when (memq context '(string comment)) + (set! results '()) + (set! prefix-lower "")) ;; force empty, skip all sections below + + ;; 1. Keywords matching prefix + (for-each + (lambda (kw) + (when (prefix-match? prefix-lower kw) + (set! results + (cons (make-completion-item kw CK-KEYWORD "keyword") results)))) + jerboa-keywords) + + ;; 2. Local symbols from current document + (let ([syms (state-get-symbols state uri)]) + (for-each + (lambda (s) + (when (prefix-match? prefix-lower (sym-info-name s)) + (set! results + (cons (make-completion-item + (sym-info-name s) + (kind->completion-kind (sym-info-kind s)) + (sym-info-kind s)) + results)))) + syms)) + + ;; 3. Workspace symbols from other files + (let ([idx (server-state-symbol-index state)]) + (let-values ([(keys vals) (hashtable-entries idx)]) + (vector-for-each + (lambda (k v) + (unless (string=? k uri) + (for-each + (lambda (s) + (when (prefix-match? prefix-lower (sym-info-name s)) + (set! results + (cons (make-completion-item + (sym-info-name s) + (kind->completion-kind (sym-info-kind s)) + (string-append (sym-info-kind s) " (workspace)")) + results)))) + v))) + keys vals))) + + ;; 4. Builtin completions + (for-each + (lambda (b) + (when (prefix-match? prefix-lower (car b)) + (set! results + (cons (make-completion-item (car b) CK-FUNCTION (cdr b)) + results)))) + builtin-completions) + + ;; 5. Module name completions in import context + (when (eq? context 'import) + (for-each + (lambda (mod) + (when (or (string=? prefix-lower "") + (prefix-match? prefix-lower mod)) + (set! results + (cons (make-completion-item mod CK-MODULE "module") + results)))) + common-modules)) + + (reverse results))) + + (define (prefix-match? prefix-lower name) + (let ([name-lower (string-downcase name)] + [plen (string-length prefix-lower)]) + (and (> plen 0) + (>= (string-length name-lower) plen) + (string=? prefix-lower (substring name-lower 0 plen))))) + + (define (kind->completion-kind kind) + (cond + [(string=? kind "function") CK-FUNCTION] + [(string=? kind "variable") CK-VARIABLE] + [(string=? kind "constant") CK-CONSTANT] + [(string=? kind "macro") CK-KEYWORD] + [(string=? kind "struct") CK-STRUCT] + [(string=? kind "class") CK-CLASS] + [(string=? kind "method") CK-METHOD] + [(string=? kind "field") CK-FIELD] + [(string=? kind "interface") CK-INTERFACE] + [(string=? kind "module") CK-MODULE] + [else CK-TEXT])) + + + ) ;; end library new file mode 100644 --- /dev/null +++ b/lsp/analysis/document.ss @@ -0,0 +1,54 @@ +#!chezscheme +;;; lsp/analysis/document -- Document state and text utilities + +(library (lsp analysis document) + (export document-line-at document-line-count + document-lines uri->file-path file-path->uri) + (import (chezscheme) + (lsp util string)) + + ;; Get line at 0-based index + (define (document-line-at text line-num) + (let ([lines (string-split-lines text)]) + (if (< line-num (length lines)) + (list-ref lines line-num) + ""))) + + ;; Count lines in text + (define (document-line-count text) + (length (string-split-lines text))) + + ;; Get all lines + (define (document-lines text) + (string-split-lines text)) + + ;; Convert file:// URI to filesystem path + (define (uri->file-path uri) + (cond + [(string-prefix? "file://" uri) + (let ([path (substring uri 7 (string-length uri))]) + ;; Handle percent-encoding for spaces, etc. + (uri-decode path))] + [else uri])) + + ;; Convert filesystem path to file:// URI + (define (file-path->uri path) + (string-append "file://" path)) + + ;; Simple percent-decoding + (define (uri-decode str) + (let ([len (string-length str)]) + (let loop ([i 0] [chars '()]) + (cond + [(>= i len) (list->string (reverse chars))] + [(and (char=? (string-ref str i) #\%) + (< (+ i 2) len)) + (let* ([hi (string-ref str (+ i 1))] + [lo (string-ref str (+ i 2))] + [val (string->number (string hi lo) 16)]) + (if val + (loop (+ i 3) (cons (integer->char val) chars)) + (loop (+ i 1) (cons #\% chars))))] + [else (loop (+ i 1) (cons (string-ref str i) chars))])))) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/lsp/analysis/index.ss @@ -0,0 +1,90 @@ +#!chezscheme +;;; lsp/analysis/index -- Workspace-wide symbol indexing + +(library (lsp analysis index) + (export index-workspace! index-file! find-jerboa-files + find-symbol-in-workspace) + (import (chezscheme) + (lsp util log) + (lsp util string) + (lsp state) + (lsp analysis document) + (lsp analysis parser) + (lsp analysis symbols)) + + ;; Index all .ss and .sls files in the workspace + (define (index-workspace! state) + (let ([root (server-state-workspace-root state)]) + (when root + (lsp-info "Indexing workspace:" root) + (let ([files (find-jerboa-files root)]) + (lsp-info "Found" (length files) "Jerboa files") + (for-each + (lambda (file) + (guard (e [#t (lsp-warn "Error indexing:" file)]) + (index-file! state file))) + files) + (lsp-info "Indexing complete"))))) + + ;; Index a single file + (define (index-file! state file-path) + (let ([uri (file-path->uri file-path)]) + (guard (e [#t (lsp-debug "Parse error in" file-path ":" (condition-message e))]) + (let ([text (or (state-get-document state uri) + (read-file-to-string file-path))]) + (when text + (let ([forms (parse-source text file-path)]) + (let ([syms (extract-symbols forms)]) + (state-set-symbols! state uri syms)))))))) + + ;; Find all .ss and .sls files in a directory tree + (define (find-jerboa-files root) + (let ([result '()]) + (define (scan dir) + (guard (e [#t (void)]) + (let ([entries (directory-list dir)]) + (for-each + (lambda (entry) + (let ([path (string-append dir "/" entry)]) + (cond + ;; Skip hidden dirs and common non-source dirs + [(string-prefix? "." entry) (void)] + [(member entry '("node_modules" ".git" ".gerbil" "__pycache__")) + (void)] + [(file-directory? path) (scan path)] + [(or (string-suffix? ".ss" entry) + (string-suffix? ".sls" entry)) + (set! result (cons path result))]))) + entries)))) + (scan root) + (reverse result))) + + ;; Find a symbol across all indexed files + (define (find-symbol-in-workspace state name) + (let ([uris (state-all-document-uris state)] + [idx-keys (vector->list + (hashtable-keys (server-state-symbol-index state)))]) + (let loop ([keys (append uris idx-keys)] [found '()]) + (if (null? keys) + found + (let* ([uri (car keys)] + [syms (state-get-symbols state uri)] + [matches (filter (lambda (s) (string=? (sym-info-name s) name)) syms)]) + (loop (cdr keys) + (append found + (map (lambda (s) (cons uri s)) matches)))))))) + + ;; Helper: read file to string + (define (read-file-to-string path) + (guard (e [#t #f]) + (let ([port (open-input-file path)]) + (let loop ([chars '()]) + (let ([ch (read-char port)]) + (if (eof-object? ch) + (begin (close-input-port port) + (list->string (reverse chars))) + (loop (cons ch chars)))))))) + + ;; Use remp (Chez built-in) instead of filter to avoid name clash + + ) ;; end library new file mode 100644 --- /dev/null +++ b/lsp/analysis/module.ss @@ -0,0 +1,120 @@ +#!chezscheme +;;; lsp/analysis/module -- Module resolution for Jerboa imports + +(library (lsp analysis module) + (export resolve-import-to-path resolve-module-path + extract-imports parse-import-spec + find-jerboa-home) + (import (chezscheme) + (lsp util log) + (lsp util string)) + + ;; Find JERBOA_HOME from environment or common locations + (define (find-jerboa-home) + (or (getenv "JERBOA_HOME") + (let ([home (getenv "HOME")]) + (and home + (let ([path (string-append home "/mine/jerboa")]) + (and (file-exists? (string-append path "/lib")) + path)))))) + + ;; Resolve a module path like (std sort) to a filesystem path + (define (resolve-module-path mod-spec) + (let ([jh (find-jerboa-home)]) + (if (not jh) + #f + (let ([path (module-spec->path mod-spec)]) + (if path + (let ([full (string-append jh "/lib/" path)]) + (cond + [(file-exists? (string-append full ".sls")) (string-append full ".sls")] + [(file-exists? (string-append full ".ss")) (string-append full ".ss")] + [(file-exists? (string-append full "/main.sls")) + (string-append full "/main.sls")] + [else #f])) + #f))))) + + ;; Convert module spec to relative path + ;; (std sort) -> "std/sort" + ;; (jerboa reader) -> "jerboa/reader" + (define (module-spec->path spec) + (cond + [(list? spec) + (string-join (map symbol->string spec) "/")] + [(symbol? spec) + (let ([s (symbol->string spec)]) + ;; Handle :std/sort notation + (if (and (> (string-length s) 0) (char=? (string-ref s 0) #\:)) + (substring s 1 (string-length s)) + s))] + [(string? spec) + ;; Handle ":std/sort" string notation + (if (string-prefix? ":" spec) + (substring spec 1 (string-length spec)) + spec)] + [else #f])) + + ;; Resolve an import spec from a specific file to a path + ;; Handles relative imports (./foo, ../bar) + (define (resolve-import-to-path import-spec current-file) + (cond + [(and (string? import-spec) (string-prefix? "./" import-spec)) + (resolve-relative-import import-spec current-file)] + [(and (string? import-spec) (string-prefix? "../" import-spec)) + (resolve-relative-import import-spec current-file)] + [else (resolve-module-path import-spec)])) + + (define (resolve-relative-import rel-path current-file) + (let* ([dir (module-path-parent current-file)] + [full (string-append dir "/" rel-path)]) + (cond + [(file-exists? (string-append full ".ss")) (string-append full ".ss")] + [(file-exists? (string-append full ".sls")) (string-append full ".sls")] + [else #f]))) + + (define (module-path-parent path) + (let ([parts (string-split path #\/)]) + (if (<= (length parts) 1) "." + (string-join (reverse (cdr (reverse parts))) "/")))) + + ;; Extract import specs from parsed forms + ;; Returns list of import specs (as lists of symbols) + (define (extract-imports forms) + (let loop ([fs forms] [imports '()]) + (if (null? fs) + (reverse imports) + (let ([form (if (pair? fs) (car fs) fs)]) + (let ([value (if (and (record? form) + ;; located-form check + (guard (e [#t #f]) + (let ([v ((record-accessor (record-rtd form) 0) form)]) + (pair? v)))) + ((record-accessor (record-rtd form) 0) form) + form)]) + (if (and (pair? value) (eq? (car value) 'import)) + (loop (cdr fs) + (append (reverse (parse-import-specs (cdr value))) imports)) + (loop (cdr fs) imports))))))) + + ;; Parse import sub-specs + (define (parse-import-specs specs) + (let loop ([ss specs] [result '()]) + (if (null? ss) + (reverse result) + (let ([s (car ss)]) + (loop (cdr ss) + (cons (parse-import-spec s) result)))))) + + ;; Parse a single import spec + ;; (std sort) -> (std sort) + ;; (only (std sort) sort!) -> (std sort) + ;; (except (std sort) internal) -> (std sort) + (define (parse-import-spec spec) + (cond + [(and (pair? spec) (memq (car spec) '(only except prefix rename))) + (if (pair? (cdr spec)) + (parse-import-spec (cadr spec)) + spec)] + [else spec])) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/lsp/analysis/parser.ss @@ -0,0 +1,112 @@ +#!chezscheme +;;; lsp/analysis/parser -- S-expression parser with position tracking +;;; +;;; Uses the Jerboa reader for full Gerbil-syntax support with source locations. +;;; Falls back to Chez's reader when jerboa reader is not available. + +(library (lsp analysis parser) + (export parse-source parse-source-safe + located-form? located-form-value located-form-line + located-form-column located-form-end-line located-form-end-column) + (import (chezscheme) + (lsp util log)) + + ;; A form with source location info + (define-record-type located-form + (fields value line column end-line end-column)) + + ;; Try to load jerboa reader, fall back to chez read + (define jerboa-reader-available? + (guard (e [#t #f]) + (eval '(import (jerboa reader))) + #t)) + + ;; Parse source text into a list of located-forms + (define (parse-source text . path) + (let ([file-path (if (null? path) #f (car path))]) + (if jerboa-reader-available? + (parse-with-jerboa-reader text file-path) + (parse-with-chez-reader text)))) + + ;; Safe version that catches errors and returns partial results + diagnostics + (define (parse-source-safe text . path) + (guard (e [#t (values '() (list (parse-error->diagnostic e)))]) + (let ([forms (apply parse-source text path)]) + (values forms '())))) + + (define (parse-error->diagnostic e) + ;; Return (line col message) triple + (list 0 0 (if (condition? e) + (condition-message e) + (format "Parse error: ~a" e)))) + + ;; Parse using the Jerboa reader (handles [...], {...}, keyword: syntax) + (define (parse-with-jerboa-reader text file-path) + (let ([read-all (eval 'jerboa-read-all)] + [annotated? (eval 'annotated-datum?)] + [annot-value (eval 'annotated-datum-value)] + [annot-source (eval 'annotated-datum-source)] + [src-line (eval 'source-location-line)] + [src-col (eval 'source-location-column)]) + (let ([forms (if file-path + (read-all (open-input-string text) file-path) + (read-all (open-input-string text)))]) + (map (lambda (form) + (if (annotated? form) + (let ([src (annot-source form)]) + (make-located-form + (strip-annotations form annotated? annot-value) + (- (src-line src) 1) ;; Convert 1-based to 0-based + (src-col src) + -1 -1)) ;; End position not tracked + (make-located-form form 0 0 -1 -1))) + forms)))) + + ;; Strip annotations recursively to get plain S-expressions + (define (strip-annotations form annotated? annot-value) + (let strip ([x form]) + (cond + [(annotated? x) (strip (annot-value x))] + [(pair? x) (cons (strip (car x)) (strip (cdr x)))] + [else x]))) + + ;; Parse using Chez's built-in reader (no [...] or {...} support) + (define (parse-with-chez-reader text) + (let ([port (open-input-string text)]) + (let loop ([forms '()] [line 0]) + ;; Track approximate line numbers by counting newlines + (skip-whitespace-tracking port) + (let ([form (guard (e [#t (eof-object)]) + (read port))]) + (if (eof-object? form) + (reverse forms) + (let ([cur-line (approximate-line port text)]) + (loop (cons (make-located-form form cur-line 0 -1 -1) forms) + cur-line))))))) + + ;; Approximate current line from port position + (define (approximate-line port text) + (let ([pos (port-position port)] + [len (string-length text)]) + (let loop ([i 0] [line 0]) + (cond + [(or (>= i pos) (>= i len)) line] + [(char=? (string-ref text i) #\newline) (loop (+ i 1) (+ line 1))] + [else (loop (+ i 1) line)])))) + + (define (skip-whitespace-tracking port) + (let loop () + (let ([ch (peek-char port)]) + (cond + [(eof-object? ch) (void)] + [(char-whitespace? ch) (read-char port) (loop)] + [(char=? ch #\;) + ;; Skip line comment + (let cloop () + (let ([c (read-char port)]) + (unless (or (eof-object? c) (char=? c #\newline)) + (cloop)))) + (loop)] + [else (void)])))) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/lsp/analysis/project-config.ss @@ -0,0 +1,175 @@ +#!chezscheme +;;; lsp/analysis/project-config -- Read and merge project configuration + +(library (lsp analysis project-config) + (export load-project-config + project-config-library-dirs + project-config-exclude-patterns + project-config-get) + (import (chezscheme) + (lsp jsonrpc) + (lsp util log) + (lsp util string) + (std text json)) + + ;; Default config values + (define default-library-dirs '()) + (define default-exclude-patterns '(".git" "node_modules" ".build")) + (define default-diagnostics-on-save #t) + (define default-format-line-width 80)