*unchecked-math* on macro-emitted arithmetic + local shadowing a bare native op

Two general fixes shaken out by clojure.test.check's own suite (its splittable
PRNG mixes 64-bit longs and binds locals named min/max).

- *unchecked-math* now wraps arithmetic a macro emits. The analyzer rewrote a
  bare (+/-/*) to its wrapping unchecked-* under *unchecked-math*, but a macro's
  syntax-quote produces clojure.core/* (qualified), which was skipped — so e.g.
  test.check's mix-64 multiply grew to a bignum instead of a 64-bit long. The
  rewrite now also fires on the clojure.core-qualified form.
- A local binding named like a bare-emitted native op no longer shadows it. ops
  where native-ops maps the name to itself (+ - * / < > min max …) emit as the
  bare Scheme name; a local `max` emitted the same token, so
  (fn [max] (clojure.core/max …)) called the param. munge-name now prefixes such
  locals, like reserved words (derived from native-ops so they can't drift).

make test green (+1 corpus row, 0 new divergences), shakesmoke byte-identical.
One re-mint (analyzer + backend).
This commit is contained in:
Yogthos 2026-06-27 18:19:14 -04:00
parent 75652de1ad
commit 992fc0af34
5 changed files with 131 additions and 114 deletions

File diff suppressed because one or more lines are too long

View file

@ -485,9 +485,9 @@
(guard (e (#t #f)) (guard (e (#t #f))
(def-var! "clojure.core" "trampoline" (letrec ((trampoline (case-lambda ((f) (let fnrec4577 ((f f)) (let* ((ret (jolt-invoke f))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "fn?") ret)) (trampoline ret) ret)))) ((f . args) (let fnrec4578 ((f f) (args (list->cseq args))) (trampoline (lambda () (let fnrec4579 () (jolt-apply f args))))))))) trampoline))) (def-var! "clojure.core" "trampoline" (letrec ((trampoline (case-lambda ((f) (let fnrec4577 ((f f)) (let* ((ret (jolt-invoke f))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "fn?") ret)) (trampoline ret) ret)))) ((f . args) (let fnrec4578 ((f f) (args (list->cseq args))) (trampoline (lambda () (let fnrec4579 () (jolt-apply f args))))))))) trampoline)))
(guard (e (#t #f)) (guard (e (#t #f))
(def-var! "clojure.core" "max" (letrec ((max (case-lambda ((x) (let fnrec4580 ((x x)) x)) ((x y) (let fnrec4581 ((x x) (y y)) (if (> x y) x y))) ((x y . more) (let fnrec4582 ((x x) (y y) (more (list->cseq more))) (jolt-reduce max (max x y) more)))))) max))) (def-var! "clojure.core" "max" (letrec ((_max (case-lambda ((x) (let fnrec4580 ((x x)) x)) ((x y) (let fnrec4581 ((x x) (y y)) (if (> x y) x y))) ((x y . more) (let fnrec4582 ((x x) (y y) (more (list->cseq more))) (jolt-reduce _max (_max x y) more)))))) _max)))
(guard (e (#t #f)) (guard (e (#t #f))
(def-var! "clojure.core" "min" (letrec ((min (case-lambda ((x) (let fnrec4583 ((x x)) x)) ((x y) (let fnrec4584 ((x x) (y y)) (if (< x y) x y))) ((x y . more) (let fnrec4585 ((x x) (y y) (more (list->cseq more))) (jolt-reduce min (min x y) more)))))) min))) (def-var! "clojure.core" "min" (letrec ((_min (case-lambda ((x) (let fnrec4583 ((x x)) x)) ((x y) (let fnrec4584 ((x x) (y y)) (if (< x y) x y))) ((x y . more) (let fnrec4585 ((x x) (y y) (more (list->cseq more))) (jolt-reduce _min (_min x y) more)))))) _min)))
(guard (e (#t #f)) (guard (e (#t #f))
(def-var! "clojure.core" "reverse" (letrec ((reverse (lambda (coll) (let fnrec4586 ((coll coll)) (jolt-reduce jolt-conj (jolt-list ) coll))))) reverse))) (def-var! "clojure.core" "reverse" (letrec ((reverse (lambda (coll) (let fnrec4586 ((coll coll)) (jolt-reduce jolt-conj (jolt-list ) coll))))) reverse)))
(guard (e (#t #f)) (guard (e (#t #f))

View file

@ -636,9 +636,14 @@
(form-sym-name head))) (form-sym-name head)))
shadowed (and hname (local? env hname)) shadowed (and hname (local? env hname))
;; under *unchecked-math*, a core +/-/*/inc/dec becomes its wrapping ;; under *unchecked-math*, a core +/-/*/inc/dec becomes its wrapping
;; unchecked-* (computed once; nil when off or not such an op). ;; unchecked-* (computed once; nil when off or not such an op). The op
unm (when (and hname (not shadowed) (unchecked-math?)) ;; may arrive bare (+) or clojure.core-qualified (clojure.core/*), the
(unchecked-arith hname (count items)))] ;; latter from a macro's syntax-quote — both must wrap.
unm (when (unchecked-math?)
(let [opn (cond (and hname (not shadowed)) hname
(and (form-sym? head) (= "clojure.core" (form-sym-ns head)))
(form-sym-name head))]
(when opn (unchecked-arith opn (count items)))))]
(cond (cond
;; *unchecked-math* rewrite, before macro/special dispatch (these are ;; *unchecked-math* rewrite, before macro/special dispatch (these are
;; ordinary core fns). The unchecked-* form re-analyzes normally. ;; ordinary core fns). The unchecked-* form re-analyzes normally.

View file

@ -188,10 +188,19 @@
"unquote" "set!" "define" "define-syntax" "cond" "case" "when" "unless" "unquote" "set!" "define" "define-syntax" "cond" "case" "when" "unless"
"and" "or" "do" "else" "guard" "parameterize" "delay" "values"}) "and" "or" "do" "else" "guard" "parameterize" "delay" "values"})
;; clojure.core ops emitted as a BARE Scheme name (where native-ops maps the op
;; to itself: + - * / < > min max …). A local binding with one of these names
;; would otherwise shadow the emitted prim — e.g. (fn [max] (clojure.core/max …))
;; emits (max …) calling the param — so such locals are prefixed, like reserved
;; words. Derived from native-ops so the two never drift.
(def ^:private bare-native-names
(set (keep (fn [[k v]] (when (= k v) k)) native-ops)))
;; Most jolt names are already valid Scheme identifiers. The one that isn't is ;; Most jolt names are already valid Scheme identifiers. The one that isn't is
;; `#`, which jolt auto-gensyms use as a suffix (p1__0000X4# from #(...)) — `#` ;; `#`, which jolt auto-gensyms use as a suffix (p1__0000X4# from #(...)) — `#`
;; starts a datum in Scheme, so replace it with `_`. A name that collides with a ;; starts a datum in Scheme, so replace it with `_`. A name that collides with a
;; Scheme keyword is prefixed with `_` so it can never shadow the emitted form. ;; Scheme keyword OR a bare-emitted native op is prefixed with `_` so it can never
;; shadow the emitted form.
(defn- munge-name [s] (defn- munge-name [s]
;; A Clojure symbol may contain chars that break a Scheme identifier: ' is the ;; A Clojure symbol may contain chars that break a Scheme identifier: ' is the
;; quote reader macro (a bare f' would read as f then 'rest), # already maps to ;; quote reader macro (a bare f' would read as f then 'rest), # already maps to
@ -200,7 +209,7 @@
(let [s (-> s (let [s (-> s
(str/replace "#" "_") (str/replace "#" "_")
(str/replace "'" "_PRIME_"))] (str/replace "'" "_PRIME_"))]
(if (contains? scheme-reserved s) (str "_" s) s))) (if (or (contains? scheme-reserved s) (contains? bare-native-names s)) (str "_" s) s)))
(declare emit) (declare emit)

View file

@ -3381,4 +3381,5 @@
{:suite "host-interop / Compiler" :label "Compiler/specials keys include the special forms" :expected "true" :actual "(every? (set (keys clojure.lang.Compiler/specials)) (quote [if do let* fn* quote def loop* recur try letfn* var]))"} {:suite "host-interop / Compiler" :label "Compiler/specials keys include the special forms" :expected "true" :actual "(every? (set (keys clojure.lang.Compiler/specials)) (quote [if do let* fn* quote def loop* recur try letfn* var]))"}
{:suite "macros / letfn mutual recursion" :label "letfn binds mutually-recursive named fns" :expected "[true false]" :actual "(letfn [(ev? [n] (if (zero? n) true (od? (dec n)))) (od? [n] (if (zero? n) false (ev? (dec n))))] [(ev? 10) (ev? 7)])"} {:suite "macros / letfn mutual recursion" :label "letfn binds mutually-recursive named fns" :expected "[true false]" :actual "(letfn [(ev? [n] (if (zero? n) true (od? (dec n)))) (od? [n] (if (zero? n) false (ev? (dec n))))] [(ev? 10) (ev? 7)])"}
{:suite "host-interop / extend-protocol IPersistentList" :label "a protocol extended to IPersistentList dispatches on a list, not a vector" :expected "[:list :vec :list]" :actual "(do (defprotocol PL (m [x])) (extend-protocol PL clojure.lang.IPersistentList (m [_] :list) clojure.lang.IPersistentVector (m [_] :vec)) [(m (list 1 2)) (m [1 2]) (m ())])"} {:suite "host-interop / extend-protocol IPersistentList" :label "a protocol extended to IPersistentList dispatches on a list, not a vector" :expected "[:list :vec :list]" :actual "(do (defprotocol PL (m [x])) (extend-protocol PL clojure.lang.IPersistentList (m [_] :list) clojure.lang.IPersistentVector (m [_] :vec)) [(m (list 1 2)) (m [1 2]) (m ())])"}
{:suite "scope / qualified ref vs same-named local" :label "clojure.core/max wins over a local named max" :expected "[10 5]" :actual "[((fn [max] (clojure.core/max 5 10)) 100) ((fn [min] (clojure.core/min 5 10)) 0)]"}
] ]