diff --git a/src/jolt/clojure/walk.clj b/src/jolt/clojure/walk.clj index f2ba5e2..8d73b2b 100644 --- a/src/jolt/clojure/walk.clj +++ b/src/jolt/clojure/walk.clj @@ -1,12 +1,18 @@ ; Jolt Standard Library: clojure.walk ; Tree walking for Clojure data structures. -; Simplified: uses vector? and map? predicates (no list? or seq?). (defn walk [inner outer form] (cond + ; vectors/maps first so seq? can't swallow them (a vector is not seq? on + ; jolt, but keep the concrete branches authoritative) (vector? form) (outer (vec (map inner form))) (map? form) (outer (into (empty form) (map inner form))) + ; lists rebuild as lists, other seqs (incl. macro/template output: cons/ + ; concat/lazy-seq) walk too — without this, postwalk-replace silently no-op'd + ; a quoted list, breaking clojure.template/apply-template (jolt-khk) + (list? form) (outer (apply list (map inner form))) + (seq? form) (outer (map inner form)) :else (outer form))) (defn postwalk 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/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 62763cd..6ebf868 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -98,4 +98,12 @@ (if (= 0 (length form)) @[] (eval-list ctx bindings form)) + # A non-array ISeq used as a form is a CALL too (jolt-2rx): cons/concat/list + # and ~@ build a plist or lazy-seq (list?/seq? true, array? false) — without + # this they fell through to self-eval, so (eval (cons '+ '(1 2))) returned the + # list as data instead of 3, and macro output containing such subforms never + # evaluated. d-realize coerces to the element array; an empty list self-evals. + (or (plist? form) (lazy-seq? form)) + (let [arr (d-realize form)] + (if (= 0 (length arr)) form (eval-list ctx bindings arr))) form))) 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)))))"]) diff --git a/test/spec/iseq-call-spec.janet b/test/spec/iseq-call-spec.janet new file mode 100644 index 0000000..b1aeaa4 --- /dev/null +++ b/test/spec/iseq-call-spec.janet @@ -0,0 +1,19 @@ +# Specification: a non-array ISeq (plist/lazy-seq, e.g. from cons/concat/list or +# ~@) used as a FORM is evaluated as a call, not returned as self-evaluating data +# (jolt-2rx). The interpreter only treated a reader LIST (Janet array) as a call; +# a runtime-built list (a plist/lazy-seq table) fell through to self-eval, so +# (eval (cons '+ '(1 2))) returned the list instead of 3. The analyzer already +# punts such forms to the interpreter, so the fix lives in eval-form. +(use ../support/harness) + +(defspec "ISeq call forms (jolt-2rx)" + ["eval a cons'd call" "3" "(eval (cons (quote +) (quote (1 2))))"] + ["eval a list-built call" "6" "(eval (list (quote +) 1 2 3))"] + ["eval a concat'd call" "10" "(eval (concat (list (quote +)) (list 1 2 3 4)))"] + ["nested cons'd subform" "7" "(eval (list (quote +) 3 (cons (quote +) (quote (1 3)))))"] + ["empty list self-evals" "()" "(eval (list))"] + ["macro output via cons" "3" "(do (defmacro mc [] (cons (quote +) (quote (1 2)))) (mc))"] + ["macro output via concat" "6" "(do (defmacro mk [] (concat (list (quote +)) (list 1 2 3))) (mk))"] + # regressions: vectors/quoted-data are NOT calls + ["vector value self-evals" "[1 2 3]" "(eval (vec [1 2 3]))"] + ["quoted list of data" "(quote (1 2 3))" "(quote (1 2 3))"]) diff --git a/test/spec/walk-spec.janet b/test/spec/walk-spec.janet new file mode 100644 index 0000000..90a5aae --- /dev/null +++ b/test/spec/walk-spec.janet @@ -0,0 +1,23 @@ +# Specification: clojure.walk must descend lists and seqs, not just vectors/maps +# (jolt-khk). postwalk-replace with symbol keys over a quoted list silently +# no-op'd because walk only handled vector?/map? and fell through for list?/seq? +# — which broke clojure.template/apply-template (found during reitit work). +(use ../support/harness) + +(defspec "clojure.walk / lists + seqs" + ["postwalk-replace symbol keys in a list" "(quote (+ 2 2))" + "(do (require (quote [clojure.walk :as w])) (w/postwalk-replace {(quote x) 2} (quote (+ x x))))"] + ["postwalk descends a list" "(quote (:a :a))" + "(do (require (quote [clojure.walk :as w])) (w/postwalk (fn [n] (if (symbol? n) :a n)) (quote (x y))))"] + ["prewalk-replace in a list" "(quote (* 3 3))" + "(do (require (quote [clojure.walk :as w])) (w/prewalk-replace {(quote *) (quote *) (quote y) 3} (quote (* y y))))"] + ["nested list + vector" "(quote (1 [2 1]))" + "(do (require (quote [clojure.walk :as w])) (w/postwalk-replace {:a 1 :b 2} (quote (:a [:b :a]))))"] + # vectors/maps still work (regression guard for the existing behavior) + ["postwalk-replace in a vector" "[:one 2 :one]" + "(do (require (quote [clojure.walk :as w])) (w/postwalk-replace {1 :one} [1 2 1]))"] + ["keywordize-keys still works" "{:a 1}" + "(do (require (quote [clojure.walk :as w])) (w/keywordize-keys {\"a\" 1}))"] + # clojure.template/apply-template (the real-world trigger) substitutes now + ["apply-template substitutes" "(quote (+ 1 2))" + "(do (require (quote [clojure.template :as t])) (t/apply-template (quote [x y]) (quote (+ x y)) (quote (1 2))))"])