Fix 4 clojure.core bugs surfaced by JVM certification

The corpus certifier (test/conformance) flagged four cases where jolt's
hand-written :expected matched a real defect rather than Clojure. Fixed in the
jolt-core overlay, corrected the spec :expected, re-certified against JVM Clojure:

- ex-message: returns nil for a non-throwable (dropped the lenient string branch);
  still returns the message for ex-info. (jolt-l8e8)
- munge: preserves the argument's type — a symbol munges to a symbol, not a string.
  (jolt-hc35)
- print: (print nil) emits "nil", not "" (top-level nil guard; str yields "").
  (jolt-pqio)
- bounded-count: uses the counted? fast path (full count), else counts up to n via
  seq — was (min n (count coll)), wrong for counted colls. Added an uncounted-coll
  spec case. (jolt-2507)

Removed the 4 :bug entries from known-divergences.edn (now certified), regenerated
corpus + profile, re-minted the Chez bootstrap seed (clojure.core changed). Gates:
Janet 155/0, JVM certify clean, both Chez corpus gates 2534 (floors raised),
bootstrap 6/6, fixpoint intact.

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

@@ -55,10 +55,16 @@
 
 (defn prn [& xs] (apply pr xs) (__write "\n") nil)
 
+;; print renders each arg non-readably (strings/chars unquoted) like str — except
+;; nil, which prints as "nil" (str yields ""). Only the top-level arg needs the
+;; guard; nil nested in a collection already renders as "nil" via the collection
+;; printer.
 (defn print [& xs]
   (__write (loop [out "" s (seq xs) first? true]
              (if s
-               (recur (str out (if first? "" " ") (str (first s))) (next s) false)
+               (let [x (first s)
+                     r (if (nil? x) "nil" (str x))]
+                 (recur (str out (if first? "" " ") r) (next s) false))
                out)))
   nil)
 
@@ -210,7 +216,11 @@
       (recur (dec n) (next xs))
       xs)))
 
-(defn bounded-count [n coll] (min n (count coll)))
+(defn bounded-count [n coll]
+  (if (counted? coll)
+    (count coll)
+    (loop [i 0 s (seq coll)]
+      (if (and s (< i n)) (recur (inc i) (next s)) i))))
 
 (defn run! [proc coll] (reduce (fn [_ x] (proc x) nil) nil coll) nil)
 
@@ -650,7 +660,6 @@
 (defn ex-message [e]
   (let [e (ex-unwrap e)]
     (cond (ex-info-val? e) (get e :message)
-          (string? e)      e
           :else            nil)))
 (defn ex-cause [e]
   (let [e (ex-unwrap e)] (if (ex-info-val? e) (get e :cause) nil)))
