diff --git a/host/chez/host-contract.ss b/host/chez/host-contract.ss index 7c850f7..27ce5be 100644 --- a/host/chez/host-contract.ss +++ b/host/chez/host-contract.ss @@ -119,8 +119,22 @@ (define (hc-inst-source x) (jolt-get x hc-kw-form)) (define (hc-uuid-source x) (jolt-get x hc-kw-form)) -;; The Chez reader does not record source offsets yet. -(define (hc-form-position x) jolt-nil) +;; Source position for a list form: the reader stamps :line/:column (+ :file when +;; compiling a file) into the form's metadata. Return a clean {:line :column +;; :file?} map, or nil for a synthetic/macro-built form that carries none. +(define hc-kw-line (keyword #f "line")) +(define hc-kw-column (keyword #f "column")) +(define hc-kw-file (keyword #f "file")) +(define (hc-form-position x) + (let ((m (jolt-meta x))) + (if (and (pmap? m) (not (jolt-nil? (jolt-get m hc-kw-line)))) + (let ((line (jolt-get m hc-kw-line)) + (col (jolt-get m hc-kw-column)) + (file (jolt-get m hc-kw-file))) + (if (jolt-nil? file) + (jolt-hash-map hc-kw-line line hc-kw-column col) + (jolt-hash-map hc-kw-line line hc-kw-column col hc-kw-file file))) + jolt-nil))) ;; --- special forms ---------------------------------------------------------- ;; Mirrors host_iface special-names + interop-head? — forms the analyzer marks diff --git a/host/chez/loader.ss b/host/chez/loader.ss index d2cd31d..b456642 100644 --- a/host/chez/loader.ss +++ b/host/chez/loader.ss @@ -169,17 +169,20 @@ ;; skip the no-op form and continue to true end-of-string. (define (load-jolt-file path) (let* ((src (read-file-string path)) (end (string-length src))) - (let loop ((i 0)) - (when (< i end) - (let-values (((form j) (rdr-read-form src i end))) - (when (> j i) - (unless (rdr-eof? form) - (when (getenv "JOLT_TRACE_LOAD") - (display " [load-form] " (current-error-port)) - (display (jolt-pr-str form) (current-error-port)) (newline (current-error-port))) - (jolt-compile-eval-form (if data-readers-active (ldr-apply-readers form) form) - (chez-current-ns))) - (loop j))))))) + ;; parameterize (not a bare set!) so a require nested in this file's ns form + ;; restores path when control returns to the rest of this file. + (parameterize ((rdr-source-file path)) ; list forms read here carry :file = path + (let loop ((i 0)) + (when (< i end) + (let-values (((form j) (rdr-read-form src i end))) + (when (> j i) + (unless (rdr-eof? form) + (when (getenv "JOLT_TRACE_LOAD") + (display " [load-form] " (current-error-port)) + (display (jolt-pr-str form) (current-error-port)) (newline (current-error-port))) + (jolt-compile-eval-form (if data-readers-active (ldr-apply-readers form) form) + (chez-current-ns))) + (loop j)))))))) ;; load-namespace: load `name`'s source once. Marked loaded BEFORE eval so a ;; dependency cycle terminates (Clojure's behavior). The caller's current ns is diff --git a/host/chez/reader.ss b/host/chez/reader.ss index 42a9abb..1d0a1e2 100644 --- a/host/chez/reader.ss +++ b/host/chez/reader.ss @@ -316,7 +316,11 @@ ;; (with-meta form meta) for a meta-carrying collection literal in code, so ;; (meta ^{:tag :int} [1 2]) / ^:foo {} still works. (else - (let ((c (jolt-with-meta target meta))) + ;; Merge onto any metadata the target already carries (a list form picks up + ;; :line/:column first, then ^meta folds its keys on top). + (let* ((old (jolt-meta target)) + (merged (rdr-merge-meta (if (jolt-nil? old) jolt-nil old) meta)) + (c (jolt-with-meta target merged))) ;; jolt-with-meta copies a pmap, giving it a fresh identity the rdr-map-order ;; side-table (source key order for left-to-right map-literal eval) loses — ;; carry the order entry over to the copy. @@ -324,6 +328,45 @@ (when order (hashtable-set! rdr-map-order c order))) c)))) +;; --- source position -------------------------------------------------------- +;; List forms (code) carry 1-based :line/:column, plus :file when the compiler +;; bound rdr-source-file. read-string leaves the file unset. The analyzer reads +;; this back via jolt.host/form-position to stamp :pos on call nodes; macros and +;; (meta (read-string "(…)")) see it too. +(define rdr-source-file (make-parameter #f)) +(define rdr-kw-line (keyword #f "line")) +(define rdr-kw-column (keyword #f "column")) +(define rdr-kw-file (keyword #f "file")) + +;; Forms are read left-to-right, so the indices queried are non-decreasing within +;; one source string — keep a cursor and count newlines only over the delta +;; (O(n) total, not O(n^2)). A different string or a backward index resets it. +(define rdr-pos-cursor (make-parameter #f)) ; #f | (vector s i line col) +(define (rdr-line-col-at s i) + (let* ((cur (rdr-pos-cursor)) + (reuse (and (vector? cur) (eq? (vector-ref cur 0) s) + (fx<=? (vector-ref cur 1) i))) + (k0 (if reuse (vector-ref cur 1) 0)) + (l0 (if reuse (vector-ref cur 2) 1)) + (c0 (if reuse (vector-ref cur 3) 1))) + (let loop ((k k0) (line l0) (col c0)) + (if (fx>=? k i) + (begin (rdr-pos-cursor (vector s k line col)) (values line col)) + (if (char=? (string-ref s k) #\newline) + (loop (fx+ k 1) (fx+ line 1) 1) + (loop (fx+ k 1) line (fx+ col 1))))))) + +(define (rdr-pos-meta line col) + (let ((f (rdr-source-file))) + (if f + (jolt-hash-map rdr-kw-line line rdr-kw-column col rdr-kw-file f) + (jolt-hash-map rdr-kw-line line rdr-kw-column col)))) + +(define (rdr-attach-pos lst line col) + (if (empty-list-t? lst) ; () is interned, can't carry meta (= Clojure) + lst + (rdr-attach-meta lst (rdr-pos-meta line col)))) + ;; --- # dispatch ------------------------------------------------------------- ;; #(...) anonymous fn shorthand: % -> p1, %N -> pN, %& -> rest. The ;; fixed arity is the MAX positional used (Clojure: #(do %2 %&) -> [p1 p2 & rest]). @@ -496,8 +539,9 @@ (values rdr-eof i) (let ((c (string-ref s i))) (cond - ((char=? c #\() (let-values (((es j) (rdr-read-seq s (+ i 1) end #\)))) - (values (apply jolt-list es) j))) + ((char=? c #\() (let-values (((line col) (rdr-line-col-at s i))) + (let-values (((es j) (rdr-read-seq s (+ i 1) end #\)))) + (values (rdr-attach-pos (apply jolt-list es) line col) j)))) ((char=? c #\[) (let-values (((es j) (rdr-read-seq s (+ i 1) end #\]))) (values (apply jolt-vector es) j))) ((char=? c #\{) (let-values (((es j) (rdr-read-seq s (+ i 1) end #\}))) diff --git a/test/chez/unit.edn b/test/chez/unit.edn index 6c0b5f9..004a0fe 100644 --- a/test/chez/unit.edn +++ b/test/chez/unit.edn @@ -331,6 +331,14 @@ {:suite "reader" :expr "(nil? (read-string \" , ,\"))" :expected "true"} {:suite "reader" :expr "(:tag (meta (read-string \"^String x\")))" :expected "String"} {:suite "reader" :expr "(:foo (meta (read-string \"^:foo x\")))" :expected "true"} + {:suite "reader" :expr "(:line (meta (read-string \"(foo bar)\")))" :expected "1"} + {:suite "reader" :expr "(:column (meta (read-string \"(foo bar)\")))" :expected "1"} + {:suite "reader" :expr "(:line (meta (read-string \"\\n\\n (x)\")))" :expected "3"} + {:suite "reader" :expr "(:column (meta (read-string \"\\n\\n (x)\")))" :expected "3"} + {:suite "reader" :expr "(nil? (meta (read-string \"[1 2]\")))" :expected "true"} + {:suite "reader" :expr "(nil? (meta (read-string \"()\")))" :expected "true"} + {:suite "reader" :expr "(:foo (meta (read-string \"^:foo (x y)\")))" :expected "true"} + {:suite "reader" :expr "(:line (meta (read-string \"^:foo (x y)\")))" :expected "1"} {:suite "reader" :expr "(= 42 (with-in-str \"42\" (read)))" :expected "true"} {:suite "reader" :expr "(= (quote (+ 1 2)) (with-in-str \"(+ 1 2)\" (read)))" :expected "true"} {:suite "reader" :expr "(with-in-str \"1 2\" [(read) (read)])" :expected "[1 2]"}