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

special-form heads are not shadowable

Browse source 
Found in a read/eval review: a local named like a special form wrongly took
over operator position. (let [if (fn ...)] (if true 1 2)) returned the fn, but
per spec section 3 (and the reference) special-form heads are not shadowable;
only macros are. Two fixes: drop the (not shadowed) guard on the special-form
branch of analyze-list (so an (if ...) head is always the special), and prefix
a local whose name is a Scheme keyword when emitting (so a value local legally
named if does not shadow the (if ...) the back end emits). Value-position
locals named if/or/case still work.
This commit is contained in:
Yogthos 2026-06-22 01:01:53 -04:00
parent f18ae3bd46
commit 212cd0399a
5 changed files with 106 additions and 81 deletions
Download patch file Download diff file Expand all files Collapse all files

148
host/chez/seed/image.ss
View file

File diff suppressed because one or more lines are too long

10
host/chez/seed/prelude.ss
View file

@ -796,15 +796,15 @@
(mark-macro! "clojure.core" "defonce"))
(guard (e (#t #f))
(def-var! "clojure.core" "if-not"
(lambda (test then . G__17) (let fnrec441 ((test test) (then then) (G__17 (list->cseq G__17))) (let* ((G__18 G__17) (else (jolt-nth G__18 0 jolt-nil))) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "if")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "not")) (jolt-invoke (var-deref "clojure.core" "__sq1") test))) (jolt-invoke (var-deref "clojure.core" "__sq1") then) (jolt-invoke (var-deref "clojure.core" "__sq1") else))))))
(lambda (test then . G__17) (let fnrec441 ((test test) (then then) (G__17 (list->cseq G__17))) (let* ((G__18 G__17) (_else (jolt-nth G__18 0 jolt-nil))) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "if")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "not")) (jolt-invoke (var-deref "clojure.core" "__sq1") test))) (jolt-invoke (var-deref "clojure.core" "__sq1") then) (jolt-invoke (var-deref "clojure.core" "__sq1") _else))))))
(mark-macro! "clojure.core" "if-not"))
(guard (e (#t #f))
(def-var! "clojure.core" "if-let"
(lambda (bindings then . G__19) (let fnrec442 ((bindings bindings) (then then) (G__19 (list->cseq G__19))) (let* ((G__20 G__19) (else (jolt-nth G__20 0 jolt-nil))) (let* ((form (jolt-invoke bindings 0)) (tst (jolt-invoke bindings 1))) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "let")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqvec") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "temp__4__auto")) (jolt-invoke (var-deref "clojure.core" "__sq1") tst))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "if")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "temp__4__auto")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "let")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqvec") (jolt-invoke (var-deref "clojure.core" "__sq1") form) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "temp__4__auto")))) (jolt-invoke (var-deref "clojure.core" "__sq1") then))) (jolt-invoke (var-deref "clojure.core" "__sq1") else)))))))))
(lambda (bindings then . G__19) (let fnrec442 ((bindings bindings) (then then) (G__19 (list->cseq G__19))) (let* ((G__20 G__19) (_else (jolt-nth G__20 0 jolt-nil))) (let* ((form (jolt-invoke bindings 0)) (tst (jolt-invoke bindings 1))) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "let")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqvec") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "temp__4__auto")) (jolt-invoke (var-deref "clojure.core" "__sq1") tst))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "if")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "temp__4__auto")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "let")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqvec") (jolt-invoke (var-deref "clojure.core" "__sq1") form) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "temp__4__auto")))) (jolt-invoke (var-deref "clojure.core" "__sq1") then))) (jolt-invoke (var-deref "clojure.core" "__sq1") _else)))))))))
(mark-macro! "clojure.core" "if-let"))
(guard (e (#t #f))
(def-var! "clojure.core" "if-some"
(lambda (bindings then . G__21) (let fnrec443 ((bindings bindings) (then then) (G__21 (list->cseq G__21))) (let* ((G__22 G__21) (else (jolt-nth G__22 0 jolt-nil))) (let* ((form (jolt-invoke bindings 0)) (tst (jolt-invoke bindings 1))) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "let")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqvec") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "temp__5__auto")) (jolt-invoke (var-deref "clojure.core" "__sq1") tst))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "if")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "some?")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "temp__5__auto")))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "let")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqvec") (jolt-invoke (var-deref "clojure.core" "__sq1") form) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "temp__5__auto")))) (jolt-invoke (var-deref "clojure.core" "__sq1") then))) (jolt-invoke (var-deref "clojure.core" "__sq1") else)))))))))
(lambda (bindings then . G__21) (let fnrec443 ((bindings bindings) (then then) (G__21 (list->cseq G__21))) (let* ((G__22 G__21) (_else (jolt-nth G__22 0 jolt-nil))) (let* ((form (jolt-invoke bindings 0)) (tst (jolt-invoke bindings 1))) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "let")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqvec") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "temp__5__auto")) (jolt-invoke (var-deref "clojure.core" "__sq1") tst))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "if")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "some?")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "temp__5__auto")))) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "let")) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "__sqvec") (jolt-invoke (var-deref "clojure.core" "__sq1") form) (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "temp__5__auto")))) (jolt-invoke (var-deref "clojure.core" "__sq1") then))) (jolt-invoke (var-deref "clojure.core" "__sq1") _else)))))))))
(mark-macro! "clojure.core" "if-some"))
(guard (e (#t #f))
(def-var! "clojure.core" "when-some"
@ -1051,10 +1051,10 @@
(guard (e (#t #f))
(def-var! "clojure.walk" "stringify-keys" (letrec ((stringify-keys (lambda (m) (let fnrec109 ((m m)) (let* ((f (lambda (G__11) (let fnrec111 ((G__11 G__11)) (let* ((G__12 G__11) (k (jolt-nth G__12 0 jolt-nil)) (v (jolt-nth G__12 1 jolt-nil))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "keyword?") k)) (let* ((_o$114 (jolt-invoke (var-deref "clojure.core" "name") k)) (_o$115 v)) (jolt-vector _o$114 _o$115)) (let* ((_o$112 k) (_o$113 v)) (jolt-vector _o$112 _o$113)))))))) (jolt-invoke (var-deref "clojure.walk" "postwalk") (lambda (x) (let fnrec110 ((x x)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "map?") x)) (jolt-into (jolt-hash-map) (jolt-map f x)) x))) m)))))) stringify-keys)))
(guard (e (#t #f))
(def-var! "clojure.template" "apply-template" (letrec ((apply-template (lambda (argv expr values) (let fnrec44 ((argv argv) (expr expr) (values values)) (begin (if (jolt-not (jolt-invoke (var-deref "clojure.core" "vector?") argv)) (jolt-throw (jolt-ex-info "Assert failed: (vector? argv)" (jolt-hash-map))) jolt-nil) (if (jolt-not (jolt-invoke (var-deref "clojure.core" "every?") (var-deref "clojure.core" "symbol?") argv)) (jolt-throw (jolt-ex-info "Assert failed: (every? symbol? argv)" (jolt-hash-map))) jolt-nil) (jolt-invoke (var-deref "clojure.walk" "postwalk-replace") (jolt-invoke (var-deref "clojure.core" "zipmap") argv values) expr)))))) apply-template)))
(def-var! "clojure.template" "apply-template" (letrec ((apply-template (lambda (argv expr _values) (let fnrec44 ((argv argv) (expr expr) (_values _values)) (begin (if (jolt-not (jolt-invoke (var-deref "clojure.core" "vector?") argv)) (jolt-throw (jolt-ex-info "Assert failed: (vector? argv)" (jolt-hash-map))) jolt-nil) (if (jolt-not (jolt-invoke (var-deref "clojure.core" "every?") (var-deref "clojure.core" "symbol?") argv)) (jolt-throw (jolt-ex-info "Assert failed: (every? symbol? argv)" (jolt-hash-map))) jolt-nil) (jolt-invoke (var-deref "clojure.walk" "postwalk-replace") (jolt-invoke (var-deref "clojure.core" "zipmap") argv _values) expr)))))) apply-template)))
(guard (e (#t #f))
(def-var! "clojure.template" "do-template"
(lambda (argv expr . values) (let fnrec45 ((argv argv) (expr expr) (values (list->cseq values))) (let* ((c (jolt-count argv))) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "do")) (jolt-map (lambda (a) (let fnrec46 ((a a)) (jolt-invoke (var-deref "clojure.template" "apply-template") argv expr a))) (jolt-invoke (var-deref "clojure.core" "partition") c values)))))))
(lambda (argv expr . _values) (let fnrec45 ((argv argv) (expr expr) (_values (list->cseq _values))) (let* ((c (jolt-count argv))) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "do")) (jolt-map (lambda (a) (let fnrec46 ((a a)) (jolt-invoke (var-deref "clojure.template" "apply-template") argv expr a))) (jolt-invoke (var-deref "clojure.core" "partition") c _values)))))))
(mark-macro! "clojure.template" "do-template"))
(guard (e (#t #f))
(def-var! "clojure.edn" "edn->value" (letrec ((edn->value (lambda (opts x) (let fnrec47 ((opts opts) (x x)) (if (jolt= (keyword "jolt" "set") (jolt-get x (keyword "jolt" "type"))) (jolt-invoke (var-deref "clojure.core" "set") (jolt-map (lambda (v) (let fnrec53 ((v v)) (jolt-invoke edn->value opts v))) (jolt-get x (keyword #f "value")))) (if (jolt= (keyword "jolt" "tagged") (jolt-get x (keyword "jolt" "type"))) (let* ((tag (jolt-get x (keyword #f "tag"))) (v (jolt-invoke edn->value opts (jolt-get x (keyword #f "form")))) (tag-sym (let* ((n (jolt-invoke (var-deref "clojure.core" "name") tag))) (jolt-invoke (var-deref "clojure.core" "symbol") (if (jolt= "#" (jolt-invoke (var-deref "clojure.core" "subs") n 0 1)) (jolt-invoke (var-deref "clojure.core" "subs") n 1) n)))) (custom (jolt-get (jolt-get opts (keyword #f "readers")) tag-sym))) (if (jolt-truthy? custom) (jolt-invoke custom v) (if (jolt-truthy? (jolt-get opts (keyword #f "default"))) (jolt-invoke (jolt-get opts (keyword #f "default")) tag v) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "clojure.core" "__read-tagged") tag v) jolt-nil)))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "map?") x)) (jolt-into (jolt-hash-map) (jolt-map (lambda (e) (let fnrec50 ((e e)) (let* ((_o$51 (jolt-invoke edn->value opts (jolt-invoke (var-deref "clojure.core" "key") e))) (_o$52 (jolt-invoke edn->value opts (jolt-invoke (var-deref "clojure.core" "val") e)))) (jolt-vector _o$51 _o$52)))) x)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "vector?") x)) (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (v) (let fnrec49 ((v v)) (jolt-invoke edn->value opts v))) x) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "seq?") x)) (jolt-map (lambda (v) (let fnrec48 ((v v)) (jolt-invoke edn->value opts v))) x) (if (jolt-truthy? (keyword #f "else")) x jolt-nil)))))))))) edn->value)))

5
jolt-core/jolt/analyzer.clj
View file

@ -465,7 +465,10 @@
;; read -> macroexpand -> analyze. A local shadows both.
(and (form-sym? head) (not shadowed) (form-macro? ctx head))
(analyze ctx (form-expand-1 ctx form) env)
(and hname (not shadowed) (contains? handled hname))
;; special-form heads are NOT shadowable (unlike macros): a local named
;; `if` does not change the meaning of (if …) in operator position, per
;; spec §3 and the reference. No (not shadowed) guard here.
(and hname (contains? handled hname))
(analyze-special ctx hname items env)
(and hname (not shadowed) (method-head? hname))
(analyze-host-call ctx hname items env)

17
jolt-core/jolt/backend_scheme.clj
View file

@ -105,10 +105,23 @@
(def ^:private gensym-counter (atom 0))
(defn- fresh-label [prefix] (str prefix (swap! gensym-counter inc)))
;; Scheme syntactic keywords. A jolt local with one of these names would, when
;; emitted verbatim, shadow the Scheme form in operator position (a local named
;; `if` would turn the special form (if …) the back end emits into a call), so
;; such locals are prefixed. Matches the spec: special-form heads are not
;; shadowable, but a value local may legally be named `if`.
(def ^:private scheme-reserved
#{"if" "begin" "lambda" "let" "let*" "letrec" "letrec*" "quote" "quasiquote"
"unquote" "set!" "define" "define-syntax" "cond" "case" "when" "unless"
"and" "or" "do" "else" "guard" "parameterize" "delay" "values"})
;; 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 #(...)) — `#`
;; starts a datum in Scheme, so replace it with `_`.
(defn- munge-name [s] (str/replace s "#" "_"))
;; 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.
(defn- munge-name [s]
(let [s (str/replace s "#" "_")]
(if (contains? scheme-reserved s) (str "_" s) s)))
(declare emit)

7
test/chez/unit.edn
View file

@ -449,4 +449,11 @@
{:suite "walk" :expr "(do (require (quote [clojure.walk :as w])) (w/postwalk-replace {:a 1 :b 2} '(:a [:b :a])))" :expected "(1 [2 1])"}
{:suite "walk" :expr "(do (require (quote [clojure.walk :as w])) (w/postwalk-replace {1 :one} [1 2 1]))" :expected "[:one 2 :one]"}
{:suite "walk" :expr "(do (require (quote [clojure.template :as t])) (t/apply-template '[x y] '(+ x y) '(1 2)))" :expected "(+ 1 2)"}
{:suite "shadowing" :expr "(let [if (fn [a b c] :L)] (if true 1 2))" :expected "1"}
{:suite "shadowing" :expr "(let [quote (fn [_] :L)] (quote x))" :expected "x"}
{:suite "shadowing" :expr "(let [if 5] if)" :expected "5"}
{:suite "shadowing" :expr "((fn [if] (+ if 1)) 7)" :expected "8"}
{:suite "shadowing" :expr "(let [when (fn [a b] :local)] (when 1 2))" :expected ":local"}
{:suite "macroexpand" :expr "(do (when true (defmacro m6 [x] `(* ~x 2))) (m6 3))" :expected "6"}
{:suite "macroexpand" :expr "(letfn [(ev? [n] (if (zero? n) true (od? (dec n)))) (od? [n] (if (zero? n) false (ev? (dec n))))] (ev? 10))" :expected "true"}
]