Merge pull request #279 from jolt-lang/data-reader-code-forms

Compile data readers that return code forms

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)"

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)))))

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))
 

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)))
+       (cond
-             ((eq? inner (jolt-get x rdr-kw-form)) x)
+         (rdr
-             (else (rdr-make-tagged (jolt-get x rdr-kw-tag) inner)))))
+          ;; 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)))

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.

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

test/chez/datareader-app/deps.edn

@@ -0,0 +1 @@
+{:paths ["src"]}

test/chez/datareader-app/src/data_readers.clj

@@ -0,0 +1 @@
+{code drtest.reader/code-reader}

test/chez/datareader-app/src/drtest/main.clj

@@ -0,0 +1,4 @@
+(ns drtest.main
+  (:require drtest.reader))
+(defn -main [& _]
+  (println #code [:ignored]))

test/chez/datareader-app/src/drtest/reader.clj

@@ -0,0 +1,2 @@
+(ns drtest.reader)
+(defn code-reader [_form] (list '+ 40 2))