diff --git a/docs/libraries.md b/docs/libraries.md new file mode 100644 index 0000000..574a2b1 --- /dev/null +++ b/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) diff --git a/jolt-core/clojure/core/20-coll.clj b/jolt-core/clojure/core/20-coll.clj index 5df1975..915c4ba 100644 --- a/jolt-core/clojure/core/20-coll.clj +++ b/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). diff --git a/jolt-core/clojure/core/50-io.clj b/jolt-core/clojure/core/50-io.clj index c1cc90d..733c3b0 100644 --- a/jolt-core/clojure/core/50-io.clj +++ b/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)) diff --git a/src/jolt/api.janet b/src/jolt/api.janet index 5e48ef2..c4c4ee5 100644 --- a/src/jolt/api.janet +++ b/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. diff --git a/src/jolt/core.janet b/src/jolt/core.janet index c56f4fa..d1102a3 100644 --- a/src/jolt/core.janet +++ b/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 "#") (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) diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index f26edcf..4379ba4 100644 --- a/src/jolt/evaluator.janet +++ b/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] diff --git a/src/jolt/javatime.janet b/src/jolt/javatime.janet index 1c22c5e..d386cfa 100644 --- a/src/jolt/javatime.janet +++ b/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. diff --git a/test/spec/io-spec.janet b/test/spec/io-spec.janet index d5b346b..c16cc4b 100644 --- a/test/spec/io-spec.janet +++ b/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)))"]) diff --git a/test/spec/untested-vars-spec.janet b/test/spec/untested-vars-spec.janet index e53124e..b5da2ed 100644 --- a/test/spec/untested-vars-spec.janet +++ b/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])))"]