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

destructuring :or, fn :pre/:post, deftype field access + map-like dispatch

Browse source 
General fixes shaken out running clojure.core.cache (66 -> 198 of its assertions):

- Map destructuring applied an :or default only for :keys/:strs/:syms, not a
  direct {x :x} binding — so {x :x :or {x 9}} (and the & {…} kwargs form) ignored
  the default. Apply it for the direct binding too.
- fn didn't implement :pre/:post: a leading conditions map was evaluated as a body
  literal (so % was unbound and (.q %) blew up). Recognize it and assert pre
  before the body, bind % to the result, assert post, return %.
- (.q inst) on a deftype field with no matching method reads the field, like the
  JVM (was "No method q").
- A deftype implementing the clojure.lang collection interfaces now dispatches
  dissoc (without), contains? (containsKey), peek/pop (IPersistentStack), and
  keys/vals (via its Seqable seq) through its methods — they were field-only, so
  core.cache's caches and data.priority-map didn't behave as maps.

JVM-certified corpus rows for each. make test + shakesmoke green.
This commit is contained in:
Yogthos 2026-06-25 10:06:33 -04:00
parent 93b4d101a1
commit b21b99b275
5 changed files with 342 additions and 273 deletions
Download patch file Download diff file Expand all files Collapse all files

34
jolt-core/clojure/core/00-syntax.clj
View file

@ -255,7 +255,13 @@
(and kns (= kn "strs")) (group a (get pat k) :str kns)
(and kns (= kn "syms")) (group a (get pat k) :sym kns)
:else a))
(proc k `(get ~gm ~(get pat k)) a)))
;; a direct binding {x :x}: apply its :or default
;; (keyed by the local symbol) when the key is absent.
(let* [fo (if (symbol? k) (find-or or-map (name k)) [false nil])]
(proc k (if (nth fo 0)
`(get ~gm ~(get pat k) ~(nth fo 1))
`(get ~gm ~(get pat k)))
a))))
g3 (keys pat)))
:else (throw (str "unsupported destructuring pattern: " (pr-str pat)))))
ploop
@ -315,6 +321,21 @@
(if (if (seq? x) (= 'with-meta (first x)) false)
(nth x 1)
x))
;; a :pre/:post conditions map (a leading map when the body has more forms
;; after it) becomes assertions: pre before the body, then bind % to the
;; result, post after, return %. (map? is a native, so this is tier-safe;
;; the assert/map calls only run when a conditions map is actually present.)
wrap-conds
(fn* [body]
(if (if (map? (first body)) (next body) false)
(let [conds (first body)
real (next body)
mka (fn* [cs] (map (fn* [c] `(assert ~c)) cs))]
`(~@(mka (get conds :pre))
(let [~'% (do ~@real)]
~@(mka (get conds :post))
~'%)))
body))
md (fn* go [ps nps lets]
(if (seq ps)
(if (symbol? (first ps))
@ -327,8 +348,11 @@
mk (fn* [sig]
(let [ps (unhint (first sig))
hinted (not (= ps (first sig)))
r (md (seq ps) [] [])]
(if (if (empty? (nth r 1)) (not hinted) false)
r (md (seq ps) [] [])
raw-body (rest sig)
body (wrap-conds raw-body)
conds? (not (= body raw-body))]
(if (if (empty? (nth r 1)) (if (not hinted) (not conds?) false) false)
sig
;; build the params/let vectors via [~@..] so they are tuple forms
;; (the accumulators are plain seqs, the wrong representation).
@ -337,8 +361,8 @@
(let [pv `[~@(nth r 0)]
lv `[~@(nth r 1)]]
(if (empty? (nth r 1))
`(~pv ~@(rest sig))
`(~pv (let ~lv ~@(rest sig))))))))]
`(~pv ~@body)
`(~pv (let ~lv ~@body)))))))]
(if (vector? (unhint (first aftn)))
(let [a (mk aftn)]
(if nm `(fn* ~nm ~@a) `(fn* ~@a)))