diff --git a/docs/building-and-deps.md b/docs/building-and-deps.md index 7251486..5341769 100644 --- a/docs/building-and-deps.md +++ b/docs/building-and-deps.md @@ -61,7 +61,8 @@ bin/joltc run -m NS [args] # resolve deps.edn, load NS, call its -main bin/joltc run FILE # resolve deps.edn, load a Clojure file bin/joltc -M:alias [args] # run the alias's :main-opts bin/joltc -A:alias [args] # add the alias's paths/deps, then run the rest -bin/joltc repl # start a line REPL +bin/joltc repl # start a line REPL (project deps + native libs loaded) +bin/joltc nrepl [port] # start an nREPL server (default 7888) for editors bin/joltc path # print the resolved source roots (':'-joined) bin/joltc # run a deps.edn :tasks entry ``` diff --git a/host/chez/io.ss b/host/chez/io.ss index fc7bfe3..7cf189b 100644 --- a/host/chez/io.ss +++ b/host/chez/io.ss @@ -202,6 +202,12 @@ (set! jolt-str-render-one (lambda (v) (if (jfile? v) (jfile-path v) (%io-str-render v)))) +;; stdin line seam: the clojure.core *in* reader (50-io.clj) drives read-line / +;; read / read+string through __stdin-read-line. Return the next line (newline +;; stripped) or nil at EOF. Without this, (read-line) and the REPL call nil. +(def-var! "clojure.core" "__stdin-read-line" + (lambda () (let ((l (get-line (current-input-port)))) (if (eof-object? l) jolt-nil l)))) + ;; (type f) -> :jolt/file (the tagged-file :jolt/type). Re-def-var! ;; "type": natives-meta.ss already bound the var to the old jolt-type value, so the ;; set! alone (which updates the symbol for internal callers) wouldn't reach it. diff --git a/host/chez/records.ss b/host/chez/records.ss index 00cd03a..77a5d4f 100644 --- a/host/chez/records.ss +++ b/host/chez/records.ss @@ -256,6 +256,11 @@ (let loop ((xs irr) (acc m)) (if (null? xs) acc (loop (cdr xs) (string-append acc " " (jolt-pr-str (car xs))))))) (with-output-to-string (lambda () (display-condition c))))) +;; expose a Chez condition's message to Clojure (ex-message returns nil for raw +;; host conditions): the nREPL eval handler surfaces it instead of an opaque +;; "#". +(def-var! "jolt.host" "condition-message" + (lambda (c) (if (condition? c) (condition->message-string c) jolt-nil))) (define (record-method-dispatch obj method-name rest-args) (let ((rest (if (jolt-nil? rest-args) '() (seq->list rest-args)))) (cond diff --git a/jolt-core/jolt/main.clj b/jolt-core/jolt/main.clj index 6cfe3dc..e790088 100644 --- a/jolt-core/jolt/main.clj +++ b/jolt-core/jolt/main.clj @@ -86,13 +86,20 @@ (println (str/join ":" roots)))) (defn- repl [] + ;; resolve the project so deps (git libs) are on the roots and native libs are + ;; loaded — same context a run gets, so (require '[some.lib]) works in the REPL. + (try (apply-project! (deps/resolve-project (project-dir))) + (catch :default _ nil)) (println ";; jolt repl — ^D to exit") (loop [] (print "user=> ") (flush) (let [line (read-line)] (when line (try (println (pr-str (load-string line))) - (catch :default e (println "error:" (ex-message e)))) + (catch :default e + (println "error:" (or (ex-message e) + (try ((resolve 'jolt.host/condition-message) e) (catch :default _ nil)) + (pr-str e))))) (recur))))) ;; A deps.edn :tasks entry: a string is a shell command; a map is {:main-opts …}. @@ -105,6 +112,15 @@ (map? task) (do (apply-project! resolved) (apply-main-opts (:main-opts task) more)) :else (throw (ex-info (str "bad task " name) {}))))) +(defn- nrepl [more] + ;; resolve the project (deps on the roots, native libs loaded), then start the + ;; nREPL server so an editor can connect and (require '[some.lib]) live. + (try (apply-project! (deps/resolve-project (project-dir))) (catch :default _ nil)) + (let [port (or (some-> (first (filter #(not (str/starts-with? % "-")) more)) parse-long) + (parse-long (or (jolt.host/getenv "JOLT_NREPL_PORT") "7888")))] + (require 'jolt.nrepl) + ((resolve 'jolt.nrepl/start) port))) + (defn- usage [] (println "usage: jolt [args]") (println " run -m NS [args] resolve deps.edn, load NS, call its -main") @@ -112,6 +128,7 @@ (println " -M:alias [args] run the alias's :main-opts") (println " -A:alias [args] add the alias's paths/deps") (println " repl start a line REPL") + (println " nrepl [port] start an nREPL server (default 7888) for editors") (println " path print the resolved source roots") (println " run a deps.edn :tasks entry")) @@ -121,6 +138,7 @@ (nil? cmd) (usage) (= cmd "run") (cmd-run more) (= cmd "repl") (repl) + (= cmd "nrepl") (nrepl more) (= cmd "path") (cmd-path) (str/starts-with? cmd "-M") (cmd-M cmd more) (str/starts-with? cmd "-A") (cmd-A cmd more) diff --git a/jolt-core/jolt/nrepl.clj b/jolt-core/jolt/nrepl.clj new file mode 100644 index 0000000..7d446b4 --- /dev/null +++ b/jolt-core/jolt/nrepl.clj @@ -0,0 +1,188 @@ +(ns jolt.nrepl + "A minimal nREPL server for jolt, so an editor (CIDER / Calva / Cursive) can + connect and develop a project live. Speaks bencode over a loopback TCP socket + bound through jolt.ffi; supports the ops a client needs to connect and eval: + clone, describe, eval, load-file, close. The project's deps are already on the + source roots and its native libs loaded (jolt.main applies the project before + starting the server), so (require '[some.lib]) works at the REPL. + + Writes .nrepl-port in the project dir so editors auto-detect the port." + (:require [clojure.string :as str] + [jolt.ffi :as ffi])) + +;; --- sockets (loopback server) --------------------------------------------- +;; Load libc (the running process's symbols) BEFORE the foreign-fn bindings below +;; — defcfn resolves the C entry point when the def is evaluated (at ns load), so +;; the socket symbols must already be available. +(ffi/load-library) +(ffi/defcfn c-socket "socket" [:int :int :int] :int) +(ffi/defcfn c-bind "bind" [:int :pointer :int] :int) +(ffi/defcfn c-listen "listen" [:int :int] :int) +(ffi/defcfn c-setsockopt "setsockopt" [:int :int :int :pointer :int] :int) +(ffi/defcfn c-accept "accept" [:int :pointer :pointer] :int :blocking) +(ffi/defcfn c-recv "recv" [:int :pointer :size_t :int] :ssize_t :blocking) +(ffi/defcfn c-send "send" [:int :pointer :size_t :int] :ssize_t :blocking) +(ffi/defcfn c-close "close" [:int] :int) + +(def ^:private AF-INET 2) +(def ^:private SOCK-STREAM 1) +(def ^:private macos? + (str/includes? (str/lower-case (or (System/getProperty "os.name") "")) "mac")) +(def ^:private sol-socket (if macos? 0xffff 1)) +(def ^:private so-reuse (if macos? 4 2)) + +(defn- make-sockaddr [port] + (let [sa (ffi/alloc 16)] + (dotimes [i 16] (ffi/write sa :uint8 i 0)) + (if macos? + (do (ffi/write sa :uint8 0 16) (ffi/write sa :uint8 1 AF-INET)) + (ffi/write sa :uint8 0 AF-INET)) + (ffi/write sa :uint8 2 (bit-and (bit-shift-right port 8) 0xff)) + (ffi/write sa :uint8 3 (bit-and port 0xff)) + (ffi/write sa :uint8 4 127) (ffi/write sa :uint8 7 1) ; 127.0.0.1 + sa)) + +(defn- listen-socket [port] + (ffi/load-library) ; libc process symbols + (let [fd (c-socket AF-INET SOCK-STREAM 0)] + (when (neg? fd) (throw (ex-info "socket() failed" {}))) + (let [opt (ffi/alloc 4)] (ffi/write opt :int 0 1) (c-setsockopt fd sol-socket so-reuse opt 4) (ffi/free opt)) + (let [sa (make-sockaddr port)] + (when (neg? (c-bind fd sa 16)) (c-close fd) (ffi/free sa) (throw (ex-info (str "bind() failed on port " port) {}))) + (ffi/free sa)) + (when (neg? (c-listen fd 16)) (c-close fd) (throw (ex-info "listen() failed" {}))) + fd)) + +;; bytes flow as latin1 strings on the wire (1 char = 1 byte). Text fields that +;; may carry unicode (code / value / out) convert at the boundary. +(defn- ->wire [s] (String. (.getBytes (str s) "UTF-8") "ISO-8859-1")) +(defn- wire-> [s] (String. (byte-array (map int s)) "UTF-8")) + +(def ^:private bufsize 65536) +(defn- recv-str [fd] + (let [buf (ffi/alloc bufsize)] + (try (let [n (c-recv fd buf bufsize 0)] + (when (pos? n) (String. (ffi/read-array buf n) "ISO-8859-1"))) + (finally (ffi/free buf))))) + +(defn- send-str [fd s] + (let [data (byte-array (map int s)) n (alength data) buf (ffi/alloc (max 1 n))] + (try (ffi/write-array buf data) + (loop [off 0] (when (< off n) (let [sent (c-send fd (+ buf off) (- n off) 0)] + (when (pos? sent) (recur (+ off sent)))))) + (finally (ffi/free buf))))) + +;; --- bencode --------------------------------------------------------------- +(defn- bencode [v] + (cond + (integer? v) (str "i" v "e") + (string? v) (let [w (->wire v)] (str (count w) ":" w)) + (keyword? v) (let [w (->wire (name v))] (str (count w) ":" w)) + (map? v) (str "d" (apply str (mapcat (fn [[k val]] [(bencode (name k)) (bencode val)]) + (sort-by #(name (first %)) v))) "e") + (or (seq? v) (vector? v)) (str "l" (apply str (map bencode v)) "e") + (nil? v) "0:" + :else (let [w (->wire (str v))] (str (count w) ":" w)))) + +;; decode one value from `s` at index `i` -> [value next-index], or nil if the +;; buffer doesn't yet hold a complete value. +(defn- bdecode [s i] + (when (< i (count s)) + (let [c (nth s i)] + (cond + (= c \i) (let [e (str/index-of s "e" i)] + (when e [(parse-long (subs s (inc i) e)) (inc e)])) + (= c \l) (loop [j (inc i) acc []] + (cond (>= j (count s)) nil + (= (nth s j) \e) [acc (inc j)] + :else (let [r (bdecode s j)] (when r (recur (second r) (conj acc (first r))))))) + (= c \d) (loop [j (inc i) acc {}] + (cond (>= j (count s)) nil + (= (nth s j) \e) [acc (inc j)] + :else (let [k (bdecode s j)] + (when k (let [val (bdecode s (second k))] + (when val (recur (second val) (assoc acc (wire-> (first k)) (first val))))))))) + (and (char? c) (>= (int c) 48) (<= (int c) 57)) ; string: : + (let [colon (str/index-of s ":" i)] + (when colon + (let [n (parse-long (subs s i colon)) start (inc colon) end (+ start n)] + (when (<= end (count s)) [(subs s start end) end])))) + :else nil)))) + +;; --- eval ------------------------------------------------------------------ +(def ^:private session-counter (atom 0)) +(defn- new-session [] (str "jolt-" (swap! session-counter inc))) + +(defn- err-msg [e] + (or (ex-message e) + (try ((resolve 'jolt.host/condition-message) e) (catch :default _ nil)) + (pr-str e))) + +(defn- eval-in-ns [ns-str code] + ;; evaluate in the requested ns if it's loaded (CIDER sends :ns with each eval). + ;; in-ns — not (binding [*ns* ..]) — sets the ns load-string resolves against on + ;; jolt; it persists for the next eval (fine for a serial editor session). + (when (and ns-str (not (str/blank? ns-str)) (find-ns (symbol ns-str))) + (in-ns (symbol ns-str))) + (load-string code)) + +(defn- do-eval [code ns-str] + ;; eval the code, capturing *out*; return {:value .. :out .. :ns .. :err ..}. + (let [result (atom nil) err (atom nil) + out (with-out-str + (try (reset! result (eval-in-ns ns-str (wire-> code))) + (catch :default e (reset! err (err-msg e)))))] + {:value (when (nil? @err) (pr-str @result)) + :out out + :ns (str (ns-name *ns*)) + :err @err})) + +(defn- handle-msg [fd msg] + (let [op (get msg "op") + id (get msg "id") + session (or (get msg "session") "none") + base (fn [m] (cond-> m id (assoc "id" id) session (assoc "session" session))) + reply (fn [m] (send-str fd (bencode (base m))))] + (cond + (= op "clone") (reply {"new-session" (new-session) "status" ["done"]}) + (= op "close") (reply {"status" ["session-closed" "done"]}) + (= op "describe") (reply {"status" ["done"] + "versions" {"jolt-nrepl" {"major" 0 "minor" 1}} + "ops" {"clone" {} "close" {} "describe" {} "eval" {} "load-file" {}}}) + (or (= op "eval") (= op "load-file")) + (let [code (if (= op "load-file") (get msg "file") (get msg "code")) + {:keys [value out ns err]} (do-eval code (get msg "ns"))] + (when (seq out) (reply {"out" out})) + (if err + (do (reply {"err" (str err "\n")}) (reply {"ex" (str err) "status" ["eval-error" "done"]})) + (reply {"value" value "ns" ns "status" ["done"]}))) + :else (reply {"status" ["done" "unknown-op"]})))) + +(defn- handle-conn [fd] + (loop [buf ""] + (let [chunk (recv-str fd)] + (if (nil? chunk) + (c-close fd) + (let [buf (str buf chunk) + ;; drain every complete message in the buffer + rest-buf (loop [b buf] + (let [r (bdecode b 0)] + (if (nil? r) b + (do (when (map? (first r)) (handle-msg fd (first r))) + (recur (subs b (second r)))))))] + (recur rest-buf)))))) + +(defn start + "Start the nREPL server on `port` (0 = an OS-assigned port is not supported here; + pass a concrete port). Writes .nrepl-port. Blocks accepting connections." + [port] + (let [fd (listen-socket port)] + (try (spit ".nrepl-port" (str port)) (catch :default _ nil)) + (println (str "nREPL server started on port " port " (127.0.0.1) — .nrepl-port written")) + (println ";; connect your editor; ^C to stop") + (loop [] + (let [conn (c-accept fd ffi/null ffi/null)] + (when (>= conn 0) + (future (try (handle-conn conn) + (catch :default e (println "nrepl conn error:" (ex-message e)) (c-close conn))))) + (recur)))))