From 908ad63caadf743dbba407ecab19cc286f91f606 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Wed, 1 Jul 2026 10:57:55 -0400 Subject: [PATCH] Compile data readers that return code forms MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A registered #tag data reader whose fn returns a FORM (borkdude/html's #html expands to (->Html (str …))) was rewritten to a runtime call (reader-fn 'inner), so the returned code became a runtime list value instead of being compiled — (str #html [:div]) rendered the code, not "
". Clojure applies a data reader at read time and substitutes its result as code. loader.ss now applies the reader at load time: a code form (a list) is spliced in to be compiled, a value (time-literals #time/date -> a Date) keeps the runtime call, which also keeps a non-serializable constant out of an AOT build. The build emit path never applied data readers at all (a #tag literal failed a `jolt build` with "unsupported form"); emit-image.ss gets an ei-emit-form-hook the build sets to the same rewrite, left as a no-op elsewhere so the seed mint (which doesn't load loader.ss) is unaffected and the self-host byte-fixpoint holds. Also make clojure.test report the actual values of a failing (is (= a b)) — it printed only the form. Restricted to the common pure predicates so a macro head still takes the plain path. Fixture test/chez/datareader-app + a smoke check (interpreted) and a build-smoke check (AOT). make test green, no corpus change. --- host/chez/build-smoke.sh | 15 ++++++++++++- host/chez/build.ss | 7 +++++- host/chez/emit-image.ss | 14 +++++++++--- host/chez/loader.ss | 22 ++++++++++++++++--- host/chez/smoke.sh | 12 ++++++++++ stdlib/clojure/test.clj | 18 +++++++++++++++ test/chez/datareader-app/deps.edn | 1 + test/chez/datareader-app/src/data_readers.clj | 1 + test/chez/datareader-app/src/drtest/main.clj | 4 ++++ .../chez/datareader-app/src/drtest/reader.clj | 2 ++ 10 files changed, 88 insertions(+), 8 deletions(-) create mode 100644 test/chez/datareader-app/deps.edn create mode 100644 test/chez/datareader-app/src/data_readers.clj create mode 100644 test/chez/datareader-app/src/drtest/main.clj create mode 100644 test/chez/datareader-app/src/drtest/reader.clj diff --git a/host/chez/build-smoke.sh b/host/chez/build-smoke.sh index 9a4b536..68480df 100755 --- a/host/chez/build-smoke.sh +++ b/host/chez/build-smoke.sh @@ -116,4 +116,17 @@ fi if grep -q 'def-var! "clojure.core" "group-by"' "$out.build/flat.ss"; then echo " FAIL: --tree-shake kept an unreachable clojure.core fn (group-by)"; exit 1 fi -echo "build smoke: passed (release + optimized + direct-link + tree-shake + compiler+core shake)" +# A registered data reader that returns a CODE form must be compiled into the +# binary (the emit path applies it too, not just the interpreted loader): the +# datareader-app's #code literal builds to 42, not the literal list. +drapp="$root/test/chez/datareader-app" +drout="$(dirname "$out")/dr-bin" +if ! JOLT_PWD="$drapp" bin/joltc build -m drtest.main -o "$drout" >/dev/null 2>&1; then + echo " FAIL: jolt build of a data-reader app exited non-zero"; exit 1 +fi +got_dr="$(cd / && "$drout" 2>&1 | tail -1)" +if [ "$got_dr" != "42" ]; then + echo " FAIL: built #code data reader — want 42, got \`$got_dr\`"; exit 1 +fi + +echo "build smoke: passed (release + optimized + direct-link + tree-shake + compiler+core shake + data-reader)" diff --git a/host/chez/build.ss b/host/chez/build.ss index b4f7934..d4564a2 100644 --- a/host/chez/build.ss +++ b/host/chez/build.ss @@ -449,6 +449,11 @@ ;; whole-program param-type fixpoint before per-form emit (when (string=? mode "optimized") (bld-wp-infer! ordered))) (lambda () + ;; A #tag data-reader literal must compile in the binary the same as + ;; it loads interpreted — apply the reader rewrite to each emitted + ;; form too (no-op unless the app registered data readers). + (parameterize ((ei-emit-form-hook + (lambda (form) (if data-readers-active (ldr-apply-readers form) form)))) (if tree-shake? (dce-shake (dce-blob-records "host/chez/seed/prelude.ss") @@ -473,7 +478,7 @@ (append (bld-ns-prelude (car nf) src) (bld-emit-ns (car nf) src))))) ordered)) - #f))) + #f)))) (lambda () (set-optimize! #f) ((var-deref "jolt.backend-scheme" "set-direct-link!") #f))))) diff --git a/host/chez/emit-image.ss b/host/chez/emit-image.ss index d67c69f..286ad6a 100644 --- a/host/chez/emit-image.ss +++ b/host/chez/emit-image.ss @@ -63,15 +63,23 @@ ;; the seed minter (ei-emit-ns: optimize? #f, guard? #t — tolerant, skips a form ;; that fails to emit) and `jolt build` (bld-emit-ns: optimize? #t, guard? #f — ;; strict, a failing form errors the build). +;; A per-form transform applied to each read form before emit — the build sets it +;; to the data-reader rewrite (loader.ss ldr-apply-readers) so a registered #tag +;; literal compiles in a `jolt build` the same as it does in an interpreted load. +;; #f (the default, and during the seed mint where loader.ss isn't loaded) is no +;; transform, so emit-image.ss carries no loader dependency. +(define ei-emit-form-hook (make-parameter #f)) + (define (ei-emit-ns* ns-name src optimize? guard?) ;; set the ns before reading so ::kw auto-resolves against this ns (the runtime ;; loader reads form-by-form after the ns form sets it; the cross-compile reads ;; all forms up front, so set it here). (set-chez-ns! ns-name) - (let loop ((forms (ei-read-all src)) (acc '())) + (let ((hook (ei-emit-form-hook))) + (let loop ((forms (ei-read-all src)) (acc '())) (if (null? forms) (reverse acc) - (let ((f (car forms))) + (let ((f (let ((f0 (car forms))) (if hook (hook f0) f0)))) (ce-scan-requires! f ns-name) (cond ((ei-ns-form? f) (loop (cdr forms) acc)) @@ -89,7 +97,7 @@ (ei-compile-form (make-analyze-ctx ns-name) f optimize?)))) (loop (cdr forms) (if (and guard? (not scm)) acc - (cons (if guard? (string-append "(guard (e (#t #f))\n " scm ")") scm) acc)))))))))) + (cons (if guard? (string-append "(guard (e (#t #f))\n " scm ")") scm) acc))))))))))) (define (ei-emit-ns ns-name src) (ei-emit-ns* ns-name src #f #t)) diff --git a/host/chez/loader.ss b/host/chez/loader.ss index ad57dfd..00bd84a 100644 --- a/host/chez/loader.ss +++ b/host/chez/loader.ss @@ -57,9 +57,25 @@ ((and (pmap? x) (eq? (jolt-get x rdr-kw-jolt-type) rdr-kw-jolt-tagged)) (let ((rdr (data-reader-symbol (jolt-get x rdr-kw-tag))) (inner (ldr-apply-readers (jolt-get x rdr-kw-form)))) - (cond (rdr (jolt-list rdr (jolt-list (jolt-symbol #f "quote") inner))) - ((eq? inner (jolt-get x rdr-kw-form)) x) - (else (rdr-make-tagged (jolt-get x rdr-kw-tag) inner))))) + (cond + (rdr + ;; Clojure applies a data reader at read time and substitutes its result + ;; as code. A reader that returns a FORM (a list — e.g. borkdude.html's + ;; #html expands to (->Html (str …))) must be compiled, so splice it in. + ;; A reader that returns a VALUE (time-literals #time/date -> a Date) is + ;; left as a runtime call (reader-fn 'inner): the value rebuilds at + ;; startup, which also keeps a non-serializable constant out of an AOT + ;; build. Apply is guarded — a reader that can't run at load time (its + ;; deps not ready) falls back to the runtime call too. + (let ((result (and (symbol-t? rdr) (not (jolt-nil? (symbol-t-ns rdr))) + (guard (e (#t #f)) + (let ((fn (var-deref (symbol-t-ns rdr) (symbol-t-name rdr)))) + (and (procedure? fn) (jolt-invoke fn inner))))))) + (if (cseq? result) + result + (jolt-list rdr (jolt-list (jolt-symbol #f "quote") inner))))) + ((eq? inner (jolt-get x rdr-kw-form)) x) + (else (rdr-make-tagged (jolt-get x rdr-kw-tag) inner))))) ((rdr-set-form? x) (let-values (((items changed) (ldr-conv-each (seq->list (jolt-get x rdr-kw-value))))) (if changed (rdr-carry-meta x (rdr-make-set items)) x))) diff --git a/host/chez/smoke.sh b/host/chez/smoke.sh index 0ca1882..7343f5f 100755 --- a/host/chez/smoke.sh +++ b/host/chez/smoke.sh @@ -75,6 +75,18 @@ else fails=$((fails + 1)) fi +# A data reader that returns a CODE form (deps.edn data_readers.clj -> reader fn) +# must have its result spliced in and COMPILED, like Clojure — #code [:x] becomes +# (+ 40 2) and evaluates to 42, not the literal list. A project run so the source +# root's data_readers.clj is picked up. +dr_out="$(JOLT_PWD="$root/test/chez/datareader-app" bin/joltc run -m drtest.main 2>/dev/null | tail -1)" +if [ "$dr_out" = "42" ]; then + pass=$((pass + 1)) +else + echo " FAIL: code-returning data reader (#code) not compiled — got \`$dr_out\`, want 42" + fails=$((fails + 1)) +fi + # Unit-checks the REPL read-until-complete predicate over balanced/unbalanced, # string, comment and regex-literal inputs. A multi-form `joltc run` so jolt.main # is loaded and its private var resolves; the file self-checks and prints a sentinel. diff --git a/stdlib/clojure/test.clj b/stdlib/clojure/test.clj index 420da95..dabd851 100644 --- a/stdlib/clojure/test.clj +++ b/stdlib/clojure/test.clj @@ -102,6 +102,12 @@ (clojure.test/do-report {:type :error :message ~msg :form '~form :actual (clojure.test/err-text e#)})))) +;; The common pure predicates whose args `is` evaluates so a failure shows the +;; actual values — (is (= expected got)) prints `got`, not just the form. A macro +;; head (not in this set) keeps the plain form-only path. +(def ^:private reported-preds + '#{= not= == < > <= >= identical? contains? instance? nil? some? empty? even? odd? pos? neg? zero?}) + ;; --- class matching for thrown? -------------------------------------------- (defn- last-seg [s] @@ -173,6 +179,18 @@ (contains? (methods clojure.test/assert-expr) (first form))) (clojure.test/assert-expr msg form) + ;; a predicate call — (= a b), (< x y), (pred? v): evaluate the args so a + ;; failure shows the actual values, like clojure.test's assert-predicate. + (and (seq? form) (contains? clojure.test/reported-preds (first form))) + `(try + (let [vs# (list ~@(rest form))] + (if (apply ~(first form) vs#) + (clojure.test/inc-pass!) + (clojure.test/fail! (str (pr-str (list '~'not (cons '~(first form) vs#))) + (when ~msg (str " — " ~msg)))))) + (catch Throwable e# + (clojure.test/err! (str (pr-str '~form) " threw: " (clojure.test/err-text e#))))) + :else `(try (if ~form diff --git a/test/chez/datareader-app/deps.edn b/test/chez/datareader-app/deps.edn new file mode 100644 index 0000000..ccd9a31 --- /dev/null +++ b/test/chez/datareader-app/deps.edn @@ -0,0 +1 @@ +{:paths ["src"]} diff --git a/test/chez/datareader-app/src/data_readers.clj b/test/chez/datareader-app/src/data_readers.clj new file mode 100644 index 0000000..dec0d19 --- /dev/null +++ b/test/chez/datareader-app/src/data_readers.clj @@ -0,0 +1 @@ +{code drtest.reader/code-reader} diff --git a/test/chez/datareader-app/src/drtest/main.clj b/test/chez/datareader-app/src/drtest/main.clj new file mode 100644 index 0000000..63ce7ed --- /dev/null +++ b/test/chez/datareader-app/src/drtest/main.clj @@ -0,0 +1,4 @@ +(ns drtest.main + (:require drtest.reader)) +(defn -main [& _] + (println #code [:ignored])) diff --git a/test/chez/datareader-app/src/drtest/reader.clj b/test/chez/datareader-app/src/drtest/reader.clj new file mode 100644 index 0000000..43b7dd6 --- /dev/null +++ b/test/chez/datareader-app/src/drtest/reader.clj @@ -0,0 +1,2 @@ +(ns drtest.reader) +(defn code-reader [_form] (list '+ 40 2))