Merge pull request #81 from jolt-lang/print-method-multimethod

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

docs/libraries.md

@@ -0,0 +1,10 @@
+# Clojure libraries known to work with Jolt
+
+Libraries confirmed to load and pass their conformance checks on Jolt
+(see `test/integration/deps-conformance-test.janet` and the
+[greeter example](https://github.com/jolt-lang/examples/tree/main/greeter)).
+
+* [config](https://github.com/yogthos/config)
+* [Selmer](https://github.com/yogthos/Selmer)
+* [medley](https://github.com/weavejester/medley)
+* [cuerdas](https://github.com/funcool/cuerdas)

jolt-core/clojure/core/20-coll.clj

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

jolt-core/clojure/core/50-io.clj

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

src/jolt/api.janet

@@ -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.

src/jolt/core.janet

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

src/jolt/evaluator.janet

@@ -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]

src/jolt/javatime.janet

@@ -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.

test/spec/io-spec.janet

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

test/spec/untested-vars-spec.janet

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