diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj index 05f9217..9df03ca 100644 --- a/jolt-core/clojure/core/30-macros.clj +++ b/jolt-core/clojure/core/30-macros.clj @@ -295,6 +295,15 @@ (and mt (:num mt)) "num" :else nil))) fields) + ;; per-field MUTABILITY (jolt-c3q): ^:unsynchronized-mutable / ^:volatile- + ;; mutable marks a field set!-able. A type with any mutable field opts out + ;; of the immutable shape-rec layout and uses the mutable table form, so + ;; set! can mutate it (the ctor reads this vector). Spliced as a literal. + field-muts (map (fn [f] (let [mt (meta f)] + (if (and mt (or (:unsynchronized-mutable mt) + (:volatile-mutable mt))) + true false))) + fields) impl (fn [proto specs] `(extend-type ~tname ~proto ~@(map (fn [spec] @@ -304,7 +313,7 @@ `(~(first spec) ~argv (let [~@binds] ~@(drop 2 spec))))) specs)))] `(do - (def ~tname (make-deftype-ctor (quote ~tname) [~@field-kws] [~@field-tags])) + (def ~tname (make-deftype-ctor (quote ~tname) [~@field-kws] [~@field-tags] [~@field-muts])) (def ~arrow ~tname) ~@(map (fn [g] (impl (first g) (rest g))) (group-by-head body)) ~tname))) diff --git a/src/jolt/eval_runtime.janet b/src/jolt/eval_runtime.janet index 6e4caef..0e20298 100644 --- a/src/jolt/eval_runtime.janet +++ b/src/jolt/eval_runtime.janet @@ -385,20 +385,26 @@ instances carry a stable tag matching what extend-type registers methods under. field-kws is the [:f1 :f2 …] keyword vector; the ctor maps positional args to those keys. A ctx-capturing closure (make-deftype-ctor) is the public handle." - [ctx type-name-sym field-kws &opt field-tags] + [ctx type-name-sym field-kws &opt field-tags field-muts] (def type-tag (string (ctx-current-ns ctx) "." (type-name-sym :name))) (def kws (d-realize field-kws)) # per-field type hints (jolt-3ko): a tuple parallel to kws — "Vec3" (a record # type name), "num", or nil. The inference resolves these to the field's exact # type so reading a field back carries it (a nested record stays typed). (def tags (if field-tags (d-realize field-tags) (array/new-filled (length kws)))) + # jolt-c3q: a type with any ^:unsynchronized-mutable / ^:volatile-mutable field + # is set!-able, so it CAN'T be an immutable shape-rec tuple. Such a type uses + # the mutable :jolt/deftype table form regardless of :shapes? (set! mutates it, + # field reads route through the tagged-table path), and is NOT registered as a + # shape so the inference never emits a bare-index read against the table. + (def mutable? (and field-muts (some |(identity $) (d-realize field-muts)))) # The ctor closure itself. Built FIRST so it can be indexed by value below. # Records are shape-recs when shapes are active (:shapes? = direct-link, where # the inference proves the reads) — the whole field-access pipeline handles - # them; otherwise the original :jolt/deftype tables. Read at ctor-BUILD time so - # a type is consistently one representation or the other. + # them; otherwise (or when mutable) the original :jolt/deftype tables. Read at + # ctor-BUILD time so a type is consistently one representation or the other. (def the-ctor - (if (get (ctx :env) :shapes?) + (if (and (get (ctx :env) :shapes?) (not mutable?)) (fn [& args] (make-record type-tag kws args)) (fn [& args] (var inst @{:jolt/deftype type-tag}) @@ -408,7 +414,9 @@ # the inference types (->Name ...) as a struct of these fields and field reads # on the result bare-index. Keyed by the ctor var-key "ns/->Name" to match how # the IR names the call head. Harmless when records aren't shaped (sidx gated). - (let [rs (or (get (ctx :env) :record-shapes) + # Skipped for mutable types — they're tables, not shape-recs (jolt-c3q). + (unless mutable? + (let [rs (or (get (ctx :env) :record-shapes) (let [t @{}] (put (ctx :env) :record-shapes t) t)) # ctor-value index: maps each ctor closure to its rs key, so a ^Type hint # in another namespace can resolve home through the type var's root value @@ -428,7 +436,7 @@ tags)] (put rs (string (ctx-current-ns ctx) "/->" (type-name-sym :name)) {:fields (tuple ;kws) :type type-tag :tags (tuple ;resolved)}) - (put cix the-ctor (string (ctx-current-ns ctx) "/->" (type-name-sym :name)))) + (put cix the-ctor (string (ctx-current-ns ctx) "/->" (type-name-sym :name))))) the-ctor) (defn install-stateful-fns! @@ -504,7 +512,7 @@ (ns-intern core "refer-clojure" (fn [& args] (refer-clojure-impl ctx ;args))) (ns-intern core "defmulti-setup" (fn [name-sym dispatch & opts] (defmulti-setup ctx name-sym dispatch ;opts))) (ns-intern core "defmethod-setup" (fn [mm-sym dval impl] (defmethod-setup ctx mm-sym dval impl))) - (ns-intern core "make-deftype-ctor" (fn [name-sym field-kws &opt field-tags] (make-deftype-ctor-impl ctx name-sym field-kws field-tags))) + (ns-intern core "make-deftype-ctor" (fn [name-sym field-kws &opt field-tags field-muts] (make-deftype-ctor-impl ctx name-sym field-kws field-tags field-muts))) # Var/namespace lookups that need the ctx (the rest of the var fns — var-get/ # var-set/var?/alter-var-root/alter-meta!/reset-meta! — are plain core-bindings). (ns-intern core "find-var" (fn [sym] (find-var ctx sym))) diff --git a/test/integration/mutable-deftype-test.janet b/test/integration/mutable-deftype-test.janet new file mode 100644 index 0000000..261cee2 --- /dev/null +++ b/test/integration/mutable-deftype-test.janet @@ -0,0 +1,57 @@ +# Mutable deftype fields under shapes/direct-link (jolt-c3q). +# +# A deftype field tagged ^:unsynchronized-mutable / ^:volatile-mutable is set! at +# runtime. Immutable records are shape-recs (immutable tuples) where shapes are +# active (direct-link), so set! can't mutate them. A deftype with ANY mutable +# field opts out of the shape-rec layout and uses the mutable table form (which +# set! already mutates and field reads route through), regardless of :shapes?. +# Immutable deftypes/records keep the fast shape-rec. + +(use ../../src/jolt/api) + +(var failures 0) +(defn- check [label got want] + (unless (= got want) + (++ failures) + (printf "FAIL [%s] got %q want %q" label got want))) + +# direct-linking? true => :shapes? on (the mode where immutable records are +# tuples and this used to error "Can't set! field on non-deftype: tuple"). +(let [ctx (init {:compile? true :direct-linking? true})] + (eval-string ctx "(deftype Counter [^:unsynchronized-mutable n])") + (eval-string ctx "(def c (->Counter 0))") + (check "read initial mutable field" (eval-string ctx "(.-n c)") 0) + (eval-string ctx "(set! (.-n c) 5)") + (check "read after set!" (eval-string ctx "(.-n c)") 5) + (eval-string ctx "(set! (.-n c) (inc (.-n c)))") + (check "set! using prior value" (eval-string ctx "(.-n c)") 6) + # keyword access reads the same mutated field + (check "keyword access sees mutation" (eval-string ctx "(:n c)") 6)) + +# Mixed mutable + immutable fields: a method reads both, set! touches the mutable. +(let [ctx (init {:compile? true :direct-linking? true})] + (eval-string ctx "(deftype Cell [label ^:unsynchronized-mutable v] Object (toString [_] (str label \"=\" v)))") + (eval-string ctx "(def cell (->Cell \"x\" 1))") + (check "immutable field reads" (eval-string ctx "(.-label cell)") "x") + (check "custom toString before" (eval-string ctx "(str cell)") "x=1") + (eval-string ctx "(set! (.-v cell) 42)") + (check "mutable field after set!" (eval-string ctx "(.-v cell)") 42) + (check "custom toString after mutation" (eval-string ctx "(str cell)") "x=42") + (check "immutable field unchanged" (eval-string ctx "(.-label cell)") "x")) + +# volatile-mutable is treated the same (also a mutable field). +(let [ctx (init {:compile? true :direct-linking? true})] + (eval-string ctx "(deftype Box [^:volatile-mutable x])") + (eval-string ctx "(def b (->Box :a))") + (eval-string ctx "(set! (.-x b) :z)") + (check "volatile-mutable set!" (eval-string ctx "(.-x b)") :z)) + +# An all-immutable deftype/record is unaffected: still a shape-rec, fast reads. +(let [ctx (init {:compile? true :direct-linking? true})] + (eval-string ctx "(defrecord Pt [x y])") + (check "immutable record reads" (eval-string ctx "(:x (->Pt 3 4))") 3) + (check "immutable record reads y" (eval-string ctx "(:y (->Pt 3 4))") 4)) + +(if (pos? failures) + (do (printf "mutable-deftype: %d failure(s)" failures) (os/exit 1)) + (print "mutable-deftype: all cases passed"))