Merge pull request #123 from jolt-lang/fix-outstanding-bugs

Fix outstanding bugs: clojure.walk lists, deftype toString, ISeq call forms

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

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]

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

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

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

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" "\"<hi>\""
+   "(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)))))"])

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

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