simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

More library-compat fixes from porting the examples (markdown, malli)

Browse source 
Reader / loader:
- #?@ splicing reader conditionals now actually splice the matched collection's
  items into the enclosing sequence; the splice flag was read but ignored, so a
  binding vector like [a #?@(:clj [b (.foo b)])] lost its alignment.
- the file loader reads by position and skips a top-level form that reads as
  nothing (a :cljs-only #?, a #_ discard, a trailing comment) instead of
  treating it as EOF — which silently dropped the rest of a large .cljc file.
- jolt's reader feature set now includes :clj (was {:jolt :default}). jolt is a
  Clojure/JVM-compatible host that emulates clojure.lang.* and java.* interop,
  so it reads the :clj branch of a .cljc library, not :cljs. This also lets four
  more reader-conditional corpus cases pass (floor 2726 -> 2730).

Backend:
- munge-name escapes ' (prime) -> _PRIME_; a Clojure symbol like f' otherwise
  emitted a bare ' into Scheme, which is the quote reader macro and unbalanced
  the output.

Host shims:
- clojure.java.io/writer (pass through a StringWriter, file-back a path) and a
  readLine on the string reader, so line-seq over (io/reader …) works (markdown).

A better "unsupported destructuring pattern: <pat>" error message.
This commit is contained in:
Yogthos 2026-06-22 02:25:11 -04:00
parent 7e2704642b
commit 2de0543613
9 changed files with 93 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

27
host/chez/host-static.ss
View file

@ -294,6 +294,20 @@
(cons "close" (lambda (self) jolt-nil))
(cons "toString" (lambda (self) (sb-str self)))))
;; a file-backed writer (clojure.java.io/writer of a File/path): accumulates like
;; StringWriter, then persists to the path on flush/close, so
;; (with-open [w (io/writer "f")] (.write w …)) writes the file. State #(path buf).
(define (fw-path self) (vector-ref (jhost-state self) 0))
(define (fw-buf self) (vector-ref (jhost-state self) 1))
(define (fw-append! self s) (vector-set! (jhost-state self) 1 (string-append (fw-buf self) s)))
(define (fw-flush! self) (jolt-spit (fw-path self) (fw-buf self))) ; jolt-spit: io.ss
(register-host-methods! "file-writer"
(list (cons "write" (lambda (self x) (fw-append! self (writer-piece x)) jolt-nil))
(cons "append" (lambda (self x) (fw-append! self (render-piece x)) self))
(cons "flush" (lambda (self) (fw-flush! self) jolt-nil))
(cons "close" (lambda (self) (fw-flush! self) jolt-nil))
(cons "toString" (lambda (self) (fw-buf self)))))
;; ---- StringReader -----------------------------------------------------------
;; state: a vector #(string pos marked).
(register-class-ctor! "StringReader"
@ -310,6 +324,19 @@
(cons "reset" (lambda (self) (sr-pos! self (vector-ref (jhost-state self) 2)) jolt-nil))
(cons "skip" (lambda (self n) (let ((n (jnum->exact n)))
(sr-pos! self (min (string-length (sr-s self)) (+ (sr-pos self) n))) (->num n))))
;; readLine: the next line without its terminator (\n or \r\n), nil at EOF —
;; what line-seq drives over a BufferedReader.
(cons "readLine"
(lambda (self)
(let ((s (sr-s self)) (p (sr-pos self)) (len (string-length (sr-s self))))
(if (>= p len) jolt-nil
(let scan ((i p))
(cond
((>= i len) (sr-pos! self len) (substring s p len))
((char=? (string-ref s i) #\newline)
(sr-pos! self (+ i 1))
(substring s p (if (and (> i p) (char=? (string-ref s (- i 1)) #\return)) (- i 1) i)))
(else (scan (+ i 1)))))))))
(cons "close" (lambda (self) jolt-nil))))
;; ---- PushbackReader ---------------------------------------------------------

13
host/chez/io.ss
View file

@ -245,9 +245,22 @@
(host-new "StringReader" (seq-source->string x)))
(else (host-new "StringReader" (jolt-str-render-one x)))))
;; --- clojure.java.io/writer: an existing writer passes through; a File / path
;; gets a file-backed writer (host-static.ss "file-writer") that persists on
;; flush/close. Mirrors io.clj's writer over the host's StringWriter/file ports.
(define (jolt-io-writer x)
(cond
((and (jhost? x) (string=? (jhost-tag x) "writer")) x)
((and (jhost? x) (string=? (jhost-tag x) "file-writer")) x)
((jfile? x) (make-jhost "file-writer" (vector (jfile-path x) "")))
((string? x) (make-jhost "file-writer" (vector x "")))
(else (error #f "io/writer: don't know how to create a writer from" x))))
;; --- clojure.java.io ns -----------------------------------------------------
(def-var! "clojure.java.io" "file" jolt-make-file)
(def-var! "clojure.java.io" "as-file" (lambda (x) (if (jfile? x) x (make-jfile (file-path-of x)))))
(def-var! "clojure.java.io" "reader" jolt-io-reader)
(def-var! "clojure.java.io" "writer" jolt-io-writer)
(def-var! "clojure.java.io" "input-stream" jolt-io-reader)
(def-var! "clojure.java.io" "output-stream" jolt-io-writer)
(def-var! "clojure.java.io" "as-url" (lambda (x) (if (and (jhost? x) (string=? (jhost-tag x) "url")) x (make-url (jolt-str-render-one x)))))

19
host/chez/loader.ss
View file

@ -57,12 +57,21 @@
;; Read every form from a file and compile+eval it in turn. The first form is
;; normally (ns …), which expands to (in-ns …) and switches the current ns, so
;; later forms compile in that namespace — (chez-current-ns) is re-read each step.
;;
;; Reads by POSITION rather than via __parse-next: a top-level form that reads as
;; nothing — a :cljs-only #? with no matching branch, a #_ discard, a trailing
;; comment — yields rdr-eof but still advances. parse-next collapses that to "no
;; more forms", which would silently drop the entire rest of the file; here we
;; skip the no-op form and continue to true end-of-string.
(define (load-jolt-file path)
(let loop ((src (read-file-string path)))
(let ((pn (jolt-parse-next src)))
(unless (jolt-nil? pn)
(jolt-compile-eval-form (jolt-nth pn 0) (chez-current-ns))
(loop (jolt-nth pn 1))))))
(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)
(jolt-compile-eval-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

34
host/chez/reader.ss
View file

@ -33,6 +33,10 @@
(define rdr-eof (list 'reader-eof))
(define (rdr-eof? x) (eq? x rdr-eof))
;; A splicing reader conditional #?@(...) yields this wrapper; the enclosing
;; sequence reader splices its items in place (never a legal jolt value).
(define-record-type rdr-splice-t (fields items) (nongenerative rdr-splice-v1))
(define (rdr-ws? c)
(or (char-whitespace? c) (char=? c #\,)))
@ -248,9 +252,11 @@
((char=? (string-ref s i) close) (values (reverse acc) (+ i 1)))
(else
(let-values (((form j) (rdr-read-form s i end)))
(if (rdr-eof? form)
(loop j acc) ; a #_ discard or close — re-check at j
(loop j (cons form acc)))))))))
(cond
((rdr-eof? form) (loop j acc)) ; a #_ discard or no-match #? — re-check at j
((rdr-splice-t? form) ; #?@ — splice the matched collection's items
(loop j (append (reverse (rdr-splice-t-items form)) acc)))
(else (loop j (cons form acc))))))))))
;; Map literals must preserve SOURCE key order so the analyzer emits the value
;; expressions in source order (Clojure guarantees left-to-right map-literal eval).
@ -360,9 +366,13 @@
(if rest-sym (list (jolt-symbol #f "&") rest-sym) '()))))
(values (jolt-list (jolt-symbol #f "fn*") (apply jolt-vector params) body) j))))))
;; reader conditionals (jolt-qjr0): jolt's feature set is {:jolt :default}; the
;; FIRST clause whose feature key is in the set wins (clause order, like Clojure).
(define rdr-features '("jolt" "default"))
;; reader conditionals (jolt-qjr0): jolt's feature set is {:jolt :clj :default};
;; the FIRST clause whose feature key is in the set wins (clause order, like
;; Clojure). jolt is a Clojure/JVM-compatible host — it emulates clojure.lang.*
;; and java.* interop — so it reads the :clj branch of a .cljc library (the JVM
;; code path its host shims target), not the :cljs one. A library can still
;; override with a :jolt-specific branch (place it before :clj).
(define rdr-features '("jolt" "clj" "default"))
(define (rdr-feature? kw)
(and (keyword? kw) (jolt-nil? (let ((n (keyword-t-ns kw))) (if n n jolt-nil)))
(and (member (keyword-t-name kw) rdr-features) #t)))
@ -376,7 +386,17 @@
(else '()))))
(let loop ((xs items))
(cond ((or (null? xs) (null? (cdr xs))) (values rdr-eof j)) ; no match -> discard
((rdr-feature? (car xs)) (values (cadr xs) j))
((rdr-feature? (car xs))
(if splice
;; #?@ — the matched value is a collection whose ITEMS splice
;; into the enclosing sequence (read-seq expands the wrapper).
(let ((v (cadr xs)))
(values (make-rdr-splice-t
(cond ((pvec? v) (seq->list v))
((or (cseq? v) (empty-list-t? v)) (seq->list v))
(else (list v))))
j))
(values (cadr xs) j)))
(else (loop (cddr xs)))))))))
(define (rdr-read-dispatch s i end) ; i points just past the '#'

4
host/chez/run-corpus.ss
View file

@ -11,7 +11,7 @@
;; reset between cases so there is no leakage — same isolation a fresh process gives.
;;
;; chez --script host/chez/run-corpus.ss
;; JOLT_CHEZ_ZJ_FLOOR=N override the regression floor (default 2726)
;; JOLT_CHEZ_ZJ_FLOOR=N override the regression floor (default 2730)
;; JOLT_CORPUS_LIMIT=N every-Nth stride (fast iteration; floor drops to 0)
;; JOLT_DUMP_CRASH_LABELS=1 list crash + allowlisted labels
(import (chezscheme))
@ -196,7 +196,7 @@
;; Regression floor: fail on any NEW divergence or if pass drops below the floor.
(define base-floor (let ((s (getenv "JOLT_CHEZ_ZJ_FLOOR")))
(if s (string->number s) 2726)))
(if s (string->number s) 2730)))
(define floor (if limit 0 base-floor))
(when (or (> (length diverged) 0) (< pass floor))
(printf "REGRESSION: pass ~a < floor ~a or ~a new divergence(s)\n"

2
host/chez/seed/image.ss
View file

@ -131,7 +131,7 @@
(guard (e (#t #f))
(def-var-with-meta! "jolt.backend-scheme" "scheme-reserved" (let* ((_o$1341 "if") (_o$1342 "begin") (_o$1343 "lambda") (_o$1344 "let") (_o$1345 "let*") (_o$1346 "letrec") (_o$1347 "letrec*") (_o$1348 "quote") (_o$1349 "quasiquote") (_o$1350 "unquote") (_o$1351 "set!") (_o$1352 "define") (_o$1353 "define-syntax") (_o$1354 "cond") (_o$1355 "case") (_o$1356 "when") (_o$1357 "unless") (_o$1358 "and") (_o$1359 "or") (_o$1360 "do") (_o$1361 "else") (_o$1362 "guard") (_o$1363 "parameterize") (_o$1364 "delay") (_o$1365 "values")) (jolt-hash-set _o$1341 _o$1342 _o$1343 _o$1344 _o$1345 _o$1346 _o$1347 _o$1348 _o$1349 _o$1350 _o$1351 _o$1352 _o$1353 _o$1354 _o$1355 _o$1356 _o$1357 _o$1358 _o$1359 _o$1360 _o$1361 _o$1362 _o$1363 _o$1364 _o$1365)) (jolt-hash-map (keyword #f "private") #t)))
(guard (e (#t #f))
(def-var! "jolt.backend-scheme" "munge-name" (letrec ((munge-name (lambda (s) (let fnrec1366 ((s s)) (let* ((s (jolt-invoke (var-deref "clojure.string" "replace") s "#" "_"))) (if (jolt-contains? (var-deref "jolt.backend-scheme" "scheme-reserved") s) (jolt-invoke (var-deref "clojure.core" "str") "_" s) s)))))) munge-name)))
(def-var! "jolt.backend-scheme" "munge-name" (letrec ((munge-name (lambda (s) (let fnrec1366 ((s s)) (let* ((s (jolt-invoke (var-deref "clojure.string" "replace") (jolt-invoke (var-deref "clojure.string" "replace") s "#" "_") "'" "_PRIME_"))) (if (jolt-contains? (var-deref "jolt.backend-scheme" "scheme-reserved") s) (jolt-invoke (var-deref "clojure.core" "str") "_" s) s)))))) munge-name)))
(guard (e (#t #f))
(declare-var! "jolt.backend-scheme" "emit"))
(guard (e (#t #f))

2
host/chez/seed/prelude.ss
View file

File diff suppressed because one or more lines are too long

2
jolt-core/clojure/core/00-syntax.clj
View file

@ -247,7 +247,7 @@
a
(proc k `(get ~gm ~(get pat k)) a)))
g3 (keys pat)))
:else (throw (str "unsupported destructuring pattern"))))
:else (throw (str "unsupported destructuring pattern: " (pr-str pat)))))
ploop
(fn* ploop [i acc]
(if (< i (count bindings))

8
jolt-core/jolt/backend_scheme.clj
View file

@ -120,7 +120,13 @@
;; starts a datum in Scheme, so replace it with `_`. A name that collides with a
;; Scheme keyword is prefixed with `_` so it can never shadow the emitted form.
(defn- munge-name [s]
(let [s (str/replace s "#" "_")]
;; A Clojure symbol may contain chars that break a Scheme identifier: ' is the
;; quote reader macro (a bare f' would read as f then 'rest), # already maps to
;; _. Munge both to safe tokens; the same mapping applies at the binding and at
;; every reference, so resolution stays consistent.
(let [s (-> s
(str/replace "#" "_")
(str/replace "'" "_PRIME_"))]
(if (contains? scheme-reserved s) (str "_" s) s)))
(declare emit)