feat(ir): def+name* IR-compile seam — top-level (def x (fn …)) via the IR path

pkg/compiler/compiler.go

@@ -1959,6 +1959,13 @@ func defCompiler(c *Context, form vm.Value) error {
 		c.defName = ""
 		return nil
 	}
+	rewritten, irErr := c.maybeIRCompileDefFnArg(sym.(vm.Symbol), val)
+	if irErr != nil {
+		return compileErrorAt("ir-compile-strict def value", form).Wrap(irErr)
+	}
+	if rewritten != nil {
+		val = rewritten
+	}
 	err := c.compileForm(val)
 	if err != nil {
 		return compileErrorAt("compiling def value", form).Wrap(err)
@@ -1970,6 +1977,132 @@ func defCompiler(c *Context, form vm.Value) error {
 	return nil
 }
 
+// maybeIRCompileDefFnArg is the runtime seam for name*-wrapped fn defs:
+// when *ir-compile* is on and a TOP-LEVEL
+// `(def NAME (name* ... (fn [args] ...) ...))` is being compiled, route the
+// anonymous inner fn form through the Lisp IR pipeline
+// (ir.passes.pipeline/compile-def-fn-value) and substitute the compiled Fn
+// value as an embedded constant — the same def-value shape the defn macro
+// produces via chunk->fn. The defn macro can't cover these: `def` is a
+// special form, so grammar-style rule defs never reach the macro layer and
+// their bodies otherwise always compile via the plain bytecode compiler.
+// Returns the rewritten value form, or nil to compile the original. A
+// matched-but-unlowerable form falls back silently to bytecode unless
+// *ir-compile-strict* (#580) is on, in which case it returns an error so the
+// bytecode-path census can see the miss — mirroring the defn macro's hybrid
+// path (core.lg).
+func (c *Context) maybeIRCompileDefFnArg(name vm.Symbol, val vm.Value) (vm.Value, error) {
+	// Top-level defs only: an inner fn compiled through the pipeline cannot
+	// capture enclosing locals.
+	if len(c.locals) != 0 {
+		return nil, nil
+	}
+	icv, ok := c.CurrentNS().Lookup(vm.Symbol("clojure.core/*ir-compile*")).(*vm.Var)
+	if !ok || !vm.IsTruthy(icv.Deref()) {
+		return nil, nil
+	}
+	// Under *ir-compile-strict* (#580) a matched-but-unlowerable form must NOT
+	// fall back to bytecode silently — that is exactly the class of hole the
+	// bytecode-path census exists to surface. The "not a name*-fn-def" checks
+	// below stay silent (the seam simply doesn't apply); only a shape that
+	// SHOULD lower but can't becomes an error when strict is on.
+	strict := false
+	if scv, ok := c.CurrentNS().Lookup(vm.Symbol("clojure.core/*ir-compile-strict*")).(*vm.Var); ok {
+		strict = vm.IsTruthy(scv.Deref())
+	}
+	lst, ok := val.(*vm.List)
+	if !ok {
+		return nil, nil
+	}
+	headSym, ok := lst.First().(vm.Symbol)
+	if !ok {
+		return nil, nil
+	}
+	_, headName, hasNS := headSym.NamespacedRaw()
+	if !hasNS {
+		headName = headSym
+	}
+	if headName != vm.Symbol("name*") {
+		return nil, nil
+	}
+	elems, ok := lst.Unbox().([]vm.Value)
+	if !ok {
+		return nil, nil
+	}
+	fnIdx := -1
+	for i := 1; i < len(elems); i++ {
+		el, isList := elems[i].(*vm.List)
+		if !isList {
+			continue
+		}
+		h, isSym := el.First().(vm.Symbol)
+		if !isSym || (h != "fn" && h != "fn*") {
+			continue
+		}
+		if fnIdx != -1 {
+			return nil, nil // more than one fn argument: ambiguous, leave alone
+		}
+		fnIdx = i
+	}
+	if fnIdx == -1 {
+		return nil, nil
+	}
+	// Named fn forms have a lexical self-binding: `(fn self [...] (self ...))`.
+	// The defn-shaped IR helper cannot preserve that binding (renaming it to the
+	// outer def would turn lexical recursion into mutable Var lookup), so named
+	// forms are deliberately outside this seam and stay on the ordinary compiler
+	// even under strict mode.
+	fnForm := elems[fnIdx].(*vm.List)
+	if fnTail := fnForm.Next(); fnTail != nil {
+		if _, named := fnTail.First().(vm.Symbol); named {
+			return nil, nil
+		}
+	}
+	// From here the form IS a name*-wrapped single-fn def that should lower;
+	// a failure is a real IR-compile miss, so honor strict.
+	hv, ok := c.CurrentNS().Lookup(vm.Symbol("ir.passes.pipeline/compile-def-fn-value")).(*vm.Var)
+	if !ok {
+		if strict {
+			return nil, fmt.Errorf("ir-compile-strict: ir.passes.pipeline/compile-def-fn-value unavailable for (def %v (name* …))", name)
+		}
+		return nil, nil
+	}
+	hfn, ok := hv.Deref().(vm.Fn)
+	if !ok {
+		if strict {
+			return nil, fmt.Errorf("ir-compile-strict: compile-def-fn-value is not callable")
+		}
+		return nil, nil
+	}
+	compiled, err := hfn.Invoke([]vm.Value{elems[fnIdx], c.CurrentNS(), name})
+	if err != nil {
+		if strict {
+			return nil, fmt.Errorf("ir-compile-strict: IR compile of (def %v (name* (fn …))) failed: %w", name, err)
+		}
+		return nil, nil
+	}
+	if compiled == vm.NIL {
+		if strict {
+			return nil, fmt.Errorf("ir-compile-strict: IR compile of (def %v (name* (fn …))) produced nil", name)
+		}
+		return nil, nil
+	}
+	newElems := make([]vm.Value, len(elems))
+	copy(newElems, elems)
+	newElems[fnIdx] = compiled
+	rewritten, berr := vm.ListType.Box(newElems)
+	if berr != nil {
+		if strict {
+			return nil, fmt.Errorf("ir-compile-strict: reboxing (def %v …) failed: %w", name, berr)
+		}
+		return nil, nil
+	}
+	if info := vm.FormSource.Get(val); info != nil {
+		vm.FormSource.Set(rewritten, *info)
+	}
+	return rewritten, nil
+}
+
 func setBangCompiler(c *Context, form vm.Value) error {
 	tc := c.tailPosition
 	c.tailPosition = false

pkg/rt/core/ir/passes/pipeline.lg

@@ -761,6 +761,28 @@
       (assoc result :status :lowered)
       result)))
 
