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

records as shape-recs carrying a type tag (jolt-t34 R3)

Browse source 
Records (defrecord/deftype) become shape-recs whose descriptor also carries
:type, under JOLT_SHAPE (flag off keeps the :jolt/deftype table form). A record
is a Janet tuple [descriptor field0 ...] in declared field order, so the
positional ->Name ctor maps args straight to slots.

- record-tag unifies the type accessor over both reps; instance?/satisfies?/
  protocol dispatch and the . interop path go through it.
- virtual :jolt/deftype key on record shape-recs (via shape-get) keeps every
  existing (get obj :jolt/deftype) dispatch site working.
- emit-kw-lookup's non-proven fallback routes any tuple to core-get (shape
  aware), not gated on compile-time JOLT_SHAPE — core is baked without the flag
  but still receives user shape-recs.
- assoc keeps the type (same-shape in place, new key grows a slot Clojure-style);
  dissoc of a declared field demotes to a plain map; pr prints #ns.Type{...}.
- JOLT_SHAPE added to the image-cache key (it shapes core's own compiled paths).
This commit is contained in:
Yogthos 2026-06-13 19:23:04 -04:00
parent e61a175f91
commit 2900d36176
7 changed files with 110 additions and 35 deletions
Download patch file Download diff file Expand all files Collapse all files

1
clojuredocs-export.edn Normal file
View file

File diff suppressed because one or more lines are too long

1
clojuredocs-export.json Normal file
View file

File diff suppressed because one or more lines are too long

6
src/jolt/api.janet
View file

@ -300,7 +300,7 @@
# Opts land in the key via their printed form; an opt that prints unstably
# (e.g. a closure in :namespaces) just degrades to a cache miss, never to a
# wrong hit. Runtime knobs that shape the ctx outside opts ride along too.
(def key (string/format "%q|%q|%q|%q|%q|%q|%q|%q|%q|%q"
(def key (string/format "%q|%q|%q|%q|%q|%q|%q|%q|%q|%q|%q"
(string janet/version "-" janet/build)
opts
(os/getenv "JOLT_PATH")
@ -310,7 +310,9 @@
(os/getenv "JOLT_INTERPRET_MACROS")
(os/getenv "JOLT_DIRECT_LINK")
(os/getenv "JOLT_NO_IR_PASSES")
(os/getenv "JOLT_CHECK_HINTS")))
(os/getenv "JOLT_CHECK_HINTS")
# JOLT_SHAPE shapes core's own compiled get/record paths
(os/getenv "JOLT_SHAPE")))
(string dir "/jolt-ctx-" (band h 0x7FFFFFFF) "-" len "-" (band (hash key) 0x7FFFFFFF) ".jimg"))
(defn init-cached

10
src/jolt/backend.janet
View file

@ -384,10 +384,14 @@
# on, a raw-get-safe value may still be a shape-rec (its :shape dropped by a
# join), so read the index from the value's own descriptor when it is a tuple;
# a real struct takes the bare get. (jolt-t34)
# sidx => proven complete shape, bare index (the fast path). Otherwise route a
# TUPLE (a possible shape-rec) to core-get, which is shape-aware and nil-safe;
# a struct takes the bare get. NOT gated on compile-time JOLT_SHAPE: core is
# baked WITHOUT the flag but still receives user shape-recs, so this must hold
# in baked core too. Cost on the default path is one tuple? test per
# non-proven keyword lookup. (jolt-t34 R3)
(defn get-or-shape [getexpr]
(cond sidx ['in m sidx]
(os/getenv "JOLT_SHAPE") ['if ['tuple? m] ['in m ['+ 1 [[['in m 0] :idx] k]]] getexpr]
getexpr))
(if sidx ['in m sidx] ['if ['tuple? m] (tuple core-get m k nil) getexpr]))
(if (nil? d-expr)
(let [fast (get-or-shape ['get m k])]
(wrap (cond

11
src/jolt/core.janet
View file

@ -1631,8 +1631,15 @@
(buffer/push-string buf (ns-display-name v))
(buffer/push-string buf "]"))
(and (table? v) (= :jolt/var (get v :jolt/type))) (buffer/push-string buf (var-display v))
(shape-rec? v) (pr-render-pairs buf
(map (fn [k] [k (shape-get v k nil)]) (shape-keys v)))
(shape-rec? v)
(let [rtag (record-tag v)
pairs (map (fn [k] [k (shape-get v k nil)]) (shape-keys v))]
(cond
# a record shape-rec prints Clojure-style: #ns.Type{:k v, ...}
(and rtag print-method-cb (print-method-cb v (fn [piece] (buffer/push-string buf piece)))) nil
rtag (do (buffer/push-string buf (string "#" rtag))
(pr-render-pairs buf pairs))
(pr-render-pairs buf pairs)))
(core-sorted-map? v) (pr-render-pairs buf
(map (fn [e] [(vnth e 0) (vnth e 1)]) (sorted-entries-arr v)))
(core-sorted-set? v) (pr-render-seq buf (sorted-entries-arr v) "#{" "}")

55
src/jolt/evaluator.janet
View file

@ -134,6 +134,12 @@
(cond
(or (function? f) (cfunction? f)) (apply f args)
(jolt-transient? f) (transient-lookup f (get args 0) (get args 1))
# a record shape-rec is callable: IFn impl if it has one, else map-like
# field access. A plain (non-record) shape-rec is just field access.
(shape-rec? f)
(let [tag (record-tag f)
ifn (when tag (find-protocol-method ctx tag "IFn" "-invoke"))]
(if ifn (apply ifn f args) (shape-get f (get args 0) (get args 1))))
(keyword? f) (coll-lookup (get args 0) f (get args 1))
(and (struct? f) (= :symbol (f :jolt/type)))
(coll-lookup (get args 0) f (get args 1))
@ -1062,6 +1068,7 @@
# maps: phm / plain struct / sorted / records — java.util.Map covers them
# all in ring-style extend-protocol clauses
(or (phm? obj)
(shape-rec? obj) # plain shape maps AND records — both map-like
(and (struct? obj) (nil? (get obj :jolt/type)))
(and (table? obj) (or (get obj :jolt/deftype)
(= :jolt/sorted-map (get obj :jolt/type)))))
@ -1085,9 +1092,8 @@
(defn protocol-dispatch-impl [ctx proto-name method-name obj rest-args]
# an empty jolt rest arg is NIL (Clojure semantics); janet apply needs a tuple
(default rest-args [])
(def type-tag (if (and (table? obj) (get obj :jolt/deftype))
(get obj :jolt/deftype)
(if (get obj :jolt/protocol-methods) (get obj :jolt/deftype))))
(def type-tag (or (record-tag obj)
(if (and (table? obj) (get obj :jolt/protocol-methods)) (get obj :jolt/deftype))))
(if (and (table? obj) (get obj :jolt/protocol-methods))
(let [reified-fns (get obj :jolt/protocol-methods)
f (get reified-fns (keyword method-name))]
@ -1362,11 +1368,16 @@
[ctx type-name-sym field-kws]
(def type-tag (string (ctx-current-ns ctx) "." (type-name-sym :name)))
(def kws (d-realize field-kws))
(fn [& args]
(var inst @{:jolt/deftype type-tag})
(var i 0)
(each kw kws (put inst kw (in args i)) (++ i))
inst))
# Records become shape-recs only under JOLT_SHAPE (jolt-t34 R3) — part of the
# shape feature, which the whole field-access pipeline handles. With the flag
# off, records are the original :jolt/deftype tables. Read the flag at ctor-
# BUILD time (deftype eval) so a type is consistently one rep or the other.
(if (os/getenv "JOLT_SHAPE")
(fn [& args] (make-record type-tag kws args))
(fn [& args]
(var inst @{:jolt/deftype type-tag})
(var i 0) (each kw kws (put inst kw (in args i)) (++ i))
inst)))
(defn install-stateful-fns!
"Intern ctx-capturing closures for the stateful primitives into clojure.core, so
@ -1583,10 +1594,9 @@
# satisfies?: evaluated protocol value + instance (matches the prior arm).
(ns-intern core "satisfies?"
(fn [proto obj]
(def type-tag (if (and (table? obj) (get obj :jolt/deftype))
(get obj :jolt/deftype)
(if (get obj :jolt/protocol-methods)
(get obj :jolt/deftype))))
(def type-tag (or (record-tag obj)
(if (and (table? obj) (get obj :jolt/protocol-methods))
(get obj :jolt/deftype))))
(if type-tag
(let [pn (proto :name)
pn-str (if (struct? pn) (pn :name) pn)]
@ -1596,8 +1606,8 @@
# evaluate to values on jolt); the value arg arrives evaluated.
(ns-intern core "instance-check"
(fn [type-sym val]
(if (get val :jolt/deftype)
(let [type-tag (val :jolt/deftype)
(if (record-tag val)
(let [type-tag (record-tag val)
type-name (type-sym :name)]
(or (= type-tag type-name)
(and (> (length type-tag) (length type-name))
@ -2324,19 +2334,20 @@
(if m
(m target ;args)
(error (string "Unsupported method ." field-name " on " (string (get target :jolt/type))))))
(if (target :jolt/deftype)
(if (record-tag target)
# deftype/reify methods live in the protocol registry (or the
# instance's reified-fns table), not on the instance
# instance's reified-fns table), not on the instance. get is safe
# on a shape-rec tuple (returns nil for the method/protocol keys).
(let [method-key (keyword field-name)
own (get target method-key)
reified (get (get target :jolt/protocol-methods) method-key)
m (cond
(or (function? own) (cfunction? own)) own
(or (function? reified) (cfunction? reified)) reified
(find-method-any-protocol ctx (target :jolt/deftype) field-name))]
(find-method-any-protocol ctx (record-tag target) field-name))]
(if m
(apply m target args)
(error (string "No method ." field-name " on " (target :jolt/deftype)))))
(error (string "No method ." field-name " on " (record-tag target)))))
# Janet-native interop: try field lookup + call
(if (or (table? target) (struct? target))
(let [method (get target (keyword field-name))]
@ -2371,16 +2382,18 @@
(get tagged-methods (get target :jolt/type))
(get (get tagged-methods (get target :jolt/type)) field-name))
((get (get tagged-methods (get target :jolt/type)) field-name) target)
(let [v (get target (keyword field-name))]
(let [v (if (record-tag target)
(coll-lookup target (keyword field-name) nil)
(get target (keyword field-name)))]
(if (and (struct? member-raw) (= :symbol (member-raw :jolt/type))
(not (string/has-prefix? "-" member-name)))
(cond
(or (function? v) (cfunction? v)) (v target)
# zero-arg deftype/reify method via the protocol registry
(and (table? target) (target :jolt/deftype))
(record-tag target)
(let [reified (get (get target :jolt/protocol-methods) (keyword field-name))
m (if (or (function? reified) (cfunction? reified)) reified
(find-method-any-protocol ctx (target :jolt/deftype) field-name))]
(find-method-any-protocol ctx (record-tag target) field-name))]
(if m (m target) v))
# value stored as an unevaluated fn* form: compile then call
(array? v) (let [f (eval-form ctx bindings v)]

61
src/jolt/types.janet
View file

@ -625,15 +625,31 @@
(struct? (in x 0)) (not (nil? (in (in x 0) :jolt/shape)))))
(defn shape-keys [rec] ((in rec 0) :jolt/shape))
(defn shape-get [rec k default]
(def pos (get ((in rec 0) :idx) k))
(if (nil? pos) default (in rec (+ pos 1))))
(defn shape-assoc [rec k v]
# assoc on a known key keeps the layout; a new key falls back to a struct
(def desc (in rec 0))
(def pos (get (desc :idx) k))
(if (nil? pos)
(let [t @{}] (each kk (desc :jolt/shape) (put t kk (shape-get rec kk nil))) (put t k v) (table/to-struct t))
(let [a (array ;rec)] (put a (+ pos 1) v) (tuple ;a))))
(cond
(not (nil? pos)) (in rec (+ pos 1))
# records respond to the virtual :jolt/deftype key with their type tag, so
# every existing (get obj :jolt/deftype) dispatch site keeps working
(and (= k :jolt/deftype) (desc :type)) (desc :type)
default))
(defn shape-assoc [rec k v]
# assoc on a known key keeps the layout. A new key: a record keeps its type
# and grows a slot (Clojure records stay records when extended); a plain
# shape-rec falls back to a struct.
(def desc (in rec 0))
(def pos (get (desc :idx) k))
(cond
(not (nil? pos)) (let [a (array ;rec)] (put a (+ pos 1) v) (tuple ;a))
(desc :type)
(let [new-keys (array ;(desc :jolt/shape) k) idx @{}]
(var i 0) (each kk new-keys (put idx kk i) (++ i))
(def ndesc (struct :jolt/shape (tuple ;new-keys) :idx (table/to-struct idx) :type (desc :type)))
(def out @[ndesc])
(each kk (desc :jolt/shape) (array/push out (shape-get rec kk nil)))
(array/push out v)
(tuple ;out))
(let [t @{}] (each kk (desc :jolt/shape) (put t kk (shape-get rec kk nil))) (put t k v) (table/to-struct t))))
(defn shape-count [rec] (- (length rec) 1))
(defn shape-contains? [rec k] (not (nil? (get ((in rec 0) :idx) k))))
(defn shape-vals [rec] (tuple/slice rec 1))
@ -644,3 +660,34 @@
(each kk (desc :jolt/shape) (put t kk (in rec (+ 1 (get (desc :idx) kk)))))
(table/to-struct t))
# --- records as shapes (jolt-t34 R3) ----------------------------------------
# A user record (deftype/defrecord) is a shape-rec whose descriptor ALSO carries
# :type (the type tag). Field layout is the DECLARED field order (not sorted),
# so the positional ->Name constructor maps args to slots directly. The
# descriptor is interned per type tag, so all instances of a type share it.
# record-tag unifies the type accessor over both the new shape-rec records and
# the table form still used for reified protocol objects.
(def- record-desc-cache @{})
(defn record-desc [type-tag field-keys]
"Build a record descriptor (interned in declared field order) for the given
key set. Not cached — used for records extended past their declared fields."
(let [idx @{}]
(var i 0) (each k field-keys (put idx k i) (++ i))
(struct :jolt/shape (tuple ;field-keys) :idx (table/to-struct idx) :type type-tag)))
(defn record-shape-for [type-tag field-keys]
(or (get record-desc-cache type-tag)
(let [desc (record-desc type-tag field-keys)]
(put record-desc-cache type-tag desc)
desc)))
(defn make-record [type-tag field-keys args]
(def out @[(record-shape-for type-tag field-keys)])
(var i 0) (each k field-keys (array/push out (in args i)) (++ i))
(tuple ;out))
(defn record-tag
"The deftype/record type tag of x, or nil. Covers shape-rec records (descriptor
:type) and the table form (reified objects, :jolt/deftype)."
[x]
(cond
(and (tuple? x) (> (length x) 0) (struct? (in x 0))) (get (in x 0) :type)
(and (table? x) (get x :jolt/deftype)) (get x :jolt/deftype)))