core: the fn-macro hint unwrap that belonged in the previous commit

(^bytes [b])-style return hints reach fn as a (with-meta [b] {:tag ...})
form; unhint sheds the wrapper through the rebuild path so the clause
representation never changes. The host-interop hint rows exercise it.
This commit is contained in:
Yogthos 2026-06-11 20:39:58 -04:00
parent 8212bc76f7
commit 9ba8e0870c

View file

@ -293,6 +293,13 @@
(defmacro fn [& raw] (defmacro fn [& raw]
(let [nm (if (symbol? (first raw)) (first raw) nil) (let [nm (if (symbol? (first raw)) (first raw) nil)
aftn (if nm (next raw) raw) aftn (if nm (next raw) raw)
;; a return-type hint (defn f ^bytes [x] ...) reaches us as a
;; (with-meta [x] {:tag ...}) FORM in params position — unwrap it
;; (the hint means nothing on jolt; ring-codec carries several).
unhint (fn* [x]
(if (if (seq? x) (= 'with-meta (first x)) false)
(nth x 1)
x))
md (fn* go [ps nps lets] md (fn* go [ps nps lets]
(if (seq ps) (if (seq ps)
(if (symbol? (first ps)) (if (symbol? (first ps))
@ -303,15 +310,21 @@
(go (next ps) (conj nps g) (conj (conj lets (first ps)) g)))) (go (next ps) (conj nps g) (conj (conj lets (first ps)) g))))
[nps lets])) [nps lets]))
mk (fn* [sig] mk (fn* [sig]
(let [r (md (seq (first sig)) [] [])] (let [ps (unhint (first sig))
(if (empty? (nth r 1)) hinted (not (= ps (first sig)))
r (md (seq ps) [] [])]
(if (if (empty? (nth r 1)) (not hinted) false)
sig sig
;; build the params/let vectors via [~@..] so they are tuple forms ;; build the params/let vectors via [~@..] so they are tuple forms
;; (the accumulators are plain seqs, the wrong representation). ;; (the accumulators are plain seqs, the wrong representation).
;; A hinted-but-undestructured arity also rebuilds, to shed the
;; with-meta wrapper without changing the clause representation.
(let [pv `[~@(nth r 0)] (let [pv `[~@(nth r 0)]
lv `[~@(nth r 1)]] lv `[~@(nth r 1)]]
`(~pv (let ~lv ~@(rest sig)))))))] (if (empty? (nth r 1))
(if (vector? (first aftn)) `(~pv ~@(rest sig))
`(~pv (let ~lv ~@(rest sig))))))))]
(if (vector? (unhint (first aftn)))
(let [a (mk aftn)] (let [a (mk aftn)]
(if nm `(fn* ~nm ~@a) `(fn* ~@a))) (if nm `(fn* ~nm ~@a) `(fn* ~@a)))
(let [as (vec (map mk aftn))] (let [as (vec (map mk aftn))]