Run core.memoize's test suite on jolt

Shaking out clojure.core.memoize (207 assertions, 0 fail) cleared several
general gaps:

- deref/@ on a deftype or reify implementing clojure.lang.IDeref dispatches to
  its deref method (RetryingDelay / make-derefable).
- deftype mutable fields (^:unsynchronized-mutable / ^:volatile-mutable) are
  read live: a set! within a method is observed by a later read in the same
  invocation, not the entry-time capture. Needed for double-checked locking.
  Immutable fields stay let-bound. Field reads rewrite to (.-field inst) with
  lexical-shadow tracking.
- def metadata values are evaluated, like Clojure: ^{:k (f)} stores (f)'s
  result and ^{:af some-fn} the fn. :tag stays a literal hint.
- try dispatches catch clauses by class in order via the exception supertype
  hierarchy; a non-matching value re-throws, an untyped host condition is caught
  by a RuntimeException/Exception/Throwable clause. Previously the last clause
  won and the class was ignored.
- locking takes a real per-object monitor (recursive Chez mutex) now that
  futures/agents/threads share one heap; it was a no-op.
- supers/ancestors reflect a small modeled JVM interface hierarchy, so
  (ancestors (class f)) yields Runnable/Callable (core.memoize's arg check).
- AssertionError / Error constructors.

JOLT_FEATURES is gone from the docs: it isn't read anywhere on Chez, and the
reader already includes :clj in its default feature set. RFC 0002's
{:jolt :default} design was reverted in the reader; docs now match the code.

Raises the SCI floor 205 -> 210.

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

@@ -311,7 +311,12 @@
 
 (defn ancestors
   ([tag] (ancestors (deref global-hierarchy) tag))
-  ([h tag] (not-empty (get (get h :ancestors) tag))))
+  ([h tag]
+   ;; the user hierarchy plus any modeled JVM ancestry (jolt.host/class-ancestors)
+   ;; so (ancestors (class x)) answers like the JVM for the common interfaces.
+   (let [hier (get (get h :ancestors) tag)
+         host (jolt.host/class-ancestors tag)]
+     (not-empty (if host (into (or hier #{}) host) hier)))))
 
 (defn descendants
   ([tag] (descendants (deref global-hierarchy) tag))

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

@@ -344,8 +344,12 @@
 (defn numerator [x] (throw (ex-info "numerator requires a ratio (Jolt has no ratios)" {})))
 (defn denominator [x] (throw (ex-info "denominator requires a ratio (Jolt has no ratios)" {})))
 
-;; No class hierarchy on this host.
-(defn supers [x] #{})
+;; jolt has no reflection, but a few common JVM interfaces carry a modeled
+;; ancestry (jolt.host/class-supers) so reflective checks like
+;; (ancestors (class f)) answer like the JVM.
+(defn supers [x]
+  (let [s (jolt.host/class-supers x)]
+    (if s (set s) #{})))
 
 ;; Like Clojure's munge: rewrite dashes to underscores, preserving the argument's
 ;; type — a symbol munges to a symbol, anything else to a string. (jolt only

jolt-core/clojure/core/30-macros.clj

@@ -69,10 +69,10 @@
     `(instance-check ~t ~x)
     `(instance-check (quote ~t) ~x)))
 
-;; Single-threaded host: evaluate the monitor expr (for its effects, matching
-;; Clojure's evaluation order) and the body — no lock to take.
+;; Take x's monitor for the duration of body (futures/agents/threads share one
+;; heap, so this is a real per-object lock), releasing on any exit.
 (defmacro locking [x & body]
-  `(do ~x ~@body))
+  `(jolt.host/with-monitor ~x (fn* [] ~@body)))
 
 ;; defonce: define name only if it isn't already bound to a non-nil root;
 ;; returns the existing var untouched otherwise.
@@ -310,16 +310,61 @@
         ;; in-place field write the analyzer compiles to jolt-set-field!.
         mutable-syms (map first (filter second (map vector fields field-muts)))
         mutable? (fn [s] (boolean (some (fn [m] (= m s)) mutable-syms)))
-        rewrite-set (fn rw [inst form]
-                      (cond
-                        (and (seq? form) (seq form) (symbol? (first form))
-                             (= "set!" (name (first form)))
-                             (symbol? (second form)) (mutable? (second form)))
-                        (list 'set! (list (symbol (str ".-" (name (second form)))) inst)
-                              (rw inst (nth form 2)))
-                        (seq? form) (map (fn [x] (rw inst x)) form)
-                        (vector? form) (mapv (fn [x] (rw inst x)) form)
-                        :else form))
+        ;; rewrite a method body: (set! mut-field v) -> an in-place (.-field inst)
+        ;; write, and a READ of a mutable field -> (.-field inst) so it observes the
+        ;; live value after a set! (the double-checked-locking idiom re-reads a field
+        ;; after taking a lock). Immutable fields stay let-bound (captured once is
+        ;; correct and cheaper). Tracks lexical shadowing through let/loop/fn/letfn so
+        ;; a same-named local wins over a field.
+        rewrite-body
+        (fn rw [inst shadowed form]
+          (cond
+            (and (seq? form) (seq form) (symbol? (first form))
+                 (= "set!" (name (first form)))
+                 (symbol? (second form)) (mutable? (second form))
+                 (not (contains? shadowed (second form))))
+            (list 'set! (list (symbol (str ".-" (name (second form)))) inst)
+                  (rw inst shadowed (nth form 2)))
+            ;; let/loop-style vector-binding forms: rewrite inits, then shadow the
+            ;; bound names in the body.
+            (and (seq? form) (seq form) (symbol? (first form))
+                 (contains? #{"let" "let*" "loop" "binding" "when-let" "if-let"
+                              "when-some" "if-some"} (name (first form)))
+                 (vector? (second form)))
+            (let [bv (second form) n (count bv)
+                  bv' (loop [i 0 acc []]
+                        (if (< i n)
+                          (recur (+ i 2)
+                                 (let [a (conj acc (nth bv i))]
+                                   (if (< (inc i) n) (conj a (rw inst shadowed (nth bv (inc i)))) a)))
+                          acc))
+                  sh (loop [i 0 acc shadowed]
+                       (if (< i n)
+                         (recur (+ i 2) (if (symbol? (nth bv i)) (conj acc (nth bv i)) acc))
+                         acc))]
+              (cons (first form) (cons bv' (map (fn [x] (rw inst sh x)) (drop 2 form)))))
+            ;; fn/fn*: shadow each arity's params in its body.
+            (and (seq? form) (seq form) (symbol? (first form))
+                 (contains? #{"fn" "fn*"} (name (first form))))
+            (let [head (first form) tail (rest form)
+                  named? (and (seq tail) (symbol? (first tail)))
+                  fname (when named? (first tail))
+                  arts (if named? (rest tail) tail)
+                  psyms (fn [pv] (loop [p (seq pv) acc shadowed]
+                                   (if p
+                                     (recur (next p)
+                                            (if (and (symbol? (first p)) (not= (name (first p)) "&"))
+                                              (conj acc (first p)) acc))
+                                     acc)))
+                  do-art (fn [ar] (cons (first ar) (map (fn [x] (rw inst (psyms (first ar)) x)) (rest ar))))
+                  arts' (if (vector? (first arts)) (do-art arts) (map do-art arts))]
+              (concat (list head) (when named? (list fname)) arts'))
+            ;; a bare read of a mutable field -> live field access
+            (and (symbol? form) (mutable? form) (not (contains? shadowed form)))
+            (list (symbol (str ".-" (name form))) inst)
+            (seq? form) (map (fn [x] (rw inst shadowed x)) form)
+            (vector? form) (mapv (fn [x] (rw inst shadowed x)) form)
+            :else form))
         ;; inline impls register for dispatch but are NOT extenders of the
         ;; protocol (the JVM compiles them into the class) — register-inline-method,
         ;; not extend-type.
@@ -329,8 +374,11 @@
         mk-clause (fn [spec]
                     (let [argv (nth spec 1)
                           inst (first argv)
-                          binds (vec (mapcat (fn [f] [f `(get ~inst ~(keyword (name f)))]) fields))
-                          mbody (map (fn [bf] (rewrite-set inst bf)) (drop 2 spec))]
+                          ;; let-bind only immutable fields; mutable ones are read live
+                          ;; via rewrite-body so a set! within the method is observed.
+                          binds (vec (mapcat (fn [f] [f `(get ~inst ~(keyword (name f)))])
+                                             (filter (fn [f] (not (mutable? f))) fields)))
+                          mbody (map (fn [bf] (rewrite-body inst #{} bf)) (drop 2 spec))]
                       (list argv (list* 'let binds mbody))))
         groups (group-by-head body)
         ;; merge clauses by method NAME across ALL protocols into one multi-arity