git » blacktide.git » commit d7b99f1

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..5ba17be
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,6 @@
+.cpcache/
+.clj-kondo/
+.lsp/
+target/
+*.class
+__pycache__/
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..16be1d1
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2026 Alan Dipert
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..6997247
--- /dev/null
+++ b/README.md
@@ -0,0 +1,70 @@
+<p align="center">
+  <img src="doc/blacktide-logo.png" alt="Blacktide: moonlight over ocean waves" width="240">
+</p>
+
+# Blacktide
+
+A Clojure-to-Clojure compiler library. Its `loophole` macro provides mutable
+lexical locals and explicit jumps for algorithmic code. It compiles to ordinary
+Clojure, without mutable cells or a runtime interpreter for local state.
+
+```clojure
+(require '[com.tailrecursion.blacktide :refer [loophole setq psetq label goto]])
+
+(loophole [i 0 total 0]
+  (label again)
+  (when (< i 5)
+    (setq total (+ total i) i (inc i))
+    (goto again))
+  total) ; => 10
+
+(loophole [x 1 y 2]
+  (psetq x y y x)
+  [(setq x (+ x 10)) y]) ; => [12 1]
+```
+
+`setq` assigns pairs sequentially and returns the last value. `psetq` evaluates
+all right-hand sides before assigning and returns nil. Both work in expressions.
+Labels belong to the outer statement sequence; jumps can leave nested statement
+bodies. `(goto end)` exits with nil.
+
+The region supports `let`, destructuring, `if`, `case`, `loop`/`recur`, calls,
+collections and Java interop. Ordinary macros such as `when`, `cond`, `dotimes`
+and `doseq` work through expansion. Define functions and protect resources
+outside the region. Functions, `letfn`, `try`, native `set!` and nested `loophole`
+forms are rejected inside it, including through macroexpansion.
+
+Read the [language reference](doc/language.md) for the exact boundary and
+[algorithm examples](examples/blacktide/algorithms.clj) for partitioning and parsing.
+This is a control-flow tool; it makes no general speedup guarantee.
+
+## Use
+
+Requires Clojure 1.12.6 and JDK 17 or later. From a neighboring checkout:
+
+```clojure
+{:deps {com.tailrecursion/blacktide {:local/root "../loophole"}}}
+```
+
+Run `clojure -X:deps prep` in the client project to compile the bundled JVM
+keyword-cache helper. Library JARs include it. Ordinary use depends only on
+Clojure; Typed Clojure checks compiler passes during development.
+
+## Develop
+
+```sh
+clojure -T:build compile-java # after checkout or changes to src-java
+clojure -M:test              # semantic, generative, differential and AOT tests
+clojure -M:check             # language contracts and production pass bodies
+bin/check                   # all of the above; accepts CLI -S options
+clojure -T:build jar         # target/blacktide-0.1.0-SNAPSHOT.jar
+```
+
+Select a JDK with `JAVA_CMD=/path/to/jdk/bin/java bin/check`. Development targets
+JDK 25/27; 17/21 are compatibility targets. Generators use deterministic seeds,
+independent models and shrinking; failures report their seed and source.
+
+See the [compiler architecture](doc/compiler.md) and [nanopass guide](doc/nanopass.md)
+for implementation contracts and extension guidance.
+
+Copyright © 2026 Alan Dipert. Distributed under the [MIT License](LICENSE).
diff --git a/bin/check b/bin/check
new file mode 100755
index 0000000..f6bf105
--- /dev/null
+++ b/bin/check
@@ -0,0 +1,6 @@
+#!/usr/bin/env bash
+set -euo pipefail
+cd "$(dirname "$0")/.."
+clojure "$@" -T:build compile-java
+clojure "$@" -M:test
+clojure "$@" -M:check
diff --git a/build.clj b/build.clj
new file mode 100644
index 0000000..53402b1
--- /dev/null
+++ b/build.clj
@@ -0,0 +1,25 @@
+(ns build
+  "Build the JVM helper and a source library JAR; the compiler stays in Clojure."
+  (:require [clojure.tools.build.api :as b]
+            [clojure.java.io :as io]))
+
+(defn compile-java [_]
+  (b/delete {:path "target/classes"})
+  (b/javac {:src-dirs ["src-java"] :class-dir "target/classes"
+            :basis (b/create-basis {:project "deps.edn"})
+            :javac-opts ["--release" "17" "-Xlint:all" "-Werror"]}))
+
+(defn jar [{:keys [version] :or {version "0.1.0-SNAPSHOT"}}]
+  (compile-java nil)
+  (let [lib 'com.tailrecursion/blacktide class-dir "target/jar-classes"
+        basis (b/create-basis {:project "deps.edn"})]
+    (b/delete {:path class-dir})
+    (b/copy-dir {:src-dirs ["src" "resources" "target/classes"] :target-dir class-dir})
+    ;; Editor state may be nested beneath namespace directories.
+    (doseq [file (file-seq (io/file class-dir))
+            :when (.startsWith (.getName file) ".")]
+      (b/delete {:path (.getPath file)}))
+    (b/copy-file {:src "LICENSE" :target (str class-dir "/META-INF/LICENSE")})
+    (b/write-pom {:lib lib :version version :basis basis :class-dir class-dir
+                  :src-dirs ["src"]})
+    (b/jar {:class-dir class-dir :jar-file (str "target/blacktide-" version ".jar")})))
diff --git a/deps.edn b/deps.edn
new file mode 100644
index 0000000..c18a050
--- /dev/null
+++ b/deps.edn
@@ -0,0 +1,14 @@
+{:paths ["src" "resources" "target/classes"]
+ :deps {org.clojure/clojure {:mvn/version "1.12.6"}}
+ :deps/prep-lib {:alias :build :fn compile-java
+                 :ensure "target/classes/com/tailrecursion/blacktide/runtime/KeywordSite.class"}
+ :aliases
+ {:build {:deps {io.github.clojure/tools.build {:mvn/version "0.10.14"}}
+          :ns-default build}
+  :test {:extra-paths ["test" "examples"]
+         :jvm-opts ["-Xmx768m"]
+         :main-opts ["-m" "com.tailrecursion.test-runner"]}
+  :check {:extra-paths ["test" "test-resources"]
+          :extra-deps {org.typedclojure/typed.clj.checker {:mvn/version "1.3.0"}}
+          :jvm-opts ["-Xmx768m"]
+          :main-opts ["-m" "com.tailrecursion.check-runner"]}}}
diff --git a/doc/blacktide-logo.png b/doc/blacktide-logo.png
new file mode 100644
index 0000000..83dc7a3
Binary files /dev/null and b/doc/blacktide-logo.png differ
diff --git a/doc/compiler.md b/doc/compiler.md
new file mode 100644
index 0000000..f2102e5
--- /dev/null
+++ b/doc/compiler.md
@@ -0,0 +1,42 @@
+# Compiler architecture
+
+Blacktide transforms immutable Clojure data through languages defined with
+`com.tailrecursion.nanopass`. Typed Clojure checks production pass bodies; the
+checker is absent from ordinary library use. Namespace docstrings state pass
+contracts. Compiler namespaces and intermediate representations are internal.
+
+| Stage | Responsibility |
+| --- | --- |
+| Source | Expand macros in order, resolve unique lexical identities and source JVM facts, enforce the subset, solve loop representations without repeating expansion. |
+| Classification | Preserve analyzed loops without DSL effects and native keyword calls; materialize representations for loops requiring lowering. |
+| Normalization | Lower sequential/parallel assignments, case and collections; prepare conversions and save operands in evaluation order. |
+| Graph | Resolve outer labels, check destinations and definite initialization, compute liveness and allocate slots. |
+| Backend | Fold literal branches, recover structured control with shared joins, choose conservative primitive storage and compact safe intermediates. Fall back to the dispatcher when recovery is ineligible. |
+| Emission | Emit Clojure with original conversions, construction sites and an opaque Object result. |
+
+`compiler/compile-form` orchestrates:
+
+`Bound → Classified → Sequential → Assigned → Cases → Collections → Prepared → Ordered → Symbolic → CFG → Machine → Code`.
+
+The outer bindings enter as one lexical scope. `goto end` directly returns nil;
+emission seals the whole result with an Object type boundary. `Native` is the
+analyzed subtree language without DSL operations. The structured backend uses
+`Machine → Planned → Joined → Stored → Compact → Code` and shares graph
+validation with the dispatcher.
+
+Assignments, normalization and graph construction are pure. Locals become
+lexical bindings and loop parameters, never mutable cells. A generated
+`RT.box(Object)` is an identity operation that preserves an inference boundary;
+its appearance alone does not imply allocation.
+
+Java method values, functional-interface adapters and keyword sites must not be
+duplicated during control recovery. Keyword calls with effectful targets save
+the cache thunk before evaluating the target. `runtime.KeywordSite` implements
+that native cache protocol; an internal macro allocates each site during final
+Clojure analysis. The Java helper targets JDK 17 and is bundled in JARs.
+
+To extend the compiler, change the language and affected passes, then run
+`bin/check`. Prefer a compiler-local transformation over new nanopass machinery.
+Tests should establish source semantics or a necessary invariant. Generators
+use independent models or ordinary Clojure, deterministic seeds and shrinking;
+backend comparisons supplement those independent references.
diff --git a/doc/language.md b/doc/language.md
new file mode 100644
index 0000000..a107484
--- /dev/null
+++ b/doc/language.md
@@ -0,0 +1,151 @@
+# Language reference
+
+The public namespace is `com.tailrecursion.blacktide`; its macros are `loophole`,
+`setq`, `psetq`, `label` and `goto`. Qualified calls and namespace aliases work.
+Lexical bindings can shadow macro names. DSL markers have no meaning outside
+`loophole` and report an error there.
+
+## Bindings and assignment
+
+`loophole` takes an even vector of simple symbols and initializers, followed by
+a body. Initializers run once, sequentially, and may read or assign earlier
+bindings. The result is the last body value, or nil for an empty body.
+
+```clojure
+(require '[com.tailrecursion.blacktide :refer [loophole setq psetq label goto]])
+(loophole [x 1 y x]
+  (let [x 3] [x y])) ; => [3 1]
+
+(loophole [x 1 y 2]
+  (psetq x y y x)
+  [(setq x 10) y]) ; => [10 1]
+```
+
+`setq` writes each pair immediately and returns its last value (nil for no
+pairs). `psetq` evaluates every RHS before writing targets, in pair order, and
+returns nil. Repeated targets are written in order. Nested assignments take
+effect during RHS evaluation; an exception abandons pending parallel writes.
+Only bindings introduced by `loophole` are assignable. Shadowing with an ordinary
+`let` makes the inner binding immutable. Native `set!` is not admitted.
+
+## Statements and jumps
+
+Labels are simple symbols in the **outer statement sequence**, including nested
+transparent `do` forms after macroexpansion. They cannot appear inside `let`,
+`loop`, conditional arms, operands or initializers. Names are unique within the
+region; `end` is reserved.
+
+`goto` is a statement. It can occur in `if`/`case` arms and `let`/`loop` bodies
+and jump out to an outer label. It is forbidden anywhere within an operand or
+initializer, even a discarded expression nested in `do`. `(goto end)` returns
+nil immediately. A normal final result can be obtained with a final label:
+
+```clojure
+(loophole [x 0]
+  (label again)
+  (let [next (inc x)]
+    (setq x next)
+    (when (< x 3) (goto again)))
+  (goto done)
+  (setq x 99)
+  (label done) x) ; => 3
+
+(loophole [] (goto end) :unreachable) ; => nil
+```
+
+Backward jumps rerun initializers they encounter. They cannot enter a lexical
+scope or bypass its initialization. These forms are errors:
+
+```clojure
+(loophole [] (let [] (label inside)))
+(loophole [] (+ 1 (do (goto end) 2)))
+(loophole [x (goto end)] x)
+```
+
+## Clojure subset
+
+Supported forms are literals, quote/var, symbol reads, function calls, collection
+literals and their executable metadata, `do`, `if`, `throw`, `let`, `case`,
+`loop`/`recur`, Java calls, constructors, field reads and arrays. Ordinary `let`
+and `loop` support destructuring. Calls may use external function values;
+called code can use unrestricted Clojure.
+
+Macros are expanded in the caller namespace with lexical shadowing and visibility
+checks. `&env` provides binding names, hints and inferred immutable types, not
+private `Compiler$LocalBinding` objects. Common admitted macros include `when`,
+`when-not`, `cond`, `and`, `or`, `if-let`, `when-let`, threading, `dotimes`, `while`
+and `doseq`. A macro is supported only when its entire expansion is admitted.
+Quoted data is never analyzed as code.
+
+`fn`/`fn*`, `letfn`/`letfn*`, `try`/`catch`/`finally`, monitor operations, native
+`set!`, nested `loophole`, namespace/Var/type definitions and `reify` are rejected.
+This also excludes `delay`, `lazy-seq`, `future`, `binding`, `locking`, `with-open`
+and `with-redefs` **inside** the region. Put helpers and dynamic extent outside:
+
+```clojure
+(letfn [(step [n] (inc n))]
+  (loophole [x 0]
+    (dotimes [_ 3] (setq x (step x)))
+    x)) ; => 3
+
+(try
+  (loophole [] (throw (Exception. "example")))
+  (catch Exception e (.getMessage e))) ; => "example"
+
+(loophole [total 0]
+  (dotimes [i 4] (dotimes [j i] (setq total (+ total j))))
+  total) ; => 4
+```
+
+Original `recur` keeps its local loop target, tail-position requirement and arity.
+Arguments evaluate before rebinding. Source primitive inference is preserved,
+including int→long and float→double initializer promotion and incompatible
+backedges that require boxing. Even unreachable recur contributes to inference.
+A recur cannot target a loop outside the region.
+
+`case` preserves Clojure's constant matching, grouping, hash collisions and
+missing-default exception. Dispatch executes once; only the selected arm runs.
+Each source arm is analyzed once in written order. Arms may assign or recur,
+and may jump when the case itself is a statement.
+
+```clojure
+(loophole [x 0]
+  (case (do (setq x (inc x)) x)
+    1 (setq x 10)
+    2 (setq x 20)
+    (setq x 30))
+  x) ; => 10
+```
+
+## JVM semantics and limits
+
+Source facts determine overloads and conversion order. Clojure 1.12 qualified
+method values, functional-interface adaptation and `:param-tags` are supported.
+Arithmetic respects `*unchecked-math*`; calls respect `:direct-linking` and direct
+protocol dispatch. Unreachable code still receives syntax and JVM compilation
+checks. Very large regions remain subject to JVM method-size limits.
+
+Mutable locals retain reference identity, including through assignment and
+immutable snapshots. Ordinary primitive locals retain Clojure's semantics:
+separate Object uses may box separately. Literal pooling is unspecified;
+independently embedded constants, macro-supplied quoted data, regex literals and
+inlined `^:const` values may share differently from ordinary Clojure. Bind a
+reference once when its identity matters. Runtime construction sites and cached
+lookup sites are not duplicated.
+
+```clojure
+(let [token (Object.)]
+  (loophole [x token y nil]
+    (psetq y x x x)
+    (identical? token y))) ; => true
+```
+
+Literal keyword calls retain Clojure's cached `IKeywordLookup` behavior, including
+reentrant target evaluation. An assigned target uses a bundled cache helper;
+that cache never stores mutable region locals.
+
+Explicit reference conversions may use `Class.cast`, whose exception message
+differs from JVM `checkcast`. Invalid protocol fallback roots can also have
+different generated error text. Failing types and evaluation order are preserved.
+DSL errors carry `:kind`, `:form`, `:file`, available `:line`/`:column`, and relevant
+binding or label data. Clojure normally wraps them in `CompilerException`.
diff --git a/doc/nanopass.md b/doc/nanopass.md
new file mode 100644
index 0000000..bb1e150
--- /dev/null
+++ b/doc/nanopass.md
@@ -0,0 +1,64 @@
+# Nanopass library
+
+Define languages from Typed Clojure syntax without loading the
+checker. Local nonterminals are rebound recursively when deriving a language:
+
+```clojure
+(require '[com.tailrecursion.nanopass :as np]
+         '[typed.clojure :as-alias t])
+
+(np/deflanguage Source
+  {Expr (t/U (t/HMap :mandatory {:op ':literal :value t/Any} :complete? true)
+             (t/HMap :mandatory {:op ':negate :value Expr} :complete? true))})
+
+(np/derive-language Core Source
+  {:remove {Expr #{:negate}}
+   :add {Expr [(t/HMap :mandatory {:op ':subtract :left Expr :right Expr}
+                      :complete? true)]}})
+```
+
+Descriptions are immutable values. `:replace` replaces or adds a complete
+nonterminal definition. Structural types support `U`, closed keyword-field
+`HMap`, fixed `HVec`, `Vec`, `Map`, `Set`, and `Option`. Other types are opaque
+terminals and cannot hide local nonterminal references. Quoted singleton data
+and `Val`/`Value` payloads stay untouched. Tagged productions have a required
+`:op` with a singleton keyword type. `clojure.core.typed` spelling is accepted too.
+Use explicit `HMap`/`HVec` constructors rather than their quoted collection
+shorthand. Declare complex polymorphic terminal types as external aliases.
+
+An annotation-only namespace can require `typed.clojure` and call
+`(np/ann-languages Source Core)` to generate aliases `Source-Expr` and `Core-Expr`
+in the languages' defining namespace. Nothing registers types during ordinary
+language loading.
+
+Passes supply clauses for changed productions and inherit checked structural
+traversal for unchanged ones:
+
+```clojure
+(np/defpass lower {:from [Source Expr] :to [Core Expr]}
+  [node]
+  :negate {:op :subtract
+           :left {:op :literal :value 0}
+           :right (lower (:value node))})
+```
+
+Register `(np/ann-passes lower)` in the checking-only namespace, then check the
+implementation namespace with `typed.clojure/check-ns-clj`. Generated signatures
+are contracts, not a replacement for checking function bodies.
+
+`:processors {Binding lower-binding}` names other nonterminal processors; use
+ordinary `declare` for mutual recursion. `:args [ContextType]` types leading
+arguments, which generated traversal forwards unchanged. Write explicit clauses
+when lexical context changes. With `:body true`, supply one ordinary expression
+and any result type in `:to`, including state/result tuples. Automatic clauses
+require matching fields and structural containers; removed productions and
+incompatible fields require explicit code. Missing cases are checked using a
+generated bottom-type guard. `macroexpand-1` exposes the complete generated code.
+Use qualified aliases such as `languages/Core-Expr` in `:args` and explicit
+result types; checking-only aliases need not exist as runtime Vars.
+
+Structural traversal preserves metadata and optional-field presence, including
+present nil values, and shares unchanged fields. Quoted payloads remain opaque. Map/set traversal is structural;
+use vectors and explicit clauses when order or scope has semantic significance.
+
+Run `bin/check` from the repository root to check pass bodies as well as generated contracts.
diff --git a/examples/blacktide/algorithms.clj b/examples/blacktide/algorithms.clj
new file mode 100644
index 0000000..24a03d4
--- /dev/null
+++ b/examples/blacktide/algorithms.clj
@@ -0,0 +1,51 @@
+(ns blacktide.algorithms
+  "Small parsers and an in-place Hoare partition using mutable lexical locals."
+  (:require [com.tailrecursion.blacktide :refer [loophole label goto setq]]))
+
+(defn tokens [^String s]
+  (loophole [i 0 word "" out []]
+    (label scan)
+    (when (= i (count s)) (goto flush))
+    (let [c (.charAt s i)]
+      (setq i (inc i))
+      (if (Character/isWhitespace c)
+        (do (when (seq word) (setq out (conj out word)))
+            (setq word ""))
+        (setq word (str word c))))
+    (goto scan)
+    (label flush)
+    (when (seq word) (setq out (conj out word)))
+    out))
+
+(defn partition! [^longs a]
+  (when (pos? (alength a))
+    (let [pivot (aget a 0)]
+      (loophole [left -1 right (alength a)]
+        (label scan)
+        (setq left (inc left))
+        (while (< (aget a left) pivot) (setq left (inc left)))
+        (setq right (dec right))
+        (while (> (aget a right) pivot) (setq right (dec right)))
+        (when (>= left right) (goto done))
+        (let [v (aget a left)] (aset-long a left (aget a right)) (aset-long a right v))
+        (goto scan)
+        (label done) right))))
+
+(defn decimal-prefix [^String s]
+  (loophole [i 0 sign 1 value 0N start 0]
+    (when (empty? s) (goto end))
+    (case (.charAt s 0)
+      \- (setq sign -1 i 1)
+      \+ (setq i 1)
+      nil)
+    (setq start i)
+    (label digit)
+    (when (= i (count s)) (goto done))
+    (let [c (.charAt s i)]
+      (when-not (<= (int \0) (int c) (int \9)) (goto done))
+      (setq value (+ (* value 10) (- (int c) (int \0)))
+            i (inc i)))
+    (goto digit)
+    (label done)
+    (when (= i start) (goto end))
+    [(* sign value) i]))
diff --git a/src-java/com/tailrecursion/blacktide/runtime/KeywordSite.java b/src-java/com/tailrecursion/blacktide/runtime/KeywordSite.java
new file mode 100644
index 0000000..189e645
--- /dev/null
+++ b/src-java/com/tailrecursion/blacktide/runtime/KeywordSite.java
@@ -0,0 +1,40 @@
+package com.tailrecursion.blacktide.runtime;
+
+import clojure.lang.AFn;
+import clojure.lang.ILookupThunk;
+import clojure.lang.IPersistentVector;
+import clojure.lang.IType;
+import clojure.lang.Keyword;
+import clojure.lang.KeywordLookupSite;
+import clojure.lang.PersistentVector;
+import clojure.lang.Symbol;
+
+/** KeywordInvokeExpr's cache, snapshotted before evaluating an effectful target. */
+public final class KeywordSite extends AFn implements IType {
+    public final Keyword keyword;
+    private final KeywordLookupSite site;
+    private ILookupThunk thunk;
+
+    public KeywordSite(Keyword keyword) {
+        this.keyword = keyword;
+        this.site = new KeywordLookupSite(keyword);
+        this.thunk = site;
+    }
+
+    // Clojure emits IType constants through this basis and the public constructor,
+    // giving each emitted call site a cache in both REPL and AOT compilation.
+    public static IPersistentVector getBasis() {
+        return PersistentVector.create((Object) Symbol.intern("keyword"));
+    }
+
+    public ILookupThunk snapshot() { return thunk; }
+
+    @Override public Object invoke(Object saved, Object target) {
+        ILookupThunk before = (ILookupThunk) saved;
+        Object value = before.get(target);
+        if (value != before) return value;
+        ILookupThunk next = site.fault(target);
+        thunk = next;
+        return next.get(target);
+    }
+}
diff --git a/src/com/tailrecursion/blacktide.clj b/src/com/tailrecursion/blacktide.clj
new file mode 100644
index 0000000..ab04ce0
--- /dev/null
+++ b/src/com/tailrecursion/blacktide.clj
@@ -0,0 +1,41 @@
+(ns com.tailrecursion.blacktide
+  "Blacktide's loophole macro adds mutable lexical locals and statement jumps
+  to a bounded subset of Clojure, compiled through typed nanopasses."
+  (:require [com.tailrecursion.blacktide.compiler.errors :as errors]
+            [com.tailrecursion.blacktide.compiler :as compiler]))
+
+(defmacro label
+  "Mark a position in the outer statement sequence of a loophole region."
+  [& _]
+  (errors/fail :outside-region "label is only valid inside loophole" {}
+               (errors/site {:form &form :file *file* :line nil :column nil} &form)))
+
+(defmacro goto
+  "Jump from a statement to an outer label; (goto end) returns nil."
+  [& _]
+  (errors/fail :outside-region "goto is only valid inside loophole" {}
+               (errors/site {:form &form :file *file* :line nil :column nil} &form)))
+
+(defmacro setq
+  "Assign symbol/value pairs sequentially; return the last value, or nil."
+  [& _]
+  (errors/fail :outside-region "setq is only valid inside loophole" {}
+               (errors/site {:form &form :file *file* :line nil :column nil} &form)))
+
+(defmacro psetq
+  "Evaluate symbol/value pairs before assigning their targets; return nil."
+  [& _]
+  (errors/fail :outside-region "psetq is only valid inside loophole" {}
+               (errors/site {:form &form :file *file* :line nil :column nil} &form)))
+
+(defmacro loophole
+  "Initialize simple-symbol bindings sequentially; make them mutable through
+  setq/psetq. Return the last body value, or nil. Labels belong to the outer
+  statement sequence; goto is forbidden within operands and initializers.
+  Supports let, loop/recur, case, calls, collections, Java interop and macros
+  expanding into these forms. Functions, try, native set! and nested regions
+  must be outside the macro. See doc/language.md for the complete contract."
+  [bindings & body]
+  (compiler/compile-form (or &env {})
+           {#'loophole :loophole #'label :label #'goto :goto #'setq :setq #'psetq :psetq}
+           &form))
diff --git a/src/com/tailrecursion/blacktide/compiler.clj b/src/com/tailrecursion/blacktide/compiler.clj
new file mode 100644
index 0000000..21507eb
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler.clj
@@ -0,0 +1,48 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler
+  "Orchestrate source analysis, lowering, graph checks and emission. The public
+  macro supplies marker Vars and the caller's lexical environment."
+  (:require [com.tailrecursion.blacktide.compiler.errors :as errors]
+            [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as s]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [com.tailrecursion.blacktide.compiler.source :as source]
+            [com.tailrecursion.blacktide.compiler.source-jvm :as facts]
+            [com.tailrecursion.blacktide.compiler.boundaries :as boundaries]
+            [com.tailrecursion.blacktide.compiler.cases :as cases]
+            [com.tailrecursion.blacktide.compiler.assignment :as assignment]
+            [com.tailrecursion.blacktide.compiler.source-values :as source-values]
+            [com.tailrecursion.blacktide.compiler.collections :as collections]
+            [com.tailrecursion.blacktide.compiler.order :as order]
+            [com.tailrecursion.blacktide.compiler.prepare :as prepare]
+            [com.tailrecursion.blacktide.compiler.lower :as lower]
+            [com.tailrecursion.blacktide.compiler.transfers :as transfers]
+            [com.tailrecursion.blacktide.compiler.graph :as graph]
+            [com.tailrecursion.blacktide.compiler.backend :as backend]
+            [com.tailrecursion.blacktide.compiler.host-emit :as host]
+            [typed.clojure :as-alias t]))
+
+(np/defpass compile-tree {:from [s/Bound Expr] :to [l/Machine Code] :args [s/Bound-Supply] :body true}
+  [supply expr]
+  (let [[supply expr] (assignment/parallel supply (assignment/sequential (source-values/expression (boundaries/classify expr))))
+        [supply expr] (order/normalize supply (prepare/prepare (collections/normalize (cases/normalize expr))))
+        program (graph/analyze (transfers/resolve-program (lower/compile-graph supply expr)))]
+    (host/box-form (backend/compile-program program))))
+
+(np/defpass caller-locals
+  {:from [s/Bound Context] :to [s/Bound Context] :body true}
+  [ctx]
+  (assoc ctx :locals
+    (reduce-kv (fn [^{::t/- (t/Map t/Sym s/Bound-Local)} out ^{::t/- t/Sym} name ^{::t/- t/Any} binding]
+                 (assoc out name {:id name :name name :mutable? false :external? true
+                                  :jvm (facts/caller-facts name binding)})) {} (:macro-env ctx))))
+
+(np/defpass compile-form
+  {:from [s/Bound Raw] :to [l/Machine Code]
+   :args [(t/Map t/Sym t/Any) (t/Map t/AnyVar t/Kw)] :body true}
+  [env markers form]
+  (let [_ (assert (seq? form) "Expected a loophole macro form")
+        site (errors/site {:form form :file *file* :line nil :column nil} form)
+        ctx (caller-locals {:locals {} :macro-env env :markers markers :outer? true :transfer? true
+                            :recur nil :site site :statement? true :tail? false})
+        [supply expr] (source/parse-scope {:prefix (str (gensym "loophole__")) :next 0} ctx true (vec form))]
+    (compile-tree supply expr)))
diff --git a/src/com/tailrecursion/blacktide/compiler/analysis_languages.clj b/src/com/tailrecursion/blacktide/compiler/analysis_languages.clj
new file mode 100644
index 0000000..9fd8408
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/analysis_languages.clj
@@ -0,0 +1,23 @@
+(ns com.tailrecursion.blacktide.compiler.analysis-languages
+  "Value proofs and join plans for checked control-flow graphs. Bottom is an
+  unresolved copy cycle; boxed values have no primitive storage proof."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [typed.clojure :as-alias t]))
+
+(np/deflanguage Analysis
+  {Type (t/U ':bottom ':boxed java.lang.Class)
+   Types (t/Map t/Sym Type)
+   Definitions (t/Map t/Sym (t/Vec l/Machine-Rhs))
+   Program (t/HMap :mandatory {:machine l/Machine-Program :types Types
+                               :reachable (t/Set l/Machine-Label)} :complete? true)})
+
+(np/derive-language Planned Analysis
+  {:replace
+   {Postdominators (t/Map l/Machine-Label (t/Set l/Machine-Label))
+    Region (t/HMap :mandatory {:definite (t/Set t/Sym) :changed (t/Set t/Sym)} :complete? true)
+    Regions (t/Map l/Machine-Label Region)
+    Join (t/HMap :mandatory {:target l/Machine-Label :result t/Sym} :complete? true)
+    Joins (t/Map l/Machine-Label Join)
+    Program (t/HMap :mandatory {:machine l/Machine-Program :types Types
+                                :reachable (t/Set l/Machine-Label) :joins Joins} :complete? true)}})
diff --git a/src/com/tailrecursion/blacktide/compiler/assignment.clj b/src/com/tailrecursion/blacktide/compiler/assignment.clj
new file mode 100644
index 0000000..f79276e
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/assignment.clj
@@ -0,0 +1,123 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.assignment
+  "Lower sequential batches to writes, then parallel batches to saved RHSs and
+  writes. Pending parallel writes do not execute if an RHS abandons evaluation."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as l]
+            [com.tailrecursion.blacktide.compiler.source :as source]
+            [typed.clojure :as-alias t]))
+
+(declare sequential sequential-binding sequential-pair sequential-forms sequential-pairs parallel)
+
+(np/defpass sequential-pair
+  {:from [l/Classified Assignment] :to [l/Sequential Assignment]
+   :processors {Local clojure.core/identity Expr sequential}}
+  [pair])
+
+(np/defpass sequential-pairs
+  {:from [l/Classified Assignments] :to [l/Sequential Assignments] :processors {Assignment sequential-pair}}
+  [pairs])
+
+(np/defpass sequential-forms
+  {:from [l/Classified Exprs] :to [l/Sequential Exprs] :processors {Expr sequential}}
+  [forms])
+
+(np/defpass sequential-node
+  {:from [l/Classified Node] :to [l/Sequential Node]
+   :processors {Local clojure.core/identity Raw clojure.core/identity CollectionKind clojure.core/identity RecurTarget clojure.core/identity CaseSpec clojure.core/identity
+                Expr sequential Exprs sequential-forms Binding sequential-binding Assignments sequential-pairs}}
+  [node]
+  :setq {:op :do :forms
+         (mapv (fn [pair]
+                 (let [value (sequential (:value pair))]
+                   (assoc value :node {:op :write :target (:target pair) :value value}))) (:pairs node))})
+
+(np/defpass sequential-binding
+  {:from [l/Classified Binding] :to [l/Sequential Binding]
+   :processors {Local clojure.core/identity Expr sequential}}
+  [binding])
+
+(np/defpass sequential
+  {:from [l/Classified Expr] :to [l/Sequential Expr] :body true}
+  [expr]
+  (assoc expr :node (sequential-node (:node expr))))
+
+(np/defpass parallel-forms
+  {:from [l/Sequential Exprs] :to (t/HVec [l/Bound-Supply l/Assigned-Exprs])
+   :args [l/Bound-Supply] :body true}
+  [supply forms]
+  (reduce (fn [^{::t/- (t/HVec [l/Bound-Supply l/Assigned-Exprs])} acc ^{::t/- l/Sequential-Expr} expr]
+            (let [[supply out] acc [supply expr] (parallel supply expr)] [supply (conj out expr)]))
+          [supply []] forms))
+
+(np/defpass parallel-bindings
+  {:from [l/Sequential Bindings] :to (t/HVec [l/Bound-Supply l/Assigned-Bindings])
+   :args [l/Bound-Supply] :body true}
+  [supply bindings]
+  (reduce (fn [^{::t/- (t/HVec [l/Bound-Supply l/Assigned-Bindings])} acc ^{::t/- l/Sequential-Binding} binding]
+            (let [[supply out] acc [supply init] (parallel supply (:init binding))]
+              [supply (conj out (assoc binding :init init))])) [supply []] bindings))
+
+(np/defpass save-parallel-values
+  {:from [l/Sequential Assignments]
+   :to (t/HVec [l/Bound-Supply l/Assigned-Bindings l/Assigned-Exprs]) :args [l/Bound-Supply] :body true}
+  [supply pairs]
+  (reduce (fn [^{::t/- (t/HVec [l/Bound-Supply l/Assigned-Bindings l/Assigned-Exprs])} acc
+               ^{::t/- l/Sequential-Assignment} pair]
+            (let [[supply bindings writes] acc [supply value] (parallel supply (:value pair))
+                  [supply id] (source/fresh "parallel" supply)
+                  local {:id id :name id :mutable? false :external? false :jvm (:jvm value)}
+                  read (assoc value :node {:op :local :local local})
+                  write (assoc value :node {:op :write :target (:target pair) :value read})]
+              [supply (conj bindings {:local local :init value}) (conj writes write)])) [supply [] []] pairs))
+
+(np/defpass parallel-node
+  {:from [l/Sequential Node] :to (t/HVec [l/Bound-Supply l/Assigned-Node]) :args [l/Bound-Supply]}
+  [supply node]
+  :literal [supply node]
+  :local [supply node]
+  :global [supply node]
+  :var [supply node]
+  :label [supply node]
+  :goto [supply node]
+  :native [supply node]
+  :dispatch (let [[supply value] (parallel supply (:value node))]
+              [supply {:op :dispatch :value value :spec (:spec node)}])
+  :case (let [[supply selector] (parallel supply (:selector node))
+              [supply arms] (parallel-forms supply (:arms node))]
+          [supply {:op :case :selector selector :arms arms}])
+  :recur (let [[supply args] (parallel-forms supply (:args node))]
+           [supply {:op :recur :target (:target node) :args args}])
+  :loop (let [[supply bindings] (parallel-bindings supply (:bindings node))
+              [supply body] (parallel supply (:body node))]
+          [supply {:op :loop :id (:id node) :bindings bindings :body body}])
+  :if (let [[supply test] (parallel supply (:test node))
+            [supply yes] (parallel supply (:then node))
+            [supply no] (parallel supply (:else node))]
+        [supply {:op :if :test test :then yes :else no}])
+  :throw (let [[supply value] (parallel supply (:value node))] [supply {:op :throw :value value}])
+  :write (let [[supply value] (parallel supply (:value node))]
+           [supply {:op :write :target (:target node) :value value}])
+  :do (let [[supply forms] (parallel-forms supply (:forms node))] [supply {:op :do :forms forms}])
+  :host (let [[supply args] (parallel-forms supply (:args node))]
+          [supply {:op :host :operation (:operation node) :args args}])
+  :invoke (let [[supply function] (parallel supply (:function node))
+                [supply args] (parallel-forms supply (:args node))]
+            [supply {:op :invoke :function function :args args}])
+  :collection (let [[supply items] (parallel-forms supply (:items node))
+                    [supply metadata] (if-let [metadata (:metadata node)] (parallel supply metadata) [supply nil])]
+                [supply {:op :collection :kind (:kind node) :items items :metadata metadata}])
+  :let (let [[supply bindings] (parallel-bindings supply (:bindings node))
+             [supply body] (parallel supply (:body node))]
+         [supply {:op :let :bindings bindings :body body}])
+  :psetq (let [[supply bindings writes] (save-parallel-values supply (:pairs node))
+               template (first writes)]
+           (if template
+             [supply {:op :let :bindings bindings
+                      :body (assoc template :node {:op :do :forms (conj writes (assoc template :node {:op :literal :value nil}))})}]
+             [supply {:op :literal :value nil}])))
+
+(np/defpass parallel
+  {:from [l/Sequential Expr] :to (t/HVec [l/Bound-Supply l/Assigned-Expr])
+   :args [l/Bound-Supply] :body true}
+  [supply expr]
+  (let [[supply node] (parallel-node supply (:node expr))] [supply (assoc expr :node node)]))
diff --git a/src/com/tailrecursion/blacktide/compiler/backend.clj b/src/com/tailrecursion/blacktide/compiler/backend.clj
new file mode 100644
index 0000000..279f53a
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/backend.clj
@@ -0,0 +1,26 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.backend
+  "Select checked structured code when eligible, otherwise the general machine.
+  Independent models and both emitters exercise the same source semantics."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [com.tailrecursion.blacktide.compiler.feasible :as feasible]
+            [com.tailrecursion.blacktide.compiler.graph :as graph]
+            [com.tailrecursion.blacktide.compiler.invariants :as invariants]
+            [com.tailrecursion.blacktide.compiler.value-facts :as facts]
+            [com.tailrecursion.blacktide.compiler.joins :as joins]
+            [com.tailrecursion.blacktide.compiler.storage :as storage]
+            [com.tailrecursion.blacktide.compiler.compact :as compact]
+            [com.tailrecursion.blacktide.compiler.structure :as structure]
+            [com.tailrecursion.blacktide.compiler.structured-emit :as structured]
+            [com.tailrecursion.blacktide.compiler.emit :as emit]))
+
+(np/defpass compile-program {:from [l/Machine Program] :to [l/Machine Code] :body true}
+  [machine]
+  (let [program (-> {:entry (:entry machine) :blocks (:blocks machine)}
+                    feasible/program graph/analyze)
+        analysis (facts/analyze program)
+        decision (structure/recover (joins/plan analysis))]
+    (if (= :structured (:op decision))
+      (let [program (compact/program (storage/select-storage analysis (invariants/expression #{} (:body decision))))]
+        (structured/expression (:types program) (:body program)))
+      (emit/program-form machine))))
diff --git a/src/com/tailrecursion/blacktide/compiler/boundaries.clj b/src/com/tailrecursion/blacktide/compiler/boundaries.clj
new file mode 100644
index 0000000..d7e1d5d
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/boundaries.clj
@@ -0,0 +1,70 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.boundaries
+  "Classify analyzed native bodies before expression lowering. Native subtrees
+  exclude DSL effects; lowered loops materialize their source representations."
+  (:require [com.tailrecursion.blacktide.compiler.effects :refer [effects]]
+            [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as s]
+            [com.tailrecursion.blacktide.compiler.loop-facts :as loops]
+            [typed.clojure :as-alias t]))
+
+(declare native native-binding native-forms classify classify-binding classify-forms classify-pair classify-pairs)
+
+(np/defpass native-node
+  {:from [s/Bound Node] :to [s/Native Node]
+   :processors {Expr native Exprs native-forms Binding native-binding}}
+  [node]
+  :literal node :local node :global node :var node
+  :case {:op :case :selector (native (:selector node))
+         :arms (native-forms (:arms node))}
+  :dispatch {:op :dispatch :value (native (:value node)) :spec (:spec node)}
+  :collection {:op :collection :kind (:kind node) :items (native-forms (:items node))
+               :metadata (when-let [metadata (:metadata node)] (native metadata))}
+  :recur {:op :recur :target (:target node) :args (mapv native (:args node))}
+  :loop {:op :loop :id (:id node) :bindings (mapv native-binding (:bindings node))
+         :body (native (:body node))}
+  :setq (if (empty? (:pairs node)) {:op :literal :value nil} (throw (IllegalStateException. "Native local write")))
+  :psetq (if (empty? (:pairs node)) {:op :literal :value nil} (throw (IllegalStateException. "Native parallel write")))
+  :label (throw (IllegalStateException. "Native label"))
+  :goto (throw (IllegalStateException. "Native transfer")))
+
+(np/defpass native-binding {:from [s/Bound Binding] :to [s/Native Binding] :body true}
+  [binding] (assoc binding :init (native (:init binding))))
+(np/defpass native-forms {:from [s/Bound Exprs] :to [s/Native Exprs] :processors {Expr native}}
+  [forms])
+(np/defpass native {:from [s/Bound Expr] :to [s/Native Expr] :body true}
+  [expr]
+  (assoc expr :node (native-node (:node expr))))
+
+(np/defpass classify-node
+  {:from [s/Bound Node] :to [s/Classified Node]
+   :processors {Expr classify Exprs classify-forms Binding classify-binding Assignments classify-pairs
+                Local clojure.core/identity RecurTarget clojure.core/identity
+                Raw clojure.core/identity CollectionKind clojure.core/identity CaseSpec clojure.core/identity}}
+  [node]
+  :loop {:op :loop :id (:id node) :bindings (mapv classify-binding (:bindings node)) :body (classify (:body node))})
+
+(np/defpass classify-pair {:from [s/Bound Assignment] :to [s/Classified Assignment]
+                          :processors {Expr classify Local clojure.core/identity}}
+  [pair])
+(np/defpass classify-pairs {:from [s/Bound Assignments] :to [s/Classified Assignments] :processors {Assignment classify-pair}}
+  [pairs])
+(np/defpass classify-binding {:from [s/Bound Binding] :to [s/Classified Binding]
+                             :processors {Expr classify Local clojure.core/identity}}
+  [binding])
+(np/defpass classify-forms {:from [s/Bound Exprs] :to [s/Classified Exprs] :processors {Expr classify}}
+  [forms])
+(np/defpass classify {:from [s/Bound Expr] :to [s/Classified Expr] :body true}
+  [expr]
+  (let [node (:node expr)]
+    (cond
+      ;; KeywordInvokeExpr snapshots its cache before evaluating the target.
+      ;; Retain the whole call when the target needs no DSL control or writes;
+      ;; saving the target first would change reentrant lookup behavior.
+      (and (= :invoke (:op node)) (= 1 (count (:args node)))
+           (= :literal (:op (:node (:function node))))
+           (keyword? (:form (:site (:function node)))) (not (effects expr)))
+      (assoc expr :node {:op :native :value (native expr)})
+      (and (= :loop (:op node)) (not (effects expr)))
+      (assoc expr :node {:op :native :value (native expr)})
+      (= :loop (:op node)) (let [expr (loops/lower expr)] (assoc expr :node (classify-node (:node expr))))
+      :else (assoc expr :node (classify-node node)))))
diff --git a/src/com/tailrecursion/blacktide/compiler/box_origins.clj b/src/com/tailrecursion/blacktide/compiler/box_origins.clj
new file mode 100644
index 0000000..3c78396
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/box_origins.clj
@@ -0,0 +1,38 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.box-origins
+  "Find values that can be reboxed at return, following copies. Primitive
+  computations create boxes; compiled small Long literals use the guaranteed
+  cache. Storage analysis must still exclude all other identity observations."
+  (:require [clojure.set :as set]
+            [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [com.tailrecursion.blacktide.compiler.analysis-languages :as a]
+            [com.tailrecursion.blacktide.compiler.value-facts :as facts]
+            [typed.clojure :as-alias t]))
+
+(np/defpass copy-source {:from [l/Machine Rhs] :to (t/Option t/Sym) :body true}
+  [rhs]
+  (when (and (= :value (:op rhs)) (= :local (:op (:value rhs)))) (:id (:value rhs))))
+
+(np/defpass reboxable? {:from [l/Machine Rhs] :to t/Bool :body true}
+  [rhs]
+  (case (:op rhs)
+    :value (let [value (:value rhs)]
+             (boolean (and (= :literal (:op value)) (instance? Long (:value value))
+                           (<= -128 (:value value) 127))))
+    (:host :convert) (class? (facts/rhs-type {} rhs))
+    false))
+
+(np/defpass reboxable-values {:from [a/Analysis Program] :to (t/Set t/Sym) :body true}
+  [analysis]
+  (let [definitions (facts/definitions (:reachable analysis) (:machine analysis))
+        initial (reduce-kv
+                  (fn [^{::t/- (t/Set t/Sym)} out ^{::t/- t/Sym} id ^{::t/- (t/Vec l/Machine-Rhs)} values]
+                    (if (some #(and (nil? (copy-source %)) (not (reboxable? %))) values) (conj out id) out))
+                  #{} definitions)
+        denied ((fn ^{::t/- [(t/Set t/Sym) :-> (t/Set t/Sym)]} solve [denied]
+                  (let [next (reduce-kv
+                               (fn [^{::t/- (t/Set t/Sym)} out ^{::t/- t/Sym} id ^{::t/- (t/Vec l/Machine-Rhs)} values]
+                                 (if (some #(contains? denied (copy-source %)) values) (conj out id) out))
+                               denied definitions)]
+                    (if (= next denied) denied (recur next)))) initial)]
+    (set/difference (set (keys definitions)) denied)))
diff --git a/src/com/tailrecursion/blacktide/compiler/case_emit.clj b/src/com/tailrecursion/blacktide/compiler/case_emit.clj
new file mode 100644
index 0000000..bf670f6
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/case_emit.clj
@@ -0,0 +1,25 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.case-emit
+  "Emit native case* dispatch from constant table data. Result arms are separate
+  from constant matching; selection never substitutes ordinary equality for case."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as s]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [typed.clojure :as-alias t]))
+
+(np/defpass selector-form
+  {:from [s/Bound CaseSpec] :to [l/Machine Code] :args [l/Machine-Code] :body true}
+  [value spec]
+  (let [local (gensym "dispatch__")]
+    (list 'let* [local value]
+          (list 'case* local (:shift spec) (:mask spec) (:default spec)
+                (into (sorted-map) (:tests spec)) (:switch spec) (:test spec) (:skip spec)))))
+
+(np/defpass arms-form
+  {:from [l/Machine Code] :to [l/Machine Code] :args [(t/Vec l/Machine-Code)] :body true}
+  [arms selector]
+  (let [local (gensym "selected__")
+        default (or (first arms) (throw (IllegalStateException. "Case requires an arm")))
+        table (into (sorted-map) (map-indexed (fn [index arm] [index [index arm]]) arms))]
+    ;; The selector is exhaustive. Reusing an arm as the unreachable default
+    ;; preserves native common-return typing without introducing a nil arm.
+    (list 'let* [local selector] (list 'case* local 0 0 default table :compact :int))))
diff --git a/src/com/tailrecursion/blacktide/compiler/cases.clj b/src/com/tailrecursion/blacktide/compiler/cases.clj
new file mode 100644
index 0000000..422d17e
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/cases.clj
@@ -0,0 +1,24 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.cases
+  "Separate source case from ordinal arm selection after native constant dispatch.
+  Each source arm occurs once, including grouped and hash-collision alternatives."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as s]))
+
+(declare normalize normalize-binding normalize-forms)
+
+(np/defpass normalize-node
+  {:from [s/Assigned Node] :to [s/Cases Node]
+   :processors {Expr normalize Exprs normalize-forms Binding normalize-binding
+                Raw clojure.core/identity Local clojure.core/identity CollectionKind clojure.core/identity
+                RecurTarget clojure.core/identity CaseSpec clojure.core/identity}}
+  [node]
+  :case
+  {:op :select :selector (normalize (:selector node)) :arms (normalize-forms (:arms node))})
+
+(np/defpass normalize-binding {:from [s/Assigned Binding] :to [s/Cases Binding]
+                              :processors {Expr normalize Local clojure.core/identity}}
+  [binding])
+(np/defpass normalize-forms {:from [s/Assigned Exprs] :to [s/Cases Exprs] :processors {Expr normalize}}
+  [forms])
+(np/defpass normalize {:from [s/Assigned Expr] :to [s/Cases Expr] :body true}
+  [expr] (assoc expr :node (normalize-node (:node expr))))
diff --git a/src/com/tailrecursion/blacktide/compiler/collections.clj b/src/com/tailrecursion/blacktide/compiler/collections.clj
new file mode 100644
index 0000000..02bd5d0
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/collections.clj
@@ -0,0 +1,71 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.collections
+  "Preserve native constant collections and construction checks. Metadata keeps
+  construction dynamic and is evaluated only after that construction succeeds."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as l]
+            [com.tailrecursion.blacktide.compiler.languages :as m]
+            [com.tailrecursion.blacktide.compiler.host-emit :as host]
+            [typed.clojure :as-alias t]))
+
+(declare normalize normalize-binding)
+
+(np/defpass form
+  {:from [l/Collections CollectionKind] :to [m/Machine Code]
+   :args [(t/Vec m/Machine-Code) t/Bool] :body true}
+  [items unique? kind]
+  (if (= :vector kind)
+    (if (<= (count items) 6)
+      (list* 'clojure.lang.Tuple/create items)
+      ;; An Object expression prevents constant folding without unboxing the
+      ;; first literal, which would lose its original numeric width or identity.
+      (list 'do (assoc items 0 (host/box-form (nth items 0)))))
+    (list (if (= :set kind) 'clojure.lang.RT/set
+              (if unique? 'clojure.lang.RT/mapUniqueKeys 'clojure.lang.RT/map))
+          (list 'clojure.lang.RT/object_array items))))
+
+(np/defpass normalize-forms
+  {:from [l/Cases Exprs] :to [l/Collections Exprs] :processors {Expr normalize}}
+  [forms])
+
+(np/defpass literal-values
+  {:from [l/Collections Exprs] :to (t/Option (t/Vec t/Any)) :body true}
+  [items]
+  (reduce (fn [^{::t/- (t/Option (t/Vec t/Any))} values ^{::t/- l/Collections-Expr} expr]
+            (let [node (:node expr)]
+              (if (and values (= :literal (:op node))) (conj values (:value node)) (reduced nil))))
+          [] items))
+
+(np/defpass constant
+  {:from [l/Collections CollectionKind] :to t/Any :args [(t/Vec t/Any)] :body true}
+  [values kind]
+  (case kind
+    :vector (vec values)
+    :map (reduce (fn [^{::t/- (t/Map t/Any t/Any)} out ^{::t/- (t/Seq t/Any)} pair]
+                   (assoc out (first pair) (second pair))) {} (partition 2 values))
+    :set (set values)))
+
+(np/defpass normalize-node
+  {:from [l/Cases Node] :to [l/Collections Node]
+   :processors {Expr normalize Exprs normalize-forms Binding normalize-binding Raw clojure.core/identity
+                Local clojure.core/identity RecurTarget clojure.core/identity CaseSpec clojure.core/identity}}
+  [node]
+  :collection
+  (let [items (mapv normalize (:items node)) metadata (some-> (:metadata node) normalize)
+        values (literal-values items)
+        keys (when (= :map (:kind node)) (literal-values (vec (take-nth 2 items))))
+        unique? (boolean (and keys (= (count keys) (count (set keys)))))]
+    (when (and (nil? metadata) keys (not unique?))
+      (throw (IllegalArgumentException. "Duplicate constant keys in map")))
+    (if (and (nil? metadata) values)
+      {:op :literal :value (constant values (:kind node))}
+      {:op :build :kind (:kind node) :items items :metadata metadata :unique? unique?})))
+
+(np/defpass normalize-binding
+  {:from [l/Cases Binding] :to [l/Collections Binding]
+   :processors {Expr normalize Local clojure.core/identity}}
+  [binding])
+
+(np/defpass normalize
+  {:from [l/Cases Expr] :to [l/Collections Expr] :body true}
+  [expr]
+  (assoc expr :node (normalize-node (:node expr))))
diff --git a/src/com/tailrecursion/blacktide/compiler/compact.clj b/src/com/tailrecursion/blacktide/compiler/compact.clj
new file mode 100644
index 0000000..ea027c1
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/compact.clj
@@ -0,0 +1,197 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.compact
+  "Discard unused storage without discarding evaluation. Substitute compatible
+  copies and single-use, total primitive computations only before their inputs
+  are rebound. Native bodies remain opaque, including their free local reads."
+  (:require [clojure.set :as set]
+            [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.structured-languages :as s]
+            [com.tailrecursion.blacktide.compiler.compact-languages :as c]
+            [com.tailrecursion.blacktide.compiler.native :as native]
+            [com.tailrecursion.blacktide.compiler.jvm :as jvm]
+            [typed.clojure :as-alias t]))
+
+(np/defpass introduce {:from [s/Stored Expr] :to [c/Compact Expr]}
+  [node]
+  :bind (assoc node :body (introduce (:body node)))
+  :join (assoc node :value (introduce (:value node)) :body (introduce (:body node)))
+  :branch (assoc node :yes (introduce (:yes node)) :no (introduce (:no node)))
+  :switch (assoc node :arms (mapv introduce (:arms node)))
+  :loop {:op :loop :bindings (mapv (fn [id] {:target id :value {:op :local :id id}}) (:slots node))
+         :body (introduce (:body node))}
+  :recur {:op :recur :args (mapv (fn [id] {:op :local :id id}) (:slots node))}
+  :return node :throw node)
+
+(declare rhs-reads)
+(np/defpass atom-reads {:from [c/Compact Atom] :to (t/Vec t/Sym)}
+  [node]
+  :local [(:id node)] :literal [] :inline (rhs-reads (:value node)))
+
+(np/defpass rhs-reads {:from [c/Compact Rhs] :to (t/Vec t/Sym)}
+  [node]
+  :value (atom-reads (:value node))
+  :global [] :external [] :var []
+  :native (vec (native/reads (:value node)))
+  :dispatch (atom-reads (:value (:value node)))
+  :convert (atom-reads (:value (:value node)))
+  :construct (into [] (mapcat atom-reads) (:items node))
+  :metadata (into (atom-reads (:value node)) (atom-reads (:metadata node)))
+  :host (into [] (mapcat #(atom-reads (:value %))) (:args node))
+  :invoke (into (atom-reads (:function node)) (mapcat atom-reads) (:args node)))
+
+(np/defpass reads {:from [c/Compact Expr] :to (t/Vec t/Sym)}
+  [node]
+  :bind (into (rhs-reads (:value (:binding node))) (filterv #(not= % (:target (:binding node))) (reads (:body node))))
+  :effect (into (rhs-reads (:value (:binding node))) (reads (:body node)))
+  :join (into (reads (:value node)) (filterv #(not= % (:target node)) (reads (:body node))))
+  :branch (into (into (atom-reads (:test node)) (reads (:yes node))) (reads (:no node)))
+  :switch (into (atom-reads (:test node)) (mapcat reads) (:arms node))
+  :loop (reduce (fn [^{::t/- (t/Vec t/Sym)} refs ^{::t/- c/Compact-Binding} binding]
+                  (into (atom-reads (:value binding)) (filterv #(not= % (:target binding)) refs)))
+                (reads (:body node)) (rseq (:bindings node)))
+  :recur (into [] (mapcat atom-reads) (:args node))
+  :return (atom-reads (:value node)) :throw (atom-reads (:value node)))
+
+(np/defpass stable?
+  {:from [c/Compact Expr] :to t/Bool :args [t/Sym (t/Set t/Sym)]}
+  [id dependencies node]
+  :bind (if (contains? dependencies (:target (:binding node)))
+          (not (some #{id} (reads (:body node)))) (stable? id dependencies (:body node)))
+  :effect (stable? id dependencies (:body node))
+  :join (and (stable? id dependencies (:value node))
+             (if (contains? dependencies (:target node))
+               (not (some #{id} (reads (:body node)))) (stable? id dependencies (:body node))))
+  :branch (and (stable? id dependencies (:yes node)) (stable? id dependencies (:no node)))
+  :switch (every? #(stable? id dependencies %) (:arms node))
+  ;; Loop binders also rebind on the backedge. Do not move an outer snapshot
+  ;; into a loop that changes one of its inputs, even if the first entry agrees.
+  :loop (and (empty? (set/intersection dependencies (set (map :target (:bindings node)))))
+             (stable? id dependencies (:body node)))
+  :recur true :return true :throw true)
+
+(declare substitute-rhs)
+(np/defpass substitute-atom
+  {:from [c/Compact Atom] :to [c/Compact Atom] :args [t/Sym c/Compact-Atom]
+   :processors {Rhs substitute-rhs}}
+  [from replacement node]
+  :local (if (= from (:id node)) replacement node))
+
+(np/defpass substitute-operand
+  {:from [c/Compact Operand] :to [c/Compact Operand] :args [t/Sym c/Compact-Atom]
+   :processors {Atom substitute-atom}} [from replacement node])
+
+(np/defpass substitute-rhs
+  {:from [c/Compact Rhs] :to [c/Compact Rhs] :args [t/Sym c/Compact-Atom]
+   :processors {Atom substitute-atom Operand substitute-operand}} [from replacement node])
+
+(np/defpass substitute-operation
+  {:from [c/Compact Operation] :to [c/Compact Operation] :args [t/Sym c/Compact-Atom]
+   :processors {Rhs substitute-rhs}} [from replacement node])
+
+(np/defpass substitute-binding
+  {:from [c/Compact Binding] :to [c/Compact Binding] :args [t/Sym c/Compact-Atom]
+   :processors {Atom substitute-atom}} [from replacement node])
+
+(np/defpass substitute
+  {:from [c/Compact Expr] :to [c/Compact Expr] :args [t/Sym c/Compact-Atom]
+   :processors {Atom substitute-atom Rhs substitute-rhs Operation substitute-operation Binding substitute-binding}}
+  [from replacement node]
+  :bind (assoc node :binding (substitute-operation from replacement (:binding node))
+                   :body (if (= from (:target (:binding node))) (:body node)
+                           (substitute from replacement (:body node))))
+  :join (assoc node :value (substitute from replacement (:value node))
+                   :body (if (= from (:target node)) (:body node)
+                           (substitute from replacement (:body node))))
+  ;; Loop initializers see earlier bindings, but the body sees all loop binders.
+  :loop ((fn ^{::t/- [t/Int (t/Vec c/Compact-Binding) t/Bool :-> c/Compact-Expr]} bindings [index pairs shadowed?]
+           (if (< index (count (:bindings node)))
+             (let [binding (nth (:bindings node) index)]
+               (recur (inc index) (conj pairs (if shadowed? binding (substitute-binding from replacement binding)))
+                      (or shadowed? (= from (:target binding)))))
+             (assoc node :bindings pairs :body (if shadowed? (:body node)
+                                                (substitute from replacement (:body node)))))) 0 [] false))
+
+(np/defpass atom-type
+  {:from [c/Compact Atom] :to (t/Option java.lang.Class) :args [c/Compact-Types]}
+  [types node]
+  :local (get types (:id node))
+  :literal (cond (instance? Long (:value node)) Long/TYPE (instance? Double (:value node)) Double/TYPE :else nil)
+  :inline (:type node))
+
+(np/defpass movable?
+  {:from [c/Compact Rhs] :to t/Bool :args [c/Compact-Types] :body true}
+  [types rhs]
+  (and (= :host (:op rhs))
+       (let [operation (:operation rhs)]
+         (and (= :static (:op operation)) (= clojure.lang.Numbers (:class operation))
+              (contains? '#{lt lte gt gte equiv unchecked_add unchecked_minus unchecked_multiply
+                            unchecked_inc unchecked_dec unchecked_negate} (:member operation))
+              (every? (fn [^{::t/- c/Compact-Operand} operand]
+                        (let [type (atom-type types (:value operand))]
+                          (and (contains? #{Long/TYPE Double/TYPE} type) (= type (:type (:jvm operand))))))
+                      (:args rhs))
+              (let [type (jvm/host-type (mapv #(:type (:jvm %)) (:args rhs)) operation)]
+                (and (class? type) (.isPrimitive ^Class type) (not= Void/TYPE type)))))))
+
+(np/defpass replacement
+  {:from [c/Compact Operation] :to (t/Option c/Compact-Atom) :args [c/Compact-Types t/Int] :body true}
+  [types uses binding]
+  (let [rhs (:value binding) ^Class type (get types (:target binding))]
+    (case (:op rhs)
+      :value (let [value (:value rhs)]
+               ;; A bound reference must not become several independently boxed reads.
+               (when (and (= type (atom-type types value))
+                          (or type (= :local (:op value)))
+                          (or (not= :inline (:op value)) (= uses 1))) value))
+      :convert (let [conversion (:conversion rhs) operand (:value rhs)]
+                 (when (and type (:parameter? conversion) (= type (:type conversion))
+                            (= type (atom-type types (:value operand))) (= type (:type (:jvm operand))))
+                   (:value operand)))
+      :host (let [operation (:operation rhs) operand (first (:args rhs))
+                  cast-name (when (class? type) (symbol (str (.getName ^Class type) "Cast")))]
+              ;; RT's same-width primitive casts are identities only after both
+              ;; storage and source operand types agree. Keep Object results:
+              ;; those casts may establish a fresh box at a source-local read.
+              (if (and type (= :static (:op operation)) (= clojure.lang.RT (:class operation))
+                       (= 1 (count (:args rhs))) operand
+                       (= type (atom-type types (:value operand)) (:type (:jvm operand)))
+                       (= cast-name (:member operation))
+                       (= [type] (:tags operation)))
+                (:value operand)
+                (when (and type (= uses 1) (movable? types rhs)) {:op :inline :value rhs :type type})))
+      nil)))
+
+(np/defpass discardable? {:from [c/Compact Rhs] :to t/Bool :body true}
+  [rhs]
+  ;; Keep native validation, including constants that may fail AOT embedding.
+  (and (= :value (:op rhs))
+       (let [value (:value rhs)]
+         (or (= :local (:op value)) (and (= :literal (:op value)) (nil? (:value value)))))))
+
+(np/defpass simplify {:from [c/Compact Expr] :to [c/Compact Expr] :args [c/Compact-Types]}
+  [types node]
+  :bind (let [binding (:binding node) id (:target binding) body (simplify types (:body node))
+              uses (count (filter #{id} (reads body)))
+              value (replacement types uses binding)]
+          (cond
+            (and (= :native (:op (:value binding))) (not (contains? types id))
+                 (= body {:op :return :value {:op :local :id id}}))
+            {:op :return :value {:op :inline :value (:value binding) :type nil}}
+            (zero? uses) (if (discardable? (:value binding)) body {:op :effect :binding binding :body body})
+            (and value (stable? id (set (atom-reads value)) body))
+            (let [out (substitute id value body)]
+              ;; Substitution deliberately leaves native code alone.
+              (if (some #{id} (reads out)) (assoc node :body body) out))
+            :else (assoc node :body body)))
+  :effect (let [body (simplify types (:body node))]
+            (if (discardable? (:value (:binding node))) body (assoc node :body body)))
+  :join (let [value (simplify types (:value node)) body (simplify types (:body node)) id (:target node)]
+          (if (and (not (contains? types id)) (= body {:op :return :value {:op :local :id id}}))
+            value (assoc node :value value :body body)))
+  :branch (assoc node :yes (simplify types (:yes node)) :no (simplify types (:no node)))
+  :switch (assoc node :arms (mapv #(simplify types %) (:arms node)))
+  :loop (assoc node :body (simplify types (:body node)))
+  :recur node :return node :throw node)
+
+(np/defpass program {:from [s/Stored Program] :to [c/Compact Program] :body true}
+  [program]
+  {:types (:types program) :body (simplify (:types program) (introduce (:body program)))})
diff --git a/src/com/tailrecursion/blacktide/compiler/compact_languages.clj b/src/com/tailrecursion/blacktide/compiler/compact_languages.clj
new file mode 100644
index 0000000..aa881cd
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/compact_languages.clj
@@ -0,0 +1,24 @@
+(ns com.tailrecursion.blacktide.compiler.compact-languages
+  "Lexical expressions after storage selection. Discarded results have an effect
+  destination; total primitive computations may occupy operand positions.
+  Native results may remain in tail position. Loop initializers and recur
+  arguments are explicit, separate from binders."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [typed.clojure :as-alias t]))
+
+(np/derive-language Compact l/Machine
+  {:add {Atom [(t/HMap :mandatory {:op ':inline :value Rhs :type (t/Option java.lang.Class)} :complete? true)]}
+   :replace
+   {Binding (t/HMap :mandatory {:target t/Sym :value Atom} :complete? true)
+    Expr (t/U (t/HMap :mandatory {:op ':bind :binding Operation :body Expr} :complete? true)
+              (t/HMap :mandatory {:op ':effect :binding Operation :body Expr} :complete? true)
+              (t/HMap :mandatory {:op ':join :target t/Sym :value Expr :body Expr} :complete? true)
+              (t/HMap :mandatory {:op ':branch :test Atom :yes Expr :no Expr} :complete? true)
+              (t/HMap :mandatory {:op ':switch :test Atom :arms (t/Vec Expr)} :complete? true)
+              (t/HMap :mandatory {:op ':loop :bindings (t/Vec Binding) :body Expr} :complete? true)
+              (t/HMap :mandatory {:op ':recur :args (t/Vec Atom)} :complete? true)
+              (t/HMap :mandatory {:op ':return :value Atom} :complete? true)
+              (t/HMap :mandatory {:op ':throw :value Atom} :complete? true))
+    Types (t/Map t/Sym java.lang.Class)
+    Program (t/HMap :mandatory {:body Expr :types Types} :complete? true)}})
diff --git a/src/com/tailrecursion/blacktide/compiler/effects.clj b/src/com/tailrecursion/blacktide/compiler/effects.clj
new file mode 100644
index 0000000..8562b1b
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/effects.clj
@@ -0,0 +1,28 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.effects
+  "Identify local writes and transfers that prevent native subtree emission."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as s]
+            [typed.clojure :as-alias t]))
+
+(declare effects)
+
+(np/defpass effect-node {:from [s/Bound Node] :to t/Bool}
+  [node]
+  :literal false :local false :global false :var false
+  :setq (boolean (seq (:pairs node)))
+  :psetq (boolean (seq (:pairs node)))
+  :label true :goto true
+  :if (or (effects (:test node)) (effects (:then node)) (effects (:else node)))
+  :case (or (effects (:selector node)) (boolean (some effects (:arms node))))
+  :dispatch (effects (:value node))
+  :throw (effects (:value node))
+  :host (boolean (some effects (:args node)))
+  :invoke (or (effects (:function node)) (boolean (some effects (:args node))))
+  :collection (or (boolean (some effects (:items node))) (boolean (some-> (:metadata node) effects)))
+  :do (boolean (some effects (:forms node)))
+  :let (or (boolean (some #(effects (:init %)) (:bindings node))) (effects (:body node)))
+  :loop (or (boolean (some #(effects (:init %)) (:bindings node))) (effects (:body node)))
+  :recur (boolean (some effects (:args node))))
+
+(np/defpass effects {:from [s/Bound Expr] :to t/Bool :body true}
+  [expr] (effect-node (:node expr)))
diff --git a/src/com/tailrecursion/blacktide/compiler/emit.clj b/src/com/tailrecursion/blacktide/compiler/emit.clj
new file mode 100644
index 0000000..7492023
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/emit.clj
@@ -0,0 +1,77 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.emit
+  "Emit allocated machines as ordinary Clojure forms. Source effects occur in
+  sequential lets; edges carry live values through boxed loop bindings."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [com.tailrecursion.blacktide.compiler.native :as native]
+            [com.tailrecursion.blacktide.compiler.collections :as collections]
+            [com.tailrecursion.blacktide.compiler.case-emit :as cases]
+            [typed.clojure :as-alias t]
+            [com.tailrecursion.blacktide.compiler.host-emit :as host]))
+
+(np/defpass atom-form {:from [l/Machine Atom] :to [l/Machine Code]}
+  [node]
+  :literal (list 'quote (:value node))
+  :local (:id node))
+
+(np/defpass rhs-form {:from [l/Machine Rhs] :to [l/Machine Code]}
+  [node]
+  :value (atom-form (:value node))
+  :global (host/global-form (:name node))
+  :external (:name node)
+  :var (list 'var (:name node))
+  :native (native/form #{} (:value node))
+  :dispatch (cases/selector-form (host/typed-form (:jvm (:value node)) (atom-form (:value (:value node)))) (:spec node))
+  :construct (collections/form (mapv atom-form (:items node)) (:unique? node) (:kind node))
+  :metadata (let [value (gensym "value__") metadata (gensym "metadata__")]
+              (list 'let* [(with-meta value {:tag 'clojure.lang.IObj}) (atom-form (:value node))
+                           (with-meta metadata {:tag 'clojure.lang.IPersistentMap}) (atom-form (:metadata node))]
+                    (list '. value 'withMeta metadata)))
+  :convert (host/conversion-form (:conversion node) (:jvm (:value node)) (atom-form (:value (:value node))))
+  :host (host/host-form
+          (mapv (fn [arg] (host/typed-form (assoc (:jvm arg) :primitive? false) (atom-form (:value arg))))
+                (:args node)) (:operation node))
+  :invoke (list* (atom-form (:function node)) (mapv atom-form (:args node))))
+
+(np/defpass operation-form
+  {:from [l/Machine Operation] :to (t/HVec [t/Sym l/Machine-Code]) :body true}
+  [op]
+  [(with-meta (:target op) nil) (host/box-form (rhs-form (:value op)))])
+
+(np/defpass edge-form
+  {:from [l/Machine Label] :to [l/Machine Code]
+   :args [(t/Vec t/Sym) (t/Map l/Machine-Label (t/Set t/Sym))] :body true}
+  [slots live target]
+  (list* 'recur target (mapv (fn [id] (when (contains? (get live target #{}) id) (with-meta id nil))) slots)))
+
+(np/defpass term-form
+  {:from [l/Machine Term] :to [l/Machine Code]
+   :args [(t/Vec t/Sym) (t/Map l/Machine-Label (t/Set t/Sym))]}
+  [slots live term]
+  :jump (edge-form slots live (:target term))
+  :branch (list 'if (atom-form (:test term))
+                (edge-form slots live (:yes term)) (edge-form slots live (:no term)))
+  :switch (cases/arms-form (mapv #(edge-form slots live %) (:targets term)) (atom-form (:test term)))
+  :return (atom-form (:value term))
+  :throw (list 'throw (atom-form (:value term))))
+
+(np/defpass block-form
+  {:from [l/Machine Block] :to [l/Machine Code]
+   :args [(t/Vec t/Sym) (t/Map l/Machine-Label (t/Set t/Sym))] :body true}
+  [slots live block]
+  (let [end (term-form slots live (:term block))]
+    (if (seq (:ops block))
+      (list 'let* (vec (mapcat identity (mapv operation-form (:ops block)))) end)
+      end)))
+
+(np/defpass program-form {:from [l/Machine Program] :to [l/Machine Code] :body true}
+  [program]
+  (let [pc (gensym "pc__")
+        slots (mapv #(with-meta % nil) (:slots program))
+        bindings (into [pc (host/box-form (list 'quote (:entry program)))]
+                       (mapcat #(vector % nil)) slots)
+        arms (mapcat (fn [[label block]] [label (block-form slots (:live program) block)])
+                     (sort-by key (:blocks program)))]
+    (list 'loop* bindings
+          (list* 'clojure.core/case pc
+                 (concat arms [(list 'throw (list 'clojure.core/ex-info "Invalid machine PC" {:pc pc}))])))))
diff --git a/src/com/tailrecursion/blacktide/compiler/errors.clj b/src/com/tailrecursion/blacktide/compiler/errors.clj
new file mode 100644
index 0000000..caef819
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/errors.clj
@@ -0,0 +1,27 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.errors
+  "Source locations and structured errors shared by syntax analysis and lowering.
+  DSL markers obey the same Var visibility rules as other source forms."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as s]
+            [typed.clojure :as-alias t]))
+
+(np/defpass site {:from [s/Bound Raw] :to [s/Bound Site] :args [s/Bound-Site] :body true}
+  [parent form]
+  ((fn ^{::t/- [t/Any t/Any t/Any :-> s/Bound-Site]} location [file line column]
+     {:form form :file (if (string? file) file (:file parent))
+      :line (if (integer? line) line (:line parent))
+      :column (if (integer? column) column (:column parent))})
+   (:file (meta form)) (:line (meta form)) (:column (meta form))))
+
+(np/defpass fail
+  {:from [s/Bound Site] :to t/Nothing :args [t/Kw t/Str (t/Map t/Kw t/Any)] :body true}
+  [kind message details site]
+  (throw (ex-info message (merge site details {:kind kind}))))
+
+(np/defpass check-visibility
+  {:from [s/Bound Site] :to nil :args [t/AnyVar] :body true}
+  [v site]
+  ;; The public Var field is authoritative; :ns metadata can be changed.
+  (when (and (not (.isPublic ^clojure.lang.Var v))
+             (not= *ns* (clojure.lang.Reflector/getInstanceField v "ns")))
+    (fail :private-var "Cannot access a private Var from another namespace" {:binding (.toSymbol ^clojure.lang.Var v)} site)))
diff --git a/src/com/tailrecursion/blacktide/compiler/feasible.clj b/src/com/tailrecursion/blacktide/compiler/feasible.clj
new file mode 100644
index 0000000..b2a138d
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/feasible.clj
@@ -0,0 +1,22 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.feasible
+  "Fold literal truth tests after source validation. Keep every block so dead
+  source still receives JVM validation."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [typed.clojure :as-alias t]))
+
+(np/defpass terminator {:from [l/CFG Term] :to [l/CFG Term] :body true}
+  [term]
+  (if (and (= :branch (:op term)) (= :literal (:op (:test term))))
+    {:op :jump :target (if (:value (:test term)) (:yes term) (:no term))}
+    term))
+
+(np/defpass block {:from [l/CFG Block] :to [l/CFG Block] :body true}
+  [block] (assoc block :term (terminator (:term block))))
+
+(np/defpass program {:from [l/CFG Program] :to [l/CFG Program] :body true}
+  [program]
+  (assoc program :blocks
+    (reduce-kv (fn [^{::t/- (t/Map l/CFG-Label l/CFG-Block)} out
+                     ^{::t/- l/CFG-Label} id ^{::t/- l/CFG-Block} node]
+                 (assoc out id (block node))) {} (:blocks program))))
diff --git a/src/com/tailrecursion/blacktide/compiler/graph.clj b/src/com/tailrecursion/blacktide/compiler/graph.clj
new file mode 100644
index 0000000..ace2765
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/graph.clj
@@ -0,0 +1,143 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.graph
+  "Check initialization on reachable paths; retain all blocks for native Clojure
+  validation. Liveness carries values through edges without evaluating dead code."
+  (:require [clojure.set :as set]
+            [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [com.tailrecursion.blacktide.compiler.native :as native]
+            [typed.clojure :as-alias t]))
+
+(np/defpass atom-reads {:from [l/CFG Atom] :to (t/Set t/Sym)}
+  [node]
+  :literal #{}
+  :local #{(:id node)})
+
+(np/defpass rhs-reads {:from [l/CFG Rhs] :to (t/Set t/Sym)}
+  [node]
+  :value (atom-reads (:value node))
+  :global #{}
+  :external #{}
+  :var #{}
+  :native (native/reads (:value node))
+  :dispatch (atom-reads (:value (:value node)))
+  :construct (reduce set/union #{} (mapv atom-reads (:items node)))
+  :metadata (set/union (atom-reads (:value node)) (atom-reads (:metadata node)))
+  :convert (atom-reads (:value (:value node)))
+  :host (into #{} (mapcat #(atom-reads (:value %))) (:args node))
+  :invoke (reduce set/union (atom-reads (:function node)) (mapv atom-reads (:args node))))
+
+(np/defpass term-reads {:from [l/CFG Term] :to (t/Set t/Sym)}
+  [term]
+  :jump #{}
+  :branch (atom-reads (:test term))
+  :switch (atom-reads (:test term))
+  :return (atom-reads (:value term))
+  :throw (atom-reads (:value term)))
+
+(np/defpass successors {:from [l/CFG Term] :to (t/Vec l/CFG-Label)}
+  [term]
+  :jump [(:target term)]
+  :branch [(:yes term) (:no term)]
+  :switch (if (seq (:targets term)) (:targets term)
+            (throw (ex-info "Ordinal dispatch requires a destination" {:kind :invalid-graph})))
+  :return []
+  :throw [])
+
+(np/defpass block-facts {:from [l/CFG Block] :to [l/CFG BlockFacts] :body true}
+  [block]
+  (let [[reads defs]
+        (reduce (fn [^{::t/- (t/HVec [(t/Set t/Sym) (t/Set t/Sym)])} acc
+                     ^{::t/- l/CFG-Operation} op]
+                  (let [[reads defs] acc]
+                    [(set/union reads (set/difference (rhs-reads (:value op)) defs))
+                     (conj defs (:target op))])) [#{} #{}] (:ops block))]
+    {:reads (set/union reads (set/difference (term-reads (:term block)) defs))
+     :defs defs :successors (successors (:term block))}))
+
+(np/defpass collect-facts {:from [l/CFG Program] :to [l/CFG Facts] :body true}
+  [program]
+  (reduce-kv (fn [^{::t/- l/CFG-Facts} facts ^{::t/- l/CFG-Label} id ^{::t/- l/CFG-Block} block]
+               (assoc facts id (block-facts block))) {} (:blocks program)))
+
+(np/defpass fact-at {:from [l/CFG Label] :to [l/CFG BlockFacts] :args [l/CFG-Facts] :body true}
+  [facts id]
+  (or (get facts id) (throw (ex-info "Missing control-flow block" {:kind :invalid-graph :block id}))))
+
+(np/defpass validate-edges {:from [l/CFG Program] :to [l/CFG Program] :args [l/CFG-Facts] :body true}
+  [facts program]
+  (do
+    (fact-at facts (:entry program))
+    (doseq [[id fact] facts target (:successors fact)]
+      (when-not (contains? facts target)
+        (throw (ex-info "Dangling control-flow edge" {:kind :invalid-graph :block id :target target}))))
+    program))
+
+(np/defpass reachable {:from [l/CFG Label] :to [l/CFG Labels] :args [l/CFG-Facts] :body true}
+  [facts entry]
+  ((fn ^{::t/- [(t/Vec l/CFG-Label) l/CFG-Labels :-> l/CFG-Labels]} visit [pending seen]
+     (if-let [id (peek pending)]
+       (if (contains? seen id)
+         (recur (pop pending) seen)
+         (recur (into (pop pending) (:successors (fact-at facts id))) (conj seen id)))
+       seen)) [entry] #{}))
+
+(np/defpass predecessors {:from [l/CFG Facts] :to [l/CFG Predecessors] :body true}
+  [facts]
+  (reduce-kv (fn [^{::t/- l/CFG-Predecessors} out ^{::t/- l/CFG-Label} id ^{::t/- l/CFG-BlockFacts} fact]
+               (reduce (fn [^{::t/- l/CFG-Predecessors} out ^{::t/- l/CFG-Label} target]
+                         (assoc out target (conj (get out target #{}) id))) out (:successors fact)))
+             {} facts))
+
+(np/defpass initialized
+  {:from [l/CFG Label] :to [l/CFG Flow] :args [l/CFG-Facts l/CFG-Predecessors] :body true}
+  [facts predecessors entry]
+  (let [universe (reduce set/union #{} (map :defs (vals facts)))
+        initial (reduce (fn [^{::t/- l/CFG-Flow} out ^{::t/- l/CFG-Label} id]
+                          (assoc out id (if (= entry id) #{} universe))) {} (keys facts))]
+    ;; Greatest fixed point: a backedge does not erase initialization on entry.
+    ((fn ^{::t/- [l/CFG-Flow :-> l/CFG-Flow]} solve [known]
+      (let [next (reduce-kv
+                  (fn [^{::t/- l/CFG-Flow} out ^{::t/- l/CFG-Label} id ^{::t/- l/CFG-BlockFacts} _]
+                    (assoc out id
+                      (if (= entry id) #{}
+                        (reduce (fn [^{::t/- (t/Set t/Sym)} acc ^{::t/- l/CFG-Label} pred]
+                                  (set/intersection acc
+                                    (set/union (get known pred #{}) (:defs (fact-at facts pred)))))
+                                universe (get predecessors id #{}))))) {} facts)]
+        (if (= known next) known (recur next)))) initial)))
+
+(np/defpass validate-initialization
+  {:from [l/CFG Facts] :to [l/CFG Facts] :args [l/CFG-Flow] :body true}
+  [known facts]
+  (do
+    (doseq [[id fact] facts]
+      (let [missing (set/difference (:reads fact) (get known id #{}))]
+        (when (seq missing)
+          (throw (ex-info "Control flow reads uninitialized locals"
+                          {:kind :uninitialized-slot :block id :slots missing})))))
+    facts))
+
+(np/defpass liveness {:from [l/CFG Facts] :to [l/CFG Flow] :body true}
+  [facts]
+  ((fn ^{::t/- [l/CFG-Flow :-> l/CFG-Flow]} solve [live]
+    (let [next (reduce-kv
+                (fn [^{::t/- l/CFG-Flow} out ^{::t/- l/CFG-Label} id ^{::t/- l/CFG-BlockFacts} fact]
+                  (let [after (reduce set/union #{} (map #(get live % #{}) (:successors fact)))]
+                    (assoc out id (set/union (:reads fact) (set/difference after (:defs fact)))))) {} facts)]
+      (if (= live next) live (recur next)))) {}))
+
+(np/defpass allocate
+  {:from [l/CFG Program] :to [l/Machine Program] :args [l/CFG-Flow] :body true}
+  [live program]
+  (assoc program :live live :slots (vec (sort (reduce set/union #{} (vals live))))))
+
+(np/defpass analyze {:from [l/CFG Program] :to [l/Machine Program] :body true}
+  [program]
+  (let [facts (collect-facts program)
+        program (validate-edges facts program)
+        seen (reachable facts (:entry program))
+        reachable-facts (select-keys facts seen)]
+    (validate-initialization (initialized reachable-facts (predecessors reachable-facts) (:entry program)) reachable-facts)
+    ;; Even unreachable native bodies must reach Clojure's compiler. Pruning
+    ;; them here suppresses Java call errors in source code.
+    (allocate (liveness facts) program)))
diff --git a/src/com/tailrecursion/blacktide/compiler/host_emit.clj b/src/com/tailrecursion/blacktide/compiler/host_emit.clj
new file mode 100644
index 0000000..ae9cd66
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/host_emit.clj
@@ -0,0 +1,91 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.host-emit
+  "Emit host descriptors with source-typed saved operands. Known nil is retained
+  explicitly; Object prevents boxed storage from inventing a more specific type."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.jvm-languages :as j]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [com.tailrecursion.blacktide.runtime]
+            [typed.clojure :as-alias t]))
+
+(np/defpass global-form {:from [l/Machine Name] :to [l/Machine Code] :body true}
+  [name]
+  ;; A later macro can change :const or :macro metadata after source analysis.
+  (let [v (ns-resolve *ns* name)
+        method (if (and (var? v) (.isDynamic ^clojure.lang.Var v)) 'get 'getRawRoot)]
+    (list '. (list 'var name) method)))
+
+(np/defpass box-form {:from [l/Machine Code] :to [l/Machine Code] :body true}
+  [form]
+  ;; Select Object explicitly: nil must not choose RT.box(Boolean), and callers
+  ;; may supply genuine primitive locals that cannot accept an Object hint.
+  (list (with-meta 'clojure.lang.RT/box {:param-tags ['java.lang.Object]}) form))
+
+(np/defpass typed-form
+  {:from [l/Machine Code] :to [l/Machine Code] :args [j/JVM-Fact] :body true}
+  [fact form]
+  (let [^Class type (:type fact)
+        object-form (with-meta (if (symbol? form) form (apply list form)) {:tag 'java.lang.Object})]
+    (cond
+      (or (nil? type) (= Void/TYPE type)) (list 'do form nil)
+      (and (class? type) (.isPrimitive type) (:primitive? fact))
+      (list (with-meta (symbol "clojure.lang.RT" (str (.getName type) "Cast")) {:param-tags ['java.lang.Object]}) object-form)
+      :else (with-meta (if (symbol? form) form (apply list form))
+                       {:tag (if (class? type) (symbol (.getName type)) 'java.lang.Object)}))))
+
+(np/defpass conversion-form
+  {:from [l/Machine Code] :to [l/Machine Code] :args [j/JVM-Conversion j/JVM-Fact] :body true}
+  [conversion fact form]
+  (let [^Class type (:type conversion)]
+    (cond
+      (not (:parameter? conversion))
+      ;; Validate the receiver before evaluating later operands.
+      (list 'java.lang.Class/.cast (list 'quote type) (box-form form))
+      (.isPrimitive type)
+      (list (with-meta 'clojure.lang.RT/box {:param-tags [type]}) (typed-form fact form))
+      :else
+      (let [local (gensym "parameter__")]
+        (list 'let* [(with-meta local {:tag (symbol (.getName type))})
+                     (list (with-meta 'clojure.lang.RT/box {:param-tags ['java.lang.Object]}) form)]
+              (list 'java.lang.Class/.cast (list 'quote type) local))))))
+
+
+(np/defpass host-form
+  {:from [j/JVM Operation] :to [l/Machine Code] :args [(t/Vec l/Machine-Code)]}
+  [args operation]
+  :keyword-site (list 'com.tailrecursion.blacktide.runtime/keyword-site (:key operation))
+  :protocol
+  (let [locals (mapv (fn [_] (gensym "protocol__")) args)
+        receiver (first locals) function (second locals) arguments (subvec locals 2)
+        method (:method operation)
+        fallback (list 'if (list 'clojure.core/or (list 'clojure.core/nil? function) (list 'clojure.core/instance? clojure.lang.IFn function))
+                       (list* function receiver arguments)
+                       (list 'throw (list 'new 'java.lang.IncompatibleClassChangeError "Protocol method root does not implement clojure.lang.IFn")))
+        call (if-let [class (:class method)]
+               (list 'if (list 'clojure.core/instance? class receiver)
+                     (list* (with-meta (symbol (.getName ^Class class) (str "." (:member method))) {:param-tags (:parameters method)}) receiver arguments)
+                     fallback) fallback)]
+    ;; Even an invalid fallback root is checked only after all source operands.
+    (list 'let* (vec (mapcat (fn [id value] [id (box-form value)]) locals args)) call))
+  :direct (let [params (:parameters operation)
+                fixed (if (:variadic? operation) (dec (count params)) (count params))
+                args (if (:variadic? operation)
+                       (conj (subvec args 0 fixed)
+                             (list 'clojure.lang.ArraySeq/create (list 'clojure.lang.RT/object_array (subvec args fixed)))) args)]
+            (list* (with-meta (symbol (.getName ^Class (:class operation)) "invokeStatic") {:param-tags params}) args))
+  :instanceof (list 'clojure.core/instance? (:class operation) (first args))
+  :adapt (let [local (gensym "hinted__")]
+           (list 'let* [(with-meta local {:tag (symbol (.getName ^Class (:class operation)))}) (first args)] local))
+  :method-value (:name operation)
+  :static-field (symbol (.getName ^Class (:class operation)) (name (:member operation)))
+  :constructor (if-let [tags (:tags operation)]
+                 (list* (with-meta (symbol (.getName ^Class (:class operation)) "new") {:param-tags tags}) args)
+                 (list* 'new (symbol (.getName ^Class (:class operation))) args))
+  :static (list* (with-meta (symbol (.getName ^Class (:class operation)) (name (:member operation)))
+                           (when-let [tags (:tags operation)] {:param-tags tags})) args)
+  :instance (if-let [class (:class operation)]
+              (list* (with-meta (symbol (.getName ^Class class) (str "." (:member operation)))
+                               (when-let [tags (:tags operation)] {:param-tags tags})) args)
+              (case (:mode operation)
+                :method (list '. (first args) (list* (:member operation) (rest args)))
+                :member (list '. (first args) (:member operation))
+                :field (list '. (first args) (symbol (str "-" (:member operation)))))))
diff --git a/src/com/tailrecursion/blacktide/compiler/invariants.clj b/src/com/tailrecursion/blacktide/compiler/invariants.clj
new file mode 100644
index 0000000..f6092ae
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/invariants.clj
@@ -0,0 +1,28 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.invariants
+  "Remove loop parameters that only forward an outer lexical value. Their
+  initializers remain in place, and recur keeps exactly the retained parameters."
+  (:require [clojure.set :as set]
+            [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.structured-languages :as s]
+            [typed.clojure :as-alias t]))
+
+(np/defpass assigned {:from [s/Joined Expr] :to (t/Set t/Sym)}
+  [node]
+  :bind (conj (assigned (:body node)) (:target (:binding node)))
+  :join (conj (set/union (assigned (:value node)) (assigned (:body node))) (:target node))
+  :branch (set/union (assigned (:yes node)) (assigned (:no node)))
+  :switch (into #{} (mapcat assigned) (:arms node))
+  :loop (into (assigned (:body node)) (:slots node))
+  :recur #{} :return #{} :throw #{})
+
+(np/defpass expression {:from [s/Joined Expr] :to [s/Joined Expr] :args [(t/Set t/Sym)]}
+  [invariants node]
+  :bind (assoc node :body (expression invariants (:body node)))
+  :join (assoc node :value (expression invariants (:value node)) :body (expression invariants (:body node)))
+  :branch (assoc node :yes (expression invariants (:yes node)) :no (expression invariants (:no node)))
+  :switch (assoc node :arms (mapv #(expression invariants %) (:arms node)))
+  :loop (let [invariants (set/difference (set (:slots node)) (assigned (:body node)))]
+          (assoc node :slots (filterv #(not (contains? invariants %)) (:slots node))
+                      :body (expression invariants (:body node))))
+  :recur (assoc node :slots (filterv #(not (contains? invariants %)) (:slots node)))
+  :return node :throw node)
diff --git a/src/com/tailrecursion/blacktide/compiler/joins.clj b/src/com/tailrecursion/blacktide/compiler/joins.clj
new file mode 100644
index 0000000..141cc29
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/joins.clj
@@ -0,0 +1,71 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.joins
+  "Share acyclic branch continuations with at most one escaping definition.
+  Every incoming path must define the result. Postdominators nominate exits;
+  region proofs reject cycles and incomplete paths before recovery."
+  (:require [clojure.set :as set]
+            [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [com.tailrecursion.blacktide.compiler.analysis-languages :as a]
+            [com.tailrecursion.blacktide.compiler.graph :as graph]
+            [typed.clojure :as-alias t]))
+
+(np/defpass postdominators {:from [l/Machine Program] :to [a/Planned Postdominators] :body true}
+  [machine]
+  (let [labels (set (keys (:blocks machine)))]
+    ((fn ^{::t/- [a/Planned-Postdominators :-> a/Planned-Postdominators]} solve [known]
+       (let [next (reduce-kv
+                    (fn [^{::t/- a/Planned-Postdominators} out ^{::t/- l/Machine-Label} id
+                         ^{::t/- l/Machine-Block} block]
+                      (let [successors (graph/successors (:term block))
+                            common (if (seq successors)
+                                     (reduce set/intersection labels (map #(get known % #{}) successors)) #{})]
+                        (assoc out id (conj common id)))) {} (:blocks machine))]
+         (if (= known next) known (recur next)))) (zipmap labels (repeat labels)))))
+
+(np/defpass region
+  {:from [l/Machine Label] :to (t/Option a/Planned-Region)
+   :args [l/Machine-Program l/Machine-Label] :body true}
+  [machine stop id]
+  ;; Prove blocks only after every successor is proved. Each block contributes
+  ;; once; shared paths do not exhaust a traversal budget. Cycles never qualify.
+  ((fn ^{::t/- [a/Planned-Regions :-> (t/Option a/Planned-Region)]} solve [known]
+     (let [next (reduce-kv
+                  (fn [^{::t/- a/Planned-Regions} out ^{::t/- l/Machine-Label} label
+                       ^{::t/- l/Machine-Block} block]
+                    (let [successors (graph/successors (:term block))]
+                      (if (and (not (contains? out label)) (seq successors)
+                               (every? #(contains? out %) successors))
+                        (let [own (set (map :target (:ops block)))
+                              regions (mapv #(get out % {:definite #{} :changed #{}}) successors)]
+                          (assoc out label
+                            {:definite (into own (reduce set/intersection (map :definite regions)))
+                             :changed (into own (mapcat :changed) regions)})) out))) known (:blocks machine))]
+       (if-let [proof (get next id)] proof
+         (when (not= known next) (recur next))))) {stop {:definite #{} :changed #{}}}))
+
+(np/defpass candidate
+  {:from [l/Machine Label] :to (t/Option a/Planned-Join)
+   :args [l/Machine-Program a/Planned-Postdominators] :body true}
+  [machine known id]
+  (when-let [block (get (:blocks machine) id)]
+    (let [term (:term block)
+          exits (sort-by (fn [^{::t/- l/Machine-Label} target] (- (count (get known target #{}))))
+                         (disj (get known id #{}) id))]
+      (when (contains? #{:branch :switch} (:op term))
+        (when-let [target (first exits)]
+          ;; Only the nearest postdominator can form a nested lexical join.
+          ;; Ignore the branch's preceding definitions when proving its result.
+          (let [branch-machine (update machine :blocks assoc id (assoc block :ops []))]
+            (when-let [proof (region branch-machine target id)]
+              (let [outputs (set/intersection (:changed proof) (get (:live machine) target #{}))
+                    result (or (first outputs) (first (sort (:definite proof))))]
+                (when (and (<= (count outputs) 1) (symbol? result) (contains? (:definite proof) result))
+                  {:target target :result result})))))))))
+
+(np/defpass plan {:from [a/Analysis Program] :to [a/Planned Program] :body true}
+  [analysis]
+  (let [machine (:machine analysis) known (postdominators machine)]
+    (assoc analysis :joins
+      (reduce (fn [^{::t/- a/Planned-Joins} out ^{::t/- l/Machine-Label} id]
+                (if-let [join (candidate machine known id)] (assoc out id join) out))
+              {} (keys (:blocks machine))))))
diff --git a/src/com/tailrecursion/blacktide/compiler/jvm.clj b/src/com/tailrecursion/blacktide/compiler/jvm.clj
new file mode 100644
index 0000000..14614fc
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/jvm.clj
@@ -0,0 +1,217 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.jvm
+  "Resolve source JVM facts without evaluating expressions or running the native
+  analyzer. Method inference follows the pinned Clojure overload rules."
+  (:refer-clojure :exclude [methods])
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.jvm-languages :as l]
+            [typed.clojure :as-alias t]))
+
+(np/defpass resolved-class
+  {:from [l/JVM Raw] :to (t/Option java.lang.Class) :body true}
+  [name]
+  (cond (class? name) name
+        (symbol? name) (let [v (ns-resolve *ns* name)] (when (class? v) v))))
+
+(np/defpass source-tag {:from [l/JVM Raw] :to (t/Option t/Sym) :body true}
+  [form]
+  ;; Compiler.tagOf ignores all other metadata values, including Class objects.
+  (let [tag (:tag (meta form))] (cond (symbol? tag) tag (string? tag) (symbol tag))))
+
+(np/defpass tag-class
+  {:from [l/JVM Raw] :to (t/Option java.lang.Class) :body true}
+  [tag]
+  (when (some? tag)
+    (or (when (and (symbol? tag) (nil? (namespace tag))) (clojure.lang.Compiler$HostExpr/maybeSpecialTag tag))
+        (when (symbol? tag) (clojure.lang.Compiler$HostExpr/maybeArrayClass tag))
+        (when (string? tag) (clojure.lang.RT/classForNameNonLoading tag))
+        (resolved-class tag)
+        (throw (IllegalArgumentException. (str "Unable to resolve classname: " tag))))))
+
+(np/defpass fact
+  {:from [l/JVM Type] :to [l/JVM Fact] :args [t/Bool l/JVM-Seed] :body true}
+  [primitive? seed type]
+  (assoc seed :type type :primitive? primitive? :hint-error nil))
+
+(np/defpass value-type {:from [l/JVM Fact] :to [l/JVM Type] :body true}
+  [fact]
+  (if-let [^String error (:hint-error fact)] (throw (UnsupportedOperationException. error)) (:type fact)))
+
+(np/defpass hint-conflict
+  {:from [l/JVM Type] :to (t/Option t/Str) :args [(t/Option java.lang.Class)] :body true}
+  [^Class hint ^Class type]
+  (when (and hint (class? type) (.isPrimitive hint) (.isPrimitive type) (not= hint type)
+             (not (and (#{"int" "byte" "short" "char"} (.getName hint))
+                       (#{"int" "byte" "short" "char"} (.getName type)))))
+    (str "Cannot coerce " type " to " hint ", use a cast instead")))
+
+(np/defpass visible-class
+  {:from [l/JVM Type] :to [l/JVM Type] :body true}
+  [^Class class]
+  (if (and (class? class) (java.lang.reflect.Modifier/isPublic (.getModifiers class))) class :unknown))
+
+(np/defpass literal-type {:from [l/JVM Raw] :to [l/JVM Type] :body true}
+  [value]
+  (cond
+    (nil? value) nil
+    (or (instance? Long value) (instance? Integer value)) Long/TYPE
+    (instance? Double value) Double/TYPE
+    (and (coll? value) (empty? value) (nil? (meta value)))
+    (cond (vector? value) clojure.lang.IPersistentVector
+          (map? value) clojure.lang.IPersistentMap
+          (set? value) clojure.lang.IPersistentSet
+          :else clojure.lang.IPersistentList)
+    (instance? clojure.lang.APersistentVector value) clojure.lang.APersistentVector
+    (instance? clojure.lang.APersistentMap value) clojure.lang.APersistentMap
+    (instance? clojure.lang.APersistentSet value) clojure.lang.APersistentSet
+    :else (visible-class (class value))))
+
+(np/defpass join-type {:from [l/JVM Type] :to [l/JVM Type] :args [l/JVM-Type] :body true}
+  [a b]
+  (cond (= a b) a
+        (and (nil? a) (class? b) (not (.isPrimitive ^Class b))) b
+        (and (nil? b) (class? a) (not (.isPrimitive ^Class a))) a
+        :else :unknown))
+
+(np/defpass methods
+  {:from [l/JVM Raw] :to [l/JVM Methods] :args [java.lang.Class t/Int t/Bool] :body true}
+  [class arity static? member]
+  ;; Reflector's raw Java List is an external API boundary; refine its elements.
+  (reduce (fn [^{::t/- l/JVM-Methods} out ^{::t/- t/Any} item]
+            (if (instance? java.lang.reflect.Method item) (conj out item) out))
+          [] (clojure.lang.Reflector/getMethods class (int arity) (clojure.lang.Compiler/munge (str member)) static?)))
+
+(np/defpass static-method?
+  {:from [l/JVM Raw] :to t/Bool :args [java.lang.Class] :body true}
+  [^Class class member]
+  (let [methods (.getMethods class) name (clojure.lang.Compiler/munge (str member))]
+    (boolean
+      (some (fn [^{::t/- t/Int} index]
+              (let [^java.lang.reflect.Method method (aget methods (int index))]
+                (and (= name (.getName method)) (java.lang.reflect.Modifier/isStatic (.getModifiers method)))))
+            (range (alength methods))))))
+
+(np/defpass return-type {:from [l/JVM Method] :to java.lang.Class :body true}
+  [member]
+  (if (instance? java.lang.reflect.Method member)
+    (.getReturnType ^java.lang.reflect.Method member) (.getDeclaringClass ^java.lang.reflect.Constructor member)))
+
+(np/defpass constructors
+  {:from [l/JVM Raw] :to [l/JVM Methods] :args [java.lang.Class t/Int] :body true}
+  [^Class class arity _]
+  (let [constructors (.getConstructors class)]
+    (filterv (fn [^{::t/- l/JVM-Method :tag java.lang.reflect.Executable} member] (= arity (.getParameterCount member)))
+             (mapv (fn [^{::t/- t/Int} index] (aget constructors (int index))) (range (alength constructors))))))
+
+(np/defpass parameters
+  {:from [l/JVM Method] :to (t/Vec java.lang.Class) :body true}
+  [^java.lang.reflect.Executable method]
+  (let [params (.getParameterTypes method)]
+    (mapv (fn [^{::t/- t/Int} index] (aget params (int index))) (range (alength params)))))
+
+(np/defpass select-method
+  {:from [l/JVM Methods] :to (t/Option l/JVM-Method) :args [l/JVM-Types l/JVM-Tags] :body true}
+  [types tags methods]
+  (if tags
+    (let [tags (mapv #(when-not (= '_ %) (tag-class %)) tags)
+          matches (filter (fn [^{::t/- l/JVM-Method} method]
+                            (and (not (.isSynthetic ^java.lang.reflect.Executable method)) (= (count tags) (.getParameterCount ^java.lang.reflect.Executable method))
+                                 (every? true? (map #(or (nil? %1) (= %1 %2)) tags (parameters method))))) methods)]
+      (if (= 1 (count matches)) (first matches)
+          (throw (IllegalArgumentException. "param-tags do not resolve a single method"))))
+    (if (= 1 (count methods))
+      (first methods)
+      (let [result
+            (reduce
+              (fn [^{::t/- l/JVM-Selection} selection ^{::t/- l/JVM-Method} method]
+                (let [params (parameters method)
+                      exact? (= types params)
+                      match? (every? true? (map (fn [^{::t/- Class :tag Class} p ^{::t/- l/JVM-Type} a]
+                                                 (if (nil? a) (not (.isPrimitive p))
+                                                   (clojure.lang.Reflector/paramArgTypeMatch p (if (= a :unknown) Object a)))) params types))
+                      previous (:method selection)]
+                  (cond
+                    exact? (if (or (not (:exact? selection)) (nil? previous)
+                                   (.isAssignableFrom ^Class (return-type previous) (return-type method)))
+                             {:method method :exact? true :tied? false}
+                             (assoc selection :tied? false))
+                    (and match? (not (:exact? selection)))
+                    (cond (nil? previous) (assoc selection :method method)
+                          (clojure.lang.Compiler/subsumes (.getParameterTypes ^java.lang.reflect.Executable method) (.getParameterTypes ^java.lang.reflect.Executable previous))
+                          (assoc selection :method method :tied? false)
+                          (= params (parameters previous))
+                          (if (.isAssignableFrom ^Class (return-type previous) (return-type method))
+                            (assoc selection :method method) selection)
+                          (not (clojure.lang.Compiler/subsumes (.getParameterTypes ^java.lang.reflect.Executable previous) (.getParameterTypes ^java.lang.reflect.Executable method)))
+                          (assoc selection :tied? true)
+                          :else selection)
+                    :else selection))) {:method nil :exact? false :tied? false} methods)]
+        (if (:tied? result) (throw (IllegalArgumentException. "More than one matching method found")) (:method result))))))
+
+(np/defpass public-member
+  {:from [l/JVM Raw] :to (t/Option l/JVM-Method) :body true}
+  [member]
+  (cond
+    (instance? java.lang.reflect.Constructor member) member
+    (instance? java.lang.reflect.Method member)
+    (let [class (.getDeclaringClass ^java.lang.reflect.Method member)]
+      (if (java.lang.reflect.Modifier/isPublic (.getModifiers ^Class class)) member
+          (clojure.lang.Reflector/getAsMethodOfPublicBase class member)))))
+
+(np/defpass host-type
+  {:from [l/JVM Operation] :to [l/JVM Type] :args [l/JVM-Types]}
+  [types operation]
+  :keyword-site com.tailrecursion.blacktide.runtime.KeywordSite
+  :protocol Object
+  :direct (:return operation)
+  :instanceof Boolean/TYPE
+  :adapt (:class operation)
+  :constructor (:class operation)
+  :method-value clojure.lang.AFn
+  :static-field (when-let [field (clojure.lang.Reflector/getField (:class operation) (name (:member operation)) true)]
+                  (.getType field))
+  :static (if-let [method (select-method types (:tags operation)
+                                        (methods (:class operation) (count types) true (:member operation)))]
+            (return-type method) :unknown)
+  :instance
+  (let [class (or (:class operation) (when (class? (first types)) (first types)))
+        args (subvec types 1)]
+    (if (class? class)
+      (let [methods (methods class (count args) false (:member operation))
+            field? (and (empty? args) (or (= :field (:mode operation))
+                                          (and (= :member (:mode operation)) (empty? methods))))]
+        (if field?
+          (if-let [field (clojure.lang.Reflector/getField class (name (:member operation)) false)] (.getType field) :unknown)
+          (if-let [method (public-member (select-method args (:tags operation) methods))] (return-type method) :unknown)))
+      :unknown)))
+
+(np/defpass prepare-call
+  {:from [l/JVM Operation] :to [l/JVM Plan] :args [l/JVM-Types] :body true}
+  [types operation]
+  (let [unchanged {:operation operation :conversions (mapv (fn [_] nil) types)}]
+    (case (:op operation)
+      (:adapt :instanceof :method-value :static-field :protocol :keyword-site) unchanged
+      :direct (let [params (:parameters operation)
+                    fixed (if (:variadic? operation) (pop params) params)]
+                {:operation operation
+                 :conversions (into (mapv (fn [type] {:type type :parameter? true}) fixed)
+                                    (repeat (- (count types) (count fixed)) nil))})
+      :constructor
+      (if-let [member (select-method types (:tags operation) (constructors (:class operation) (count types) nil))]
+        {:operation (cond-> operation (:tags operation) (assoc :tags (parameters member)))
+         :conversions (mapv (fn [type] {:type type :parameter? true}) (parameters member))} unchanged)
+      :static
+      (if-let [member (select-method types (:tags operation) (methods (:class operation) (count types) true (:member operation)))]
+        {:operation (cond-> operation (:tags operation) (assoc :tags (parameters member)))
+         :conversions (mapv (fn [type] {:type type :parameter? true}) (parameters member))} unchanged)
+      :instance
+      (let [class (or (:class operation) (when (class? (first types)) (first types))) args (subvec types 1)]
+        (if (class? class)
+          (let [members (methods class (count args) false (:member operation))
+                field? (and (empty? args) (or (= :field (:mode operation))
+                                              (and (= :member (:mode operation)) (empty? members))))]
+            (if field? unchanged
+              (if-let [member (public-member (select-method args (:tags operation) members))]
+                (let [class (.getDeclaringClass ^java.lang.reflect.Executable member)]
+                  {:operation (cond-> (assoc operation :class class :mode :method) (:tags operation) (assoc :tags (parameters member)))
+                   :conversions (into [{:type class :parameter? false}]
+                                      (mapv (fn [type] {:type type :parameter? true}) (parameters member)))}) unchanged))) unchanged)))))
diff --git a/src/com/tailrecursion/blacktide/compiler/jvm_languages.clj b/src/com/tailrecursion/blacktide/compiler/jvm_languages.clj
new file mode 100644
index 0000000..7a04a91
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/jvm_languages.clj
@@ -0,0 +1,35 @@
+(ns com.tailrecursion.blacktide.compiler.jvm-languages
+  "JVM facts and host operation descriptors contain no executable source children.
+  Unknown type, known nil and a known JVM class are distinct facts."
+  (:require [com.tailrecursion.nanopass :as np]
+            [typed.clojure :as-alias t]))
+
+(np/deflanguage JVM
+  {Raw t/Any
+   Type (t/U ':unknown nil java.lang.Class)
+   Seed (t/HMap :mandatory {:hint Raw :var-meta (t/Map t/Any t/Any)} :complete? true)
+   Fact (t/HMap :mandatory {:hint Raw :var-meta (t/Map t/Any t/Any)
+                            :type Type :primitive? t/Bool :hint-error (t/Option t/Str)} :complete? true)
+   Types (t/Vec Type)
+   Tags (t/Option (t/Vec Raw))
+   Mode (t/U ':method ':member ':field)
+   Protocol (t/HMap :mandatory {:class (t/Option java.lang.Class) :member (t/Option t/Sym)
+                                 :parameters (t/Vec java.lang.Class)} :complete? true)
+   Operation (t/U (t/HMap :mandatory {:op ':keyword-site :key t/Kw} :complete? true)
+                  (t/HMap :mandatory {:op ':protocol :method Protocol} :complete? true)
+                  (t/HMap :mandatory {:op ':direct :class java.lang.Class :parameters (t/Vec java.lang.Class)
+                                                    :variadic? t/Bool :return java.lang.Class} :complete? true)
+                  (t/HMap :mandatory {:op ':instanceof :class java.lang.Class} :complete? true)
+                  (t/HMap :mandatory {:op ':adapt :class java.lang.Class} :complete? true)
+                  (t/HMap :mandatory {:op ':constructor :class java.lang.Class :tags Tags} :complete? true)
+                  (t/HMap :mandatory {:op ':static :class java.lang.Class :member t/Sym :tags Tags} :complete? true)
+                  (t/HMap :mandatory {:op ':instance :class (t/Option java.lang.Class) :member t/Sym
+                                      :mode Mode :tags Tags} :complete? true)
+                  (t/HMap :mandatory {:op ':static-field :class java.lang.Class :member t/Sym} :complete? true)
+                  (t/HMap :mandatory {:op ':method-value :name t/Sym} :complete? true))
+   Syntax (t/HMap :mandatory {:operation Operation :operands (t/Vec Raw)} :complete? true)
+   Method (t/U java.lang.reflect.Method java.lang.reflect.Constructor)
+   Methods (t/Vec Method)
+   Conversion (t/HMap :mandatory {:type java.lang.Class :parameter? t/Bool} :complete? true)
+   Plan (t/HMap :mandatory {:operation Operation :conversions (t/Vec (t/Option Conversion))} :complete? true)
+   Selection (t/HMap :mandatory {:method (t/Option Method) :exact? t/Bool :tied? t/Bool} :complete? true)})
diff --git a/src/com/tailrecursion/blacktide/compiler/languages.clj b/src/com/tailrecursion/blacktide/compiler/languages.clj
new file mode 100644
index 0000000..92f9341
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/languages.clj
@@ -0,0 +1,54 @@
+(ns com.tailrecursion.blacktide.compiler.languages
+  "Loophole's backend languages. Stable operands are separate from evaluations;
+  allocated machines explicitly name the values live at every block entry."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as s]
+            [typed.clojure :as-alias t]
+            [com.tailrecursion.blacktide.compiler.jvm-languages :as j]))
+
+(np/deflanguage Machine
+  {Atom (t/U (t/HMap :mandatory {:op ':literal :value t/Any} :complete? true)
+             (t/HMap :mandatory {:op ':local :id t/Sym} :complete? true))
+   Operand (t/HMap :mandatory {:value Atom :jvm j/JVM-Fact} :complete? true)
+   Rhs (t/U (t/HMap :mandatory {:op ':convert :conversion j/JVM-Conversion :value Operand} :complete? true)
+           (t/HMap :mandatory {:op ':dispatch :value Operand :spec s/Bound-CaseSpec} :complete? true)
+           (t/HMap :mandatory {:op ':native :value s/Native-Expr} :complete? true)
+           (t/HMap :mandatory {:op ':host :operation j/JVM-Operation :args (t/Vec Operand)} :complete? true)
+            (t/HMap :mandatory {:op ':value :value Atom} :complete? true)
+            (t/HMap :mandatory {:op ':global :name t/Sym} :complete? true)
+            (t/HMap :mandatory {:op ':external :name t/Sym :jvm j/JVM-Fact} :complete? true)
+            (t/HMap :mandatory {:op ':var :name t/Sym} :complete? true)
+            (t/HMap :mandatory {:op ':construct :kind s/Bound-CollectionKind :items (t/Vec Atom) :unique? t/Bool} :complete? true)
+            (t/HMap :mandatory {:op ':metadata :value Atom :metadata Atom} :complete? true)
+            (t/HMap :mandatory {:op ':invoke :function Atom :args (t/Vec Atom)} :complete? true))
+   Operation (t/HMap :mandatory {:target t/Sym :value Rhs} :complete? true)
+   Term (t/U (t/HMap :mandatory {:op ':jump :target Label} :complete? true)
+             (t/HMap :mandatory {:op ':switch :test Atom :targets (t/Vec Label)} :complete? true)
+             (t/HMap :mandatory {:op ':branch :test Atom :yes Label :no Label} :complete? true)
+             (t/HMap :mandatory {:op ':return :value Atom} :complete? true)
+             (t/HMap :mandatory {:op ':throw :value Atom} :complete? true))
+   Block (t/HMap :mandatory {:ops (t/Vec Operation) :term Term} :complete? true)
+   Program (t/HMap :mandatory {:entry Label :slots (t/Vec t/Sym)
+                               :blocks (t/Map Label Block) :live (t/Map Label (t/Set t/Sym))} :complete? true)
+   Label t/Int
+   Name t/Sym
+   Code (t/U t/Sym (t/Seq t/Any))})
+
+(np/derive-language CFG Machine
+  {:replace
+   {Program (t/HMap :mandatory {:entry Label :blocks (t/Map Label Block)} :complete? true)
+    BlockFacts (t/HMap :mandatory {:reads (t/Set t/Sym) :defs (t/Set t/Sym)
+                                  :successors (t/Vec Label)} :complete? true)
+    Facts (t/Map Label BlockFacts)
+    Labels (t/Set Label)
+    Flow (t/Map Label (t/Set t/Sym))
+    Predecessors (t/Map Label Labels)}})
+
+(np/derive-language Symbolic CFG
+  {:add {Term [(t/HMap :mandatory {:op ':transfer :name t/Sym :site s/Bound-Site} :complete? true)]}
+   :replace
+   {LabelTable (t/Map t/Sym Label)
+    Program (t/HMap :mandatory {:entry Label :blocks (t/Map Label Block) :labels LabelTable} :complete? true)
+    Builder (t/HMap :mandatory {:supply s/Bound-Supply :ops (t/Vec Operation) :next Label :current Label
+                                :blocks (t/Map Label Block) :labels LabelTable
+                                :loops (t/Map t/Sym Label)} :complete? true)}})
diff --git a/src/com/tailrecursion/blacktide/compiler/loop_facts.clj b/src/com/tailrecursion/blacktide/compiler/loop_facts.clj
new file mode 100644
index 0000000..74c805f
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/loop_facts.clj
@@ -0,0 +1,186 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.loop-facts
+  "Recover source loop representations using Clojure's monotone boxing analysis.
+  Reanalyze expanded bindings in order without repeating user macros. Native
+  syntax retains its initializers; lowered loops materialize the conversions."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as s]
+            [com.tailrecursion.blacktide.compiler.jvm-languages :as j]
+            [com.tailrecursion.blacktide.compiler.jvm :as jvm]
+            [com.tailrecursion.blacktide.compiler.errors :as errors]
+            [com.tailrecursion.blacktide.compiler.source-jvm :as facts]
+            [typed.clojure :as-alias t]))
+
+(np/defpass children {:from [s/Bound Expr] :to [s/Bound Exprs] :body true}
+  [expr]
+  (let [node (:node expr)]
+    (case (:op node)
+      :if [(:test node) (:then node) (:else node)]
+      :case (into [(:selector node)] (:arms node))
+      (:dispatch :throw) [(:value node)]
+      :do (:forms node)
+      :collection (cond-> (:items node) (:metadata node) (conj (:metadata node)))
+      (:host :recur) (:args node)
+      :invoke (into [(:function node)] (:args node))
+      (:let :loop) (conj (mapv :init (:bindings node)) (:body node))
+      (:setq :psetq) (mapv :value (:pairs node))
+      [])))
+
+
+(np/defpass primitive {:from [j/JVM Fact] :to (t/Option java.lang.Class) :body true}
+  [fact]
+  (let [type (:type fact)]
+    (when (and (:primitive? fact) (class? type) (.isPrimitive ^Class type) (not= Void/TYPE type)) type)))
+
+(np/defpass inferred {:from [s/Bound Expr] :to [s/Bound Expr] :args [s/Bound-Node] :body true}
+  [node expr]
+  (assoc expr :node node :jvm (facts/infer {:hint (:hint (:jvm expr)) :var-meta (:var-meta (:jvm expr))} node)))
+
+(np/defpass converted {:from [s/Bound Expr] :to [s/Bound Expr] :args [java.lang.Class] :body true}
+  [^Class type expr]
+  (let [node {:op :host :operation {:op :static :class clojure.lang.RT
+                                   :member (symbol (str (.getName type) "Cast")) :tags [type]}
+             :args [expr]}]
+    (assoc expr :node node :jvm (facts/infer {:hint nil :var-meta {}} node))))
+
+(np/defpass boxed {:from [s/Bound Expr] :to [s/Bound Expr] :body true}
+  [expr]
+  (let [node {:op :host :operation {:op :static :class clojure.lang.RT :member 'box :tags nil} :args [expr]}]
+    ;; Reanalysis can select RT.box(Object), rather than RT.box(long/double).
+    (assoc expr :node node :jvm (facts/infer {:hint nil :var-meta {}} node))))
+
+(np/defpass initializer {:from [s/Bound Expr] :to [s/Bound Expr] :args [t/Bool] :body true}
+  [box? init]
+  (let [type (primitive (:jvm init))]
+    (if box? (boxed init)
+      (if-let [promoted (cond (= type Integer/TYPE) Long/TYPE (= type Float/TYPE) Double/TYPE)]
+        (converted promoted init) init))))
+
+(declare expression solve)
+(np/defpass bindings
+  {:from [s/Bound Bindings] :to (t/HVec [(t/Map t/Sym s/Bound-Local) s/Bound-Bindings])
+   :args [(t/Map t/Sym s/Bound-Local) t/Bool (t/Set t/Sym)] :body true}
+  [env loop? boxed-ids originals]
+  (reduce (fn [^{::t/- (t/HVec [(t/Map t/Sym s/Bound-Local) s/Bound-Bindings])} state
+               ^{::t/- s/Bound-Binding} binding]
+            (let [[env out] state init (expression env (:init binding)) local (:local binding)
+                  effective (if loop? (initializer (contains? boxed-ids (:id local)) init) init)
+                  value (facts/binding-facts (:name local) (:mutable? local) (:jvm effective))
+                  local (assoc local :jvm value)]
+              [(assoc env (:id local) local) (conj out {:local local :init init})])) [env []] originals))
+
+(np/defpass expression
+  {:from [s/Bound Expr] :to [s/Bound Expr] :args [(t/Map t/Sym s/Bound-Local)] :body true}
+  [env expr]
+  (let [node (:node expr)
+        node (case (:op node)
+               :local (assoc node :local (get env (:id (:local node)) (:local node)))
+               :if (assoc node :test (expression env (:test node))
+                               :then (expression env (:then node)) :else (expression env (:else node)))
+               :case (assoc node :selector (expression env (:selector node))
+                                 :arms (mapv #(expression env %) (:arms node)))
+               (:dispatch :throw) (assoc node :value (expression env (:value node)))
+               :do (assoc node :forms (mapv #(expression env %) (:forms node)))
+               :collection (assoc node :items (mapv #(expression env %) (:items node))
+                                       :metadata (some->> (:metadata node) (expression env)))
+               :host (assoc node :args (mapv #(expression env %) (:args node)))
+               :recur (assoc node :args (mapv #(expression env %) (:args node))
+                                  :target (assoc (:target node) :bindings
+                                            (mapv #(get env (:id %) %) (:bindings (:target node)))))
+               :invoke (assoc node :function (expression env (:function node))
+                                   :args (mapv #(expression env %) (:args node)))
+               :let (let [[inner values] (bindings env false #{} (:bindings node))]
+                                (assoc node :bindings values :body (expression inner (:body node))))
+               :loop (:node (first (solve env expr)))
+               (:setq :psetq) (assoc node :pairs (mapv #(assoc % :value (expression env (:value %))) (:pairs node)))
+               node)]
+    (inferred node expr)))
+
+(np/defpass recurs {:from [s/Bound Expr] :to [s/Bound Exprs] :args [t/Sym] :body true}
+  [target expr]
+  (if (and (= :recur (:op (:node expr))) (= target (:id (:target (:node expr)))))
+    [expr] (into [] (mapcat #(recurs target %)) (children expr))))
+
+(np/defpass compatible? {:from [j/JVM Fact] :to t/Bool :args [java.lang.Class] :body true}
+  [type fact]
+  (let [actual (primitive fact)]
+    (or (= type actual) (and (= type Long/TYPE) (contains? #{Integer/TYPE Short/TYPE Byte/TYPE Character/TYPE} actual))
+        (and (= type Double/TYPE) (= actual Float/TYPE)))))
+
+(np/defpass solve
+  {:from [s/Bound Expr] :to (t/HVec [s/Bound-Expr (t/Set t/Sym)])
+   :args [(t/Map t/Sym s/Bound-Local)] :body true}
+  [env expr]
+  (let [node (:node expr)]
+    (if-not (= :loop (:op node)) (throw (IllegalStateException. "Expected source loop"))
+      ((fn ^{::t/- [(t/Set t/Sym) :-> (t/HVec [s/Bound-Expr (t/Set t/Sym)])]} fixed [boxed-ids]
+         (let [[env values] (bindings env true boxed-ids (:bindings node))
+               body (expression env (:body node))
+               mismatches (reduce
+                            (fn [^{::t/- (t/Set t/Sym)} out ^{::t/- s/Bound-Expr} edge]
+                              (into out (keep identity)
+                                (map (fn [^{::t/- s/Bound-Binding} binding ^{::t/- s/Bound-Expr} arg]
+                                       (let [local (:local binding) type (primitive (:jvm local))]
+                                         (when (and type (contains? #{Long/TYPE Double/TYPE} type)
+                                                    (not (compatible? type (:jvm arg)))) (:id local))))
+                                     values (:args (:node edge))))) boxed-ids (recurs (:id node) body))]
+           (if (not= boxed-ids mismatches) (recur mismatches)
+             [(inferred (assoc node :bindings values :body body) expr) boxed-ids]))) #{}))))
+
+;; RecurExpr's parser admits byte/short/char to long, but its emitter rejects
+;; them. Preserve that validation before replacing recur with graph edges.
+(np/defpass recur-error
+  {:from [s/Bound Expr] :to (t/Option (t/HVec [s/Bound-Local s/Bound-Expr])) :body true}
+  [expr]
+  (let [node (:node expr)]
+    (when (= :loop (:op node))
+      (first
+        (keep (fn [^{::t/- s/Bound-Expr} edge]
+                (first
+                  (keep identity
+                    (map (fn [^{::t/- s/Bound-Binding} binding ^{::t/- s/Bound-Expr} arg]
+                           (let [local (:local binding) type (primitive (:jvm local)) actual (primitive (:jvm arg))]
+                             (when (and type (not (or (= type actual)
+                                                     (and (= type Long/TYPE) (= actual Integer/TYPE))
+                                                     (and (= type Double/TYPE) (= actual Float/TYPE)))))
+                               [local arg]))) (:bindings node) (:args (:node edge))))))
+              (recurs (:id node) (:body node)))))))
+
+(np/defpass recurrence {:from [s/Bound Expr] :to [s/Bound Expr] :body true}
+  [expr]
+  (let [node (:node expr)]
+    (case (:op node)
+      :recur (assoc expr :node
+               (assoc node :args
+                 (mapv (fn [local arg]
+                         (if-let [type (primitive (:jvm local))]
+                           (if (= type (primitive (:jvm arg))) arg (converted type arg)) arg))
+                       (:bindings (:target node)) (:args node))))
+      :if (assoc expr :node (assoc node :then (recurrence (:then node)) :else (recurrence (:else node))))
+      :do (assoc expr :node (assoc node :forms (mapv recurrence (:forms node))))
+      :case (assoc expr :node (assoc node :arms (mapv recurrence (:arms node))))
+      :let (assoc expr :node (assoc node :body (recurrence (:body node))))
+      expr)))
+
+(np/defpass materialize {:from [s/Bound Expr] :to [s/Bound Expr] :args [(t/Set t/Sym)] :body true}
+  [boxed-ids expr]
+  (let [node (:node expr)]
+    (if-not (= :loop (:op node)) (throw (IllegalStateException. "Expected source loop"))
+      (assoc expr :node
+        (assoc node :body (recurrence (:body node)) :bindings
+          (mapv (fn [binding]
+                  (let [local (:local binding) init (:init binding)
+                        effective (initializer (contains? boxed-ids (:id local)) init)
+                        type (primitive (:jvm init))
+                        ;; Keep primitive provenance available to storage analysis.
+                        init (if (and type (contains? boxed-ids (:id local))) (converted type init) effective)
+                        hint (jvm/tag-class (:hint (:jvm local)))
+                        init (if hint (inferred {:op :host :operation {:op :adapt :class hint} :args [init]} init) init)]
+                    (assoc binding :init init))) (:bindings node)))))))
+
+(np/defpass lower {:from [s/Bound Expr] :to [s/Bound Expr] :body true}
+  [expr]
+  (let [[expr boxed-ids] (solve {} expr)]
+    (when-let [[local arg] (recur-error expr)]
+      (errors/fail :invalid-recur-type "recur argument does not match its primitive loop binding"
+                   {:binding (:name local) :expected (:type (:jvm local)) :actual (:type (:jvm arg))} (:site arg)))
+    (materialize boxed-ids expr)))
diff --git a/src/com/tailrecursion/blacktide/compiler/lower.clj b/src/com/tailrecursion/blacktide/compiler/lower.clj
new file mode 100644
index 0000000..1d812ea
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/lower.clj
@@ -0,0 +1,145 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.lower
+  "Lower ordered expressions into a CFG with explicit branch joins and exits.
+  Operands have explicit bindings; operations retain their execution position."
+  (:require [com.tailrecursion.blacktide.compiler.errors :as errors]
+            [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as s]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [com.tailrecursion.blacktide.compiler.source :as source]
+            [typed.clojure :as-alias t]))
+
+(declare lower lower-forms lower-bindings)
+
+(np/defpass fresh-block
+  {:from [l/Symbolic Builder] :to (t/HVec [l/Symbolic-Builder l/Symbolic-Label]) :body true}
+  [builder]
+  [(assoc builder :next (inc (:next builder))) (:next builder)])
+
+(np/defpass start
+  {:from [l/Symbolic Label] :to [l/Symbolic Builder] :args [l/Symbolic-Builder] :body true}
+  [builder label]
+  (assoc builder :current label :ops []))
+
+(np/defpass seal
+  {:from [l/Symbolic Term] :to [l/Symbolic Builder] :args [l/Symbolic-Builder] :body true}
+  [builder term]
+  (if (contains? (:blocks builder) (:current builder))
+    (throw (ex-info "Control-flow block already has a terminator" {:kind :invalid-graph :block (:current builder)}))
+    (assoc builder :blocks (assoc (:blocks builder) (:current builder) {:ops (:ops builder) :term term}) :ops [])))
+
+(np/defpass evaluate
+  {:from [l/Symbolic Rhs] :to (t/HVec [l/Symbolic-Builder l/Symbolic-Atom])
+   :args [l/Symbolic-Builder] :body true}
+  [builder rhs]
+  (let [[supply id] (source/fresh "value" (:supply builder))]
+    [(-> builder (assoc :supply supply) (update :ops conj {:target id :value rhs})) {:op :local :id id}]))
+
+(np/defpass lower-forms
+  {:from [s/Ordered Exprs] :to (t/HVec [l/Symbolic-Builder (t/Vec l/Symbolic-Atom)])
+   :args [l/Symbolic-Builder] :body true}
+  [builder forms]
+  (reduce (fn [^{::t/- (t/HVec [l/Symbolic-Builder (t/Vec l/Symbolic-Atom)])} acc ^{::t/- s/Ordered-Expr} expr]
+            (let [[builder out] acc [builder value] (lower builder expr)] [builder (conj out value)]))
+          [builder []] forms))
+
+(np/defpass lower-bindings
+  {:from [s/Ordered Bindings] :to [l/Symbolic Builder] :args [l/Symbolic-Builder] :body true}
+  [builder bindings]
+  (reduce (fn [^{::t/- l/Symbolic-Builder} builder ^{::t/- s/Ordered-Binding} binding]
+            (let [[builder value] (lower builder (:init binding))]
+              (update builder :ops conj {:target (:id (:local binding)) :value {:op :value :value value}})))
+          builder bindings))
+
+(np/defpass lower-node
+  {:from [s/Ordered Node] :to (t/HVec [l/Symbolic-Builder l/Symbolic-Atom])
+   :args [l/Symbolic-Builder s/Ordered-Expr]}
+  [builder expr node]
+  :literal [builder {:op :literal :value (:value node)}]
+  :local (let [local (:local node)]
+           (evaluate builder (if (:external? local) {:op :external :name (:id local) :jvm (:jvm local)}
+                                 {:op :value :value {:op :local :id (:id local)}})))
+  :global (evaluate builder {:op :global :name (:name node)})
+  :var (evaluate builder {:op :var :name (:name node)})
+  :native (evaluate builder node)
+  :dispatch (evaluate builder {:op :dispatch :spec (:spec node)
+                               :value {:value {:op :local :id (:id (:value node))} :jvm (:jvm (:value node))}})
+  :select
+  (let [[builder test] (lower builder (:selector node))
+        [builder join] (fresh-block builder)
+        [supply result] (source/fresh "case_result" (:supply builder))
+        [builder targets] (reduce (fn [^{::t/- (t/HVec [l/Symbolic-Builder (t/Vec l/Symbolic-Label)])} acc
+                                       ^{::t/- s/Ordered-Expr} _]
+                                    (let [[builder targets] acc [builder label] (fresh-block builder)]
+                                      [builder (conj targets label)]))
+                                  [(assoc builder :supply supply) []] (:arms node))
+        builder (seal builder {:op :switch :test test :targets targets})
+        builder (reduce (fn [^{::t/- l/Symbolic-Builder} builder ^{::t/- t/Int} index]
+                          (let [[builder value] (lower (start builder (nth targets index)) (nth (:arms node) index))]
+                            (seal (update builder :ops conj {:target result :value {:op :value :value value}})
+                                  {:op :jump :target join}))) builder (range (count targets)))]
+    [(start builder join) {:op :local :id result}])
+  :loop (let [builder (lower-bindings builder (:bindings node))
+              [builder header] (fresh-block builder)
+              builder (assoc builder :loops (assoc (:loops builder) (:id node) header))]
+          (lower (start (seal builder {:op :jump :target header}) header) (:body node)))
+  :recur (let [target (:target node)
+               header (or (get (:loops builder) (:id target))
+                          (errors/fail :invalid-graph "Missing source recur target" {} (:site expr)))
+               writes (mapv (fn [local arg] {:target (:id local) :value {:op :value :value {:op :local :id (:id arg)}}})
+                            (:bindings target) (:args node))
+               builder (seal (update builder :ops into writes) {:op :jump :target header})
+               [builder next] (fresh-block builder)]
+           [(start builder next) {:op :literal :value nil}])
+  :if (let [[builder test] (lower builder (:test node))
+            [builder yes] (fresh-block builder) [builder no] (fresh-block builder) [builder join] (fresh-block builder)
+            [supply result] (source/fresh "join" (:supply builder))
+            builder (seal (assoc builder :supply supply) {:op :branch :test test :yes yes :no no})
+            [builder a] (lower (start builder yes) (:then node))
+            builder (seal (update builder :ops conj {:target result :value {:op :value :value a}}) {:op :jump :target join})
+            [builder b] (lower (start builder no) (:else node))
+            builder (seal (update builder :ops conj {:target result :value {:op :value :value b}}) {:op :jump :target join})]
+        [(start builder join) {:op :local :id result}])
+  :throw (let [[builder value] (lower builder (:value node))
+               builder (seal builder {:op :throw :value value})
+               [builder next] (fresh-block builder)]
+           [(start builder next) {:op :literal :value nil}])
+  :write (let [[builder value] (lower builder (:value node))]
+           [(update builder :ops conj {:target (:id (:target node)) :value {:op :value :value value}}) value])
+  :convert (evaluate builder {:op :convert :conversion (:conversion node)
+                              :value {:value {:op :local :id (:id (:value node))} :jvm (:jvm (:value node))}})
+  :host-call (evaluate builder {:op :host :operation (:operation node)
+                           :args (mapv (fn [local] {:value {:op :local :id (:id local)} :jvm (:jvm local)}) (:args node))})
+  :invoke (evaluate builder {:op :invoke :function {:op :local :id (:id (:function node))}
+                             :args (mapv (fn [local] {:op :local :id (:id local)}) (:args node))})
+  :build (evaluate builder {:op :construct :kind (:kind node) :unique? (:unique? node)
+                            :items (mapv (fn [local] {:op :local :id (:id local)}) (:items node))})
+  :metadata (evaluate builder {:op :metadata :value {:op :local :id (:id (:value node))}
+                               :metadata {:op :local :id (:id (:metadata node))}})
+  :label (let [key (:name node)]
+           (when (contains? (:labels builder) key)
+             (errors/fail :duplicate-label "Duplicate label" {:label (:name node)} (:site expr)))
+           (let [[builder label] (fresh-block builder)
+                 builder (assoc builder :labels (assoc (:labels builder) key label))
+                 builder (seal builder {:op :jump :target label})]
+             [(start builder label) {:op :literal :value nil}]))
+  :goto (let [builder
+              (if (= 'end (:name node))
+                (seal builder {:op :return :value {:op :literal :value nil}})
+                (seal builder {:op :transfer :name (:name node)
+                               :site (:site expr)}))
+              [builder next] (fresh-block builder)]
+          [(start builder next) {:op :literal :value nil}])
+  :do (let [[builder values] (lower-forms builder (:forms node))]
+        [builder (or (peek values) {:op :literal :value nil})])
+  :let (lower (lower-bindings builder (:bindings node)) (:body node)))
+
+(np/defpass lower
+  {:from [s/Ordered Expr] :to (t/HVec [l/Symbolic-Builder l/Symbolic-Atom]) :args [l/Symbolic-Builder] :body true}
+  [builder expr]
+  (lower-node builder expr (:node expr)))
+
+(np/defpass compile-graph
+  {:from [s/Ordered Expr] :to [l/Symbolic Program] :args [s/Bound-Supply] :body true}
+  [supply expr]
+  (let [[builder value] (lower {:supply supply :ops [] :next 1 :current 0 :blocks {} :labels {} :loops {}} expr)]
+    {:entry 0 :labels (:labels builder) :blocks (:blocks (seal builder {:op :return :value value}))}))
diff --git a/src/com/tailrecursion/blacktide/compiler/native.clj b/src/com/tailrecursion/blacktide/compiler/native.clj
new file mode 100644
index 0000000..fdc6176
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/native.clj
@@ -0,0 +1,108 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.native
+  "Analyze native free reads and recover their source types from machine storage.
+  Primitive source reads cannot observe the slot's box; reference reads retain
+  it. Internal bindings keep native inference."
+  (:require [clojure.set :as set]
+            [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as s]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [com.tailrecursion.blacktide.compiler.collections :as collections]
+            [com.tailrecursion.blacktide.compiler.host-emit :as host]
+            [com.tailrecursion.blacktide.compiler.case-emit :as cases]
+            [com.tailrecursion.blacktide.compiler.jvm-languages :as j]
+            [typed.clojure :as-alias t]))
+
+(declare boxed-reads form)
+
+(np/defpass hinted-form {:from [l/Machine Code] :to [l/Machine Code] :args [j/JVM-Raw] :body true}
+  [hint code]
+  ;; Var return tags may be Class objects; source form tags cannot be.
+  (let [hint (if (class? hint) (symbol (.getName ^Class hint)) hint)]
+    (with-meta (if (symbol? code) code (apply list code))
+               (cond-> (meta code) hint (assoc :tag hint)))))
+
+(np/defpass reads-node {:from [s/Native Node] :to (t/Set t/Sym)
+                        :args [(t/Map t/Sym java.lang.Class)]}
+  [types node]
+  :literal #{} :global #{} :var #{}
+  :local (if (:external? (:local node)) #{} #{(:id (:local node))})
+  :host (into #{} (mapcat (partial boxed-reads types)) (:args node))
+  :invoke (into (boxed-reads types (:function node)) (mapcat (partial boxed-reads types)) (:args node))
+  :if (set/union (boxed-reads types (:test node)) (boxed-reads types (:then node)) (boxed-reads types (:else node)))
+  :case (into (boxed-reads types (:selector node)) (mapcat (partial boxed-reads types)) (:arms node))
+  :dispatch (boxed-reads types (:value node))
+  :throw (boxed-reads types (:value node))
+  :collection (into (if-let [metadata (:metadata node)] (boxed-reads types metadata) #{}) (mapcat (partial boxed-reads types)) (:items node))
+  :do (into #{} (mapcat (partial boxed-reads types)) (:forms node))
+  :recur (into #{} (mapcat (partial boxed-reads types)) (:args node))
+  :let (set/difference (into (boxed-reads types (:body node)) (mapcat #(boxed-reads types (:init %))) (:bindings node))
+                       (set (map #(get-in % [:local :id]) (:bindings node))))
+  :loop (set/difference (into (boxed-reads types (:body node)) (mapcat #(boxed-reads types (:init %))) (:bindings node))
+                        (set (map #(get-in % [:local :id]) (:bindings node)))))
+
+(np/defpass boxed-reads {:from [s/Native Expr] :to (t/Set t/Sym)
+                         :args [(t/Map t/Sym java.lang.Class)] :body true}
+  [types expr]
+  (let [node (:node expr) fact (:jvm expr)]
+    (if (and (= :local (:op node)) (:primitive? fact)
+             (= (:type fact) (get types (:id (:local node)))))
+      #{} (reads-node types node))))
+
+(np/defpass reads {:from [s/Native Expr] :to (t/Set t/Sym) :body true}
+  [expr] (boxed-reads {} expr))
+
+
+(np/defpass literal-values {:from [s/Native Exprs] :to (t/Option (t/Vec t/Any)) :body true}
+  [items]
+  (reduce (fn [^{::t/- (t/Option (t/Vec t/Any))} values ^{::t/- s/Native-Expr} expr]
+            (let [node (:node expr)]
+              (if (and values (= :literal (:op node))) (conj values (:value node)) (reduced nil)))) [] items))
+
+(np/defpass bindings-form
+  {:from [s/Native Bindings] :to (t/Vec t/Any) :args [(t/Set t/Sym)] :body true}
+  [bound bindings]
+  (vec (mapcat (fn [^{::t/- s/Native-Binding} binding]
+                 [(with-meta (:id (:local binding)) (meta (:name (:local binding))))
+                  (form bound (:init binding))]) bindings)))
+
+
+(np/defpass node-form
+  {:from [s/Native Node] :to [l/Machine Code] :args [(t/Set t/Sym) s/Native-Expr]}
+  [bound expr node]
+  :literal (list 'quote (:value node))
+  :global (host/typed-form (:jvm expr) (host/global-form (:name node)))
+  :var (list 'var (:name node))
+  :local (let [local (:local node) id (:id local)]
+           (if (contains? bound id)
+             (with-meta id (when-let [hint (:hint (:jvm expr))] {:tag hint}))
+             (host/typed-form (:jvm expr) (host/box-form id))))
+  :host (hinted-form (:hint (:jvm expr)) (host/host-form (mapv #(form bound %) (:args node)) (:operation node)))
+  :invoke (let [function (:function node) source (:form (:site function))
+                ;; Quote changes KeywordExpr into ConstantExpr, bypassing the
+                ;; source call site's IKeywordLookup cache. Preserve its syntax.
+                callee (if (and (keyword? source) (= :literal (:op (:node function))))
+                         source (form bound function))]
+            (hinted-form (:hint (:jvm expr)) (list* callee (mapv #(form bound %) (:args node)))))
+  :if (list 'if (form bound (:test node)) (form bound (:then node)) (form bound (:else node)))
+  :case (cases/arms-form (mapv #(form bound %) (:arms node)) (form bound (:selector node)))
+  :dispatch (cases/selector-form (form bound (:value node)) (:spec node))
+  :throw (list 'throw (form bound (:value node)))
+  :do (list* 'do (mapv #(form bound %) (:forms node)))
+  :recur (list* 'recur (mapv #(form bound %) (:args node)))
+  :let (let [bound (into bound (map #(:id (:local %))) (:bindings node))]
+         (list 'let* (bindings-form bound (:bindings node)) (form bound (:body node))))
+  :loop (let [bound (into bound (map #(:id (:local %))) (:bindings node))]
+          (list 'loop* (bindings-form bound (:bindings node)) (form bound (:body node))))
+  :collection
+  (let [items (:items node) metadata (:metadata node) values (literal-values items)
+        keys (when (= :map (:kind node)) (literal-values (vec (take-nth 2 items))))
+        unique? (boolean (and keys (= (count keys) (count (set keys)))))
+        _ (when (and (nil? metadata) keys (not unique?))
+            (throw (IllegalArgumentException. "Duplicate constant keys in map")))
+        value (if (and (nil? metadata) values)
+                (list 'quote (collections/constant values (:kind node)))
+                (collections/form (mapv #(form bound %) items) unique? (:kind node)))]
+    (if metadata (list '. value 'withMeta (form bound metadata)) value)))
+
+(np/defpass form {:from [s/Native Expr] :to [l/Machine Code] :args [(t/Set t/Sym)] :body true}
+  [bound expr] (node-form bound expr (:node expr)))
diff --git a/src/com/tailrecursion/blacktide/compiler/order.clj b/src/com/tailrecursion/blacktide/compiler/order.clj
new file mode 100644
index 0000000..ea63a7e
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/order.clj
@@ -0,0 +1,116 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.order
+  "Make operand evaluation explicit before CFG construction. Calls and collection
+  construction consume immutable saved locals; source scopes stay unchanged."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as l]
+            [com.tailrecursion.blacktide.compiler.source :as source]
+            [typed.clojure :as-alias t]))
+
+(declare normalize)
+
+(np/defpass save
+  {:from [l/Ordered Expr] :to (t/HVec [l/Bound-Supply l/Ordered-Binding l/Ordered-Local])
+   :args [l/Bound-Supply] :body true}
+  [supply expr]
+  (let [[supply id] (source/fresh "operand" supply)
+        local {:id id :name id :mutable? false :external? false :jvm (:jvm expr)}]
+    [supply {:local local :init expr} local]))
+
+(np/defpass operands
+  {:from [l/Prepared Exprs]
+   :to (t/HVec [l/Bound-Supply (t/Vec l/Ordered-Binding) (t/Vec l/Ordered-Local)])
+   :args [l/Bound-Supply] :body true}
+  [supply exprs]
+  (reduce (fn [^{::t/- (t/HVec [l/Bound-Supply (t/Vec l/Ordered-Binding) (t/Vec l/Ordered-Local)])} acc
+               ^{::t/- l/Prepared-Expr} expr]
+            (let [[supply bindings locals] acc
+                  [supply expr] (normalize supply expr)
+                  [supply binding local] (save supply expr)]
+              [supply (conj bindings binding) (conj locals local)])) [supply [] []] exprs))
+
+(np/defpass normalize-forms
+  {:from [l/Prepared Exprs] :to (t/HVec [l/Bound-Supply l/Ordered-Exprs])
+   :args [l/Bound-Supply] :body true}
+  [supply exprs]
+  (reduce (fn [^{::t/- (t/HVec [l/Bound-Supply l/Ordered-Exprs])} acc ^{::t/- l/Prepared-Expr} expr]
+            (let [[supply out] acc [supply expr] (normalize supply expr)] [supply (conj out expr)]))
+          [supply []] exprs))
+
+(np/defpass normalize-bindings
+  {:from [l/Prepared Bindings] :to (t/HVec [l/Bound-Supply l/Ordered-Bindings])
+   :args [l/Bound-Supply] :body true}
+  [supply bindings]
+  (reduce (fn [^{::t/- (t/HVec [l/Bound-Supply l/Ordered-Bindings])} acc ^{::t/- l/Prepared-Binding} binding]
+            (let [[supply out] acc [supply init] (normalize supply (:init binding))]
+              [supply (conj out (assoc binding :init init))])) [supply []] bindings))
+
+(np/defpass normalize-node
+  {:from [l/Prepared Node] :to (t/HVec [l/Bound-Supply l/Ordered-Expr])
+   :args [l/Bound-Supply l/Prepared-Expr]}
+  [supply expr node]
+  :literal [supply (assoc expr :node node)]
+  :local [supply (assoc expr :node node)]
+  :global [supply (assoc expr :node node)]
+  :var [supply (assoc expr :node node)]
+  :label [supply (assoc expr :node node)]
+  :goto [supply (assoc expr :node node)]
+  :native [supply (assoc expr :node node)]
+  :select (let [[supply selector] (normalize supply (:selector node))
+                [supply arms] (normalize-forms supply (:arms node))]
+            [supply (assoc expr :node {:op :select :selector selector :arms arms})])
+  :dispatch (let [[supply value] (normalize supply (:value node))
+                  [supply binding local] (save supply value)]
+              [supply (assoc expr :node {:op :let :bindings [binding]
+                                        :body (assoc expr :node {:op :dispatch :value local :spec (:spec node)})})])
+  :recur (let [[supply bindings args] (operands supply (:args node))]
+           [supply (assoc expr :node {:op :let :bindings bindings
+                                     :body (assoc expr :node {:op :recur :target (:target node) :args args})})])
+  :loop (let [[supply bindings] (normalize-bindings supply (:bindings node))
+              [supply body] (normalize supply (:body node))]
+          [supply (assoc expr :node {:op :loop :id (:id node) :bindings bindings :body body})])
+  :if (let [[supply test] (normalize supply (:test node))
+            [supply yes] (normalize supply (:then node))
+            [supply no] (normalize supply (:else node))]
+        [supply (assoc expr :node {:op :if :test test :then yes :else no})])
+  :throw (let [[supply value] (normalize supply (:value node))]
+           [supply (assoc expr :node {:op :throw :value value})])
+  :write (let [[supply value] (normalize supply (:value node))]
+           [supply (assoc expr :node {:op :write :target (:target node) :value value})])
+  :do (let [[supply forms] (normalize-forms supply (:forms node))]
+        [supply (assoc expr :node {:op :do :forms forms})])
+  :let (let [[supply bindings] (normalize-bindings supply (:bindings node))
+             [supply body] (normalize supply (:body node))]
+         [supply (assoc expr :node {:op :let :bindings bindings :body body})])
+  :convert
+  (let [[supply value] (normalize supply (:value node))
+        [supply binding local] (save supply value)]
+    [supply (assoc expr :node {:op :let :bindings [binding]
+                              :body (assoc expr :node {:op :convert :conversion (:conversion node) :value local})})])
+  :host-call
+  (let [[supply bindings args] (operands supply (:args node))]
+    [supply (assoc expr :node {:op :let :bindings bindings
+                              :body (assoc expr :node {:op :host-call :operation (:operation node) :args args})})])
+  :invoke
+  (let [[supply function] (normalize supply (:function node))
+        [supply binding local] (save supply function)
+        [supply bindings args] (operands supply (:args node))]
+    [supply (assoc expr :node {:op :let :bindings (into [binding] bindings)
+                              :body (assoc expr :node {:op :invoke :function local :args args})})])
+  :build
+  (let [[supply bindings items] (operands supply (:items node))
+        value (assoc expr :node {:op :build :kind (:kind node) :items items :unique? (:unique? node)})
+        [supply bindings value]
+        (if-let [metadata (:metadata node)]
+          (let [[supply binding local] (save supply value)
+                [supply metadata] (normalize supply metadata)
+                [supply meta-binding meta-local] (save supply metadata)]
+            [supply (into bindings [binding meta-binding])
+             (assoc expr :node {:op :metadata :value local :metadata meta-local})])
+          [supply bindings value])]
+    [supply (assoc expr :node {:op :let :bindings bindings :body value})]))
+
+(np/defpass normalize
+  {:from [l/Prepared Expr] :to (t/HVec [l/Bound-Supply l/Ordered-Expr])
+   :args [l/Bound-Supply] :body true}
+  [supply expr]
+  (normalize-node supply expr (:node expr)))
diff --git a/src/com/tailrecursion/blacktide/compiler/prepare.clj b/src/com/tailrecursion/blacktide/compiler/prepare.clj
new file mode 100644
index 0000000..3d004e4
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/prepare.clj
@@ -0,0 +1,46 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.prepare
+  "Make function casts and resolved JVM argument conversions explicit before
+  ordering operands. A failing conversion must prevent subsequent evaluation."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as l]
+            [com.tailrecursion.blacktide.compiler.jvm-languages :as j]
+            [com.tailrecursion.blacktide.compiler.jvm :as jvm]
+            [typed.clojure :as-alias t]))
+
+(declare prepare prepare-binding)
+
+(np/defpass prepare-forms
+  {:from [l/Collections Exprs] :to [l/Prepared Exprs] :processors {Expr prepare}}
+  [forms])
+
+(np/defpass conversion
+  {:from [l/Prepared Expr] :to [l/Prepared Expr] :args [(t/Option j/JVM-Conversion)] :body true}
+  [conversion expr]
+  (if conversion
+    (let [fact (jvm/fact (.isPrimitive ^Class (:type conversion)) {:hint nil :var-meta {}} (:type conversion))]
+      ;; The consumer still sees Object, but evaluating an Object cast cannot
+      ;; fail. Operand normalization supplies the required value snapshot.
+      (if (= Object (:type conversion)) (assoc expr :jvm fact)
+        (assoc expr :jvm fact :node {:op :convert :conversion conversion :value expr}))) expr))
+
+(np/defpass prepare-node
+  {:from [l/Collections Node] :to [l/Prepared Node]
+   :processors {Expr prepare Exprs prepare-forms Binding prepare-binding Raw clojure.core/identity Local clojure.core/identity
+                CollectionKind clojure.core/identity RecurTarget clojure.core/identity CaseSpec clojure.core/identity}}
+  [node]
+  :invoke {:op :invoke :function (conversion {:type clojure.lang.IFn :parameter? false} (prepare (:function node)))
+           :args (mapv prepare (:args node))}
+  :host
+  (let [plan (jvm/prepare-call (mapv #(:type (:jvm %)) (:args node)) (:operation node))]
+    {:op :host-call :operation (:operation plan)
+     :args (mapv (fn [how value] (conversion how (prepare value))) (:conversions plan) (:args node))}))
+
+(np/defpass prepare-binding
+  {:from [l/Collections Binding] :to [l/Prepared Binding]
+   :processors {Expr prepare Local clojure.core/identity}}
+  [binding])
+
+(np/defpass prepare
+  {:from [l/Collections Expr] :to [l/Prepared Expr] :body true}
+  [expr]
+  (assoc expr :node (prepare-node (:node expr))))
diff --git a/src/com/tailrecursion/blacktide/compiler/source.clj b/src/com/tailrecursion/blacktide/compiler/source.clj
new file mode 100644
index 0000000..f7bebcc
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/source.clj
@@ -0,0 +1,414 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.source
+  "Expand in the caller namespace while discovering lexical bindings. Macro
+  expansion and binding discovery stay ordered; every child becomes bound IR."
+  (:require [com.tailrecursion.blacktide.compiler.errors :as errors]
+            [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as l]
+            [typed.clojure :as-alias t]
+            [com.tailrecursion.blacktide.compiler.jvm-languages :as j]
+            [com.tailrecursion.blacktide.compiler.jvm :as jvm]
+            [com.tailrecursion.blacktide.compiler.source-jvm :as facts]
+            [com.tailrecursion.blacktide.compiler.loop-facts :as loops]
+            [com.tailrecursion.blacktide.compiler.source-case :as cases]
+            [com.tailrecursion.blacktide.compiler.effects :refer [effects]]
+            [com.tailrecursion.blacktide.compiler.source-host :as host]))
+
+(declare parse parse-forms parse-list parse-bindings)
+
+(np/defpass fresh
+  {:from [l/Bound Supply] :to (t/HVec [l/Bound-Supply t/Sym]) :args [t/Str] :body true}
+  [stem supply]
+  ;; Put the unique counter before the user-controlled stem. A source name
+  ;; must not impersonate another binding's generated identity.
+  [(assoc supply :next (inc (:next supply))) (symbol (str (:prefix supply) "__" (:next supply) "__" stem))])
+
+(np/defpass expression
+  {:from [l/Bound Node] :to [l/Bound Expr] :args [l/Bound-Context j/JVM-Seed] :body true}
+  [ctx jvm node]
+  {:site (:site ctx) :jvm (facts/infer jvm node) :node node})
+
+(np/defpass resolve-name
+  {:from [l/Bound Raw] :to (t/U nil t/AnyVar java.lang.Class) :args [l/Bound-Context] :body true}
+  [ctx name]
+  (if (var? name) name
+      (when (and (symbol? name) (not (contains? (:locals ctx) name))) (ns-resolve *ns* name))))
+
+(np/defpass parse-symbol
+  {:from [l/Bound Raw] :to [l/Bound Expr] :args [l/Bound-Context] :body true}
+  [ctx form]
+  (if (symbol? form)
+    (if-let [local (get (:locals ctx) form)]
+      (expression ctx {:hint (jvm/source-tag form) :var-meta {}} {:op :local :local local})
+      (let [resolved (resolve-name ctx form) qualified (host/qualified form)]
+        (cond
+          (var? resolved)
+          (let [m (or (meta resolved) {})]
+            (errors/check-visibility resolved (:site ctx))
+            (when (:macro m) (errors/fail :invalid-expression "Cannot take the value of a macro" {} (:site ctx)))
+            (if (:const m)
+              (expression ctx {:hint nil :var-meta {}} {:op :literal :value (.get ^clojure.lang.Var resolved)})
+              (expression ctx {:hint (jvm/source-tag form) :var-meta m}
+                          {:op :global :name (.toSymbol ^clojure.lang.Var resolved)})))
+          (class? resolved) (expression ctx {:hint (jvm/source-tag form) :var-meta {}} {:op :literal :value resolved})
+          qualified
+          (let [operation qualified]
+            (expression ctx {:hint (jvm/source-tag form) :var-meta {}}
+                        {:op :host :operation (if (= :static-field (:op operation)) operation
+                                                 {:op :method-value :name form}) :args []}))
+          :else (errors/fail :unresolved-symbol "Unable to resolve symbol" {:binding form} (:site ctx)))))
+    (errors/fail :invalid-expression "Expected a symbol" {} (:site ctx))))
+
+(np/defpass parse-operand
+  {:from [l/Bound Raw] :to (t/HVec [l/Bound-Supply l/Bound-Expr])
+   :args [l/Bound-Supply l/Bound-Context] :body true}
+  [supply ctx form]
+  (parse supply (assoc ctx :statement? false :tail? false :outer? false :transfer? false) form))
+
+(np/defpass parse-forms
+  {:from [l/Bound Forms] :to (t/HVec [l/Bound-Supply (t/Vec l/Bound-Expr)])
+   :args [l/Bound-Supply l/Bound-Context] :body true}
+  [supply ctx forms]
+  (reduce (fn [^{::t/- (t/HVec [l/Bound-Supply (t/Vec l/Bound-Expr)])} acc ^{::t/- l/Bound-Raw} form]
+            (let [[supply out] acc
+                  last? (= (count out) (dec (count forms)))
+                  ctx (assoc ctx :tail? (and (:tail? ctx) last?))
+                  [supply expr] (if (:statement? ctx) (parse supply ctx form) (parse-operand supply ctx form))]
+              [supply (conj out expr)]))
+          [supply []] forms))
+
+(np/defpass parse-body
+  {:from [l/Bound Forms] :to (t/HVec [l/Bound-Supply l/Bound-Expr])
+   :args [l/Bound-Supply l/Bound-Context] :body true}
+  [supply ctx forms]
+  (let [[supply forms] (parse-forms supply (assoc ctx :statement? true) forms)]
+    [supply (expression ctx {:hint nil :var-meta {}} {:op :do :forms forms})]))
+
+(np/defpass bind-local
+  {:from [l/Bound Raw] :to (t/HVec [l/Bound-Supply l/Bound-Context l/Bound-Local])
+   :args [l/Bound-Supply l/Bound-Context t/Bool j/JVM-Fact] :body true}
+  [supply ctx mutable? init name]
+  (if (simple-symbol? name)
+    (let [[supply id] (fresh (str name) supply)
+          jvm (facts/binding-facts name mutable? init)
+          type (:type jvm)
+          tag (or (:hint jvm) (when (class? type) (symbol (.getName ^Class type))))
+          local {:id id :name name :mutable? mutable? :external? false
+                 :jvm jvm}]
+      [supply (assoc ctx :locals (assoc (:locals ctx) name local)
+                         :macro-env (assoc (:macro-env ctx) name {:name name :tag tag})) local])
+    (errors/fail :invalid-binding "Binding targets must be simple symbols" {:binding name} (:site ctx))))
+
+(np/defpass parse-bindings
+  {:from [l/Bound Raw] :to (t/HVec [l/Bound-Supply l/Bound-Context (t/Vec l/Bound-Binding)])
+   :args [l/Bound-Supply l/Bound-Context (t/U ':mutable ':immutable ':loop)] :body true}
+  [supply ctx mode bindings]
+  (if (and (vector? bindings) (even? (count bindings)))
+    (reduce (fn [^{::t/- (t/HVec [l/Bound-Supply l/Bound-Context (t/Vec l/Bound-Binding)])} acc
+                 ^{::t/- (t/Seq t/Any)} pair]
+              (let [[supply ctx out] acc
+                    [supply init] (parse-operand supply ctx (second pair))
+                    [supply ctx local] (bind-local supply ctx (not= mode :immutable) (:jvm init) (first pair))
+                    local (cond-> local (= mode :loop) (assoc :mutable? false))
+                    ctx (assoc ctx :locals (assoc (:locals ctx) (:name local) local))
+                    hint (jvm/tag-class (:hint (:jvm local)))
+                    init (if (and hint (= mode :immutable))
+                           (expression ctx {:hint nil :var-meta {}} {:op :host :operation {:op :adapt :class hint} :args [init]}) init)]
+                [supply ctx (conj out {:local local :init init})])) [supply ctx []] (partition 2 bindings))
+    (errors/fail :invalid-bindings "Expected an even binding vector" {} (:site ctx))))
+
+(np/defpass parse-scope
+  {:from [l/Bound Forms] :to (t/HVec [l/Bound-Supply l/Bound-Expr])
+   :args [l/Bound-Supply l/Bound-Context t/Bool] :body true}
+  [supply ctx mutable? forms]
+  (let [inner (assoc ctx :outer? mutable?)
+        [supply inner bindings] (parse-bindings supply inner (if mutable? :mutable :immutable) (second forms))
+        [supply body] (parse-body supply inner (vec (drop 2 forms)))]
+    [supply (expression ctx {:hint (jvm/source-tag (:form (:site ctx))) :var-meta {}}
+                        {:op :let :bindings bindings :body body})]))
+
+(np/defpass parse-loop
+  {:from [l/Bound Forms] :to (t/HVec [l/Bound-Supply l/Bound-Expr])
+   :args [l/Bound-Supply l/Bound-Context] :body true}
+  [supply ctx forms]
+  (let [[supply id] (fresh "loop" supply)
+        inner (assoc ctx :outer? false :recur nil :tail? false)
+        [supply inner bindings] (parse-bindings supply inner :loop (second forms))
+        target {:id id :bindings (mapv :local bindings)}
+        [supply body] (parse-body supply (assoc inner :recur target :tail? true) (vec (drop 2 forms)))]
+    [supply (first (loops/solve {} (expression ctx {:hint nil :var-meta {}} {:op :loop :id id :bindings bindings :body body})))]))
+
+(np/defpass parse-recur
+  {:from [l/Bound Forms] :to (t/HVec [l/Bound-Supply l/Bound-Expr])
+   :args [l/Bound-Supply l/Bound-Context] :body true}
+  [supply ctx forms]
+  (let [target (:recur ctx)]
+    (when-not (and target (:tail? ctx))
+      (errors/fail :invalid-recur "recur requires the tail position of a local loop" {} (:site ctx)))
+    (when-not (= (count (:bindings target)) (dec (count forms)))
+      (errors/fail :recur-arity "recur argument count does not match its target" {} (:site ctx)))
+    (let [[supply args] (parse-forms supply (assoc ctx :statement? false :tail? false) (subvec forms 1))]
+      [supply (expression ctx {:hint nil :var-meta {}} {:op :recur :target target :args args})])))
+
+(np/defpass parse-arms
+  {:from [l/Bound Forms] :to (t/HVec [l/Bound-Supply l/Bound-Exprs])
+   :args [l/Bound-Supply l/Bound-Context] :body true}
+  [supply ctx forms]
+  (reduce (fn [^{::t/- (t/HVec [l/Bound-Supply l/Bound-Exprs])} acc ^{::t/- t/Any} form]
+            (let [[supply arms] acc [supply arm] (parse supply (assoc ctx :outer? false) form)] [supply (conj arms arm)]))
+          [supply []] forms))
+
+(np/defpass case-expression
+  {:from [l/Bound Exprs] :to (t/HVec [l/Bound-Supply l/Bound-Expr])
+   :args [l/Bound-Supply l/Bound-Context l/Bound-Expr] :body true}
+  [supply ctx selector arms]
+  [supply (expression ctx {:hint nil :var-meta {}} {:op :case :selector selector :arms arms})])
+
+(np/defpass parse-case
+  {:from [l/Bound Forms] :to (t/HVec [l/Bound-Supply l/Bound-Expr])
+   :args [l/Bound-Supply l/Bound-Context] :body true}
+  [supply ctx forms]
+  (let [{:keys [selector arms]} (cases/expand-case (:macro-env ctx) forms)]
+    (if (empty? arms) (parse supply ctx selector)
+      (do
+        (when-not (and (seq? selector) (= 3 (count selector)))
+          (errors/fail :invalid-case "Expected core case's selector binding" {} (:site ctx)))
+        (let [[supply inner bindings] (parse-bindings supply ctx :immutable (second selector))
+              [supply selector] (parse-operand supply inner (first (nnext selector)))
+              [supply arms] (parse-arms supply inner arms)
+              [supply body] (case-expression supply ctx selector arms)]
+          [supply (expression ctx {:hint nil :var-meta {}} {:op :let :bindings bindings :body body})])))))
+
+(np/defpass parse-dispatch
+  {:from [l/Bound Forms] :to (t/HVec [l/Bound-Supply l/Bound-Expr])
+   :args [l/Bound-Supply l/Bound-Context] :body true}
+  [supply ctx forms]
+  (let [{:keys [value spec arms]} (cases/dispatch-syntax forms)
+        [supply value] (parse-operand supply ctx value)]
+    (when-not (= :local (:op (:node value)))
+      (errors/fail :invalid-case "case* dispatch must reference a lexical local" {} (:site ctx)))
+    (let [selector (expression ctx {:hint nil :var-meta {}} {:op :dispatch :value value :spec spec})
+          [supply arms] (parse-arms supply ctx arms)]
+      (case-expression supply ctx selector arms))))
+
+(np/defpass protocol-argument
+  {:from [l/Bound Expr] :to (t/HVec [l/Bound-Supply l/Bound-Expr])
+   :args [l/Bound-Supply l/Bound-Context l/Bound-Expr java.lang.Class] :body true}
+  [supply ctx direct? type arg]
+  (let [seed {:hint nil :var-meta {}} [supply id] (fresh "protocol-argument" supply)
+        local {:id id :name id :mutable? false :external? false :jvm (facts/binding-facts id false (:jvm arg))}
+        read (expression ctx seed {:op :local :local local})
+        boxed (expression ctx seed {:op :host :operation {:op :static :class clojure.lang.RT :member 'box :tags [Object]} :args [read]})
+        converted (if (.isPrimitive ^Class type)
+                    (expression ctx seed {:op :host :operation {:op :static :class clojure.lang.RT :member 'box :tags [type]} :args [read]})
+                    (expression ctx seed {:op :host :operation {:op :instance :class Class :member 'cast :mode :method :tags [Object]}
+                                         :args [(expression ctx seed {:op :literal :value type})
+                                                (expression ctx seed {:op :host :operation {:op :adapt :class type} :args [read]})]}))]
+    [supply (expression ctx seed {:op :let :bindings [{:local local :init arg}]
+                                 :body (expression ctx seed {:op :if :test direct? :then converted :else boxed})})]))
+
+(np/defpass protocol-call
+  {:from [l/Bound Exprs] :to (t/HVec [l/Bound-Supply l/Bound-Expr])
+   :args [l/Bound-Supply l/Bound-Context j/JVM-Seed j/JVM-Protocol t/Sym] :body true}
+  [supply ctx seed method name args]
+  (let [plain {:hint nil :var-meta {}} [supply id] (fresh "protocol-receiver" supply)
+        receiver (expression ctx plain {:op :host :operation {:op :static :class clojure.lang.RT :member 'box :tags [Object]} :args [(nth args 0)]})
+        local {:id id :name id :mutable? false :external? false :jvm (:jvm receiver)}
+        read (expression ctx plain {:op :local :local local})
+        direct? (if-let [class (:class method)]
+                  (expression ctx plain {:op :host :operation {:op :instanceof :class class} :args [read]})
+                  (expression ctx plain {:op :literal :value false}))
+        root (expression ctx plain {:op :host :operation {:op :instance :class clojure.lang.Var :member 'getRawRoot :mode :method :tags []}
+                                    :args [(expression ctx plain {:op :var :name name})]})
+        root (expression ctx plain {:op :if :test direct? :then (expression ctx plain {:op :literal :value nil}) :else root})
+        [supply args] (reduce (fn [^{::t/- (t/HVec [l/Bound-Supply l/Bound-Exprs])} acc ^{::t/- t/Int} index]
+                               (let [[supply out] acc arg (nth args index) type (get (:parameters method) (dec index) Object)
+                                     [supply arg] (if (= Object type) [supply arg] (protocol-argument supply ctx direct? type arg))]
+                                 [supply (conj out arg)])) [supply [read root]] (range 1 (count args)))]
+    [supply (expression ctx seed {:op :let :bindings [{:local local :init receiver}]
+                                 :body (expression ctx seed {:op :host :operation {:op :protocol :method method} :args args})})]))
+
+(np/defpass keyword-call
+  {:from [l/Bound Expr] :to (t/HVec [l/Bound-Supply l/Bound-Expr])
+   :args [l/Bound-Supply l/Bound-Context j/JVM-Seed t/Kw] :body true}
+  [supply ctx seed key target]
+  (let [plain {:hint nil :var-meta {}} [supply id] (fresh "keyword-site" supply)
+        site (expression ctx plain {:op :host :operation {:op :keyword-site :key key} :args []})
+        local {:id id :name id :mutable? false :external? false :jvm (:jvm site)}
+        read (expression ctx plain {:op :local :local local})
+        snapshot (expression ctx plain {:op :host :operation {:op :instance :class com.tailrecursion.blacktide.runtime.KeywordSite
+                                                              :member 'snapshot :mode :method :tags []} :args [read]})]
+    ;; The first argument snapshots the cache before the target runs.
+    ;; An IFn call retains KeywordInvokeExpr's unknown result type.
+    [supply (expression ctx seed {:op :let :bindings [{:local local :init site}]
+                                 :body (expression ctx seed {:op :invoke :function read :args [snapshot target]})})]))
+
+(np/defpass parse-call
+  {:from [l/Bound Forms] :to (t/HVec [l/Bound-Supply l/Bound-Expr])
+   :args [l/Bound-Supply l/Bound-Context] :body true}
+  [supply ctx forms]
+  (let [inner (assoc ctx :statement? false :tail? false)
+        [supply function] (parse-operand supply inner (first forms))
+        arity (dec (count forms))
+        direct (facts/direct-call arity function)
+        metadata (:var-meta (:jvm function))
+        primitive (when-not direct (facts/primitive-interface arity (:arglists metadata)))
+        hint (or (jvm/source-tag (:form (:site ctx)))
+                 (jvm/source-tag (facts/signature arity (:arglists metadata)))
+                 (when (and (not direct) (not primitive) (= :global (:op (:node function)))) (:hint (:jvm function)))
+                 (:tag metadata))
+        [supply args] (parse-forms supply inner (vec (rest forms)))
+        class-arg (some-> args first :node)
+        node (cond
+               (and (= :global (:op (:node function))) (= 'clojure.core/instance? (:name (:node function)))
+                    (= 2 (count args)) (= :literal (:op class-arg)) (class? (:value class-arg)))
+               {:op :host :operation {:op :instanceof :class (:value class-arg)} :args [(nth args 1)]}
+               direct {:op :host :operation direct :args args}
+               primitive {:op :host :operation {:op :instance :class primitive :member 'invokePrim :mode :method :tags nil}
+                          :args (into [function] args)}
+               :else {:op :invoke :function function :args args})]
+    (let [method (when-not (or direct primitive) (facts/protocol-call arity function))
+          fnode (:node function) key (:form (:site function))]
+      (cond
+        (and method (= :global (:op fnode)))
+        (protocol-call supply ctx {:hint hint :var-meta {}} method (:name fnode) args)
+        (and (= :literal (:op fnode)) (keyword? key) (= 1 arity)
+             (effects (nth args 0)))
+        (keyword-call supply ctx {:hint hint :var-meta {}} key (nth args 0))
+        :else [supply (expression ctx {:hint hint :var-meta {}} node)]))))
+
+(np/defpass parse-host
+  {:from [j/JVM Syntax] :to (t/HVec [l/Bound-Supply l/Bound-Expr])
+   :args [l/Bound-Supply l/Bound-Context] :body true}
+  [supply ctx syntax]
+  (let [[supply args] (parse-forms supply (assoc ctx :statement? false :tail? false) (:operands syntax))]
+    [supply (expression ctx {:hint (jvm/source-tag (:form (:site ctx))) :var-meta {}}
+                        {:op :host :operation (:operation syntax) :args args})]))
+
+(np/defpass parse-assignment
+  {:from [l/Bound Forms] :to (t/HVec [l/Bound-Supply l/Bound-Expr])
+   :args [l/Bound-Supply l/Bound-Context (t/U ':setq ':psetq)] :body true}
+  [supply ctx kind forms]
+  (if (even? (count forms))
+    (let [[supply pairs]
+          (reduce (fn [^{::t/- (t/HVec [l/Bound-Supply l/Bound-Assignments])} acc ^{::t/- (t/Seq t/Any)} pair]
+                    (let [[supply pairs] acc target (first pair)]
+                      (when-not (simple-symbol? target)
+                        (errors/fail :invalid-assignment "Assignment targets must be simple symbols" {:binding target} (:site ctx)))
+                      (let [local (or (get (:locals ctx) target)
+                                      (errors/fail :unknown-assignment "Expected a mutable loophole local" {:binding target} (:site ctx)))]
+                        (when-not (:mutable? local)
+                          (errors/fail :immutable-assignment "Cannot assign to an immutable local" {:binding target} (:site ctx)))
+                        (let [[supply value] (parse-operand supply ctx (second pair))]
+                          [supply (conj pairs {:target local :value value})])))) [supply []] (partition 2 forms))]
+      [supply (expression ctx {:hint (jvm/source-tag (:form (:site ctx))) :var-meta {}}
+                          (if (= kind :setq) {:op :setq :pairs pairs} {:op :psetq :pairs pairs}))])
+    (errors/fail :invalid-assignment "setq/psetq requires symbol/value pairs" {} (:site ctx))))
+
+(np/defpass parse-marker
+  {:from [l/Bound Forms] :to [l/Bound Expr] :args [l/Bound-Context (t/U ':label ':goto)] :body true}
+  [ctx kind forms]
+  (let [name (second forms)]
+    (when-not (and (= 2 (count forms)) (simple-symbol? name))
+      (errors/fail :invalid-marker "label/goto requires one simple symbol" {:label name} (:site ctx)))
+    (when-not (and (:statement? ctx) (:transfer? ctx) (or (= kind :goto) (:outer? ctx)))
+      (errors/fail :marker-position "Labels require the outer body; goto requires a statement outside operands and initializers"
+                   {:operator kind :label name} (:site ctx)))
+    (when (and (= kind :label) (= name 'end))
+      (errors/fail :reserved-label "end is reserved" {:label name} (:site ctx)))
+    (expression ctx {:hint nil :var-meta {}}
+                (if (= kind :label) {:op :label :name name}
+                    {:op :goto :name name}))))
+
+(np/defpass parse-list
+  {:from [l/Bound Forms] :to (t/HVec [l/Bound-Supply l/Bound-Expr])
+   :args [l/Bound-Supply l/Bound-Context] :body true}
+  [supply ctx forms]
+  (let [op (first forms) form (:form (:site ctx)) resolved (resolve-name ctx op)
+        marker (when (var? resolved) (get (:markers ctx) resolved))
+        _ (when (var? resolved) (errors/check-visibility resolved (:site ctx)))]
+    (cond
+      (= :loophole marker)
+      (errors/fail :unsupported-form "Nested loophole regions are unsupported" {:operator op} (:site ctx))
+      (= :setq marker) (parse-assignment supply ctx :setq (vec (rest forms)))
+      (= :psetq marker) (parse-assignment supply ctx :psetq (vec (rest forms)))
+      (= :label marker) [supply (parse-marker ctx :label forms)]
+      (= :goto marker) [supply (parse-marker ctx :goto forms)]
+      (= op 'quote)
+      (if (= 2 (count forms))
+        [supply (expression ctx {:hint nil :var-meta {}} {:op :literal :value (second forms)})]
+        (errors/fail :invalid-quote "quote requires one argument" {} (:site ctx)))
+      (= op 'var)
+      (let [name (second forms) resolved (when (symbol? name) (ns-resolve *ns* name))]
+        (if (and (= 2 (count forms)) (var? resolved))
+          [supply (expression ctx {:hint nil :var-meta {}}
+                              {:op :var :name (.toSymbol ^clojure.lang.Var resolved)})]
+          (errors/fail :invalid-var "var requires a resolvable Var name" {} (:site ctx))))
+      (#{'fn* 'letfn* 'try 'set! 'monitor-enter 'monitor-exit} op)
+      (errors/fail :unsupported-form "Form is unsupported inside loophole; place it outside the region" {:operator op} (:site ctx))
+      (#{'new '.} op) (parse-host supply ctx (or (host/syntax ctx forms)
+                                                (errors/fail :invalid-interop "Missing host syntax" {} (:site ctx))))
+      (= op 'do) (parse-body supply ctx (vec (rest forms)))
+      (= op 'let*) (parse-scope supply ctx false forms)
+      (= op 'loop*) (parse-loop supply ctx forms)
+      (= op 'recur) (parse-recur supply ctx forms)
+      (= op 'case*) (parse-dispatch supply ctx forms)
+      (and (= resolved #'clojure.core/case) (< (count forms) 2))
+      (errors/fail :invalid-case "case requires a dispatch expression" {} (:site ctx))
+      (= resolved #'clojure.core/case) (parse-case supply ctx forms)
+      (= op 'if)
+      (if (<= 3 (count forms) 4)
+        (let [[supply test] (parse-operand supply ctx (second forms))
+              [supply yes] (parse supply (assoc ctx :outer? false) (nth forms 2))
+              [supply no] (parse supply (assoc ctx :outer? false) (get forms 3))]
+          [supply (expression ctx {:hint (jvm/source-tag form) :var-meta {}} {:op :if :test test :then yes :else no})])
+        (errors/fail :invalid-if "if requires a test, then, and optional else" {} (:site ctx)))
+      (= op 'throw)
+      (if (= 2 (count forms))
+        (let [[supply value] (parse-operand supply ctx (second forms))]
+          [supply (expression ctx {:hint nil :var-meta {}} {:op :throw :value value})])
+        (errors/fail :invalid-throw "throw requires one value" {} (:site ctx)))
+      (and (symbol? op) (special-symbol? op))
+      (errors/fail :unsupported-form "Special form is not supported inside loophole" {:operator op} (:site ctx))
+      (and (var? resolved) (:macro (meta resolved)))
+      (let [expanded (.applyTo ^clojure.lang.Var resolved (cons form (cons (:macro-env ctx) (rest forms))))
+            expanded (if (instance? clojure.lang.IObj expanded)
+                       (with-meta expanded (merge (meta expanded) (meta form))) expanded)]
+        (parse supply ctx expanded))
+      (and (var? resolved) (ifn? (:inline (meta resolved)))
+           (let [arity (:inline-arities (meta resolved))] (or (nil? arity) (and (ifn? arity) (.invoke ^clojure.lang.IFn arity (dec (count forms)))))))
+      (let [inline (:inline (meta resolved))
+            expanded (if (ifn? inline) (.applyTo ^clojure.lang.IFn inline (rest forms))
+                         (errors/fail :invalid-expression "Invalid inline expander" {} (:site ctx)))
+            expanded (if (instance? clojure.lang.IObj expanded)
+                       (with-meta expanded (merge (meta expanded) (meta form))) expanded)]
+        (parse supply ctx expanded))
+      :else (if-let [syntax (host/syntax ctx forms)]
+              (parse-host supply ctx syntax)
+              (parse-call supply ctx forms)))))
+
+(np/defpass parse-collection
+  {:from [l/Bound Raw] :to (t/HVec [l/Bound-Supply l/Bound-Expr])
+   :args [l/Bound-Supply l/Bound-Context] :body true}
+  [supply ctx form]
+  (if (or (vector? form) (map? form) (set? form))
+    (let [kind (cond (vector? form) :vector (map? form) :map :else :set)
+          ;; Freeze source traversal before alpha-renaming changes element hashes.
+          items (if (map? form) (vec (mapcat identity form)) (vec form))
+          inner (assoc ctx :statement? false :tail? false)
+          [supply items] (parse-forms supply inner items)
+          [supply metadata] (if (some? (meta form)) (parse-operand supply inner (meta form)) [supply nil])]
+      [supply (expression ctx {:hint (jvm/source-tag form) :var-meta {}}
+                          {:op :collection :kind kind :items items :metadata metadata})])
+    (errors/fail :invalid-expression "Expected a collection" {} (:site ctx))))
+
+(np/defpass parse
+  {:from [l/Bound Raw] :to (t/HVec [l/Bound-Supply l/Bound-Expr])
+   :args [l/Bound-Supply l/Bound-Context] :body true}
+  [supply ctx form]
+  (let [ctx (assoc ctx :site (errors/site (:site ctx) form))]
+    (cond
+      (symbol? form) [supply (parse-symbol ctx form)]
+      (and (seq? form) (seq form)) (parse-list supply ctx (vec form))
+      (or (vector? form) (map? form) (set? form))
+      (parse-collection supply ctx form)
+      :else [supply (expression ctx {:hint (jvm/source-tag form) :var-meta {}} {:op :literal :value form})])))
diff --git a/src/com/tailrecursion/blacktide/compiler/source_case.clj b/src/com/tailrecursion/blacktide/compiler/source_case.clj
new file mode 100644
index 0000000..7d565c7
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/source_case.clj
@@ -0,0 +1,42 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.source-case
+  "Ask core case to select source-arm ordinals. Constants stay opaque, while
+  source bodies remain unique. Decode prepared case* tables without evaluating them."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as s]
+            [typed.clojure :as-alias t]))
+
+(np/defpass expand-case
+  {:from [s/Bound Forms] :to [s/Bound CaseSyntax] :args [(t/Map t/Sym t/Any)] :body true}
+  [env forms]
+  (let [_ (when (< (count forms) 2)
+            (.applyTo ^clojure.lang.Var #'clojure.core/case (cons (apply list forms) (cons env (rest forms)))))
+        clauses (subvec forms 2) pairs (vec (partition 2 clauses)) default? (odd? (count clauses))
+        arms (cond-> (mapv second pairs) default? (conj (peek clauses)))
+        clauses (into [] (mapcat (fn [^{::t/- t/Int} index] [(first (nth pairs index)) index])) (range (count pairs)))
+        clauses (cond-> clauses default? (conj (count pairs)))
+        form (list* 'clojure.core/case (second forms) clauses)]
+    {:selector (.applyTo ^clojure.lang.Var #'clojure.core/case (cons form (cons env (rest form)))) :arms arms}))
+
+(np/defpass int32 {:from [s/Bound Raw] :to t/Int :body true}
+  [value]
+  (if (instance? Number value) (.intValue ^Number value)
+      (throw (IllegalArgumentException. "case* expects numeric dispatch data"))))
+
+(np/defpass dispatch-syntax {:from [s/Bound Forms] :to [s/Bound DispatchSyntax] :body true}
+  [forms]
+  (let [_ (when-not (<= 8 (count forms) 9) (throw (IllegalArgumentException. "Malformed case*")))
+        [_ value shift mask default table switch test skip] forms]
+    (when-not (and (map? table) (seq table) (#{:compact :sparse} switch)
+                   (#{:int :hash-equiv :hash-identity} test) (or (nil? skip) (set? skip)))
+      (throw (IllegalArgumentException. "Malformed case* dispatch table")))
+    (let [[tests arms]
+          (reduce (fn [^{::t/- (t/HVec [(t/Map t/Int (t/HVec [t/Any t/Int])) s/Bound-Forms])} acc
+                       ^{::t/- (t/HVec [t/Any t/Any])} entry]
+                    (let [[tests arms] acc [key pair] entry]
+                      (when-not (and (vector? pair) (= 2 (count pair)))
+                        (throw (IllegalArgumentException. "case* table entries require constant/body pairs")))
+                      [(assoc tests (int32 key) [(if (= :int test) (int32 (first pair)) (first pair)) (count arms)])
+                       (conj arms (second pair))])) [{} []] (mapv (fn [[key value]] [key value]) table))]
+      {:value value :arms (conj arms default)
+       :spec {:shift (int32 shift) :mask (int32 mask) :default (count arms) :tests tests
+              :switch switch :test test :skip (when skip (set (map int32 skip)))}})))
diff --git a/src/com/tailrecursion/blacktide/compiler/source_host.clj b/src/com/tailrecursion/blacktide/compiler/source_host.clj
new file mode 100644
index 0000000..5e8f5b7
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/source_host.clj
@@ -0,0 +1,72 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.source-host
+  "Recognize native JVM syntax with the source lexical environment. Return host
+  descriptors and ordered source operands; none of those operands is evaluated."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as s]
+            [com.tailrecursion.blacktide.compiler.jvm-languages :as l]
+            [com.tailrecursion.blacktide.compiler.jvm :as jvm]
+            [typed.clojure :as-alias t]))
+
+(np/defpass tags {:from [l/JVM Raw] :to [l/JVM Tags] :body true}
+  [symbol]
+  (let [tags (:param-tags (meta symbol))]
+    (if (or (nil? tags) (vector? tags)) tags
+        (throw (IllegalArgumentException. "param-tags must be a vector")))))
+
+(np/defpass qualified
+  {:from [l/JVM Raw] :to (t/Option l/JVM-Operation) :body true}
+  [symbol]
+  (when (and (symbol? symbol) (namespace symbol))
+    (when-let [class (jvm/resolved-class (clojure.core/symbol (or (namespace symbol) "")))]
+      (let [member (name symbol) tags (tags symbol)]
+        (cond (= member "new") {:op :constructor :class class :tags tags}
+              (.startsWith member ".") {:op :instance :class class :member (clojure.core/symbol (subs member 1))
+                                         :mode :method :tags tags}
+              (and (clojure.lang.Reflector/getField class member true)
+                   (not (jvm/static-method? class member)))
+              {:op :static-field :class class :member (clojure.core/symbol member)}
+              :else {:op :static :class class :member (clojure.core/symbol member) :tags tags})))))
+
+(np/defpass syntax
+  {:from [s/Bound Forms] :to (t/Option l/JVM-Syntax) :args [s/Bound-Context] :body true}
+  [ctx forms]
+  (let [op (first forms) args (subvec forms 1)]
+    (cond
+      (= op 'new)
+      (if-let [class (jvm/resolved-class (first args))]
+        {:operation {:op :constructor :class class :tags nil} :operands (vec (rest args))}
+        (throw (IllegalArgumentException. "new requires a class name")))
+      (= op '.)
+      (let [[target member & extra] args
+            _ (when (< (count forms) 3) (throw (IllegalArgumentException. "Malformed member expression")))
+            class (jvm/resolved-class target)
+            method? (seq? member)
+            values (if method? (vec (rest member)) (vec extra))
+            member (if method? (first member) member)]
+        (when-not (symbol? member) (throw (IllegalArgumentException. "Expected a Java member name")))
+        (let [field? (.startsWith (name member) "-")
+              member (symbol (if field? (subs (name member) 1) (name member)))
+              mode (cond field? :field (or method? (seq values)) :method :else :member)]
+          (if class
+            (if (and (not= mode :method)
+                     (or field? (empty? (jvm/methods class 0 true member))))
+              {:operation {:op :static-field :class class :member member} :operands []}
+              {:operation {:op :static :class class :member member :tags nil} :operands values})
+            {:operation {:op :instance :class nil :member member :mode mode :tags nil}
+             :operands (into [target] values)})))
+      (symbol? op)
+      (cond
+        (and (nil? (namespace op)) (.startsWith (name op) "."))
+        (let [target (first args)
+              target (if (jvm/resolved-class target)
+                       (with-meta (list 'clojure.core/identity target) {:tag 'java.lang.Class}) target)]
+          (when (empty? args) (throw (IllegalArgumentException. "Instance member requires a receiver")))
+          (syntax ctx (into ['. target (symbol (subs (name op) 1))] (rest args))))
+        (.endsWith (name op) ".")
+        (syntax ctx (into ['new (symbol (subs (str op) 0 (dec (count (str op)))))] args))
+        :else (when-let [operation (qualified op)]
+                (when (and (= :instance (:op operation)) (empty? args))
+                  (throw (IllegalArgumentException. "Qualified instance call requires a receiver")))
+                (when (and (= :static-field (:op operation)) (seq args))
+                  (throw (IllegalArgumentException. "Cannot invoke a static field with arguments")))
+                {:operation operation :operands args})))))
diff --git a/src/com/tailrecursion/blacktide/compiler/source_jvm.clj b/src/com/tailrecursion/blacktide/compiler/source_jvm.clj
new file mode 100644
index 0000000..45d2fc2
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/source_jvm.clj
@@ -0,0 +1,149 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.source-jvm
+  "Infer source expression and binding facts before normalization erases native
+  typing evidence. Mutable locals use declared hints, never initializer guesses."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as s]
+            [com.tailrecursion.blacktide.compiler.jvm-languages :as l]
+            [com.tailrecursion.blacktide.compiler.jvm :as jvm]
+            [typed.clojure :as-alias t]))
+
+(np/defpass signature
+  {:from [l/JVM Raw] :to (t/Option (t/Vec t/Any)) :args [t/Int] :body true}
+  [arity arglists]
+  (when-let [entries (when (or (seq? arglists) (vector? arglists)) (seq arglists))]
+    (let [sig (first entries)]
+      (if (and (vector? sig)
+               (or (= arity (count sig))
+                   (let [offset (count (take-while #(not= '& %) sig))]
+                     (and (< offset (count sig)) (<= offset arity)))))
+        sig
+        (signature arity (next entries))))))
+
+(np/defpass primitive-interface
+  {:from [l/JVM Raw] :to (t/Option java.lang.Class) :args [t/Int] :body true}
+  [arity arglists]
+  (when-let [sig (signature arity arglists)]
+    (when (= arity (count sig))
+      (when-let [name (clojure.lang.Compiler$FnMethod/primInterface sig)]
+        (clojure.lang.RT/classForNameNonLoading name)))))
+
+(np/defpass direct-call
+  {:from [s/Bound Expr] :to (t/Option l/JVM-Operation) :args [t/Int] :body true}
+  [arity function]
+  (let [node (:node function)]
+    (when (and (:direct-linking *compiler-options*) (= :global (:op node)))
+      (let [v (ns-resolve *ns* (:name node))]
+        (when (and (var? v) (not (.isDynamic ^clojure.lang.Var v))
+                   (not (:redef (:var-meta (:jvm function)))) (.isBound ^clojure.lang.Var v))
+          (when-let [value (.get ^clojure.lang.Var v)]
+            (let [^Class class (.getClass ^Object value) members (.getMethods class)
+                  selected (first (filter
+                                    (fn [^{::t/- java.lang.reflect.Method :tag java.lang.reflect.Method} member]
+                                      (let [params (jvm/parameters member)]
+                                        (and (= "invokeStatic" (.getName member))
+                                             (java.lang.reflect.Modifier/isStatic (.getModifiers member))
+                                             (or (= arity (count params))
+                                                 (and (> arity (count params)) (= clojure.lang.ISeq (peek params)))))))
+                                    (mapv (fn [^{::t/- t/Int} index] (aget members (int index))) (range (alength members)))))]
+              (when selected
+                (let [params (jvm/parameters selected)]
+                  {:op :direct :class class :parameters params :return (jvm/return-type selected)
+                   :variadic? (= clojure.lang.ISeq (peek params))})))))))))
+
+(np/defpass protocol-class {:from [l/JVM Raw] :to (t/Option java.lang.Class) :body true}
+  [on]
+  (when (or (class? on) (symbol? on)) (clojure.lang.Compiler$HostExpr/maybeClass on false)))
+
+(np/defpass protocol-call
+  {:from [s/Bound Expr] :to (t/Option l/JVM-Protocol) :args [t/Int] :body true}
+  [arity function]
+  ;; InvokeExpr reads protocol metadata after analyzing the operands. A macro
+  ;; in an argument may change it; later source must not change this call.
+  (when (= :global (:op (:node function)))
+    (let [v (ns-resolve *ns* (:name (:node function)))
+          protocol (:protocol (meta v))]
+      (when protocol
+        (when-not (and (var? protocol) (pos? arity))
+          (throw (IllegalArgumentException. "A protocol call requires a protocol Var and receiver")))
+        (let [value (.get ^clojure.lang.Var protocol) class (protocol-class (:on value))]
+          (if class
+            (let [member (get (:method-map value) (keyword (name (:name (:node function)))))
+                  methods (when (keyword? member) (jvm/methods class (dec arity) false (symbol member)))]
+              (when-not (and (keyword? member) (= 1 (count methods)))
+                (throw (IllegalArgumentException. "No single protocol interface method matches the call")))
+              {:class class :member (symbol (clojure.lang.Compiler/munge (str (symbol member))))
+               :parameters (jvm/parameters (first methods))})
+            {:class nil :member nil :parameters []}))))))
+
+(np/defpass infer
+  {:from [s/Bound Node] :to [l/JVM Fact] :args [l/JVM-Seed] :body true}
+  [seed node]
+  (let [hint (when (#{:local :global :invoke :host} (:op node)) (jvm/tag-class (:hint seed)))
+        fact (fn ^{::t/- [l/JVM-Type t/Bool :-> l/JVM-Fact]} describe [type primitive?]
+               (jvm/fact primitive? seed (or hint type)))
+        inherited (fn ^{::t/- [l/JVM-Fact :-> l/JVM-Fact]} inherit [value]
+                    (assoc (fact (:type value) (:primitive? value)) :hint-error (:hint-error value)))]
+    (case (:op node)
+      :literal (let [type (jvm/literal-type (:value node))]
+                 (fact type (boolean (and (class? type) (.isPrimitive ^Class type)))))
+      :local (let [local (:jvm (:local node))]
+               (when (and hint (:primitive? local) (not= hint (:type local)))
+                 (throw (UnsupportedOperationException. "Can't type hint a primitive local with a different type")))
+               (inherited local))
+      :global (fact (or hint (jvm/tag-class (:tag (:var-meta seed))) :unknown) false)
+      :var (fact clojure.lang.Var false)
+      :invoke (let [metadata (:var-meta (:jvm (:function node)))
+                    sig (signature (count (:args node)) (:arglists metadata))]
+                (fact (or hint (jvm/tag-class (jvm/source-tag sig))
+                          (when (= :global (:op (:node (:function node)))) (:type (:jvm (:function node))))
+                          :unknown) false))
+      :host (let [operation (:operation node)
+                  types (mapv #(jvm/value-type (:jvm %)) (:args node))
+                  type (jvm/host-type types operation)
+                  value (fact type (boolean (and (class? type) (.isPrimitive ^Class type)
+                                                 (not (#{:adapt} (:op operation))))))]
+              (assoc value :hint-error (jvm/hint-conflict hint type)))
+      :collection (let [constant? (and (seq (:items node)) (nil? (:metadata node)) (every? #(= :literal (:op (:node %))) (:items node)))]
+                    (case (:kind node)
+                      :vector (if constant? (fact clojure.lang.APersistentVector false) (fact clojure.lang.IPersistentVector false))
+                      :map (if constant? (fact clojure.lang.APersistentMap false) (fact clojure.lang.IPersistentMap false))
+                      :set (if constant? (fact clojure.lang.APersistentSet false) (fact clojure.lang.IPersistentSet false))))
+      :if (let [a (:jvm (:then node)) b (:jvm (:else node))]
+            (assoc (fact (jvm/join-type (:type a) (:type b))
+                         (and (:primitive? a) (:primitive? b) (= (:type a) (:type b))))
+                   :hint-error (or (:hint-error a) (:hint-error b))))
+      :case (let [values (reduce (fn [^{::t/- (t/Vec l/JVM-Fact)} values ^{::t/- s/Bound-Expr} arm]
+                                  (if (= :throw (:op (:node arm))) values (conj values (:jvm arm)))) [] (:arms node))
+                  type (some-> values first :type)
+                  type (if (and (class? type) (every? #(and (= type (:type %)) (nil? (:hint-error %))) values)) type :unknown)]
+              (fact type (boolean (and (class? type) (.isPrimitive ^Class type)))))
+      :dispatch (fact Long/TYPE true)
+      :do (if-let [last (peek (:forms node))] (inherited (:jvm last)) (fact nil false))
+      :let (inherited (:jvm (:body node)))
+      :loop (fact :unknown false)
+      :recur (fact :unknown false)
+      :setq (if-let [last (peek (:pairs node))] (inherited (:jvm (:value last))) (fact nil false))
+      :psetq (fact nil false)
+      :label (fact nil false)
+      :goto (fact :unknown false)
+      :throw (fact :unknown false))))
+
+(np/defpass binding-facts
+  {:from [l/JVM Fact] :to [l/JVM Fact] :args [l/JVM-Raw t/Bool] :body true}
+  [name mutable? init]
+  (let [hint (jvm/source-tag name) type (jvm/tag-class hint)]
+    (when-not mutable? (jvm/value-type init))
+    (when (and (not mutable?) hint (:primitive? init))
+      (throw (UnsupportedOperationException. "Can't type hint a local with a primitive initializer")))
+    (jvm/fact (and (not mutable?) (:primitive? init)) {:hint hint :var-meta {}}
+      (cond mutable? (or type :unknown)
+            (and (class? (:type init)) (.isPrimitive ^Class (:type init)) (not (:primitive? init))) :unknown
+            :else (or type (:type init))))))
+
+(np/defpass caller-facts
+  {:from [l/JVM Raw] :to [l/JVM Fact] :args [t/Sym] :body true}
+  [name ^clojure.lang.Compiler$LocalBinding binding]
+  (if (instance? clojure.lang.Compiler$LocalBinding binding)
+    (jvm/fact (boolean (.getPrimitiveType binding)) {:hint (jvm/source-tag name) :var-meta {}}
+              (if (.hasJavaClass binding) (.getJavaClass binding) :unknown))
+    (jvm/fact false {:hint (jvm/source-tag name) :var-meta {}} (or (jvm/tag-class (jvm/source-tag name)) :unknown))))
diff --git a/src/com/tailrecursion/blacktide/compiler/source_languages.clj b/src/com/tailrecursion/blacktide/compiler/source_languages.clj
new file mode 100644
index 0000000..fc43c9c
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/source_languages.clj
@@ -0,0 +1,93 @@
+(ns com.tailrecursion.blacktide.compiler.source-languages
+  "Bound source separates executable children from source/provenance data.
+  Raw forms, macro environments and JVM hints are external compiler inputs."
+  (:require [com.tailrecursion.nanopass :as np]
+            [typed.clojure :as-alias t]
+            [com.tailrecursion.blacktide.compiler.jvm-languages :as j]))
+
+(np/deflanguage Bound
+  {Raw t/Any
+   Forms (t/Vec Raw)
+   Site (t/HMap :mandatory {:form Raw :file (t/Option t/Str)
+                            :line (t/Option t/Int) :column (t/Option t/Int)} :complete? true)
+   Jvm j/JVM-Fact
+   Local (t/HMap :mandatory {:id t/Sym :name t/Sym :mutable? t/Bool :external? t/Bool
+                             :jvm Jvm} :complete? true)
+   Binding (t/HMap :mandatory {:local Local :init Expr} :complete? true)
+   Bindings (t/Vec Binding)
+   Assignment (t/HMap :mandatory {:target Local :value Expr} :complete? true)
+   Assignments (t/Vec Assignment)
+   RecurTarget (t/HMap :mandatory {:id t/Sym :bindings (t/Vec Local)} :complete? true)
+   CaseSpec (t/HMap :mandatory {:shift t/Int :mask t/Int :default t/Int
+                                :tests (t/Map t/Int (t/HVec [Raw t/Int]))
+                                :switch (t/U ':compact ':sparse)
+                                :test (t/U ':int ':hash-equiv ':hash-identity)
+                                :skip (t/Option (t/Set t/Int))} :complete? true)
+   CaseSyntax (t/HMap :mandatory {:selector Raw :arms Forms} :complete? true)
+   DispatchSyntax (t/HMap :mandatory {:value Raw :spec CaseSpec :arms Forms} :complete? true)
+   Exprs (t/Vec Expr)
+   CollectionKind (t/U ':vector ':map ':set)
+   Expr (t/HMap :mandatory {:site Site :jvm Jvm :node Node} :complete? true)
+   Node (t/U (t/HMap :mandatory {:op ':literal :value Raw} :complete? true)
+             (t/HMap :mandatory {:op ':local :local Local} :complete? true)
+             (t/HMap :mandatory {:op ':global :name t/Sym} :complete? true)
+             (t/HMap :mandatory {:op ':var :name t/Sym} :complete? true)
+             (t/HMap :mandatory {:op ':host :operation j/JVM-Operation :args (t/Vec Expr)} :complete? true)
+             (t/HMap :mandatory {:op ':invoke :function Expr :args (t/Vec Expr)} :complete? true)
+             (t/HMap :mandatory {:op ':collection :kind CollectionKind :items Exprs
+                                 :metadata (t/Option Expr)} :complete? true)
+             (t/HMap :mandatory {:op ':setq :pairs Assignments} :complete? true)
+             (t/HMap :mandatory {:op ':psetq :pairs Assignments} :complete? true)
+             (t/HMap :mandatory {:op ':if :test Expr :then Expr :else Expr} :complete? true)
+             (t/HMap :mandatory {:op ':case :selector Expr :arms Exprs} :complete? true)
+             (t/HMap :mandatory {:op ':dispatch :value Expr :spec CaseSpec} :complete? true)
+             (t/HMap :mandatory {:op ':throw :value Expr} :complete? true)
+             (t/HMap :mandatory {:op ':label :name t/Sym} :complete? true)
+             (t/HMap :mandatory {:op ':goto :name t/Sym} :complete? true)
+             (t/HMap :mandatory {:op ':do :forms (t/Vec Expr)} :complete? true)
+             (t/HMap :mandatory {:op ':let :bindings (t/Vec Binding) :body Expr} :complete? true)
+             (t/HMap :mandatory {:op ':loop :id t/Sym :bindings (t/Vec Binding) :body Expr} :complete? true)
+             (t/HMap :mandatory {:op ':recur :target RecurTarget :args (t/Vec Expr)} :complete? true))
+   Supply (t/HMap :mandatory {:prefix t/Str :next t/Int} :complete? true)
+   Context (t/HMap :mandatory {:locals (t/Map t/Sym Local) :macro-env (t/Map t/Sym Raw)
+                               :markers (t/Map t/AnyVar t/Kw) :outer? t/Bool :transfer? t/Bool
+                               :site Site
+                               :recur (t/Option RecurTarget) :statement? t/Bool :tail? t/Bool} :complete? true)})
+
+(np/derive-language Native Bound
+  {:remove {Node #{:setq :psetq :label :goto}}})
+
+(np/derive-language Classified Bound
+  {:add {Node [(t/HMap :mandatory {:op ':native :value com.tailrecursion.blacktide.compiler.source-languages/Native-Expr}
+                       :complete? true)]}})
+
+(np/derive-language Sequential Classified
+  {:remove {Node #{:setq}}
+   :add {Node [(t/HMap :mandatory {:op ':write :target Local :value Expr} :complete? true)]}})
+
+(np/derive-language Assigned Sequential
+  {:remove {Node #{:psetq}}})
+
+(np/derive-language Cases Assigned
+  {:remove {Node #{:case}}
+   :add {Node [(t/HMap :mandatory {:op ':select :selector Expr :arms Exprs} :complete? true)]}})
+
+(np/derive-language Collections Cases
+  {:remove {Node #{:collection}}
+   :add {Node [(t/HMap :mandatory {:op ':build :kind CollectionKind :items Exprs :unique? t/Bool
+                                  :metadata (t/Option Expr)} :complete? true)]}})
+
+(np/derive-language Prepared Collections
+  {:remove {Node #{:host}}
+   :add {Node [(t/HMap :mandatory {:op ':host-call :operation j/JVM-Operation :args (t/Vec Expr)} :complete? true)
+                (t/HMap :mandatory {:op ':convert :conversion j/JVM-Conversion :value Expr} :complete? true)]}})
+
+(np/derive-language Ordered Prepared
+  {:remove {Node #{:invoke :build :host-call :convert :recur :dispatch}}
+   :add {Node [(t/HMap :mandatory {:op ':convert :conversion j/JVM-Conversion :value Local} :complete? true)
+                (t/HMap :mandatory {:op ':dispatch :value Local :spec CaseSpec} :complete? true)
+                (t/HMap :mandatory {:op ':recur :target RecurTarget :args (t/Vec Local)} :complete? true)
+                (t/HMap :mandatory {:op ':host-call :operation j/JVM-Operation :args (t/Vec Local)} :complete? true)
+                (t/HMap :mandatory {:op ':invoke :function Local :args (t/Vec Local)} :complete? true)
+                (t/HMap :mandatory {:op ':build :kind CollectionKind :items (t/Vec Local) :unique? t/Bool} :complete? true)
+                (t/HMap :mandatory {:op ':metadata :value Local :metadata Local} :complete? true)]}})
diff --git a/src/com/tailrecursion/blacktide/compiler/source_values.clj b/src/com/tailrecursion/blacktide/compiler/source_values.clj
new file mode 100644
index 0000000..52713ab
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/source_values.clj
@@ -0,0 +1,36 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.source-values
+  "Restore primitive source-local reads before compiler temporaries exist.
+  Clojure boxes each Object use of a primitive local independently; a machine
+  slot must not turn those reads into aliases of one box. Native trees already
+  preserve this behavior, and mutable locals have reference semantics."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.source-languages :as s]
+            [typed.clojure :as-alias t]))
+
+(declare expression forms binding-form pair pairs)
+
+(np/defpass node
+  {:from [s/Classified Node] :to [s/Classified Node]
+   :processors {Expr expression Exprs forms Binding binding-form Assignments pairs
+                Local clojure.core/identity Raw clojure.core/identity
+                CollectionKind clojure.core/identity RecurTarget clojure.core/identity CaseSpec clojure.core/identity}}
+  [node]
+  :native node)
+
+(np/defpass binding-form {:from [s/Classified Binding] :to [s/Classified Binding]
+                          :processors {Expr expression Local clojure.core/identity}} [binding])
+(np/defpass pair {:from [s/Classified Assignment] :to [s/Classified Assignment]
+                  :processors {Expr expression Local clojure.core/identity}} [assignment])
+(np/defpass pairs {:from [s/Classified Assignments] :to [s/Classified Assignments]
+                   :processors {Assignment pair}} [assignments])
+(np/defpass forms {:from [s/Classified Exprs] :to [s/Classified Exprs] :processors {Expr expression}} [exprs])
+
+(np/defpass expression {:from [s/Classified Expr] :to [s/Classified Expr] :body true}
+  [expr]
+  (let [expr (assoc expr :node (node (:node expr)))
+        type (:type (:jvm expr))]
+    (if (and (= :local (:op (:node expr))) (:primitive? (:jvm expr))
+             (class? type) (.isPrimitive ^Class type) (not= Void/TYPE type))
+      (assoc expr :node {:op :host :operation {:op :static :class clojure.lang.RT
+                                             :member (symbol (str (.getName ^Class type) "Cast")) :tags [type]}
+                         :args [expr]}) expr)))
diff --git a/src/com/tailrecursion/blacktide/compiler/storage.clj b/src/com/tailrecursion/blacktide/compiler/storage.clj
new file mode 100644
index 0000000..4bb8ea6
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/storage.clj
@@ -0,0 +1,100 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.storage
+  "Select primitive storage only when every producer and consumer agrees.
+  Object observations and reference-valued native reads retain identity; loop slots
+  specialize only to long/double. Observed copies share boxing requirements;
+  reboxable results may be boxed at return when no other observer requires a box."
+  (:require [clojure.set :as set]
+            [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [com.tailrecursion.blacktide.compiler.analysis-languages :as a]
+            [com.tailrecursion.blacktide.compiler.structured-languages :as s]
+            [com.tailrecursion.blacktide.compiler.graph :as graph]
+            [com.tailrecursion.blacktide.compiler.native :as native]
+            [com.tailrecursion.blacktide.compiler.value-facts :as facts]
+            [com.tailrecursion.blacktide.compiler.box-origins :as origins]
+            [typed.clojure :as-alias t]))
+
+(np/defpass loop-slots {:from [s/Joined Expr] :to (t/Set t/Sym)}
+  [node]
+  :bind (loop-slots (:body node))
+  :join (set/union (loop-slots (:value node)) (loop-slots (:body node)))
+  :branch (set/union (loop-slots (:yes node)) (loop-slots (:no node)))
+  :switch (into #{} (mapcat loop-slots) (:arms node))
+  :loop (into (loop-slots (:body node)) (:slots node))
+  :recur #{} :return #{} :throw #{})
+
+(np/defpass cyclic? {:from [s/Joined Expr] :to t/Bool}
+  [node]
+  :bind (cyclic? (:body node))
+  :join (or (cyclic? (:value node)) (cyclic? (:body node)))
+  :branch (or (cyclic? (:yes node)) (cyclic? (:no node)))
+  :switch (boolean (some cyclic? (:arms node)))
+  :loop true :recur true :return false :throw false)
+
+(np/defpass operand-boxes
+  {:from [l/Machine Operand] :to (t/Set t/Sym) :args [s/Stored-Types] :body true}
+  [types operand]
+  (let [type (facts/atom-type types (:value operand))]
+    (if (and (class? type) (= type (:type (:jvm operand)))) #{} (graph/atom-reads (:value operand)))))
+
+(np/defpass operation-boxes
+  {:from [l/Machine Operation] :to (t/Set t/Sym) :args [s/Stored-Types (t/Set t/Sym)] :body true}
+  [types observed operation]
+  (let [rhs (:value operation)]
+    (case (:op rhs)
+      :value (if-not (contains? observed (:target operation)) #{}
+               (if (contains? types (:target operation))
+                 (if-let [source (origins/copy-source rhs)]
+                   (if (contains? types source) #{} #{(:target operation)}) #{})
+                 (graph/atom-reads (:value rhs))))
+      :host (if (#{:adapt} (:op (:operation rhs))) (graph/rhs-reads rhs)
+                (into #{} (mapcat #(operand-boxes types %)) (:args rhs)))
+      :convert (let [conversion (:conversion rhs)]
+                 (if (and (:parameter? conversion) (.isPrimitive ^Class (:type conversion)))
+                   (operand-boxes types (:value rhs)) (graph/rhs-reads rhs)))
+      :dispatch (operand-boxes types (:value rhs))
+      :native (native/boxed-reads types (:value rhs))
+      (graph/rhs-reads rhs))))
+
+(np/defpass observed-values
+  {:from [l/Machine Program] :to (t/Set t/Sym) :body true}
+  [machine]
+  (let [ops (mapcat :ops (vals (:blocks machine)))
+        initial (into (into #{} (mapcat #(graph/term-reads (:term %))) (vals (:blocks machine)))
+                      (mapcat #(if (= :value (:op (:value %))) #{} (graph/rhs-reads (:value %)))) ops)]
+    ((fn ^{::t/- [(t/Set t/Sym) :-> (t/Set t/Sym)]} solve [observed]
+       (let [next (reduce (fn [^{::t/- (t/Set t/Sym)} out ^{::t/- l/Machine-Operation} op]
+                            (if (contains? observed (:target op)) (into out (graph/rhs-reads (:value op))) out)) observed ops)]
+         (if (= observed next) observed (recur next)))) initial)))
+
+(np/defpass term-boxes
+  {:from [l/Machine Term] :to (t/Set t/Sym) :args [s/Stored-Types (t/Set t/Sym)] :body true}
+  [types reboxable term]
+  (case (:op term)
+    :return (if (and (= :local (:op (:value term))) (contains? reboxable (:id (:value term))))
+              #{} (graph/term-reads term))
+    :branch (if (= Boolean/TYPE (facts/atom-type types (:test term))) #{} (graph/term-reads term))
+    :switch (if (= Long/TYPE (facts/atom-type types (:test term))) #{} (graph/term-reads term))
+    (graph/term-reads term)))
+
+(np/defpass select-storage
+  {:from [s/Joined Expr] :to [s/Stored Program] :args [a/Analysis-Program] :body true}
+  [analysis expr]
+  ;; Clojure wraps an expression-position loop in an Object-returning call.
+  ;; Acyclic code has no such boundary: keep its return boxed so outer numeric
+  ;; overloads and native loop promotions cannot change after storage selection.
+  (let [reboxable (if (cyclic? expr) (origins/reboxable-values analysis) #{})
+        slots (loop-slots expr)
+        initial (reduce-kv
+                  (fn [^{::t/- s/Stored-Types} out ^{::t/- t/Sym} id ^{::t/- a/Analysis-Type} type]
+                    (if (and (class? type) (or (not (contains? slots id)) (#{Long/TYPE Double/TYPE} type)))
+                      (assoc out id type) out)) {} (:types analysis))
+        machine (update (:machine analysis) :blocks #(select-keys % (:reachable analysis)))
+        observed (observed-values machine)
+        blocks (vals (:blocks machine))
+        types ((fn ^{::t/- [s/Stored-Types :-> s/Stored-Types]} solve [types]
+                 (let [boxed (into (into #{} (mapcat #(operation-boxes types observed %)) (mapcat :ops blocks))
+                                   (mapcat #(term-boxes types reboxable (:term %))) blocks)
+                       next (apply dissoc types boxed)]
+                   (if (= types next) types (recur next)))) initial)]
+    {:body expr :types types}))
diff --git a/src/com/tailrecursion/blacktide/compiler/structure.clj b/src/com/tailrecursion/blacktide/compiler/structure.clj
new file mode 100644
index 0000000..5a98727
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/structure.clj
@@ -0,0 +1,163 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.structure
+  "Recover acyclic control or a single-header loop with bounded duplication.
+  Construction records block identities to preserve native construction and
+  cache sites. Dead native code keeps the dispatcher for source validation."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [com.tailrecursion.blacktide.compiler.analysis-languages :as a]
+            [com.tailrecursion.blacktide.compiler.structured-languages :as s]
+            [com.tailrecursion.blacktide.compiler.graph :as graph]
+            [typed.clojure :as-alias t]))
+
+(declare edge body)
+
+(np/defpass block
+  {:from [l/Machine Label] :to [l/Machine Block] :args [l/Machine-Program] :body true}
+  [machine id]
+  (or (get (:blocks machine) id) (throw (IllegalStateException. "Missing checked block"))))
+
+(np/defpass scan
+  {:from [l/Machine Label] :to [s/Joined Scan]
+   :args [l/Machine-Program (t/Set l/Machine-Label) s/Joined-Scan] :body true}
+  [machine path state id]
+  (let [[seen headers] state]
+    (cond (contains? path id) [seen (conj headers id)]
+          (contains? seen id) state
+          :else (reduce (fn [^{::t/- s/Joined-Scan} state ^{::t/- l/Machine-Label} next]
+                          (scan machine (conj path id) state next))
+                        [(conj seen id) headers]
+                        (graph/successors (:term (block machine id)))))))
+
+(np/defpass harmless-atom? {:from [l/Machine Atom] :to t/Bool}
+  [atom]
+  :local true
+  :literal (nil? (:value atom)))
+
+(np/defpass harmless-block? {:from [l/Machine Block] :to t/Bool :body true}
+  [block]
+  ;; Lowering leaves nil result copies after transfers. No host/native form or
+  ;; arbitrary quoted constant may disappear before Clojure validates it.
+  (and (every? (fn [op] (let [rhs (:value op)]
+                         (and (= :value (:op rhs)) (harmless-atom? (:value rhs))))) (:ops block))
+       (let [term (:term block)]
+         (case (:op term)
+           :jump true
+           (:return :throw) (harmless-atom? (:value term))
+           (:branch :switch) (harmless-atom? (:test term))))))
+
+(np/defpass wrap
+  {:from [l/Machine Block] :to [s/Joined Expr] :args [s/Joined-Expr] :body true}
+  [end block]
+  (reduce (fn [^{::t/- s/Joined-Expr} body ^{::t/- l/Machine-Operation} op]
+            {:op :bind :binding op :body body}) end (reverse (:ops block))))
+
+(np/defpass arms
+  {:from [l/Machine Term] :to [s/Joined Arms] :args [s/Joined-Context t/Bool t/Int] :body true}
+  [ctx inside? budget term]
+  (if (= :switch (:op term))
+    ((fn ^{::t/- [t/Int t/Int (t/Vec s/Joined-Expr) (t/Vec l/Machine-Label) :-> s/Joined-Arms]} build [index budget out blocks]
+       (if (= index (count (:targets term))) {:op :built :budget budget :arms out :blocks blocks}
+         (let [result (edge ctx inside? budget (nth (:targets term) index))]
+           (if (= :built (:op result))
+             (recur (inc index) (:budget result) (conj out (:expr result)) (into blocks (:blocks result))) result)))) 0 budget [] [])
+    {:op :exhausted}))
+
+(np/defpass terminator
+  {:from [l/Machine Term] :to [s/Joined Build] :args [s/Joined-Context t/Bool t/Int]}
+  [ctx inside? budget term]
+  :jump (edge ctx inside? budget (:target term))
+  :return {:op :built :budget budget :blocks [] :expr term}
+  :throw {:op :built :budget budget :blocks [] :expr term}
+  :switch (let [result (arms ctx inside? budget term)]
+            (if (= :built (:op result))
+              {:op :built :budget (:budget result) :blocks (:blocks result) :expr {:op :switch :test (:test term) :arms (:arms result)}} result))
+  :branch (let [yes (edge ctx inside? budget (:yes term))]
+            (if (= :exhausted (:op yes)) yes
+              (let [no (edge ctx inside? (:budget yes) (:no term))]
+                (if (= :exhausted (:op no)) no
+                  {:op :built :budget (:budget no) :blocks (into (:blocks yes) (:blocks no))
+                   :expr {:op :branch :test (:test term) :yes (:expr yes) :no (:expr no)}})))))
+
+(np/defpass joined
+  {:from [a/Planned Join] :to [s/Joined Build] :args [s/Joined-Context t/Bool t/Int l/Machine-Term] :body true}
+  [ctx inside? budget term join]
+  (let [inner (assoc ctx :stop [(:target join) (:result join)])
+        result (terminator inner inside? budget term)]
+    (if (= :built (:op result))
+      (let [tail (edge ctx inside? (:budget result) (:target join))]
+        (if (= :built (:op tail))
+          (assoc tail :blocks (into (:blocks result) (:blocks tail))
+                      :expr {:op :join :target (:result join) :value (:expr result) :body (:expr tail)}) tail))
+      {:op :exhausted})))
+
+(np/defpass body
+  {:from [l/Machine Label] :to [s/Joined Build] :args [s/Joined-Context t/Bool t/Int] :body true}
+  [ctx inside? budget id]
+  (let [block (block (:machine ctx) id)
+        budget (- budget (inc (count (:ops block))))]
+    (if (neg? budget) {:op :exhausted}
+      (let [result (if-let [join (get (:joins ctx) id)]
+                     (joined ctx inside? budget (:term block) join)
+                     (terminator ctx inside? budget (:term block)))]
+        (if (= :built (:op result)) (assoc result :blocks (conj (:blocks result) id) :expr (wrap (:expr result) block)) result)))))
+
+(np/defpass edge
+  {:from [l/Machine Label] :to [s/Joined Build] :args [s/Joined-Context t/Bool t/Int] :body true}
+  [ctx inside? budget id]
+  (let [stop (:stop ctx)]
+    (cond
+      (and stop (= id (first stop)))
+      {:op :built :budget budget :blocks [] :expr {:op :return :value {:op :local :id (second stop)}}}
+      (= id (:header ctx))
+      (if inside? (if (pos? budget) {:op :built :budget (dec budget) :blocks [] :expr {:op :recur :slots (:slots ctx)}}
+                      {:op :exhausted})
+        (let [result (body ctx true (dec budget) id)]
+          (if (= :built (:op result)) (assoc result :expr {:op :loop :slots (:slots ctx) :body (:expr result)}) result)))
+      :else (body ctx inside? budget id))))
+
+(np/defpass construction-site?
+  {:from [l/Machine Rhs] :to t/Bool :body true}
+  [rhs]
+  (case (:op rhs)
+    :native true
+    :convert (let [conversion (:conversion rhs)]
+               (and (:parameter? conversion)
+                    (.isAnnotationPresent ^Class (:type conversion) java.lang.FunctionalInterface)))
+    :host (let [operation (:operation rhs)]
+            (case (:op operation)
+              (:keyword-site :method-value) true
+              :adapt (.isAnnotationPresent ^Class (:class operation) java.lang.FunctionalInterface)
+              :protocol (boolean (some (fn [^Class type] (.isAnnotationPresent type java.lang.FunctionalInterface))
+                                       (:parameters (:method operation))))
+              false))
+    false))
+
+(np/defpass site-failure
+  {:from [l/Machine Program] :to (t/Option ':native-sites)
+   :args [(t/Vec l/Machine-Label)] :body true}
+  [blocks machine]
+  (let [copies (frequencies blocks)
+        repeated (mapv (fn [[id _]] (block machine id)) (filter (fn [[_ n]] (> n 1)) copies))]
+    (when (some (fn [block]
+                  (some (fn [operation] (construction-site? (:value operation)))
+                        (:ops block))) repeated)
+      :native-sites)))
+
+(np/defpass recover {:from [a/Planned Program] :to [s/Joined Decision] :body true}
+  [analysis]
+  (let [machine (:machine analysis) reachable (:reachable analysis)
+        [_ headers] (scan machine #{} [#{} #{}] (:entry machine))
+        dead (apply dissoc (:blocks machine) reachable)
+        header (first headers)]
+    (cond
+      (> (count headers) 1) {:op :fallback :reason :cycles}
+      (not (every? harmless-block? (vals dead))) {:op :fallback :reason :validation}
+      :else
+      (let [slots (if header (vec (sort (get (:live machine) header #{}))) [])
+            ctx {:machine machine :header header :slots slots :joins (:joins analysis) :stop nil}
+            budget (* 4 (reduce + 0 (map #(inc (count (:ops %))) (vals (select-keys (:blocks machine) reachable)))))
+            result (edge ctx false budget (:entry machine))]
+        (if (= :built (:op result))
+          (if-let [reason (site-failure (:blocks result) machine)]
+            {:op :fallback :reason reason} {:op :structured :body (:expr result)})
+          {:op :fallback :reason :budget})))))
diff --git a/src/com/tailrecursion/blacktide/compiler/structured_emit.clj b/src/com/tailrecursion/blacktide/compiler/structured_emit.clj
new file mode 100644
index 0000000..c0c1e5a
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/structured_emit.clj
@@ -0,0 +1,110 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.structured-emit
+  "Emit lexical control with proven storage classes. Consumer source types stay
+  distinct from storage; Java argument conversions remain explicit evaluations."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [com.tailrecursion.blacktide.compiler.structured-languages :as s]
+            [com.tailrecursion.blacktide.compiler.compact-languages :as c]
+            [com.tailrecursion.blacktide.compiler.compact :as compact]
+            [com.tailrecursion.blacktide.compiler.collections :as collections]
+            [com.tailrecursion.blacktide.compiler.jvm :as jvm]
+            [typed.clojure :as-alias t]
+            [com.tailrecursion.blacktide.compiler.emit :as emit]
+            [com.tailrecursion.blacktide.compiler.host-emit :as host]
+            [com.tailrecursion.blacktide.compiler.case-emit :as cases]))
+
+(np/defpass primitive-form
+  {:from [l/Machine Code] :to [l/Machine Code] :args [java.lang.Class] :body true}
+  [^Class type form]
+  ;; The parameter conversion is exactly the conversion previously performed by
+  ;; RT.box(type); the matching primitive cast overload itself is an identity.
+  (list (with-meta (symbol "clojure.lang.RT" (str (.getName type) "Cast")) {:param-tags [type]}) form))
+
+(np/defpass binding-form
+  {:from [l/Machine Code] :to [l/Machine Code] :args [s/Stored-Types t/Sym (t/Option java.lang.Class)] :body true}
+  [types id actual form]
+  (if-let [type (get types id)] (if (= type actual) form (primitive-form type form)) (host/box-form form)))
+
+(declare rhs-form)
+(np/defpass atom-form {:from [c/Compact Atom] :to [l/Machine Code] :args [c/Compact-Types]}
+  [types node]
+  :local (:id node)
+  :literal (list 'quote (:value node))
+  :inline (rhs-form types (:value node)))
+
+(np/defpass operand-form
+  {:from [c/Compact Operand] :to [l/Machine Code] :args [c/Compact-Types] :body true}
+  [types operand]
+  (let [form (atom-form types (:value operand)) actual (compact/atom-type types (:value operand))
+        fact (:jvm operand)]
+    (if (and (class? actual) (= actual (:type fact))) form
+      (host/typed-form (assoc fact :primitive? false) (if (class? actual) (host/box-form form) form)))))
+
+(np/defpass rhs-form
+  {:from [c/Compact Rhs] :to [l/Machine Code] :args [c/Compact-Types]}
+  [types rhs]
+  :host (host/host-form (mapv #(operand-form types %) (:args rhs)) (:operation rhs))
+  :dispatch (cases/selector-form (operand-form types (:value rhs)) (:spec rhs))
+  :convert (let [conversion (:conversion rhs) operand (:value rhs)]
+             (if (and (:parameter? conversion) (.isPrimitive ^Class (:type conversion)))
+               (if (= (:type conversion) (compact/atom-type types (:value operand)) (:type (:jvm operand)))
+                 (atom-form types (:value operand))
+                 (primitive-form (:type conversion) (operand-form types operand)))
+               (host/conversion-form conversion (:jvm operand) (atom-form types (:value operand)))))
+  :value (atom-form types (:value rhs))
+  :global (emit/rhs-form rhs) :external (emit/rhs-form rhs) :var (emit/rhs-form rhs) :native (emit/rhs-form rhs)
+  :construct (collections/form (mapv #(atom-form types %) (:items rhs)) (:unique? rhs) (:kind rhs))
+  :metadata (let [value (gensym "value__") metadata (gensym "metadata__")]
+              (list 'let* [(with-meta value {:tag 'clojure.lang.IObj}) (atom-form types (:value rhs))
+                           (with-meta metadata {:tag 'clojure.lang.IPersistentMap}) (atom-form types (:metadata rhs))]
+                    (list '. value 'withMeta metadata)))
+  :invoke (list* (atom-form types (:function rhs)) (mapv #(atom-form types %) (:args rhs))))
+
+(np/defpass rhs-type
+  {:from [c/Compact Rhs] :to (t/Option java.lang.Class) :args [c/Compact-Types] :body true}
+  [types rhs]
+  (case (:op rhs)
+    :value (compact/atom-type types (:value rhs))
+    :convert (when (:parameter? (:conversion rhs)) (:type (:conversion rhs)))
+    :host (let [type (jvm/host-type (mapv #(:type (:jvm %)) (:args rhs)) (:operation rhs))]
+            (when (and (class? type) (not (#{:adapt} (:op (:operation rhs))))) type))
+    ;; Other producers retain an explicit storage conversion.
+    nil))
+
+(np/defpass operation-form
+  {:from [c/Compact Operation] :to [l/Machine Code] :args [c/Compact-Types] :body true}
+  [types op]
+  (binding-form types (:target op) (rhs-type types (:value op)) (rhs-form types (:value op))))
+
+(declare expression)
+(np/defpass let-form {:from [c/Compact Expr] :to [l/Machine Code] :args [c/Compact-Types] :body true}
+  [types node]
+  ((fn ^{::t/- [(t/Vec t/Any) c/Compact-Expr :-> l/Machine-Code]} bindings [pairs node]
+     (case (:op node)
+       :bind (let [op (:binding node)]
+               (recur (conj pairs (:target op) (operation-form types op)) (:body node)))
+       :join (recur (conj pairs (:target node)
+                          (binding-form types (:target node) nil (expression types (:value node)))) (:body node))
+       (list 'let* pairs (expression types node)))) [] node))
+
+(np/defpass expression {:from [c/Compact Expr] :to [l/Machine Code] :args [c/Compact-Types]}
+  [types node]
+  :bind (let-form types node)
+  :effect (let [binding (:binding node) rhs (:value binding) type (get types (:target binding))
+                form (rhs-form types rhs)]
+            (list 'do (if (and type (not= type (rhs-type types rhs))) (primitive-form type form) form)
+                  (expression types (:body node))))
+  :join (let-form types node)
+  :branch (list 'if (atom-form types (:test node)) (expression types (:yes node)) (expression types (:no node)))
+  :switch (cases/arms-form (mapv #(expression types %) (:arms node)) (atom-form types (:test node)))
+  :loop (list 'loop* (vec (mapcat (fn [binding]
+                                  [(:target binding) (binding-form types (:target binding)
+                                                       (compact/atom-type types (:value binding))
+                                                       (atom-form types (:value binding)))]) (:bindings node)))
+              (expression types (:body node)))
+  :recur (list* 'recur (mapv #(atom-form types %) (:args node)))
+  :return (let [value (:value node) form (atom-form types value)]
+            ;; Tail compaction must retain the region's opaque result type.
+            (if (and (= :inline (:op value)) (= :native (:op (:value value))))
+              (host/box-form form) form))
+  :throw (list 'throw (atom-form types (:value node))))
diff --git a/src/com/tailrecursion/blacktide/compiler/structured_languages.clj b/src/com/tailrecursion/blacktide/compiler/structured_languages.clj
new file mode 100644
index 0000000..9fbdf88
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/structured_languages.clj
@@ -0,0 +1,34 @@
+(ns com.tailrecursion.blacktide.compiler.structured-languages
+  "Lexical control trees contain at most one loop target. General graph shapes remain
+  machines; bounded construction returns an explicit fallback, never partial code."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [com.tailrecursion.blacktide.compiler.analysis-languages :as a]
+            [typed.clojure :as-alias t]))
+
+(np/deflanguage Structured
+  {Expr (t/U (t/HMap :mandatory {:op ':bind :binding l/Machine-Operation :body Expr} :complete? true)
+             (t/HMap :mandatory {:op ':branch :test l/Machine-Atom :yes Expr :no Expr} :complete? true)
+             (t/HMap :mandatory {:op ':switch :test l/Machine-Atom :arms (t/Vec Expr)} :complete? true)
+             (t/HMap :mandatory {:op ':loop :slots (t/Vec t/Sym) :body Expr} :complete? true)
+             (t/HMap :mandatory {:op ':recur :slots (t/Vec t/Sym)} :complete? true)
+             (t/HMap :mandatory {:op ':return :value l/Machine-Atom} :complete? true)
+             (t/HMap :mandatory {:op ':throw :value l/Machine-Atom} :complete? true))
+   Build (t/U (t/HMap :mandatory {:op ':built :budget t/Int :blocks (t/Vec l/Machine-Label) :expr Expr} :complete? true)
+               (t/HMap :mandatory {:op ':exhausted} :complete? true))
+   Arms (t/U (t/HMap :mandatory {:op ':built :budget t/Int :blocks (t/Vec l/Machine-Label) :arms (t/Vec Expr)} :complete? true)
+              (t/HMap :mandatory {:op ':exhausted} :complete? true))
+   Scan (t/HVec [(t/Set l/Machine-Label) (t/Set l/Machine-Label)])
+   Fallback (t/U ':cycles ':validation ':budget ':native-sites)
+   Decision (t/U (t/HMap :mandatory {:op ':structured :body Expr} :complete? true)
+                 (t/HMap :mandatory {:op ':fallback :reason Fallback} :complete? true))})
+
+(np/derive-language Joined Structured
+  {:add {Expr [(t/HMap :mandatory {:op ':join :target t/Sym :value Expr :body Expr} :complete? true)]}
+   :replace {Context (t/HMap :mandatory {:machine l/Machine-Program :header (t/Option l/Machine-Label)
+                                        :slots (t/Vec t/Sym) :joins a/Planned-Joins
+                                        :stop (t/Option (t/HVec [l/Machine-Label t/Sym]))} :complete? true)}})
+
+(np/derive-language Stored Joined
+  {:replace {Types (t/Map t/Sym java.lang.Class)
+             Program (t/HMap :mandatory {:body Expr :types Types} :complete? true)}})
diff --git a/src/com/tailrecursion/blacktide/compiler/transfers.clj b/src/com/tailrecursion/blacktide/compiler/transfers.clj
new file mode 100644
index 0000000..3be932b
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/transfers.clj
@@ -0,0 +1,34 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.transfers
+  "Resolve region-local jumps after all labels exist, including dead source.
+  Source analysis admits only outer-body labels and statement-position jumps."
+  (:require [com.tailrecursion.blacktide.compiler.errors :as errors]
+            [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [typed.clojure :as-alias t]))
+
+
+(np/defpass resolve-term
+  {:from [l/Symbolic Term] :to [l/CFG Term] :args [l/Symbolic-LabelTable]}
+  [labels term]
+  :jump term
+  :branch term
+  :switch term
+  :return term
+  :throw term
+  :transfer
+  (let [target (or (get labels (:name term))
+                   (errors/fail :undefined-label "Undefined label" {:label (:name term)} (:site term)))]
+    {:op :jump :target target}))
+
+(np/defpass resolve-block
+  {:from [l/Symbolic Block] :to [l/CFG Block] :args [l/Symbolic-LabelTable] :body true}
+  [labels block]
+  (assoc block :term (resolve-term labels (:term block))))
+
+(np/defpass resolve-program
+  {:from [l/Symbolic Program] :to [l/CFG Program] :body true}
+  [program]
+  {:entry (:entry program)
+   :blocks (reduce-kv (fn [^{::t/- (t/Map l/CFG-Label l/CFG-Block)} out
+                           ^{::t/- l/Symbolic-Label} id ^{::t/- l/Symbolic-Block} block]
+                        (assoc out id (resolve-block (:labels program) block))) {} (:blocks program))})
diff --git a/src/com/tailrecursion/blacktide/compiler/value_facts.clj b/src/com/tailrecursion/blacktide/compiler/value_facts.clj
new file mode 100644
index 0000000..75d5732
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/compiler/value_facts.clj
@@ -0,0 +1,65 @@
+(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.value-facts
+  "Prove primitive results across all reachable definitions, including copy
+  cycles. Hints describe consumers; only actual primitive producers prove values."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.languages :as l]
+            [com.tailrecursion.blacktide.compiler.analysis-languages :as a]
+            [com.tailrecursion.blacktide.compiler.jvm :as jvm]
+            [com.tailrecursion.blacktide.compiler.jvm-languages :as j]
+            [com.tailrecursion.blacktide.compiler.graph :as graph]
+            [typed.clojure :as-alias t]))
+
+(np/defpass primitive {:from [j/JVM Type] :to [a/Analysis Type] :body true}
+  [type]
+  (if (and (class? type) (.isPrimitive ^Class type) (not= Void/TYPE type)) type :boxed))
+
+(np/defpass join {:from [a/Analysis Type] :to [a/Analysis Type] :args [a/Analysis-Type] :body true}
+  [a b]
+  (cond (= a :bottom) b (= b :bottom) a (= a b) a :else :boxed))
+
+(np/defpass atom-type {:from [l/Machine Atom] :to [a/Analysis Type] :args [a/Analysis-Types]}
+  [types node]
+  :local (get types (:id node) :bottom)
+  ;; Quoted Integer constants must keep their boxed identity and width.
+  :literal (cond (instance? Long (:value node)) (primitive Long/TYPE)
+                 (instance? Double (:value node)) (primitive Double/TYPE)
+                 :else :boxed))
+
+(np/defpass rhs-type {:from [l/Machine Rhs] :to [a/Analysis Type] :args [a/Analysis-Types]}
+  [types rhs]
+  :value (atom-type types (:value rhs))
+  :external (if (:primitive? (:jvm rhs)) (primitive (:type (:jvm rhs))) :boxed)
+  :convert (if (:parameter? (:conversion rhs)) (primitive (:type (:conversion rhs))) :boxed)
+  :dispatch (primitive Long/TYPE)
+  :host (if (#{:adapt} (:op (:operation rhs))) :boxed
+            (primitive (jvm/host-type (mapv #(:type (:jvm %)) (:args rhs)) (:operation rhs))))
+  :native :boxed
+  :global :boxed
+  :var :boxed
+  :construct :boxed
+  :metadata :boxed
+  :invoke :boxed)
+
+(np/defpass definitions
+  {:from [l/Machine Program] :to [a/Analysis Definitions] :args [(t/Set l/Machine-Label)] :body true}
+  [reachable machine]
+  (reduce (fn [^{::t/- a/Analysis-Definitions} out ^{::t/- l/Machine-Operation} op]
+            (assoc out (:target op) (conj (get out (:target op) []) (:value op))))
+          {} (mapcat :ops (vals (select-keys (:blocks machine) reachable)))))
+
+(np/defpass solve {:from [a/Analysis Definitions] :to [a/Analysis Types] :body true}
+  [definitions]
+  ((fn ^{::t/- [a/Analysis-Types :-> a/Analysis-Types]} fixed-point [types]
+     (let [next (reduce-kv
+                  (fn [^{::t/- a/Analysis-Types} out ^{::t/- t/Sym} id ^{::t/- (t/Vec l/Machine-Rhs)} values]
+                    (assoc out id
+                      ((fn ^{::t/- [t/Int a/Analysis-Type :-> a/Analysis-Type]} common [index type]
+                         (if (< index (count values))
+                           (recur (inc index) (join type (rhs-type types (nth values index)))) type))
+                       0 :bottom))) {} definitions)]
+       (if (= types next) next (recur next)))) {}))
+
+(np/defpass analyze {:from [l/Machine Program] :to [a/Analysis Program] :body true}
+  [machine]
+  (let [reachable (graph/reachable (graph/collect-facts {:entry (:entry machine) :blocks (:blocks machine)}) (:entry machine))]
+    {:machine machine :reachable reachable :types (solve (definitions reachable machine))}))
diff --git a/src/com/tailrecursion/blacktide/runtime.clj b/src/com/tailrecursion/blacktide/runtime.clj
new file mode 100644
index 0000000..9e6c76b
--- /dev/null
+++ b/src/com/tailrecursion/blacktide/runtime.clj
@@ -0,0 +1,7 @@
+(ns com.tailrecursion.blacktide.runtime
+  "Internal emission support. Cache literals are created during final Clojure
+  analysis, so macros duplicating an expansion still get distinct call sites."
+  (:import [com.tailrecursion.blacktide.runtime KeywordSite]))
+
+(defmacro keyword-site [keyword]
+  (list 'quote (KeywordSite. keyword)))
diff --git a/src/com/tailrecursion/nanopass.clj b/src/com/tailrecursion/nanopass.clj
new file mode 100644
index 0000000..58ff10c
--- /dev/null
+++ b/src/com/tailrecursion/nanopass.clj
@@ -0,0 +1,86 @@
+(ns com.tailrecursion.nanopass
+  "Define immutable languages and emit their Typed Clojure aliases on demand.
+  Ordinary language loading has no Typed Clojure dependency."
+  (:require [com.tailrecursion.nanopass.language :as language]
+            [com.tailrecursion.nanopass.pass :as pass]))
+
+(defn- description [name]
+  (let [v (when (symbol? name) (resolve name))]
+    (when-not (and (var? v) (::language (meta v)))
+      (language/fail :unknown-language name "Expected a nanopass language Var"))
+    @v))
+
+(defmacro deflanguage
+  "Define named nonterminals using Typed Clojure syntax. Local references are
+  rebound when deriving a language; quoted singleton values remain data."
+  [name types]
+  (when-not (and (simple-symbol? name) (map? types))
+    (language/fail :invalid-language &form "Expected a simple language name and a type map"))
+  (let [qualified (symbol (str (ns-name *ns*)) (str name))
+        types (language/qualify *ns* (set (keys types)) types)
+        value (language/language qualified types)]
+    ;; Keep each descriptor's constants in its own class during AOT compilation;
+    ;; many derived languages otherwise overflow the namespace initializer.
+    `(def ~(vary-meta name assoc ::language true) ((fn [] '~value)))))
+
+(defmacro derive-language
+  "Derive from a language with :remove tag sets, :add production vectors, and
+  :replace complete nonterminal definitions. Changes use local nonterminal names."
+  [name parent changes]
+  (when-not (and (simple-symbol? name) (map? changes))
+    (language/fail :invalid-extension &form "Expected a simple language name and a change map"))
+  (let [base (description parent)
+        names (set (concat (keys (:types base)) (keys (:replace changes))))
+        changes (language/qualify *ns* names changes)
+        value (language/derive (symbol (str (ns-name *ns*)) (str name)) base changes)]
+    `(def ~(vary-meta name assoc ::language true) ((fn [] '~value)))))
+
+(defmacro ann-languages
+  "Emit checker declarations from language descriptions in an annotation-only
+  namespace requiring typed.clojure. This macro is unnecessary in ordinary use."
+  [& languages]
+  `(do ~@(language/type-forms (map description languages))))
+
+(defmacro defpass
+  "Define a checked pass. :from and :to identify [language nonterminal]; :to may
+  instead be a result type. :args types the leading context parameters. Supply
+  tag/expression clauses; unchanged productions get structural recursion through
+  :processors (nonterminal -> function). :body true accepts one explicit body."
+  [name {:keys [from to args processors body] :as options} arguments & clauses]
+  (when-not (and (simple-symbol? name) (vector? from) (= 2 (count from))
+                 (symbol? (first from)) (simple-symbol? (second from))
+                 (contains? options :to)
+                 (or (not (vector? to)) (and (= 2 (count to)) (symbol? (first to))
+                                                           (simple-symbol? (second to))))
+                 (or (nil? args) (vector? args))
+                 (or (nil? body) (boolean? body))
+                 (or (nil? processors) (and (map? processors) (every? simple-symbol? (keys processors))
+                                                            (every? symbol? (vals processors))))
+                 (vector? arguments) (every? simple-symbol? arguments)
+                 (= (count arguments) (count (set arguments)))
+                 (= (count arguments) (inc (count args)))
+                 (every? #{:from :to :args :processors :body} (keys options)))
+    (language/fail :invalid-pass &form "Invalid pass name, signature, or options"))
+  (let [source (description (first from))
+        target (when (vector? to) (description (first to)))
+        result-type (if target (language/type-name target (second to))
+                        (language/qualify *ns* #{} to))]
+    (with-meta (pass/definition
+     {: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 (language/qualify *ns* #{} processor)])) processors)
+      :body? body}
+     clauses) (meta &form))))
+
+(defmacro ann-passes
+  "Emit checker signatures stored by defpass. The generated function bodies
+  must additionally be checked with Typed Clojure's check-ns-clj."
+  [& passes]
+  `(do ~@(for [name passes
+               :let [v (resolve name) signature (::signature (meta v))]]
+           (do (when-not signature
+                 (language/fail :unknown-pass name "Expected a defined nanopass function"))
+               (list 'typed.clojure/ann
+                     (symbol (str (ns-name (:ns (meta v)))) (str (:name (meta v)))) signature)))))
diff --git a/src/com/tailrecursion/nanopass/language.clj b/src/com/tailrecursion/nanopass/language.clj
new file mode 100644
index 0000000..a042d2b
--- /dev/null
+++ b/src/com/tailrecursion/nanopass/language.clj
@@ -0,0 +1,170 @@
+(ns com.tailrecursion.nanopass.language
+  "Immutable language descriptions from public Typed Clojure type syntax.
+  Local nonterminals remain symbolic until aliases are emitted for a language."
+  (:refer-clojure :exclude [derive])
+  (:require [clojure.set :as set]))
+
+(defn fail [kind form message & [details]]
+  (throw (ex-info message (merge {:kind kind :form form :file *file*}
+                                (select-keys (meta form) [:line :column]) details))))
+
+(defn literal-type? [form]
+  (and (seq? form) (#{'quote 'typed.clojure/Val 'typed.clojure/Value} (first form))))
+
+(defn- qualified-type-name [sym]
+  (if (= "clojure.core.typed" (namespace sym))
+    (symbol "typed.clojure" (name sym)) sym))
+
+(defn qualify
+  "Resolve type names in the defining namespace; leave local nonterminals and
+  singleton quoted values intact. No checker is loaded or consulted."
+  [caller nonterminals form]
+  (cond
+    (and (seq? form) (= 'quote (first form)))
+    (if (and (= 2 (count form)) (not (coll? (second form)))) form
+      (fail :unsupported-type form "Use explicit HMap/HVec types, or Val for a literal collection"))
+    (symbol? form)
+    (cond
+      (nonterminals form) form
+      (namespace form) (qualified-type-name
+                       (if-let [alias (get (ns-aliases caller) (symbol (namespace form)))]
+                         (symbol (str (ns-name alias)) (name form)) form))
+      :else (let [v (ns-resolve caller form)]
+              (cond (class? v) (symbol (.getName ^Class v))
+                    (var? v) (symbol (str (ns-name (:ns (meta v)))) (str (:name (meta v))))
+                    :else (fail :unknown-type form "Unknown type or nonterminal"))))
+    (seq? form) (let [op (qualify caller nonterminals (first form))]
+                  (if (#{'typed.clojure/Val 'typed.clojure/Value} op)
+                    (cons op (rest form))
+                    (cons op (map #(qualify caller nonterminals %) (rest form)))))
+    (vector? form) (mapv #(qualify caller nonterminals %) form)
+    (map? form) (into (empty form) (map (fn [[k v]] [k (qualify caller nonterminals v)])) form)
+    :else form))
+
+(defn hmap-options [form]
+  (when (= 'typed.clojure/HMap (first form))
+    (let [options (rest form)]
+      (when (or (odd? (count options))
+                (not= (count (take-nth 2 options)) (count (set (take-nth 2 options)))))
+        (fail :invalid-hmap form "HMap options must be distinct key/value pairs"))
+      (apply hash-map options))))
+
+(defn children
+  "Immediate type children in supported structural constructors. nil means an
+  opaque terminal type, whereas an empty vector means a known leaf structure."
+  [form]
+  (when (seq? form)
+    (case (first form)
+      typed.clojure/HMap (let [{:keys [mandatory optional]} (hmap-options form)]
+                          (vec (concat (vals mandatory) (vals optional))))
+      typed.clojure/HVec (second form)
+      (typed.clojure/U typed.clojure/Vec typed.clojure/Map
+       typed.clojure/Set typed.clojure/Option) (vec (rest form))
+      nil)))
+
+(defn references [nonterminals form]
+  (into #{} (filter nonterminals)
+        (tree-seq #(and (coll? %) (not (literal-type? %))) seq form)))
+
+(defn tag [form]
+  (when (and (seq? form) (= 'typed.clojure/HMap (first form)))
+    (let [value (get-in (hmap-options form) [:mandatory :op])]
+      (when (and (literal-type? value) (= 2 (count value)) (keyword? (second value)))
+        (second value)))))
+
+(defn alternatives [form]
+  (if (and (seq? form) (= 'typed.clojure/U (first form)))
+    (vec (mapcat alternatives (rest form))) [form]))
+
+(defn- validate-type [nonterminals form]
+  (when (seq? form)
+    (case (first form)
+      typed.clojure/HMap
+      (let [{:keys [mandatory optional complete?] :as options} (hmap-options form)]
+        (when-not (and (true? complete?)
+                       (every? #{:mandatory :optional :complete?} (keys options))
+                       (or (nil? mandatory) (map? mandatory))
+                       (or (nil? optional) (map? optional))
+                       (every? keyword? (concat (keys mandatory) (keys optional))))
+          (fail :invalid-hmap form "Structural maps need keyword fields and :complete? true"))
+        (when (seq (set/intersection (set (keys mandatory)) (set (keys optional))))
+          (fail :invalid-hmap form "Required and optional fields must be disjoint"))
+        (when (or (contains? optional :op) (and (contains? mandatory :op) (nil? (tag form))))
+          (fail :invalid-tag form "An :op field must be a required quoted keyword")))
+      typed.clojure/HVec
+      (when-not (and (= 2 (count form)) (vector? (second form)))
+        (fail :invalid-tuple form "Use a fixed HVec vector without options"))
+      (typed.clojure/Vec typed.clojure/Set typed.clojure/Option)
+      (when-not (= 2 (count form)) (fail :invalid-type form "Expected one type argument"))
+      typed.clojure/Map
+      (when-not (= 3 (count form)) (fail :invalid-type form "Expected key and value types"))
+      typed.clojure/U
+      (let [tags (keep tag (alternatives form))]
+        (when-not (= (count tags) (count (set tags)))
+          (fail :duplicate-tag form "Union production tags must be distinct")))
+      nil))
+  (if-let [parts (children form)]
+    (doseq [child parts] (validate-type nonterminals child))
+    (when (and (not (nonterminals form)) (seq (references nonterminals form)))
+      (fail :unsupported-recursion form "Nonterminal occurs in an unsupported type constructor"))))
+
+(defn language [name types]
+  (when-not (and (qualified-symbol? name) (map? types) (seq types)
+                 (every? simple-symbol? (keys types)))
+    (fail :invalid-language types "A language needs a qualified name and named nonterminals"))
+  (let [nonterminals (set (keys types))]
+    (doseq [[_ type] types] (validate-type nonterminals type)))
+  {:name name :types (into (sorted-map) types)})
+
+(defn derive [name base {:keys [remove add replace] :as changes}]
+  (when-not (every? #{:remove :add :replace} (keys changes))
+    (fail :invalid-extension changes "Expected :remove, :add, or :replace"))
+  (let [types (:types base)
+        removed-or-added (set (concat (keys remove) (keys add)))]
+    (when (seq (set/intersection removed-or-added (set (keys replace))))
+      (fail :invalid-extension changes "Replace cannot also add/remove the same nonterminal"))
+    (doseq [nt removed-or-added]
+      (when-not (contains? types nt)
+        (fail :unknown-nonterminal nt "Add/remove needs an existing nonterminal")))
+    (language name
+      (merge
+       (reduce
+        (fn [types nt]
+          (let [old (alternatives (get types nt))
+                tags (set (map tag old))
+                removed (get remove nt #{})
+                added (get add nt [])]
+            (when-not (and (set? removed) (vector? added)
+                           (not (contains? tags nil)) (every? tag added))
+              (fail :invalid-extension nt "Add/remove applies to tagged productions"))
+            (when-not (set/subset? removed tags)
+              (fail :unknown-production removed "Cannot remove a production that is absent"))
+            (assoc types nt (list* 'typed.clojure/U
+                                  (concat (clojure.core/remove #(removed (tag %)) old) added)))))
+        types removed-or-added)
+       replace))))
+
+(defn type-name [{:keys [name types]} nonterminal]
+  (when-not (contains? types nonterminal)
+    (fail :unknown-nonterminal nonterminal "Language has no such nonterminal" {:language name}))
+  (symbol (namespace name) (str (clojure.core/name name) "-" nonterminal)))
+
+(defn instantiate
+  "Replace local nonterminals with this language's aliases, preserving quoted
+  singleton data. Used for checker declarations and pass signatures."
+  ([language form] (instantiate language {} form))
+  ([{:keys [types] :as language} bound form]
+   (cond
+     (literal-type? form) form
+     (and (symbol? form) (contains? types form)) (get bound form (type-name language form))
+     (seq? form) (apply list (map #(instantiate language bound %) form))
+     (vector? form) (mapv #(instantiate language bound %) form)
+     (map? form) (into (empty form) (map (fn [[k v]] [k (instantiate language bound v)])) form)
+     :else form)))
+
+(defn type-forms [languages]
+  ;; Rec prevents container-kind checks from expanding recursive aliases forever.
+  ;; Cross-nonterminal aliases are registered before any pass is checked.
+  (for [language languages [nt type] (:types language)]
+    (list 'typed.clojure/defalias (type-name language nt)
+          (list 'typed.clojure/Rec [nt] (instantiate language {nt nt} type)))))
diff --git a/src/com/tailrecursion/nanopass/pass.clj b/src/com/tailrecursion/nanopass/pass.clj
new file mode 100644
index 0000000..c09ce38
--- /dev/null
+++ b/src/com/tailrecursion/nanopass/pass.clj
@@ -0,0 +1,140 @@
+(ns com.tailrecursion.nanopass.pass
+  "Generate ordinary checked functions for a declared language transformation.
+  Structural defaults recurse only through explicit nonterminal positions."
+  (:require [com.tailrecursion.nanopass.language :as l]))
+
+(defn- typed [sym type]
+  (vary-meta sym assoc :typed.clojure/- type))
+
+(defn- unexpected [pass value]
+  (let [bad (gensym "unhandled__")]
+    `((fn [~(typed bad 'typed.clojure/Nothing)] (throw (ex-info "Unexpected nanopass production"
+                                {:pass '~pass :node ~bad}))) ~value)))
+
+(declare walk dispatch)
+
+(defn- preserve-meta [{:keys [target]} type value result]
+  (let [type (l/instantiate target type)
+        id (gensym "result__")
+        attach (with-meta 'clojure.core/with-meta
+                 {:typed.clojure/inst [(list 'typed.clojure/I 'clojure.lang.IObj type)]})]
+    `(let [~(typed id type) ~result]
+       (if (instance? clojure.lang.IObj ~id)
+         (~attach ~id (meta ~value))
+         ~id))))
+
+(defn- mapper [{:keys [source] :as context} in out]
+  (let [item (gensym "item__")]
+    `(fn [~(typed item (l/instantiate source in))] ~(walk context in out item))))
+
+(defn- map-fields [{:keys [source target] :as context} in out value]
+  (let [a (l/hmap-options in) b (l/hmap-options out)]
+    (when-not (every? #(= (set (keys (% a))) (set (keys (% b)))) [:mandatory :optional])
+      (l/fail :explicit-clause-required in "Changed map fields need an explicit clause"))
+    (let [changed (filter (fn [[key type]]
+                            (or (not= type (get-in b [:optional key]))
+                                (seq (l/references (set (keys (:types source))) type))))
+                          (sort-by (comp str key) (:optional a)))
+          base (if (seq changed) `(dissoc ~value ~@(map first changed)) value)
+          fields (mapcat (fn [[key type]]
+                           (let [before `(~key ~value)
+                                 after (walk context type (get-in b [:mandatory key]) before)]
+                             (when (not= before after) [key after]))) (:mandatory a))
+          required (if (seq fields) `(assoc ~base ~@fields) base)]
+      ;; assoc/dissoc preserve metadata. Retain unchanged fields and reconstruct
+      ;; only recursive or changed fields; no metadata wrapper is needed.
+      (reduce (fn [result [key type]]
+                (let [acc (gensym "record__") child (gensym "child__")
+                      other-keys (remove #{key} (concat (keys (:mandatory a)) (keys (:optional a))))]
+                  ;; Project a zero/one-entry map. Its value type excludes
+                  ;; missing-key nil while retaining an explicitly present nil.
+                  `(reduce-kv
+                    (fn [~(typed acc (l/instantiate target out)) ~'_ ~(typed child (l/instantiate source type))]
+                      (assoc ~acc ~key ~(walk context type (get-in b [:optional key]) child)))
+                    ~result (dissoc ~value ~@other-keys))))
+              required changed))))
+
+(defn- optional [context in out value]
+  (let [id (gensym "optional__")]
+    `((fn [~(typed id (list 'typed.clojure/Option (l/instantiate (:source context) in)))]
+        (if (nil? ~id) nil ~(walk context in out id))) ~value)))
+
+(defn- walk [{:keys [source target processors params] :as context} in out value]
+  (cond
+    (and (symbol? in) (contains? (:types source) in))
+    (if-let [processor (and (contains? (:types target) out) (get processors in))]
+      `(~processor ~@params ~value)
+      (l/fail :missing-processor in "Recursive field needs a processor" {:target out}))
+
+    (and (= in out) (empty? (l/references (set (keys (:types source))) in))) value
+
+    (not (and (seq? in) (seq? out) (= (first in) (first out))))
+    (l/fail :explicit-clause-required in "Changed field types need an explicit clause" {:target out})
+
+    :else
+    (case (first in)
+      typed.clojure/HMap (map-fields context in out value)
+      typed.clojure/Vec (preserve-meta context out value `(mapv ~(mapper context (second in) (second out)) ~value))
+      typed.clojure/Set (preserve-meta context out value `(into #{} (map ~(mapper context (second in) (second out))) ~value))
+      typed.clojure/HVec
+      (do (when-not (= (count (second in)) (count (second out)))
+            (l/fail :explicit-clause-required in "Changed tuple arity needs an explicit clause"))
+          (preserve-meta context out value
+                         (mapv (fn [i a b] (walk context a b `(nth ~value ~i)))
+                               (range) (second in) (second out))))
+      typed.clojure/Map
+      (let [[_ ik iv] in [_ ok ov] out
+            acc (gensym "map__") k (gensym "key__") v (gensym "val__")]
+        (preserve-meta context out value
+                       `(reduce-kv (fn [~(typed acc (l/instantiate target out))
+                                        ~(typed k (l/instantiate source ik))
+                                        ~(typed v (l/instantiate source iv))]
+                                     (assoc ~acc ~(walk context ik ok k) ~(walk context iv ov v))) {} ~value)))
+      typed.clojure/Option (optional context (second in) (second out) value)
+      typed.clojure/U
+      (let [a (l/alternatives in) b (l/alternatives out)]
+        (if (and (= 2 (count a) (count b)) (some nil? a) (some nil? b))
+          (optional context (first (remove nil? a)) (first (remove nil? b)) value)
+          (dispatch context in out value {})))
+      (l/fail :explicit-clause-required in "Cannot derive structural traversal for this type"))))
+
+(defn- dispatch [{:keys [name] :as context} in out value clauses]
+  (let [variants (l/alternatives in)
+        tags (set (map l/tag variants))
+        targets (when out (into {} (map (juxt l/tag identity)) (l/alternatives out)))]
+    (when (contains? tags nil)
+      (l/fail :ambiguous-dispatch in "Dispatch needs tagged map alternatives; use :body true"))
+    (when-not (every? tags (keys clauses))
+      (l/fail :unknown-production clauses "Pass clause is absent from the input language"))
+    `(case (:op ~value)
+       ~@(mapcat (fn [variant]
+                   (let [tag (l/tag variant)]
+                     [tag (if (contains? clauses tag) (get clauses tag)
+                            (if-let [other (get targets tag)]
+                              (walk context variant other value)
+                              (l/fail :missing-clause variant "Removed production needs a clause"
+                                      {:pass name :production tag})))])) variants)
+       ~(unexpected name value))))
+
+(defn definition
+  [{:keys [name source target from to params arguments result-type processors body?]} forms]
+  (let [node (last arguments)
+        input-type (l/type-name source from)
+        signature (vec (concat params [input-type :-> result-type]))
+        context {:name name :source source :target target
+                 :processors (merge {from name} processors) :params (vec (butlast arguments))}
+        in (get-in source [:types from]) out (get-in target [:types to])
+        body (if body?
+               (do (when-not (= 1 (count forms))
+                     (l/fail :invalid-pass forms "A whole-body pass needs one expression"))
+                   (first forms))
+               (do (when (or (odd? (count forms))
+                             (not= (count (take-nth 2 forms)) (count (set (take-nth 2 forms)))))
+                     (l/fail :invalid-pass forms "Pass clauses must be distinct tag/expression pairs"))
+                   (if (and (empty? forms) (not-every? l/tag (l/alternatives in)))
+                     (walk context in out node)
+                     (dispatch context in out node (apply hash-map forms)))))
+        local-name (symbol (clojure.core/name name))]
+    `(defn ~local-name
+       {:com.tailrecursion.nanopass/signature '~signature}
+       ~arguments ~body)))
diff --git a/test-resources/typedclojure_config.cljc b/test-resources/typedclojure_config.cljc
new file mode 100644
index 0000000..ee5384c
--- /dev/null
+++ b/test-resources/typedclojure_config.cljc
@@ -0,0 +1 @@
+{:ann [com.tailrecursion.nanopass.annotations com.tailrecursion.blacktide.annotations]}
diff --git a/test/com/tailrecursion/blacktide/algorithms_test.clj b/test/com/tailrecursion/blacktide/algorithms_test.clj
new file mode 100644
index 0000000..abdbb7f
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/algorithms_test.clj
@@ -0,0 +1,59 @@
+(ns com.tailrecursion.blacktide.algorithms-test
+  "Partitioning and small parsers compared with independent collection/regex
+  models. These programs are also used in the public examples."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.blacktide :refer [loophole label goto setq]]
+            [blacktide.algorithms :refer [tokens partition! decimal-prefix]]))
+
+(defn- partition-reference [xs]
+  (when (seq xs)
+    (let [pivot (first xs)]
+      (loop [xs (vec xs) left -1 right (count xs)]
+        (let [left (first (drop-while #(< (xs %) pivot) (range (inc left) (count xs))))
+              right (first (drop-while #(> (xs %) pivot) (range (dec right) -1 -1)))]
+          (if (>= left right) [right xs]
+              (recur (assoc xs left (xs right) right (xs left)) left right)))))))
+
+(defn- decimal-reference [s]
+  (when-let [[token sign digits] (re-find #"^([+-]?)([0-9]+)" s)]
+    [(* (if (= sign "-") -1 1) (bigint (java.math.BigInteger. digits))) (count token)]))
+
+(defn- even-flips? [xs]
+  (loophole [i 0 even-state true valid true]
+    (label scan)
+    (when (= i (count xs)) (goto done))
+    (case (nth xs i)
+      :flip (setq even-state (not even-state))
+      :hold nil
+      (do (setq valid false) (goto done)))
+    (setq i (inc i)) (goto scan)
+    (label done) (and valid even-state)))
+
+(defn token-reference [s]
+  (->> s (partition-by #(Character/isWhitespace ^char %))
+       (remove #(Character/isWhitespace ^char (first %))) (mapv #(apply str %))))
+
+(deftest parsing-and-partition-boundaries
+  (doseq [s ["" "-" "+" "x" "0" "-0" "+0001" "-9223372036854775809!"
+             "9999999999999999999999999999999999999999999999999"]]
+    (is (= (decimal-reference s) (decimal-prefix s))))
+  (doseq [s ["" " " "a" " a " "one two\tthree\nfour" "a\u2003b\u00a0c"]]
+    (is (= (token-reference s) (tokens s))))
+  (doseq [xs [[] [1] [2 1] [1 1 1] [0 -1 2 -3] [Long/MAX_VALUE Long/MIN_VALUE 0]]]
+    (let [a (long-array xs)]
+      (is (= (partition-reference xs) (when (seq xs) [(partition! a) (vec a)]))))))
+
+(deftest deterministic-parser-and-mutation-differentials
+  (let [seed 424242 rng (java.util.Random. seed)]
+    (dotimes [index 300]
+      (let [xs (vec (repeatedly (.nextInt rng 35) #(- (.nextInt rng 31) 15))) a (long-array xs)
+            number (str (nth ["" "-" "+"] (.nextInt rng 3))
+                        (apply str (repeatedly (.nextInt rng 25) #(char (+ (int \0) (.nextInt rng 10)))))
+                        (nth ["" "x" " 3"] (.nextInt rng 3)))
+            text (apply str (repeatedly (.nextInt rng 40) #(nth [\a \b \space \tab \newline \u2003 \u00a0] (.nextInt rng 7))))
+            states (vec (repeatedly (.nextInt rng 35) #(nth [:flip :hold :hold :bad] (.nextInt rng 4))))
+            context (str "seed=" seed " index=" index)]
+        (is (= (partition-reference xs) (when (seq xs) [(partition! a) (vec a)])) context)
+        (is (= (decimal-reference number) (decimal-prefix number)) context)
+        (is (= (token-reference text) (tokens text)) context)
+        (is (= (and (every? #{:flip :hold} states) (even? (count (filter #{:flip} states)))) (even-flips? states)) context)))))
diff --git a/test/com/tailrecursion/blacktide/annotations.clj b/test/com/tailrecursion/blacktide/annotations.clj
new file mode 100644
index 0000000..6166da3
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/annotations.clj
@@ -0,0 +1,138 @@
+(ns com.tailrecursion.blacktide.annotations
+  "Checking-only aliases and signatures for every production compiler pass."
+  (:require [typed.clojure]
+            [clojure.core.typed :as ct]
+            [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.blacktide.compiler.assignment :as assignment]
+            [com.tailrecursion.blacktide.compiler.backend :as backend]
+            [com.tailrecursion.blacktide.compiler.boundaries :as boundaries]
+            [com.tailrecursion.blacktide.compiler.box-origins :as box-origins]
+            [com.tailrecursion.blacktide.compiler.case-emit :as case-emit]
+            [com.tailrecursion.blacktide.compiler.cases :as cases]
+            [com.tailrecursion.blacktide.compiler.collections :as collections]
+            [com.tailrecursion.blacktide.compiler.compact :as compact]
+            [com.tailrecursion.blacktide.compiler.compact-languages :as compact-languages]
+            [com.tailrecursion.blacktide.compiler.effects :as effects]
+            [com.tailrecursion.blacktide.compiler.emit :as emit]
+            [com.tailrecursion.blacktide.compiler.errors :as errors]
+            [com.tailrecursion.blacktide.compiler.feasible :as feasible]
+            [com.tailrecursion.blacktide.compiler.graph :as graph]
+            [com.tailrecursion.blacktide.compiler.host-emit :as host-emit]
+            [com.tailrecursion.blacktide.compiler.invariants :as invariants]
+            [com.tailrecursion.blacktide.compiler.joins :as joins]
+            [com.tailrecursion.blacktide.compiler.jvm :as jvm]
+            [com.tailrecursion.blacktide.compiler.jvm-languages :as jvm-languages]
+            [com.tailrecursion.blacktide.compiler.languages :as languages]
+            [com.tailrecursion.blacktide.compiler.loop-facts :as loop-facts]
+            [com.tailrecursion.blacktide.compiler.lower :as lower]
+            [com.tailrecursion.blacktide.compiler.native :as native]
+            [com.tailrecursion.blacktide.compiler.analysis-languages :as analysis-languages]
+            [com.tailrecursion.blacktide.compiler.order :as order]
+            [com.tailrecursion.blacktide.compiler.prepare :as prepare]
+            [com.tailrecursion.blacktide.compiler.source :as source]
+            [com.tailrecursion.blacktide.compiler.source-case :as source-case]
+            [com.tailrecursion.blacktide.compiler.source-host :as source-host]
+            [com.tailrecursion.blacktide.compiler.source-jvm :as source-jvm]
+            [com.tailrecursion.blacktide.compiler.source-languages :as source-languages]
+            [com.tailrecursion.blacktide.compiler.source-values :as source-values]
+            [com.tailrecursion.blacktide.compiler.storage :as storage]
+            [com.tailrecursion.blacktide.compiler.structure :as structure]
+            [com.tailrecursion.blacktide.compiler.structured-emit :as structured-emit]
+            [com.tailrecursion.blacktide.compiler.structured-languages :as structured-languages]
+            [com.tailrecursion.blacktide.compiler.transfers :as transfers]
+            [com.tailrecursion.blacktide.compiler.value-facts :as value-facts]
+            [com.tailrecursion.blacktide.compiler :as compiler]))
+
+;; Var.toSymbol delegates to Symbol.create; its successful result is non-null.
+(ct/non-nil-return clojure.lang.Var/toSymbol :all)
+;; Java reflection guarantees these successful results are non-null.
+(ct/non-nil-return java.lang.Class/getName :all)
+(ct/non-nil-return java.lang.Object/getClass :all)
+(ct/non-nil-return java.lang.Class/getConstructors :all)
+(ct/non-nil-return java.lang.Class/getMethods :all)
+(ct/non-nil-return java.lang.reflect.Method/getName :all)
+(ct/non-nil-return java.lang.reflect.Executable/getDeclaringClass :all)
+(ct/non-nil-return java.lang.reflect.Executable/getParameterTypes :all)
+(ct/non-nil-return java.lang.reflect.Constructor/getDeclaringClass :all)
+(ct/non-nil-return java.lang.reflect.Method/getReturnType :all)
+(ct/non-nil-return java.lang.reflect.Method/getDeclaringClass :all)
+(ct/non-nil-return java.lang.reflect.Method/getParameterTypes :all)
+
+(np/ann-languages compact-languages/Compact)
+(np/ann-languages jvm-languages/JVM)
+(np/ann-languages languages/Machine languages/CFG languages/Symbolic)
+(np/ann-languages analysis-languages/Analysis analysis-languages/Planned)
+(np/ann-languages source-languages/Bound source-languages/Native source-languages/Classified
+               source-languages/Sequential source-languages/Assigned source-languages/Cases
+               source-languages/Collections source-languages/Prepared source-languages/Ordered)
+(np/ann-languages structured-languages/Structured structured-languages/Joined structured-languages/Stored)
+(np/ann-passes assignment/sequential-pair assignment/sequential-pairs assignment/sequential-forms
+               assignment/sequential-node assignment/sequential-binding assignment/sequential
+               assignment/parallel-forms assignment/parallel-bindings assignment/save-parallel-values
+               assignment/parallel-node assignment/parallel)
+(np/ann-passes backend/compile-program)
+(np/ann-passes boundaries/native-node boundaries/native-binding boundaries/native-forms boundaries/native
+               boundaries/classify-node boundaries/classify-pair boundaries/classify-pairs
+               boundaries/classify-binding boundaries/classify-forms boundaries/classify)
+(np/ann-passes box-origins/copy-source box-origins/reboxable? box-origins/reboxable-values)
+(np/ann-passes case-emit/selector-form case-emit/arms-form)
+(np/ann-passes cases/normalize-node cases/normalize-binding cases/normalize-forms cases/normalize)
+(np/ann-passes collections/form collections/normalize-forms collections/literal-values collections/constant
+               collections/normalize-node collections/normalize-binding collections/normalize)
+(np/ann-passes compact/introduce compact/atom-reads compact/rhs-reads compact/reads compact/stable?
+               compact/substitute-atom compact/substitute-operand compact/substitute-rhs
+               compact/substitute-operation compact/substitute-binding compact/substitute compact/atom-type
+               compact/movable? compact/replacement compact/discardable? compact/simplify compact/program)
+(np/ann-passes effects/effect-node effects/effects)
+(np/ann-passes emit/atom-form emit/rhs-form emit/operation-form emit/edge-form emit/term-form emit/block-form
+               emit/program-form)
+(np/ann-passes errors/site errors/fail errors/check-visibility)
+(np/ann-passes feasible/terminator feasible/block feasible/program)
+(np/ann-passes graph/atom-reads graph/rhs-reads graph/term-reads graph/successors graph/block-facts
+               graph/collect-facts graph/fact-at graph/validate-edges graph/reachable graph/predecessors
+               graph/initialized graph/validate-initialization graph/liveness graph/allocate graph/analyze)
+(np/ann-passes host-emit/global-form host-emit/box-form host-emit/typed-form host-emit/conversion-form
+               host-emit/host-form)
+(np/ann-passes invariants/assigned invariants/expression)
+(np/ann-passes joins/postdominators joins/region joins/candidate joins/plan)
+(np/ann-passes jvm/resolved-class jvm/source-tag jvm/tag-class jvm/fact jvm/value-type jvm/hint-conflict
+               jvm/visible-class jvm/literal-type jvm/join-type jvm/methods jvm/static-method? jvm/return-type
+               jvm/constructors jvm/parameters jvm/select-method jvm/public-member jvm/host-type
+               jvm/prepare-call)
+(np/ann-passes loop-facts/children loop-facts/primitive loop-facts/inferred loop-facts/converted
+               loop-facts/boxed loop-facts/initializer loop-facts/bindings loop-facts/expression
+               loop-facts/recurs loop-facts/compatible? loop-facts/solve loop-facts/recur-error
+               loop-facts/recurrence loop-facts/materialize loop-facts/lower)
+(np/ann-passes lower/fresh-block lower/start lower/seal lower/evaluate lower/lower-forms lower/lower-bindings
+               lower/lower-node lower/lower lower/compile-graph)
+(np/ann-passes native/hinted-form native/reads-node native/boxed-reads native/reads native/literal-values
+               native/bindings-form native/node-form native/form)
+(np/ann-passes order/save order/operands order/normalize-forms order/normalize-bindings order/normalize-node
+               order/normalize)
+(np/ann-passes prepare/prepare-forms prepare/conversion prepare/prepare-node prepare/prepare-binding
+               prepare/prepare)
+(np/ann-passes source/fresh source/expression source/resolve-name source/parse-symbol source/parse-operand
+               source/parse-forms source/parse-body source/bind-local source/parse-bindings source/parse-scope
+               source/parse-loop source/parse-recur source/parse-arms source/case-expression source/parse-case
+               source/parse-dispatch source/protocol-argument source/protocol-call source/keyword-call
+               source/parse-call source/parse-host source/parse-assignment source/parse-marker
+               source/parse-list source/parse-collection source/parse)
+(np/ann-passes source-case/expand-case source-case/int32 source-case/dispatch-syntax)
+(np/ann-passes source-host/tags source-host/qualified source-host/syntax)
+(np/ann-passes source-jvm/signature source-jvm/primitive-interface source-jvm/direct-call
+               source-jvm/protocol-class source-jvm/protocol-call source-jvm/infer source-jvm/binding-facts
+               source-jvm/caller-facts)
+(np/ann-passes source-values/node source-values/binding-form source-values/pair source-values/pairs
+               source-values/forms source-values/expression)
+(np/ann-passes storage/loop-slots storage/cyclic? storage/operand-boxes storage/operation-boxes
+               storage/observed-values storage/term-boxes storage/select-storage)
+(np/ann-passes structure/block structure/scan structure/harmless-atom? structure/harmless-block?
+               structure/wrap structure/arms structure/terminator structure/joined structure/body
+               structure/edge structure/construction-site? structure/site-failure structure/recover)
+(np/ann-passes structured-emit/primitive-form structured-emit/binding-form structured-emit/atom-form
+               structured-emit/operand-form structured-emit/rhs-form structured-emit/rhs-type
+               structured-emit/operation-form structured-emit/let-form structured-emit/expression)
+(np/ann-passes transfers/resolve-term transfers/resolve-block transfers/resolve-program)
+(np/ann-passes value-facts/primitive value-facts/join value-facts/atom-type value-facts/rhs-type
+               value-facts/definitions value-facts/solve value-facts/analyze)
+(np/ann-passes compiler/compile-tree compiler/caller-locals compiler/compile-form)
diff --git a/test/com/tailrecursion/blacktide/aot_fixture.clj b/test/com/tailrecursion/blacktide/aot_fixture.clj
new file mode 100644
index 0000000..0ed7f27
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/aot_fixture.clj
@@ -0,0 +1,23 @@
+(ns com.tailrecursion.blacktide.aot-fixture
+  "Fresh AOT client exercising both compiler loading and generated code."
+  (:require [com.tailrecursion.blacktide :refer [loophole setq label goto]]))
+
+(defn keyword-read [target]
+  (loophole [saved nil] (:k (setq saved target))))
+
+(defn sample [n]
+  (loophole [^long i 0 total 0]
+    (while (< i n)
+      (setq total (case i 0 3
+                        (+ total 2))
+            i (inc i)))
+    total))
+
+(defn reference-site [flag value]
+  (let [result (loophole [a 0 b 0]
+                 (if flag (setq a 1 b 2) (setq a 3 b 4))
+                 (label again)
+                 (when (neg? a) (goto again))
+                 (+ a b)
+                 value)]
+    result))
diff --git a/test/com/tailrecursion/blacktide/aot_test.clj b/test/com/tailrecursion/blacktide/aot_test.clj
new file mode 100644
index 0000000..445a334
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/aot_test.clj
@@ -0,0 +1,42 @@
+(ns com.tailrecursion.blacktide.aot-test
+  "AOT in a fresh JVM must compile dependencies and run without source files or
+  the type checker. Preloading compiler namespaces would hide initializer limits."
+  (:require [clojure.test :refer [deftest is]]
+            [clojure.java.io :as io]
+            [clojure.string :as str]))
+
+(defn subprocess [classpath form]
+  (let [java (str (io/file (System/getProperty "java.home") "bin" "java"))
+        process (-> (ProcessBuilder. ^java.util.List [java "-Xmx768m" "-cp" classpath "clojure.main" "-e" (pr-str form)])
+                    (.redirectErrorStream true) (.start))
+        output (slurp (.getInputStream process))]
+    {:exit (.waitFor process) :output output}))
+
+(deftest fresh-aot-and-source-free-use
+  (let [directory (.toFile (java.nio.file.Files/createTempDirectory "loophole-aot-" (make-array java.nio.file.attribute.FileAttribute 0)))
+        classpath (System/getProperty "java.class.path")
+        dependencies (filter #(str/ends-with? % ".jar") (str/split classpath (re-pattern java.io.File/pathSeparator)))
+        compiled (subprocess classpath `(binding [*compile-path* ~(.getPath directory)]
+                                         (compile 'com.tailrecursion.blacktide.aot-fixture)))]
+    (try
+      (is (zero? (:exit compiled)) (:output compiled))
+      (when (zero? (:exit compiled))
+        ;; A library JAR includes this Java class; AOT does not copy dependencies.
+        (let [path "com/tailrecursion/blacktide/runtime/KeywordSite.class"
+              target (io/file directory path)]
+          (io/make-parents target)
+          (with-open [source (io/input-stream (io/resource path))] (io/copy source target)))
+        (let [loaded (subprocess (str/join java.io.File/pathSeparator (cons (.getPath directory) dependencies))
+                                 '(do (require 'com.tailrecursion.blacktide.aot-fixture)
+                                      (assert (= 9 (com.tailrecursion.blacktide.aot-fixture/sample 4)))
+                                      (assert (= 7 (com.tailrecursion.blacktide.aot-fixture/keyword-read {:k 7})))
+                                      (let [value (Object.)]
+                                        (doseq [flag [true false]]
+                                          (assert (identical? value (com.tailrecursion.blacktide.aot-fixture/reference-site flag value)))))
+                                      (assert (= 9 (eval '(com.tailrecursion.blacktide/loophole [x 1]
+                                                           (com.tailrecursion.blacktide/setq x 9) x))))
+                                      (assert (= 11 (eval '(com.tailrecursion.blacktide/loophole [x nil]
+                                                            (:k (com.tailrecursion.blacktide/setq x {:k 11}))))))
+                                      (println "AOT client and source-free macro expansion passed")))]
+          (is (zero? (:exit loaded)) (:output loaded))))
+      (finally (doseq [file (reverse (file-seq directory))] (io/delete-file file))))))
diff --git a/test/com/tailrecursion/blacktide/assignment_test.clj b/test/com/tailrecursion/blacktide/assignment_test.clj
new file mode 100644
index 0000000..b40ee92
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/assignment_test.clj
@@ -0,0 +1,107 @@
+(ns com.tailrecursion.blacktide.assignment-test
+  "Assignment semantics, saved operands, and independent interpreter comparisons."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.blacktide :as lh :refer [loophole setq psetq]]
+            [com.tailrecursion.blacktide.source-test :as source]
+            [com.tailrecursion.nanopass.assignment-test :as oracle]))
+
+(defn add [a b] (+ a b))
+(defn event! [events tag value] (swap! events conj [tag value]) value)
+
+(deftest batch-results-and-repeated-targets
+  (is (= [nil nil] (loophole [] [(setq) (psetq)])))
+  (is (= [2 1] (loophole [x 1 y 2] (psetq x y y x) [x y])))
+  (is (= [3 3 3] (loophole [x 1 y 2] [(setq x 3 y x) x y])))
+  (is (= [nil 2 2] (loophole [x 1 y 2] [(psetq x 9 x y) x y])))
+  (is (= [2 9] (loophole [x 1 y 2] (psetq x y y (setq x 9)) [x y])))
+  (is (= [1 2] (loophole [x 1 y 2] (psetq x (do (psetq x y y x) y) y x) [x y])))
+  (is (= "changed" (loophole [x 1] (setq x 2.5 x "changed") x)))
+  (is (= [1 10 10 10] (loophole [x 1] (let [a x b (setq x 10) c x] [a b c x])))))
+
+(deftest operand-and-assignment-snapshots
+  (is (= 30 (loophole [x 0] (add (do (setq x 10) x) (do (setq x 20) x)))))
+  (is (= [1 10 10 20] (loophole [x 1] [x (setq x 10) x (setq x 20)])))
+  (is (= [3 9] (loophole [x 1] [(add x (setq x 2)) (setq x 9)])))
+  (is (= 7 (loophole [f add] (f (do (setq f vector) 3) 4))))
+  (is (= [nil 1 8] (loophole [x 1 y 2] [(psetq x (setq y 8) y x) y x]))))
+
+(deftest writes-in-collections-and-metadata
+  (is (= #{1 2} (loophole [x 0] #{(setq x 1) (setq x 2)})))
+  (is (= [{1 2} 2] (loophole [x 1] [{x (setq x 2)} x])))
+  (is (= [[1] 9 {:note 9}]
+         (loophole [x 1] (let [v ^{:note (setq x 9)} [x]] [v x (meta v)])))))
+
+(deftest initialization-and-abandonment
+  (is (= [1 9 9] (loophole [x 1 before x y (setq x 9)] [before x y])))
+  (let [events (atom []) fail (fn [x] (event! events :before-throw x) (throw (ex-info "stop" {})))]
+    (is (thrown-with-msg? clojure.lang.ExceptionInfo #"stop"
+          (loophole [x 1 y 2] (psetq x (event! events :first 10) y (fail x)))))
+    (is (= [[:first 10] [:before-throw 1]] @events))
+    (reset! events [])
+    (is (thrown-with-msg? clojure.lang.ExceptionInfo #"stop"
+          (loophole [x 1 y 2]
+            (psetq x (event! events :first 10)
+                   y (do (setq x 9) (fail x))))))
+    (is (= [[:first 10] [:before-throw 9]] @events)))
+  (let [events (atom [])]
+    (is (= [nil 2 1]
+           (loophole [x 1 y 2] [(psetq x (event! events :first y) y (event! events :second x)) x y])))
+    (is (= [[:first 2] [:second 1]] @events))))
+
+(deftest assignment-diagnostics-and-shadowing
+  (doseq [[body kind] [['(setq x) :invalid-assignment]
+                       ['(psetq x 1 y) :invalid-assignment]
+                       ['(setq ns/x 1) :invalid-assignment]
+                       ['(setq [x] 1) :invalid-assignment]
+                       ['(psetq missing 1) :unknown-assignment]
+                       ['(let [x 3] (setq x 4)) :immutable-assignment]]]
+    (is (= kind (:kind (source/rejection (list 'loophole '[x 1] body))))))
+  (is (= [1 2] (loophole [setq vector] (setq 1 2))))
+  (is (= [3] (loophole [psetq vector] (psetq 3))))
+  (is (= :immutable-assignment (:kind (source/rejection '(let [outside 1] (loophole [] (setq outside 2)))))))
+  (is (= 2 (loophole [x 1] (lh/setq x 2)))))
+
+(defn render [node]
+  (case (:op node)
+    :const (list 'quote (:value node))
+    :read (:binding node)
+    :add (list '+ (render (:left node)) (render (:right node)))
+    :do (list* 'do (map render (:forms node)))
+    :if (list 'if (render (:test node)) (render (:then node)) (render (:else node)))
+    :event (list 'event! 'events (:tag node) (render (:value node)))
+    (:setq :psetq) (list* (symbol (name (:op node)))
+                          (mapcat (fn [[name rhs]] [name (render rhs)]) (:writes node)))))
+
+(defn execute [node x y]
+  (binding [*ns* (the-ns 'com.tailrecursion.blacktide.assignment-test)]
+    (try
+      (eval (list 'let ['events '(atom [])]
+                  (list 'loophole ['x x 'y y]
+                        (list 'let ['result (render node)]
+                              {:status :return :value 'result :trace '(deref events)
+                               :vars {(list 'quote 'x) 'x (list 'quote 'y) 'y}}))))
+      (catch Throwable e {:compiler-error (class e) :message (ex-message e)}))))
+
+(deftest generated-assignment-programs
+  ;; Reuse the library client's independently interpreted source semantics, not
+  ;; its lowering or output evaluator. Both the compiler and its IR are separate.
+  (doseq [seed [712381 314159]]
+    (let [random (java.util.Random. seed)]
+      (dotimes [trial 100]
+        (let [node (oracle/expression random 3)]
+          (doseq [[x y] [[0 0] [1 2] [-7 5] [10 -3]]]
+            (let [expected (oracle/execute node {'x x 'y y}) actual (execute node x y)]
+              (is (= expected actual)
+                  (when (not= expected actual)
+                    (pr-str {:seed seed :trial trial :input [x y]
+                             :source (oracle/minimize node
+                                       #(let [candidate (execute % x y)]
+                                          (and (= (boolean (:compiler-error actual)) (boolean (:compiler-error candidate)))
+                                               (not= (oracle/execute % {'x x 'y y}) candidate))))}))))))))))
+
+(deftest invocation-arity-boundaries-preserve-operator-and-argument-snapshots
+  (doseq [n [19 20 21 40]]
+    (let [args (concat (map #(list 'setq 'x %) (range 1 (inc n))) ['(do (setq f list) x) 'x])
+          form (list 'loophole '[f vector x 0] [(cons 'f args) '(f :after) 'x])
+          expected [(vec (concat (range 1 (inc n)) [n n])) '(:after) n]]
+      (is (= expected (source/run-form form)) (pr-str {:arity (+ n 2) :form form})))))
diff --git a/test/com/tailrecursion/blacktide/backend_test.clj b/test/com/tailrecursion/blacktide/backend_test.clj
new file mode 100644
index 0000000..244271f
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/backend_test.clj
@@ -0,0 +1,311 @@
+(ns com.tailrecursion.blacktide.backend-test
+  "Backend decisions, primitive storage, reference identity and conversion order."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.blacktide :refer [loophole label goto setq psetq]]
+            [com.tailrecursion.blacktide.compiler.backend :as backend]
+            [com.tailrecursion.blacktide.compiler.emit :as emit]
+            [com.tailrecursion.blacktide.compiler.structure :as structure]
+            [com.tailrecursion.blacktide.compiler.storage :as storage]
+            [com.tailrecursion.blacktide.compiler.compact :as compact]
+            [com.tailrecursion.blacktide.compiler.value-facts :as facts]
+            [com.tailrecursion.blacktide.compiler.box-origins :as origins]
+            [com.tailrecursion.blacktide.compiler.graph :as graph]
+            [com.tailrecursion.blacktide.compiler.jvm :as jvm]
+            [com.tailrecursion.blacktide.compiler.prepare :as prepare]
+            [com.tailrecursion.blacktide.compiler.lower :as lower]
+            [com.tailrecursion.blacktide.machine-test :as m]))
+
+(defn compile-program [form mode]
+  (binding [*ns* (the-ns 'com.tailrecursion.blacktide.backend-test)]
+    (with-redefs [backend/compile-program (if (= mode :dispatcher)
+                                                  emit/program-form
+                                                  backend/compile-program)]
+      (eval (list 'fn '[events] form)))))
+
+(defn selection [form]
+  (let [selected (atom nil) recover structure/recover]
+    (with-redefs [structure/recover (fn [analysis] (let [out (recover analysis)] (reset! selected out) out))]
+      (compile-program form :default))
+    @selected))
+
+(defn stored [form]
+  (let [selected (atom nil) choose storage/select-storage]
+    (with-redefs [storage/select-storage (fn [analysis expr]
+                                          (let [out (choose analysis expr)] (reset! selected out) out))]
+      (compile-program form :default))
+    @selected))
+
+(defn execution [form mode]
+  (let [f (compile-program form mode) events (atom [])]
+    (try {:value (f events) :trace @events}
+         (catch Throwable error {:throw (class error) :trace @events}))))
+
+(defn compacted [form]
+  (let [selected (atom nil) simplify compact/program]
+    (with-redefs [compact/program (fn [program] (let [out (simplify program)] (reset! selected out) out))]
+      (compile-program form :default))
+    @selected))
+
+(defmacro local-class [name]
+  (list 'quote (.getJavaClass ^clojure.lang.Compiler$LocalBinding (get &env name))))
+
+(deftest result-type-boundary
+  (doseq [body '[1 2.5 nil false "text" (loop [] 1) (goto end)]
+          mode [:default :dispatcher]]
+    (let [form (list 'let ['result (list 'loophole [] body)] '(local-class result))]
+      (is (= Object ((compile-program form mode) nil)) (pr-str [body mode])))))
+
+(deftest object-arguments-need-facts-and-snapshots-but-no-cast
+  (let [conversions (atom []) graphs (atom []) conversion prepare/conversion compile-graph lower/compile-graph]
+    (with-redefs [prepare/conversion
+                  (fn [how expr]
+                    (let [out (conversion how expr)]
+                      (when (= Object (:type how)) (swap! conversions conj out)) out))
+                  lower/compile-graph (fn [supply expr]
+                                        (let [out (compile-graph supply expr)] (swap! graphs conj out) out))]
+      (doseq [mode [:default :dispatcher]]
+        (is (= {:value [false 30] :trace [10 20]}
+               (execution '(loophole [x 10]
+                             [(java.util.Objects/equals (do (swap! events conj x) x)
+                                                        (do (setq x 20) (swap! events conj x) (setq x 30))) x]) mode)))
+        (is (= :throw
+               (if (:throw (execution '(loophole []
+                                        (^{:param-tags [Object Object]} clojure.lang.Numbers/minus
+                                          (long Long/MIN_VALUE) (long Long/MIN_VALUE))) mode)) :throw :returned)))
+        (is (.startsWith ^String (:value (execution '(loophole []
+                                                      (^{:param-tags [Object]} String/valueOf (char-array [\a \b]))) mode))
+                         "[C@"))))
+    (is (seq @conversions))
+    (is (every? #(and (= Object (:type (:jvm %))) (false? (:primitive? (:jvm %)))) @conversions))
+    (is (not-any? #(and (map? %) (= :convert (:op %)) (= Object (:type (:conversion %))))
+                  (mapcat #(tree-seq coll? seq %) @graphs)))))
+
+(deftest integer-conversion-overloads-are-not-interchangeable
+  (let [random (java.util.Random. 173205)
+        outcome (fn [f x] (try (let [v (f x)] [v (class v)])
+                              (catch Throwable e [(class e) (ex-message e)])))
+        reference (fn [x] (int (identity x)))]
+    (doseq [[cast values]
+            [['long (concat [Long/MIN_VALUE (dec (long Integer/MIN_VALUE)) Integer/MIN_VALUE
+                             -1 0 1 Integer/MAX_VALUE (inc (long Integer/MAX_VALUE)) Long/MAX_VALUE]
+                            (repeatedly 64 #(.nextLong random)))]
+             ['double [Double/NaN Double/POSITIVE_INFINITY Double/NEGATIVE_INFINITY
+                       -0.0 0.0 1.5 -1.5 2147483647.5 -2147483648.9
+                       (double Long/MIN_VALUE) (double Long/MAX_VALUE)]]]
+            mode [:default :dispatcher]
+            :let [form (list 'fn '[input] (list 'loophole ['x (list cast 'input)] '(int x)))
+                  compiled ((compile-program form mode) (atom []))]
+            value values]
+      (let [value (if (= cast 'long) (long value) (double value))]
+        (is (= (outcome reference value) (outcome compiled value))
+            (pr-str [173205 cast mode value]))))))
+
+(deftest cached-long-origins-retain-value-class-and-identity
+  ;; Compiler.NumberExpr initializes constants with Long.valueOf, including
+  ;; distinct Long objects supplied by macros. Only its guaranteed cache is safe.
+  (doseq [n [-129 -128 -1 0 1 127 128 1000]]
+    (let [literal (Long. (long n)) cached? (<= -128 n 127)
+          form (list 'loophole ['i 0 'x literal]
+                     '(while (< i 2) (setq i (inc i))) 'x)]
+      (is (= cached? (origins/reboxable? {:op :value :value (m/literal literal)})))
+      (doseq [mode [:default :dispatcher]]
+        (let [f (compile-program form mode) first-value (f nil)]
+          (is (= n first-value))
+          (is (= Long (class first-value)))
+          (is (identical? first-value (f nil)))
+          (is (= cached? (identical? (Long/valueOf (long n)) first-value)))))))
+  ;; Small external boxes and constructor results are not cached literals.
+  (doseq [mode [:default :dispatcher]
+          value [(Long. 0) (Long. 127) (Long. 128) (Integer. 0) (Double. 0.0)]]
+    (let [f (compile-program '(loophole [i 0 x events]
+                               (while (< i 2) (setq i (inc i))) x) mode)]
+      (is (identical? value (f value)))))
+  (doseq [mode [:default :dispatcher]
+          initializer '[(Long. 0) (Long. 128) 0 127 128]]
+    (let [form (list 'loophole ['i 0 'x initializer 'saved 'x]
+                     '(while (< i 2) (setq x (inc x) i (inc i)))
+                     '(do (reset! events saved) saved))
+          f (compile-program form mode) events (atom nil) result (f events)]
+      (is (identical? result @events)))))
+
+(deftest primitive-proofs-follow-producers
+  (let [hint (jvm/fact false {:hint 'long :var-meta {}} Long/TYPE)]
+    (is (= :boxed (facts/rhs-type {} {:op :external :name 'x :jvm hint})))
+    (is (= Long/TYPE (facts/rhs-type {} {:op :external :name 'x :jvm (assoc hint :primitive? true)})))
+    (is (= :boxed (facts/atom-type {} (m/literal (Integer/valueOf 1000))))))
+  (is (= {'x Long/TYPE 'y Long/TYPE}
+         (facts/solve {'x [{:op :value :value (m/literal 1)} {:op :value :value (m/local 'y)}]
+                       'y [{:op :value :value (m/local 'x)}]})))
+  (is (= {'x :boxed 'y :boxed}
+         (facts/solve {'x [{:op :value :value (m/literal 1)} {:op :value :value (m/local 'y)}]
+                       'y [{:op :value :value (m/local 'x)} {:op :value :value (m/literal 2.0)}]}))))
+
+(deftest dead-blocks-are-retained-but-not-type-proofs
+  (let [machine (graph/analyze {:entry 0 :blocks {0 (m/block [(m/put-value 'x 1)] {:op :return :value (m/local 'x)})
+                                                1 (m/block [(m/put-value 'x nil)] {:op :return :value (m/local 'x)})}})
+        analysis (facts/analyze machine)]
+    (is (= machine (:machine analysis)))
+    (is (= #{0} (:reachable analysis)))
+    (is (= {'x Long/TYPE} (:types analysis)))))
+
+(deftest feasible-paths-preserve-primitive-state
+  (let [form '(loophole [^long i 0 ^long total 0]
+                (while (< i 5)
+                  (setq total (cond (= i 2) (unchecked-add total 10)
+                                    :else (unchecked-inc total))
+                        i (unchecked-inc i)))
+                (long total))
+        program (stored form)
+        slots (storage/loop-slots (:body program))]
+    (is (= 2 (count slots)))
+    (is (= #{Long/TYPE} (set (vals (select-keys (:types program) slots)))))
+    (is (every? (:types program) slots))
+    (doseq [mode [:default :dispatcher]]
+      (is (= {:value 14 :trace []} (execution form mode)))))
+  (doseq [[value expected] [[nil -3] [false -3] [true 3] [0 3] ["" 3] [:else 3] [[] 3]]
+          mode [:default :dispatcher]]
+    (let [form (list 'loophole '[i 0 x 0]
+                     (list 'while '(< i 3)
+                           (list 'if (list 'do '(swap! events conj :test) (list 'quote value))
+                                 '(setq x (inc x)) '(setq x (dec x)))
+                           '(setq i (inc i))) 'x)]
+      (is (= {:value expected :trace [:test :test :test]} (execution form mode))))))
+
+(deftest structured-loops-and-fallbacks
+  (let [form '(loophole [i 0 a 0 b 1]
+                (label again)
+                (swap! events conj [i a b])
+                (if (< i 6)
+                  (do (psetq a b b (+ a b)) (setq i (inc i)) (goto again))
+                  [a b]))]
+    (is (= :structured (:op (selection form))))
+    (doseq [mode [:default :dispatcher]]
+      (let [events (atom [])]
+        (is (= [8 13] ((compile-program form mode) events)))
+        (is (= [[0 0 1] [1 1 1] [2 1 2] [3 2 3] [4 3 5] [5 5 8] [6 8 13]] @events)))))
+  (is (= :cycles (:reason (selection '(loophole [i 0 j 0]
+                                       (while (< i 2) (setq i (inc i)))
+                                       (while (< j 3) (setq j (inc j))) [i j])))))
+  (let [step '(if (odd? i) (setq x (inc x) y (inc y)) (setq x (+ x 2) y (+ y 2)))
+        form (list 'loophole '[i 0 x 0 y 0]
+                   (list* 'while '(< i 3) (concat (repeat 8 step) ['(setq i (inc i))])) '[x y])]
+    (is (= :budget (:reason (selection form))))
+    (is (= [40 40] ((compile-program form :default) (atom []))))))
+
+(deftest structured-code-preserves-native-validation
+  (doseq [invalid '[(Math/abs 1 2 3) (String. 1 2 3 4 5)]]
+    (let [form (list 'loophole '[i 0] '(label again) '(setq i (inc i))
+                     '(when (< i 2) (goto again)) '(goto end) invalid)]
+      (doseq [mode [:default :dispatcher]]
+        (is (thrown? clojure.lang.Compiler$CompilerException (compile-program form mode))))))
+  (let [form '(loophole [i 0]
+                (label again) (setq i (inc i)) (when (< i 2) (goto again))
+                (goto end) (swap! events conj :dead))
+        events (atom [])]
+    (is (= :validation (:reason (selection form))))
+    (is (nil? ((compile-program form :default) events)))
+    (is (empty? @events))))
+
+(deftest joins-share-one-continuation
+  (let [step '(if (odd? i) (setq hits (inc hits)) (setq hits (+ hits 2)))
+        form (list 'loophole '[i 0 hits 0]
+                   (list* 'while '(< i 3) (concat (repeat 8 step) ['(setq i (inc i))])) 'hits)
+        decision (selection form)]
+    (is (= :structured (:op decision)))
+    (is (= 9 (count (filter #(and (map? %) (= :branch (:op %))) (tree-seq coll? seq (:body decision))))))
+    (doseq [mode [:default :dispatcher]] (is (= 40 ((compile-program form mode) (atom []))))))
+  (let [form (list 'loophole '[i 0 answer nil]
+                   (list 'while '(< i 96)
+                         (list 'setq 'answer (list* 'case 'i (concat (mapcat #(vector % %) (range 96)) [nil])))
+                         '(setq i (inc i))) 'answer)]
+    (is (= :structured (:op (selection form))))
+    (doseq [mode [:default :dispatcher]] (is (= 95 ((compile-program form mode) (atom []))))))
+  (doseq [mode [:default :dispatcher]]
+    (let [events (atom [])]
+      (is (= [false nil 7]
+             ((compile-program '(loophole [i 0 values []]
+                                  (while (< i 3)
+                                    (let [value (case i 0 (do (swap! events conj :false) false)
+                                                       1 (do (swap! events conj :nil) nil)
+                                                       (do (swap! events conj :number) 7))]
+                                      (setq values (conj values value)))
+                                    (setq i (inc i))) values) mode) events)))
+      (is (= [:false :nil :number] @events)))))
+
+(defn primitive-target ^long [^long n] (+ n 1))
+(defn primitive-replacement ^long [^long n] (+ n 100))
+
+(deftest primitive-conversions-effects-and-exceptions
+  (doseq [mode [:default :dispatcher]]
+    (is (= {:throw ArithmeticException :trace [:before]}
+           (execution '(loophole [^long i 1]
+                         (while (< i 2)
+                           (swap! events conj :before)
+                           (+ Long/MAX_VALUE i)
+                           (swap! events conj :after)
+                           (setq i (inc i)))) mode)))
+    (is (= {:throw NullPointerException :trace []}
+           (execution '(loophole [^long i 0]
+                         (while (< i 1)
+                           (^{:param-tags [long long]} Math/max nil (do (swap! events conj :argument) 1))
+                           (setq i (inc i)))) mode)))
+    (let [f (compile-program '(loophole [^long i 0]
+                               (while (< i 1)
+                                 (primitive-target (do (swap! events conj :argument) 5))
+                                 (setq i (inc i)))) mode)
+          events (atom [])]
+      (with-redefs [primitive-target (fn [x] x)]
+        (is (thrown? ClassCastException (f events)))
+        (is (empty? @events))))
+    (with-redefs [primitive-target primitive-target]
+      (is (= {:value 6 :trace []}
+             (execution '(loophole [^long i 0 result nil]
+                           (while (< i 1)
+                             (setq result (primitive-target
+                                            (do (alter-var-root #'primitive-target (constantly primitive-replacement)) 5))
+                                   i (inc i))) result) mode))))))
+
+(deftest object-conversions-preserve-references-dispatch-and-order
+  (doseq [mode [:default :dispatcher]]
+    (is (= {:throw ClassCastException :trace [:array]}
+           (execution '(loophole [^long i 0]
+                         (while (< i 1)
+                           (^{:param-tags [long/1 int long]} clojure.lang.RT/aset
+                             (do (swap! events conj :array) (identity :wrong))
+                             (do (swap! events conj :index) 0)
+                             (do (swap! events conj :value) 1))
+                           (setq i (inc i)))) mode)))
+    (is (= {:value true :trace []}
+           (execution '(loophole [i 0 x (inc (long 1000)) same true]
+                         (while (< i 3)
+                           (let [copy (java.util.Objects/requireNonNull x)]
+                             (setq same (and same (identical? copy x)) i (inc i)))) same) mode)))
+    (is (= {:value [false false "null"] :trace [:left :right]}
+           (execution '(loophole [i 0 x nil result nil]
+                         (while (< i 1)
+                           (setq result (java.util.Objects/equals
+                                          (do (swap! events conj :left) x)
+                                          (do (setq x false) (swap! events conj :right) x))
+                                 i (inc i)))
+                         [result x (^{:param-tags [Object]} String/valueOf nil)]) mode)))
+    (is (= {:throw NullPointerException :trace [:message]}
+           (execution '(loophole [i 0]
+                         (while (< i 1)
+                           (^{:param-tags [Object String]} java.util.Objects/requireNonNull
+                             nil (do (swap! events conj :message) "required"))
+                           (setq i (inc i)))) mode)))))
+
+(deftest primitive-cast-cleanup-keeps-observable-boxes
+  (let [form '(loophole [x (long events)]
+                (< (^{:param-tags [long]} clojure.lang.RT/longCast x) 0))
+        program (compacted form)]
+    (is (not-any? #(and (map? %) (= :host (:op %))
+                        (= clojure.lang.RT (:class (:operation %)))
+                        (= 'longCast (:member (:operation %)))
+                        (= [Long/TYPE] (:tags (:operation %))))
+                  (tree-seq coll? seq (:body program))))
+    (doseq [mode [:default :dispatcher] input [Long/MIN_VALUE 1000 Long/MAX_VALUE]]
+      (is (= (neg? input) ((compile-program form mode) input)))))
+  (doseq [mode [:default :dispatcher]]
+    (is (false? ((compile-program '(loophole [] (let [x 1000] (identical? x x))) mode) nil)))
+    (is (true? ((compile-program '(loophole [x (long 1000) y nil] (psetq y x) (identical? x y)) mode) nil)))))
diff --git a/test/com/tailrecursion/blacktide/case_test.clj b/test/com/tailrecursion/blacktide/case_test.clj
new file mode 100644
index 0000000..bb77319
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/case_test.clj
@@ -0,0 +1,225 @@
+(ns com.tailrecursion.blacktide.case-test
+  "Compare native case dispatch, then attack unique arms, lexical joins and
+  pending evaluation. Constants are deliberately not interpreted with ordinary =."
+  (:require [clojure.test :refer [deftest is]]
+            [clojure.walk :as walk]
+            [com.tailrecursion.blacktide :refer [loophole setq psetq label goto]]
+            [com.tailrecursion.blacktide.jvm-test :as jvm]
+            [com.tailrecursion.blacktide.source-test :as source]))
+
+(defn compile-function [form]
+  (binding [*ns* (the-ns 'com.tailrecursion.blacktide.case-test)]
+    (eval (list 'fn ['input] form))))
+
+(defn result [f value]
+  (try {:value (f value)} (catch Throwable error {:error (class error) :message (ex-message error)})))
+
+(deftest constants-match-native-dispatch
+  (let [tables ['[1 :integer]
+                '[:a :keyword nil :nil false :false true :true]
+                '["Aa" :aa "BB" :bb "AaAa" :aaaa "BBBB" :bbbb]
+                '[alpha :alpha beta :beta]
+                '[\a :character \newline :newline]
+                '[1N :bigint 1M :decimal 1/2 :ratio 4294967297 :large]
+                '[nil :nil [1 2] :vector {:a 1} :map #{1 2} :set]
+                '[1 :one :a :keyword "Aa" :string \a :character nil :nil false :false]
+                '[(1 2) :integers ("Aa" "BB") :strings (alpha beta) :symbols]
+                (vec (mapcat (fn [n] [n (* n n)]) (range 96)))]
+        values [nil false true -1 0 1 2 (int 1) (byte 1) 1N 1M 1.0 (float 1) 1/2
+                4294967297 95 96 :a :missing 'alpha 'beta 'String "Aa" "BB" "AaAa" "BBBB" "other"
+                \a \newline [1 2] '(1 2) {:a 1} #{1 2} String]]
+    (doseq [table tables default? [true false]]
+      (let [form (list* 'case 'input (cond-> table default? (conj :default)))
+            expected (compile-function form) actual (compile-function (list 'loophole [] form))]
+        (doseq [value values]
+          (is (= (result expected value) (result actual value)) (pr-str {:table table :default? default? :value value})))))))
+
+(deftest dispatch-effects-and-branch-results
+  (is (= 10 (loophole [x 0]
+              (case (do (setq x (inc x)) x) 1 (setq x 10) 2 (setq x 20) (setq x 30)) x)))
+  (let [events (atom [])]
+    (is (= [1 30 40 40]
+           (loophole [x 0]
+             [(do (setq x 1) x)
+              (case (do (swap! events conj :dispatch) (setq x 2))
+                1 (do (swap! events conj :wrong) (setq x 10))
+                2 (do (swap! events conj :chosen) (+ (setq x 10) (setq x 20)))
+                (setq x 99))
+              (setq x 40) x])))
+    (is (= [:dispatch :chosen] @events)))
+  (is (= [9 nil 3]
+         (loophole [x 1 y 2]
+           [(case x 1 (setq x (case y 2 9 0)) 0)
+            (case x 9 (psetq x 3 y x) 0) x])))
+  (is (= 0 (loophole [x 0] (case (setq x 1) :default) (setq x 0))))
+  (is (= [:string :long :object :object]
+         (loophole [x 1]
+           [(.choose ^com.tailrecursion.blacktide.jvm_test.Choice jvm/chooser (case x 1 "x" "y"))
+            (.choose ^com.tailrecursion.blacktide.jvm_test.Choice jvm/chooser (case x 1 2 3))
+            (.choose ^com.tailrecursion.blacktide.jvm_test.Choice jvm/chooser (case x 1 true false))
+            (.choose ^com.tailrecursion.blacktide.jvm_test.Choice jvm/chooser (case x 1 2 nil))]))))
+
+(deftest case-jumps-do-not-fall-through
+  (is (= :done (loophole []
+                 (case :a (:a :b :c) (goto done) :wrong)
+                 (throw (Exception. "fell through")) (label done) :done)))
+  (is (= [3 [0 1 2 3]]
+         (loophole [n 0 trace []]
+           (label again)
+           (case (do (setq trace (conj trace n)) n)
+             (0 1 2) (do (setq n (inc n)) (goto again))
+             3 :done)
+           [n trace]))))
+
+(deftest cases-and-original-loops
+  (is (= [3 6] (loophole [sum 0]
+                 (loop [i 0]
+                   (case i
+                     (0 1 2) (do (setq sum (+ sum i)) (recur (inc i)))
+                     3 (do (setq sum (+ sum i)) [i sum]))))))
+  (doseq [form '[(loop [i 3] (case i 0 :done (recur (dec i))))
+                (loop [i 1] (.choose ^com.tailrecursion.blacktide.jvm_test.Choice chooser (case i 1 i 0)))
+                (loop [i 1] (.choose ^com.tailrecursion.blacktide.jvm_test.Choice chooser (case i 1 "a" nil)))
+                (loop [i 0] (case i 0 (let [i 1] (case i 1 :yes :no)) :wrong))]]
+    (is (= (jvm/outcome form) (jvm/outcome (list 'loophole [] form))) (pr-str form)))
+  (is (= :done (loophole [] (loop [i 1] (case i 0 :done (do (setq) (psetq) (recur 0))))))))
+
+(defmacro env-size [] (count &env))
+(defmacro dispatch-local [] (first (keys &env)))
+(def expansions (atom []))
+(defmacro expanded [tag value] (swap! expansions conj tag) value)
+
+(deftest case-macro-environments-and-initialization
+  (reset! expansions [])
+  (is (= :group
+         (source/run-form
+           '(com.tailrecursion.blacktide/loophole []
+              (case :a
+                (:a :b) (com.tailrecursion.blacktide.case-test/expanded :group :group)
+                "Aa" (com.tailrecursion.blacktide.case-test/expanded :aa :aa)
+                "BB" (com.tailrecursion.blacktide.case-test/expanded :bb :bb)
+                (com.tailrecursion.blacktide.case-test/expanded :default :default))))))
+  (is (= [:group :aa :bb :default] @expansions))
+  (let [body '(let [x 0] (case input 1 (env-size) :other))]
+    (is (= (result (compile-function body) 1) (result (compile-function (list 'loophole [] body)) 1))))
+  (binding [*ns* (the-ns 'com.tailrecursion.blacktide.case-test)]
+    (is (= 1 (eval '(loophole [] (case 1 1 (dispatch-local))))))
+    (let [form '(loophole [] (goto body) (case 1 1 (do (label body) (dispatch-local))))]
+      (is (= :marker-position
+             (try (eval form) nil
+                  (catch Throwable error
+                    (:kind (ex-data (loop [error error] (if-let [cause (ex-cause error)] (recur cause) error)))))))))))
+
+(deftest native-case-errors-and-source-validation
+  (doseq [form '[(case 1 1 :a 1 :b)
+                (case 1 (1 2) :a 2 :b)
+                (case 1 1 :a 1N :b)
+                (case 0 () :empty :other)
+                (case 0)]]
+    (is (= (:error (jvm/outcome form)) (:error (jvm/outcome (list 'loophole [] form)))) (pr-str form)))
+  ;; The public diagnostic contract distinguishes a missing dispatch expression
+  ;; from core case's constant/default errors.
+  (is (= :invalid-case (:kind (source/rejection '(loophole [] (case))))))
+  (is (= :marker-position (:kind (source/rejection '(loophole [] (case 1 1 (label same) 2 (label same)))))))
+  (is (= :undefined-label (:kind (source/rejection '(loophole [] (case 1 1 :ok 2 (goto missing)))))))
+  (is (= :marker-position
+         (:kind (source/rejection '(loophole [] (goto inside) (+ 1 (case 0 0 (do (label inside) 2) 3)))))))
+  (is (= :invalid-recur (:kind (source/rejection '(loophole [] (loop [] (inc (case 0 0 (recur) 1)))))))))
+
+(deftest prepared-dispatch-and-expansion-equivalence
+  (doseq [body '[(case input 0 :zero 2 :two :other)
+                (case input "Aa" :aa "BB" :bb :other)
+                (case input (:a :b) :group nil :nil :other)
+                (case input [1 2] :sequential :other)
+                (case input 1N :one 1M :decimal :other)]
+          :let [expanded (binding [*ns* (the-ns 'com.tailrecursion.blacktide.case-test)] (macroexpand-1 body))
+                expected (compile-function body) actual (compile-function (list 'loophole [] expanded))]
+          value [nil :a :b 0 1 1N 1M 2 "Aa" "BB" "missing" [1 2] '(1 2)]]
+    (is (= (result expected value) (result actual value)) (pr-str {:body body :input value})))
+  (is (= [7 3]
+         (loophole [x 0]
+           [(+ (setq x 1) (case (setq x 2) 2 (setq x 3) 99) x) x])))
+  (is (= [3 :text true]
+         (loophole [x nil out []]
+           (dotimes [i 3]
+             (case i 0 (setq x 3) 1 (setq x :text) (setq x true))
+             (setq out (conj out x))) out)))
+  (doseq [body '[(case input 1 "x" (throw (Exception. "missing")))
+                (case input 1 (long 2) (long 3))
+                (case input 1 (boolean true) (boolean false))
+                (case input 1 "x" nil)
+                (case input 1 nil "x")]]
+    (let [form (list 'let '[input 1]
+                    (list '.choose (with-meta 'chooser {:tag 'com.tailrecursion.blacktide.jvm_test.Choice}) body))]
+      (is (= (jvm/outcome form) (jvm/outcome (list 'loophole [] form)))))))
+
+(defn command-model [{:keys [tokens a b weight width]}]
+  ;; Independent transitions on an input tape; no labels, assignment lowering,
+  ;; dispatch ordinals or production compiler representation participate.
+  (loop [i 0 m a n b out []]
+    (if (= i (count tokens)) [m n i out]
+      (let [token (nth tokens i) snapshot m i (inc i)
+            delta (cond (= 0 (mod m 3)) weight (= 1 (mod m 3)) (- weight) :else 0)]
+        (cond
+          (= :stop token) [m n i out]
+          (= :skip token) (recur i m n out)
+          :else
+          (let [[m n] (cond
+                        (or (= :swap token) (= \s token)) [n m]
+                        (= :add token) [(+ m delta) (+ n m delta)]
+                        (= "Aa" token) [(+ m (reduce + 0 (map #(+ delta %) (range width)))) n]
+                        (= "BB" token) [(if (even? n) (+ m delta) (- m delta)) m]
+                        (nil? token) [(if (zero? snapshot) 7 snapshot) n]
+                        :else [m (- n delta)])]
+            (recur i m n (conj out [i snapshot m n]))))))))
+
+(defn command-program [{:keys [tokens a b weight width]}]
+  `(loophole [~'m ~a ~'n ~b ~'i 0 ~'out []]
+     (label ~'scan)
+     (when (= ~'i ~(count tokens)) (goto ~'finished))
+     (let [~'snapshot ~'m ~'token (nth ~tokens ~'i)
+           ~'delta (case (mod ~'snapshot 3) 0 ~weight 1 (- ~weight) 0)]
+       (setq ~'i (inc ~'i))
+       (case ~'token
+         (:swap \s) (psetq ~'m ~'n ~'n ~'m)
+         :add (setq ~'m (+ ~'m ~'delta) ~'n (+ ~'n ~'m))
+         "Aa" (loop [~'snapshot 0]
+                (when (< ~'snapshot ~width)
+                  (setq ~'m (+ ~'m ~'delta ~'snapshot)) (recur (inc ~'snapshot))))
+         "BB" (psetq ~'m (case (mod ~'n 2) 0 (+ ~'m ~'delta) (- ~'m ~'delta)) ~'n ~'m)
+         :stop (goto ~'finished)
+         :skip (goto ~'scan)
+         nil (setq ~'m (case ~'snapshot 0 7 ~'snapshot))
+         (setq ~'n (- ~'n ~'delta)))
+       (setq ~'out (conj ~'out [~'i ~'snapshot ~'m ~'n])))
+     (goto ~'scan)
+     (label ~'finished) [~'m ~'n ~'i ~'out]))
+
+(defn command-outcome [config wrap]
+  (try {:value (source/run-form (wrap (command-program config)))}
+       (catch Throwable error {:error (class error) :message (ex-message error)})))
+
+(defn minimize-command [config wrap]
+  (let [failure (:error (command-outcome config wrap))]
+   (loop [config config]
+    (let [smaller (concat
+                    (for [index (range (count (:tokens config)))]
+                      (update config :tokens #(into (subvec % 0 index) (subvec % (inc index)))))
+                    (for [key [:a :b :weight :width] value (distinct [0 (quot (get config key) 2)])
+                          :when (not= value (get config key))] (assoc config key value)))]
+      (if-let [candidate (first (filter #(let [actual (command-outcome % wrap)]
+                                          (and (= failure (:error actual)) (not= {:value (command-model %)} actual))) smaller))]
+        (recur candidate) config)))))
+
+(deftest generated-case-loop-jump-programs
+  (let [seed 173205 random (java.util.Random. seed) alphabet [:swap \s :add "Aa" "BB" :stop :skip nil :other]]
+    (dotimes [index 120]
+      (let [config {:tokens (vec (repeatedly (.nextInt random 25) #(nth alphabet (.nextInt random (count alphabet)))))
+                    :a (- (.nextInt random 21) 10) :b (- (.nextInt random 21) 10)
+                    :weight (- (.nextInt random 7) 3) :width (.nextInt random 6)}
+            expected {:value (command-model config)}]
+        (doseq [wrap [identity #(list 'do (walk/postwalk-replace '{m left n right scan again finished done snapshot saved} %))]]
+          (let [actual (command-outcome config wrap)]
+            (is (= expected actual)
+                (pr-str {:seed seed :index index :config config :expected expected :actual actual
+                         :minimal (when-not (= expected actual) (command-program (minimize-command config wrap)))}))))))))
diff --git a/test/com/tailrecursion/blacktide/check.clj b/test/com/tailrecursion/blacktide/check.clj
new file mode 100644
index 0000000..9d3b0cf
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/check.clj
@@ -0,0 +1,86 @@
+(ns com.tailrecursion.blacktide.check
+  "Check production compiler pass bodies independently of the nanopass library."
+  (:require [clojure.test :refer [deftest is]]
+            [typed.clojure :as t]
+            [com.tailrecursion.nanopass.check :as probes]
+            [com.tailrecursion.blacktide.annotations]))
+
+(deftest compiler-passes
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.errors))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.feasible))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.value-facts))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.box-origins))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.invariants))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.structure))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.joins))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.storage))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.compact))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.structured-emit))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.backend))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.jvm))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.source-host))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.source-jvm))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.source-case))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.cases))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.case-emit))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.host-emit))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.emit))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.graph))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.source))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.loop-facts))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.effects))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.boundaries))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.native))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.assignment))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.source-values))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.collections))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.prepare))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.order))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.lower))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler.transfers))
+  (is (t/check-ns-clj 'com.tailrecursion.blacktide.compiler)))
+
+(deftest assignment-stage-exclusions
+  (let [expr (fn [node] {:site {:form nil :file nil :line nil :column nil}
+                         :jvm {:hint nil :var-meta {} :type :unknown :primitive? false :hint-error nil}
+                         :node node})
+        batch {:op :psetq :pairs []}
+        assigned 'com.tailrecursion.blacktide.compiler.source-languages/Assigned-Expr]
+    (probes/accepts? 'com.tailrecursion.blacktide.compiler.source-languages/Bound-Node {:op :setq :pairs []} true)
+    (probes/accepts? 'com.tailrecursion.blacktide.compiler.source-languages/Sequential-Node {:op :setq :pairs []} false)
+    (probes/accepts? 'com.tailrecursion.blacktide.compiler.source-languages/Sequential-Node batch true)
+    (probes/accepts? assigned (expr batch) false)
+    (probes/accepts? assigned (expr {:op :do :forms [(expr batch)]}) false)
+    (probes/accepts? 'com.tailrecursion.blacktide.compiler.source-languages/Native-Expr
+                    (expr {:op :do :forms [(expr batch)]}) false)
+    (probes/accepts? assigned (expr {:op :literal :value batch}) true)))
+
+(deftest native-and-recur-boundaries
+  (probes/accepts? 'com.tailrecursion.blacktide.compiler.source-languages/Native-Node {:op :setq :pairs []} false)
+  (probes/accepts? 'com.tailrecursion.blacktide.compiler.source-languages/Native-Node
+                  {:op :goto :name 'end} false)
+  (probes/accepts? 'com.tailrecursion.blacktide.compiler.source-languages/Ordered-Node
+                  {:op :recur :target {:id 'loop :bindings []} :args []} true)
+  (probes/accepts? 'com.tailrecursion.blacktide.compiler.source-languages/Ordered-Node
+                  {:op :recur :target {:id 'loop :bindings []} :args [{:op :literal :value 1}]} false))
+
+(deftest host-preparation-boundary
+  (let [operation {:op :method-value :name 'String/.length}
+        unprepared {:op :host :operation operation :args []}
+        prepared {:op :host-call :operation operation :args []}]
+    (probes/accepts? 'com.tailrecursion.blacktide.compiler.source-languages/Collections-Node unprepared true)
+    (probes/accepts? 'com.tailrecursion.blacktide.compiler.source-languages/Prepared-Node unprepared false)
+    (probes/accepts? 'com.tailrecursion.blacktide.compiler.source-languages/Prepared-Node prepared true)
+    (probes/accepts? 'com.tailrecursion.blacktide.compiler.source-languages/Ordered-Node
+                    (assoc prepared :args [{:op :literal :value nil}]) false)))
+
+(deftest case-selection-boundary
+  (let [expr {:site {:form nil :file nil :line nil :column nil}
+              :jvm {:hint nil :var-meta {} :type Long/TYPE :primitive? true :hint-error nil}
+              :node {:op :literal :value 0}}
+        node {:op :case :selector expr :arms [expr]}]
+    (probes/accepts? 'com.tailrecursion.blacktide.compiler.source-languages/Assigned-Node node true)
+    (probes/accepts? 'com.tailrecursion.blacktide.compiler.source-languages/Cases-Node node false)
+    (probes/accepts? 'com.tailrecursion.blacktide.compiler.source-languages/Cases-Node (assoc node :op :select) true)
+    (probes/accepts? 'com.tailrecursion.blacktide.compiler.languages/CFG-Term
+                    {:op :switch :test {:op :literal :value 0} :targets [1 2]} true)))
diff --git a/test/com/tailrecursion/blacktide/collections_test.clj b/test/com/tailrecursion/blacktide/collections_test.clj
new file mode 100644
index 0000000..67b4392
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/collections_test.clj
@@ -0,0 +1,135 @@
+(ns com.tailrecursion.blacktide.collections-test
+  "Compare native collection construction, metadata, errors and observable order."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.blacktide :refer [loophole]]
+            [com.tailrecursion.blacktide.compiler.backend :as backend]
+            [com.tailrecursion.blacktide.compiler.emit :as emit]))
+
+(defn record! [events tag value] (swap! events conj tag) value)
+(defmacro key-a [] :a)
+(defmacro key-b [] :a)
+
+(defn observe [form]
+  (binding [*ns* (the-ns 'com.tailrecursion.blacktide.collections-test)]
+    (eval (list 'let ['events '(atom [])
+                     'result (list 'try [:value form]
+                                   '(catch Throwable e [:error (class e) (ex-message e)]))]
+                ['result '(deref events)]))))
+
+(deftest collection-values-and-constant-identity
+  (doseq [body ['[] '{} '#{} '[1 2 :a] '{:a 1 :b 2} '#{1 :a}
+                '[1 {:a [2]} #{3}] '[nil false true 1N 2M 1/2]]]
+    (is (= (observe body) (observe (list 'loophole [] body))) (pr-str body)))
+  (let [plain (fn [] [1 {:a 2}]) compiled (fn [] (loophole [] [1 {:a 2}]))
+        plain-meta (fn [] ^{:note :yes} [1]) compiled-meta (fn [] (loophole [] ^{:note :yes} [1]))]
+    (is (identical? (plain) (plain)))
+    (is (identical? (compiled) (compiled)))
+    (is (not (identical? (plain-meta) (plain-meta))))
+    (is (not (identical? (compiled-meta) (compiled-meta))))))
+
+(deftest source-traversal-is-frozen
+  (let [entry (fn [i] [(list 'record! 'events (keyword (str "key" i)) i)
+                       (list 'record! 'events (keyword (str "value" i)) (- i))])
+        map-form (into {} (map entry (range 19)))
+        set-form (set (map first (map entry (range 19))))]
+    (doseq [body [map-form set-form (vec (map second (map entry (range 19))))]]
+      (is (= (observe body) (observe (list 'loophole [] body)))))))
+
+(deftest duplicate-errors-and-metadata-extent
+  (doseq [body [(array-map '(record! events :key1 :a) '(record! events :value1 1)
+                          '(record! events :key2 :a) '(record! events :value2 2))
+                #{'(record! events :first :a) '(record! events :second :a)}]]
+    (let [body (with-meta body {:note '(record! events :metadata :never)})
+          expected (observe body) actual (observe (list 'loophole [] body))]
+      (is (= expected actual))
+      (is (= :error (ffirst actual)))
+      (is (not (some #{:metadata} (second actual))))))
+  (let [body (with-meta ['(record! events :value 1)] {:note '(record! events :metadata :done)})
+        compiled (list 'loophole [] body)]
+    (is (= (observe body) (observe compiled)))
+    (is (= [:value :metadata] (second (observe compiled))))
+    (is (= {:note :done} (meta (second (first (observe compiled)))))))
+  (let [quoted (list 'quote (with-meta [1] {:note '(unresolved-data)}))]
+    (is (= {:note '(unresolved-data)} (meta (second (first (observe (list 'loophole [] quoted)))))))))
+
+(deftest constant-duplicates-are-compile-errors
+  (doseq [body [(array-map '(key-a) 1 '(key-b) 2)]
+          form [body (list 'loophole [] body)]]
+    (let [error (try (observe form) nil (catch Throwable e (loop [e e] (if-let [cause (ex-cause e)] (recur cause) e))))]
+      (is (instance? IllegalArgumentException error))))
+  ;; Native constant sets coalesce macro-expanded duplicates. Metadata prevents
+  ;; that constant folding, so the same duplicates then fail during construction.
+  (let [body #{'(key-a) '(key-b)}]
+    (is (= [[:value #{:a}] []] (observe body) (observe (list 'loophole [] body))))
+    (let [body (with-meta body {})]
+      (is (= (observe body) (observe (list 'loophole [] body))))
+      (is (= :error (ffirst (observe (list 'loophole [] body))))))))
+
+(deftype TracedKey [id events]
+  Object
+  (hashCode [_] (swap! events conj [:hash id]) (int id))
+  (equals [_ other] (and (instance? TracedKey other) (= id (.-id ^TracedKey other)))))
+
+(deftest construction-retains-key-hash-order
+  (doseq [body ['#{a b c} '{a 1 b 2 c 3}]]
+    (let [wrap (fn [body] (list 'let ['a '(TracedKey. 1 events) 'b '(TracedKey. 2 events) 'c '(TracedKey. 3 events)] body))]
+      (is (= (observe (wrap body)) (observe (wrap (list 'loophole [] body))))))))
+
+(deftest construction-uses-native-operations
+  (let [f (fn [x] (loophole [] ^{:note :yes} [x {x x} #{x}]))
+        value (with-redefs [with-meta (constantly :wrong) vector (constantly :wrong)
+                           hash-map (constantly :wrong) hash-set (constantly :wrong)] (f 3))]
+    (is (= [3 {3 3} #{3}] value))
+    (is (= {:note :yes} (meta value)))))
+
+(deftest vector-construction-boundaries
+  (doseq [mode [:default :dispatcher]]
+    (binding [*ns* (the-ns 'com.tailrecursion.blacktide.collections-test)]
+      (with-redefs [backend/compile-program (if (= mode :dispatcher)
+                                                  emit/program-form
+                                                  backend/compile-program)]
+        (doseq [size [0 1 6 7 32 33 63] metadata [nil {} {:note :yes}]]
+          (let [body (with-meta (mapv #(list 'record! 'events % %) (range size)) metadata)
+                wrap identity
+                constant (with-meta (vec (range size)) metadata)
+                plain (eval (list 'fn [] (wrap constant)))
+                compiled (eval (list 'fn [] (list 'loophole [] (wrap constant))))
+                observation (fn [f] [(class (f)) (meta (f))])]
+            (is (= [(observe (wrap body)) (observation plain)]
+                   [(observe (list 'loophole [] (wrap body))) (observation compiled)])
+                (pr-str [mode size metadata]))))
+        (doseq [size [1 6 7 32 33]
+                offset (distinct [0 (quot size 2) (dec size)])]
+          (let [body (assoc (mapv #(list 'record! 'events % %) (range size)) offset
+                           '(throw (IllegalStateException. "stop")))]
+            (is (= (observe body) (observe (list 'loophole [] body))) (pr-str [mode size offset]))))
+        (doseq [size [1 6 7 32 33]]
+          (let [body (assoc (vec (range size)) 0 '(int 1000))]
+            (is (= (mapv class (second (first (observe body))))
+                   (mapv class (second (first (observe (list 'loophole [] body)))))))))
+        (doseq [size [1 6 7 33] value [1000 1.5 (Integer/valueOf 1000)]]
+          (let [body (with-meta (assoc (vec (range size)) 0 value) {})
+                wrap identity
+                plain (eval (list 'fn [] (wrap body)))
+                compiled (eval (list 'fn [] (list 'loophole [] (wrap body))))
+                observation (fn [f] [(class (first (f))) (first (f))])]
+            (is (= (observation plain) (observation compiled)) (pr-str [mode size value]))))))))
+
+(deftest deterministic-construction-differentials
+  (let [seed 314159 random (java.util.Random. seed)
+        value (fn [tag] (let [v (.nextInt random 8)]
+                          (case (.nextInt random 3)
+                            0 v
+                            1 (list 'record! 'events tag v)
+                            (list 'let ['x v] (list 'record! 'events tag 'x)))))]
+    (dotimes [trial 150]
+      (let [n (.nextInt random 13)
+            values (mapv #(value (keyword (str "item" %))) (range (* 2 n)))
+            body (case (.nextInt random 3)
+                   0 values
+                   1 (into {} (map vec (partition 2 values)))
+                   (set values))
+            body (if (.nextBoolean random) (with-meta body {:note '(record! events :metadata :ready)}) body)
+            wrap (fn [body] (list 'let ['out body] ['out '(meta out)]))]
+        (is (= (observe (wrap body)) (observe (wrap (list 'loophole [] body))))
+            (str "seed " seed ", trial " trial ": " (pr-str body)))))))
diff --git a/test/com/tailrecursion/blacktide/control_test.clj b/test/com/tailrecursion/blacktide/control_test.clj
new file mode 100644
index 0000000..c6d0829
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/control_test.clj
@@ -0,0 +1,80 @@
+(ns com.tailrecursion.blacktide.control-test
+  "Source control flow and live values across state-machine transitions."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.blacktide :refer [loophole setq psetq]]
+            [com.tailrecursion.blacktide.source-test :as source]
+            [com.tailrecursion.blacktide.assignment-test :as assignment]
+            [com.tailrecursion.nanopass.assignment-test :as oracle]))
+
+(defn record! [events tag value] (swap! events conj tag) value)
+
+(deftest clojure-conditions-and-joins
+  (doseq [condition [nil false true 0 "" []]]
+    (is (= (if condition :yes :no) (loophole [] (if condition :yes :no)))))
+  (is (nil? (loophole [] (if false :unused))))
+  (is (= 20 (loophole [x 0] (if (setq x false) (setq x 10) (setq x 20)) x)))
+  (doseq [condition [true false]]
+    (is (= (if condition [10 2] [1 "changed"])
+           (loophole [x 1 y 2] (if condition (setq x 10) (setq y "changed")) [x y]))))
+  (is (= [3 4] (loophole [x 1] [(if true (if false 2 (setq x 3)) 9) (setq x 4)]))))
+
+(deftest operands-survive-partial-evaluation
+  (is (= [1 10 10 20]
+         (loophole [x 1] [x (if true (setq x 10) 0) x (if false 0 (setq x 20))])))
+  (is (= [1 :changed 9]
+         (loophole [f vector x 1]
+           (f x (if true (do (setq f list x 9) :changed) :unused) x))))
+  (is (= [nil 2 1]
+         (loophole [x 1 y 2]
+           [(psetq x (if true y 99) y (if false 99 x)) x y])))
+  (is (= [1 3 3]
+         (loophole [x 1]
+           [(let [before x after (if true (setq x 3) 4)] before) x x]))))
+
+(deftest selected-effects-and-short-circuit-macros
+  (let [events (atom [])]
+    (is (= [:yes nil false 7]
+           (loophole [x 1]
+             [(if (record! events :test true) (record! events :yes :yes) (record! events :no :no))
+              (and (setq x nil) (record! events :unused 4))
+              (or (setq x false) (record! events :or false))
+              (cond (setq x false) (record! events :unused 6) :else (record! events :cond 7))])))
+    (is (= [:test :yes :or :cond] @events)))
+  (is (= [3 3] (loophole [x nil] (when-not x (setq x 3)) [(when x x) x])))
+  (is (= [9 nil] (loophole [x 9] [(if-let [y x] y :absent) (when-let [y (setq x nil)] y)]))))
+
+(deftest throwing-branches-and-dead-source
+  (let [one (ex-info "one" {}) two (ex-info "two" {})]
+    (doseq [condition [true false]]
+      (is (identical? (if condition one two)
+                     (try (loophole [] (if condition (throw one) (throw two))) (catch Throwable e e))))))
+  (let [events (atom []) error (ex-info "stop" {})]
+    (is (identical? error
+          (try (loophole [x 1 y 2]
+                 (psetq x (record! events :first 10)
+                        y (if (record! events x true) (throw error) 9))
+                 (record! events :after :bad))
+               (catch Throwable e e))))
+    (is (= [:first 1] @events)))
+  (is (= :unresolved-symbol (:kind (source/rejection '(loophole [] (if true 1 missing))))))
+  (is (= :unresolved-symbol (:kind (source/rejection '(loophole [] (throw nil) missing)))))
+  (doseq [form ['(if true) '(if true 1 2 3) '(throw) '(throw nil nil)]]
+    (is (= (if (= 'if (first form)) :invalid-if :invalid-throw)
+           (:kind (source/rejection (list 'loophole [] form)))))))
+
+(deftest generated-effectful-conditions
+  (let [seed 20261104 random (java.util.Random. seed)]
+    (dotimes [trial 100]
+      (let [test (case (.nextInt random 3)
+                   0 (oracle/batch :psetq 'x (oracle/read-var 'y) 'y (oracle/read-var 'x))
+                   1 (oracle/batch :setq 'x (oracle/lit 0))
+                   (oracle/read-var 'x))
+            node {:op :if :test (oracle/event :test test)
+                  :then (oracle/expression random 2) :else (oracle/expression random 2)}]
+        (doseq [[x y] [[0 0] [1 2] [-7 5] [10 -3]]]
+          (let [expected (oracle/execute node {'x x 'y y}) actual (assignment/execute node x y)]
+            (is (= expected actual)
+                (when (not= expected actual)
+                  (pr-str {:seed seed :trial trial :input [x y]
+                           :source (oracle/minimize node
+                                     #(not= (oracle/execute % {'x x 'y y}) (assignment/execute % x y)))})))))))))
diff --git a/test/com/tailrecursion/blacktide/fixtures/HostFixture.java b/test/com/tailrecursion/blacktide/fixtures/HostFixture.java
new file mode 100644
index 0000000..556ec2b
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/fixtures/HostFixture.java
@@ -0,0 +1,10 @@
+package com.tailrecursion.blacktide.fixtures;
+
+public final class HostFixture {
+    public static String clash = "field";
+    public static String clash() { return "method"; }
+    public static String clash(String suffix) { return "method:" + suffix; }
+    public static String argumentOnly = "field";
+    public static String argumentOnly(String suffix) { return suffix; }
+    public static String fieldOnly = "field";
+}
diff --git a/test/com/tailrecursion/blacktide/generated_test.clj b/test/com/tailrecursion/blacktide/generated_test.clj
new file mode 100644
index 0000000..a4a2756
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/generated_test.clj
@@ -0,0 +1,145 @@
+(ns com.tailrecursion.blacktide.generated-test
+  "Bounded source generation with a separate state model, two backends, alpha
+  variants and validity-preserving shrinking. Coverage includes fallback code."
+  (:require [clojure.test :refer [deftest is]]
+            [clojure.walk :as walk]
+            [com.tailrecursion.blacktide :refer [loophole label goto setq psetq]]
+            [com.tailrecursion.blacktide.backend-test :as backend]
+            [com.tailrecursion.blacktide.compiler.structure :as structure]
+            [com.tailrecursion.blacktide.compiler.storage :as storage]))
+
+(defn three-steps [x k] (+ x (* 3 k)))
+
+(def operations [:parallel :if :case :snapshot :arguments :shadow :helper :loop :check :truth :cast])
+
+(defn model-step [{:keys [x y] :as state} i index [op k]]
+  (if (and (= op :check) (= i k)) (reduced (assoc state :throw ArithmeticException))
+    (let [[x y] (case op
+                  :parallel [(+ y k) (- x k)]
+                  :if [(if (< x y) (+ x k) (- x k)) y]
+                  :case [(+ x (case (mod i 3) 0 k 1 (- k) (* 2 k))) y]
+                  :snapshot [(+ x k) (+ y x)]
+                  :arguments [x (+ (* 2 x) k)]
+                  :shadow [x (+ y (* 2 k))]
+                  :helper [(+ x (* 3 k)) y]
+                  :loop [(+ x (* 2 k)) y]
+                  :truth [(+ x (if (even? k) k (- k))) y]
+                  :cast [(+ x k) y]
+                  :check [x y])]
+      (assoc state :x x :y y :trace (conj (:trace state) [i index x y])))))
+
+(defn model [{:keys [limit cut x y steps scalar?]}]
+  (loop [i 0 state {:x x :y y :trace []}]
+    (cond
+      (:throw state) (select-keys state [:throw :trace])
+      (or (= i limit) (= i cut)) {:value (if scalar? (:x state) [(:x state) (:y state)]) :trace (:trace state)}
+      :else (recur (inc i) (reduce (fn [state [index step]] (model-step state i index step))
+                                  state (map-indexed vector steps))))))
+
+(defn observed [numeric? id]
+  ;; A numeric computation observes the number without observing the identity
+  ;; of its source box, so primitive storage can participate in this regime.
+  (if numeric? (list 'unchecked-add id 0) id))
+
+(defn step-form [numeric? index [op k]]
+  `(do
+     ~(case op
+        :parallel `(psetq ~'x (+ ~'y ~k) ~'y (- ~'x ~k))
+        :if `(if (< ~'x ~'y) (setq ~'x (+ ~'x ~k)) (setq ~'x (- ~'x ~k)))
+        :case `(setq ~'x (case (mod ~'i 3) 0 (+ ~'x ~k) 1 (- ~'x ~k) (+ ~'x (* 2 ~k))))
+        :snapshot `(let [~'old ~'x] (setq ~'x (+ ~'x ~k) ~'y (+ ~'y ~'old)))
+        :arguments `(setq ~'y (+ (do (setq ~'x (+ ~'x ~k)) ~'x)
+                                (do (setq ~'x (- ~'x ~k)) ~'x)))
+        :shadow `(let [~'x (+ ~'y ~k)] (setq ~'y (+ ~'x ~k)))
+        :helper `(setq ~'x (com.tailrecursion.blacktide.generated-test/three-steps ~'x ~k))
+        :loop `(let [~'old ~'x]
+                 (setq ~'x (loop [~'n 2 ~'v ~'old]
+                              (if (zero? ~'n) ~'v (recur (dec ~'n) (+ ~'v ~k))))))
+        :truth `(setq ~'x (if ~(if (even? k) (if (pos? k) 0 :selected) (if (pos? k) false nil))
+                           (+ ~'x ~k) (- ~'x ~k)))
+        :cast `(setq ~'x (+ (long ~'x) ~k))
+        :check `(when (= ~'i ~k) (+ Long/MAX_VALUE 1)))
+     (swap! ~'events conj [~(observed numeric? 'i) ~index ~(observed numeric? 'x) ~(observed numeric? 'y)])))
+
+(defn program [{:keys [limit cut x y steps numeric? scalar? hinted? native-result? literal-init?]} control renamed?]
+  (let [body (map-indexed (partial step-form numeric?) steps)
+        local #(if hinted? (with-meta % {:tag 'long}) %)
+        initial #(if (and numeric? (not literal-init?)) (list 'long %) %)
+        cut-form `(when (= ~'i ~cut) (goto ~'done))
+        forms (case control
+                :linear (mapcat (fn [i] `((setq ~'i ~i) ~cut-form ~@body)) (range limit))
+                :goto `((label ~'again) (when (>= ~'i ~limit) (goto ~'done)) ~cut-form
+                        ~@body (setq ~'i (inc ~'i)) (goto ~'again))
+                :recur `((loop [~'i 0]
+                           (when (< ~'i ~limit) ~cut-form ~@body (recur (inc ~'i)))))
+                :nested `((while (< ~'i ~limit) ~cut-form
+                            (dotimes [~'inner 1] ~@body) (setq ~'i (inc ~'i)))))
+        result (if scalar? 'x [(observed numeric? 'x) (observed numeric? 'y)])
+        result (if native-result? `(loop [remaining# 1]
+                                     (if (zero? remaining#) ~result (recur (dec remaining#)))) result)
+        form `(loophole [~(local 'i) 0 ~(local 'x) ~(initial x) ~(local 'y) ~(initial y)]
+                ~@forms (label ~'done) ~result)]
+    (if renamed?
+      (let [renames '{i counter__17 x value__93 y value__94 again start__51 done finish__88}]
+        (list 'let ['unused :harmless]
+              (walk/postwalk #(if (symbol? %) (with-meta (get renames % %) (meta %)) %) form)))
+      form)))
+
+(defn outcome [config control renamed? mode]
+  (try (backend/execution (program config control renamed?) mode)
+       (catch Throwable error {:compile-error (class error) :message (ex-message error)})))
+
+(defn minimize [config control renamed? mode]
+  (loop [config config]
+    (let [smaller (concat
+                    (for [index (range (count (:steps config)))]
+                      (update config :steps #(vec (concat (subvec % 0 index) (subvec % (inc index))))))
+                    (for [key [:limit :cut :x :y] value (distinct [0 (quot (get config key) 2)])
+                          :when (not= value (get config key))] (assoc config key value))
+                    (for [index (range (count (:steps config)))
+                          :when (not (zero? (get-in config [:steps index 1])))]
+                      (assoc-in config [:steps index 1] 0)))]
+      (if-let [next (first (filter #(not= (model %) (outcome % control renamed? mode)) smaller))]
+        (recur next) config))))
+
+(deftest generated-backend-equivalence
+  (let [seed 618033 random (java.util.Random. seed) coverage (atom {}) recover structure/recover
+        choose storage/select-storage]
+    (with-redefs [structure/recover (fn [analysis]
+                                    (let [out (recover analysis)]
+                                      (when (and (= :structured (:op out))
+                                                 (empty? (second (structure/scan (:machine analysis) #{} [#{} #{}]
+                                                                                (:entry (:machine analysis))))))
+                                        (swap! coverage update :acyclic (fnil inc 0)))
+                                      (swap! coverage update (or (:reason out) (:op out)) (fnil inc 0)) out))
+                  storage/select-storage (fn [analysis expr]
+                                           (let [out (choose analysis expr)]
+                                             (when (seq (select-keys (:types out) (storage/loop-slots (:body out))))
+                                               (swap! coverage update :primitive-loops (fnil inc 0)))
+                                             (when (some #(and (map? %) (= :return (:op %))
+                                                              (contains? (:types out) (:id (:value %))))
+                                                         (tree-seq coll? seq (:body out)))
+                                               (swap! coverage update :primitive-returns (fnil inc 0)))
+                                             out))]
+      (dotimes [index 80]
+        (let [config {:numeric? (odd? index) :hinted? (= 1 (mod index 4)) :scalar? (zero? (mod index 3))
+                      :native-result? (zero? (mod index 5))
+                      :literal-init? (= 3 (mod index 4))
+                      :limit (.nextInt random 7) :cut (.nextInt random 9)
+                      :x (- (.nextInt random 31) 15) :y (- (.nextInt random 31) 15)
+                      :steps (vec (repeatedly (inc (.nextInt random 5))
+                                             #(vector (nth operations (.nextInt random (count operations)))
+                                                      (- (.nextInt random 9) 4))))}
+              expected (model config)]
+          (doseq [control [:linear :goto :recur :nested] renamed? [false true] mode [:default :dispatcher]]
+            (let [actual (outcome config control renamed? mode)]
+              (is (= expected actual)
+                  (when-not (= expected actual)
+                    (pr-str {:seed seed :index index :control control :mode mode :expected expected :actual actual
+                             :minimal (program (minimize config control renamed? mode) control renamed?)}))))))))
+    (is (pos? (get @coverage :structured 0)) (str @coverage))
+    (is (pos? (get @coverage :acyclic 0)) (str @coverage))
+    (is (pos? (get @coverage :cycles 0)) (str @coverage))
+    (is (pos? (get @coverage :primitive-loops 0)) (str @coverage))
+    (is (pos? (get @coverage :primitive-returns 0)) (str @coverage))
+    (println "Control generator: seed=" seed "source variants=640 executions=1280 coverage=" @coverage)))
diff --git a/test/com/tailrecursion/blacktide/graph_test.clj b/test/com/tailrecursion/blacktide/graph_test.clj
new file mode 100644
index 0000000..afcaf56
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/graph_test.clj
@@ -0,0 +1,109 @@
+(ns com.tailrecursion.blacktide.graph-test
+  "Graph invariants and executable allocation, independent of source lowering."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.blacktide.compiler.graph :as graph]
+            [com.tailrecursion.blacktide.machine-test :as m]))
+
+(defn jump [target] {:op :jump :target target})
+(defn result [value] {:op :return :value value})
+(defn failure [program]
+  (try (graph/analyze program) nil (catch clojure.lang.ExceptionInfo e (ex-data e))))
+
+(deftest validate-destinations-before-reachability
+  (is (= {:kind :invalid-graph :block 0} (failure {:entry 0 :blocks {}})))
+  (is (= {:kind :invalid-graph :block 9 :target 10}
+         (failure {:entry 0 :blocks {0 (m/block [] (result (m/literal :ok)))
+                                    9 (m/block [] (jump 10))}}))))
+
+(deftest initialization-is-path-sensitive
+  (doseq [program [{:entry 0 :blocks {0 (m/block [] (result (m/local 'x)))}}
+                   {:entry 0 :blocks {0 (m/block [(m/assign 'x {:op :value :value (m/local 'x)})]
+                                                 (result (m/local 'x)))}}
+                   {:entry 0 :blocks {0 (m/block [] {:op :branch :test (m/literal true) :yes 1 :no 2})
+                                      1 (m/block [(m/put-value 'x 1)] (jump 3))
+                                      2 (m/block [] (jump 3))
+                                      3 (m/block [] (result (m/local 'x)))}}]]
+    (is (= :uninitialized-slot (:kind (failure program))))
+    (is (= '#{x} (:slots (failure program)))))
+  ;; A definition after a read cannot initialize that read, even with a backedge.
+  (is (= :uninitialized-slot
+         (:kind (failure {:entry 0 :blocks {0 (m/block [(m/assign 'y {:op :value :value (m/local 'x)})
+                                                       (m/put-value 'x 1)] (jump 0))}})))))
+
+(deftest sequential-facts-and-opaque-payloads
+  (is (= {:reads '#{x} :defs '#{x y} :successors []}
+         (graph/block-facts
+           (m/block [(m/assign 'y {:op :value :value (m/local 'x)})
+                     (m/put-value 'x 2)] (result (m/local 'y))))))
+  (let [data {:op :local :id 'ghost}
+        machine (graph/analyze {:entry 0 :blocks {0 (m/block [(m/put-value 'x data)]
+                                                            (result (m/local 'x)))
+                                                  9 (m/block [] (result (m/local 'ghost)))}})]
+    (is (= #{0 9} (set (keys (:blocks machine)))))
+    (is (= '[ghost] (:slots machine)))
+    (is (= data (m/run-machine machine)))))
+
+(deftest multiway-joins
+  (is (= :invalid-graph (:kind (failure {:entry 0 :blocks {0 (m/block [] {:op :switch :test (m/literal 0) :targets []})}}))))
+  (doseq [index (range 3)]
+    (let [program {:entry 0 :blocks {0 (m/block [] {:op :switch :test (m/literal index) :targets [1 2 3]})
+                                     1 (m/block [(m/put-value 'x :first)] (jump 4))
+                                     2 (m/block [(m/put-value 'x :middle)] (jump 4))
+                                     3 (m/block [(m/put-value 'x :last)] (jump 4))
+                                     4 (m/block [] (result (m/local 'x)))}}]
+      (is (= (nth [:first :middle :last] index) (m/run-machine (graph/analyze program))))
+      (is (= :uninitialized-slot (:kind (failure (assoc-in program [:blocks 2 :ops] []))))))))
+
+(deftest joins-and-live-value-survival
+  (doseq [test [true false]]
+    (let [machine (graph/analyze
+                    {:entry 0 :blocks {0 (m/block [(m/put-value 'x 10)
+                                                   (m/assign 'saved {:op :value :value (m/local 'x)})]
+                                                  {:op :branch :test (m/literal test) :yes 1 :no 2})
+                                       1 (m/block [(m/put-value 'x "new")] (jump 3))
+                                       2 (m/block [(m/put-value 'x 2.5)] (jump 3))
+                                       3 (m/block [(m/assign 'f {:op :global :name 'clojure.core/vector})
+                                                   (m/call 'out 'f (m/local 'saved) (m/local 'x))]
+                                                  (result (m/local 'out)))}})]
+      (is (= '[saved x] (:slots machine)))
+      (is (= '#{saved} (get (:live machine) 1)))
+      (is (= '#{saved x} (get (:live machine) 3)))
+      (is (= [10 (if test "new" 2.5)] (m/run-machine machine))))))
+
+(defn step-value [value n] (if (odd? n) (+ value n) (- value n)))
+
+(defn counting-graph [initial n]
+  {:entry 0
+   :blocks {0 (m/block [(m/put-value 'x initial) (m/put-value 'n n)
+                        (m/assign 'step {:op :global :name 'com.tailrecursion.blacktide.graph-test/step-value})
+                        (m/assign 'dec {:op :global :name 'clojure.core/dec})
+                        (m/assign 'zero {:op :global :name 'clojure.core/zero?})]
+                       (jump 1))
+            1 (m/block [(m/call 'done 'zero (m/local 'n))]
+                       {:op :branch :test (m/local 'done) :yes 3 :no 2})
+            2 (m/block [(m/call 'x 'step (m/local 'x) (m/local 'n))
+                        (m/call 'n 'dec (m/local 'n))] (jump 1))
+            3 (m/block [] (result (m/local 'x)))}})
+
+(defn rename-blocks [program]
+  (let [rename #(+ 100 (* 7 %))]
+    {:entry (rename (:entry program))
+     :blocks (into {} (map (fn [[id block]]
+                             [(rename id)
+                              (update block :term
+                                (fn [term]
+                                  (case (:op term)
+                                    :jump (update term :target rename)
+                                    :branch (-> term (update :yes rename) (update :no rename))
+                                    term)))])) (:blocks program))}))
+
+(deftest deterministic-backedges-and-metamorphisms
+  (let [seed 8675309 random (java.util.Random. seed)]
+    (dotimes [trial 75]
+      (let [initial (- (.nextInt random 200) 100) n (.nextInt random 30)
+            expected (+ initial (reduce + 0 (map #(if (odd? %) % (- %)) (range 1 (inc n)))))
+            program (counting-graph initial n)]
+        (doseq [variant [program (rename-blocks program)
+                         (assoc-in program [:blocks 99] (m/block [] (result (m/local 'uninitialized))))]]
+          (is (= expected (m/run-machine (graph/analyze variant)))
+              (str "seed " seed ", trial " trial ", input " [initial n])))))))
diff --git a/test/com/tailrecursion/blacktide/invocation_test.clj b/test/com/tailrecursion/blacktide/invocation_test.clj
new file mode 100644
index 0000000..968c9e1
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/invocation_test.clj
@@ -0,0 +1,142 @@
+(ns com.tailrecursion.blacktide.invocation-test
+  "Direct protocol calls select interface dispatch before falling back to the
+  method Var. Compare values, failures and evaluation traces with Clojure."
+  (:require [clojure.test :refer [deftest is]]
+            [clojure.core.protocols :as p]
+            [com.tailrecursion.blacktide.backend-test :as backend]))
+
+(deftype DirectReduction [events]
+  p/CollReduce
+  (coll-reduce [_ f] (swap! events conj :interface) (f :direct))
+  (coll-reduce [_ f init] (swap! events conj :interface) (f init :direct)))
+
+(defn observe [form mode direct? target-kind replacement]
+  (binding [*compiler-options* {:direct-linking direct?}]
+    (let [events (atom []) f ((backend/compile-program form mode) nil)
+          target (case target-kind :direct (DirectReduction. events) :nil nil :vector [1 2])
+          replacement (case replacement :function (fn [& xs] (swap! events conj :fallback) (vec (rest xs)))
+                                       :nil nil :invalid 42)]
+      (with-redefs [p/coll-reduce replacement]
+        (let [out (try {:value (f target events)} (catch Throwable e {:throw (class e)}))]
+          (assoc out :trace @events))))))
+
+(defn record-result [events tag & _] (swap! events conj tag) tag)
+
+(defn wrapped [body location]
+  (case location
+    :region (list 'fn '[target events] (list 'loophole [] body))
+    :ordinary (list 'fn '[target events] body)))
+
+(deftest direct-protocol-and-first-class-calls-stay-distinct
+  (doseq [body '[(clojure.core.protocols/coll-reduce target vector)
+                (clojure.core.protocols/coll-reduce target vector 7)
+                ((do clojure.core.protocols/coll-reduce) target vector 7)
+                (let [f clojure.core.protocols/coll-reduce] (f target vector 7))]
+          target [:direct :nil :vector] direct? [false true]
+          mode [:default :dispatcher]]
+    (is (= (observe (wrapped body :ordinary) :default direct? target :function)
+           (observe (wrapped body :region) mode direct? target :function))
+        (pr-str [body target direct? mode]))))
+
+(deftest fallback-root-is-read-after-the-target-before-later-arguments
+  (let [body '(clojure.core.protocols/coll-reduce
+                (do (swap! events conj :target)
+                    (alter-var-root #'clojure.core.protocols/coll-reduce
+                                    (constantly (partial com.tailrecursion.blacktide.invocation-test/record-result events :early))) target)
+                (do (swap! events conj :argument)
+                    (alter-var-root #'clojure.core.protocols/coll-reduce
+                                    (constantly (partial com.tailrecursion.blacktide.invocation-test/record-result events :late))) vector)
+                (do (swap! events conj :initial) 7))]
+    (doseq [target [:direct :nil :vector] mode [:default :dispatcher]]
+      (is (= (observe (wrapped body :ordinary) :default false target :function)
+             (observe (wrapped body :region) mode false target :function))
+          (pr-str [target mode])))))
+
+(deftest invalid-fallback-roots-fail-after-arguments
+  (doseq [body '[(clojure.core.protocols/coll-reduce
+                  (do (swap! events conj :target) target)
+                  (do (swap! events conj :argument) vector)
+                  (do (swap! events conj :initial) 7))
+                (clojure.core.protocols/coll-reduce target vector
+                  (do (swap! events conj :throw) (throw (ex-info "argument" {}))))]
+          target [:direct :nil] replacement [:nil :invalid]
+          mode [:default :dispatcher]]
+    (is (= (observe (wrapped body :ordinary) :default false target replacement)
+           (observe (wrapped body :region) mode false target replacement))
+        (pr-str [body target replacement mode]))))
+
+(deftest protocol-operands-may-change-region-state
+  (let [body '(clojure.core.protocols/coll-reduce
+                (do (swap! events conj :target) target)
+                (do (swap! events conj :argument) vector)
+                (do (swap! events conj :initial) 7))
+        source '(fn [target events]
+                  (loophole [x nil]
+                    (clojure.core.protocols/coll-reduce
+                      (do (swap! events conj :target) (setq x target))
+                      (do (swap! events conj :argument) (setq x vector))
+                      (do (swap! events conj :initial) (setq x 7)))))]
+    (doseq [target [:direct :nil :vector] mode [:default :dispatcher]]
+      (is (= (observe (wrapped body :ordinary) :default false target :function)
+             (observe source mode false target :function))))))
+
+(defmacro remove-protocol [value]
+  (alter-meta! #'p/coll-reduce dissoc :protocol)
+  value)
+
+(deftest protocol-facts-are-captured-after-arguments-before-following-forms
+  (let [metadata (meta #'p/coll-reduce)
+        observe (fn [body mode location]
+                  (try (reset-meta! #'p/coll-reduce metadata)
+                       (observe (wrapped body location) mode false :direct :function)
+                       (finally (reset-meta! #'p/coll-reduce metadata))))]
+    (doseq [body '[(do (clojure.core.protocols/coll-reduce target vector 7)
+                      (com.tailrecursion.blacktide.invocation-test/remove-protocol :done))
+                  (clojure.core.protocols/coll-reduce
+                    (com.tailrecursion.blacktide.invocation-test/remove-protocol target) vector 7)]
+            mode [:default :dispatcher]]
+      (is (= (observe body :default :ordinary) (observe body mode :region))
+          (pr-str [body mode])))))
+
+(deftest invalid-direct-protocol-arity-is-rejected-at-compilation
+  (doseq [body '[(clojure.core.protocols/coll-reduce)
+                (clojure.core.protocols/coll-reduce target)
+                (clojure.core.protocols/coll-reduce target vector 7 8)]
+          location [:ordinary :region] mode [:default :dispatcher]]
+    (is (thrown? clojure.lang.Compiler$CompilerException
+                 (backend/compile-program (wrapped body location) mode))
+        (pr-str [body location mode]))))
+
+;; Existing Java interfaces can also be protocol dispatch targets. They expose
+;; conversions that the Object-only interfaces generated by defprotocol cannot.
+(def java-list {:on 'java.util.List :method-map {:list-set :set}})
+(defn list-set [& _] :fallback)
+(alter-meta! #'list-set assoc :protocol #'java-list)
+(def java-map {:on 'java.util.Map :method-map {:map-compute :compute}})
+(defn map-compute [_ k f] (f k :fallback))
+(alter-meta! #'map-compute assoc :protocol #'java-map)
+
+(deftest interface-conversions-are-conditional-and-ordered
+  (let [observe (fn [body mode location direct?]
+                  (let [events (atom []) f ((backend/compile-program (wrapped body location) mode) nil)
+                        target (when direct? (java.util.ArrayList. [1 2]))]
+                    [(try [:value (f target events)] (catch Throwable e [:throw (class e)]))
+                     (when target (vec target)) @events]))]
+    (doseq [index [0 2147483648 nil] direct? [false true]
+            mode [:default :dispatcher]
+            :let [body (list 'com.tailrecursion.blacktide.invocation-test/list-set 'target
+                             (list 'do '(swap! events conj :index) index)
+                             '(do (swap! events conj :value) :new))]]
+      (is (= (observe body :default :ordinary direct?) (observe body mode :region direct?))
+          (pr-str [index direct? mode])))))
+
+(deftest interface-functional-arguments
+  (let [body '(com.tailrecursion.blacktide.invocation-test/map-compute target :key
+                (do (swap! events conj :argument) vector))
+        observe (fn [mode location direct?]
+                  (let [events (atom []) f ((backend/compile-program (wrapped body location) mode) nil)
+                        target (when direct? (java.util.HashMap. {:key :old}))]
+                    [(f target events) (when target (into {} target)) @events]))]
+    (doseq [direct? [false true] mode [:default :dispatcher]]
+      (is (= (observe :default :ordinary direct?) (observe mode :region direct?))
+          (pr-str [direct? mode])))))
diff --git a/test/com/tailrecursion/blacktide/jumps_test.clj b/test/com/tailrecursion/blacktide/jumps_test.clj
new file mode 100644
index 0000000..60e04c8
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/jumps_test.clj
@@ -0,0 +1,116 @@
+(ns com.tailrecursion.blacktide.jumps-test
+  "Statement transfers, outer labels, scope reentry and bounded control graphs."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.blacktide :refer [loophole label goto setq psetq]]
+            [com.tailrecursion.blacktide.source-test :as source]))
+
+(defn step [n] (dec n))
+(defn more? [n] (pos? n))
+(defn add [a b] (+' a b))
+(defn odd-value? [n] (odd? n))
+(defn record! [events tag value] (swap! events conj tag) value)
+
+(deftest basic-and-conditional-transfers
+  (is (= 1 (loophole [x 1] (goto done) (setq x 9) (label done) x)))
+  (is (nil? (loophole [] (goto end) :unreachable)))
+  (is (nil? (loophole [] (label first) (label last))))
+  (is (= 0 (loophole [n 3] (label again) (setq n (step n)) (when (more? n) (goto again)) n))))
+
+(deftest scope-reentry
+  (let [events (atom [])]
+    (is (= 1 (loophole [n 3 result nil]
+               (label again)
+               (let [x (record! events n n)]
+                 (setq n (step n))
+                 (if (more? n) (goto again) (setq result x))) result)))
+    (is (= [3 2 1] @events))))
+
+(deftest invalid-transfers-even-in-dead-source
+  (doseq [[body kind] [['(goto missing) :undefined-label]
+                       ['(do (label x) (label x)) :duplicate-label]
+                       ['(label end) :reserved-label]
+                       ['(label :keyword) :invalid-marker]
+                       ['(goto qualified/name) :invalid-marker]
+                       ['(vector (label x)) :marker-position]
+                       ['(let [] (label x)) :marker-position]
+                       ['(if true (label x) nil) :marker-position]
+                       ['(case 0 0 (label x) nil) :marker-position]
+                       ['(vector (do (goto end) 1)) :marker-position]
+                       ['(let [x (do (goto end) 1)] x) :marker-position]
+                       ['(setq x (do (goto end) 1)) :marker-position]
+                       ['(loophole [] 1) :unsupported-form]]
+          prefix [[] ['(goto end)]]]
+    (is (= kind (:kind (source/rejection (list* 'loophole '[x 0] (concat prefix [body])))))
+        (pr-str [prefix body]))))
+
+(defn sum-through [input]
+  (loophole [n input total 0]
+    (label again)
+    (when-not (more? n) (goto done))
+    (setq total (add total n) n (step n))
+    (goto again)
+    (label done) total))
+
+(defn fibonacci [input]
+  (loophole [n input a 0 b 1]
+    (label again)
+    (when-not (more? n) (goto done))
+    (psetq a b b (add a b))
+    (setq n (step n))
+    (goto again)
+    (label done) a))
+
+(defn reference-fibonacci [n]
+  (loop [n n a 0 b 1] (if (zero? n) a (recur (dec n) b (+' a b)))))
+
+(deftest bounded-algorithm-differentials
+  (let [seed 424242 random (java.util.Random. seed)]
+    (dotimes [trial 300]
+      (let [n (.nextInt random 50)]
+        (is (= (reduce +' 0 (range 1 (inc n))) (sum-through n)) (str "sum seed " seed ", trial " trial))
+        (is (= (reference-fibonacci n) (fibonacci n)) (str "fibonacci seed " seed ", trial " trial)))))
+  (is (= 5000050000 (sum-through 100000))))
+
+(defn reference-machine [table budget value]
+  (loop [state 0 budget budget value value trace []]
+    (if (zero? budget) [value trace]
+      (let [{:keys [delta yes no]} (nth table state)
+            next-value (+ value delta)]
+        (recur (if (odd? next-value) yes no) (dec budget) next-value (conj trace [state value]))))))
+
+(defn machine-form [table budget value labels wrapped?]
+  (let [blocks
+        (mapcat (fn [state {:keys [delta yes no]}]
+                  (let [body (list 'let ['x (list 'record! 'events [state 'value] 'value)]
+                                   (list 'setq 'value (list 'add 'x delta) 'budget '(step budget))
+                                   (list 'if '(more? budget)
+                                         (list 'if '(odd-value? value) (list 'goto (nth labels yes)) (list 'goto (nth labels no)))
+                                         '(goto done)))]
+                    [(list 'label (nth labels state)) (if wrapped? (list 'do (list 'do body)) body)]))
+                (range) table)]
+    (list 'let ['events '(atom [])]
+          (list* 'loophole ['budget budget 'value value]
+                 (concat ['(when-not (more? budget) (goto done)) (list 'goto (first labels))]
+                         blocks ['(label done) ['value '(deref events)]])))))
+
+(defn execute-machine [table budget value labels wrapped?]
+  (binding [*ns* (the-ns 'com.tailrecursion.blacktide.jumps-test)]
+    (try (eval (machine-form table budget value labels wrapped?))
+         (catch Throwable e {:compiler-error (ex-message e)}))))
+
+(deftest generated-bounded-control-graphs
+  (let [seed 8675309 random (java.util.Random. seed)]
+    (dotimes [trial 60]
+      (let [table (vec (repeatedly 3 #(hash-map :delta (- (.nextInt random 9) 4)
+                                              :yes (.nextInt random 3) :no (.nextInt random 3))))
+            budget (.nextInt random 14) value (- (.nextInt random 41) 20)
+            expected (reference-machine table budget value)]
+        (doseq [[labels wrapped?] [['[a b c] false] ['[renamed-a renamed-b renamed-c] true]]]
+          (let [actual (execute-machine table budget value labels wrapped?)]
+            (is (= expected actual)
+                (when (not= expected actual)
+                  ;; Shrink the execution budget while retaining a mismatch.
+                  (let [small (first (filter #(not= (reference-machine table % value)
+                                                    (execute-machine table % value labels wrapped?)) (range (inc budget))))]
+                    (pr-str {:seed seed :trial trial :table table :budget small :value value
+                             :program (machine-form table small value labels wrapped?)}))))))))))
diff --git a/test/com/tailrecursion/blacktide/jvm_fixture.clj b/test/com/tailrecursion/blacktide/jvm_fixture.clj
new file mode 100644
index 0000000..d96a53e
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/jvm_fixture.clj
@@ -0,0 +1,18 @@
+(ns com.tailrecursion.blacktide.jvm-fixture
+  "Compile the small Java-only syntax fixture once into a temporary directory."
+  (:require [clojure.java.io :as io]))
+
+(def fixture-class
+  (let [directory (.toFile (java.nio.file.Files/createTempDirectory "loophole-jvm-fixture-"
+                           (make-array java.nio.file.attribute.FileAttribute 0)))
+        source (io/file directory "HostFixture.java")
+        compiler (javax.tools.ToolProvider/getSystemJavaCompiler)]
+    (with-open [input (io/input-stream (io/resource "com/tailrecursion/blacktide/fixtures/HostFixture.java"))]
+      (io/copy input source))
+    (when-not (zero? (.run compiler nil nil nil
+                           (into-array String ["--release" "17" "-d" (.getPath directory) (.getPath source)])))
+      (throw (ex-info "Java fixture compilation failed" {:directory directory})))
+    (.defineClass ^clojure.lang.DynamicClassLoader (clojure.lang.RT/baseLoader)
+                "com.tailrecursion.blacktide.fixtures.HostFixture"
+                (java.nio.file.Files/readAllBytes
+                  (.toPath (io/file directory "com/tailrecursion/blacktide/fixtures/HostFixture.class"))) nil)))
diff --git a/test/com/tailrecursion/blacktide/jvm_test.clj b/test/com/tailrecursion/blacktide/jvm_test.clj
new file mode 100644
index 0000000..8c6fba0
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/jvm_test.clj
@@ -0,0 +1,233 @@
+(ns com.tailrecursion.blacktide.jvm-test
+  "Native Clojure is the dispatch oracle; event traces test receivers, pending
+  operands and assignment effects that result-only comparisons cannot observe."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.blacktide.source-test :as source]
+            [com.tailrecursion.blacktide.jvm-fixture]
+            [com.tailrecursion.blacktide :refer [loophole setq psetq label goto]]))
+
+(definterface Choice
+  (choose [^boolean x]) (choose [^long x]) (choose [^int x]) (choose [^double x])
+  (choose [^String x]) (choose [^chars x]) (choose [^Object x]) (choose [^Number x]))
+(def chooser
+  (reify Choice
+    (choose [_ ^boolean x] :boolean) (choose [_ ^long x] :long) (choose [_ ^int x] :int) (choose [_ ^double x] :double)
+    (choose [_ ^String x] :string) (choose [_ ^chars x] :chars)
+    (choose [_ ^Object x] :object) (choose [_ ^Number x] :number)))
+(defn ^String text [] "x")
+(defn primitive ^long [] 1)
+(def ^:dynamic *value* :root)
+(defmacro .answer [] 42)
+(defmacro constructed. [] 43)
+(defmacro inferred-tag [sym] (list 'quote (:tag (get &env sym))))
+
+(defn outcome [form]
+  (try
+    {:value (binding [*ns* (the-ns 'com.tailrecursion.blacktide.jvm-test)]
+              (eval (list (list 'fn [] form))))}
+    (catch Throwable error
+      {:error (class (loop [e error] (if-let [cause (ex-cause e)] (recur cause) e)))})))
+
+(deftest overloads-preserve-source-types
+  (doseq [expr '[1 1.5 1N 1M 1/2 "x" nil false \a
+                 (int 1) (long 1) (double 1) (char-array [\a])
+                 (String. "x") (.substring "xyz" 1) (instance? String "x")
+                 (identity "x") (identity nil) (inc 1) (+ 1 2)
+                 (if true nil "x") (if true "x" nil) (if true 1 nil)
+                 (if true nil 1) (if true 1 2.0) (if true (int 1) (int 2))
+                 (let [a "x"] a) (text) (primitive) Integer/MAX_VALUE
+                 (.-x (java.awt.Point. 1 2)) (String/valueOf 1) (do nil "x") ^Object (if true 1 2) ^Object (let [x 1] x)]
+          wrap [identity #(list 'if true % %)
+                #(list 'let ['value %] '(if true nil nil) 'value)]]
+    (let [arg (wrap expr) form (list '.choose (with-meta 'chooser {:tag 'Choice}) arg)]
+      (is (= (outcome form) (outcome (list 'loophole [] form))) (pr-str arg)))))
+
+(deftest host-syntax-and-typing
+  (is (= 3 (loophole [] (. "abc" (length)))))
+  (is (= 4 (loophole [] (.length (StringBuilder. "abcd"))))))
+
+(deftest source-tags-follow-native-metadata-rules
+  (doseq [tag [Object String Long/TYPE :ignored 42 false]
+          form [(list 'let [(with-meta 'x {:tag tag}) 1] 'x)
+                (list 'let ['x 1] (with-meta 'x {:tag tag}))
+                (list '.choose (with-meta 'chooser {:tag 'Choice}) (with-meta '(identity "x") {:tag tag}))
+                (list '.choose (with-meta 'chooser {:tag 'Choice}) (with-meta '(.length "x") {:tag tag}))]]
+    (is (= (outcome form) (outcome (list 'loophole [] form))) (pr-str [tag form])))
+  (is (= :string (loophole [] (.choose ^Choice chooser (^String identity "x")))))
+  (is (= :string (loophole [] (loop [] (.choose ^Choice chooser (text))))))
+  (doseq [tag ["String" "java.lang.String"]]
+    (let [form (list 'let [(with-meta 'x {:tag tag}) '(identity "word")] '(.length x))]
+      (is (= {:value 4} (outcome form) (outcome (list 'loophole [] form))))))
+  (let [form (list (with-meta 'Math/abs {:param-tags [Integer/TYPE]}) -2)]
+    (is (= {:value 2} (outcome form) (outcome (list 'loophole [] form))))))
+
+(deftest caller-facts-and-qualified-operations
+  (is (= 42 (loophole [] (.answer))))
+  (is (= 43 (loophole [] (constructed.))))
+  (is (= "java.lang.String" (loophole [] (.getName String))))
+  (let [values (java.util.ArrayList. [10 20 30]) index (int 1)]
+    (is (= [20 [10 30]] (loophole [] [(.remove values index) (vec values)]))))
+  (is (= 2 (loophole [x 0] (String/.length (String/new (do (setq x 1) "ab"))))))
+  (is (= 7 (loophole [] (^{:param-tags [String]} Integer/parseInt "7"))))
+  (is (= "7" (loophole [] (^{:param-tags [Object]} String/valueOf 7))))
+  (is (= "ab" (loophole [] (^{:param-tags [String]} String/new "ab"))))
+  (is (= 3 (loophole [] (let [length String/.length] (length "abc")))))
+  (is (= "13" (loophole [] (let [convert ^{:param-tags [Object]} String/valueOf] (convert 13)))))
+  (is (= Integer/MAX_VALUE (loophole [] (Integer/MAX_VALUE))))
+  (is (= "3" (loophole [String nil] (. String valueOf 3))))
+  (is (= (outcome '(let [nil-value nil] (.choose ^Choice chooser nil-value)))
+         (outcome '(let [nil-value nil] (loophole [] (.choose ^Choice chooser nil-value)))))))
+
+(deftest binding-hints-and-macro-environments
+  (is (= 'java.lang.String (loophole [] (let [s (text)] (inferred-tag s)))))
+  (is (= [true false]
+         (loophole []
+           (let [^java.util.function.Predicate predicate odd?]
+             (if true nil nil)
+             [(.test predicate 1) (.test predicate 2)]))))
+  (doseq [form '[(let [^Object value 1] value)
+                (let [value 1] ^double value)
+                (let [^Object value (primitive)] value)
+                (.choose ^Choice chooser ^double (.length "abc"))
+                (let [value ^double (.length "abc")] (.choose ^Choice chooser value))]]
+    (is (= (outcome form) (outcome (list 'loophole [] form))) (pr-str form))))
+
+(deftest inline-expansion-and-arithmetic
+  (is (= 30 (loophole [x 0] (+ (do (setq x 10) x) (do (setq x 20) x)))))
+  (is (= [1 2] (loophole [+ vector] (+ 1 2))))
+  (doseq [unchecked [false true :warn-on-boxed]
+          form '[(+ Long/MAX_VALUE 1) (inc Long/MAX_VALUE)
+                 (* Long/MAX_VALUE 2) (int Long/MAX_VALUE)
+                 (let [x 4] (+ x (if true 2 3)))
+                 (let [x (identity Long/MAX_VALUE)] (+ x 1))]]
+    (binding [*unchecked-math* unchecked]
+      (is (= (outcome form) (outcome (list 'loophole [] form))) (pr-str [unchecked form])))))
+
+(defn numeric-expression [^java.util.Random random depth locals]
+  (let [pick #(.nextInt random %) child #(numeric-expression random (dec depth) locals)]
+    (if (zero? depth)
+      (if (and (seq locals) (zero? (pick 2))) (nth locals (pick (count locals)))
+          (nth [-13 -1 0 1 7 2.5 1/2] (pick 7)))
+      (case (pick 8)
+        0 (list '+ (child) (child))
+        1 (list 'if (list 'neg? (child)) (child) (child))
+        2 (let [name (nth '[x y] (pick 2))]
+            (list 'let [name (child)] (numeric-expression random (dec depth) (conj locals name))))
+        3 (list '.length (list 'StringBuilder. (list 'str (child))))
+        4 (list 'Math/max (list 'double (child)) (list 'double (child)))
+        5 (list 'aget (list 'long-array [(child) (child)]) (list 'int 1))
+        6 (list 'alength (list 'char-array (list 'str (child))))
+        (list 'do (child) (child))))))
+
+(defn minimize-host [form]
+  (loop [form form]
+    (if-let [smaller (first (filter #(and (not= form %)
+                                         (contains? (outcome %) :value)
+                                         (not= (outcome %) (outcome (list 'loophole [] %))))
+                                   (source/smaller form)))]
+      (recur smaller) form)))
+
+(deftest generated-host-and-inline-expressions
+  (let [seed 112358 random (java.util.Random. seed)]
+    (dotimes [trial 180]
+      (let [form (numeric-expression random 3 []) expected (outcome form)]
+        (doseq [variant [form (list 'do form) (list 'let ['unused nil] form)]]
+          (let [actual (outcome (list 'loophole [] variant))]
+            (is (= expected actual)
+                (when (not= expected actual)
+                  (pr-str {:seed seed :trial trial :form (minimize-host variant)
+                           :expected expected :actual actual})))))))))
+
+(defn failure-trace [form]
+  (binding [*ns* (the-ns 'com.tailrecursion.blacktide.jvm-test)]
+    (eval (list 'let ['events '(atom [])]
+                (list 'try form
+                      '(catch Throwable error [(class error) @events]))))))
+
+(deftest conversions-happen-before-later-operands
+  (doseq [form '[(0 (do (swap! events conj :argument) 1))
+                (String/.substring (do (swap! events conj :receiver) 7)
+                                   (do (swap! events conj :argument) 1))
+                (^{:param-tags [long long]} Math/max
+                  (do (swap! events conj :first) nil)
+                  (do (swap! events conj :second) 1))
+                (String. ^bytes (do (swap! events conj :first) "wrong")
+                         (do (swap! events conj :second) (java.nio.charset.Charset/defaultCharset)))
+]]
+    (is (= (failure-trace form) (failure-trace (list 'loophole [] form))) (pr-str form))))
+
+(defn direct-fixed [x] [:fixed x])
+(defn direct-rest [x & xs] [x (vec xs)])
+(defn direct-primitive ^long [^long x] (inc x))
+(defn ^:redef redefinable [x] [:original x])
+(def ^:dynamic *direct-dynamic* identity)
+
+(deftest direct-linking-and-redefinitions
+  (doseq [direct? [false true]
+          form '[(direct-fixed 1) (direct-rest 1) (direct-rest 1 2 3)
+                 (direct-primitive 4) (redefinable 5) (*direct-dynamic* 6)]]
+    (let [[native rewritten]
+          (binding [*ns* (the-ns 'com.tailrecursion.blacktide.jvm-test)
+                    *compiler-options* {:direct-linking direct?}]
+            [(eval (list 'fn [] form)) (eval (list 'fn [] (list 'loophole [] form)))])]
+      (with-redefs [direct-fixed (constantly :changed)
+                    direct-rest (constantly :changed)
+                    direct-primitive (fn ^long [^long _] 99)
+                    redefinable (constantly :changed)
+                    *direct-dynamic* (constantly :changed)]
+        (is (= (native) (rewritten)) (pr-str [direct? form]))))))
+
+(definterface BoxChoice
+  (boxChoice [^Integer x ^String y]) (boxChoice [^Long x ^String y]))
+(def box-chooser
+  (reify BoxChoice
+    (boxChoice [_ ^Integer x ^String y] :integer)
+    (boxChoice [_ ^Long x ^String y] :long)))
+(defmacro integer-constant [] (Integer/valueOf 1000))
+
+(deftest reflective-calls-preserve-boxed-operands
+  (is (= :integer
+         (.boxChoice ^BoxChoice box-chooser (integer-constant) (identity "s"))
+         (loophole [] (.boxChoice ^BoxChoice box-chooser (integer-constant) (identity "s"))))))
+
+(def ^:const constant-number 7)
+(defmacro var-inline [value] (list #'inc value))
+(defmacro var-macro [value] (list #'when true value))
+(defmacro var-marker [value] (list #'setq 'x value))
+
+(deftest constant-vars-and-var-operators
+  (is (= :long (loophole [] (.choose ^Choice chooser constant-number))))
+  (is (= 8 (loophole [] (var-inline constant-number))))
+  (is (= :body (loophole [] (var-macro :body))))
+  (is (= 9 (loophole [x 0] (var-marker 9) x)))
+  (is (= [2 [3 4] [1 2 3 4]]
+         (loophole [] (let [[_ a & more :as all] [1 2 3 4]] [a more all]))))
+  (is (= [1 9]
+         (loophole [x 0] (let [{:keys [a] :or {a (setq x 9)}} {:a 1}] [a x])))))
+
+(deftest overlapping-field-and-method-names
+  (doseq [form '[com.tailrecursion.blacktide.fixtures.HostFixture/clash
+                (com.tailrecursion.blacktide.fixtures.HostFixture/clash)
+                (com.tailrecursion.blacktide.fixtures.HostFixture/clash "x")
+                (.choose ^Choice chooser com.tailrecursion.blacktide.fixtures.HostFixture/clash)
+
+                (com.tailrecursion.blacktide.fixtures.HostFixture/argumentOnly "x")
+                (.choose ^Choice chooser com.tailrecursion.blacktide.fixtures.HostFixture/argumentOnly)
+                ^{:param-tags []} com.tailrecursion.blacktide.fixtures.HostFixture/fieldOnly]]
+    (is (= (outcome form) (outcome (list 'loophole [] form))) (pr-str form))))
+
+(deftest unreachable-source-still-receives-native-validation
+  (doseq [form '[(Math/abs 1 2 3) Math/MISSING (String. 1 2 3 4 5)]
+          wrap [identity #(list 'do %)]]
+    (let [body (wrap form)
+          expected (outcome body)
+          actual (outcome (list 'loophole [] '(goto end) body))]
+      (is (:error expected) (pr-str {:form body :native expected}))
+      (is (= (:error expected) (:error actual)) (pr-str {:form body :native expected :actual actual}))))
+  ;; Instance reflection reports a missing overload only when executed.
+  (is (nil? (loophole [] (goto end) (.substring "abc" 1 2 3))))
+  (let [events (atom [])]
+    (is (nil? (loophole [] (goto end)
+                (swap! events conj :expression)
+                (identity (swap! events conj :after)))))
+    (is (empty? @events))))
diff --git a/test/com/tailrecursion/blacktide/lookup_test.clj b/test/com/tailrecursion/blacktide/lookup_test.clj
new file mode 100644
index 0000000..f936066
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/lookup_test.clj
@@ -0,0 +1,199 @@
+(ns com.tailrecursion.blacktide.lookup-test
+  "Keyword call syntax determines cached IKeywordLookup versus ordinary ILookup
+  dispatch. Native emission must preserve call sites, effects and cache faults."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.blacktide.backend-test :as backend]))
+
+(deftype ObservedLookup [events entries]
+  clojure.lang.ILookup
+  (valAt [_ key] (swap! events conj [:val key]) (get entries key))
+  (valAt [_ key default] (swap! events conj [:default key]) (get entries key default))
+  clojure.lang.IKeywordLookup
+  (getLookupThunk [_ key]
+    (swap! events conj [:install key])
+    (reify clojure.lang.ILookupThunk
+      (get [thunk target]
+        (if (instance? ObservedLookup target)
+          (do (swap! (.-events ^ObservedLookup target) conj [:get key])
+              (get (.-entries ^ObservedLookup target) key))
+          thunk)))))
+
+(deftype UncachedLookup [events entries]
+  clojure.lang.ILookup
+  (valAt [_ key] (swap! events conj [:val key]) (get entries key))
+  (valAt [_ key default] (swap! events conj [:default key]) (get entries key default))
+  clojure.lang.IKeywordLookup
+  (getLookupThunk [_ key] (swap! events conj [:no-thunk key]) nil))
+
+(def ^:const constant-key :k)
+(defmacro lookup [target] `(:k ~target))
+(defmacro lookup-key [] :k)
+
+(defn trace [function]
+  (let [events (atom []) a (ObservedLookup. events {:k 7}) b (ObservedLookup. events {:k nil})
+        c (UncachedLookup. events {:k 9})
+        targets [a a b c c {:k 11} nil a {} (java.util.HashMap. {:k 13})]]
+    [(mapv #(function % events) targets) @events]))
+
+(deftest native-keyword-call-syntax
+  (doseq [body '[(:k (do (swap! events conj :target) target))
+                (:missing target)
+                (:k (do (swap! events conj :target) target) (do (swap! events conj :default) 17))
+                ((quote :k) target)
+                (let [key :k] (key target))
+                ((do :k) target)
+                ((if true :k :other) target)
+                (com.tailrecursion.blacktide.lookup-test/constant-key target)
+                ((com.tailrecursion.blacktide.lookup-test/lookup-key) target)
+                (com.tailrecursion.blacktide.lookup-test/lookup target)]
+          wrap [identity #(list 'loop [] %)]
+          :let [form (list 'fn '[target events] (wrap body))
+                reference ((backend/compile-program form :default) nil)]
+          mode [:default :dispatcher]
+          :let [compiled ((backend/compile-program (list 'fn '[target events] (list 'loophole [] (wrap body))) mode) nil)]]
+    (is (= (trace reference) (trace compiled)) (pr-str [body mode (wrap body)]))))
+
+(deftest keyword-sites-in-mutable-regions
+  (doseq [body '[(:k (do (swap! events conj :target) target))
+                (:missing target)
+                ((quote :k) target)
+                ((do :k) target)
+                (com.tailrecursion.blacktide.lookup-test/constant-key target)
+                (com.tailrecursion.blacktide.lookup-test/lookup target)]
+          mode [:default :dispatcher]
+          :let [reference (list 'fn '[target events] body)
+                compiled (list 'fn '[target events]
+                               (list 'loophole ['target 'target 'unused 0]
+                                     '(setq unused (inc unused)) body))]]
+    (is (= (trace ((backend/compile-program reference :default) nil))
+           (trace ((backend/compile-program compiled mode) nil)))
+        (pr-str [body mode]))))
+
+(deftest region-keyword-site-keeps-the-thunk-snapshot
+  (let [body '(:k (do (swap! events conj :target)
+                     (if (vector? target)
+                       (do (read-key (first target) events) (second target)) target)))
+        run (fn [body mode]
+              (let [f ((backend/compile-program (list 'fn 'read-key '[target events] body) mode) nil)
+                    events (atom []) a (ObservedLookup. events {:k 7})
+                    b (UncachedLookup. events {:k 9})]
+                [(f [a b] events) (f [b a] events) (f a events) @events]))]
+    (doseq [mode [:default :dispatcher]]
+      (is (= (run body :default)
+             (run (list 'loophole [] body) mode)) (str mode)))))
+
+(deftest keyword-sites-across-backward-jumps
+  (let [reference '(fn [target events]
+                     (loop [i 0 out []]
+                       (if (< i 3) (recur (inc i) (conj out (:k target))) out)))
+        source '(fn [target events]
+                  (loophole [i 0 out []]
+                    (label again)
+                    (setq out (conj out (:k target)) i (inc i))
+                    (when (< i 3) (goto again)) out))]
+    (doseq [mode [:default :dispatcher]]
+      (is (= (trace ((backend/compile-program reference :default) nil))
+             (trace ((backend/compile-program source mode) nil))) (str mode)))))
+
+(deftest lookup-faults-are-not-bypassed
+  (let [target (reify
+                 clojure.lang.ILookup
+                 (valAt [_ _] :wrong-path)
+                 (valAt [_ _ _] :wrong-path)
+                 clojure.lang.IKeywordLookup
+                 (getLookupThunk [_ _] (throw (ex-info "lookup fault" {:phase :install}))))]
+    (doseq [mode [:default :dispatcher]
+            source '[(fn [target] (loophole [] (:k target)))
+                     (fn [target] (loophole [saved nil] (:k (setq saved target))))]
+            :let [f ((backend/compile-program source mode) nil)]]
+      (is (= {:phase :install}
+             (try (f target) (catch clojure.lang.ExceptionInfo e (ex-data e)))) (str mode)))))
+
+(deftest assigned-keyword-targets
+  (doseq [operator '[:k :missing (quote :k) (do :k)
+                    (com.tailrecursion.blacktide.lookup-test/lookup-key)
+                    com.tailrecursion.blacktide.lookup-test/constant-key
+                    com.tailrecursion.blacktide.lookup-test/lookup]
+          mode [:default :dispatcher]
+          :let [target '(do (swap! events conj :target) target)
+                assigned '(do (swap! events conj :target) (setq saved target))
+                reference (list 'fn '[target events] (list operator target))
+                source (list 'fn '[target events] (list 'loophole '[saved nil] (list operator assigned)))]]
+    (is (= (trace ((backend/compile-program reference :default) nil))
+           (trace ((backend/compile-program source mode) nil))) (pr-str [operator mode])))
+  (doseq [mode [:default :dispatcher]
+          :let [reference '(fn [target events] [(:k target) true])
+                source '(fn [target events]
+                          (loophole [saved nil]
+                            (let [result (:k (case (count (swap! events identity))
+                                              0 (setq saved target)
+                                              (do (psetq saved target) saved)))]
+                              [result (identical? saved target)])))]]
+    (is (= (trace ((backend/compile-program reference :default) nil))
+           (trace ((backend/compile-program source mode) nil))) (str mode))))
+
+(deftest assigned-target-keeps-reentrant-snapshot
+  (let [reference '(fn read-key [target events]
+                     (:k (do (swap! events conj :target)
+                             (if (vector? target)
+                               (do (read-key (first target) events) (second target)) target))))
+        source '(fn read-key [target events]
+                  (loophole [saved nil]
+                    (:k (do (swap! events conj :target)
+                            (setq saved (if (vector? target)
+                                          (do (read-key (first target) events) (second target)) target))))))
+        run (fn [form mode]
+              (let [f ((backend/compile-program form mode) nil)
+                    events (atom []) a (ObservedLookup. events {:k 7}) b (UncachedLookup. events {:k 9})]
+                [(f [a b] events) (f [b a] events) (f a events) @events]))]
+    (doseq [mode [:default :dispatcher]]
+      (is (= (run reference :default) (run source mode)) (str mode)))))
+
+(deftest skipped-lookup-and-reentry
+  (let [reference '(fn [target events]
+                     (loop [i 0 out []]
+                       (if (< i 3)
+                         (if (= i 1) (recur (inc i) out)
+                           (recur (inc i) (conj out (:k (do (swap! events conj :target) target))))) out)))
+        source '(fn [target events]
+                  (loophole [i 0 out [] saved nil]
+                    (label again)
+                    (when (= i 1) (setq i (inc i)) (goto again))
+                    (setq out (conj out (:k (do (swap! events conj :target) (setq saved target)))))
+                    (setq i (inc i)) (when (< i 3) (goto again)) out))]
+    (doseq [mode [:default :dispatcher]]
+      (is (= (trace ((backend/compile-program reference :default) nil))
+             (trace ((backend/compile-program source mode) nil))) (str mode)))))
+
+(defmacro twice-expanded [form]
+  (let [expanded (macroexpand form)] `(do ~expanded ~expanded)))
+
+(deftest cache-sites-survive-expansion-and-closure-instances
+  (doseq [[reference source]
+          '[[(fn [target events]
+               (com.tailrecursion.blacktide.lookup-test/twice-expanded (:k target)))
+             (fn [target events]
+               (com.tailrecursion.blacktide.lookup-test/twice-expanded
+                 (loophole [saved nil] (:k (setq saved target)))))]
+            [(let [factory (fn [] (fn [target events] (:k target)))]
+               (fn [target events] ((factory) target events)))
+             (let [factory (fn [] (fn [target events] (loophole [saved nil] (:k (setq saved target)))))]
+               (fn [target events] ((factory) target events)))]]
+          mode [:default :dispatcher]]
+    (is (= (trace ((backend/compile-program reference :default) nil))
+           (trace ((backend/compile-program source mode) nil))) (pr-str [source mode]))))
+
+(deftest assigned-lookup-after-multiple-scope-entries
+  (let [reference '(fn [flag target events] [(if flag 3 7) (:k target)])
+        source '(fn [flag target events]
+                  (loophole [a 0 b 0 saved nil]
+                    (if flag (setq a 1 b 2) (setq a 3 b 4))
+                    (label again)
+                    (when (neg? a) (goto again))
+                    [(+ a b) (:k (setq saved target))]))
+        run (fn [form mode]
+              (let [f ((backend/compile-program form mode) nil)
+                    events (atom []) target (ObservedLookup. events {:k 42})]
+                [(mapv #(f % target events) [true false false true]) @events]))]
+    (doseq [mode [:default :dispatcher]]
+      (is (= (run reference :default) (run source mode)) (str mode)))))
diff --git a/test/com/tailrecursion/blacktide/loops_test.clj b/test/com/tailrecursion/blacktide/loops_test.clj
new file mode 100644
index 0000000..812187e
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/loops_test.clj
@@ -0,0 +1,220 @@
+(ns com.tailrecursion.blacktide.loops-test
+  "Original recur targets, native loop inference, and bounded independent loop
+  models. Iteration budgets are structural, so shrinking cannot create hangs."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.blacktide :refer [loophole label goto setq psetq]]
+            [com.tailrecursion.blacktide.source-test :as source]
+            [com.tailrecursion.blacktide.jvm-test :as jvm]))
+
+(deftest source-recursion-and-macro-loops
+  (is (= [2 1] (loophole [] (loop [n 3 a 1 b 2] (if (zero? n) [a b] (recur (dec n) b a))))))
+  (is (= [2 1 3] (loophole [calls 0]
+                   (loop [n 3 a 1 b 2]
+                     (if (zero? n) [a b calls]
+                       (do (setq calls (inc calls)) (recur (dec n) b a)))))))
+  (is (= 18 (loophole [total 0]
+              (dotimes [i 4] (dotimes [i i] (setq total (+ total 3)))) total)))
+  (is (= [0 2 4] (loophole [out []]
+                   (doseq [i (range 6) :when (even? i) :let [i (* i 2)] :while (< i 10)]
+                     (setq out (conj out (quot i 2)))) out)))
+  (is (= 5 (loophole [n 0] (while (< n 5) (setq n (inc n))) n)))
+  (is (= :zero (loophole [] (dotimes [i 0] (throw (Exception. "unreachable"))) :zero)))
+  (is (= 6 (loophole [n 0] (loop [] (setq n (inc n)) (when (< n 6) (recur))) n))))
+
+(deftest recur-operands-and-abandonment
+  (let [events (atom [])]
+    (is (= [1 10 20 20]
+           (loophole [x 0]
+             (loop [n 0 a nil b nil]
+               (if (zero? n)
+                 (recur (do (swap! events conj :first) 1)
+                        (do (setq x 10) (swap! events conj x) x)
+                        (do (setq x 20) (swap! events conj x) x))
+                 [n a b x])))))
+    (is (= [:first 10 20] @events)))
+  (is (= [0 1 0 1] (loophole [round 0 out []]
+                      (label again)
+                      (loop [i 0]
+                        (setq out (conj out i))
+                        (when (zero? i) (recur 1)))
+                      (setq round (inc round))
+                      (when (< round 2) (goto again)) out)))
+  (is (= 8 (loophole [x 0]
+             (loop [n 4]
+               (when (pos? n)
+                 (loop [m 2] (when (pos? m) (setq x (inc x)) (recur (dec m))))
+                 (recur (dec n)))) x))))
+
+(deftest native-loop-inference
+  (doseq [form '[(loop [i 1] (.choose ^com.tailrecursion.blacktide.jvm_test.Choice chooser i))
+                (loop [i (int 1)] (.choose ^com.tailrecursion.blacktide.jvm_test.Choice chooser i))
+                (loop [i (float 1)] (.choose ^com.tailrecursion.blacktide.jvm_test.Choice chooser i))
+                (loop [n 1 value 0] (if (pos? n) (recur (dec n) "string") value))
+                (loop [n 1 value 0] (if (pos? n) (recur (dec n) 1.5) (class value)))
+                (loop [n 1 value 0] (if (pos? n) (recur (dec n) 1.5)
+                                     (.choose ^com.tailrecursion.blacktide.jvm_test.Choice chooser value)))
+                (loop [a (java.util.ArrayList. [1 2 3]) i (int 1)] (.remove a i) (vec a))
+                (loop [x "abc"] (let [snapshot x] (String/.substring snapshot 1)))
+                (loop [n 0] (if (zero? n) (recur 1) ^{:value n} [n]))
+                (loop [f ^{:param-tags [int]} Math/abs] (f -2))
+]
+          lowered? [false true]
+          :let [body (if lowered? (list* (first form) (second form) '(setq touched true) (nnext form)) form)]]
+    (is (= (jvm/outcome form) (jvm/outcome (list 'loophole '[touched nil] body))) (pr-str [lowered? form])))
+  (is (= :long (loophole [x 1]
+                 (loop [n 2] (setq x n)
+                   (loop [n 1] (.choose ^com.tailrecursion.blacktide.jvm_test.Choice jvm/chooser n))))))
+  ;; DSL writes retain the same initializer promotions as ordinary Clojure.
+  (is (= (loop [i (int 1)] (class i)) (loophole [x nil] (loop [i (int 1)] (setq x true) (class i)))))
+  (is (= (loop [i (float 1)] (class i)) (loophole [x nil] (loop [i (float 1)] (setq x true) (class i))))))
+
+(def ^String tagged-value "word")
+(defmacro erase-tag [] (alter-meta! #'tagged-value assoc :tag 'Object) :retagged)
+(def changing-value :old)
+(defmacro make-constant [] (alter-meta! #'changing-value assoc :const true) nil)
+
+(deftest native-types-survive-later-macro-expansion
+  (let [body '[(loop [] (.choose ^com.tailrecursion.blacktide.jvm_test.Choice jvm/chooser tagged-value)) (erase-tag)]
+        evaluate (fn [wrap]
+                   (alter-meta! #'tagged-value assoc :tag 'String)
+                   (binding [*ns* (the-ns 'com.tailrecursion.blacktide.loops-test)]
+                     (eval (list (list 'fn [] (wrap body))))))]
+    (try
+      (is (= [:string :retagged] (evaluate identity) (evaluate #(list 'loophole [] %))))
+      (finally (alter-meta! #'tagged-value assoc :tag 'String))))
+  (doseq [body ['[changing-value (make-constant)] '[(loop [] changing-value) (make-constant)]]]
+    (try
+      (let [evaluate (fn [wrap]
+                       (alter-meta! #'changing-value dissoc :const)
+                       (alter-var-root #'changing-value (constantly :old))
+                       (let [compiled (binding [*ns* (the-ns 'com.tailrecursion.blacktide.loops-test)]
+                                        (eval (list 'fn [] (wrap body))))]
+                         (alter-var-root #'changing-value (constantly :new))
+                         (compiled)))]
+        (is (= [:new nil] (evaluate identity) (evaluate #(list 'loophole [] %)))))
+      (finally (alter-meta! #'changing-value dissoc :const)
+               (alter-var-root #'changing-value (constantly :old))))))
+
+(deftest lowered-loop-interop-boundary
+  (doseq [body '[(.choose ^com.tailrecursion.blacktide.jvm_test.Choice com.tailrecursion.blacktide.jvm-test/chooser i)
+                (let [copy i] (.choose ^com.tailrecursion.blacktide.jvm_test.Choice com.tailrecursion.blacktide.jvm-test/chooser copy))
+                (.choose ^com.tailrecursion.blacktide.jvm_test.Choice com.tailrecursion.blacktide.jvm-test/chooser (inc i))
+                (loop [] (.choose ^com.tailrecursion.blacktide.jvm_test.Choice com.tailrecursion.blacktide.jvm-test/chooser i))
+                (loop [copy i] (.choose ^com.tailrecursion.blacktide.jvm_test.Choice com.tailrecursion.blacktide.jvm-test/chooser copy))]]
+    (let [form (list 'loophole '[x 0] (list 'loop '[i 1] '(setq x 1) body))]
+      (is (= (jvm/outcome (list 'loop '[i 1] body)) (jvm/outcome form)) (pr-str form))))
+  (is (= :int (loophole [x 0] (loop [i 1] (setq x 1)
+                               (.choose ^com.tailrecursion.blacktide.jvm_test.Choice jvm/chooser (int i))))))
+  (is (= :object (loophole [x 0] (loop [i (identity 1)] (setq x 1)
+                                  (.choose ^com.tailrecursion.blacktide.jvm_test.Choice jvm/chooser i)))))
+  (is (= :long (loophole [x 0] (loop [i 1] (setq x 1)
+                                (^{:param-tags [long]} com.tailrecursion.blacktide.jvm_test.Choice/.choose jvm/chooser i))))))
+
+(deftest recur-legality-and-loop-scopes
+  (doseq [[form kind]
+          [['(loophole [] (recur)) :invalid-recur]
+           ['(loophole [] (loop [n 0] (recur))) :recur-arity]
+           ['(loophole [] (loop [] (recur) 1)) :invalid-recur]
+           ['(loophole [] (loop [n 0] (if (recur 1) n n))) :invalid-recur]
+           ['(loophole [] (loop [] [(recur)])) :invalid-recur]
+           ['(loophole [] (loop [n (recur 0)] n)) :invalid-recur]
+           ['(loophole [] (loop [] (loophole [] (recur)))) :unsupported-form]
+           ['(loophole [] (loop [n 1] (setq n 2))) :immutable-assignment]
+           ['(loophole [x nil] (loop [n (byte 1)] (setq x n) (recur nil))) :invalid-recur-type]
+           ['(loophole [x nil] (loop [n 1] (setq x n) (recur (short n)))) :invalid-recur-type]
+           ['(loophole [] (goto body) (loop [] (label body))) :marker-position]
+           ['(loophole [] (loop [] (goto other)) (loop [] (label other))) :marker-position]
+           ['(loophole [] (goto end) (loop [] (recur 1))) :recur-arity]]]
+    (is (= kind (:kind (source/rejection form))) (pr-str form))))
+
+(deftest illegal-primitive-recur-conversions
+  (doseq [cast '[byte short char]]
+    (let [body (list 'loop '[n 0] (list 'recur (list cast 1)))
+          lowered (list 'loop '[n 0] '(setq x n) (list 'recur (list cast 1)))]
+      (is (= IllegalArgumentException (:error (jvm/outcome body))))
+      (is (= :invalid-recur-type
+             (:kind (source/rejection (list 'loophole '[x nil] lowered))))))))
+
+(defn loop-model [{:keys [limit cut width a b weight]}]
+  (loop [i 0 a a b b history []]
+    (if (or (= i limit) (= i cut)) [a b history i]
+      (let [delta (reduce + weight (range width))
+            next (if (even? i) [(+ b delta) (- a delta)] [(- b delta) (+ a delta)])]
+        (recur (inc i) (first next) (second next) (conj history [a b (inc i)]))))))
+
+(defn loop-program [{:keys [limit cut width a b weight]}]
+  `(loophole [~'ticks 0 ~'result nil]
+     (setq ~'result
+       (loop [~'i 0 ~'a ~a ~'b ~b ~'history []]
+         (if (= ~'i ~cut) [~'a ~'b ~'history ~'ticks]
+           (if (= ~'i ~limit) [~'a ~'b ~'history ~'ticks]
+             (let [~'delta (loop [~'i 0 ~'total ~weight]
+                            (if (= ~'i ~width) ~'total (recur (inc ~'i) (+ ~'total ~'i))))]
+               (if (even? ~'i)
+                 (recur (do (setq ~'ticks (inc ~'ticks)) (inc ~'i)) (+ ~'b ~'delta) (- ~'a ~'delta)
+                        (conj ~'history [~'a ~'b ~'ticks]))
+                 (recur (do (setq ~'ticks (inc ~'ticks)) (inc ~'i)) (- ~'b ~'delta) (+ ~'a ~'delta)
+                        (conj ~'history [~'a ~'b ~'ticks]))))))))
+     (label ~'done) ~'result))
+
+(defn loop-outcome [config wrap]
+  (try {:value (source/run-form (wrap (loop-program config)))}
+       (catch Throwable error {:error (class error) :message (ex-message error)})))
+
+(defn minimize-loop [config wrap]
+  (loop [config config]
+    (if-let [smaller (first (for [key [:limit :cut :width :a :b :weight]
+                                 value (distinct [0 (quot (get config key) 2)])
+                                 :when (not= value (get config key))
+                                 :let [candidate (assoc config key value)]
+                                 :when (not= {:value (loop-model candidate)} (loop-outcome candidate wrap))]
+                             candidate))]
+      (recur smaller) config)))
+
+(deftest generated-nested-loops
+  (let [seed 161803 random (java.util.Random. seed)]
+    (dotimes [index 240]
+      (let [config {:limit (.nextInt random 12) :cut (.nextInt random 15) :width (.nextInt random 6)
+                    :a (- (.nextInt random 21) 10) :b (- (.nextInt random 21) 10) :weight (- (.nextInt random 7) 3)}
+            expected {:value (loop-model config)}]
+        (doseq [wrap [identity #(list 'let ['unused 1] (list 'do %))]]
+          (let [actual (loop-outcome config wrap)]
+            (is (= expected actual)
+                (pr-str {:seed seed :index index :config config :expected expected :actual actual
+                         :minimal (when-not (= expected actual) (loop-program (minimize-loop config wrap)))}))))))))
+
+(defn insertion-sort! [^longs values]
+  (loophole [writes 0]
+    (loop [i 1]
+      (when (< i (alength values))
+        (let [key (aget values (int i))]
+          (loop [j i]
+            (if (and (pos? j) (> (aget values (int (dec j))) key))
+              (do (aset-long values (int j) (aget values (int (dec j))))
+                  (setq writes (inc writes)) (recur (dec j)))
+              (aset-long values (int j) key))))
+        (recur (inc i))))
+    writes))
+
+(defn first-negative [^longs values]
+  (loophole [found -1]
+    (loop [i 0]
+      (when (< i (alength values))
+        (when (neg? (aget values (int i))) (setq found i) (goto done))
+        (recur (inc i))))
+    (label done) found))
+
+(defn gcd [a b]
+  (loophole [steps 0]
+    (loop [a (abs a) b (abs b)]
+      (if (zero? b) a (do (setq steps (inc steps)) (recur b (rem a b)))))))
+
+(deftest algorithms-against-independent-references
+  (let [seed 577215 random (java.util.Random. seed)]
+    (dotimes [index 180]
+      (let [input (vec (repeatedly (.nextInt random 25) #(- (.nextInt random 15) 7)))
+            values (long-array input) a (- (.nextInt random 1001) 500) b (- (.nextInt random 1001) 500)]
+        (insertion-sort! values)
+        (is (= (vec (sort input)) (vec values)) (pr-str {:seed seed :index index :input input}))
+        (is (= (or (first (keep-indexed #(when (neg? %2) %1) input)) -1) (first-negative (long-array input))))
+        (is (= (.longValue (.gcd (biginteger a) (biginteger b))) (gcd a b)))))))
diff --git a/test/com/tailrecursion/blacktide/machine_test.clj b/test/com/tailrecursion/blacktide/machine_test.clj
new file mode 100644
index 0000000..128393a
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/machine_test.clj
@@ -0,0 +1,98 @@
+(ns com.tailrecursion.blacktide.machine-test
+  "Compile allocated machines with the real Clojure compiler and execute them."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.blacktide.compiler.jvm :as jvm]
+            [com.tailrecursion.blacktide.compiler.emit :as emit]))
+
+(defn literal [value] {:op :literal :value value})
+(defn local [id] {:op :local :id id})
+(defn assign [id rhs] {:target id :value rhs})
+(defn put-value [id value] (assign id {:op :value :value (literal value)}))
+(defn call [id f & args] (assign id {:op :invoke :function (local f) :args (vec args)}))
+(defn block [ops term] {:ops (vec ops) :term term})
+(defn run-machine [machine]
+  (binding [*ns* (the-ns 'com.tailrecursion.blacktide.machine-test)]
+    (eval (emit/program-form machine))))
+
+(deftest values-and-clojure-truth
+  (doseq [value [nil false true 0 1N 1/2 2.5 2M "text" :keyword 'symbol [1 2] {:a 3} #{4}]]
+    (is (= value (run-machine {:entry 0 :slots [] :live {0 #{}}
+                              :blocks {0 (block [] {:op :return :value (literal value)})}}))))
+  (doseq [condition [nil false true 0 "" []]]
+    (is (= (if condition :yes :no)
+           (run-machine {:entry 0 :slots [] :live {0 #{} 1 #{} 2 #{}}
+                         :blocks {0 (block [] {:op :branch :test (literal condition) :yes 1 :no 2})
+                                  1 (block [] {:op :return :value (literal :yes)})
+                                  2 (block [] {:op :return :value (literal :no)})}})))))
+
+(deftest label-values-and-exceptions
+  (doseq [label [0N 2147483648 Long/MAX_VALUE]]
+    (is (= :ok (run-machine {:entry label :slots [] :live {label #{}}
+                             :blocks {label (block [] {:op :return :value (literal :ok)})}}))))
+  (let [machine {:entry 0 :slots [] :live {0 #{}}
+                 :blocks {0 (block [(assign 'make-error {:op :global :name 'clojure.core/ex-info})
+                                    (call 'error 'make-error (literal "machine failure") (literal {:tag :expected}))]
+                                   {:op :throw :value (local 'error)})}}
+        error (try (run-machine machine) nil (catch clojure.lang.ExceptionInfo e e))]
+    (is (= {:tag :expected} (ex-data error)))
+    (is (= "machine failure" (ex-message error)))))
+
+(deftest boxed-storage-and-native-calls
+  (doseq [value [nil false 3 2.5 1/2 "text"]]
+    (is (= value
+           (run-machine {:entry 0 :slots '[x] :live {0 #{} 1 '#{x}}
+                         :blocks {0 (block [(put-value 'x value)] {:op :jump :target 1})
+                                  1 (block [(assign 'copy {:op :value :value (local 'x)})]
+                                           {:op :return :value (local 'copy)})}}))))
+  (let [machine {:entry 0 :slots ['x] :live {0 #{} 1 '#{x} 2 '#{x}}
+                 :blocks {0 (block [(put-value 'x 1)] {:op :jump :target 1})
+                          1 (block [(put-value 'x "changed")] {:op :jump :target 2})
+                          2 (block [] {:op :return :value (local 'x)})}}]
+    (is (= "changed" (run-machine machine))))
+  (is (= [10 20]
+         (run-machine {:entry 0 :slots [] :live {0 #{}}
+                       :blocks {0 (block [(assign 'f {:op :global :name 'clojure.core/vector})
+                                          (call 'value 'f (literal 10) (literal 20))]
+                                         {:op :return :value (local 'value)})}})))
+  (is (= #'clojure.core/vector
+         (run-machine {:entry 0 :slots [] :live {0 #{}}
+                       :blocks {0 (block [(assign 'v {:op :var :name 'clojure.core/vector})]
+                                         {:op :return :value (local 'v)})}}))))
+
+(deftest backedges-and-constant-stack
+  (let [machine {:entry 0 :slots '[case dec-fn zero-fn]
+                 :live {0 #{} 1 '#{case dec-fn zero-fn} 2 '#{case dec-fn zero-fn} 3 '#{case}}
+                 :blocks {0 (block [(put-value 'case 100000)
+                                    (assign 'dec-fn {:op :global :name 'clojure.core/dec})
+                                    (assign 'zero-fn {:op :global :name 'clojure.core/zero?})]
+                                   {:op :jump :target 1})
+                          1 (block [(call 'done 'zero-fn (local 'case))]
+                                   {:op :branch :test (local 'done) :yes 3 :no 2})
+                          2 (block [(call 'case 'dec-fn (local 'case))] {:op :jump :target 1})
+                          3 (block [] {:op :return :value (local 'case)})}}]
+    (is (zero? (run-machine machine)))
+    (is (zero? (run-machine machine)))
+    (let [form (emit/program-form machine)
+          nodes (tree-seq #(and (coll? %) (not (and (seq? %) (= 'quote (first %))))) seq form)
+          operators (set (keep #(when (seq? %) (first %)) nodes))]
+      (is (= 'loop* (first form)))
+      (is (operators 'clojure.core/case))
+      (is (operators 'recur))
+      (is (not-any? operators '[atom volatile! object-array ref reset! swap! aset])))))
+
+(defn record! [events tag value]
+  (swap! events conj tag)
+  value)
+
+(deftest external-values-and-ordered-effects
+  (let [machine {:entry 0 :slots '[events f a]
+                 :live {0 #{} 1 '#{events f a}}
+                 :blocks {0 (block [(assign 'events {:op :external :name 'event-log :jvm (jvm/fact false {:hint nil :var-meta {}} :unknown)})
+                                    (assign 'f {:op :global :name 'com.tailrecursion.blacktide.machine-test/record!})
+                                    (call 'a 'f (local 'events) (literal :first) (literal 10))]
+                                   {:op :jump :target 1})
+                          1 (block [(call 'b 'f (local 'events) (literal :second) (literal 20))]
+                                   {:op :return :value (local 'a)})}}
+        form (list 'let ['event-log '(atom []) 'value (emit/program-form machine)]
+                   ['value '(deref event-log)])]
+    (is (= [10 [:first :second]] (eval form)))))
diff --git a/test/com/tailrecursion/blacktide/native_sites_test.clj b/test/com/tailrecursion/blacktide/native_sites_test.clj
new file mode 100644
index 0000000..8b98233
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/native_sites_test.clj
@@ -0,0 +1,101 @@
+(ns com.tailrecursion.blacktide.native-sites-test
+  "Control recovery retains Java function construction and cached lookup sites.
+  Generated loops preserve bound references without promising literal pooling."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.blacktide.backend-test :as backend]
+            [com.tailrecursion.blacktide :refer [loophole setq label goto]]
+            [com.tailrecursion.blacktide.invocation-test]
+            [com.tailrecursion.blacktide.lookup-test :as lookup]))
+
+(def flags [true false false true])
+(defn identity-pattern [values]
+  (mapv (fn [a] (mapv #(identical? a %) values)) values))
+(deftest java-function-construction-sites
+  ;; Qualified method values and implicit functional-interface adapters also
+  ;; construct classes. A join must not split one source site across its paths.
+  (let [target (proxy [java.util.HashMap] [] (compute [_ callback] callback))
+        callback (fn [x y] [x y])]
+    (doseq [[tail invoke]
+            [['String/.length #(% "abc")]
+             [(with-meta 'String/valueOf {:param-tags ['Object]}) #(% "abc")]
+             [(with-meta 'String/new {:param-tags ['String]}) #(% "abc")]
+             ['(let [^java.util.function.BiFunction f callback] f)
+              #(.apply ^java.util.function.BiFunction % :left :right)]
+             ['(java.util.Map/.compute target :key callback)
+              #(.apply ^java.util.function.BiFunction % :left :right)]
+             ['(com.tailrecursion.blacktide.invocation-test/map-compute target :key callback)
+              #(.apply ^java.util.function.BiFunction % :left :right)]]
+            mode [:default :dispatcher]]
+      (let [ordinary (list 'let ['values '(if flag [1 2] [3 4])] (list 'vector 'values tail))
+            compiled (list 'loophole '[a 0 b 0]
+                           '(if flag (setq a 1 b 2) (setq a 3 b 4)) (list 'vector '[a b] tail))
+            observe (fn [body mode]
+                      (let [f ((backend/compile-program (list 'fn '[flag target callback] body) mode) nil)
+                            results (mapv #(f % target callback) flags)]
+                        [(identity-pattern (mapv (comp class second) results))
+                         (mapv (fn [[pair f]] [pair (invoke f)]) results)]))]
+        (is (= (observe ordinary :ordinary) (observe compiled mode)) (pr-str [mode tail]))))))
+
+(defn cached-lookups [mode wrapped?]
+  (let [lookup '(:k target)
+        body `(do (if ~'flag (swap! ~'events conj :yes) (swap! ~'events conj :no)) ~lookup)
+        events (atom []) target (lookup/->ObservedLookup events {:k 42})
+        f ((backend/compile-program (list 'fn '[flag target] (if wrapped? (list 'loophole [] body) body)) mode) events)
+        values (mapv #(f % target) flags)]
+    [values @events]))
+
+(deftest cached-lookup-sites-through-joins
+  (doseq [mode [:default :dispatcher]]
+    (is (= (cached-lookups mode false) (cached-lookups mode true))
+        (pr-str [mode]))))
+
+(defn loop-program [tail real-backedge?]
+  `(loophole [~'a 0 ~'b 0 ~'i 0]
+     (if ~'flag (setq ~'a 1 ~'b 2) (setq ~'a 3 ~'b 4))
+     (label ~'again)
+     ~(if real-backedge?
+        '(when (< i 1) (setq i (inc i)) (goto again))
+        '(when (neg? a) (goto again)))
+     (+ ~'a ~'b)
+     ~tail))
+
+(deftest bound-references-across-generated-loops
+  (doseq [real-backedge? [false true] context [:tail :expression]
+          mode [:default :dispatcher]]
+    (let [body (loop-program 'input real-backedge?)
+          source (list 'fn '[flag input] (if (= context :tail) body (list 'identity body)))
+          f ((backend/compile-program source mode) nil)
+          inputs [(Object.) (object-array [nil]) (Long/valueOf 1000)]
+          inputs (conj inputs (first inputs))]
+      (is (every? true? (map (fn [flag input] (identical? input (f flag input))) flags inputs))
+          (pr-str [real-backedge? context mode])))))
+
+(defn selection-tree [^java.util.Random random depth path]
+  (if (zero? depth)
+    (list 'do (list 'swap! 'events 'conj [:leaf path])
+          (list 'quote (nth [nil false 1000 1.5 :selected "text"] (.nextInt random 6))))
+    (let [test (list 'do (list 'swap! 'events 'conj [:test path])
+                     (list 'mod (list '+ 'input (.nextInt random 5)) 3))
+          arm (fn [index] (selection-tree random (dec depth) (conj path index)))]
+      (if (.nextBoolean random)
+        (list 'if (list 'zero? test) (arm 0) (arm 1))
+        (list 'let ['choice test]
+              (list 'case 'choice 0 (arm 0) 1 (arm 1) (arm 2)))))))
+
+(deftest nested-joins-preserve-one-continuation
+  ;; Java method values after a join retain one class construction site.
+  (let [seed 331662 random (java.util.Random. seed)]
+    (doseq [trial (range 32)]
+      (let [tree (selection-tree random (+ 1 (.nextInt random 3)) [])
+            body (list 'let ['picked tree] '(swap! events conj :joined) '[picked String/.length])
+            form (list 'loophole [] body)
+            source (fn [body] (list 'fn '[input] body))
+            observe (fn [body mode]
+                      (let [events (atom []) f ((backend/compile-program (source body) mode) events)
+                            values (mapv f (range 6))]
+                        [(mapv (fn [[picked f]] [picked (f "abc")]) values)
+                         (identity-pattern (mapv (comp class second) values)) @events]))
+            expected (observe body :default)]
+        (is (= :structured (:op (backend/selection (source form)))) (pr-str [seed trial tree]))
+        (doseq [mode [:default :dispatcher]]
+          (is (= expected (observe form mode)) (pr-str [seed trial mode tree])))))))
diff --git a/test/com/tailrecursion/blacktide/package_test.clj b/test/com/tailrecursion/blacktide/package_test.clj
new file mode 100644
index 0000000..720be9e
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/package_test.clj
@@ -0,0 +1,32 @@
+(ns com.tailrecursion.blacktide.package-test
+  "A release built from a working checkout must exclude nested editor caches."
+  (:require [clojure.test :refer [deftest is]]
+            [clojure.java.io :as io]
+            [clojure.java.shell :as shell]))
+
+(deftest jar-excludes-editor-state
+  (let [directory (.toFile (java.nio.file.Files/createTempDirectory "blacktide-package-"
+                            (make-array java.nio.file.attribute.FileAttribute 0)))
+        write! (fn [path value]
+                 (let [file (io/file directory path)] (io/make-parents file) (spit file value)))]
+    (try
+      (doseq [root ["deps.edn" "build.clj" "LICENSE" "src" "src-java"]
+              file (file-seq (io/file root)) :when (.isFile file)]
+        (let [target (io/file directory (.getPath file))]
+          (io/make-parents target) (io/copy file target)))
+      (write! "src/com/tailrecursion/.clj-kondo/hooks.clj" "(ns private-editor-hook)")
+      (write! "src/com/tailrecursion/blacktide/.lsp/cache.json" "private editor state")
+      (write! "resources/application.edn" "{:library-resource true}")
+      (let [java (str (io/file (System/getProperty "java.home") "bin" "java"))
+            result (shell/sh "clojure" "-T:build" "jar" :dir directory
+                             :env (assoc (into {} (System/getenv)) "JAVA_CMD" java))]
+        (is (zero? (:exit result)) (str (:out result) (:err result)))
+        (when (zero? (:exit result))
+          (with-open [jar (java.util.jar.JarFile. (io/file directory "target/blacktide-0.1.0-SNAPSHOT.jar"))]
+            (let [names (set (map #(.getName ^java.util.jar.JarEntry %) (enumeration-seq (.entries jar))))]
+              (is (not-any? #(re-find #"(?:^|/)\." %) names))
+              (is (every? names ["com/tailrecursion/blacktide.clj"
+                                 "com/tailrecursion/blacktide/runtime/KeywordSite.class"
+                                 "META-INF/LICENSE" "application.edn"]))
+              (is (not-any? #(re-find #"(?:^|/)(?:test|tools|examples)/" %) names))))))
+      (finally (doseq [file (reverse (file-seq directory))] (io/delete-file file))))))
diff --git a/test/com/tailrecursion/blacktide/source_fixture.clj b/test/com/tailrecursion/blacktide/source_fixture.clj
new file mode 100644
index 0000000..306271f
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/source_fixture.clj
@@ -0,0 +1,7 @@
+(ns com.tailrecursion.blacktide.source-fixture
+  "Foreign macro identities and visibility for source-expansion tests."
+  (:require [com.tailrecursion.blacktide :as lh]))
+
+(def expansion-events (atom 0))
+(defmacro ^:private hidden [] (swap! expansion-events inc) :hidden)
+(defmacro goto [value] value)
diff --git a/test/com/tailrecursion/blacktide/source_loops_test.clj b/test/com/tailrecursion/blacktide/source_loops_test.clj
new file mode 100644
index 0000000..d7e20a3
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/source_loops_test.clj
@@ -0,0 +1,241 @@
+(ns com.tailrecursion.blacktide.source-loops-test
+  "Compare ordinary numeric loops with both backends, including source boxing,
+  recur inference, evaluation traces and bounded generated alpha variants."
+  (:require [com.tailrecursion.blacktide :refer [loophole]]
+            [com.tailrecursion.blacktide.compiler.backend :as backend]
+            [com.tailrecursion.blacktide.compiler.emit :as emit]
+            [com.tailrecursion.blacktide.jvm-test :as jvm]
+            [clojure.walk :as walk]
+            [clojure.test :as t]))
+(defn root-error [e] (if-let [cause (ex-cause e)] (recur cause) e))
+(defn canonical [value]
+  (cond
+    (instance? Double value) [(class value) (Double/doubleToLongBits value)]
+    (instance? Float value) [(class value) (Float/floatToIntBits value)]
+    (number? value) [(class value) value]
+    (sequential? value) (mapv canonical value)
+    :else value))
+
+(defn error-message [error]
+  (let [message (ex-message error)]
+    ;; Prepared reference conversions use Class.cast. JVM checkcast has different
+    ;; wording; retain both failing types, not just the exception class.
+    (if (and message (instance? ClassCastException error))
+      (or (some-> (re-matches #"class (\S+) cannot be cast to class (\S+)(?: .*)?" message) rest vec)
+          (some-> (re-matches #"Cannot cast (\S+) to (\S+)" message) rest vec)
+          message)
+      message)))
+(defn enclose [body mode]
+  ;; The helper functions belong to the caller. Only the loop is the region.
+  (if (#{'let 'clojure.core/let} (first body))
+    (list* (first body) (second body) (concat (butlast (nnext body)) [(enclose (last body) mode)]))
+    (if (= mode :ordinary) body
+      (list 'loophole '[loop-effect nil]
+            (list* (first body) (second body) '(com.tailrecursion.blacktide/setq loop-effect true) (nnext body))))))
+
+(defn compile-body [body mode]
+  (try
+    (binding [*ns* (the-ns 'com.tailrecursion.blacktide.source-loops-test)]
+      (with-redefs [backend/compile-program (if (= mode :dispatcher)
+                                            emit/program-form
+                                            backend/compile-program)]
+        (eval (list 'fn '[events input n] (enclose body mode)))))
+    (catch Throwable e {:compile (class (root-error e))})))
+(defn outcome [f input n]
+  (if (map? f) f
+    (let [events (atom [])]
+      (try (let [value (f events input n)] {:value (canonical value) :class (class value) :trace (canonical @events)})
+           (catch Throwable e {:throw (class e) :message (error-message e) :trace (canonical @events)})))))
+(def bodies
+  '[(let [step (fn ^long [^long x] (unchecked-inc x))]
+      (loop [i 0 x 1000] (if (< i n) (recur (inc i) (step x)) [x (class x) (identical? x x)])))
+    (let [step (fn [x] x)]
+      (loop [i 0 x 1000 y x]
+        (if (< i n) (recur (inc i) (step x) x) [(identical? x y) (identical? x x)])))
+    (let [step (fn [x] x)]
+      (loop [i 0 x Long/MIN_VALUE]
+        (if (< i n) (recur (inc i) (step x)) (- x x))))
+    (let [step (fn [x] x)]
+      (loop [i 0 x Long/MIN_VALUE y 1000]
+        (if (< i n) (recur (inc i) x (step y)) (- x x))))
+    (let [step (fn [x] x)]
+      (loop [i 0 x Long/MIN_VALUE y Long/MIN_VALUE]
+        (if (< i n) (recur (inc i) (step x) x) (- y y))))
+    (let [step (fn ^long [^long x] (unchecked-inc x))]
+      (loop [i 1000 x (long input)]
+        (if (< i (+ 1000 n)) (recur (inc i) (step x)) [(identical? i i) x])))
+    (let [step (fn ^long [^long x] (unchecked-inc x))]
+      (loop [i 0 x 0]
+        (if (< i n) (let [next (step x)]
+                      (recur (do (swap! events conj [:index i]) (inc i))
+                             (do (swap! events conj [:value x next]) next)))
+          x)))
+    (let [step (fn ^double [^double x] (+ x 0.5))]
+      (loop [i 0 x (double input)] (if (< i n) (recur (inc i) (step x)) (Double/doubleToRawLongBits x))))
+    (let [step (fn [x] input)]
+      (loop [i 0 x 0] (if (< i n) (recur (inc i) (step x)) [x (class x)])))
+    (let [step (fn ^long [^long x] (inc x))]
+      (loop [i 0 x 1000]
+        (if (< i n) (recur (int (inc i)) (step x)) x)))
+    (let [step (fn ^double [^double x] (+ x 0.5))]
+      (loop [i 0.0 x 1.5]
+        (if (< i n) (recur (float (+ i 1.0)) (step x)) [i x (class i)])))
+    (let [step (fn ^long [^long x] (inc x))]
+      (loop [i 0 x (do (swap! events conj :initial) 1000)]
+        (if (< i n) (recur (inc i) (step x)) x)))
+    (let [step (fn [x] (if x nil 1000))]
+      (loop [i 0 x 1000] (if (< i n) (recur (inc i) (step x)) x)))])
+
+(t/deftest dependent-loop-initializers-retain-final-types
+  (doseq [init [1000 1.5]
+          :let [body `(let [~'step (fn [~'x] (swap! ~'events conj ~'x) ~'x)]
+                        (loop [~'i 0 ~'x ~init ~'y (+ ~'x 1)]
+                          (if (< ~'i ~'n)
+                            (recur (inc ~'i) (~'step ~'x) (~'step ~'y))
+                            [(.choose ^com.tailrecursion.blacktide.jvm_test.Choice jvm/chooser ~'x)
+                             (.choose ^com.tailrecursion.blacktide.jvm_test.Choice jvm/chooser ~'y)
+                             ~'x ~'y])))
+                ordinary (compile-body body :ordinary)]]
+    (doseq [mode [:default :dispatcher]
+            :let [compiled (compile-body body mode)] n [0 1 3]]
+      (t/is (= (outcome ordinary nil n) (outcome compiled nil n)) (pr-str [init mode n])))))
+
+(t/deftest source-loop-regressions
+  (doseq [body bodies
+          :let [ordinary (compile-body body :ordinary)]
+          mode [:default :dispatcher]
+          :let [compiled (compile-body body mode)]
+          input [0 1000 -7 1.5 1/3 1000N 2M nil]
+          n [0 1 3]]
+    (t/is (= (outcome ordinary input n) (outcome compiled input n)) (pr-str [mode input n body])))
+  (doseq [initializer '[1000 1.5 -0.0 Double/NaN]
+          :let [body (list 'let ['step '(fn [x] x)]
+                          (list 'loop ['i 0 'x initializer]
+                                '(if (< i n) (recur (inc i) (step x)) x)))
+                ordinary (compile-body body :ordinary)]
+          mode [:default :dispatcher] :let [compiled (compile-body body mode)]
+          n [0 1 3]]
+    (t/is (= (identical? (ordinary nil nil n) (ordinary nil nil n))
+             (identical? (compiled nil nil n) (compiled nil nil n))) (pr-str [mode n body])))
+  ;; A primitive backedge is insufficient to specialize an unknown initial box.
+  (let [body '(loop [i 0 x (identity input)]
+                (if (< i n) (recur (inc i) (Math/fma 1.5 (double x) 0.25)) x))]
+    (doseq [mode [:default :dispatcher] input [0 1.5 -0.0 1M nil] n [0 1 3]]
+      (t/is (= (outcome (compile-body body :ordinary) input n)
+               (outcome (compile-body body mode) input n))))))
+
+(t/deftest source-loop-overloads-follow-fixed-point-types
+  (doseq [body '[(let [step (fn ^long [^long x] (inc x))]
+                   (loop [i 0 x 1000]
+                     (if (< i n) (recur (inc i) (step x))
+                       [(.choose ^com.tailrecursion.blacktide.jvm_test.Choice jvm/chooser x)
+                        (.choose ^com.tailrecursion.blacktide.jvm_test.Choice jvm/chooser i)])))
+                (let [step (fn ^long [^long x] (inc x))]
+                   (loop [i 0 x 1000 y x]
+                     (if (< i n) (recur (inc i) (step x) x)
+                       (.choose ^com.tailrecursion.blacktide.jvm_test.Choice jvm/chooser y))))
+                (let [step (fn ^double [^double x] (+ x 0.5))]
+                   (loop [i 0 x 1000.0]
+                     (if (< i n) (recur (inc i) (step x))
+                       (.choose ^com.tailrecursion.blacktide.jvm_test.Choice jvm/chooser x))))
+                (let [step (fn [x] input)]
+                   (loop [i 0 x 1000]
+                     (if (< i n) (recur (inc i) (step x))
+                       (.choose ^com.tailrecursion.blacktide.jvm_test.Choice jvm/chooser x))))
+                (let [step (fn ^long [^long x] (inc x))]
+                   (loop [i 0 x 1000]
+                     (if (< i n) (recur (inc i) (step x)) (Math/abs x))))
+                (let [step (fn [x] input)]
+                   (loop [i 0 x 1000]
+                     (if (< i n) (recur (inc i) (step x)) (.substring x 1))))
+                (let [step (fn [x] input)]
+                   (loop [i 0 x 1000]
+                     (if (< i n) (recur (inc i) (step x)) (.length x))))]
+          :let [reference (compile-body body :ordinary)]]
+    (doseq [mode [:default :dispatcher] :let [compiled (compile-body body mode)]
+            input [0 1.5 1/3 2M "word" nil] n [0 1 3]]
+      (t/is (= (outcome reference input n) (outcome compiled input n)) (pr-str [body mode input n])))))
+
+(defn arithmetic [double? value [op k]]
+  (let [v (gensym "operand") k (if double? (double k) k)]
+    `(let [~v ~value]
+       ~(case op
+          :add `(+ ~v ~k)
+          :increment `(inc ~v)
+          :negate `(- ~v)
+          :scale `(* ~v ~k)
+          :branch `(if (< ~v 0) (+ ~v ~k) (- ~v ~k))
+          :flip (if double? `(- 0.0 ~v) `(bit-xor ~v ~(long k)))))))
+
+(defn generated-body [{:keys [double? typed? narrow? alias? shadow? scalar? forward? literal? steps k]} renamed?]
+  (let [cast (if double? 'double 'long)
+        parameters (cond-> ['p] typed? (with-meta {:tag cast}))
+        parameters (if typed? (with-meta [(with-meta 'p {:tag cast})] (meta parameters)) parameters)
+        compute (reduce (partial arithmetic double?) (list cast 'p) steps)
+        compute `(do (swap! ~'events conj [:call ~'p ~'bias]) ~compute)
+        call (list 'step 'x)
+        call (if shadow? `(let [~'x (+ ~'x ~'bias)] ~call) call)
+        update (if alias? `(let [~'snapshot ~call] ~'snapshot) call)
+        next-index (if narrow? (list (if double? 'float 'int) '(inc i)) '(inc i))
+        initial (if literal? (if double? 1.5 1000) (list cast 'input))
+        result (if scalar? '(- y y)
+                 '[x y (class x) (class y) (identical? x x) (identical? x y) (identical? i i)
+                   (.choose ^com.tailrecursion.blacktide.jvm_test.Choice jvm/chooser x)
+                   (.choose ^com.tailrecursion.blacktide.jvm_test.Choice jvm/chooser y)])
+        body `(let [~'bias ~(if double? (double k) k)
+                    ~'step (fn ~parameters ~compute)]
+                (loop [~'i ~(if double? 0.0 0)
+                       ~'x (do (swap! ~'events conj :init) ~initial)
+                       ~'y ~'x]
+                  (if (< ~'i ~'n)
+                    (recur (do (swap! ~'events conj [:index ~'i]) ~next-index)
+                           (do (swap! ~'events conj [:left ~'x]) ~update)
+                           (do (swap! ~'events conj [:right ~'y]) ~(if forward? 'x '(step y))))
+                    ~result)))]
+    (if renamed?
+      (list 'let ['unused :harmless]
+            (walk/postwalk #(if (symbol? %) (with-meta (get '{i counter x left y right p value
+                                                           step when bias amount snapshot saved} % %) (meta %)) %) body))
+      body)))
+
+(defn config-outcome [config renamed? mode n]
+  (let [form (generated-body config renamed?)]
+    (outcome (compile-body form mode) (:input config) n)))
+
+(defn minimize [config renamed? mode n]
+  (loop [config config]
+    (let [candidates (concat
+                       (for [index (range (count (:steps config)))]
+                         (update config :steps #(into (subvec % 0 index) (subvec % (inc index)))))
+                       (for [key [:typed? :narrow? :alias? :shadow? :scalar? :forward? :literal?]
+                             :when (get config key)] (assoc config key false))
+                       (when (not= 0 (:input config)) [(assoc config :input 0)])
+                       (when (not= 0 (:k config)) [(assoc config :k 0)]))]
+      (if-let [smaller (first (filter #(not= (config-outcome % false :ordinary n)
+                                            (config-outcome % renamed? mode n)) candidates))]
+        (recur smaller) config))))
+
+(t/deftest generated-source-loop-equivalence
+  (let [seed 141421 random (java.util.Random. seed)
+        choose #(nth % (.nextInt random (count %)))]
+    (dotimes [index 128]
+      (let [double? (odd? index)
+            config {:double? double? :typed? (.nextBoolean random) :narrow? (.nextBoolean random)
+                    :alias? (.nextBoolean random) :shadow? (.nextBoolean random)
+                    :scalar? (.nextBoolean random) :forward? (.nextBoolean random)
+                    :literal? (.nextBoolean random) :k (- (.nextInt random 7) 3)
+                    :input (choose (if double? [-0.0 1.5 Double/NaN Double/POSITIVE_INFINITY Double/MIN_VALUE]
+                                             [0 1000 Long/MIN_VALUE Long/MAX_VALUE 2M 1/3 nil]))
+                    :steps (vec (repeatedly (inc (.nextInt random 4))
+                                           #(vector (choose [:add :increment :negate :scale :branch :flip])
+                                                    (- (.nextInt random 7) 3))))}
+            reference (compile-body (generated-body config false) :ordinary)]
+        (doseq [renamed? [false true] mode [:default :dispatcher]
+                :let [compiled (compile-body (generated-body config renamed?) mode)] n [0 1 4]]
+          (let [expected (outcome reference (:input config) n) actual (outcome compiled (:input config) n)]
+            (t/is (= expected actual)
+                  (when (not= expected actual)
+                    (let [small (minimize config renamed? mode n)]
+                      (pr-str {:seed seed :index index :mode mode :renamed? renamed? :n n
+                               :input (:input small) :form (generated-body small renamed?)}))))))))
+    (println "Source loop generator:" {:seed seed :configs 128 :comparisons 1536})))
diff --git a/test/com/tailrecursion/blacktide/source_test.clj b/test/com/tailrecursion/blacktide/source_test.clj
new file mode 100644
index 0000000..2c64535
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/source_test.clj
@@ -0,0 +1,179 @@
+(ns com.tailrecursion.blacktide.source-test
+  "Source binding and expansion compared with ordinary Clojure, including
+  generated lexical programs."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.blacktide :as lh :refer [loophole label goto setq psetq]]
+            [com.tailrecursion.blacktide.source-fixture :as fixture]))
+
+(defn sum [a b] (+ a b))
+(defn record! [events tag value] (swap! events conj tag) value)
+(defmacro sees-local? [name] (contains? &env name))
+(defmacro local-name [name] (list 'quote (:name (get &env name))))
+(defmacro nested [expr] `(do (do ~expr)))
+(defmacro bind-x [value & body] `(let [~'x ~value] ~@body))
+(def expansion-events (atom []))
+(defmacro expanded [value] (swap! expansion-events conj value) value)
+(def ^:dynamic *operator* identity)
+(defn change-operator [x] (set! *operator* (constantly :new)) x)
+
+(defn run-form [form]
+  (binding [*ns* (the-ns 'com.tailrecursion.blacktide.source-test)] (eval form)))
+(defn rejection [form]
+  (try (run-form form) nil
+       (catch Throwable e
+         (loop [e e] (if-let [cause (ex-cause e)] (recur cause) (ex-data e))))))
+
+(deftest sequential-scopes-and-results
+  (is (nil? (loophole [])))
+  (is (nil? (loophole [x 1])))
+  (is (= [1 1 3 4]
+         (loophole [x 1 y x] (let [x 3 z (sum x y)] (vector y y x z)))))
+  (is (= [1 2 1]
+         (loophole [x 1] (vector x (let [x 2] x) x))))
+  (is (= :done (loophole [] 1 nil :done)))
+  (is (= 3 (loophole [x 1 x (sum x 2)] x)))
+  (is (= [3] (loophole [x 3] (-> x vector))))
+  (is (= '(setq x 3) (loophole [] '(setq x 3))))
+  (is (= {:op :local :id 'ghost} (loophole [] '{:op :local :id ghost})))
+  (is (= #'sum (loophole [sum 2] (var sum))))
+  (is (= String (loophole [] String)))
+  (let [x 9 f (fn [n] (+ n x))]
+    (is (= 13 (loophole [] (f 4))))))
+
+(deftest expansion-knows-lexical-context
+  (is (loophole [x 1] (sees-local? x)))
+  (is (= 'x (loophole [x 1] (local-name x))))
+  (is (false? (loophole [] (sees-local? absent))))
+  (let [caller 1] (is (loophole [] (sees-local? caller))))
+  (is (= 10 (loophole [x 3] (bind-x 10 (nested x)))))
+  (is (= [1 2] (loophole [goto vector] (goto 1 2))))
+  (is (= [3] (loophole [when vector] (when 3))))
+  (is (= [4] (loophole [loophole vector] (loophole 4))))
+  (is (= 6 (loophole [] (fixture/goto 6))))
+  (reset! expansion-events [])
+  (is (= 3 (run-form '(loophole [x (expanded 1) y (expanded 2)] (expanded 3)))))
+  (is (= [1 2 3] @expansion-events)))
+
+(deftest macro-visibility-before-expansion
+  (reset! fixture/expansion-events 0)
+  (is (thrown-with-msg? IllegalStateException #"not public" (run-form '(fixture/hidden))))
+  (is (= :private-var (:kind (rejection '(loophole [] (fixture/hidden))))))
+  (let [v (ns-resolve 'com.tailrecursion.blacktide.source-fixture 'hidden) original (meta v)]
+    (try
+      (alter-meta! v assoc :ns (the-ns 'com.tailrecursion.blacktide.source-test))
+      (is (thrown-with-msg? IllegalStateException #"not public" (run-form '(fixture/hidden))))
+      (is (= :private-var (:kind (rejection '(loophole [] (fixture/hidden))))))
+      (finally (reset-meta! v original))))
+  (is (zero? @fixture/expansion-events))
+  (binding [*ns* (the-ns 'com.tailrecursion.blacktide.source-fixture)]
+    (is (= :hidden (eval '(hidden)) (eval '(lh/loophole [] (hidden))))))
+  (is (= 2 @fixture/expansion-events)))
+
+(deftest source-evaluation-order
+  (is (= :old
+         (binding [*operator* (constantly :old)] (*operator* (change-operator 0)))
+         (binding [*operator* (constantly :old)] (loophole [] (*operator* (change-operator 0))))))
+  (let [events (atom [])]
+    (is (= [10 20 30]
+           (loophole [x (record! events :init 10)]
+             ((do (record! events :operator vector))
+              (record! events :first x)
+              (let [x (record! events :second 20)] x)
+              (record! events :third 30)))))
+    (is (= [:init :operator :first :second :third] @events)))
+  (let [events (atom []) error (ex-info "source failure" {})
+        explode (fn [] (throw error))]
+    (is (identical? error
+          (try (loophole [x (record! events :first 1) y (explode)]
+                 (record! events :unreachable x))
+               (catch Throwable e e))))
+    (is (= [:first] @events))))
+
+(deftest storage-is-independent-of-redefined-vars
+  (with-redefs [identity (constantly :changed)]
+    (is (= 1 (loophole [x 1] x)))
+    (is (= :changed (loophole [] (identity 2)))))
+  (doseq [value [nil true false 1 2.5 1N 1M 1/2 \a "text" :key 'name
+                 (byte 1) (short 2) (int 3) (float 4) (Object.)]]
+    (is (identical? value (loophole [x value] x)))))
+
+(deftest diagnostics-and-public-surface
+  (is (not (contains? (loaded-libs) 'typed.clojure)))
+  (is (= '#{loophole label goto setq psetq} (set (keys (ns-publics 'com.tailrecursion.blacktide)))))
+  (doseq [op '[label goto setq psetq]]
+    (is (= :outside-region (:kind (rejection (list op))))))
+  (doseq [[form kind] [['(loophole [x] x) :invalid-bindings]
+                       ['(loophole [(x) 1] x) :invalid-binding]
+                       ['(loophole [] missing) :unresolved-symbol]
+                       ['(loophole [] (quote 1 2)) :invalid-quote]
+                       ['(loophole [] (var missing)) :invalid-var]
+                       ['(loophole [] (def x 1)) :unsupported-form]
+                       ['(loophole [] (reify Object (toString [_] "later"))) :unsupported-form]
+                       ['(loophole [x 1] (fn [] x)) :unsupported-form]]]
+    (is (= kind (:kind (rejection form))) (pr-str form)))
+  (let [bad (with-meta '(quote 1 2) {:file "example.clj" :line 31 :column 9})
+        data (rejection (list 'loophole [] bad))]
+    (is (= {:file "example.clj" :line 31 :column 9 :form bad :kind :invalid-quote}
+           data))))
+
+(defn expression [^java.util.Random random depth locals]
+  (let [pick #(.nextInt random %)]
+    (if (zero? depth)
+      (if (and (seq locals) (zero? (pick 2))) (nth locals (pick (count locals))) (- (pick 31) 15))
+      (case (pick 5)
+        0 (list 'sum (expression random (dec depth) locals) (expression random (dec depth) locals))
+        1 (let [name (nth '[x y z] (pick 3))]
+            (list 'let [name (expression random (dec depth) locals)]
+                  (expression random (dec depth) (conj locals name))))
+        2 (list 'do (expression random (dec depth) locals) (expression random (dec depth) locals))
+        3 (list 'identity (expression random (dec depth) locals))
+        (expression random 0 locals)))))
+
+(defn smaller [form]
+  (when (seq? form)
+    (let [[op & args] form]
+      (concat [0]
+              (if (= op 'let)
+                [(last args) (list 'let [(first (first args)) 0] (last args))]
+                args)
+              (for [i (range (count args)) child (smaller (nth args i))]
+                (list* op (assoc (vec args) i child)))))))
+
+(defn difference [body]
+  ;; Invalid shrinks are discarded by the independent Clojure oracle.
+  (try
+    (let [expected (run-form (list 'let '[x 7] body))]
+      (try (let [actual (run-form (list 'loophole '[x 7] body))]
+             (when-not (= expected actual) :value))
+           (catch Throwable _ :compilation-or-execution)))
+    (catch Throwable _ nil)))
+
+(defn minimize [body kind]
+  (loop [body body]
+    (if-let [small (first (filter #(and (not= body %) (= kind (difference %))) (smaller body)))]
+      (recur small) body)))
+
+(deftest deterministic-lexical-programs
+  (let [seed 20261103 random (java.util.Random. seed)]
+    (dotimes [trial 150]
+      (let [body (expression random 3 '[x])
+            expected (run-form (list 'let '[x 7] body))]
+        (doseq [variant [body (list 'do body) (list 'let ['unused 99] body)]]
+          (let [actual (try [:value (run-form (list 'loophole '[x 7] variant))]
+                            (catch Throwable e [:error (ex-message e)]))]
+            (is (= [:value expected] actual)
+                (when (not= [:value expected] actual)
+                  (str "seed " seed ", trial " trial ": "
+                       (pr-str (if-let [kind (difference variant)] (minimize variant kind) variant)))))))))))
+
+(deftest diagnostic-context-survives-expansion-and-native-boundaries
+  (doseq [body '[(case)]
+          prefix [[] ['(goto end)]]]
+    (let [form (with-meta (list* 'loophole [] (concat prefix [body])) {:line 123 :column 9})
+          error (binding [*file* "diagnostic-example.clj"] (rejection form))]
+      (is (= :invalid-case (:kind error)))
+      (is (= '(case) (:form error)))
+      (is (string? (:file error)))
+      (is (integer? (:line error)))
+      (is (integer? (:column error)))))
+  (let [case (constantly 4)] (is (= 4 (loophole [] (case))))))
diff --git a/test/com/tailrecursion/blacktide/source_values_test.clj b/test/com/tailrecursion/blacktide/source_values_test.clj
new file mode 100644
index 0000000..9a46f1a
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/source_values_test.clj
@@ -0,0 +1,42 @@
+(ns com.tailrecursion.blacktide.source-values-test
+  "Primitive source reads box at each Object use; mutable locations and saved
+  Object references retain their identity across normalization and transfers."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.blacktide.backend-test :as backend]))
+
+(def initializers
+  '[1000 1.5 (int 1000) (short 1000) (byte 4) (float 1.5) (char 256) (boolean true)
+    (identity 1000) (identity 1.5) (Integer. 1000) (Double. 1.5)])
+
+(deftest source-reads-preserve-width-and-identity
+  (doseq [init initializers
+          body '[(identical? x x)
+                 (let [[a b] [x x]] (identical? a b))
+                 (let [snapshot (identity x)] (identical? snapshot snapshot))
+                 (let [x (identity x)] (identical? x x))]
+          :let [form (list 'let ['x init] body) reference (backend/compile-program form :default)]
+          mode [:default :dispatcher]]
+    (is (= (reference nil) ((backend/compile-program (list 'loophole [] form) mode) nil)) (pr-str [init body mode])))
+  (doseq [init initializers :let [form (list 'let ['x init] 'x) reference (backend/compile-program form :default)]
+          mode [:default :dispatcher] :let [compiled (backend/compile-program (list 'loophole [] form) mode)]]
+    (is (= (reference nil) (compiled nil)) (pr-str [init mode]))
+    (is (= (class (reference nil)) (class (compiled nil))) (pr-str [init mode]))
+    (is (= (identical? (reference nil) (reference nil)) (identical? (compiled nil) (compiled nil)))
+        (pr-str [init mode]))))
+
+(deftest mutable-snapshots-remain-references
+  (doseq [mode [:default :dispatcher] init initializers
+          form [(list 'loophole ['x init 'y nil] '(psetq y x x x) '(identical? x y))
+                (list 'loophole ['x nil 'y nil] (list 'psetq 'y (list 'setq 'x init)) '(identical? x y))
+                (list 'loophole ['x init]
+                      '(let [saved x] (setq x nil) (identical? saved saved)))]]
+    (is (true? ((backend/compile-program form mode) nil)) (pr-str [mode form])))
+  (doseq [mode [:default :dispatcher]]
+    (is (= [1000 true false]
+           ((backend/compile-program
+              '(loophole [x 1000 y nil count 0 saved x]
+                   (label again)
+                   (psetq y x x (long 1001))
+                   (setq count (inc count))
+                   (when (< count 2) (setq x saved) (goto again))
+                   [saved (identical? saved y) (identical? saved x)]) mode) nil)))))
diff --git a/test/com/tailrecursion/blacktide/subset_test.clj b/test/com/tailrecursion/blacktide/subset_test.clj
new file mode 100644
index 0000000..12719e3
--- /dev/null
+++ b/test/com/tailrecursion/blacktide/subset_test.clj
@@ -0,0 +1,52 @@
+(ns com.tailrecursion.blacktide.subset-test
+  "The language boundary applies after macroexpansion, including dead code;
+  callers may freely use Clojure outside the region. Quoted data stays opaque."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.blacktide :refer [loophole label goto setq]]
+            [com.tailrecursion.blacktide.source-test :as source]))
+
+(defmacro hidden-function [] `(fn [] :hidden))
+(defmacro hidden-label [] `(label ~'hidden))
+
+(deftest excluded-forms-are-rejected-before-reachability
+  (doseq [body '[(fn [] 1) (fn* [] 1) (letfn [(f [] 1)] (f)) (letfn* [f (fn* [] 1)] (f))
+                (try 1 (catch Exception e 2) (finally nil)) (monitor-enter nil) (monitor-exit nil)
+                (set! x 1) (def value 1) (declare value) (reify Object (toString [_] "x"))
+                (loophole [] 1) (delay 1) (lazy-seq [1]) (future 1)
+                (binding [*print-length* 1] 2) (locking (Object.) 1)
+                (with-open [r (java.io.StringReader. "")] 1) (with-redefs [identity vector] 1)
+                (com.tailrecursion.blacktide.subset-test/hidden-function)]
+          prefix [[] ['(goto end)]]]
+    (is (= :unsupported-form
+           (:kind (source/rejection (list* 'loophole '[x 0] (concat prefix [body])))))
+        (pr-str [prefix body]))))
+
+(deftest operands-cannot-hide-transfers
+  (doseq [body '[(identity (do (goto end) 1))
+                ((do (goto end) identity) 1)
+                (if (do (goto end) true) 1 2)
+                (case (do (goto end) 1) 1 2 3)
+                (let [a (do (goto end) 1)] a)
+                (loop [a (do (goto end) 1)] a)
+                (loop [a 0] (recur (do (goto end) 1)))
+                (setq x (case 1 1 (goto end) 2))
+                [(let [] (goto end) 1)]
+                (identity (loop [] (goto end)))
+                ^{:note (do (goto end) 1)} [1]
+                (let [] (com.tailrecursion.blacktide.subset-test/hidden-label))]]
+    (is (= :marker-position (:kind (source/rejection (list 'loophole '[x 0] body)))) (pr-str body)))
+  (is (= :ok (loophole [] (do (label a) (do (goto b))) :wrong (label b) :ok)))
+  (is (= '(fn [] (goto end)) (loophole [] '(fn [] (goto end))))))
+
+(deftest caller-functions-and-dynamic-extent
+  (let [events (atom []) helper (fn [x] (try (inc x) (finally (swap! events conj :helper))))]
+    (is (= 4 (try (loophole [x 0] (dotimes [_ 4] (setq x (helper x))) x)
+                   (finally (swap! events conj :caller)))))
+    (is (= [:helper :helper :helper :helper :caller] @events)))
+  (letfn [(even-state [n] (if (zero? n) true (odd-state (dec n))))
+          (odd-state [n] (if (zero? n) false (even-state (dec n))))]
+    (is (= [true false] (loophole [] [(even-state 4) (odd-state 4)]))))
+  (binding [*print-length* 1]
+    (is (= "[1 ...]" (loophole [] (pr-str [1 2])))))
+  (let [error (Exception. "caller handles it")]
+    (is (identical? error (try (loophole [] (throw error)) (catch Exception e e))))))
diff --git a/test/com/tailrecursion/check_runner.clj b/test/com/tailrecursion/check_runner.clj
new file mode 100644
index 0000000..aae620f
--- /dev/null
+++ b/test/com/tailrecursion/check_runner.clj
@@ -0,0 +1,11 @@
+(ns com.tailrecursion.check-runner
+  "Run the library's static probes and the production compiler checks."
+  (:require [clojure.test :as test]
+            [com.tailrecursion.nanopass.check]
+            [com.tailrecursion.blacktide.check]))
+
+(defn -main [& _]
+  (let [{:keys [fail error]} (test/run-tests 'com.tailrecursion.nanopass.check
+                                          'com.tailrecursion.blacktide.check)]
+    (shutdown-agents)
+    (when (pos? (+ fail error)) (System/exit 1))))
diff --git a/test/com/tailrecursion/nanopass/annotations.clj b/test/com/tailrecursion/nanopass/annotations.clj
new file mode 100644
index 0000000..b7aa96e
--- /dev/null
+++ b/test/com/tailrecursion/nanopass/annotations.clj
@@ -0,0 +1,17 @@
+(ns com.tailrecursion.nanopass.annotations
+  "Checking-only declarations, generated from the ordinary language values."
+  (:require [typed.clojure]
+            [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.nanopass.fixtures :as f]
+            [com.tailrecursion.nanopass.passes :as p]
+            [com.tailrecursion.nanopass.clients.assignment :as assignment]
+            [com.tailrecursion.nanopass.clients.flow :as flow]
+            [com.tailrecursion.nanopass.clients.flow-languages :as flow-languages]))
+
+(np/ann-languages f/Source f/Core f/Literals f/Mutual f/Stopped)
+(np/ann-passes p/lower p/lower-binding p/rename p/rename-binding p/count-step p/lower-envelope)
+(np/ann-languages assignment/Source assignment/Core)
+(np/ann-passes assignment/lower assignment/sequential-writes assignment/parallel-writes)
+(np/ann-languages flow-languages/Syntax flow-languages/Bound flow-languages/Machine)
+(np/ann-passes flow/bind-expr flow/bind-exprs flow/bind-local flow/fresh-block flow/fresh-value
+               flow/emit-op flow/seal flow/start flow/lower flow/lower-exprs flow/compile-program)
diff --git a/test/com/tailrecursion/nanopass/assignment_test.clj b/test/com/tailrecursion/nanopass/assignment_test.clj
new file mode 100644
index 0000000..6fa625c
--- /dev/null
+++ b/test/com/tailrecursion/nanopass/assignment_test.clj
@@ -0,0 +1,173 @@
+(ns com.tailrecursion.nanopass.assignment-test
+  "Execute both grammars against explicit traces and deterministic generated inputs.
+  The interpreter is test instrumentation; the compiler pass only constructs data."
+  (:require [clojure.test :refer [deftest is testing]]
+            [com.tailrecursion.nanopass.clients.assignment :as lower]))
+
+(defn lit [value] {:op :const :value value})
+(defn read-var [name] {:op :read :binding name})
+(defn batch [op & writes] {:op op :writes (mapv vec (partition 2 writes))})
+(defn sequence-of [& forms] {:op :do :forms (vec forms)})
+(defn event [tag value] {:op :event :tag tag :value value})
+
+(defn evaluate [form state]
+  (let [run #(evaluate % %2)
+        binding (:binding form)]
+    (case (:op form)
+      :const [(:value form) state]
+      :read [(get-in state [:vars binding]) state]
+      :temp (let [id (:id form)]
+              (when-not (contains? (:temps state) id)
+                (throw (ex-info "Unbound temporary" {:id id})))
+              [(get-in state [:temps id]) state])
+      :add (let [[a state] (run (:left form) state)
+                 [b state] (run (:right form) state)] [(+ a b) state])
+      :do (reduce (fn [[_ state] form] (run form state)) [nil state] (:forms form))
+      :if (let [[test state] (run (:test form) state)]
+            (run (if test (:then form) (:else form)) state))
+      :event (let [[value state] (run (:value form) state)]
+               [value (update state :trace conj [(:tag form) value])])
+      :exit (throw (ex-info "Region exit" {:status :exit :state state}))
+      :throw (throw (ex-info "Source exception" {:status :throw :tag (:tag form) :state state}))
+      ;; Source assignments define their semantics directly, independent of
+      ;; the pass's generated binding tree and the output's write primitive.
+      :setq (reduce (fn [[_ state] [name rhs]]
+                      (let [[value state] (run rhs state)]
+                        [value (assoc-in state [:vars name] value)]))
+                    [nil state] (:writes form))
+      :psetq (let [[values state]
+                   (reduce (fn [[values state] [_ rhs]]
+                             (let [[value state] (run rhs state)]
+                               [(conj values value) state]))
+                           [[] state] (:writes form))]
+               [nil (update state :vars merge (zipmap (map first (:writes form)) values))])
+      ;; The output interpreter knows only a single write and lexical temps.
+      :write (let [[value state] (run (:value form) state)]
+               [value (assoc-in state [:vars binding] value)])
+      :bind (let [[value state] (run (:value form) state)
+                  temps (:temps state)
+                  [result state] (run (:body form) (assoc-in state [:temps (:id form)] value))]
+              [result (assoc state :temps temps)]))))
+
+(defn execute [form vars]
+  (let [state {:vars vars :temps {} :trace []}]
+    (try
+      (let [[value state] (evaluate form state)]
+        (assoc (select-keys state [:vars :trace]) :value value :status :return))
+      (catch clojure.lang.ExceptionInfo e
+        (let [{:keys [state status tag]} (ex-data e)]
+          (if status
+            (cond-> (assoc (select-keys state [:vars :trace]) :status status)
+              tag (assoc :tag tag))
+            (throw e)))))))
+
+(deftest values-and-sequencing
+  (let [x (read-var 'x) y (read-var 'y)]
+    (doseq [[name source value vars trace]
+            [[:empty-sequential (batch :setq) nil {'x 1 'y 2} []]
+             [:empty-parallel (batch :psetq) nil {'x 1 'y 2} []]
+             [:sequential (batch :setq 'x (lit 3) 'y x) 3 {'x 3 'y 3} []]
+             [:swap (batch :psetq 'x y 'y x) nil {'x 2 'y 1} []]
+             [:repeated (batch :psetq 'x (event :first (lit 9)) 'x (event :second y))
+              nil {'x 2 'y 2} [[:first 9] [:second 2]]]
+             [:nested (batch :psetq 'x y 'y (batch :setq 'x (lit 9)))
+              nil {'x 2 'y 9} []]
+             [:nested-parallel (batch :psetq 'x (sequence-of (batch :psetq 'x y 'y x) y) 'y x)
+              nil {'x 1 'y 2} []]
+             [:sequential-trace (batch :setq 'x (event :first y) 'y (event :second x))
+              2 {'x 2 'y 2} [[:first 2] [:second 2]]]
+             [:parallel-trace (batch :psetq 'x (event :first y) 'y (event :second x))
+              nil {'x 2 'y 1} [[:first 2] [:second 1]]]
+             [:branch {:op :if :test (batch :psetq 'x (lit false))
+                       :then (event :wrong (lit 0))
+                       :else (batch :setq 'y (event :chosen x))}
+              false {'x false 'y false} [[:chosen false]]]
+             [:snapshot {:op :add :left x :right (batch :setq 'x (lit 10))}
+              11 {'x 10 'y 2} []]
+             [:runtime-type (batch :setq 'x (lit "string") 'y x)
+              "string" {'x "string" 'y "string"} []]
+             [:quoted-ir (lit {:op :psetq :writes :data})
+              {:op :psetq :writes :data} {'x 1 'y 2} []]]]
+      (testing (str name)
+        (let [expected {:value value :vars vars :trace trace :status :return}]
+          (is (= expected (execute source {'x 1 'y 2})))
+          (is (= expected (execute (lower/lower source) {'x 1 'y 2}))))))))
+
+(deftest abandoned-writes
+  (doseq [op [:setq :psetq]
+          transfer [{:op :exit} {:op :throw :tag :failed}]
+          nested? [false true]]
+    (let [source (batch op 'x (event :first (lit 10))
+                          'y (sequence-of
+                               (if nested? (batch :setq 'x (lit 9)) (lit nil))
+                               transfer))
+          expected (cond-> {:status (if (= :exit (:op transfer)) :exit :throw)
+                            :vars {'x (cond nested? 9 (= op :setq) 10 :else 1) 'y 2}
+                            :trace [[:first 10]]}
+                     (= :throw (:op transfer)) (assoc :tag :failed))]
+      (testing (pr-str [op transfer nested?])
+        (is (= expected (execute source {'x 1 'y 2})))
+        (is (= expected (execute (lower/lower source) {'x 1 'y 2})))))))
+
+(defn expression [^java.util.Random rng depth]
+  (let [pick #(.nextInt rng %)
+        child #(expression rng (dec depth))
+        writes #(vec (repeatedly (pick 4) (fn [] [(nth '[x y] (pick 2)) (child)])))]
+    (if (zero? depth)
+      (if (zero? (pick 2)) (lit (- (pick 11) 5)) (read-var (nth '[x y] (pick 2))))
+      (case (pick 7)
+        0 (child)
+        1 {:op :add :left (child) :right (child)}
+        2 (sequence-of (child) (child))
+        3 {:op :if :test (lit (zero? (pick 2))) :then (child) :else (child)}
+        4 (event (nth [:a :b :c] (pick 3)) (child))
+        5 (sequence-of {:op :setq :writes (writes)} (read-var 'x))
+        6 (sequence-of {:op :psetq :writes (writes)} (read-var 'y))))))
+
+(defn child-paths [node]
+  (case (:op node)
+    :add [[:left] [:right]]
+    :if [[:test] [:then] [:else]]
+    :event [[:value]]
+    :do (mapv #(vector :forms %) (range (count (:forms node))))
+    (:setq :psetq) (mapv #(vector :writes % 1) (range (count (:writes node))))
+    []))
+
+(defn paths [node]
+  (cons [] (mapcat (fn [path] (map #(into path %) (paths (get-in node path)))) (child-paths node))))
+
+(defn minimize [source fails?]
+  (loop [source source]
+    (if-let [smaller (some (fn [path]
+                            (let [candidate (if (seq path) (assoc-in source path (lit 0)) (lit 0))]
+                              (when (and (not= candidate source) (fails? candidate)) candidate)))
+                          (paths source))]
+      (recur smaller) source)))
+
+(deftest generated-assignment-combinations
+  (doseq [seed [712381 314159]]
+    (let [rng (java.util.Random. seed)]
+      (dotimes [index 200]
+        (let [source (expression rng 4) lowered (lower/lower source)]
+          (doseq [[x y] [[0 0] [1 2] [-7 5] [10 -3]]]
+            (let [vars {'x x 'y y}
+                  expected (execute source vars)
+                  actual (execute lowered vars)
+                  fails? (fn [program]
+                           (let [expected (execute program vars)
+                                 actual (execute (lower/lower program) vars)]
+                             (and (= :return (:status expected) (:status actual)) (not= expected actual))))]
+              (is (= expected actual)
+                  (pr-str {:seed seed :index index :input [x y]
+                           :source (if (= expected actual) source (minimize source fails?))})))))))))
+
+(deftest shrinking-preserves-semantic-failure
+  (let [source (batch :psetq 'x (sequence-of (lit 8) (read-var 'y)) 'y (read-var 'x))
+        fails? (fn [node]
+                 (when (= :psetq (:op node))
+                   (not= (execute node {'x 1 'y 2})
+                         (execute (lower/lower (sequence-of (assoc node :op :setq) (lit nil))) {'x 1 'y 2}))))
+        smaller (minimize source fails?)]
+    (is (fails? smaller))
+    (is (< (count (paths smaller)) (count (paths source))))
+    (is (= [[]] (vec (paths (lit {:op :setq :writes :opaque})))))))
diff --git a/test/com/tailrecursion/nanopass/check.clj b/test/com/tailrecursion/nanopass/check.clj
new file mode 100644
index 0000000..7c3befa
--- /dev/null
+++ b/test/com/tailrecursion/nanopass/check.clj
@@ -0,0 +1,123 @@
+(ns com.tailrecursion.nanopass.check
+  "Compile-time probes for generated recursive languages."
+  (:require [clojure.test :refer [deftest is run-tests]]
+            [clojure.core.typed :as checker]
+            [typed.clojure :as t]
+            [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.nanopass.annotations]
+            [com.tailrecursion.nanopass.fixtures :as f]
+            [com.tailrecursion.nanopass.passes :as p]
+            [com.tailrecursion.nanopass.clients.assignment :as assignment]
+            [com.tailrecursion.nanopass.assignment-test :as semantics]))
+
+(defn check-form [form expected]
+  (binding [*ns* (the-ns 'com.tailrecursion.nanopass.check)
+            *err* (java.io.StringWriter.)]
+    (checker/check-form-info form :expected expected :type-provided? true
+                             :check-config {:check-form-eval :never})))
+
+(defn accepts? [expected form accepted]
+  (let [{:keys [ex delayed-errors]} (check-form (list 'quote form) expected)
+        errors (concat delayed-errors (:errors (ex-data ex)))]
+    (is (or (nil? ex) (= :top-level-error (:type-error (ex-data ex)))) (str ex))
+    (is (= accepted (empty? errors)) (pr-str [form errors]))))
+
+(deftest recursive-languages
+  (doseq [[accepted form]
+          [[true {:op :literal :value '{:op :assign :value Expr}}]
+           [true {:op :write :name 'x :value {:op :literal :value 42}}]
+           [false {:op :assign :binding {:op :binding :name 'x :value {:op :literal :value 1}}
+                   :value {:op :literal :value 2}}]
+           [false {:op :group :bindings [{:op :binding :name 'x
+                                          :value {:op :assign :binding {:op :binding :name 'y
+                                                                        :value {:op :literal :value 1}}
+                                                  :value {:op :literal :value 2}}}]
+                   :body {:op :literal :value nil}}]
+           [false {:op :write :name 42 :value {:op :literal :value nil}}]
+           [false {:op :literal :value 1 :extra true}]]]
+    (accepts? 'f/Core-Expr form accepted)))
+
+(deftest recursive-containers
+  (let [leaf {:op :literal :value 1}
+        bad {:op :assign :binding {:op :binding :name 'x :value leaf} :value leaf}
+        base {:op :many :items {} :pair [leaf nil] :unique #{}}]
+    (doseq [form [base (assoc base :note "ok")
+                  (assoc base :items {:a [leaf]} :pair [leaf leaf] :unique #{leaf})]]
+      (accepts? 'f/Core-Expr form true))
+    (doseq [form [(assoc base :items {:a [bad]}) (assoc base :pair [bad nil])
+                  (assoc base :pair [leaf bad]) (assoc base :unique #{bad})
+                  (assoc base :note 42)]]
+      (accepts? 'f/Core-Expr form false))))
+
+(deftest indirect-recursion
+  (accepts? 'f/Mutual-A {:op :a :next {:op :b :next {:op :a :next nil}}} true)
+  (accepts? 'f/Stopped-A {:op :a :next {:op :stop}} true)
+  (accepts? 'f/Stopped-A {:op :a :next {:op :b :next nil}} false))
+
+(deftest checked-passes
+  (is (t/check-ns-clj 'com.tailrecursion.nanopass.passes))
+  (is (t/check-ns-clj 'com.tailrecursion.nanopass.clients.assignment))
+  (is (t/check-ns-clj 'com.tailrecursion.nanopass.clients.flow)))
+
+(defn generated-function [clause]
+  (let [[_ _ _ args body]
+        (binding [*ns* (the-ns 'com.tailrecursion.nanopass.passes)]
+          (macroexpand-1
+           (list 'np/defpass 'lower
+                 '{:from [f/Source Expr] :to [f/Core Expr] :processors {Binding lower-binding}}
+                 '[node] :assign clause)))]
+    (list 'fn args body)))
+
+(deftest generated-negative-probes
+  (let [good (generated-function '{:op :write :name (:name (:binding node))
+                                   :value (p/lower (:value node))})
+        [f args [case-op test & arms]] good
+        missing (list f args (list* case-op test
+                                    (concat (mapcat identity (remove #(= :assign (first %))
+                                                                     (partition 2 (butlast arms))))
+                                            [(last arms)])))]
+    (doseq [[accepted form]
+            [[true good]
+             [false missing]
+             [false (generated-function 'node)]
+             [false (generated-function '{:op :write :name 42 :value (p/lower (:value node))})]
+             [false '(fn [node] (p/lower (p/lower node)))]]]
+      (let [{:keys [ex delayed-errors]} (check-form form '[f/Source-Expr :-> f/Core-Expr])
+            errors (concat delayed-errors (:errors (ex-data ex)))]
+        (is (or (nil? ex) (= :top-level-error (:type-error (ex-data ex)))) (str ex))
+        (is (= accepted (empty? errors)) (pr-str [form errors]))))))
+
+(deftest assignment-contract-probes
+  (doseq [form
+          '[(fn [node] node)
+            (fn [_] {:op :psetq :writes []})
+            (fn [node] {:op :if :test {:op :const :value true} :then node :else {:op :const :value nil}})
+            (fn [_] {:op :write :binding 'x})
+            (fn [_] {:op :write :binding 42 :value {:op :const :value nil}})
+            (fn [_] {:op :write :binding 'x :value {:op :const :value nil} :extra true})
+            (fn [node] (assignment/lower (assignment/lower node)))
+            (fn [node] (case (:op node) :const node
+                         ((fn [^{:typed.clojure/- typed.clojure/Nothing} missing]
+                            (throw (ex-info "unhandled" {:node missing}))) node)))]]
+    (let [{:keys [ex delayed-errors]} (check-form form '[assignment/Source-Expr :-> assignment/Core-Expr])
+          errors (concat delayed-errors (:errors (ex-data ex)))]
+      (is (or (nil? ex) (= :top-level-error (:type-error (ex-data ex)))) (str ex))
+      (is (seq errors) (pr-str form)))))
+
+(deftest structural-types-do-not-prove-order
+  (let [form '(fn [node]
+                (if (= :psetq (:op node))
+                  {:op :do :forms [(assignment/sequential-writes (:writes node)) {:op :const :value nil}]}
+                  (assignment/lower node)))
+        {:keys [ex delayed-errors]} (check-form form '[assignment/Source-Expr :-> assignment/Core-Expr])
+        wrong (binding [*ns* (the-ns 'com.tailrecursion.nanopass.check)] (eval form))
+        source (semantics/batch :psetq 'x (semantics/read-var 'y) 'y (semantics/read-var 'x))]
+    (is (nil? ex) (str ex))
+    (is (empty? delayed-errors))
+    (is (= {'x 2 'y 2} (:vars (semantics/execute (wrong source) {'x 1 'y 2}))))
+    (is (= {'x 2 'y 1} (:vars (semantics/execute (assignment/lower source) {'x 1 'y 2}))))))
+
+(defn -main [& _]
+  (let [{:keys [fail error]} (run-tests 'com.tailrecursion.nanopass.check)]
+    (shutdown-agents)
+    (when (pos? (+ fail error)) (System/exit 1))))
diff --git a/test/com/tailrecursion/nanopass/clients/assignment.clj b/test/com/tailrecursion/nanopass/clients/assignment.clj
new file mode 100644
index 0000000..c6f13d1
--- /dev/null
+++ b/test/com/tailrecursion/nanopass/clients/assignment.clj
@@ -0,0 +1,48 @@
+(ns ^:typed.clojure com.tailrecursion.nanopass.clients.assignment
+  "A language client lowering sequential/parallel assignment to writes and temps.
+  This compiler constructs immutable data and has no dependency on Loophole."
+  (:require [com.tailrecursion.nanopass :as np]
+            [typed.clojure :as-alias t]))
+
+(np/deflanguage Source
+  {Expr (t/U (t/HMap :mandatory {:op ':const :value t/Any} :complete? true)
+             (t/HMap :mandatory {:op ':read :binding t/Sym} :complete? true)
+             (t/HMap :mandatory {:op ':exit} :complete? true)
+             (t/HMap :mandatory {:op ':throw :tag t/Keyword} :complete? true)
+             (t/HMap :mandatory {:op ':add :left Expr :right Expr} :complete? true)
+             (t/HMap :mandatory {:op ':do :forms (t/Vec Expr)} :complete? true)
+             (t/HMap :mandatory {:op ':if :test Expr :then Expr :else Expr} :complete? true)
+             (t/HMap :mandatory {:op ':event :tag t/Keyword :value Expr} :complete? true)
+             (t/HMap :mandatory {:op ':setq :writes Writes} :complete? true)
+             (t/HMap :mandatory {:op ':psetq :writes Writes} :complete? true))
+   Writes (t/Vec (t/HVec [t/Sym Expr]))})
+
+(np/derive-language Core Source
+  {:remove {Expr #{:setq :psetq}}
+   :add {Expr [(t/HMap :mandatory {:op ':write :binding t/Sym :value Expr} :complete? true)
+               (t/HMap :mandatory {:op ':temp :id t/Sym} :complete? true)
+               (t/HMap :mandatory {:op ':bind :id t/Sym :value Expr :body Expr} :complete? true)]}})
+
+(declare lower)
+
+(np/defpass sequential-writes {:from [Source Writes] :to [Core Expr] :body true}
+  [writes]
+  {:op :do :forms (mapv (fn [[target rhs]] {:op :write :binding target :value (lower rhs)}) writes)})
+
+(np/defpass parallel-writes {:from [Source Writes] :to [Core Expr] :body true}
+  [writes]
+  (let [names (mapv (fn [_] (gensym "rhs__")) writes)
+        body {:op :do
+              :forms (conj (mapv (fn [[target _] id]
+                                  {:op :write :binding target :value {:op :temp :id id}})
+                                writes names)
+                           {:op :const :value nil})}]
+    (reduce (fn [^{::t/- Core-Expr} body ^{::t/- (t/HVec [t/Sym Source-Expr])} entry]
+              (let [[id rhs] entry]
+                {:op :bind :id id :value (lower rhs) :body body}))
+            body (reverse (mapv (fn [id [_ rhs]] [id rhs]) names writes)))))
+
+(np/defpass lower {:from [Source Expr] :to [Core Expr]}
+  [node]
+  :setq (sequential-writes (:writes node))
+  :psetq (parallel-writes (:writes node)))
diff --git a/test/com/tailrecursion/nanopass/clients/flow.clj b/test/com/tailrecursion/nanopass/clients/flow.clj
new file mode 100644
index 0000000..6d5b683
--- /dev/null
+++ b/test/com/tailrecursion/nanopass/clients/flow.clj
@@ -0,0 +1,112 @@
+(ns ^:typed.clojure com.tailrecursion.nanopass.clients.flow
+  "Lexical binding followed by CFG construction, with immutable explicit state.
+  This independent toy language has integer conditions: zero is false."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.nanopass.clients.flow-languages :as l]
+            [typed.clojure :as-alias t]))
+
+(declare bind-expr bind-exprs bind-local lower lower-exprs)
+
+(np/defpass bind-exprs
+  {:from [l/Syntax Exprs] :to (t/HVec [t/Int (t/Vec l/Bound-Expr)])
+   :args [(t/Map t/Sym t/Sym) t/Int] :body true}
+  [env supply forms]
+  (reduce (fn [^{::t/- (t/HVec [t/Int (t/Vec l/Bound-Expr)])} acc ^{::t/- l/Syntax-Expr} form]
+            (let [[supply out] acc [supply form] (bind-expr env supply form)]
+              [supply (conj out form)])) [supply []] forms))
+
+(np/defpass bind-local
+  {:from [l/Syntax Binding] :to (t/HVec [t/Int l/Bound-Binding])
+   :args [(t/Map t/Sym t/Sym) t/Int] :body true}
+  [env supply node]
+  (let [[supply init] (bind-expr env supply (:value node))]
+    [(inc supply) {:op :binding :id (symbol (str "local__" supply)) :value init}]))
+
+(np/defpass bind-expr
+  {:from [l/Syntax Expr] :to (t/HVec [t/Int l/Bound-Expr]) :args [(t/Map t/Sym t/Sym) t/Int]}
+  [env supply node]
+  :int [supply node]
+  :read [supply {:op :ref :id (or (get env (:name node)) (throw (ex-info "Unbound name" {:name (:name node)})))}]
+  :set (let [id (or (get env (:name node)) (throw (ex-info "Unbound name" {:name (:name node)})))
+             [supply value] (bind-expr env supply (:value node))]
+         [supply {:op :write :id id :value value}])
+  :plus (let [[supply left] (bind-expr env supply (:left node))
+              [supply right] (bind-expr env supply (:right node))]
+          [supply {:op :plus :left left :right right}])
+  :let (let [[supply local] (bind-local env supply (:binding node))
+             env (assoc env (:name (:binding node)) (:id local))
+             [supply body] (bind-expr env supply (:body node))]
+         [supply {:op :let :binding local :body body}])
+  :if (let [[supply test] (bind-expr env supply (:test node))
+            [supply yes] (bind-expr env supply (:then node))
+            [supply no] (bind-expr env supply (:else node))]
+        [supply {:op :if :test test :then yes :else no}])
+  :while (let [[supply test] (bind-expr env supply (:test node))
+               [supply body] (bind-expr env supply (:body node))]
+           [supply {:op :while :test test :body body}])
+  :do (let [[supply forms] (bind-exprs env supply (:forms node))]
+        [supply {:op :do :forms forms}]))
+
+(np/defpass fresh-block {:from [l/Machine Builder] :to (t/HVec [l/Machine-Builder t/Int]) :body true}
+  [state]
+  [(assoc state :next (inc (:next state))) (:next state)])
+
+(np/defpass fresh-value {:from [l/Machine Builder] :to (t/HVec [l/Machine-Builder t/Sym]) :body true}
+  [state]
+  [(assoc state :next-value (inc (:next-value state))) (symbol (str "value__" (:next-value state)))])
+
+(np/defpass emit-op {:from [l/Machine Operation] :to [l/Machine Builder] :args [l/Machine-Builder] :body true}
+  [state op]
+  (assoc state :ops (conj (:ops state) op)))
+
+(np/defpass seal {:from [l/Machine Term] :to [l/Machine Builder] :args [l/Machine-Builder] :body true}
+  [state term]
+  (assoc state :blocks (assoc (:blocks state) (:current state) {:ops (:ops state) :term term}) :ops []))
+
+(np/defpass start {:from [l/Machine Builder] :to [l/Machine Builder] :args [t/Int] :body true}
+  [id state]
+  (assoc state :current id :ops []))
+
+(np/defpass lower-exprs
+  {:from [l/Bound Exprs] :to (t/HVec [l/Machine-Builder l/Machine-Operand]) :args [l/Machine-Builder] :body true}
+  [state forms]
+  (reduce (fn [^{::t/- (t/HVec [l/Machine-Builder l/Machine-Operand])} acc ^{::t/- l/Bound-Expr} form]
+            (lower (first acc) form)) [state {:op :literal :value 0}] forms))
+
+(np/defpass lower
+  {:from [l/Bound Expr] :to (t/HVec [l/Machine-Builder l/Machine-Operand]) :args [l/Machine-Builder]}
+  [state node]
+  :int [state {:op :literal :value (:value node)}]
+  :ref (let [[state id] (fresh-value state)]
+         [(emit-op state {:op :put :id id :value {:op :register :id (:id node)}}) {:op :register :id id}])
+  :write (let [[state value] (lower state (:value node))]
+           [(emit-op state {:op :put :id (:id node) :value value}) value])
+  :plus (let [[state left] (lower state (:left node))
+              [state right] (lower state (:right node))
+              [state id] (fresh-value state)]
+          [(emit-op state {:op :add :id id :left left :right right}) {:op :register :id id}])
+  :let (let [local (:binding node) [state init] (lower state (:value local))]
+         (lower (emit-op state {:op :put :id (:id local) :value init}) (:body node)))
+  :do (lower-exprs state (:forms node))
+  :if (let [[state test] (lower state (:test node))
+            [state yes] (fresh-block state) [state no] (fresh-block state) [state join] (fresh-block state)
+            [state result] (fresh-value state)
+            state (seal state {:op :branch :test test :yes yes :no no})
+            [state a] (lower (start yes state) (:then node))
+            state (seal (emit-op state {:op :put :id result :value a}) {:op :jump :target join})
+            [state b] (lower (start no state) (:else node))
+            state (seal (emit-op state {:op :put :id result :value b}) {:op :jump :target join})]
+        [(start join state) {:op :register :id result}])
+  :while (let [[state header] (fresh-block state) [state body] (fresh-block state) [state exit] (fresh-block state)
+               state (seal state {:op :jump :target header})
+               [state test] (lower (start header state) (:test node))
+               state (seal state {:op :branch :test test :yes body :no exit})
+               [state _] (lower (start body state) (:body node))
+               state (seal state {:op :jump :target header})]
+           [(start exit state) {:op :literal :value 0}]))
+
+(np/defpass compile-program {:from [l/Syntax Expr] :to [l/Machine Graph] :body true}
+  [source]
+  (let [[_ source] (bind-expr {} 0 source)
+        [state value] (lower {:next 1 :current 0 :next-value 0 :ops [] :blocks {}} source)]
+    {:entry 0 :blocks (:blocks (seal state {:op :return :value value}))}))
diff --git a/test/com/tailrecursion/nanopass/clients/flow_languages.clj b/test/com/tailrecursion/nanopass/clients/flow_languages.clj
new file mode 100644
index 0000000..cf279db
--- /dev/null
+++ b/test/com/tailrecursion/nanopass/clients/flow_languages.clj
@@ -0,0 +1,35 @@
+(ns com.tailrecursion.nanopass.clients.flow-languages
+  "Source, bound, and graph contracts for the independent flow compiler client."
+  (:require [com.tailrecursion.nanopass :as np]
+            [typed.clojure :as-alias t]))
+
+(np/deflanguage Syntax
+  {Expr (t/U (t/HMap :mandatory {:op ':int :value t/Int :note t/Any} :complete? true)
+             (t/HMap :mandatory {:op ':read :name t/Sym} :complete? true)
+             (t/HMap :mandatory {:op ':set :name t/Sym :value Expr} :complete? true)
+             (t/HMap :mandatory {:op ':plus :left Expr :right Expr} :complete? true)
+             (t/HMap :mandatory {:op ':let :binding Binding :body Expr} :complete? true)
+             (t/HMap :mandatory {:op ':if :test Expr :then Expr :else Expr} :complete? true)
+             (t/HMap :mandatory {:op ':while :test Expr :body Expr} :complete? true)
+             (t/HMap :mandatory {:op ':do :forms Exprs} :complete? true))
+   Binding (t/HMap :mandatory {:op ':binding :name t/Sym :value Expr} :complete? true)
+   Exprs (t/Vec Expr)})
+
+(np/derive-language Bound Syntax
+  {:remove {Expr #{:read :set}}
+   :add {Expr [(t/HMap :mandatory {:op ':ref :id t/Sym} :complete? true)
+               (t/HMap :mandatory {:op ':write :id t/Sym :value Expr} :complete? true)]}
+   :replace {Binding (t/HMap :mandatory {:op ':binding :id t/Sym :value Expr} :complete? true)}})
+
+(np/deflanguage Machine
+  {Operand (t/U (t/HMap :mandatory {:op ':literal :value t/Int} :complete? true)
+                (t/HMap :mandatory {:op ':register :id t/Sym} :complete? true))
+   Operation (t/U (t/HMap :mandatory {:op ':put :id t/Sym :value Operand} :complete? true)
+                  (t/HMap :mandatory {:op ':add :id t/Sym :left Operand :right Operand} :complete? true))
+   Term (t/U (t/HMap :mandatory {:op ':jump :target t/Int} :complete? true)
+             (t/HMap :mandatory {:op ':branch :test Operand :yes t/Int :no t/Int} :complete? true)
+             (t/HMap :mandatory {:op ':return :value Operand} :complete? true))
+   Block (t/HMap :mandatory {:ops (t/Vec Operation) :term Term} :complete? true)
+   Graph (t/HMap :mandatory {:entry t/Int :blocks (t/Map t/Int Block)} :complete? true)
+   Builder (t/HMap :mandatory {:next t/Int :current t/Int :next-value t/Int
+                               :ops (t/Vec Operation) :blocks (t/Map t/Int Block)} :complete? true)})
diff --git a/test/com/tailrecursion/nanopass/fixtures.clj b/test/com/tailrecursion/nanopass/fixtures.clj
new file mode 100644
index 0000000..8050f2f
--- /dev/null
+++ b/test/com/tailrecursion/nanopass/fixtures.clj
@@ -0,0 +1,29 @@
+(ns com.tailrecursion.nanopass.fixtures
+  "Small languages exercising recursive derivation without a compiler client."
+  (:require [com.tailrecursion.nanopass :as np]
+            [typed.clojure :as-alias t]))
+
+(np/deflanguage Source
+  {Expr (t/U (t/HMap :mandatory {:op ':literal :value t/Any} :complete? true)
+             (t/HMap :mandatory {:op ':read :name t/Sym} :complete? true)
+             (t/HMap :mandatory {:op ':assign :binding Binding :value Expr} :complete? true)
+             (t/HMap :mandatory {:op ':group :bindings (t/Vec Binding) :body Expr} :complete? true)
+             (t/HMap :mandatory {:op ':many :items (t/Map t/Keyword (t/Vec Expr))
+                                 :pair (t/HVec [Expr (t/Option Expr)]) :unique (t/Set Expr)}
+                     :optional {:note t/Str :child Expr :maybe (t/Option Expr)} :complete? true))
+   Binding (t/HMap :mandatory {:op ':binding :name t/Sym :value Expr} :complete? true)
+   Envelope (t/HMap :optional {:child Expr :maybe (t/Option Expr)} :complete? true)})
+
+(np/derive-language Core Source
+  {:remove {Expr #{:assign}}
+   :add {Expr [(t/HMap :mandatory {:op ':write :name t/Sym :value Expr} :complete? true)]}})
+
+(np/derive-language Literals Core
+  {:replace {Expr (t/HMap :mandatory {:op ':literal :value t/Any} :complete? true)}})
+
+(np/deflanguage Mutual
+  {A (t/HMap :mandatory {:op ':a :next (t/Option B)} :complete? true)
+   B (t/HMap :mandatory {:op ':b :next (t/Option A)} :complete? true)})
+
+(np/derive-language Stopped Mutual
+  {:replace {B (t/HMap :mandatory {:op ':stop} :complete? true)}})
diff --git a/test/com/tailrecursion/nanopass/flow_test.clj b/test/com/tailrecursion/nanopass/flow_test.clj
new file mode 100644
index 0000000..dc44246
--- /dev/null
+++ b/test/com/tailrecursion/nanopass/flow_test.clj
@@ -0,0 +1,101 @@
+(ns com.tailrecursion.nanopass.flow-test
+  "Execute a client's graphs against independent arithmetic and scope results.
+  This bounded VM is test instrumentation, not a library or Loophole backend."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.nanopass.clients.flow :as flow]))
+
+(defn number-node [n] {:op :int :value n :note '{:op :read :name opaque}})
+(defn read-node [name] {:op :read :name name})
+(defn plus [a b] {:op :plus :left a :right b})
+(defn set-node [name value] {:op :set :name name :value value})
+(defn let-node [name value body] {:op :let :binding {:op :binding :name name :value value} :body body})
+(defn forms [& nodes] {:op :do :forms (vec nodes)})
+
+(defn execute [{:keys [entry blocks]}]
+  (let [value (fn [registers operand]
+                (case (:op operand)
+                  :literal (:value operand)
+                  :register (let [id (:id operand)]
+                              (when-not (contains? registers id)
+                                (throw (ex-info "Uninitialized register" {:id id})))
+                              (get registers id))))]
+    (loop [pc entry registers {} steps 0]
+      (when (> steps 10000) (throw (ex-info "Nonterminating test graph" {:pc pc})))
+      (let [{:keys [ops term] :as block} (get blocks pc)
+            _ (when-not block (throw (ex-info "Missing block" {:pc pc})))
+            registers (reduce (fn [registers op]
+                                (assoc registers (:id op)
+                                       (case (:op op)
+                                         :put (value registers (:value op))
+                                         :add (+ (value registers (:left op)) (value registers (:right op))))))
+                              registers ops)]
+        (case (:op term)
+          :return (value registers (:value term))
+          :jump (recur (:target term) registers (inc steps))
+          :branch (recur (if (zero? (value registers (:test term))) (:no term) (:yes term))
+                         registers (inc steps)))))))
+
+(defn sum-program [n]
+  (let-node 'n (number-node n)
+    (let-node 'total (number-node 0)
+      (forms {:op :while :test (read-node 'n)
+              :body (forms (set-node 'total (plus (read-node 'total) (read-node 'n)))
+                           (set-node 'n (plus (read-node 'n) (number-node -1))))}
+             (read-node 'total)))))
+
+(deftest contextual-bindings-and-snapshots
+  (let [source (let-node 'x (number-node 7)
+                 (plus (let-node 'x (plus (read-node 'x) (number-node 1)) (read-node 'x))
+                       (read-node 'x)))
+        [supply bound] (flow/bind-expr {} 0 source)]
+    (is (= 2 supply))
+    (is (= 15 (execute (flow/compile-program source))))
+    (is (not= (get-in bound [:binding :id]) (get-in bound [:body :left :binding :id])))
+    (is (= '{:op :read :name opaque} (get-in bound [:binding :value :note]))))
+  (is (= 17 (execute (flow/compile-program
+                      (let-node 'x (number-node 7)
+                        (plus (read-node 'x) (set-node 'x (number-node 10))))))))
+  (is (thrown-with-msg? clojure.lang.ExceptionInfo #"Unbound name"
+        (flow/compile-program (read-node 'missing)))))
+
+(deftest joins-backedges-and-repeated-execution
+  (doseq [n (range 31)]
+    (let [program (sum-program n) graph (flow/compile-program program)]
+      (is (= (reduce + (range (inc n))) (execute graph) (execute graph)))
+      (is (= graph (flow/compile-program program)))))
+  (doseq [n (range 10)]
+    (let [source (let-node 'x (number-node n)
+                   (forms {:op :if :test (read-node 'x)
+                           :then (set-node 'x (plus (read-node 'x) (number-node 4)))
+                           :else (set-node 'x (number-node 19))}
+                          (read-node 'x)))]
+      (is (= (if (zero? n) 19 (+ n 4)) (execute (flow/compile-program source)))))))
+
+(defn inconvenient-program [n initial pivot bias offset]
+  (let-node 'n (number-node n)
+    (let-node 'a (number-node initial)
+      (forms
+       {:op :while :test (read-node 'n)
+        :body (forms
+               (let-node 'snapshot (read-node 'a)
+                 {:op :if :test (plus (read-node 'n) (number-node (- pivot)))
+                  :then (set-node 'a (plus (read-node 'a)
+                                           (set-node 'a (plus (read-node 'n) (number-node offset)))))
+                  :else (set-node 'a (plus (read-node 'snapshot)
+                                           (let-node 'a (read-node 'snapshot)
+                                             (set-node 'a (plus (read-node 'a) (number-node bias))))))})
+               (set-node 'n (plus (read-node 'n) (number-node -1))))}
+       (read-node 'a)))))
+
+(deftest generated-scope-and-control-combinations
+  (let [seed 271828 rng (java.util.Random. seed)]
+    (dotimes [index 250]
+      (let [n (.nextInt rng 13) initial (- (.nextInt rng 11) 5)
+            pivot (.nextInt rng 16) bias (- (.nextInt rng 7) 3) offset (- (.nextInt rng 7) 3)
+            source (inconvenient-program n initial pivot bias offset)
+            expected (loop [i n result initial]
+                       (if (zero? i) result
+                           (recur (dec i) (if (= i pivot) (+ result result bias) (+ result i offset)))))]
+        (doseq [variant [source (forms source) (let-node 'unused (number-node 999) source)]]
+          (is (= expected (execute (flow/compile-program variant)))
+              (pr-str {:seed seed :index index :input [n initial pivot bias offset]})))))))
diff --git a/test/com/tailrecursion/nanopass/language_test.clj b/test/com/tailrecursion/nanopass/language_test.clj
new file mode 100644
index 0000000..4430265
--- /dev/null
+++ b/test/com/tailrecursion/nanopass/language_test.clj
@@ -0,0 +1,55 @@
+(ns com.tailrecursion.nanopass.language-test
+  "Derivation, syntax rejection, and terminal opacity independent of the checker."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.nanopass.language :as l]
+            [com.tailrecursion.nanopass.fixtures :as f]))
+
+(defn failure [f]
+  (try (f) nil (catch clojure.lang.ExceptionInfo e (:kind (ex-data e)))))
+
+(deftest derivation
+  (is (not (contains? (loaded-libs) 'typed.clojure)))
+  (is (= #{:literal :read :assign :group :many}
+         (set (map l/tag (l/alternatives (get-in f/Source [:types 'Expr]))))))
+  (is (= #{:literal :read :write :group :many}
+         (set (map l/tag (l/alternatives (get-in f/Core [:types 'Expr]))))))
+  (is (= 'com.tailrecursion.nanopass.fixtures/Core-Expr (l/type-name f/Core 'Expr)))
+  (let [types (l/type-forms [f/Core])
+        symbols (set (filter symbol? (tree-seq coll? seq types)))]
+    (is (symbols 'com.tailrecursion.nanopass.fixtures/Core-Binding))
+    (is (not (symbols 'com.tailrecursion.nanopass.fixtures/Source-Expr))))
+  (is (= '(quote Expr) (l/instantiate f/Core '(quote Expr))))
+  (is (= '(typed.clojure/Val Expr) (l/instantiate f/Core '(typed.clojure/Val Expr))))
+  (is (= '(typed.clojure/Val {:symbol Expr})
+         (l/qualify *ns* '#{Expr} '(clojure.core.typed/Val {:symbol Expr}))))
+  (is (= '(typed.clojure/HMap :mandatory {:op (quote :binding) :name typed.clojure/Sym
+                                         :value com.tailrecursion.nanopass.fixtures/Literals-Expr}
+                            :complete? true)
+         (l/instantiate f/Literals (get-in f/Literals [:types 'Binding])))))
+
+(deftest invalid-grammars
+  (doseq [[expected form]
+          '[[:invalid-hmap (typed.clojure/HMap :mandatory {:op ':a})]
+            [:invalid-hmap (typed.clojure/HMap :mandatory {:x Expr} :optional {:x Expr} :complete? true)]
+            [:invalid-tag (typed.clojure/HMap :mandatory {:op typed.clojure/Keyword} :complete? true)]
+            [:duplicate-tag (typed.clojure/U (typed.clojure/HMap :mandatory {:op ':a} :complete? true)
+                                           (typed.clojure/HMap :mandatory {:op ':a} :complete? true))]
+            [:duplicate-tag (typed.clojure/U (typed.clojure/HMap :mandatory {:op ':a} :complete? true)
+                                           (typed.clojure/U (typed.clojure/HMap :mandatory {:op ':a} :complete? true)))]
+            [:invalid-tuple (typed.clojure/HVec [Expr] :rest Expr)]
+            [:invalid-type (typed.clojure/Map Expr)]
+            [:unsupported-recursion (typed.clojure/IFn [Expr :-> Expr])]]]
+    (is (= expected (failure #(l/language 'example/L {'Expr form}))) (pr-str form)))
+  (is (= :unknown-type (failure #(l/qualify *ns* '#{Expr} 'Missing))))
+  (is (= :unsupported-type (failure #(l/qualify *ns* '#{Expr} '(quote [Expr])))))
+  (is (= :unsupported-type (failure #(l/qualify *ns* '#{Expr} '(quote {:value Expr})))))
+  (is (= :unknown-production
+         (failure #(l/derive 'example/L f/Source '{:remove {Expr #{:absent}}})))))
+
+(deftest extension-validation
+  (doseq [[expected changes]
+          [[:invalid-extension '{:remove {Expr #{:read}} :replace {Expr typed.clojure/Any}}]
+           [:unknown-nonterminal '{:remove {Missing #{:read}}}]
+           [:invalid-extension '{:extra {}}]
+           [:duplicate-tag {:add {'Expr [(first (l/alternatives (get-in f/Source [:types 'Expr]))) ]}}]]]
+    (is (= expected (failure #(l/derive 'example/L f/Source changes))))))
diff --git a/test/com/tailrecursion/nanopass/pass_test.clj b/test/com/tailrecursion/nanopass/pass_test.clj
new file mode 100644
index 0000000..56d9de2
--- /dev/null
+++ b/test/com/tailrecursion/nanopass/pass_test.clj
@@ -0,0 +1,64 @@
+(ns com.tailrecursion.nanopass.pass-test
+  "Generated traversal must preserve structure, terminal data, and context."
+  (:require [clojure.test :refer [deftest is]]
+            [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.nanopass.passes :as p]))
+
+(deftest recursive-traversal
+  (let [literal {:op :literal :value '{:op :assign :name x}}
+        input (with-meta {:op :many :items {:a [literal {:op :read :name 'x}]}
+                          :pair [literal {:op :read :name 'x}]
+                          :unique #{{:op :read :name 'x}} :note "preserved"} {:line 42})
+        renamed (p/rename {'x 'y} (p/lower input))]
+    (is (= {:line 42} (meta renamed)))
+    (is (= "preserved" (:note renamed)))
+    (is (= literal (first (:pair renamed))))
+    (is (= 'y (get-in renamed [:items :a 1 :name])))
+    (is (= 'y (get-in renamed [:pair 1 :name])))
+    (is (= #{{:op :read :name 'y}} (:unique renamed)))
+    (is (= [8 renamed] (p/count-step 7 renamed)))
+    (is (= {:op :group :bindings [{:op :binding :name 'x
+                                  :value {:op :write :name 'x :value literal}}]
+            :body literal}
+           (p/lower {:op :group :bindings [{:op :binding :name 'x
+                                           :value {:op :assign :binding {:op :binding :name 'x :value literal}
+                                                   :value literal}}]
+                     :body literal}))))
+  (let [value {:op :many :items {} :pair [{:op :literal :value nil} nil] :unique #{}}]
+    (is (= value (p/lower value)))
+    (is (not (contains? (p/lower value) :note)))
+    (let [leaf {:op :literal :value nil}
+          assignment {:op :assign :binding {:op :binding :name 'x :value leaf} :value leaf}
+          output (p/lower (assoc value :child assignment :maybe nil))]
+      (is (= {:op :write :name 'x :value leaf} (:child output)))
+      (is (contains? output :maybe))
+      (is (nil? (:maybe output)))
+      (is (= :write (:op (:maybe (p/lower (assoc value :maybe assignment)))))))))
+
+(deftest invalid-pass-definitions
+  (doseq [[kind form]
+          '[[:missing-clause (np/defpass broken {:from [f/Source Expr] :to [f/Core Expr]
+                                               :processors {Binding lower-binding}} [node])]
+            [:missing-processor (np/defpass broken {:from [f/Core Binding] :to [f/Core Binding]} [node])]
+            [:unknown-production (np/defpass broken {:from [f/Core Binding] :to [f/Core Binding]}
+                                   [node] :absent node)]
+            [:invalid-pass (np/defpass broken {:from [f/Core Expr] :to [f/Core Expr]}
+                             [node] :read node :read node)]
+            [:invalid-pass (np/defpass broken {:from [f/Core Expr] :to [f/Core Expr] :body true}
+                             [node] node node)]
+            [:invalid-pass (np/defpass broken {:from [f/Core Expr] :to [f/Core Expr] :body :yes}
+                             [node] node)]
+            [:invalid-pass (np/defpass broken {:from [f/Core Expr]} [node] node)]]]
+    (is (= kind (binding [*ns* (the-ns 'com.tailrecursion.nanopass.passes)]
+                  (try (macroexpand-1 form) nil
+                       (catch Exception e (-> (or (ex-cause e) e) ex-data :kind)))))
+        (pr-str form))))
+
+(deftest optional-records
+  (is (= {} (p/lower-envelope {})))
+  (is (= {:maybe nil} (p/lower-envelope {:maybe nil})))
+  (let [leaf {:op :literal :value 1}
+        assignment {:op :assign :binding {:op :binding :name 'x :value leaf} :value leaf}]
+    (is (= {:child {:op :write :name 'x :value leaf}}
+           (p/lower-envelope {:child assignment}))))
+  (is (= {:line 17} (meta (p/lower-envelope (with-meta {} {:line 17}))))))
diff --git a/test/com/tailrecursion/nanopass/passes.clj b/test/com/tailrecursion/nanopass/passes.clj
new file mode 100644
index 0000000..e6eebf8
--- /dev/null
+++ b/test/com/tailrecursion/nanopass/passes.clj
@@ -0,0 +1,40 @@
+(ns ^:typed.clojure com.tailrecursion.nanopass.passes
+  "Real generated pass bodies: mutual recursion, contexts, and explicit results."
+  (:require [com.tailrecursion.nanopass :as np]
+            [com.tailrecursion.nanopass.fixtures :as f]
+            [typed.clojure :as-alias t]))
+
+(declare lower lower-binding)
+
+(np/defpass 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))})
+
+(np/defpass lower-binding {:from [f/Source Binding] :to [f/Core Binding]
+                           :processors {Expr lower}}
+  [node])
+
+(declare rename rename-binding)
+
+(np/defpass rename
+  {:from [f/Core Expr] :to [f/Core Expr] :args [(t/Map t/Sym t/Sym)]
+   :processors {Binding rename-binding}}
+  [env node]
+  :read {:op :read :name (get env (:name node) (:name node))}
+  :write {:op :write :name (get env (:name node) (:name node)) :value (rename env (:value node))})
+
+(np/defpass rename-binding
+  {:from [f/Core Binding] :to [f/Core Binding] :args [(t/Map t/Sym t/Sym)]
+   :processors {Expr rename}}
+  [env node]
+  :binding {:op :binding :name (get env (:name node) (:name node)) :value (rename env (:value node))})
+
+(np/defpass count-step
+  {:from [f/Core Expr] :to (t/HVec [t/Int f/Core-Expr]) :args [t/Int] :body true}
+  [state node]
+  [(inc state) node])
+
+(np/defpass lower-envelope
+  {:from [f/Source Envelope] :to [f/Core Envelope] :processors {Expr lower}}
+  [node])
diff --git a/test/com/tailrecursion/test_runner.clj b/test/com/tailrecursion/test_runner.clj
new file mode 100644
index 0000000..879c48d
--- /dev/null
+++ b/test/com/tailrecursion/test_runner.clj
@@ -0,0 +1,37 @@
+(ns com.tailrecursion.test-runner
+  "Run semantic and generative suites; fail the process on any failing check."
+  (:require [clojure.test :as test]))
+
+(def suites
+  '[com.tailrecursion.nanopass.language-test
+    com.tailrecursion.nanopass.pass-test
+    com.tailrecursion.nanopass.assignment-test
+    com.tailrecursion.nanopass.flow-test
+    com.tailrecursion.blacktide.machine-test
+    com.tailrecursion.blacktide.backend-test
+    com.tailrecursion.blacktide.generated-test
+    com.tailrecursion.blacktide.aot-test
+    com.tailrecursion.blacktide.package-test
+    com.tailrecursion.blacktide.graph-test
+    com.tailrecursion.blacktide.source-test
+    com.tailrecursion.blacktide.subset-test
+    com.tailrecursion.blacktide.collections-test
+    com.tailrecursion.blacktide.assignment-test
+    com.tailrecursion.blacktide.control-test
+    com.tailrecursion.blacktide.jumps-test
+    com.tailrecursion.blacktide.jvm-test
+    com.tailrecursion.blacktide.loops-test
+    com.tailrecursion.blacktide.source-loops-test
+    com.tailrecursion.blacktide.source-values-test
+    com.tailrecursion.blacktide.case-test
+    com.tailrecursion.blacktide.lookup-test
+    com.tailrecursion.blacktide.invocation-test
+    com.tailrecursion.blacktide.native-sites-test
+    com.tailrecursion.blacktide.algorithms-test])
+
+(defn -main [& selected]
+  (let [suites (if (seq selected) (mapv symbol selected) suites)]
+    (doseq [suite suites] (require suite))
+    (let [{:keys [fail error]} (apply test/run-tests suites)]
+      (shutdown-agents)
+      (when (pos? (+ fail error)) (System/exit 1)))))