simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

One IRef seam: watches/validators/meta over atom, var, and agent

Browse source 
add-watch/remove-watch/set-validator!/get-validator were atom-only; the
atom ctor ignored :meta and :validator; watching a var crashed. Now the
ARef contract is one seam: atoms keep their record slots (hot path
unchanged), every other reference type registers a predicate and stores
watches/validators in identity-keyed side tables, and notifies at its
mutation points. Vars notify on root changes (def on a watched var,
var-set outside a thread binding, alter-var-root — thread-binding sets
don't notify, like the JVM); agents notify per action. The def-var! wrap
costs two weak-table probes per def and does IRef work only on a watched
var.

Ctor options follow ARef: the validator gates the initial value
(IllegalStateException 'Invalid reference state' — also the class for
rejected swap!/reset!), :meta must be a map (else ClassCastException),
nil allowed. meta reads any reference through the identity side-table
(the type-gated fall-through is gone); alter-meta!/reset-meta! work on
non-var references.

Runtime-only (no re-mint). 9 JVM-certified corpus rows; spec entry; cts
baseline 5781 -> 5805 pass, 73 baselined namespaces (the residual error
in the watch namespaces is their STM ref section — refs stay out of
scope).
This commit is contained in:
Yogthos 2026-07-02 09:07:00 -04:00
parent 257f822825
commit f80f9aab4b
8 changed files with 203 additions and 42 deletions
Download patch file Download diff file Expand all files Collapse all files

9
test/chez/corpus.edn
View file

@ -3542,4 +3542,13 @@
{:suite "hierarchy / classes" :label "ancestors of a concrete class roots at Object" :expected "[true true]" :actual "[(contains? (ancestors (class #{})) java.lang.Object) (contains? (ancestors (class [])) java.lang.Object)]"}
{:suite "hierarchy / classes" :label "parents of a class are its direct supers" :expected "true" :actual "(contains? (parents (class [])) clojure.lang.APersistentVector)"}
{:suite "hierarchy / classes" :label "a relationship derived on a super applies to the class (isa? supers arm)" :expected "true" :actual "(let [h (derive (make-hierarchy) java.util.Collection :user/coll-like)] (isa? h (class []) :user/coll-like))"}
{:suite "iref / atom ctor options" :label ":meta attaches, :validator gates the initial value" :expected "[{:m 1} 1 nil]" :actual "(let [a (atom 1 :meta {:m 1} :validator pos?)] [(meta a) (deref a) (meta (atom nil :meta nil))])"}
{:suite "iref / atom ctor options" :label "non-map :meta is a ClassCastException" :expected "[:cce :cce]" :actual "[(try (atom nil :meta 5) (catch ClassCastException _ :cce)) (try (atom nil :meta #{}) (catch ClassCastException _ :cce))]"}
{:suite "iref / atom ctor options" :label "an invalid initial value never constructs" :expected ":ise" :actual "(try (atom {} :validator (constantly false)) (catch IllegalStateException _ :ise))"}
{:suite "iref / atom ctor options" :label "validator still gates swap!/reset!" :expected "[:ise 1]" :actual "(let [a (atom 1 :validator pos?)] [(try (reset! a -1) (catch IllegalStateException _ :ise)) (deref a)])"}
{:suite "iref / watches" :label "an atom watch gets key, the ref, old and new" :expected "[:k true 0 1]" :actual "(let [a (atom 0) w (atom nil)] (add-watch a :k (fn [k r o n] (reset! w [k (identical? r a) o n]))) (swap! a inc) (deref w))"}
{:suite "iref / watches" :label "vars are watchable: root changes notify (alter-var-root, def)" :expected "[[1 2] [2 5]]" :actual "(do (def vw-x 1) (def vw-log (atom [])) (add-watch (var vw-x) :w (fn [k r o n] (swap! vw-log conj [o n]))) (alter-var-root (var vw-x) inc) (def vw-x 5) (deref vw-log))"}
{:suite "iref / watches" :label "add-watch returns the var; a validator gates the var root" :expected "[true :ise]" :actual "(do (def vv-y 1) [(= (var vv-y) (add-watch (var vv-y) :k (fn [a b c d] nil))) (do (set-validator! (var vv-y) pos?) (try (alter-var-root (var vv-y) -) (catch IllegalStateException _ :ise)))])"}
{:suite "iref / watches" :label "agent watches fire on state change" :expected "[0 1]" :actual "(let [ag (agent 0) p (promise)] (add-watch ag :w (fn [k r o n] (deliver p [o n]))) (send ag inc) (deref p 2000 :timeout))"}
{:suite "iref / meta" :label "alter-meta! works on atoms" :expected "{:x 1 :y 2}" :actual "(let [a (atom 1 :meta {:x 1})] (alter-meta! a assoc :y 2))"}
]

3
test/chez/cts-known-failures.txt
View file

@ -2,8 +2,7 @@
# The gate fails on any per-namespace change, worse OR better; regenerate
# with: JOLT_CTS_WRITE_BASELINE=1 host/chez/cts.sh
clojure.core-test.abs 1 0
clojure.core-test.add-watch 0 3
clojure.core-test.atom 14 0
clojure.core-test.add-watch 0 1
clojure.core-test.bigint 6 0
clojure.core-test.bit-set 1 0
clojure.core-test.boolean-qmark 0 3