Compile data readers that return code forms
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 "<div>". 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.
This commit is contained in:
parent
1008e922d8
commit
908ad63caa
10 changed files with 88 additions and 8 deletions
|
|
@ -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)"
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
1
test/chez/datareader-app/deps.edn
Normal file
1
test/chez/datareader-app/deps.edn
Normal file
|
|
@ -0,0 +1 @@
|
|||
{:paths ["src"]}
|
||||
1
test/chez/datareader-app/src/data_readers.clj
Normal file
1
test/chez/datareader-app/src/data_readers.clj
Normal file
|
|
@ -0,0 +1 @@
|
|||
{code drtest.reader/code-reader}
|
||||
4
test/chez/datareader-app/src/drtest/main.clj
Normal file
4
test/chez/datareader-app/src/drtest/main.clj
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
(ns drtest.main
|
||||
(:require drtest.reader))
|
||||
(defn -main [& _]
|
||||
(println #code [:ignored]))
|
||||
2
test/chez/datareader-app/src/drtest/reader.clj
Normal file
2
test/chez/datareader-app/src/drtest/reader.clj
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
(ns drtest.reader)
|
||||
(defn code-reader [_form] (list '+ 40 2))
|
||||
Loading…
Add table
Add a link
Reference in a new issue