Merge pull request #303 from jolt-lang/clojure-1.13-parity

Clojure 1.13 parity + no-main build fix

host/chez/build-smoke.sh

@@ -129,4 +129,20 @@ if [ "$got_dr" != "42" ]; then
   echo "  FAIL: built #code data reader — want 42, got \`$got_dr\`"; exit 1
 fi
 
-echo "build smoke: passed (release + optimized + direct-link + tree-shake + compiler+core shake + data-reader)"
+# A script namespace with no -main (just top-level side effects) must build and
+# run its top-level forms, then exit cleanly — not crash calling a nil -main.
+nomain="$(dirname "$out")/nomain"
+mkdir -p "$nomain/src"
+printf '{:paths ["src"]}\n' > "$nomain/deps.edn"
+printf '(ns script)\n(println "no-main script ran")\n' > "$nomain/src/script.clj"
+nmout="$(dirname "$out")/nomain-bin"
+if ! JOLT_PWD="$nomain" bin/joltc build -m script -o "$nmout" >/dev/null 2>&1; then
+  echo "  FAIL: jolt build of a no-main script exited non-zero"; exit 1
+fi
+got_nm="$(cd / && "$nmout" 2>&1)"; rc_nm=$?
+if [ "$got_nm" != "no-main script ran" ] || [ "$rc_nm" != "0" ]; then
+  echo "  FAIL: no-main script binary — want 'no-main script ran' rc 0, got \`$got_nm\` rc $rc_nm"
+  exit 1
+fi
+
+echo "build smoke: passed (release + optimized + direct-link + tree-shake + compiler+core shake + data-reader + no-main)"

host/chez/build.ss

@@ -571,11 +571,17 @@
                             "))\n"
                             "                (list \"jolt-core\" \"stdlib\"))))\n"))
           (put-string out (string-append
-                            "    (let ((mainv (var-deref " (ei-str-lit entry-ns) " \"-main\")))\n"
+                            ;; Call -main only if the entry namespace defines one;
+                            ;; a script ns (top-level side effects, no -main) has
+                            ;; already run its forms at heap build, so invoking a nil
+                            ;; -main would crash ("nil cannot be cast to IFn") — just
+                            ;; exit cleanly instead.
+                            "    (let ((maincell (var-cell-lookup " (ei-str-lit entry-ns) " \"-main\")))\n"
                             ;; render an uncaught throw (+ Clojure backtrace) instead
                             ;; of Chez's opaque dump, then exit non-zero.
                             "      (guard (v (#t (jolt-report-throwable v (current-error-port)) (exit 1)))\n"
-                            "        (apply jolt-invoke mainv args)))\n"
+                            "        (when (and maincell (var-cell-defined? maincell))\n"
+                            "          (apply jolt-invoke (var-cell-root maincell) args))))\n"
                             "    (exit 0)))\n"))
           (close-port out))
         ;; 4. compile -> boot -> link. Two paths, chosen by whether this process

host/chez/collections.ss

