git » blacktide.git » commit 5a7b4fe

Keep recursive processors hygienic under parameter shadowing

author Alan Dipert
2026-11-06 21:32:57 UTC
committer Alan Dipert
2026-11-06 21:32:57 UTC
parent 45a514210cf79eeddbd3894c6ed42dff9683a8b8

Keep recursive processors hygienic under parameter shadowing

src/com/tailrecursion/nanopass.clj +21 -7
test/com/tailrecursion/nanopass/passes.clj +5 -3

diff --git a/src/com/tailrecursion/nanopass.clj b/src/com/tailrecursion/nanopass.clj
index 1c609db..051be79 100644
--- a/src/com/tailrecursion/nanopass.clj
+++ b/src/com/tailrecursion/nanopass.clj
@@ -62,11 +62,12 @@
         result-type (if target (language/type-name target (second to))
                         (language/qualify *ns* #{} to))]
     (with-meta (pass/definition
-     {:name (if (locals name) name (symbol (str (ns-name *ns*)) (str name)))
+     {:name (symbol (str (ns-name *ns*)) (str name))
       :source source :target target :from (second from) :to (when target (second to))
       :params (mapv #(language/qualify *ns* #{} %) args) :arguments arguments
       :result-type result-type
-      :processors (into {} (map (fn [[nt processor]] [nt (if (locals processor) processor (language/qualify *ns* #{} processor))])) processors)
+      :processors (into (if-let [self (locals name)] {(second from) self} {})
+                        (map (fn [[nt processor]] [nt (or (locals processor) (language/qualify *ns* #{} processor))])) processors)
       :body? body}
      clauses) (meta form))))
 
@@ -89,17 +90,30 @@
       (language/fail :invalid-pass &form "Expected distinct processor names"))
     ;; Typed Clojure 1.3 collects letfn bindings in a map before matching its
     ;; positional annotations. Emit that same order, including groups over eight.
-    (let [functions (vals (into {} (map (fn [[name options arguments & clauses :as form]]
-                                         [name (pass-definition locals form name options arguments clauses)])) definitions))
+    (let [functions
+          (vals
+           (into {}
+             (for [[name options arguments & clauses :as form] definitions
+                   :let [captures (into {} (for [arg arguments :when (locals arg)] [arg (gensym "processor__")]))
+                         processors (merge (zipmap names names) captures)
+                         [_ id attributes args body] (pass-definition processors form name options arguments clauses)
+                         parameters (mapv #(if (captures %) (with-meta (gensym "argument__") (meta %)) %) args)
+                         ;; Save shadowed processors before restoring source parameter names.
+                         body (if (seq captures)
+                                `(let [~@(mapcat (fn [[name saved]] [saved name]) captures)
+                                       ~@(mapcat (fn [arg parameter]
+                                                   (when (not= arg parameter) [(with-meta arg nil) parameter])) args parameters)]
+                                   ~body) body)]]
+               [name (with-meta (list 'defn id (assoc attributes :arglists (list 'quote (list args))) parameters body)
+                                (meta form))])))
           signatures (mapv #(second (::signature (nth % 2))) functions)]
       `(letfn [~@(map (fn [[_ name _ args body :as form]]
                        (with-meta (list name args body) (meta form))) functions)]
          ;; Typed Clojure's letfn annotation is an inert quoted vector, in
          ;; binding order. It imposes no checker dependency at runtime.
          '~signatures
-         ~@(map (fn [[_ name attributes args :as form]]
-                   `(def ~(with-meta name (assoc (merge (meta form) attributes)
-                                                :arglists (list 'quote (list args)))) ~name)) functions)))))
+         ~@(map (fn [[_ name attributes :as form]]
+                   `(def ~(with-meta name (merge (meta form) attributes)) ~name)) functions)))))
 
 (defmacro ann-passes
   "Emit checker signatures stored by defpass. The generated function bodies
diff --git a/test/com/tailrecursion/nanopass/passes.clj b/test/com/tailrecursion/nanopass/passes.clj
index 9272bcb..92c4dcb 100644
--- a/test/com/tailrecursion/nanopass/passes.clj
+++ b/test/com/tailrecursion/nanopass/passes.clj
@@ -5,14 +5,16 @@
             [typed.clojure :as-alias t]))
 
 (np/defpasses
+  ;; Parameters deliberately shadow processor names. Generated traversal must
+  ;; still call the processors, while explicit clauses see the parameters.
   (lower
     {:from [f/Source Expr] :to [f/Core Expr] :processors {Binding lower-binding}}
-    [node]
-    :assign {:op :write :name (:name (:binding node)) :value (lower (:value node))})
+    [lower-binding]
+    :assign {:op :write :name (:name (:binding lower-binding)) :value (lower (:value lower-binding))})
 
   (lower-binding {:from [f/Source Binding] :to [f/Core Binding]
                              :processors {Expr lower}}
-    [node]))
+    [lower]))
 
 (np/defpasses
   (rename