mutable deftype fields: (set! field val) in a method

deftype fields tagged ^:unsynchronized-mutable / ^:volatile-mutable can now be
reassigned in place from a method, as on the JVM. A jrec stores fields as cons
cells, so a new jolt-set-field! mutates the pair with set-cdr!. The deftype macro
rewrites (set! mutable-field v) in a method body to (set! (.-field inst) v), and
the analyzer compiles a (set! (.-field obj) v) target to jolt-set-field! — so
both the rewritten symbol form and an explicit interop (set! (.-root this) v) go
through one path. Field reads remain a snapshot at method entry, which is correct
for the universal read-then-set pattern (a repeated set! of the same field in one
call would read the entry value).

Closes the set!-of-local SCI failures: SCI load 202 -> 205/218.

host/chez/records.ss

@@ -28,6 +28,16 @@
 (define (jrec-has? r k)
   (let loop ((ps (jrec-pairs r)))
     (cond ((null? ps) #f) ((jolt=2 (caar ps) k) #t) (else (loop (cdr ps))))))
+;; mutate a deftype's mutable field in place (jolt-c3q): the pairs are runtime
+;; cons cells, so set-cdr! updates the field. (set! field v) inside a method
+;; lowers to this; returns v, as set! does.
+(define (jolt-set-field! inst k v)
+  (if (jrec? inst)
+      (let loop ((ps (jrec-pairs inst)))
+        (cond ((null? ps) (error #f "set! of an unknown field" k))
+              ((jolt=2 (caar ps) k) (set-cdr! (car ps) v) v)
+              (else (loop (cdr ps)))))
+      (error #f "set! of a field on a non-record" inst)))
 (define (jrec-replace pairs k v)        ; replace existing field (keep order) or append
   (let loop ((ps pairs) (acc '()) (hit #f))
     (cond ((null? ps) (reverse (if hit acc (cons (cons k v) acc))))
@@ -329,6 +339,7 @@
 (def-var! "clojure.core" "register-protocol-methods!" register-protocol-methods!)
 (def-var! "clojure.core" "register-method" register-method)
 (def-var! "clojure.core" "register-inline-method" register-inline-method)
+(def-var! "jolt.host" "set-field!" jolt-set-field!)
 (def-var! "clojure.core" "protocol-dispatch" (lambda (pn mn obj rest) (protocol-dispatch pn mn obj rest)))
 (def-var! "clojure.core" "satisfies?" jolt-satisfies?)
 (def-var! "clojure.core" "extenders" extenders)

host/chez/run-sci.ss

@@ -1,11 +1,11 @@
 ;; run-sci.ss — SCI conformance: load borkdude/sci's own source (vendor/sci) through
 ;; joltc and require its forms to compile+eval. A real-world Clojure-compatibility
 ;; stress test. Pure Chez, no Janet. Floor-gated like the corpus: a regression below
-;; the floor (or the count today, 202/218) fails. Raise the floor as host gaps close
+;; the floor (or the count today, 205/218) fails. Raise the floor as host gaps close
 ;; (the tail is genuine gaps — set! on vars, some macro/def shapes).
 ;;
 ;;   chez --script host/chez/run-sci.ss
-;;   JOLT_SCI_FLOOR=N    override the floor (default 202)
+;;   JOLT_SCI_FLOOR=N    override the floor (default 205)
 ;;   SCI_VERBOSE=1       print each failing form's error
 (import (chezscheme))
 
@@ -74,7 +74,7 @@
   load-order)
 
 (printf "\nSCI load: ~a/~a forms ok (~a fail)\n" total-ok (+ total-ok total-fail) total-fail)
-(define floor (let ((s (getenv "JOLT_SCI_FLOOR"))) (if s (string->number s) 202)))
+(define floor (let ((s (getenv "JOLT_SCI_FLOOR"))) (if s (string->number s) 205)))
 (when (< total-ok floor)
   (printf "REGRESSION: ~a forms loaded < floor ~a\n" total-ok floor))
 (flush-output-port)

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

@@ -307,6 +307,21 @@
                                                   (:volatile-mutable mt)))
                                     true false)))
                         fields)
+        ;; mutable field symbols (^:unsynchronized-mutable / ^:volatile-mutable):
+        ;; (set! field v) in a method body lowers to (set! (.-field inst) v), the
+        ;; in-place field write the analyzer compiles to jolt-set-field! (jolt-c3q).
+        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))
         ;; 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.
@@ -315,9 +330,10 @@
                   ~@(map (fn [spec]
                            (let [argv (nth spec 1)
                                  inst (first argv)
-                                 binds (vec (mapcat (fn [f] [f `(get ~inst ~(keyword (name f)))]) fields))]
+                                 binds (vec (mapcat (fn [f] [f `(get ~inst ~(keyword (name f)))]) fields))
+                                 mbody (map (fn [bf] (rewrite-set inst bf)) (drop 2 spec))]
                              `(register-inline-method ~(name tname) ~(name proto) ~(name (first spec))
-                                                      (fn ~argv (let [~@binds] ~@(drop 2 spec))))))
+                                                      (fn ~argv (let [~@binds] ~@mbody)))))
                          specs)))]
     `(do
        (def ~tname (make-deftype-ctor (quote ~tname) [~@field-kws] [~@field-tags] [~@field-muts]))

jolt-core/jolt/analyzer.clj

@@ -343,13 +343,24 @@
                  (host-intern! ctx cur nm)
                  {:op :defmacro :ns cur :name nm
                   :fn (analyze ctx fn-form env)})
-    "set!" (let [target (nth items 1)]
+    "set!" (let [target (nth items 1)
-             (when-not (form-sym? target) (uncompilable "set! of a non-symbol target"))
+                 val-node (analyze ctx (nth items 2) env)
-             (when (local? env (form-sym-name target)) (uncompilable "set! of a local"))
+                 ti (when (form-list? target) (vec (form-elements target)))
-             (let [r (resolve-global ctx target)]
+                 thead (when (and ti (pos? (count ti)) (form-sym? (first ti)))
-               (when-not (= :var (:kind r)) (uncompilable "set! of a non-var"))
+                         (form-sym-name (first ti)))]
-               {:op :set-var :the-var (the-var (:ns r) (:name r))
+             (cond
-                :val (analyze ctx (nth items 2) env)}))
+               ;; (set! (.-field obj) v): mutate a deftype instance field in place.
+               ;; A deftype method's (set! mutable-field v) lowers to this shape.
+               (and thead (field-head? thead))
+               {:op :set-field :obj (analyze ctx (nth ti 1) env)
+                :field (subs thead 2) :val val-node}
+               ;; (set! *var* v): set the var's innermost binding, else its root.
+               (form-sym? target)
+               (do (when (local? env (form-sym-name target)) (uncompilable "set! of a local"))
+                   (let [r (resolve-global ctx target)]
+                     (when-not (= :var (:kind r)) (uncompilable "set! of a non-var"))
+                     {:op :set-var :the-var (the-var (:ns r) (:name r)) :val val-node}))
+               :else (uncompilable "set! of an unsupported target")))
     (uncompilable (str "special form " op))))
 
 ;; Host interop method call (jolt-0kf5). `(.method target arg*)` — a head that

jolt-core/jolt/backend_scheme.clj

@@ -392,6 +392,9 @@
     :the-var (str "(jolt-var " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")")
     ;; (set! *var* val) -> set the var's innermost binding (else root); returns val.
     :set-var (str "(jolt-var-set " (emit (:the-var node)) " " (emit (:val node)) ")")
+    ;; (set! (.-field obj) val) -> mutate the deftype instance field in place.
+    :set-field (str "(jolt-set-field! " (emit (:obj node)) " (keyword #f "
+                    (chez-str-lit (:field node)) ") " (emit (:val node)) ")")
     ;; a non-top-level defmacro -> def the expander fn + mark the var a macro at
     ;; runtime (the spine does the same for top-level forms).
     :defmacro (str "(begin (def-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " "

jolt-core/jolt/ir.clj

@@ -97,6 +97,7 @@
                                  :ret (f (get node :ret)))
       (= op :throw)  (assoc node :expr (f (get node :expr)))
       (= op :set-var) (assoc node :val (f (get node :val)))
+      (= op :set-field) (assoc node :obj (f (get node :obj)) :val (f (get node :val)))
       (= op :defmacro) (assoc node :fn (f (get node :fn)))
       (= op :invoke) (assoc node :fn (f (get node :fn))
                                  :args (mapv f (get node :args)))

test/chez/unit.edn

@@ -456,4 +456,7 @@
   {:suite "shadowing" :expr "(let [when (fn [a b] :local)] (when 1 2))" :expected ":local"}
   {:suite "macroexpand" :expr "(do (when true (defmacro m6 [x] `(* ~x 2))) (m6 3))" :expected "6"}
   {:suite "macroexpand" :expr "(letfn [(ev? [n] (if (zero? n) true (od? (dec n)))) (od? [n] (if (zero? n) false (ev? (dec n))))] (ev? 10))" :expected "true"}
+  {:suite "deftype-mutable" :expr "(do (defprotocol IB (gv [_]) (sv [_ v])) (deftype B [^:unsynchronized-mutable val] IB (gv [_] val) (sv [_ v] (set! val v))) (let [b (->B 1)] (sv b 42) (gv b)))" :expected "42"}
+  {:suite "deftype-mutable" :expr "(do (defprotocol IC (bump [_]) (cur [_])) (deftype C [^:unsynchronized-mutable n] IC (bump [this] (set! n (inc n)) n) (cur [_] n)) (let [c (->C 5)] (bump c) (bump c) (bump c) (cur c)))" :expected "8"}
+  {:suite "deftype-mutable" :expr "(do (defprotocol IH (g [_]) (s [_ v])) (deftype H [^:volatile-mutable st] IH (g [_] st) (s [this v] (set! (.-st this) v))) (let [h (->H :old)] (s h :new) (g h)))" :expected ":new"}
 ]