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

core: print-method is a real multimethod (jolt-g1r); records print canonically

Browse source 
print-method/print-dup are now multimethods in the io tier with Clojure's
exact dispatch ((:type meta) keyword, else type — core.clj 3693). On jolt the
dispatch value for a record is its quoted full-name symbol, since class names
aren't values here.

Records used to pr-str as the raw janet table; the renderer's record branch
now prints Clojure's #ns.Type{:k v} syntax, and first consults a callback the
api wires up after the overlay loads — so a user defmethod on a record type
fires everywhere: top level, nested in collections, through pr/prn/pr-str.
Builtin overrides (a :number method) fire only on direct print-method calls;
pr keeps the native fast path (documented divergence).

java.io.Writer arrives as a shim beside the StringReader/StringBuilder ones:
a :jolt/writer tagged value with write/append/flush/toString, a StringWriter
ctor, and a sink variant the renderer callback uses.

Two latent host bugs fixed on the way: the interpreted syntax-quote splice
blew up on ~@nil (an interpreted macro's empty & rest binds nil — first tier
user of defmulti found it; d-realize now treats nil as the empty seq), and
(print-method x nil) now throws like the JVM instead of returning nil.

10 spec rows; bench dead even (sandwich run); greeter green on a fresh
binary.
This commit is contained in:
Yogthos 2026-06-11 18:10:11 -04:00
parent eff8cb99a5
commit 1e4a0a6d53
8 changed files with 131 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

4
jolt-core/clojure/core/20-coll.clj
View file

@ -1064,9 +1064,7 @@
(defn special-symbol? [s] (contains? special-syms s))
;; Printer hooks are inert until print-method is a real multimethod (jolt-g1r).
(defn print-method [x writer] nil)
(defn print-dup [x writer] nil)
;; print-method / print-dup are real multimethods in the io tier (50-io.clj).
;; JVM proxies don't exist on a Janet host: the read-only surface is inert,
;; the constructive surface throws (matching the prior seed stubs).

29
jolt-core/clojure/core/50-io.clj
View file

