From a2c4fe317b0f5aab3669a3bac444e19cb941e1c7 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Mon, 15 Jun 2026 10:22:09 -0400 Subject: [PATCH] Honor a deftype's custom Object/toString in .toString and str (jolt-rt6n) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A deftype with (Object (toString [_] s)) had its toString ignored: the generic object-methods "toString" fired in dispatch-member before the record's own method (the record isn't a tagged shim, so that guard passed), and str rendered the #Type{...} data repr instead of routing through toString. - dispatch-member: a record's own method (instance/reified/protocol) now wins over the generic object-methods table — so .toString/.equals/.hashCode on a record use the record's definitions; plain records still reach object-methods. - str: add a late-bound record-tostring-cb (wired per-ctx by install-print-method-cb!, mirroring print-method-cb) that str-render-one consults for records — a deftype with a custom toString renders via it, plain records keep the data repr. pr-str is unchanged. Needed by hiccup's RawString. Adds deftype-tostring-spec (.toString + str + concatenation + a regression guard that record-less-toString keeps its repr). --- src/jolt/core.janet | 10 +++++++++- src/jolt/core_print.janet | 13 ++++++++++++- src/jolt/eval_special.janet | 21 +++++++++++++++++++-- test/spec/deftype-tostring-spec.janet | 22 ++++++++++++++++++++++ 4 files changed, 62 insertions(+), 4 deletions(-) create mode 100644 test/spec/deftype-tostring-spec.janet diff --git a/src/jolt/core.janet b/src/jolt/core.janet index cee091e..3c1e0e2 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -306,7 +306,15 @@ (def m (get methods dval)) (when m (m v @{:jolt/type :jolt/writer :sink emit}) - true)))))) + true))))) + # A record/deftype's own Object/toString (jolt-rt6n): str routes records here + # so a deftype with (toString [_] ...) renders via it instead of the data repr. + (set-record-tostring-cb! + (fn [v] + (def tag (record-tag v)) + (when tag + (def m (find-method-any-protocol ctx tag "toString")) + (when m (m v)))))) (def init-core! (fn [& args] diff --git a/src/jolt/core_print.janet b/src/jolt/core_print.janet index bf4fb01..f819147 100644 --- a/src/jolt/core_print.janet +++ b/src/jolt/core_print.janet @@ -31,6 +31,13 @@ (var print-method-cb nil) (defn set-print-method-cb! [f] (set print-method-cb f)) +# Late-bound hook to a record's custom Object/toString (jolt-rt6n). Returns the +# string a deftype's (toString [_] ...) produces, or nil when the type defines +# none. core can't reach the ctx type-registry directly, so install-print-method-cb! +# wires this per-ctx. str routes records through it; the data repr is the fallback. +(var record-tostring-cb nil) +(defn set-record-tostring-cb! [f] (set record-tostring-cb f)) + (def- pr-char-escapes {34 "\\\"" 92 "\\\\" 10 "\\n" 9 "\\t" 13 "\\r" 12 "\\f" 8 "\\b"}) (var pr-render nil) @@ -180,7 +187,11 @@ (number? v) (fmt-number v) (= true v) "true" (= false v) "false" - (let [buf @""] (pr-render buf v) (string buf)))) + # a record/deftype with a custom Object/toString renders via it (Clojure's + # str/.toString semantics); plain records fall through to the data repr. + (if-let [s (and record-tostring-cb (record-tag v) (record-tostring-cb v))] + s + (let [buf @""] (pr-render buf v) (string buf))))) (defn core-str [& xs] (if (= 0 (length xs)) "" diff --git a/src/jolt/eval_special.janet b/src/jolt/eval_special.janet index 1fbbf58..d748f1e 100644 --- a/src/jolt/eval_special.janet +++ b/src/jolt/eval_special.janet @@ -530,6 +530,20 @@ # keyed off `has-args` so behavior is identical (note: the object-methods guard # checks `table?` only, while tagged dispatch checks table-or-struct — both kept # verbatim from the original arms). +# A record's own implementation of `field-name` (its instance fn, a reified fn, +# or a protocol method from the type registry), or nil. A deftype/defrecord +# method must win over the generic object-methods table — e.g. a custom +# (Object (toString [_] ...)) over the default toString (jolt-rt6n). +(defn- record-member [ctx target field-name] + (when (record-tag target) + (let [mk (keyword field-name) + own (get target mk) + reified (get (get target :jolt/protocol-methods) mk)] + (cond + (or (function? own) (cfunction? own)) own + (or (function? reified) (cfunction? reified)) reified + (find-method-any-protocol ctx (record-tag target) field-name))))) + (defn dispatch-member [ctx bindings target member-raw member-name field-name args has-args] (cond # java.lang.String surface for string/buffer targets @@ -543,13 +557,16 @@ # numeric methods (and (number? target) (get number-methods field-name)) ((get number-methods field-name) target ;args) - # universal object methods — skipped when a shim tag-table owns the member. + # universal object methods — skipped when a shim tag-table owns the member, + # OR when the target is a record that implements the member itself (so a + # deftype's own toString/equals/hashCode wins over the generic one, jolt-rt6n). # Call form defers to tagged dispatch whenever a tag-table exists; bare form # only when the tag-table actually carries this member, so zero-arg # toString/hashCode still reach object-methods on shim objects. (and (get object-methods field-name) (not (and (table? target) (get tagged-methods (get target :jolt/type)) - (or has-args (get (get tagged-methods (get target :jolt/type)) field-name))))) + (or has-args (get (get tagged-methods (get target :jolt/type)) field-name)))) + (not (record-member ctx target field-name))) ((get object-methods field-name) target ;args) # registered shim objects (java.time etc.): tag-keyed method tables (and (or (table? target) (struct? target)) diff --git a/test/spec/deftype-tostring-spec.janet b/test/spec/deftype-tostring-spec.janet new file mode 100644 index 0000000..fa13476 --- /dev/null +++ b/test/spec/deftype-tostring-spec.janet @@ -0,0 +1,22 @@ +# Specification: a deftype's custom Object/toString is honored by both .toString +# and str (jolt-rt6n). Before: object-methods' generic toString intercepted the +# record's .toString (the record isn't a tagged shim), and str rendered the +# #Type{...} repr instead of routing through toString. Needed by hiccup's +# RawString (a deftype with toString). +(use ../support/harness) + +(defspec "deftype / custom toString" + [".toString uses the method" "\"hi\"" + "(do (deftype Foo [s] Object (toString [_] s)) (.toString (->Foo \"hi\")))"] + ["str uses the method" "\"hi\"" + "(do (deftype Foo [s] Object (toString [_] s)) (str (->Foo \"hi\")))"] + ["str concatenation uses it" "\"\"" + "(do (deftype Foo [s] Object (toString [_] s)) (str \"<\" (->Foo \"hi\") \">\"))"] + ["computed toString" "\"v=7\"" + "(do (deftype Boxed [v] Object (toString [_] (str \"v=\" v))) (str (->Boxed 7)))"] + # a record WITHOUT a custom toString keeps the #Type{...} repr (regression guard) + ["defrecord without toString keeps repr" "true" + "(do (defrecord Bar [x]) (boolean (re-find #\"Bar\" (str (->Bar 1)))))"] + # pr-str of a defrecord is unaffected (still the data repr) + ["pr-str of a defrecord is the repr" "true" + "(do (defrecord Baz [x]) (boolean (re-find #\"\\{\" (pr-str (->Baz 1)))))"])