@@ -298,8 +298,21 @@
 (define empty-pmap-hash (make-pmap empty-hnode 0 #f))      ; hash-order backing (sets)
 (define pmap-absent (list 'absent))    ; unique missing-key sentinel
 ;; PersistentArrayMap threshold: assoc of a new key promotes to hash mode once the
-;; map already holds 8 entries (array.length >= 16 in the reference).
+;; map already holds 8 entries (array.length >= 16 in the reference). Clojure 1.13
+;; raised the limit to 64 for maps whose keys are ALL keywords (the common
+;; keyword-map case); mixed-key maps still cap at 8.
 (define array-map-limit 8)
+(define array-map-limit-kw 64)
+(define (all-keywords? ks)
+  (or (null? ks) (and (keyword? (car ks)) (all-keywords? (cdr ks)))))
+;; Should a map of `cnt` entries with insertion order `ord` stay in array mode
+;; when key `k` is added? Under 8 always; a keyword-only map (existing keys + the
+;; new key all keywords) grows to 64; otherwise it caps at 8.
+(define (pmap-array-keep? cnt ord k)
+  (cond ((fx<? cnt array-map-limit) #t)
+        ((fx>=? cnt array-map-limit-kw) #f)
+        ((and (keyword? k) (all-keywords? ord)) #t)
+        (else #f)))
 (define (append-key ord k) (append ord (list k)))
 (define (remove-key ord k) (let loop ((o ord)) (cond ((null? o) '()) ((jolt= (car o) k) (cdr o)) (else (cons (car o) (loop (cdr o)))))))
 
@@ -310,7 +323,7 @@
   (let* ((added (box #f)) (r (node-assoc (pmap-root m) 0 (key-hash k) k v added))
          (cnt (pmap-cnt m)) (ord (pmap-order m)))
     (if (unbox added)
-        (if (and ord (fx<? cnt array-map-limit))
+        (if (and ord (pmap-array-keep? cnt ord k))
             (make-pmap r (fx+ cnt 1) (append-key ord k))
             (make-pmap r (fx+ cnt 1) #f))
         (make-pmap r cnt ord))))
@@ -352,10 +365,14 @@
         (let loop ((ks ord) (a acc))
           (if (null? ks) a (loop (cdr ks) (proc (car ks) (pmap-get m (car ks) jolt-nil) a))))
         (node-fold (pmap-root m) proc acc))))
-;; map LITERAL ({...}): array map up to 8 entries, hash map beyond (RT.map).
+;; map LITERAL ({...}): array map up to 8 entries (64 if keyword-only, per 1.13),
+;; hash map beyond (RT.map).
 (define (jolt-hash-map . kvs)
   (let loop ((m empty-pmap) (kvs kvs))
-    (cond ((null? kvs) (if (fx>? (pmap-cnt m) array-map-limit) (pmap->hash m) m))
+    (cond ((null? kvs)
+           (let ((cnt (pmap-cnt m)) (ord (pmap-order m)))
+             (if (fx>? cnt (if (all-keywords? ord) array-map-limit-kw array-map-limit))
+                 (pmap->hash m) m)))
           ((null? (cdr kvs)) (error 'hash-map "odd number of map literal entries"))
           (else (loop (pmap-put-ordered m (car kvs) (cadr kvs)) (cddr kvs))))))
 ;; array-map ctor: insertion-ordered regardless of size (createAsIfByAssoc).

host/chez/transients.ss

@@ -86,7 +86,11 @@
                (if (fx<? i cnt) (begin (vector-set! out i (vector-ref buf i)) (loop (fx+ i 1)))
                    (make-pvec out)))))))
     ((map)
-     (let* ((ht (jolt-transient-buf t)) (cnt (hashtable-size ht)) (cap (jolt-transient-n t)))
+     (let* ((ht (jolt-transient-buf t)) (cnt (hashtable-size ht)) (cap (jolt-transient-n t))
+            ;; Clojure 1.13: a keyword-only map stays an array map up to 64 entries,
+            ;; so a keyword map built through a transient (into {} …) keeps insertion
+            ;; order to 64, matching the literal/assoc paths.
+            (cap (if (all-keywords? (jolt-transient-ord t)) (fxmax array-map-limit-kw cap) cap)))
        (if (fx>? cnt cap)
            ;; promoted past the array capacity: hash order
            (let ((m empty-pmap-hash))

jolt-core/clojure/core/00-syntax.clj

@@ -188,9 +188,23 @@
                      [false nil]
                      (if or-map (keys or-map) [])))
          amp? (fn* [x] (and (symbol? x) (= "&" (name x))))
+         ;; split a :keys/:syms/:strs name list at & into [sym bind?] pairs. Names
+         ;; before & bind normally (bind? true); names after & are declared-only
+         ;; (bind? false) — accepted keys (:keys) or required keys (:keys!), per
+         ;; CLJ-2961.
+         classify
+           (fn* [names]
+             (nth (reduce (fn* [st x]
+                            (if (amp? x)
+                              [(nth st 0) false]
+                              [(conj (nth st 0) [x (nth st 1)]) (nth st 1)]))
+                          [[] true] names)
+                  0))
          proc
            (fn* proc [pat init acc]
              (cond
+               ;; CLJ-2954: & is reserved for destructuring rest, never a binding.
+               (amp? pat) (throw (new IllegalArgumentException "Can't use & as a local binding"))
                (symbol? pat) (conj (conj acc pat) init)
                (vector? pat)
                  (let* [g (symbol (str (gensym)))
@@ -231,30 +245,45 @@
                         ;; group binds a :keys/:strs/:syms list. dnsp is the destructuring
                         ;; namespace from a qualified key like :ns/keys — it both prefixes
                         ;; the lookup key and overrides a bare symbol's namespace.
+                        ;; group binds a :keys/:strs/:syms list. checked? marks the
+                        ;; :keys!/:strs!/:syms! variants (CLJ-2961): lookups use req!
+                        ;; (throw on missing) instead of get. A pair is [sym bind?];
+                        ;; bind? false (names after &) is declared-only — for checked
+                        ;; groups it still runs req! (bound to a throwaway gensym) to
+                        ;; enforce the key, for unchecked groups it's a no-op.
                         group
-                          (fn* group [a names kind dnsp]
+                          (fn* group [a names kind dnsp checked?]
                             (if names
                                 (reduce
                                   ;; s is a symbol (a b) or a keyword (:a :b); name/
                                   ;; namespace handle both, so :keys [:major] binds
                                   ;; `major` looking up :major (str would keep the colon).
-                                  (fn* [aa s]
+                                  (fn* [aa pair]
-                                    (let* [local (name s)
+                                    (let* [s (nth pair 0)
+                                           bind? (nth pair 1)
+                                           local (name s)
                                            nsp (or (namespace s) dnsp)
                                            keyform (cond
                                                      (= kind :kw) (keyword (if nsp (str nsp "/" local) local))
                                                      (= kind :str) local
                                                      :else `(quote ~(symbol nsp local)))
-                                           fo (find-or or-map local)]
+                                           fo (find-or or-map local)
-                                      (conj (conj aa (symbol local))
+                                           lookup (cond
-                                            (if (nth fo 0)
+                                                    checked? `(req! ~gm ~keyform)
-                                              `(get ~gm ~keyform ~(nth fo 1))
+                                                    (nth fo 0) `(get ~gm ~keyform ~(nth fo 1))
-                                              `(get ~gm ~keyform)))))
+                                                    :else `(get ~gm ~keyform))]
-                                  a names)
+                                      (cond
+                                        bind?    (conj (conj aa (symbol local)) lookup)
+                                        checked? (conj (conj aa (symbol (str (gensym)))) lookup)
+                                        :else    aa)))
+                                  a (classify names))
                                 a))
-                        g1 (group base (get pat :keys) :kw nil)
+                        g1 (group base (get pat :keys)  :kw  nil false)
-                        g2 (group g1 (get pat :strs) :str nil)
+                        g2 (group g1   (get pat :strs)  :str nil false)
-                        g3 (group g2 (get pat :syms) :sym nil)]
+                        g3 (group g2   (get pat :syms)  :sym nil false)
+                        g4 (group g3   (get pat :keys!) :kw  nil true)
+                        g5 (group g4   (get pat :strs!) :str nil true)
+                        g6 (group g5   (get pat :syms!) :sym nil true)]
                    ;; remaining keys: a qualified :ns/keys|:ns/strs|:ns/syms groups under
                    ;; its namespace; any other keyword is skipped; a non-keyword is a
                    ;; nested binding pattern.
@@ -262,9 +291,12 @@
                              (if (keyword? k)
                                (let* [kn (name k) kns (namespace k)]
                                  (cond
-                                   (and kns (= kn "keys")) (group a (get pat k) :kw kns)
+                                   (and kns (= kn "keys"))  (group a (get pat k) :kw  kns false)
-                                   (and kns (= kn "strs")) (group a (get pat k) :str kns)
+                                   (and kns (= kn "strs"))  (group a (get pat k) :str kns false)
-                                   (and kns (= kn "syms")) (group a (get pat k) :sym kns)
+                                   (and kns (= kn "syms"))  (group a (get pat k) :sym kns false)
+                                   (and kns (= kn "keys!")) (group a (get pat k) :kw  kns true)
+                                   (and kns (= kn "strs!")) (group a (get pat k) :str kns true)
+                                   (and kns (= kn "syms!")) (group a (get pat k) :sym kns true)
                                    :else a))
                                ;; a direct binding {x :x}: apply its :or default
                                ;; (keyed by the local symbol) when the key is absent.
@@ -273,7 +305,7 @@
                                            `(get ~gm ~(get pat k) ~(nth fo 1))
                                            `(get ~gm ~(get pat k)))
                                        a))))
-                           g3 (keys pat)))
+                           g6 (keys pat)))
                :else (throw (str "unsupported destructuring pattern: " (pr-str pat)))))
          ploop
            (fn* ploop [i acc]

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

@@ -89,6 +89,21 @@
              (recur nxt (next ks))))
          m)))))
 
+(defn req!
+  "Returns the value mapped to key k in map m, like `get`, but throws
+  IllegalArgumentException when k is not present. Unlike `get`, does not nil-pun:
+  a key present with a nil value returns nil, an absent key throws. The primitive
+  behind checked-keys destructuring (:keys! / :syms! / :strs!)."
+  {:added "1.13"}
+  [m k]
+  ;; a fresh map is its own identity, so a present-but-nil value is distinguished
+  ;; from an absent key (same trick as get-in's sentinel).
+  (let [sentinel (hash-map)
+        v (get m k sentinel)]
+    (if (identical? sentinel v)
+      (throw (new IllegalArgumentException (str "Expected key: " k)))
+      v)))
+
 ;; find-based, so nil RESULTS are cached too; args canonicalize as a collection key.
 (defn memoize [f]
   (let [mem (atom (hash-map))]

test/chez/unit.edn

@@ -576,4 +576,26 @@
   {:suite "deftype-method" :expr "(do (defprotocol P (m [_ o])) (defrecord R [n] P (m [_ _] n)) (m (->R 5) :x))" :expected "5"}
   {:suite "deftype-method" :expr "(do (defprotocol P2 (m2 [_ o])) (deftype T [n] P2 (m2 [_ _] n)) (m2 (->T 7) :x))" :expected "7"}
   {:suite "protocol-host" :expr "(do (defprotocol Q (e [_])) (extend-protocol Q clojure.lang.Var (e [_] :var)) [(satisfies? Q (var map)) (e (var map))])" :expected "[true :var]"}
+
+  ;; Clojure 1.13 (1.13.0-alpha1) parity. Ahead of the JVM 1.12.5 the corpus
+  ;; certifies against, so these live here rather than as certified corpus rows.
+  {:suite "clj-1.13 req!" :expr "(req! {:a 1} :a)" :expected "1"}
+  {:suite "clj-1.13 req!" :expr "(req! [10 20 30] 1)" :expected "20"}
+  {:suite "clj-1.13 req!" :expr "(nil? (req! {:a nil} :a))" :expected "true"}
+  {:suite "clj-1.13 req!" :expr "(req! {:a 1} :b)" :expected :throws}
+  {:suite "clj-1.13 amp-binding" :expr "(let [& 42] &)" :expected :throws}
+  {:suite "clj-1.13 amp-binding" :expr "(loop [& 42] &)" :expected :throws}
+  {:suite "clj-1.13 checked-keys" :expr "(let [{:keys! [a b]} {:a 1 :b 2}] [a b])" :expected "[1 2]"}
+  {:suite "clj-1.13 checked-keys" :expr "(let [{:keys! [a b]} {:a 1}] [a b])" :expected :throws}
+  {:suite "clj-1.13 checked-keys" :expr "(nil? (let [{:keys! [a]} {:a nil}] a))" :expected "true"}
+  {:suite "clj-1.13 checked-keys" :expr "(let [{:strs! [a]} {\"a\" 5}] a)" :expected "5"}
+  {:suite "clj-1.13 checked-keys" :expr "(let [{:keys! [a & b]} {:a 1 :b 2}] a)" :expected "1"}
+  {:suite "clj-1.13 checked-keys" :expr "(let [{:keys! [a & b]} {:a 1}] a)" :expected :throws}
+  {:suite "clj-1.13 checked-keys" :expr "(let [{:keys [a & b]} {:a 1 :b 2}] a)" :expected "1"}
+  {:suite "clj-1.13 checked-keys" :expr "(let [{:foo/keys! [a]} {:foo/a 7}] a)" :expected "7"}
+  {:suite "clj-1.13 checked-keys" :expr "(let [{:foo/keys! [a]} {}] a)" :expected :throws}
+  {:suite "clj-1.13 array-map-64" :expr "(keys {:a 1 :b 2 :c 3 :d 4 :e 5 :f 6 :g 7 :h 8 :i 9 :j 10})" :expected "(:a :b :c :d :e :f :g :h :i :j)"}
+  {:suite "clj-1.13 array-map-64" :expr "(= (map (fn [i] (keyword (str \"k\" i))) (range 20)) (keys (into {} (map (fn [i] [(keyword (str \"k\" i)) i]) (range 20)))))" :expected "true"}
+  {:suite "clj-1.13 array-map-64" :expr "(= (map (fn [i] (keyword (str \"k\" i))) (range 64)) (keys (reduce (fn [m i] (assoc m (keyword (str \"k\" i)) i)) {} (range 64))))" :expected "true"}
+  {:suite "clj-1.13 array-map-64" :expr "(= (map (fn [i] (keyword (str \"k\" i))) (range 65)) (keys (into {} (map (fn [i] [(keyword (str \"k\" i)) i]) (range 65)))))" :expected "false"}
 ]