+(defn compile-def-fn-value [fn-form the-ns def-name]
+  "Runtime seam for name*-wrapped rule defs (the Go defCompiler hook).
+   Compiles a bare `(fn ...)`/`(fn* ...)` form that appears as an argument
+   inside a top-level `(def NAME (name* ... (fn ...) ...))` through the IR
+   pipeline, returning the compiled Fn VALUE — the hook substitutes it as a
+   constant in place of the fn form, exactly like the defn macro's
+   chunk->fn embedding. Single-arity only; throws on any other shape or on
+   any pipeline failure, and the hook then falls back to the plain
+   bytecode compile of the original form."
+  (let [tail     (rest fn-form)
+        tail     (if (symbol? (first tail)) (rest tail) tail)
+        args-vec (first tail)]
+    (if (or (vector? args-vec)
+            (ir.build/return-hinted-arity-vector? args-vec))
+      (let [unwrapped (ir.build/unwrap-arity-vector args-vec)
+            variadic? (boolean (some (fn [a] (= a '&)) unwrapped))
+            arity     (if variadic? (- (count unwrapped) 1) (count unwrapped))
+            defn-form (apply list 'defn (symbol def-name) args-vec (rest tail))
+            chunk     (compile-form defn-form the-ns)]
+        (chunk->fn arity variadic? chunk))
+      (throw "compile-def-fn-value: multi-arity fn form unsupported"))))
+
   ;; --- Go bootstrap generation -------------------------------------------
 
 (defn- go-name-for [name-sym]

pkg/rt/generated.sums

@@ -2,4 +2,4 @@
 # Content digest of all .lg + lgbgen sources that feed the .lgb
 # bundle and the lowered Go tree. The genmanifest staleness test
 # fails if this no longer matches the sources on disk.
-6c8c5725aa2dd6a533d3108a40dc9a266c1e2fc50c57bdd03606f4662345e028
+e540bb6d152533dbbbbad4b0320d2791c1ba98656e5ca60cc3ec89a67b62a4be

test/ir_def_namestar_seam_test.lg

@@ -0,0 +1,83 @@
+;; The def+name* IR-compile seam (#647) — maybeIRCompileDefFnArg in the Go
+;; compiler. `defn` is a macro and already routes its body through the IR path,
+;; but `def` is a special form, so grammar-style rule defs shaped
+;; `(def NAME (name* ... (fn ...) ...))` never reach the defn macro's IR hook.
+;; This seam is the def-side equivalent: when *ir-compile* is on and a TOP-LEVEL
+;; def value is a name*-wrapped single fn, it routes that fn through
+;; ir.passes.pipeline/compile-def-fn-value and substitutes the compiled Fn as
+;; the def value's fn slot — parity-preserving with the plain bytecode compile.
+;;
+;; Because the seam is parity-preserving, a black-box "the fn still works"
+;; assertion cannot prove the seam fired rather than the ordinary compiler. The
+;; non-vacuous proof is the strict census point (#580): a name*-wrapped fn that
+;; compile-def-fn-value CANNOT lower — a multi-arity fn — must, under
+;; *ir-compile-strict*, throw from the seam, naming both ir-compile-strict and
+;; the underlying "multi-arity" refusal. Without the seam that same def compiles
+;; silently (name* is an ordinary call), so the throw can only come from the
+;; seam having run compile-def-fn-value.
+(ns test.ir-def-namestar-seam-test
+  (:require
+   [ir.passes.pipeline]
+   [test :refer :all]))
+
+;; Runtime stub for the grammar `name*` head. In a real corpus name* is a
+;; grammar macro; here it only needs to hand back the fn argument so the def
+;; value resolves at eval time. A fixed (tag fn meta) shape keeps the fn at a
+;; known position; the seam locates it structurally regardless of position.
+;; Compiled at file-load time with *ir-compile* off, so it takes the plain path.
+(defn name* [tag f meta] f)
+
+(deftest seam-happy-path-produces-a-working-fn
+  (testing "a name*-wrapped single-arity fn def IR-compiles and still works"
+    (binding [*ir-compile* true]
+      (eval '(def seam-inc-rule (name* :tag (fn [x] (inc x)) :meta))))
+    (is (= 6 (eval '(seam-inc-rule 5))))))
+
+(deftest seam-preserves-named-fn-self-binding
+  (testing "named fn recursion stays on the ordinary compiler under strict mode"
+    ;; A named fn's self symbol is lexical, not an alias for the outer Var. The
+    ;; IR seam deliberately excludes this shape until it can preserve that
+    ;; distinction; strict mode must not turn the exclusion into a regression.
+    (binding [*ir-compile* true *ir-compile-strict* true]
+      (eval '(def seam-factorial-rule
+               (name* :t
+                      (fn self [n]
+                        (if (= n 0) 1 (* n (self (- n 1)))))
+                      :m))))
+    (is (= 120 (eval '(seam-factorial-rule 5))))))
+
+(deftest seam-accepts-a-return-hinted-arity-vector
+  (testing "strict IR compilation recognizes ^long [args] as one arity"
+    (binding [*ir-compile* true *ir-compile-strict* true]
+      (eval '(def seam-hinted-rule
+               (name* :t (fn ^long [^long n] (+ n 1)) :m))))
+    (is (= 6 (eval '(seam-hinted-rule 5))))))
+
+(deftest seam-strict-throws-on-unlowerable-shape
+  ;; THE non-vacuous signal: a multi-arity fn is refused by
+  ;; compile-def-fn-value, so under strict the seam must surface the miss. A
+  ;; silent compile here would mean the seam never ran.
+  (testing "strict: a name*-wrapped MULTI-ARITY fn throws from the seam"
+    (is (= :threw
+           (binding [*ir-compile* true *ir-compile-strict* true]
+             (try (eval '(def seam-bad-rule
+                           (name* :t (fn ([x] x) ([x y] x)) :m)))
+                  :no-throw
+                  (catch _ :threw))))))
+  (testing "the throw names ir-compile-strict and the multi-arity refusal"
+    (let [msg (binding [*ir-compile* true *ir-compile-strict* true]
+                (try (eval '(def seam-bad-rule2
+                              (name* :t (fn ([x] x) ([x y] x)) :m)))
+                     ""
+                     (catch e (str e))))]
+      (is (>= (index-of msg "ir-compile-strict") 0))
+      (is (>= (index-of msg "multi-arity") 0)))))
+
+(deftest seam-falls-back-silently-without-strict
+  ;; Same unlowerable shape, strict OFF: the hybrid fallback keeps it compiling
+  ;; (name* returns the fn, the bytecode path runs it). Pins that strict is the
+  ;; only thing that makes the miss loud — the shipping default stays hybrid.
+  (testing "default: the multi-arity name* def compiles and the fn works"
+    (binding [*ir-compile* true]
+      (eval '(def seam-fallback-rule (name* :t (fn ([x] x) ([x y] x)) :m))))
+    (is (= 7 (eval '(seam-fallback-rule 7))))))