@@ -785,8 +794,12 @@
 ;; No class hierarchy on the Janet host.
 (defn supers [x] #{})
 
-;; The kernel's munge only rewrote dashes; kept as-is for parity.
+;; Like Clojure's munge: rewrite dashes to underscores, preserving the argument's
-(defn munge [s] (str-replace-all "-" "_" (str s)))
+;; type — a symbol munges to a symbol, anything else to a string. (jolt only
+;; rewrites dashes, not the full Compiler CHAR_MAP.)
+(defn munge [s]
+  (let [m (str-replace-all "-" "_" (str s))]
+    (if (symbol? s) (symbol m) m)))
 
 (defn test
   "Calls the :test fn from v's metadata; :ok if it runs, :no-test if absent."

test/chez/corpus.edn

@@ -168,7 +168,7 @@
   {:suite "exceptions / ex-info" :label "rethrow preserves ex" :expected "\"inner\"" :actual "(try (try (throw (ex-info \"inner\" {})) (catch :default e (throw e))) (catch :default e (ex-message e)))"}
   {:suite "exceptions / ex-info" :label "ex-data on non-ex" :expected "nil" :actual "(ex-data 42)"}
   {:suite "exceptions / ex-info" :label "ex-cause on non-ex" :expected "nil" :actual "(ex-cause {:k 1})"}
-  {:suite "exceptions / ex-info" :label "ex-message of string" :expected "\"hi\"" :actual "(ex-message \"hi\")"}
+  {:suite "exceptions / ex-info" :label "ex-message of string" :expected "nil" :actual "(ex-message \"hi\")"}
   {:suite "forms / case" :label "bool" :expected ":yes" :actual "(case true true :yes false :no :default)"}
   {:suite "forms / case" :label "keyword match" :expected ":b" :actual "(case :a :x :wrong :a :b :default)"}
   {:suite "forms / case" :label "number match" :expected ":two" :actual "(case 2 1 :one 2 :two :default)"}
@@ -278,7 +278,7 @@
   {:suite "clojure.core / leaf batch (complement fnil munge etc.)" :label "denominator throws" :expected :throws :actual "(denominator 1)"}
   {:suite "clojure.core / leaf batch (complement fnil munge etc.)" :label "supers empty set" :expected "#{}" :actual "(supers 1)"}
   {:suite "clojure.core / leaf batch (complement fnil munge etc.)" :label "munge dashes" :expected "\"a_b\"" :actual "(munge \"a-b\")"}
-  {:suite "clojure.core / leaf batch (complement fnil munge etc.)" :label "munge symbol" :expected "\"x_y\"" :actual "(munge (quote x-y))"}
+  {:suite "clojure.core / leaf batch (complement fnil munge etc.)" :label "munge symbol" :expected "(quote x_y)" :actual "(munge (quote x-y))"}
   {:suite "clojure.core / leaf batch (complement fnil munge etc.)" :label "test no-test" :expected ":no-test" :actual "(test (quote foo))"}
   {:suite "clojure.core / leaf batch 2" :label "key" :expected "1" :actual "(key (first {1 :a}))"}
   {:suite "clojure.core / leaf batch 2" :label "val" :expected ":a" :actual "(val (first {1 :a}))"}
@@ -669,7 +669,7 @@
   {:suite "io / print family (overlay)" :label "println appends newline" :expected "\"x 1\\n\"" :actual "(with-out-str (println \"x\" 1))"}
   {:suite "io / print family (overlay)" :label "prn is readable + newline" :expected "\"[1 \\\"s\\\"]\\n\"" :actual "(with-out-str (prn [1 \"s\"]))"}
   {:suite "io / print family (overlay)" :label "pr writes no newline" :expected "\"\\\\a\"" :actual "(with-out-str (pr \\a))"}
-  {:suite "io / print family (overlay)" :label "print nil arg" :expected "\"\"" :actual "(with-out-str (print nil))"}
+  {:suite "io / print family (overlay)" :label "print nil arg" :expected "\"nil\"" :actual "(with-out-str (print nil))"}
   {:suite "io / print family (overlay)" :label "prn keyword" :expected "\":k\\n\"" :actual "(with-out-str (prn :k))"}
   {:suite "io / print-method multimethod" :label "records print canonically" :expected "\"#user.Pt{:x 1, :y 2}\"" :actual "(do (defrecord Pt [x y]) (pr-str (->Pt 1 2)))"}
   {:suite "io / print-method multimethod" :label "records nested in colls" :expected "\"[#user.Pt{:x 1, :y 2}]\"" :actual "(do (defrecord Pt [x y]) (pr-str [(->Pt 1 2)]))"}
@@ -1927,7 +1927,8 @@
   {:suite "seq / overlay-migrated fns" :label "drop-last n" :expected "[1 2]" :actual "(drop-last 2 [1 2 3 4])"}
   {:suite "seq / overlay-migrated fns" :label "split-with" :expected "[[2 4] [5 6]]" :actual "(split-with even? [2 4 5 6])"}
   {:suite "seq / overlay-migrated fns" :label "replicate" :expected "[:x :x :x]" :actual "(replicate 3 :x)"}
-  {:suite "seq / overlay-migrated fns" :label "bounded-count" :expected "3" :actual "(bounded-count 3 [1 2 3 4 5])"}
+  {:suite "seq / overlay-migrated fns" :label "bounded-count" :expected "5" :actual "(bounded-count 3 [1 2 3 4 5])"}
+  {:suite "seq / overlay-migrated fns" :label "bounded-count uncounted" :expected "3" :actual "(bounded-count 3 (filter odd? (range 100)))"}
   {:suite "seq / overlay-migrated fns" :label "run! side effects" :expected "6" :actual "(let [a (atom 0)] (run! (fn [x] (swap! a + x)) [1 2 3]) @a)"}
   {:suite "seq / overlay-migrated fns" :label "completing wraps rf" :expected "3" :actual "((completing +) 1 2)"}
   {:suite "seq / overlay-migrated fns" :label "comparator <" :expected "[1 2 3]" :actual "(sort (comparator <) [3 1 2])"}

test/chez/run-corpus-prelude.janet

@@ -289,7 +289,7 @@
 # (`(...)/`[...]/`{...}/`#{...} via __sqcat/__sqvec/__sqmap/__sqset) run at runtime.
 # 2280->2295, 0 new divergences.
 # Strided runs scale down.
-(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2533")))
+(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2534")))
 (def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor))
 (when (or (> (length diverged) 0) (< pass floor))
   (printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))

test/chez/run-corpus-zero-janet.janet

@@ -166,7 +166,7 @@
 
 # Regression floor: raise as the Chez-hosted compiler closes gaps. The gate fails
 # on any NEW divergence or if pass drops below the floor. Strided runs scale to 0.
-(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_ZJ_FLOOR") "2533")))
+(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_ZJ_FLOOR") "2534")))
 (def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor))
 (when (or (> (length diverged) 0) (< pass floor))
   (printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))

test/conformance/known-divergences.edn

@@ -1,9 +1,7 @@
 {:doc
  "Known divergences of test/chez/corpus.edn :expected from JVM Clojure, classified. Most are deliberate jolt-specific or host-model differences (-> :features in conformance inc3). :bug entries are genuine and tracked. The certifier (certify.clj) gates on NEW (unlisted) divergences only. Keyed by [suite label].",
  :legend
- {:bug
+ {:numeric-model
-  "genuine jolt/corpus bug — tracked bead, fix in jolt-core + correct :expected",
-  :numeric-model
   "jolt is all-double: no Ratio/BigDecimal/float; (/ 1 2)=>0.5, 3.0 prints 3",
   :concurrency-model
   "Janet isolated-heap snapshot futures/agents/pmap; atoms snapshot, not shared",
@@ -18,23 +16,7 @@
   :impl-detail
   "representation detail: syntax-quote yields a list? (JVM yields a Cons)"},
  :entries
- [{:suite "clojure.core / leaf batch (complement fnil munge etc.)",
+ [{:suite "clojure.core / futures — predicates",
-   :label "munge symbol",
-   :category :bug,
-   :bead "jolt-hc35"}
-  {:suite "exceptions / ex-info",
-   :label "ex-message of string",
-   :category :bug,
-   :bead "jolt-l8e8"}
-  {:suite "io / print family (overlay)",
-   :label "print nil arg",
-   :category :bug,
-   :bead "jolt-pqio"}
-  {:suite "seq / overlay-migrated fns",
-   :label "bounded-count",
-   :category :bug,
-   :bead "jolt-2507"}
-  {:suite "clojure.core / futures — predicates",
    :label "cancel an in-flight future returns true",
    :category :concurrency-model,
    :flaky true}

test/conformance/profile.edn

@@ -1,11 +1,10 @@
 {:doc
  "Conformance profile for test/chez/corpus.edn, generated by certify.clj. Each entry is a NON-portable case (keyed by [suite label]) and the host feature(s) it requires. Cases NOT listed are portable — they pass on any faithful Clojure. A runtime's conformance LEVEL = portable + the feature families it implements. See SPEC.md.",
  :clojure-version "1.12.5",
- :portable-count 2670,
+ :portable-count 2674,
- :non-portable-count 249,
+ :non-portable-count 246,
  :feature-counts
- {:bug 4,
+ {:concurrency/snapshot 5,
-  :concurrency/snapshot 4,
   :host/arrays 12,
   :host/janet 16,
   :host/jvm-interop 174,
@@ -20,6 +19,10 @@
    :label "tracks in-ns",
    :bucket :jvm-error,
    :features [:host/jvm-interop]}
+  {:suite "clojure.core / futures — predicates",
+   :label "cancel an in-flight future returns true",
+   :bucket :divergent,
+   :features [:concurrency/snapshot]}
   {:suite "clojure.core / futures — snapshot (copy) semantics",
    :label "captured atom is snapshotted, not shared",
    :bucket :divergent,
@@ -28,10 +31,6 @@
    :label "bigdec",
    :bucket :divergent,
    :features [:numerics/double-only]}
-  {:suite "clojure.core / leaf batch (complement fnil munge etc.)",
-   :label "munge symbol",
-   :bucket :divergent,
-   :features [:bug]}
   {:suite "clojure.core / leaf batch (complement fnil munge etc.)",
    :label "supers empty set",
    :bucket :jvm-error,
@@ -149,10 +148,6 @@
    :label "ex-data via catch",
    :bucket :jvm-error,
    :features [:host/jvm-interop]}
-  {:suite "exceptions / ex-info",
-   :label "ex-message of string",
-   :bucket :divergent,
-   :features [:bug]}
   {:suite "exceptions / ex-info",
    :label "propagates to outer",
    :bucket :jvm-error,
@@ -481,10 +476,6 @@
    :label "line-seq is lazy seq",
    :bucket :jvm-error,
    :features [:host/jvm-interop]}
-  {:suite "io / print family (overlay)",
-   :label "print nil arg",
-   :bucket :divergent,
-   :features [:bug]}
   {:suite "io / print-method multimethod",
    :label "StringWriter accumulates",
    :bucket :jvm-error,
@@ -717,10 +708,6 @@
    :label "re-pattern is regex?",
    :bucket :jvm-error,
    :features [:host/jvm-interop]}
-  {:suite "seq / overlay-migrated fns",
-   :label "bounded-count",
-   :bucket :divergent,
-   :features [:bug]}
   {:suite "set / nil element (jolt-bn2p)",
    :label "transient conj! nil",
    :bucket :jvm-error,

test/spec/exceptions-spec.janet

@@ -43,4 +43,4 @@
    "(try (try (throw (ex-info \"inner\" {})) (catch :default e (throw e))) (catch :default e (ex-message e)))"]
   ["ex-data on non-ex"    "nil"       "(ex-data 42)"]
   ["ex-cause on non-ex"   "nil"       "(ex-cause {:k 1})"]
-  ["ex-message of string" "\"hi\""    "(ex-message \"hi\")"])
+  ["ex-message of string" "nil"        "(ex-message \"hi\")"])

test/spec/functions-spec.janet

@@ -58,7 +58,7 @@
   ["denominator throws"  :throws    "(denominator 1)"]
   ["supers empty set"    "#{}"      "(supers 1)"]
   ["munge dashes"        "\"a_b\""  "(munge \"a-b\")"]
-  ["munge symbol"        "\"x_y\""  "(munge (quote x-y))"]
+  ["munge symbol"        "(quote x_y)"  "(munge (quote x-y))"]
   ["test no-test"        ":no-test" "(test (quote foo))"])
 
 # Phase 2 leaf batch 2 (jolt-ded): canonical ports of key/val/select-keys/

test/spec/io-spec.janet

@@ -65,7 +65,7 @@
   ["println appends newline" "\"x 1\\n\"" "(with-out-str (println \"x\" 1))"]
   ["prn is readable + newline" "\"[1 \\\"s\\\"]\\n\"" "(with-out-str (prn [1 \"s\"]))"]
   ["pr writes no newline" "\"\\\\a\"" "(with-out-str (pr \\a))"]
-  ["print nil arg"      "\"\""        "(with-out-str (print nil))"]
+  ["print nil arg"      "\"nil\""     "(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

test/spec/sequences-spec.janet

@@ -238,7 +238,8 @@
   ["drop-last n"               "[1 2]"  "(drop-last 2 [1 2 3 4])"]
   ["split-with"                "[[2 4] [5 6]]" "(split-with even? [2 4 5 6])"]
   ["replicate"                 "[:x :x :x]" "(replicate 3 :x)"]
-  ["bounded-count"             "3"      "(bounded-count 3 [1 2 3 4 5])"]
+  ["bounded-count"             "5"      "(bounded-count 3 [1 2 3 4 5])"]
+  ["bounded-count uncounted"   "3"      "(bounded-count 3 (filter odd? (range 100)))"]
   ["run! side effects"         "6"      "(let [a (atom 0)] (run! (fn [x] (swap! a + x)) [1 2 3]) @a)"]
   ["completing wraps rf"       "3"      "((completing +) 1 2)"]
   ["comparator <"              "[1 2 3]" "(sort (comparator <) [3 1 2])"]