@ -127,3 +127,32 @@
(let [line ((:read-line-fn rdr))]
(when line
(cons line (line-seq rdr)))))))
;; --- print-method (jolt-g1r) ------------------------------------------------
;; Canonical dispatch (clojure/core.clj 3693): the :type metadata when it's a
;; keyword, else the value's type. On jolt, type is the keyword tag for
;; builtins and the deftype name SYMBOL for records — so a record method is
;; (defmethod print-method 'ns.Type [r w] ...) (class names aren't values
;; here, the quoted full name is the dispatch value).
;;
;; The :default renders through the host's fast printer. The host renderer
;; calls BACK into this table for records (the api wires the hook after the
;; overlay loads), so a record method fires nested inside collections too.
;; Builtin overrides (e.g. a :number method) fire only when print-method is
;; called directly — pr/pr-str keep the native fast path for builtins (a
;; documented jolt divergence).
(defmulti print-method (fn [x writer]
(let [t (get (meta x) :type)]
(if (keyword? t) t (type x)))))
(defmethod print-method :default [o w]
(.write w (__pr-str1 o))
nil)
;; print-dup: jolt has one print representation, so dup routes to print-method
;; (as Clojure's default does for most types).
(defmulti print-dup (fn [x writer]
(let [t (get (meta x) :type)]
(if (keyword? t) t (type x)))))
(defmethod print-dup :default [o w] (print-method o w))

5
src/jolt/api.janet
View file

@ -119,7 +119,10 @@
# was still being built, so their expanders are interpreted closures. Now that the
# full overlay + analyzer are in place, recompile those expanders to native code —
# by steady state no macro expansion runs interpreted (no-op in interpreter mode).
(backend/ensure-macros-compiled! ctx))
(backend/ensure-macros-compiled! ctx)
# print-method's record hook: only wirable once the overlay multimethod
# exists (50-io tier), so it rides the end of overlay load.
(install-print-method-cb! ctx))
(defn init
"Create a new Jolt evaluation context.

38
src/jolt/core.janet
View file

@ -1477,6 +1477,14 @@
(def n (ns :name))
(if (and (struct? n) (= :symbol (get n :jolt/type))) (n :name) (string n)))
# print-method callback (jolt-g1r): set by api/init AFTER the overlay loads,
# to a (fn [v emit] handled?) that looks for a USER-registered print-method
# multimethod entry for v's dispatch value and renders through it (emit takes
# string pieces). The renderer consults it only on the record/tagged
# fallthrough, so built-in rendering pays nothing.
(var print-method-cb nil)
(defn set-print-method-cb! [f] (set print-method-cb f))
(def- pr-char-escapes
{34 "\\\"" 92 "\\\\" 10 "\\n" 9 "\\t" 13 "\\r" 12 "\\f" 8 "\\b"})
(var pr-render nil)
@ -1577,7 +1585,15 @@
(and (table? v) (= :jolt/chan (get v :jolt/type))) (buffer/push-string buf "#<channel>")
(pvec? v) (pr-render-seq buf (pv->array v) "[" "]")
(plist? v) (pr-render-seq buf (pl->array v) "(" ")")
(and (table? v) (get v :jolt/deftype)) (buffer/push-string buf (string v))
(and (table? v) (get v :jolt/deftype))
(if (and print-method-cb (print-method-cb v (fn [piece] (buffer/push-string buf piece))))
nil
# Clojure's record syntax: #ns.Type{:k v, ...} (fields only, the
# deftype tag elided). This used to print the raw janet table.
(do
(buffer/push-string buf (string "#" (get v :jolt/deftype)))
(pr-render-pairs buf
(filter (fn [pair] (not= :jolt/deftype (in pair 0))) (pairs v)))))
(tuple? v) (pr-render-seq buf v "[" "]")
# mutable mode: arrays are vectors -> print with [] (else lists -> ())
(array? v) (if mutable? (pr-render-seq buf v "[" "]") (pr-render-seq buf v "(" ")"))
@ -2821,6 +2837,26 @@
[]
@{})
# Wire the print-method callback once the overlay (and its print-method
# multimethod) exists: the renderer's record fallthrough consults the methods
# table on the var; only a USER-registered method fires — the multimethod's
# :default would bounce straight back into the renderer.
(defn install-print-method-cb! [ctx]
(def core-ns (ctx-find-ns ctx "clojure.core"))
(def pm-var (ns-find core-ns "print-method"))
(when pm-var
(set-print-method-cb!
(fn [v emit]
(def methods (get pm-var :jolt/methods))
(when methods
(def mt (core-meta v))
(def t (and mt (core-get mt :type)))
(def dval (if (keyword? t) t (core-type v)))
(def m (get methods dval))
(when m
(m v @{:jolt/type :jolt/writer :sink emit})
true))))))
(def init-core!
(fn [& args]
(case (length args)

7
src/jolt/evaluator.janet
View file

@ -172,8 +172,11 @@
(defn- d-realize
"Realize a lazy-seq to an array for positional destructuring / splicing; pass
others (pvec/plist coerced to array, everything else unchanged)."
others (pvec/plist coerced to array, everything else unchanged). nil is an
empty seq, as everywhere in Clojure — ~@nil splices nothing (an interpreted
macro's empty & rest binds nil, which used to blow up `each`)."
[val]
(if (nil? val) @[]
(if (pvec? val) (pv->array val)
(if (plist? val) (pl->array val)
(if (lazy-seq? val)
@ -187,7 +190,7 @@
(let [rt (in cell 1)]
(if (nil? rt) (set go false) (set cur (ls-rest-cached cur rt))))))))
items)
val))))
val)))))
(defn- syntax-quote*
[ctx bindings form &opt gsmap]

25
src/jolt/javatime.janet
View file

@ -171,6 +171,11 @@
@{:jolt/type :jolt/string-builder
:buf (cond (nil? init) @"" (number? init) (buffer/new init) (buffer init))})
(defn make-string-writer []
@{:jolt/type :jolt/writer :buf @"" :sink nil})
(defn make-out-writer []
@{:jolt/type :jolt/writer :buf nil :sink prin})
(defn- render-piece [x]
(cond
(nil? x) "null"
@ -216,6 +221,24 @@
"reset" (fn [self] (put self :pos (or (self :marked) 0)) nil)
"skip" (fn [self n] (put self :pos (min (length (self :s)) (+ (self :pos) n))) n)
"close" (fn [self] nil)})
# java.io.Writer / StringWriter — the print-method protocol surface
# (jolt-g1r). A writer either pushes to a sink fn (stdout/custom) or
# accumulates in a buffer (StringWriter). write/append coerce chars the
# same way StringBuilder does.
(register-tagged-methods! :jolt/writer
@{"write" (fn [self x]
(if (self :sink)
((self :sink) (render-piece x))
(buffer/push-string (self :buf) (render-piece x)))
nil)
"append" (fn [self x]
(if (self :sink)
((self :sink) (render-piece x))
(buffer/push-string (self :buf) (render-piece x)))
self)
"flush" (fn [self] nil)
"close" (fn [self] nil)
"toString" (fn [self] (string (or (self :buf) "")))})
(register-tagged-methods! :jolt/string-builder
@{"append" (fn [self x] (buffer/push (self :buf) (render-piece x)) self)
"toString" (fn [self] (string (self :buf)))
@ -238,6 +261,8 @@
(register-class-ctor! nm string-reader))
(each nm ["StringBuilder" "java.lang.StringBuilder"]
(register-class-ctor! nm string-builder))
(each nm ["StringWriter" "java.io.StringWriter"]
(register-class-ctor! nm make-string-writer))
# java.net.URL: enough for selmer's template cache — file: URLs only.
# A protocol-less spec throws (selmer catches MalformedURLException and
# prepends file:///), and getPath hands back a stat-able filesystem path.

28
test/spec/io-spec.janet
View file

@ -67,3 +67,31 @@
["pr writes no newline" "\"\\\\a\"" "(with-out-str (pr \\a))"]
["print nil arg" "\"\"" "(with-out-str (print nil))"]
["prn keyword" "\":k\\n\"" "(with-out-str (prn :k))"])
# print-method is a real multimethod (jolt-g1r): canonical dispatch on
# (:type meta) keyword else (type x); records print as #ns.Type{...} by
# default, and a user (defmethod print-method 'ns.Type ...) overrides record
# rendering everywhere — top level AND nested, through pr/prn/pr-str — via
# the host renderer's callback. Builtin overrides apply only on direct
# print-method calls (documented divergence; pr keeps the native fast path).
(defspec "io / print-method multimethod"
["records print canonically" "\"#user.Pt{:x 1, :y 2}\""
"(do (defrecord Pt [x y]) (pr-str (->Pt 1 2)))"]
["records nested in colls" "\"[#user.Pt{:x 1, :y 2}]\""
"(do (defrecord Pt [x y]) (pr-str [(->Pt 1 2)]))"]
["defmethod overrides a record, top level" "\"<3,4>\""
"(do (defrecord Pt [x y]) (defmethod print-method (quote user.Pt) [r w] (.write w (str \"<\" (:x r) \",\" (:y r) \">\"))) (pr-str (->Pt 3 4)))"]
["defmethod fires nested in a map" "\"{:p <5,6>}\""
"(do (defrecord Pt [x y]) (defmethod print-method (quote user.Pt) [r w] (.write w (str \"<\" (:x r) \",\" (:y r) \">\"))) (pr-str {:p (->Pt 5 6)}))"]
["defmethod fires through prn" "\"[<1,2>]\\n\""
"(do (defrecord Pt [x y]) (defmethod print-method (quote user.Pt) [r w] (.write w (str \"<\" (:x r) \",\" (:y r) \">\"))) (with-out-str (prn [(->Pt 1 2)])))"]
["direct call uses :default" "\"42\""
"(let [w (StringWriter.)] (print-method 42 w) (.toString w))"]
["direct builtin override" "\"#42#\""
"(do (defmethod print-method :number [n w] (.write w (str \"#\" n \"#\"))) (let [w (StringWriter.)] (print-method 42 w) (.toString w)))"]
["print-dup routes to print-method" "\"[1 2]\""
"(let [w (StringWriter.)] (print-dup [1 2] w) (.toString w))"]
["StringWriter accumulates" "\"ab\""
"(let [w (StringWriter.)] (.write w \"a\") (.append w \\b) (.toString w))"]
["methods table inspectable" "true"
"(do (defrecord Pt [x y]) (defmethod print-method (quote user.Pt) [r w] r) (contains? (methods print-method) (quote user.Pt)))"])

4
test/spec/untested-vars-spec.janet
View file

@ -122,8 +122,8 @@
["proxy-super throws" :throws "(proxy-super count [1])"]
["re-groups throws" :throws "(re-groups (re-matcher #\"a\" \"b\"))"]
["re-matcher builds" "false" "(nil? (re-matcher #\"a\" \"abc\"))"]
["print-dup" "nil" "(print-dup 1 nil)"]
["print-method" "nil" "(print-method 1 nil)"]
["print-dup nil writer throws" :throws "(print-dup 1 nil)"]
["print-method nil writer throws" :throws "(print-method 1 nil)"]
["uri? string" "false" "(uri? \"http://x\")"]
["uri? nil" "false" "(uri? nil)"]
["definterface defines" "true" "(var? (definterface IFoo (foo [x])))"]