diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,59 @@
 # CHANGELOG for `free-foil`
 
+# Unreleased
+
+# 0.4.0 — 2026-08-29
+
+A release about *units*: checking a module independently of its neighbours, linking the results without renaming, and storing a checked one on disk. Scope restriction, a family of $O(1)$ sinks, and a linear α-equivalence rename path come with it.
+
+Changed:
+
+- **Clients of `mkFreeFoil` must delete their own `Foil.CoSinkable` instances** for the generated binding types, since `mkFreeFoil` now generates a concrete one ([#87](https://github.com/fizruk/free-foil/pull/87), [#82](https://github.com/fizruk/free-foil/issues/82)). `SinkableK`, `HasNameBinders`, and `UnifiablePattern` remain the client's.
+
+- **`withPattern`'s continuation now also receives the scope the pattern extends to**, and so do those of `withRefreshedPattern`, `withFreshPattern`, and `withRefreshedPattern'` ([#88](https://github.com/fizruk/free-foil/pull/88), [#84](https://github.com/fizruk/free-foil/issues/84)). Add the argument, and drop the `extendScopePattern` that recomputed it.
+
+- **`mkFreeFoilConversions` now requires `Bifoldable` on each signature**, for the `tryToX` it generates. `deriveBifoldable` if a signature lacks it.
+
+- `freeVarsOf` and `freeVarsOfScopedAST` no longer repeat a variable, and return names in ascending order of their identifiers rather than in the order the term mentions them.
+
+- `rawFreshName` allocates `0` over a scope whose maximum is negative, leaving the negative range to explicit policy, and reports a scope holding `maxBound` as exhausted. Nothing changes on a scope without negative names.
+
+- `convertToAST` and `convertToScopedAST` are deprecated in favour of `unsafeConvertToAST` and `unsafeConvertToScopedAST`, and `sinkContainer` in favour of `sink1`.
+
+- `containers >= 0.6.8` is required, for `Data.IntSet.fromRange`. `binary` and `bytestring` are new dependencies, both boot libraries.
+
+New:
+
+- **Reserved name ranges, and linking.** `withFreshIn` allocates inside a `NameRange`, so units drawing from disjoint reservations cannot collide. `Control.Monad.Foil.Blocks` tracks that as `ExtWithin` evidence and links two units with `withDisjointUnion`, one sweep over their range sets. `checkExtScope` and `checkScopeUnion` re-mint it for a unit loaded from a cache, and are documented as a trust boundary ([#58](https://github.com/fizruk/free-foil/pull/58)).
+
+- **Deterministic stripes.** `Control.Monad.Foil.Registry` gives each unit its own run of the name line, `registerUnit` handing out the `StripeIndex` that every reservation for that unit is derived from. A `RegionLayout` does the same for the locals of each declaration, so an edit to one file moves no name in another ([#78](https://github.com/fizruk/free-foil/pull/78), [#80](https://github.com/fizruk/free-foil/pull/80)).
+
+- **Scope restriction.** `NameSet`, `withRestrictedScope`, `supportOf`, `withRelevantScope`, and `withThinnedNameBinderList`: a term's support, the scope it really inhabits, and a chain of binders thinned against a set of names ([#56](https://github.com/fizruk/free-foil/pull/56)).
+
+- **Serialisation.** `Control.Monad.Free.Foil.Binary` has opt-in orphan `Binary` instances for the syntax, and `Control.Monad.Free.Foil.Artifact` the checks that loading a stored unit rests on, with relocation of its constants ([#68](https://github.com/fizruk/free-foil/pull/68), [#69](https://github.com/fizruk/free-foil/pull/69)). Decoding mints scope evidence, so both are a trust boundary.
+
+- **Patterns carrying scope-indexed payloads.** `PatternTransport` is the sanctioned way to rebuild one, and the generic implementation now refuses such a pattern with a type error rather than mis-refreshing it silently ([#71](https://github.com/fizruk/free-foil/pull/71)). `Control.Monad.Foil.Telescope` is the worked example, and `unifyPatternsIn` with the new `AlphaEquiv` class lets payloads take part in α-equivalence ([#72](https://github.com/fizruk/free-foil/pull/72), [#79](https://github.com/fizruk/free-foil/pull/79)).
+
+- **Conversions that report rather than crash.** `tryConvertToAST` gives the first unresolved identifier together with what was in scope there, in one pass, and `unresolvedNames` pays a second pass for all of them ([#55](https://github.com/fizruk/free-foil/pull/55)). `tryConvertToASTWith` resolves an identifier to a whole term, for constants and abbreviations ([#57](https://github.com/fizruk/free-foil/pull/57)); `convertFromASTWith` names free and bound variables separately, which a raw name alone cannot ([#59](https://github.com/fizruk/free-foil/pull/59)); and `toXIn` and its siblings allocate within a given range, so the same source elaborates to the same term ([#60](https://github.com/fizruk/free-foil/pull/60)).
+
+- **A family of $O(1)$ sinks.** `sink1` through a `Functor` and `sink2` through a `Bifunctor`, with rewrite rules and hlint hints steering the elementwise forms towards them ([#66](https://github.com/fizruk/free-foil/pull/66)).
+
+- `nameBinderListOf`, the `Id` and `RawName` synonyms, and `mapWithName` are exported. The `restriction` and `alphaequiv` benchmarks are new.
+
+Performance:
+
+- `alphaEquiv` threads the verdict's renamings down the recursion instead of applying them, which turns a quadratic rename path linear: 353 ms to 211 µs on two α-equivalent 2000-binder chains ([#81](https://github.com/fizruk/free-foil/pull/81)).
+
+- `substitute` short-circuits the empty substitution ([#80](https://github.com/fizruk/free-foil/pull/80)).
+
+- The binder and substitution operations are `INLINABLE`, so a downstream `SPECIALIZE` reaches through them, and the free foil's `Var` unpacks its name ([#86](https://github.com/fizruk/free-foil/pull/86), [#83](https://github.com/fizruk/free-foil/issues/83)).
+
+Documentation:
+
+- Every exported entity carries a `@since`, and CI fails if a new one lacks it.
+
+- The haddocks and the READMEs are proofread. The README's documentation links pointed at a version of the GitHub Pages haddocks that no longer exists, and point at Hackage now.
+
 # 0.3.3 — 2026-07-20
 
 A bugfix and documentation release. Upgrading from 0.3.2 needs no work.
@@ -214,3 +268,5 @@
 # 0.0.1 — 2024-06-08
 
 First release, corresponding to the ICCQ 2024 paper.
+
+
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,2 +1,13 @@
 # free-foil
+
 Efficient Type-Safe Capture-Avoiding Substitution for Free (Scoped Monads).
+
+This package provides a scope-safe representation for syntax with binders. Scopes are tracked in a phantom type index, so that capture-avoidance is a property the type checker enforces rather than a discipline the programmer keeps. It builds on the foil of Maclaurin, Radul, and Paszke, extends it with patterns, and adds free scoped monads, so that substitution, α-equivalence, and conversion to and from a raw syntax are implemented once for every language whose syntax is given as a signature bifunctor.
+
+- `Control.Monad.Foil` — names, scopes, binders, and the `Sinkable`/`CoSinkable` classes.
+- `Control.Monad.Free.Foil` — the free foil: `AST binder sig n`, substitution, α-equivalence, supports, and conversions.
+- `Control.Monad.Foil.TH` and `Control.Monad.Free.Foil.TH` — Template Haskell that generates the scope-safe syntax from a raw (BNFC-generated) one.
+- `Control.Monad.Foil.Blocks` and `Control.Monad.Foil.Registry` — reserved ranges of names, for units that are checked independently and linked afterwards.
+- `Control.Monad.Free.Foil.Binary` and `Control.Monad.Free.Foil.Artifact` — serialisation of a checked unit, and the checks that loading one rests on.
+
+See the [repository README](https://github.com/fizruk/free-foil#readme) for the design and the papers behind it, and the [documentation on Hackage](https://hackage.haskell.org/package/free-foil) for the modules themselves.
diff --git a/bench/alphaequiv/Main.hs b/bench/alphaequiv/Main.hs
new file mode 100644
--- /dev/null
+++ b/bench/alphaequiv/Main.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE DeriveTraversable   #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
+
+-- | What the rename branches of 'alphaEquivScoped' cost.
+--
+-- The zipmatchk benchmark compares a term against itself, so the binders
+-- always coincide and 'unifyPatternsIn' answers 'SameNameBinders': the
+-- fast path, no renaming. This benchmark forces the other branches: @t2@
+-- is α-equivalent to @t1@ but every binder carries a different raw name
+-- (it is built under a dummy binder and then 'unsinkAST'-ed back to the
+-- empty scope), so every level takes a Rename* branch. An eager
+-- implementation materialised a renamed copy of the whole remaining body
+-- per level, which is quadratic in the depth of the chain; with the
+-- renaming threaded down the recursion, all three columns must stay
+-- linear and within a small factor of one another.
+module Main (main) where
+
+import           Data.Bifunctor.TH
+import           Data.Maybe              (fromMaybe)
+import           Test.Tasty.Bench
+
+import qualified Control.Monad.Foil      as Foil
+import           Control.Monad.Free.Foil
+import           Data.ZipMatchK.TH       (deriveZipMatchK)
+
+data LamSig scope term
+  = App term term
+  | Lam scope
+  deriving (Functor, Foldable, Traversable)
+
+deriveBifunctor ''LamSig
+deriveBifoldable ''LamSig
+deriveBitraversable ''LamSig
+deriveZipMatchK ''LamSig
+
+type Term = AST Foil.NameBinder LamSig
+
+-- | λx1. λx2. … λxn. xn, allocated in the given scope.
+chainIn :: Foil.Distinct n => Foil.Scope n -> Int -> Foil.Name n -> Term n
+chainIn _scope 0 x = Var x
+chainIn scope k _x = Foil.withFresh scope $ \binder ->
+  let scope' = Foil.extendScope binder scope
+   in Node (Lam (ScopedAST binder (chainIn scope' (k - 1) (Foil.nameOf binder))))
+
+-- | The chain over the empty scope: binders 0, 1, …, n−1.
+plain :: Int -> Term Foil.VoidS
+plain n = Foil.withFresh Foil.emptyScope $ \b0 ->
+  let scope0 = Foil.extendScope b0 Foil.emptyScope
+   in Node (Lam (ScopedAST b0 (chainIn scope0 (n - 1) (Foil.nameOf b0))))
+
+-- | The same chain built under one dummy binder and cut back down:
+-- binders 1, 2, …, n, so every level differs from 'plain' by exactly one.
+shifted :: Int -> Term Foil.VoidS
+shifted n = Foil.withFresh Foil.emptyScope $ \dummy ->
+  let scope1 = Foil.extendScope dummy Foil.emptyScope
+      t = Foil.withFresh scope1 $ \b1 ->
+            let scope2 = Foil.extendScope b1 scope1
+             in Node (Lam (ScopedAST b1 (chainIn scope2 (n - 1) (Foil.nameOf b1))))
+   in fromMaybe (error "the chain uses the dummy binder")
+        (unsinkAST Foil.emptyScope t)
+
+sized :: Int -> Benchmark
+sized n =
+  let t1 = plain n
+      t2 = shifted n
+   in if not (alphaEquiv Foil.emptyScope t1 t2)
+        then error "the two chains are not alpha-equivalent"
+        else bgroup (show n <> " nested binders")
+               [ bench "same binders (fast path)" $
+                   whnf (alphaEquiv Foil.emptyScope t1) t1
+               , bench "all binders differ (rename path)" $
+                   whnf (alphaEquiv Foil.emptyScope t1) t2
+               , bench "all binders differ, alphaEquivRefreshed" $
+                   whnf (alphaEquivRefreshed Foil.emptyScope t1) t2
+               ]
+
+main :: IO ()
+main = defaultMain [ sized n | n <- [250, 500, 1000, 2000] ]
diff --git a/bench/restriction/Main.hs b/bench/restriction/Main.hs
new file mode 100644
--- /dev/null
+++ b/bench/restriction/Main.hs
@@ -0,0 +1,160 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE DeriveTraversable   #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE PatternSynonyms     #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | Restriction benchmark: cutting a chain of binders down to the ones a term
+-- actually uses, the two ways it can be done.
+--
+-- This is the operation a parametrised module performs when it discharges a
+-- declaration over the parameters it uses, and it is where the library's
+-- account of /restriction/ is put under pressure. The question is the same
+-- either way — which of these binders can the term do without? — and there are
+-- two answers:
+--
+-- * ask once. 'supportOf' computes the term's free names in one traversal, and
+--   'Foil.withThinnedNameBinderList' cuts the chain down to that set in one
+--   step, so the term is walked once whatever the number of binders;
+--
+-- * ask per binder. 'unsinkAST' answers for one binder at a time, and each call
+--   recomputes the term's support, so the term is walked once per binder.
+--
+-- The second is the shorter thing to write, and it is what a language
+-- implementation reaches for first. The benchmark is here to say what it costs:
+-- the two should separate linearly in the number of binders, and the point at
+-- which they do is worth knowing, since a module with three parameters is the
+-- common case and one with fourteen is not unheard of.
+--
+-- Both directions report the same number, and the benchmark checks that they
+-- agree before timing them, so a change that breaks one is not silently
+-- measured against the other.
+module Main (main) where
+
+import           Data.Bifoldable         (Bifoldable (..))
+import           Data.List               (foldl')
+import           Data.List.NonEmpty      (NonEmpty (..), nonEmpty)
+import           Test.Tasty.Bench
+
+import qualified Control.Monad.Foil      as Foil
+import           Control.Monad.Free.Foil (AST (..), ScopedAST (..), pattern Var,
+                                          supportOf, unsinkAST)
+
+-- * A signature to build terms over
+
+-- | Application and λ, which is all a term needs to have free variables and
+-- binders in it.
+data LamSig scope term
+  = App term term
+  | Lam scope
+  deriving (Functor, Foldable, Traversable)
+
+instance Bifoldable LamSig where
+  bifoldMap f g = \case
+    App l r -> g l <> g r
+    Lam body -> f body
+
+-- | Terms whose binders are single names, which is what a parameter block is.
+type Term = AST Foil.NameBinder LamSig
+
+-- * The workload
+
+-- | A chain of @n@ binders over the empty scope.
+--
+-- The continuation is handed the innermost scope, the chain, and the scope
+-- before each binder, innermost first.
+withChain
+  :: forall r. Int
+  -> (forall l. Foil.Distinct l
+        => Foil.NameBinderList Foil.VoidS l -> r)
+  -> r
+withChain total cont = go total Foil.emptyScope Foil.NameBinderListEmpty
+  where
+    go :: forall i. Foil.Distinct i
+       => Int -> Foil.Scope i -> Foil.NameBinderList Foil.VoidS i -> r
+    go 0 _scope chain = cont chain
+    go k scope chain =
+      Foil.withFresh scope $ \binder ->
+        go (k - 1) (Foil.extendScope binder scope) (Foil.snocNameBinderList chain binder)
+
+-- | A term over the given names, of a size the caller controls.
+--
+-- The names are used in a left-nested application spine, repeated until the
+-- term has @uses@ leaves. Which names appear decides how far the chain can be
+-- thinned; how many leaves there are decides what a traversal of the term
+-- costs, and the two are what the benchmark varies.
+spine :: Int -> NonEmpty (Foil.Name l) -> Term l
+spine uses (first :| rest) = foldl' apply (Var first) (map Var more)
+  where
+    apply f x = Node (App f x)
+    more = take (max 0 (uses - 1)) (cycle (first : rest))
+
+-- * The two directions
+
+-- | Ask once: one 'supportOf', then one thinning.
+thinOnce :: Foil.Distinct l => Foil.NameBinderList Foil.VoidS l -> Term l -> Int
+thinOnce chain term =
+  Foil.withThinnedNameBinderList (supportOf term) chain $ \thinned ->
+    length (Foil.namesOfPattern thinned)
+
+-- | Ask per binder: peel the chain from the inside out, asking 'unsinkAST' at
+-- each binder whether the term can do without it, and abstracting over it when
+-- it cannot.
+--
+-- This is the shape the alternative really has, and the reason it costs what it
+-- costs: the term is /rebuilt/ as the peeling goes, so each 'unsinkAST' faces a
+-- different (and larger) term and has to compute its support afresh. Asking the
+-- same question about one fixed term would let the compiler share that
+-- computation, and then the two directions would be indistinguishable — which
+-- is what a first version of this benchmark measured, and why it is written out
+-- like this instead.
+askPerBinder
+  :: forall n l. Foil.Distinct n
+  => Foil.Scope n -> Foil.NameBinderList n l -> Term l -> Int
+askPerBinder scope binders term = fst (peel scope binders term)
+  where
+    peel :: forall m i. Foil.Distinct m
+         => Foil.Scope m -> Foil.NameBinderList m i -> Term i -> (Int, Term m)
+    peel _scope' Foil.NameBinderListEmpty inner = (0, inner)
+    peel scope' (Foil.NameBinderListCons binder rest) inner =
+      case (Foil.assertDistinct binder, Foil.assertExt binder) of
+        (Foil.Distinct, Foil.Ext) ->
+          let (kept, body) = peel (Foil.extendScope binder scope') rest inner
+           in case unsinkAST scope' body of
+                Just dropped -> (kept, dropped)
+                Nothing      -> (kept + 1, Node (Lam (ScopedAST binder body)))
+
+-- | Both directions, at one size, with the answers checked against each other.
+--
+-- @binders@ is how many the chain has, @keep@ how many of them the term names,
+-- and @uses@ how many leaves the term has.
+sizedBench :: Int -> Int -> Int -> Benchmark
+sizedBench binders keep uses =
+  withChain binders $ \chain ->
+    case nonEmpty (take keep (Foil.namesOfPattern chain)) of
+      Nothing -> error "a benchmark size must use at least one binder"
+      Just names ->
+        let term = spine uses names
+            once = thinOnce chain term
+            perBinder = askPerBinder Foil.emptyScope chain term
+         in if once /= perBinder
+              then error ("the two directions disagree: " <> show (once, perBinder))
+              else bgroup (show binders <> " binders, " <> show keep <> " used, "
+                            <> show uses <> " leaves")
+                     [ bench "thin once"      (whnf (thinOnce chain) term)
+                     , bench "ask per binder"
+                         (whnf (askPerBinder Foil.emptyScope chain) term)
+                     ]
+
+main :: IO ()
+main = defaultMain
+  -- The term is held at one size while the chain grows, so what separates the
+  -- two directions is the number of binders and nothing else.
+  [ bgroup "a fixed term, a growing parameter block"
+      [ sizedBench binders 2 64 | binders <- [1, 3, 7, 14, 32] ]
+  -- And the other way round: a fixed block, a growing term.
+  , bgroup "a fixed parameter block, a growing term"
+      [ sizedBench 8 2 uses | uses <- [16, 64, 256, 1024] ]
+  ]
diff --git a/free-foil.cabal b/free-foil.cabal
--- a/free-foil.cabal
+++ b/free-foil.cabal
@@ -5,7 +5,7 @@
 -- see: https://github.com/sol/hpack
 
 name:           free-foil
-version:        0.3.3
+version:        0.4.0
 synopsis:       Efficient Type-Safe Capture-Avoiding Substitution for Free (Scoped Monads)
 description:    Please see the README on GitHub at <https://github.com/fizruk/free-foil#readme>
 category:       Parsing
@@ -29,10 +29,13 @@
 library
   exposed-modules:
       Control.Monad.Foil
+      Control.Monad.Foil.Blocks
       Control.Monad.Foil.Example
       Control.Monad.Foil.Internal
       Control.Monad.Foil.Internal.ValidNameBinders
+      Control.Monad.Foil.Registry
       Control.Monad.Foil.Relative
+      Control.Monad.Foil.Telescope
       Control.Monad.Foil.TH
       Control.Monad.Foil.TH.MkFoilData
       Control.Monad.Foil.TH.MkFromFoil
@@ -41,6 +44,9 @@
       Control.Monad.Foil.TH.Util
       Control.Monad.Free.Foil
       Control.Monad.Free.Foil.Annotated
+      Control.Monad.Free.Foil.Artifact
+      Control.Monad.Free.Foil.Binary
+      Control.Monad.Free.Foil.Binary.TH
       Control.Monad.Free.Foil.Example
       Control.Monad.Free.Foil.TH
       Control.Monad.Free.Foil.TH.Convert
@@ -62,7 +68,9 @@
       array >=0.5.3.0 && <0.6
     , base >=4.19 && <5
     , bifunctors >=5.5 && <5.7
-    , containers >=0.6 && <0.9
+    , binary >=0.8
+    , bytestring >=0.11
+    , containers >=0.6.8 && <0.9
     , deepseq >=1.4 && <1.6
     , kind-generics >=0.5.0 && <0.6
     , template-haskell >=2.21.0.0 && <2.24
@@ -80,7 +88,9 @@
       array >=0.5.3.0 && <0.6
     , base >=4.19 && <5
     , bifunctors >=5.5 && <5.7
-    , containers >=0.6 && <0.9
+    , binary >=0.8
+    , bytestring >=0.11
+    , containers >=0.6.8 && <0.9
     , deepseq >=1.4 && <1.6
     , doctest-parallel
     , free-foil
@@ -93,23 +103,33 @@
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
+      Control.Monad.Foil.BlocksSpec
       Control.Monad.Foil.NameMapSpec
+      Control.Monad.Foil.NameRangeSpec
+      Control.Monad.Foil.PatternTransportSpec
+      Control.Monad.Foil.SinkableSpec
       Control.Monad.Foil.UnifiablePatternSpec
       Control.Monad.Foil.UnifyNameBindersSpec
+      Control.Monad.Free.Foil.AlphaEquivSpec
       Control.Monad.Free.Foil.AnnotatedSpec
+      Control.Monad.Free.Foil.SupportSpec
       Control.Monad.Free.Foil.TH.MkFreeFoilSpec
       Control.Monad.Free.Foil.TH.MkFreeFoilSpec.Config
       Control.Monad.Free.Foil.TH.MkFreeFoilSpec.Syntax
       Data.ZipMatchK.THSpec
+      SpecHook
       Paths_free_foil
   hs-source-dirs:
       test
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -optP-Wno-nonportable-include-path -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      array >=0.5.3.0 && <0.6
+      QuickCheck
+    , array >=0.5.3.0 && <0.6
     , base >=4.19 && <5
     , bifunctors >=5.5 && <5.7
-    , containers >=0.6 && <0.9
+    , binary >=0.8
+    , bytestring >=0.11
+    , containers
     , deepseq >=1.4 && <1.6
     , free-foil
     , hspec
@@ -120,6 +140,29 @@
     , text >=1.2.3.1 && <2.2
   default-language: Haskell2010
 
+benchmark alphaequiv
+  type: exitcode-stdio-1.0
+  main-is: Main.hs
+  other-modules:
+      Paths_free_foil
+  hs-source-dirs:
+      bench/alphaequiv
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -optP-Wno-nonportable-include-path -O2 -rtsopts
+  build-depends:
+      array >=0.5.3.0 && <0.6
+    , base >=4.19 && <5
+    , bifunctors >=5.5 && <5.7
+    , binary >=0.8
+    , bytestring >=0.11
+    , containers >=0.6.8 && <0.9
+    , deepseq >=1.4 && <1.6
+    , free-foil
+    , kind-generics >=0.5.0 && <0.6
+    , tasty-bench
+    , template-haskell >=2.21.0.0 && <2.24
+    , text >=1.2.3.1 && <2.2
+  default-language: Haskell2010
+
 benchmark normalize
   type: exitcode-stdio-1.0
   main-is: Main.hs
@@ -132,7 +175,9 @@
       array >=0.5.3.0 && <0.6
     , base >=4.19 && <5
     , bifunctors >=5.5 && <5.7
-    , containers >=0.6 && <0.9
+    , binary >=0.8
+    , bytestring >=0.11
+    , containers >=0.6.8 && <0.9
     , deepseq >=1.4 && <1.6
     , free-foil
     , kind-generics >=0.5.0 && <0.6
@@ -141,6 +186,29 @@
     , text >=1.2.3.1 && <2.2
   default-language: Haskell2010
 
+benchmark restriction
+  type: exitcode-stdio-1.0
+  main-is: Main.hs
+  other-modules:
+      Paths_free_foil
+  hs-source-dirs:
+      bench/restriction
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -optP-Wno-nonportable-include-path -O2 -rtsopts
+  build-depends:
+      array >=0.5.3.0 && <0.6
+    , base >=4.19 && <5
+    , bifunctors >=5.5 && <5.7
+    , binary >=0.8
+    , bytestring >=0.11
+    , containers >=0.6.8 && <0.9
+    , deepseq >=1.4 && <1.6
+    , free-foil
+    , kind-generics >=0.5.0 && <0.6
+    , tasty-bench
+    , template-haskell >=2.21.0.0 && <2.24
+    , text >=1.2.3.1 && <2.2
+  default-language: Haskell2010
+
 benchmark zipmatchk
   type: exitcode-stdio-1.0
   main-is: Main.hs
@@ -154,7 +222,9 @@
       array >=0.5.3.0 && <0.6
     , base >=4.19 && <5
     , bifunctors >=5.5 && <5.7
-    , containers >=0.6 && <0.9
+    , binary >=0.8
+    , bytestring >=0.11
+    , containers >=0.6.8 && <0.9
     , deepseq >=1.4 && <1.6
     , free-foil
     , kind-generics >=0.5.0 && <0.6
diff --git a/src/Control/Monad/Foil.hs b/src/Control/Monad/Foil.hs
--- a/src/Control/Monad/Foil.hs
+++ b/src/Control/Monad/Foil.hs
@@ -9,10 +9,10 @@
 -- [«Free Foil: Generating Efficient and Scope-Safe Abstract Syntax»](https://arxiv.org/abs/2405.16384).
 --
 -- Since the representation of scopes and substitutions
--- is either 'IntMap' or 'IntSet', many of the operations
+-- is either @IntMap@ or @IntSet@, many of the operations
 -- have a worst-case complexity of \(O(\min(n,W))\).
--- This means that the operation can become linear in the size of the scope \(n\) with a maximum of \(W\)
--- — the number of bits in an 'Int' (32 or 64).
+-- This means that the operation can become linear in the size of the scope \(n\) with a
+-- maximum of \(W\), the number of bits in an 'Int' (32 or 64).
 module Control.Monad.Foil (
   -- * Safe scopes, names, and binders
   S(..),
@@ -26,20 +26,51 @@
   nameOf,
   namesOfPattern,
   nameId,
+  Id,
+  RawName,
   withFreshBinder,
   withFresh,
+  NameRange(..),
+  fullNameRange,
+  withFreshIn,
+  tryWithFreshIn,
   withFreshPattern,
   withRefreshed,
+  withRefreshedIn,
   withRefreshedPattern,
   withRefreshedPattern',
   unsinkName,
   unsinkNamePattern,
+  -- * Sets of names and scope restriction
+  NameSet,
+  emptyNameSet,
+  nameSetSingleton,
+  nameSetInsert,
+  nameSetMember,
+  nameSetNull,
+  nameSetSize,
+  nameSetToList,
+  nameSetFromList,
+  nameSetOfPattern,
+  scopeToNameSet,
+  nameSetSubsetOfScope,
+  unsinkNameSet,
+  withRestrictedScope,
   -- * Safe (co)sinking and renaming
   SinkableK(..),
   Sinkable(..),
   CoSinkable(..),
+  -- ** Transporting a pattern's payloads
+  PatternTransport,
+  verbatimTransport,
+  transportUnderBinder,
+  transportPayload,
+  transportName,
   HasNameBinders(getNameBinders),
   sink,
+  sink1,
+  sink2,
+  sinkabilityProof2,
   sinkContainer,
   extendRenaming,
   extendNameBinderRenaming,
@@ -50,6 +81,7 @@
   Substitution,
   lookupSubst,
   identitySubst,
+  nullSubst,
   voidSubst,
   addSubst,
   addSubstPattern,
@@ -62,6 +94,7 @@
   andThenUnifyNameBinders,
   UnifiablePattern(..),
   UnifiableInPattern(..),
+  AlphaEquiv(..),
   NameBinders,
   emptyNameBinders,
   mergeNameBinders,
@@ -70,6 +103,7 @@
   -- * Name maps
   NameMap,
   emptyNameMap,
+  mapWithName,
   lookupName,
   addNameBinder,
   popNameBinder,
@@ -78,11 +112,14 @@
   addNameBinders,
   addNameBinderList,
   withFreshNameBinderList,
+  withFreshNameBinderListIn,
   NameBinderList(..),
   nameBindersList,
+  nameBinderListOf,
   fromNameBindersList,
   snocNameBinderList,
   concatNameBinderLists,
+  withThinnedNameBinderList,
   -- * Constraints
   Ext,
   ExtEvidence(..),
diff --git a/src/Control/Monad/Foil/Blocks.hs b/src/Control/Monad/Foil/Blocks.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Foil/Blocks.hs
@@ -0,0 +1,396 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE KindSignatures      #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
+
+-- | Reserved name blocks, and linking of independently checked scopes.
+--
+-- Each unit of a module system allocates its names inside its own
+-- reservation (a 'NameRange', via 'withFreshIn'), so that units checked
+-- independently can be linked afterwards without renaming. 'ExtWithin' is
+-- the evidence for that: scope @l@ extends scope @n@ only within a set of
+-- reserved ranges. Note that the ranges bound the /extension/ and not the
+-- scope, so the names of @n@ itself (typically, a unit's imports) may lie
+-- anywhere.
+--
+-- Two units that extend a common scope within disjoint reservations have
+-- disjoint extensions. 'withDisjointUnion' links them by comparing the
+-- reservations rather than the scopes, and hands the continuation the
+-- extension evidence for both sides, a 'ScopeUnion' witness that the result
+-- is the union and nothing more, and the union's own evidence, so that a
+-- linked unit is itself linkable. Evidence composes along a chain of units
+-- with 'composeExtWithin'. To link more than two units, or to re-attach a
+-- unit loaded from a cache, rebuild the union scope and mint the evidence
+-- again with 'checkExtScope' and 'checkScopeUnion'.
+--
+-- 'checkExtScope' and 'checkScopeUnion' are a trust boundary. They compare
+-- raw names across independently built scopes, which is meaningful only
+-- under a deterministic reservation policy. Everything else in this module
+-- either tests what it claims or constructs it.
+module Control.Monad.Foil.Blocks (
+  -- * Extension-within-a-range evidence
+  ExtWithin,
+  extWithinRanges,
+  extWithinRefl,
+  extWithinStep,
+  composeExtWithin,
+  -- * Blocks in use
+  Block,
+  beginBlock,
+  resumeBlock,
+  blockRange,
+  blockExt,
+  withFreshInBlock,
+  -- * Bulk extension of a scope by a range
+  withExtendScopeRange,
+  -- * Linking
+  ScopeUnion,
+  withDisjointUnion,
+  checkScopeUnion,
+  checkExtScope,
+  unionNameMaps,
+) where
+
+import           Data.List                   (sortOn)
+import qualified Data.IntMap                 as IntMap
+import qualified Data.IntSet                 as IntSet
+import           Unsafe.Coerce               (unsafeCoerce)
+
+import           Control.Monad.Foil.Internal
+
+-- $setup
+-- >>> :set -XDataKinds
+-- >>> :set -XFlexibleContexts
+-- >>> import Control.Monad.Foil.Internal
+
+-- | Evidence that scope @l@ extends scope @n@ only within a set of reserved
+-- ranges: every name of @l@ that is not a name of @n@ lies inside one of
+-- them.
+--
+-- The evidence is built alongside allocation, with 'extWithinRefl' at the
+-- start of a unit and 'extWithinStep' at each binder, and composes along a
+-- chain of scopes with 'composeExtWithin'. Its runtime content is the
+-- ranges, sorted and disjoint.
+--
+-- @since 0.4.0
+data ExtWithin (n :: S) (l :: S) = UnsafeExtWithin [NameRange]
+
+-- | The reservations an 'ExtWithin' is evidence about: sorted, disjoint,
+-- adjacent ranges coalesced, empty ones dropped.
+--
+-- @since 0.4.0
+extWithinRanges :: ExtWithin n l -> [NameRange]
+extWithinRanges (UnsafeExtWithin ranges) = ranges
+
+-- | A scope extends itself within any range: the extension is empty.
+--
+-- Note that this does /not/ say the range is disjoint from the scope. It is
+-- 'withExtendScopeRange' that checks that, because it allocates blindly.
+--
+-- @since 0.4.0
+extWithinRefl :: NameRange -> ExtWithin n n
+extWithinRefl range = UnsafeExtWithin (normaliseRanges [range])
+
+-- | Extend the evidence across one more binder, if its name lies inside one
+-- of the ranges. One membership test per range.
+--
+-- A binder allocated by 'withFreshIn' at one of these ranges always passes.
+-- A binder allocated elsewhere, by 'withFresh' or 'withRefreshed', is
+-- rejected with 'Nothing' unless it happens to land inside them, so the
+-- evidence cannot be extended past a name that escapes the reservations.
+--
+-- >>> let range = NameRange 100 199
+-- >>> withFreshIn range emptyScope (\b -> fmap extWithinRanges (extWithinStep b (extWithinRefl range)))
+-- Just [NameRange {nameRangeLo = 100, nameRangeHi = 199}]
+--
+-- @since 0.4.0
+extWithinStep :: NameBinder l l' -> ExtWithin n l -> Maybe (ExtWithin n l')
+extWithinStep binder (UnsafeExtWithin ranges)
+  | any (\(NameRange lo hi) -> lo <= x && x <= hi) ranges = Just (UnsafeExtWithin ranges)
+  | otherwise = Nothing
+  where
+    x = nameId (nameOf binder)
+
+-- | Compose evidence along a chain of scopes: if @m@ extends @n@ only within
+-- one set of ranges and @l@ extends @m@ only within another, then @l@
+-- extends @n@ only within their union.
+--
+-- The bound is the union of the two sets and not their hull, so a
+-- reservation lying between them stays linkable. Adjacent ranges are
+-- coalesced, so a chain of units with consecutive stripes collapses back to
+-- a single range.
+--
+-- >>> extWithinRanges (composeExtWithin (extWithinRefl (NameRange 0 9)) (extWithinRefl (NameRange 30 39)))
+-- [NameRange {nameRangeLo = 0, nameRangeHi = 9},NameRange {nameRangeLo = 30, nameRangeHi = 39}]
+-- >>> extWithinRanges (composeExtWithin (extWithinRefl (NameRange 0 9)) (extWithinRefl (NameRange 10 19)))
+-- [NameRange {nameRangeLo = 0, nameRangeHi = 19}]
+--
+-- @since 0.4.0
+composeExtWithin :: ExtWithin n m -> ExtWithin m l -> ExtWithin n l
+composeExtWithin (UnsafeExtWithin rs1) (UnsafeExtWithin rs2) =
+  UnsafeExtWithin (normaliseRanges (rs1 <> rs2))
+
+-- | Sort ranges, drop empty ones, and coalesce overlapping or adjacent ones.
+normaliseRanges :: [NameRange] -> [NameRange]
+normaliseRanges = go . sortOn nameRangeLo . filter nonEmpty
+  where
+    nonEmpty (NameRange lo hi) = lo <= hi
+    go (NameRange lo1 hi1 : r2@(NameRange lo2 hi2) : rs)
+      | lo2 <= hi1                      = go (NameRange lo1 (max hi1 hi2) : rs)
+      | hi1 /= maxBound, lo2 == hi1 + 1 = go (NameRange lo1 hi2 : rs)
+      | otherwise = NameRange lo1 hi1 : go (r2 : rs)
+    go rs = rs
+
+-- | Whether two sorted sets of disjoint ranges share a name. One sweep.
+rangeSetsOverlap :: [NameRange] -> [NameRange] -> Bool
+rangeSetsOverlap (r1@(NameRange lo1 hi1) : rs1) (r2@(NameRange lo2 hi2) : rs2)
+  | hi1 < lo2 = rangeSetsOverlap rs1 (r2 : rs2)
+  | hi2 < lo1 = rangeSetsOverlap (r1 : rs1) rs2
+  | otherwise = True
+rangeSetsOverlap _ _ = False
+
+-- | A reservation in use: the range fresh names are allocated from, paired
+-- with the evidence that everything allocated since the base scope @c@ lies
+-- within the unit's ranges.
+--
+-- The allocation range is always among the evidence's ranges, so stepping
+-- the evidence at a freshly allocated name cannot fail and 'withFreshInBlock'
+-- is total. The two components are not redundant: the evidence is a
+-- normalised set bounding the whole extension, and once units are composed
+-- the range to allocate from can no longer be read off it.
+--
+-- @since 0.0.1
+data Block (c :: S) (l :: S) = UnsafeBlock !NameRange (ExtWithin c l)
+
+-- | Start a unit: no names allocated yet, so the evidence is trivial.
+--
+-- @since 0.4.0
+beginBlock :: NameRange -> Block c c
+beginBlock range = UnsafeBlock range (extWithinRefl range)
+
+-- | Resume allocating from a range once the evidence has grown past what a
+-- 'Block' tracked by itself, after composing in a loaded unit's evidence
+-- with 'composeExtWithin'. This is what lets an interactive unit keep
+-- allocating in its own reservation over the enlarged scope.
+--
+-- The allocation range must lie inside one of the evidence's ranges. The
+-- ranges are normalised, so covering is containment in a single one, and
+-- 'Nothing' says the range is not covered.
+--
+-- >>> let grown = composeExtWithin (extWithinRefl (NameRange 0 9)) (extWithinRefl (NameRange 10 19))
+-- >>> fmap blockRange (resumeBlock (NameRange 0 9) grown)
+-- Just (NameRange {nameRangeLo = 0, nameRangeHi = 9})
+-- >>> fmap blockRange (resumeBlock (NameRange 30 39) grown)
+-- Nothing
+--
+-- @since 0.4.0
+resumeBlock :: NameRange -> ExtWithin c l -> Maybe (Block c l)
+resumeBlock range@(NameRange lo hi) ext
+  | lo > hi = Nothing
+  | any covers (extWithinRanges ext) = Just (UnsafeBlock range ext)
+  | otherwise = Nothing
+  where
+    covers (NameRange lo' hi') = lo' <= lo && hi <= hi'
+
+-- | The range 'withFreshInBlock' allocates from.
+--
+-- @since 0.4.0
+blockRange :: Block c l -> NameRange
+blockRange (UnsafeBlock range _) = range
+
+-- | The evidence accumulated so far: what a finished unit hands to
+-- 'withDisjointUnion', or to 'composeExtWithin' for the next unit of a
+-- chain.
+--
+-- @since 0.4.0
+blockExt :: Block c l -> ExtWithin c l
+blockExt (UnsafeBlock _ ext) = ext
+
+-- | Allocate a fresh name in the block's range, stepping the evidence in
+-- the same motion. Fails with 'error' only on an exhausted range, exactly
+-- as 'withFreshIn' does.
+--
+-- >>> withFreshInBlock (beginBlock (NameRange 7 9)) emptyScope (\b block -> (nameId (nameOf b), extWithinRanges (blockExt block)))
+-- (7,[NameRange {nameRangeLo = 7, nameRangeHi = 9}])
+--
+-- @since 0.4.0
+withFreshInBlock
+  :: Distinct l
+  => Block c l  -- ^ The block to allocate from.
+  -> Scope l    -- ^ The ambient scope.
+  -> (forall l'. DExt l l' => NameBinder l l' -> Block c l' -> r)
+  -> r
+withFreshInBlock (UnsafeBlock range ext) scope cont =
+  withFreshIn range scope $ \binder ->
+    case extWithinStep binder ext of
+      Just ext' -> cont binder (UnsafeBlock range ext')
+      Nothing   -> error "impossible: withFreshIn allocated outside its own range"
+
+-- | Extend a scope with the first @k@ names of a range, in one step.
+--
+-- This is the bulk form of a unit's allocation, for loading a cached unit
+-- whose extension is known to be @k@ consecutive names, or for pre-allocating
+-- a unit's names before checking its bodies. The range part of the scope must
+-- be empty, which is checked, so the extension is fresh by construction.
+-- 'Nothing' reports an occupied range, and also a range with fewer than @k@
+-- names.
+--
+-- The continuation receives the extended scope, the binders in ascending
+-- order (for extending a 'NameMap' in the same step), and the 'ExtWithin'
+-- evidence. The scope extension is a dense 'IntSet.fromRange', \(O(k/W)\).
+--
+-- >>> withExtendScopeRange emptyScope (NameRange 100 199) 3 (\_ binders _ -> rawNameBinderList binders)
+-- Just [100,101,102]
+--
+-- @since 0.4.0
+withExtendScopeRange
+  :: forall c r. Distinct c
+  => Scope c      -- ^ The scope to extend (typically, a unit's imports).
+  -> NameRange    -- ^ The unit's reservation.
+  -> Int          -- ^ How many names to allocate.
+  -> (forall n. DExt c n => Scope n -> NameBinderList c n -> ExtWithin c n -> r)
+  -> Maybe r
+withExtendScopeRange (UnsafeScope scope) range@(NameRange lo hi) k cont
+  | k < 0                        = Nothing
+  | rangeOccupied                = Nothing
+  | toInteger k > rangeCapacity  = Nothing
+  | otherwise =
+      Just (unsafeExtendedWithin (UnsafeScope scope') binders (UnsafeExtWithin (normaliseRanges [range])) cont)
+  where
+    rangeOccupied = case IntSet.lookupGE lo scope of
+      Just y  -> y <= hi
+      Nothing -> False
+    rangeCapacity = max 0 (toInteger hi - toInteger lo + 1)
+    scope'
+      | k == 0    = scope
+      | otherwise = IntSet.union scope (IntSet.fromRange (lo, lo + (k - 1)))
+    binders :: forall n. NameBinderList c n
+    binders = go (if k == 0 then [] else [lo .. lo + (k - 1)])
+      where
+        go :: forall m m'. [RawName] -> NameBinderList m m'
+        go []       = unsafeCoerce NameBinderListEmpty
+        go (x : xs) = NameBinderListCons (UnsafeNameBinder (UnsafeName x)) (go xs)
+
+-- | Unsafely mint the evidence for an extension built by this module.
+--
+-- Sound when the scope really is the given base extended by the binders, and
+-- the binders' names lie inside the evidence's range and are fresh in the
+-- base. The callers here check or construct all three.
+unsafeExtendedWithin
+  :: forall c n r
+   . Scope n -> NameBinderList c n -> ExtWithin c n
+  -> (DExt c n => Scope n -> NameBinderList c n -> ExtWithin c n -> r)
+  -> r
+unsafeExtendedWithin scope binders ext cont =
+  case unsafeDistinct @n of
+    Distinct -> case unsafeExt @c @n of
+      Ext -> cont scope binders ext
+
+-- | Link two scopes that extend a common scope @c@ within their respective
+-- reservations. The evidence check is one sweep over the two range sets;
+-- the scope union is one 'IntSet.union'.
+--
+-- 'Nothing' when the two range sets overlap. The test is soundness and not
+-- an optimisation. The extensions @n \\ c@ and @m \\ c@ lie inside their
+-- respective range sets, so their disjointness is what guarantees that no
+-- raw name denotes two different variables in the union. The names the two
+-- scopes share are exactly the names of @c@, identified rather than renamed
+-- apart, which is what linking two units over a common import must do.
+--
+-- The continuation receives both extension facts at once, a 'ScopeUnion'
+-- witness (which 'unionNameMaps' requires), and the union's own 'ExtWithin',
+-- so that a linked unit is itself linkable and a whole build folds through
+-- this one function. It also receives @'Ext' c k@, which a caller cannot
+-- derive on the spot.
+--
+-- @since 0.4.0
+withDisjointUnion
+  :: forall c n m r. (Distinct n, Distinct m)
+  => ExtWithin c n  -- ^ Evidence for the first unit.
+  -> ExtWithin c m  -- ^ Evidence for the second unit.
+  -> Scope n        -- ^ The first unit's scope.
+  -> Scope m        -- ^ The second unit's scope.
+  -> (forall k. (Ext n k, Ext m k, Ext c k, Distinct k)
+        => Scope k -> ScopeUnion n m k -> ExtWithin c k -> r)
+  -> Maybe r
+withDisjointUnion (UnsafeExtWithin rs1) (UnsafeExtWithin rs2) (UnsafeScope s1) (UnsafeScope s2) cont
+  | rangeSetsOverlap rs1 rs2 = Nothing
+  | otherwise           = Just (unsafeUnion (UnsafeScope (IntSet.union s1 s2)))
+  where
+    unsafeUnion :: forall k. Scope k -> r
+    unsafeUnion scope =
+      case unsafeDistinct @k of
+        Distinct -> case unsafeExt @n @k of
+          Ext -> case unsafeExt @m @k of
+            Ext -> case unsafeExt @c @k of
+              -- Each side extends the base within its own ranges, so the
+              -- names of c are in n and in m, hence in the union. This is
+              -- handed to the continuation as a given because deriving it
+              -- from Ext c n and Ext n k leaves the solver two candidate
+              -- paths and it commits to neither.
+              Ext -> cont scope UnsafeScopeUnion
+                          (UnsafeExtWithin (normaliseRanges (rs1 <> rs2)))
+
+-- | Evidence that scope @k@ is /precisely/ the union of scopes @n@ and @m@:
+-- every name of @n@ and of @m@ is a name of @k@, and nothing else is.
+--
+-- The extension constraints @('Ext' n k, 'Ext' m k)@ state only the first
+-- half, since a strict superset of the union satisfies them too. The second
+-- half is what totality of a merged 'NameMap' rests on, so 'unionNameMaps'
+-- demands this witness. It comes from 'withDisjointUnion', which builds the
+-- union, or from 'checkScopeUnion', which tests for it.
+--
+-- @since 0.4.0
+data ScopeUnion (n :: S) (m :: S) (k :: S) = UnsafeScopeUnion
+
+-- | Test that a scope is precisely the union of two others, and produce the
+-- witness if so. \(O(n+m)\).
+--
+-- This is the union witness for the re-attachment path, where the union
+-- scope was rebuilt rather than handed down by 'withDisjointUnion'. Like
+-- 'checkExtScope', it compares raw names across independently built scopes,
+-- and is meaningful only under a deterministic reservation policy.
+--
+-- @since 0.4.0
+checkScopeUnion :: Scope n -> Scope m -> Scope k -> Maybe (ScopeUnion n m k)
+checkScopeUnion (UnsafeScope s1) (UnsafeScope s2) (UnsafeScope s3)
+  | IntSet.union s1 s2 == s3 = Just UnsafeScopeUnion
+  | otherwise                = Nothing
+
+-- | Test that every name of one scope is a name of another, and mint the
+-- extension evidence if so. \(O(n+m)\) ('IntSet.isSubsetOf').
+--
+-- __This is a trust boundary.__ The test compares raw names, and raw names
+-- from independently built scopes need not mean the same variable. The type
+-- system tracks meaning through binders, and this function goes around it
+-- deliberately, to re-attach a scope built elsewhere: in an earlier run, in
+-- a cache, or in a parallel session. It is sound only under the external
+-- discipline that a raw name has one global meaning, which a deterministic
+-- reservation policy provides. Nothing here checks that discipline, and the
+-- caller's allocator is what has to.
+--
+-- @since 0.4.0
+checkExtScope :: Scope n -> Scope l -> Maybe (ExtEvidence n l)
+checkExtScope (UnsafeScope s1) (UnsafeScope s2)
+  | s1 `IntSet.isSubsetOf` s2 = Just unsafeExt
+  | otherwise                 = Nothing
+
+-- | Union of two total maps into a map on the union of their scopes.
+-- Left-biased, like 'IntMap.union'.
+--
+-- The witness is what makes the result total on @k@. The inputs are total on
+-- @n@ and @m@, and 'ScopeUnion' says that @k@ holds their names and no
+-- others. (It also determines @k@, which an extension constraint alone would
+-- leave open.)
+--
+-- What no witness can say is that the two maps agree on the names their
+-- scopes share. Linked units agree there when the shared part comes from the
+-- same checked imports, and the left bias then only ever chooses between
+-- equal entries.
+--
+-- @since 0.4.0
+unionNameMaps :: ScopeUnion n m k -> NameMap n a -> NameMap m a -> NameMap k a
+unionNameMaps UnsafeScopeUnion (NameMap m1) (NameMap m2) = NameMap (IntMap.union m1 m2)
diff --git a/src/Control/Monad/Foil/Example.hs b/src/Control/Monad/Foil/Example.hs
--- a/src/Control/Monad/Foil/Example.hs
+++ b/src/Control/Monad/Foil/Example.hs
@@ -14,6 +14,8 @@
 -- >>> import Control.Monad.Foil
 
 -- | Untyped \(\lambda\)-terms in scope @n@.
+--
+-- @since 0.0.1
 data Expr n where
   -- | Variables are names in scope @n@: \(x\)
   VarE :: Name n -> Expr n
@@ -59,6 +61,8 @@
 
 -- | Substitution for untyped \(\lambda\)-terms.
 -- The foil helps implement this function without forgetting scope extensions and renaming.
+--
+-- @since 0.0.1
 substitute :: Distinct o => Scope o -> Substitution Expr i o -> Expr i -> Expr o
 substitute scope subst = \case
     VarE name -> lookupSubst subst name
@@ -73,6 +77,8 @@
 --
 -- >>> whnf emptyScope (AppE (churchN 2) (churchN 2))
 -- λx1. (λx0. λx1. (x0 (x0 x1)) (λx0. λx1. (x0 (x0 x1)) x1))
+--
+-- @since 0.0.1
 whnf :: Distinct n => Scope n -> Expr n -> Expr n
 whnf scope = \case
   AppE fun arg ->
@@ -87,6 +93,8 @@
 --
 -- >>> whnf' (AppE (churchN 2) (churchN 2))
 -- λx1. (λx0. λx1. (x0 (x0 x1)) (λx0. λx1. (x0 (x0 x1)) x1))
+--
+-- @since 0.0.1
 whnf' :: Expr VoidS -> Expr VoidS
 whnf' = whnf emptyScope
 
@@ -94,6 +102,8 @@
 --
 -- >>> nf emptyScope (AppE (churchN 2) (churchN 2))
 -- λx1. λx2. (x1 (x1 (x1 (x1 x2))))
+--
+-- @since 0.0.1
 nf :: Distinct n => Scope n -> Expr n -> Expr n
 nf scope expr = case expr of
   LamE binder body ->
@@ -116,10 +126,14 @@
 --
 -- >>> nf' (AppE (churchN 2) (churchN 2))
 -- λx1. λx2. (x1 (x1 (x1 (x1 x2))))
+--
+-- @since 0.0.1
 nf' :: Expr VoidS -> Expr VoidS
 nf' = nf emptyScope
 
 -- | Pretty print a name.
+--
+-- @since 0.0.1
 ppName :: Name n -> String
 ppName name = "x" <> show (nameId name)
 
@@ -127,6 +141,8 @@
 --
 -- >>> ppExpr (churchN 3)
 -- "\955x0. \955x1. (x0 (x0 (x0 x1)))"
+--
+-- @since 0.0.1
 ppExpr :: Expr n -> String
 ppExpr = \case
   VarE name -> ppName name
@@ -134,6 +150,8 @@
   LamE binder body -> "λ" <> ppName (nameOf binder) <> ". " <> ppExpr body
 
 -- | A helper for constructing \(\lambda\)-abstractions.
+--
+-- @since 0.0.1
 lam :: Distinct n => Scope n -> (forall l. DExt n l => Scope l -> NameBinder n l -> Expr l) -> Expr n
 lam scope mkBody = withFresh scope $ \x ->
   let scope' = extendScope x scope
@@ -146,6 +164,8 @@
 --
 -- >>> churchN 3
 -- λx0. λx1. (x0 (x0 (x0 x1)))
+--
+-- @since 0.0.1
 churchN :: Int -> Expr VoidS
 churchN n =
   lam emptyScope $ \sx nx ->
diff --git a/src/Control/Monad/Foil/Internal.hs b/src/Control/Monad/Foil/Internal.hs
--- a/src/Control/Monad/Foil/Internal.hs
+++ b/src/Control/Monad/Foil/Internal.hs
@@ -39,1422 +39,2386 @@
 -- [«Free Foil: Generating Efficient and Scope-Safe Abstract Syntax»](https://arxiv.org/abs/2405.16384).
 --
 -- Since the representation of scopes and substitutions
--- is either 'IntMap' or 'IntSet', many of the operations
--- have a worst-case complexity of \(O(\min(n,W))\).
--- This means that the operation can become linear in the size of the scope \(n\) with a maximum of \(W\)
--- — the number of bits in an 'Int' (32 or 64).
-module Control.Monad.Foil.Internal where
-
-import           Control.DeepSeq    (NFData (..))
-import           Data.Bifunctor
-import           Data.Coerce        (coerce)
-import           Data.Functor.Compose (Compose (..))
-import           Data.IntMap
-import qualified Data.IntMap        as IntMap
-import           Data.IntSet
-import qualified Data.IntSet        as IntSet
-import           Data.Kind          (Type)
-import qualified Data.Type.Equality as Type
-import           Generics.Kind
-import           Unsafe.Coerce
-
-import Control.Monad.Foil.Internal.ValidNameBinders
-
--- $setup
--- >>> :set -XDataKinds
--- >>> :set -XFlexibleContexts
--- >>> :set -Wno-simplifiable-class-constraints
--- >>> import qualified Data.Map as Map
-
--- * Safe types and operations
-
--- | 'S' is a data kind of scope indices.
-data S
-  = VoidS -- ^ 'VoidS' is the only explicit scope available to the users, representing an empty scope.
-          -- All other scopes are represented with type variables,
-          -- bound in rank-2 polymophic functions like 'withFreshBinder'.
-
--- | A safe scope, indexed by a type-level scope index 'n'.
-newtype Scope (n :: S) = UnsafeScope RawScope
-  deriving newtype NFData
-
--- | A name in a safe scope, indexed by a type-level scope index 'n'.
-newtype Name (n :: S) = UnsafeName RawName
-  deriving newtype (NFData, Eq, Ord, Show)
-
--- | Convert 'Name' into an identifier.
--- This may be useful for printing and debugging.
-nameId :: Name l -> Id
-nameId (UnsafeName i) = i
-
--- | A name binder is a name that extends scope @n@ to a (larger) scope @l@.
-newtype NameBinder (n :: S) (l :: S) =
-  UnsafeNameBinder (Name l)
-    deriving newtype (NFData, Eq, Ord, Show)
-
--- | An empty scope (without any names).
-emptyScope :: Scope VoidS
-emptyScope = UnsafeScope IntSet.empty
-
--- | A runtime check for potential name capture.
-member :: Name l -> Scope n -> Bool
-member (UnsafeName name) (UnsafeScope s) = rawMember name s
-
--- ** Extending scopes
-
--- | \(O(\min(n,W))\).
--- Extend a scope with one name (safely).
--- Note that as long as the foil is used as intended,
--- the name binder is guaranteed to introduce a name
--- that does not appear in the initial scope.
-extendScope :: NameBinder n l -> Scope n -> Scope l
-extendScope (UnsafeNameBinder (UnsafeName name)) (UnsafeScope scope) =
-  UnsafeScope (IntSet.insert name scope)
-
--- | Extend scope with variables inside a pattern.
--- This is a more flexible version of 'extendScope'.
-extendScopePattern
-  :: (Distinct n, CoSinkable pattern)
-  => pattern n l -> Scope n -> Scope l
-extendScopePattern pat scope = withPattern
-  (\_scope' binder k ->
-    unsafeAssertFresh binder $ \binder' ->
-      k (ExtendScope (extendScope binder)) binder')
-  idExtendScope
-  compExtendScope
-  scope
-  pat
-  (\(ExtendScope extend) _ -> extend scope)
-
--- | Auxiliary data structure for scope extension. Used in 'extendScopePattern'.
-newtype ExtendScope n l (o :: S) (o' :: S) = ExtendScope (Scope n -> Scope l)
-
--- | Identity scope extension (no extension).
-idExtendScope :: ExtendScope n n o o'
-idExtendScope = ExtendScope id
-
--- | Compose scope extensions.
-compExtendScope
-  :: ExtendScope n i o o'
-  -> ExtendScope i l o' o''
-  -> ExtendScope n l o o''
-compExtendScope (ExtendScope f) (ExtendScope g)
-  = ExtendScope (g . f)
-
--- ** Collecting new names
-
--- | Extract name from a name binder.
-nameOf :: NameBinder n l -> Name l
-nameOf (UnsafeNameBinder name) = name
-
--- | Extract names from a pattern.
--- This is a more flexible version of 'namesOf'.
-namesOfPattern
-  :: forall pattern n l. (Distinct n, CoSinkable pattern) => pattern n l -> [Name l]
-namesOfPattern pat = withPattern @_ @n
-  (\_scope' binder k ->
-    unsafeAssertFresh binder $ \binder' ->
-      k (NamesOf [nameOf binder]) binder')
-  idNamesOf compNamesOf (error "impossible") pat
-  (\(NamesOf names) _ -> names)
-
--- | Auxiliary structure collecting names in scope @l@ that extend scope @n@.
--- Used in 'namesOfPattern'.
-newtype NamesOf (n :: S) l (o :: S) (o' :: S) = NamesOf [Name l]
-
--- | Empty list of names in scope @n@.
-idNamesOf :: NamesOf n n o o'
-idNamesOf = NamesOf []
-
--- | Concatenation of names, resulting in a list of names in @l@ that extend scope @n@.
-compNamesOf :: NamesOf n i o o' -> NamesOf i l o' o'' -> NamesOf n l o o''
-compNamesOf (NamesOf xs) (NamesOf ys) =
-  NamesOf (coerce xs ++ ys)
-
--- ** Refreshing binders
-
--- | Allocate a fresh binder for a given scope.
-withFreshBinder
-  :: Scope n
-  -> (forall l. NameBinder n l -> r) -> r
-withFreshBinder (UnsafeScope scope) cont =
-  cont binder
-  where
-    binder = UnsafeNameBinder (UnsafeName (rawFreshName scope))
-
--- | Safely produce a fresh name binder with respect to a given scope.
-withFresh
-  :: Distinct n => Scope n
-  -> (forall l. DExt n l => NameBinder n l -> r) -> r
-withFresh scope cont = withFreshBinder scope (`unsafeAssertFresh` cont)
-
--- | Rename a given pattern into a fresh version of it to extend a given scope.
---
--- This is similar to 'withRefreshPattern', except here renaming always takes place.
-withFreshPattern
-  :: (Distinct o, CoSinkable pattern, Sinkable e, InjectName e)
-  => Scope o      -- ^ Ambient scope.
-  -> pattern n l  -- ^ Pattern to refresh (if it clashes with the ambient scope).
-  -> (forall o'. DExt o o' => (Substitution e n o -> Substitution e l o') -> pattern o o' -> r)
-  -- ^ Continuation, accepting the refreshed pattern.
-  -> r
-withFreshPattern scope pattern cont = withPattern
-  (\scope' binder f -> withFresh scope'
-    (\binder' -> f (WithRefreshedPattern (\subst -> addRename (sink subst) binder (nameOf binder'))) binder'))
-  idWithRefreshedPattern
-  compWithRefreshedPattern
-  scope
-  pattern
-  (\(WithRefreshedPattern f) pattern' -> cont f pattern')
-
--- | Safely rename (if necessary) a given name to extend a given scope.
--- This is similar to 'withFresh', except if the name does not clash with
--- the scope, it can be used immediately, without renaming.
-withRefreshed
-  :: Distinct o
-  => Scope o    -- ^ Ambient scope.
-  -> Name i     -- ^ Name to refresh (if it clashes with the ambient scope).
-  -> (forall o'. DExt o o' => NameBinder o o' -> r)
-  -- ^ Continuation, accepting the refreshed name.
-  -> r
-withRefreshed scope@(UnsafeScope rawScope) name@(UnsafeName rawName) cont
-  | IntSet.member rawName rawScope = withFresh scope cont
-  | otherwise = unsafeAssertFresh (UnsafeNameBinder name) cont
-
--- | Safely rename (if necessary) a given pattern to extend a given scope.
--- This is similar to 'withFreshPattern', except if a name in the pattern
--- does not clash with the scope, it can be used immediately, without renaming.
---
--- This is a more general version of 'withRefreshed'.
---
--- Note that there is deliberately no fast path for the case when /every/ binder
--- of the pattern is already fresh in the ambient scope. It is tempting to test
--- all binders at once and, when none clashes, hand the continuation @sink@
--- instead of a renaming composed per binder. That would be unsound.
---
--- Even when a binder is not renamed, the per-binder step is not the identity:
--- 'addRename' /deletes/ the name from the substitution, which is how the binder
--- shadows an outer binding of the same raw name. For skipping that delete to be
--- harmless we would need the substitution's domain to avoid the pattern's binder
--- names, but the substitution's domain lives in the pattern's own scope @n@,
--- while freshness is tested against the unrelated ambient scope @o@.
---
--- The two can indeed disagree, because 'sink' is a coercion and does not rename:
--- a term built in a small scope keeps its binder names when it is placed in a
--- larger one, so a binder can share a raw name with its own enclosing scope. The
--- @whnf@ examples in @Language.LambdaPi.Impl.FreeFoilTH@ show a @λ x1@ nested
--- inside another @λ x1@ arising from ordinary evaluation. Handing such a caller
--- @sink@ would apply its substitution to a name the pattern binds — that is,
--- capture the bound variable.
-withRefreshedPattern
-  :: (Distinct o, CoSinkable pattern, Sinkable e, InjectName e)
-  => Scope o      -- ^ Ambient scope.
-  -> pattern n l  -- ^ Pattern to refresh (if it clashes with the ambient scope).
-  -> (forall o'. DExt o o' => (Substitution e n o -> Substitution e l o') -> pattern o o' -> r)
-  -- ^ Continuation, accepting the refreshed pattern.
-  -> r
-withRefreshedPattern scope pattern cont = withPattern
-  (\scope' binder f -> withRefreshed scope' (nameOf binder)
-    (\binder' -> f (WithRefreshedPattern (\subst -> addRename (sink subst) binder (nameOf binder'))) binder'))
-  idWithRefreshedPattern
-  compWithRefreshedPattern
-  scope
-  pattern
-  (\(WithRefreshedPattern f) pattern' -> cont f pattern')
-
--- | Refresh (if needed) bound variables introduced in a pattern.
---
--- This is a version of 'withRefreshedPattern' that uses functional renamings instead of 'Substitution'.
---
--- Like 'withRefreshedPattern', this has no all-binders-already-fresh fast path,
--- and for the same reason. Here shadowing is handled by 'unsinkName' rather than
--- by a delete: a name the pattern binds is routed to 'injectName' and never
--- reaches the caller's renaming, whether or not the binder was refreshed.
-withRefreshedPattern'
-  :: (CoSinkable pattern, Distinct o, InjectName e, Sinkable e)
-  => Scope o
-  -> pattern n l
-  -> (forall o'. DExt o o' => ((Name n -> e o) -> Name l -> e o') -> pattern o o' -> r) -> r
-withRefreshedPattern' scope pattern cont = withPattern
-  (\scope' binder f -> withRefreshed scope' (nameOf binder)
-    (\binder' ->
-      let k subst name = case unsinkName binder name of
-              Nothing    -> injectName (nameOf binder')
-              Just name' -> sink (subst name')
-       in f (WithRefreshedPattern' k) binder'))
-  idWithRefreshedPattern'
-  compWithRefreshedPattern'
-  scope
-  pattern
-  (\(WithRefreshedPattern' f) pattern' -> cont f pattern')
-
--- | Unsafely declare that a given name (binder)
--- is already fresh in any scope @n'@.
-unsafeAssertFresh :: forall n l n' l' r. NameBinder n l
-  -> (DExt n' l' => NameBinder n' l' -> r) -> r
-unsafeAssertFresh binder cont =
-  case unsafeDistinct @l' of
-    Distinct -> case unsafeExt @n' @l' of
-      Ext -> cont (unsafeCoerce binder)
-
--- | Auxiliary structure to accumulate substitution extensions
--- produced when refreshing a pattern.
--- Used in 'withRefreshedPattern' and 'withFreshPattern'.
-newtype WithRefreshedPattern e n l o o' = WithRefreshedPattern (Substitution e n o -> Substitution e l o')
-
--- | Trivial substitution (coercion via 'sink').
-idWithRefreshedPattern :: (Sinkable e, DExt o o') => WithRefreshedPattern e n n o o'
-idWithRefreshedPattern = WithRefreshedPattern sink
-
--- | Composition of substitution extensions.
-compWithRefreshedPattern
-  :: (DExt o o', DExt o' o'')
-  => WithRefreshedPattern e n i o o'
-  -> WithRefreshedPattern e i l o' o''
-  -> WithRefreshedPattern e n l o o''
-compWithRefreshedPattern (WithRefreshedPattern f) (WithRefreshedPattern g) =
-  WithRefreshedPattern (g . f)
-
--- | Auxiliary structure to accumulate substitution extensions
--- produced when refreshing a pattern.
--- Similar to 'WithRefreshedPattern', except here substitutions are represented as functions.
--- Used in 'withRefreshedPattern''.
-newtype WithRefreshedPattern' e n l (o :: S) (o' :: S) = WithRefreshedPattern' ((Name n -> e o) -> Name l -> e o')
-
--- | Trivial substitution extension (coercion via 'sink').
-idWithRefreshedPattern' :: (Sinkable e, DExt o o') => WithRefreshedPattern' e n n o o'
-idWithRefreshedPattern' = WithRefreshedPattern' (\f n -> sink (f n))
-
--- | Composition of substitution extensions.
-compWithRefreshedPattern'
-  :: (DExt o o', DExt o' o'')
-  => WithRefreshedPattern' e n i o o'
-  -> WithRefreshedPattern' e i l o' o''
-  -> WithRefreshedPattern' e n l o o''
-compWithRefreshedPattern' (WithRefreshedPattern' f) (WithRefreshedPattern' g) =
-  WithRefreshedPattern' (g . f)
-
--- ** Extracting proofs from binders and patterns
-
--- | Evidence that scope @n@ contains distinct names.
-data DistinctEvidence (n :: S) where
-  Distinct :: Distinct n => DistinctEvidence n
-
--- | Evidence that scope @l@ extends scope @n@.
-data ExtEvidence (n :: S) (l :: S) where
-  Ext :: Ext n l => ExtEvidence n l
-
--- | A distinct scope extended with a 'NameBinder' is also distinct.
-assertDistinct :: (Distinct n, CoSinkable pattern) => pattern n l -> DistinctEvidence l
-assertDistinct _ = unsafeDistinct
-
--- | A distinct scope extended with a 'NameBinder' is also distinct.
-assertExt :: CoSinkable pattern => pattern n l -> ExtEvidence n l
-assertExt _ = unsafeExt
-
--- | Unsafely declare that scope @n@ is distinct.
--- Used in 'unsafeAssertFresh'.
-unsafeDistinct :: DistinctEvidence n
-unsafeDistinct = unsafeCoerce (Distinct :: DistinctEvidence VoidS)
-
--- | Unsafely declare that scope @l@ extends scope @n@.
--- Used in 'unsafeAssertFresh'.
-unsafeExt :: ExtEvidence n l
-unsafeExt = unsafeCoerce (Ext :: ExtEvidence VoidS VoidS)
-
--- ** Unsinking names
-
--- | Try coercing the name back to the (smaller) scope,
--- given a binder that extends that scope.
-unsinkName :: NameBinder n l -> Name l -> Maybe (Name n)
-unsinkName binder name@(UnsafeName raw)
-  | nameOf binder == name = Nothing
-  | otherwise = Just (UnsafeName raw)
-
--- | Check if a name in the extended context
--- is introduced in a pattern or comes from the outer scope @n@.
---
--- This is a generalization of 'unsinkName'.
-unsinkNamePattern
-  :: forall pattern n l. (Distinct n, CoSinkable pattern)
-  => pattern n l -> Name l -> Maybe (Name n)
-unsinkNamePattern pat = withPattern @_ @n
-  (\_scope' binder k ->
-      unsafeAssertFresh binder $ \binder' ->
-        k (UnsinkName (unsinkName binder)) binder')
-  idUnsinkName
-  compUnsinkName
-  (error "impossible")  -- scope is not used, but has to be provided in general
-  pat
-  (\(UnsinkName unsink) _ -> unsink)
-
--- | Auxiliary structure for unsinking names.
--- Used in 'unsinkNamePattern'.
-newtype UnsinkName n l (o :: S) (o' :: S) = UnsinkName (Name l -> Maybe (Name n))
-
--- | Trivial unsinking. If no scope extension took place, any name is free (since it cannot be bound by anything).
-idUnsinkName :: UnsinkName n n o o'
-idUnsinkName = UnsinkName Just
-
--- | Composition of unsinking for nested binders/patterns.
-compUnsinkName
-  :: UnsinkName n i o o'
-  -> UnsinkName i l o' o''
-  -> UnsinkName n l o o''
-compUnsinkName (UnsinkName f) (UnsinkName g)
-  = UnsinkName (\name -> g name >>= f)
-
--- * Unification of binders
-
--- | Unification result for two binders,
--- extending some common scope to scopes @l@ and @r@ respectively.
---
--- Due to the implementation of the foil, we can often rename binders efficiently,
--- by renaming binders only in one of the two unified terms.
-data UnifyNameBinders (pattern :: S -> S -> Type) n l r where
-  -- | Binders are the same, proving that type parameters @l@ and @r@
-  -- are in fact equivalent.
-  SameNameBinders
-    :: NameBinders n l  -- ^ /Unordered/ set of binders in the unified pattern (from any of the original patterns).
-    -> UnifyNameBinders pattern n l l
-  -- | It is possible to safely rename the left binder
-  -- to match the right one.
-  RenameLeftNameBinder
-    :: NameBinders n r                    -- ^ /Unordered/ set of binders in the unified pattern (the binders from the right pattern).
-    -> (NameBinder n l -> NameBinder n r) -- ^ Binder renaming for the left pattern.
-    -> UnifyNameBinders pattern n l r
-  -- | It is possible to safely rename the right binder
-  -- to match the left one.
-  RenameRightNameBinder
-    :: NameBinders n l                    -- ^ /Unordered/ set of binders in the unified pattern (the binders from the left pattern).
-    -> (NameBinder n r -> NameBinder n l) -- ^ Binder renaming for the right pattern.
-    -> UnifyNameBinders pattern n l r
-  -- | It is necessary to rename both binders.
-  RenameBothBinders
-    :: NameBinders n lr                     -- ^ /Unordered/ set of binders in the unified pattern
-    -> (NameBinder n l -> NameBinder n lr)  -- ^ Binder renaming for the left pattern.
-    -> (NameBinder n r -> NameBinder n lr)  -- ^ Binder renaming for the right pattern.
-    -> UnifyNameBinders pattern n l r
-  -- | Cannot unify to (sub)patterns.
-  NotUnifiable :: UnifyNameBinders pattern n l r
-
--- | Unify binders either by asserting that they are the same,
--- or by providing a /safe/ renaming function to convert one binder to another.
---
--- When the binders differ, the one with the /larger/ name is renamed towards the
--- one with the smaller name. The direction is deliberate, but it is not what makes
--- the renaming safe, and it is worth being explicit about that, since the choice
--- looks arbitrary and has been "fixed" downstream before.
---
--- The renaming returned here is not applied by substituting names blindly: callers
--- push it through a term with 'Control.Monad.Foil.Relative.liftRM', which refreshes
--- a binder whenever it would capture. So the target name may perfectly well be used
--- by a binder /inside/ the term being renamed — a term built in a small scope keeps
--- its small binder names when 'sink' places it in a larger one, so binder names do
--- not always grow with depth — and the result is still correct. See
--- @Control.Monad.Foil.UnifyNameBindersSpec@ for the term that exercises exactly
--- this.
-unifyNameBinders
-  :: forall i l r pattern. Distinct i
-  => NameBinder i l -- ^ Left pattern.
-  -> NameBinder i r -- ^ Right pattern.
-  -> UnifyNameBinders pattern i l r
-unifyNameBinders l@(UnsafeNameBinder (UnsafeName i1)) r@(UnsafeNameBinder (UnsafeName i2))
-  | i1 == i2  = case assertDistinct l of
-      Distinct -> unsafeCoerce (SameNameBinders (nameBindersSingleton l))  -- equal names extend scopes equally
-  | i1 < i2   = RenameRightNameBinder (nameBindersSingleton l) $ \(UnsafeNameBinder (UnsafeName i'')) ->
-      if i'' == i2 then UnsafeNameBinder (UnsafeName i1) else UnsafeNameBinder (UnsafeName i'')
-  | otherwise = RenameLeftNameBinder (nameBindersSingleton r) $ \(UnsafeNameBinder (UnsafeName i')) ->
-      if i'  == i1 then UnsafeNameBinder (UnsafeName i2) else UnsafeNameBinder (UnsafeName i')
-
--- | Unsafely merge results of unification for nested binders/patterns.
--- Used in 'andThenUnifyPatterns'.
-unsafeMergeUnifyBinders :: UnifyNameBinders pattern a a' a'' -> UnifyNameBinders pattern a''' b' b'' -> UnifyNameBinders pattern a b' b''
-unsafeMergeUnifyBinders = \case
-
-  SameNameBinders x -> \case
-    SameNameBinders y -> SameNameBinders (x `unsafeMergeNameBinders` y)
-    RenameLeftNameBinder y f -> RenameLeftNameBinder (x `unsafeMergeNameBinders` y) (unsafeCoerce f)
-    RenameRightNameBinder y g -> RenameRightNameBinder (x `unsafeMergeNameBinders` y) (unsafeCoerce g)
-    RenameBothBinders y f g -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f) (unsafeCoerce g)
-    NotUnifiable -> NotUnifiable
-
-  RenameLeftNameBinder x f -> \case
-    SameNameBinders y -> RenameLeftNameBinder (x `unsafeMergeNameBinders` y) (unsafeCoerce f)
-    RenameLeftNameBinder y g -> RenameLeftNameBinder (x `unsafeMergeNameBinders` y) (unsafeCoerce f . unsafeCoerce g)
-    RenameRightNameBinder y g -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f) (unsafeCoerce g)
-    RenameBothBinders y f' g -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f . unsafeCoerce f') (unsafeCoerce g)
-    NotUnifiable -> NotUnifiable
-
-  RenameRightNameBinder x g -> \case
-    SameNameBinders y -> RenameRightNameBinder (x `unsafeMergeNameBinders` y) (unsafeCoerce g)
-    RenameLeftNameBinder y f -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f) (unsafeCoerce g)
-    RenameRightNameBinder y g' -> RenameRightNameBinder (x `unsafeMergeNameBinders` y) (unsafeCoerce g . unsafeCoerce g')
-    RenameBothBinders y f g' -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f) (unsafeCoerce g . unsafeCoerce g')
-    NotUnifiable -> NotUnifiable
-
-  RenameBothBinders x f g -> \case
-    SameNameBinders y -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f) (unsafeCoerce g)
-    RenameLeftNameBinder y f' -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f . unsafeCoerce f') (unsafeCoerce g)
-    RenameRightNameBinder y g' -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f) (unsafeCoerce g . unsafeCoerce g')
-    RenameBothBinders y f' g' -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f . unsafeCoerce f') (unsafeCoerce g . unsafeCoerce g')
-    NotUnifiable -> NotUnifiable
-
-  NotUnifiable -> const (NotUnifiable)
-
--- | Chain unification of nested patterns.
-andThenUnifyPatterns
-  :: (UnifiablePattern pattern, Distinct l, Distinct l')
-  => UnifyNameBinders pattern n l l'    -- ^ Unifying action for some outer patterns.
-  -> (pattern l r, pattern l' r')       -- ^ Two nested patterns (cannot be unified directly since they extend different scopes).
-  -> UnifyNameBinders pattern n r r'
-andThenUnifyPatterns u (l, r) = unsafeMergeUnifyBinders u (unifyPatterns (unsafeCoerce l) r)
-
--- | Chain unification of nested patterns with 'NameBinder's.
-andThenUnifyNameBinders
-  :: (UnifiablePattern pattern, Distinct l, Distinct l')
-  => UnifyNameBinders pattern n l l'    -- ^ Unifying action for some outer patterns.
-  -> (NameBinder l r, NameBinder l' r') -- ^ Two nested binders (cannot be unified directly since they extend different scopes).
-  -> UnifyNameBinders pattern n r r'
-andThenUnifyNameBinders u (l, r) = unsafeMergeUnifyBinders u (unifyNameBinders (unsafeCoerce l) r)
-
--- | An /unordered/ collection of 'NameBinder's, that together extend scope @n@ to scope @l@.
---
--- For an ordered version see 'NameBinderList'.
-newtype NameBinders (n :: S) (l :: S) = UnsafeNameBinders IntSet
-
--- | /Unsafely/ merge sets of binders (via set union).
-unsafeMergeNameBinders :: NameBinders a b -> NameBinders c d -> NameBinders n l
-unsafeMergeNameBinders (UnsafeNameBinders x) (UnsafeNameBinders y) = UnsafeNameBinders (x <> y)
-
--- | An empty set of binders keeps the scope as is.
-emptyNameBinders :: NameBinders n n
-emptyNameBinders = UnsafeNameBinders IntSet.empty
-
--- | Composition of sets of binders.
-mergeNameBinders :: NameBinders n i -> NameBinders i l -> NameBinders n l
-mergeNameBinders = unsafeMergeNameBinders
-
--- | A singleton name binder set.
-nameBindersSingleton :: NameBinder n l -> NameBinders n l
-nameBindersSingleton binder = UnsafeNameBinders (IntSet.singleton (nameId (nameOf binder)))
-
--- | An /ordered/ collection (list) of 'NameBinder's, that together extend scope @n@ to scope @l@.
---
--- For an unordered version see 'NameBinders'.
-data NameBinderList n l where
-  -- | An empty list of binders keeps the scope as is.
-  NameBinderListEmpty :: NameBinderList n n
-  -- | A non-empty list of binders.
-  NameBinderListCons
-    :: NameBinder n i       -- ^ Outermost binder.
-    -> NameBinderList i l   -- ^ Remaining list of binders.
-    -> NameBinderList n l
-
--- | Convert an unordered set of name binders into an ordered list (with some order).
-nameBindersList :: NameBinders n l -> NameBinderList n l
-nameBindersList (UnsafeNameBinders names) = go (IntSet.toList names)
-  where
-    go []     = unsafeCoerce NameBinderListEmpty
-    go (x:xs) = NameBinderListCons (UnsafeNameBinder (UnsafeName x)) (go xs)
-
--- | Add a binder to the end of an (ordered) list of binders.
---
--- Note that 'NameBinderListCons' adds a binder to the /front/ of the list, which
--- is the outermost position. This adds one to the innermost position instead.
-snocNameBinderList :: NameBinderList n i -> NameBinder i l -> NameBinderList n l
-snocNameBinderList NameBinderListEmpty binder =
-  NameBinderListCons binder NameBinderListEmpty
-snocNameBinderList (NameBinderListCons binder binders) binder' =
-  NameBinderListCons binder (snocNameBinderList binders binder')
-
--- | Concatenate two (ordered) lists of binders, the second extending the scope
--- that the first extends to.
-concatNameBinderLists :: NameBinderList n i -> NameBinderList i l -> NameBinderList n l
-concatNameBinderLists NameBinderListEmpty binders = binders
-concatNameBinderLists (NameBinderListCons binder binders) binders' =
-  NameBinderListCons binder (concatNameBinderLists binders binders')
-
--- | Convert an ordered list of name binders into an unordered set.
-fromNameBindersList :: NameBinderList n l -> NameBinders n l
-fromNameBindersList = UnsafeNameBinders . IntSet.fromList . go
-  where
-    go :: NameBinderList n l -> [RawName]
-    go NameBinderListEmpty                 = []
-    go (NameBinderListCons binder binders) = nameId (nameOf binder) : go binders
-
-instance CoSinkable NameBinders where
-  coSinkabilityProof _rename (UnsafeNameBinders names) cont =
-    cont unsafeCoerce (UnsafeNameBinders names)
-
-  withPattern withBinder unit comp scope binders cont =
-    withPattern withBinder unit comp scope (nameBindersList binders) $ \f binders' ->
-      cont f (fromNameBindersList binders')
-
-instance CoSinkable NameBinderList where
-  coSinkabilityProof rename NameBinderListEmpty cont = cont rename NameBinderListEmpty
-  coSinkabilityProof rename (NameBinderListCons binder binders) cont =
-    coSinkabilityProof rename binder $ \rename' binder' ->
-      coSinkabilityProof rename' binders $ \rename'' binders' ->
-        cont rename'' (NameBinderListCons binder' binders')
-
-  withPattern withBinder unit comp scope binders cont = case binders of
-    NameBinderListEmpty -> cont unit NameBinderListEmpty
-    NameBinderListCons x xs ->
-      withBinder scope x $ \f x' ->
-        let scope' = extendScopePattern x' scope
-        in withPattern withBinder unit comp scope' xs $ \f' xs' ->
-            cont (comp f f') (NameBinderListCons x' xs')
-
--- ** Pattern combinators
-
--- | An empty pattern type specifies zero possibilities for patterns.
---
--- This type can be used to specify that patterns are not possible.
-data V2 (n :: S) (l :: S)
-
--- | Since 'V2' values logically don't exist, this witnesses the logical reasoning tool of "ex falso quodlibet".
-absurd2 :: V2 n l -> a
-absurd2 v2 = case v2 of {}
-
-instance CoSinkable V2 where
-  coSinkabilityProof _ v2 _ = absurd2 v2
-  withPattern _ _ _ _ v2 _ = absurd2 v2
-instance UnifiablePattern V2 where
-  unifyPatterns = absurd2
-
--- | A unit pattern type corresponds to a wildcard pattern.
-data U2 (n :: S) (l :: S) where
-  U2 :: U2 n n  -- ^ Wildcard patten does not modify the scope.
-
-instance CoSinkable U2 where
-  coSinkabilityProof rename U2 cont = cont rename U2
-  withPattern _withBinder unit _combine _scope U2 cont = cont unit U2
-instance UnifiablePattern U2 where
-  unifyPatterns U2 U2 = SameNameBinders emptyNameBinders
-
--- ** Unifiable patterns
-
--- | A pattern type is unifiable if it is possible to match two
--- patterns and decide how to rename binders.
---
--- Note that the default implementation compares patterns only up to their
--- binders; see 'unifyPatterns' for what that does and does not distinguish.
-class CoSinkable pattern => UnifiablePattern pattern where
-  -- | Unify two patterns and decide which binders need to be renamed.
-  unifyPatterns :: Distinct n => pattern n l -> pattern n r -> UnifyNameBinders pattern n l r
-
-  -- | The default implementation flattens both patterns to their binders (via
-  -- 'nameBinderListOf') and unifies the resulting 'NameBinderList's. It therefore
-  -- compares only the /number and order/ of binders, and ignores
-  --
-  -- * the constructor, so two patterns built from /different/ constructors with
-  --   the same number of binders unify;
-  -- * non-binding fields (locations, sorts, literals), whatever their values;
-  -- * the nesting of sub-patterns, so @(x, (y, z))@ unifies with @((x, y), z)@.
-  --
-  -- For most languages this is the intended notion of α-equivalence: what the
-  -- body of a binding construct can refer to is precisely the pattern's binders,
-  -- in order. Since α-equivalence is defined in terms of 'unifyPatterns', this
-  -- also means that terms differing only in such a pattern are α-equivalent.
-  --
-  -- If your patterns carry data that is semantically relevant, this default is
-  -- not what you want and you should write the instance by hand — see the
-  -- @UnifiablePattern Pattern@ instance in @Language.LambdaPi.Impl.Foil@ for a
-  -- structural one. Use 'UnifiableInPattern' to compare non-binding fields, which
-  -- also lets you deliberately ignore some of them (as
-  -- @Language.LambdaPi.Impl.FreeFoilTH@ does for BNFC source positions).
-  --
-  -- The behaviour described here is pinned down in
-  -- @Control.Monad.Foil.UnifiablePatternSpec@.
-  default unifyPatterns
-    :: (CoSinkable pattern, Distinct n)
-    => pattern n l -> pattern n r -> UnifyNameBinders pattern n l r
-  unifyPatterns l r = coerce (unifyPatterns (nameBinderListOf l) (nameBinderListOf r))
-
-instance UnifiablePattern NameBinderList where
-  unifyPatterns NameBinderListEmpty NameBinderListEmpty = SameNameBinders emptyNameBinders
-  unifyPatterns (NameBinderListCons x xs) (NameBinderListCons y ys) =
-    case (assertDistinct x, assertDistinct y) of
-      (Distinct, Distinct) -> unifyNameBinders x y `andThenUnifyPatterns` (xs, ys)
-  -- Lists of different lengths are not unifiable. This case is reachable
-  -- whenever a language has patterns that bind different numbers of names --
-  -- a wildcard and a variable, say -- since the default 'unifyPatterns'
-  -- flattens every pattern to a 'NameBinderList'. Note that this module sets
-  -- @-Wno-incomplete-patterns@, so its absence was not reported.
-  unifyPatterns _ _ = NotUnifiable
-
--- | Unification of values in patterns.
--- By default, 'Eq' instance is used, but it may be useful to ignore
--- some data in pattens (such as location annotations).
-class UnifiableInPattern a where
-  -- | Unify non-binding components of a pattern.
-  unifyInPattern :: a -> a -> Bool
-  default unifyInPattern :: Eq a => a -> a -> Bool
-  unifyInPattern = (==)
-
-instance UnifiablePattern NameBinder where
-  unifyPatterns = unifyNameBinders
-
--- | The easiest way to compare two patterns is to check if they are the same.
--- This function is labelled /unsafe/, since we generally are interested in proper α-equivalence
--- instead of direct equality.
-unsafeEqPattern :: (UnifiablePattern pattern, Distinct n) => pattern n l -> pattern n' l' -> Bool
-unsafeEqPattern l r =
-  case unifyPatterns l (unsafeCoerce r) of
-    SameNameBinders{} -> True
-    _                 -> False
-
--- * Safe sinking
-
--- | Sinking an expression from scope @n@ into a (usualy extended) scope @l@,
--- given the renaming (injection from scope @n@ to scope @l@).
-class Sinkable (e :: S -> Type) where
-  -- | An implementation of this method that typechecks
-  -- proves to the compiler that the expression is indeed
-  -- 'Sinkable'. However, instead of this implementation, 'sink'
-  -- should be used at all call sites for efficiency.
-  sinkabilityProof
-    :: (Name n -> Name l)   -- ^ Map names from scope @n@ to a (possibly larger) scope @l@.
-    -> e n                  -- ^ Expression with free variables in scope @n@.
-    -> e l
-
-  default sinkabilityProof
-    :: (GenericK e, GSinkableK (RepK e)) => (Name n -> Name l) -> e n -> e l
-  sinkabilityProof rename = toK . gsinkabilityProof1 rename . fromK
-
--- | Sinking a 'Name' is as simple as applying the renaming.
-instance Sinkable Name where
-  sinkabilityProof rename = rename
-
--- | A container of sinkable expressions is sinkable, elementwise.
---
--- The point of this instance is 'sinkContainer': since the proof typechecks,
--- sinking the whole container is a coercion, and does not walk its spine.
-instance (Functor f, Sinkable e) => Sinkable (Compose f e) where
-  sinkabilityProof rename (Compose xs) = Compose (fmap (sinkabilityProof rename) xs)
-
--- | Efficient version of 'sinkabilityProof'.
--- In fact, once 'sinkabilityProof' typechecks,
--- it is safe to 'sink' by coercion.
--- See Section 3.5 in [«The Foil: Capture-Avoiding Substitution With No Sharp Edges»](https://doi.org/10.1145/3587216.3587224) for the details.
-sink :: (Sinkable e, DExt n l) => e n -> e l
-sink = unsafeCoerce
-
--- | Sink an entire container of sinkable expressions, in \(O(1)\).
---
--- The soundness argument for 'sink' extends to a container of sinkables — an
--- 'Data.IntMap.IntMap' of terms, a 'Data.Map.Map' keyed by something else, a
--- list of them — so there is no need to walk the spine with @'fmap' 'sink'@, and
--- entering a binder need not be \(O(size)\).
---
--- >>> :{
--- sinkEnv :: DExt n l => Map.Map String (Name n) -> Map.Map String (Name l)
--- sinkEnv = sinkContainer
--- :}
---
--- Two things this does /not/ cover:
---
--- * A 'Scope' is __not__ sinkable, and must not be sunk: it is the set of names
---   /in/ scope @n@, and it has to grow when a binder is entered (see 'extendScope').
--- * A 'NameMap' must stay __total__ on the names in scope ('lookupName' errors
---   otherwise), so sinking one has to be paired with adding the new binder's
---   entry (see 'addNameBinder').
-sinkContainer :: (Functor f, Sinkable e, DExt n l) => f (e n) -> f (e l)
-sinkContainer = getCompose . sink . Compose
-
--- | Extend renaming when going under a 'CoSinkable' pattern (generalized binder).
--- Note that the scope under pattern is independent of the codomain of the renaming.
---
--- This function is used to go under binders when implementing 'sinkabilityProof'
--- and is both a generalization of 'extendRenamingNameBinder' and an efficient implementation of 'coSinkabilityProof'.
-extendRenaming
-  :: CoSinkable pattern
-  => (Name n -> Name n')  -- ^ Map names from scope @n@ to a (possibly larger) scope @n'@.
-  -> pattern n l          -- ^ A pattern that extends scope @n@ to another scope @l@.
-  -> (forall l'. (Name l -> Name l') -> pattern n' l' -> r )
-  -- ^ A continuation, accepting an extended renaming from @l@ to @l'@ (which itself extends @n'@)
-  -- and a (possibly refreshed) pattern that extends @n'@ to @l'@.
-  -> r
-extendRenaming _ pattern cont =
-  cont unsafeCoerce (unsafeCoerce pattern)
-
--- | Extend renaming of binders when going under a 'CoSinkable' pattern (generalized binder).
--- Note that the scope under pattern is independent of the codomain of the renaming.
-extendNameBinderRenaming
-  :: CoSinkable pattern
-  => (NameBinder i n -> NameBinder i n')  -- ^ Map names from scope @n@ to a (possibly larger) scope @n'@.
-  -> pattern n l          -- ^ A pattern that extends scope @n@ to another scope @l@.
-  -> (forall l'. (NameBinder n' l -> NameBinder n' l') -> pattern n' l' -> r )
-  -- ^ A continuation, accepting an extended renaming from @l@ to @l'@ (which itself extends @n'@)
-  -- and a (possibly refreshed) pattern that extends @n'@ to @l'@.
-  -> r
-extendNameBinderRenaming _ pattern cont =
-  cont unsafeCoerce (unsafeCoerce pattern)
-
--- | Safely compose renamings of name binders.
--- The underlying implementation is
-composeNameBinderRenamings
-  :: (NameBinder n i -> NameBinder n i')    -- ^ Rename binders extending scope @n@ from @i@ to @i'@.
-  -> (NameBinder i' l -> NameBinder i' l')  -- ^ Rename binders extending scope @i'@ from @l@ to @l'@.
-  -> (NameBinder n l -> NameBinder n l')
-composeNameBinderRenamings = unsafeCoerce (flip (.))
-
--- | Convert renaming of name binders into renaming of names in the inner scopes.
-fromNameBinderRenaming :: (NameBinder n l -> NameBinder n l') -> Name l -> Name l'
-fromNameBinderRenaming = coerce
-
--- | Extend renaming when going under a 'NameBinder'.
--- Note that the scope under binder is independent of the codomain of the renaming.
---
--- Semantically, this function may need to rename the binder (resulting in the new scope @l'@),
--- to make sure it does not clash with scope @n'@.
--- However, as it turns out, the foil makes it safe
--- to implement this function as a coercion.
--- See Appendix A in [«The Foil: Capture-Avoiding Substitution With No Sharp Edges»](https://doi.org/10.1145/3587216.3587224) for the details.
---
--- This function is used to go under binders when implementing 'sinkabilityProof'.
--- A generalization of this function is 'extendRenaming' (which is an efficient version of 'coSinkabilityProof').
-extendRenamingNameBinder
-  :: (Name n -> Name n')  -- ^ Map names from scope @n@ to a (possibly larger) scope @n'@.
-  -> NameBinder n l       -- ^ A name binder that extends scope @n@ to another scope @l@.
-  -> (forall l'. (Name l -> Name l') -> NameBinder n' l' -> r )
-  -- ^ A continuation, accepting an extended renaming from @l@ to @l'@ (which itself extends @n'@)
-  -- and a (possibly refreshed) binder that extends @n'@ to @l'@.
-  -> r
-extendRenamingNameBinder _ (UnsafeNameBinder name) cont =
-  cont unsafeCoerce (UnsafeNameBinder name)
-
--- | 'CoSinkable' is to patterns (generalized binders)
--- what 'Sinkable' is to expressions.
---
--- See Section 2.3 of [«Free Foil: Generating Efficient and Scope-Safe Abstract Syntax»](https://arxiv.org/abs/2405.16384) for more details.
-class CoSinkable (pattern :: S -> S -> Type) where
-  -- | An implementation of this method that typechecks
-  -- proves to the compiler that the pattern is indeed
-  -- 'CoSinkable'. However, instead of this implementation,
-  -- 'extendRenaming' should be used at all call sites for efficiency.
-  coSinkabilityProof
-    :: (Name n -> Name n')  -- ^ Map names from scope @n@ to a (possibly larger) scope @n'@.
-    -> pattern n l          -- ^ A pattern that extends scope @n@ to another scope @l@.
-    -> (forall l'. (Name l -> Name l') -> pattern n' l' -> r)
-    -- ^ A continuation, accepting an extended renaming from @l@ to @l'@ (which itself extends @n'@)
-    -- and a (possibly refreshed) pattern that extends @n'@ to @l'@.
-    -> r
-  default coSinkabilityProof
-    :: (GenericK pattern, GSinkableK (RepK pattern))
-    => (Name n -> Name n')
-    -> pattern n l
-    -> (forall l'. (Name l -> Name l') -> pattern n' l' -> r)
-    -> r
-  coSinkabilityProof rename p cont = gsinkabilityProof2 rename (fromK @_ @pattern p) $ \rename' p' ->
-    cont rename' (toK @_ @pattern p')
-
-  -- | Generalized processing of a pattern.
-  --
-  -- You can see 'withPattern' as a CPS-style traversal over the binders in a pattern.
-  withPattern
-    :: Distinct o
-    => (forall x y z r'. Distinct z => Scope z -> NameBinder x y -> (forall z'. DExt z z' => f x y z z' -> NameBinder z z' -> r') -> r')
-    -- ^ Processing of a single 'NameBinder', this will be applied to each binder in a pattern.
-    -> (forall x z z'. DExt z z' => f x x z z')
-    -- ^ Result in case no binders are present. This can be seen as scope-indexed 'mempty'.
-    -> (forall x y y' z z' z''. (DExt z z', DExt z' z'') => f x y z z' -> f y y' z' z'' -> f x y' z z'')
-    -- ^ Composition of results for nested binders/patterns. This can be seen as scope-indexed 'mappend'.
-    -> Scope o
-    -- ^ Ambient scope.
-    -> pattern n l
-    -- ^ Pattern to process.
-    -> (forall o'. DExt o o' => f n l o o' -> pattern o o' -> r)
-    -- ^ Continuation, accepting result for the entire pattern and a (possibly refreshed) pattern.
-    -> r
-  default withPattern
-    :: (Distinct o, GenericK pattern, GValidNameBinders pattern (RepK pattern), GHasNameBinders (RepK pattern))
-    => (forall x y z r'. Distinct z => Scope z -> NameBinder x y -> (forall z'. DExt z z' => f x y z z' -> NameBinder z z' -> r') -> r')
-    -> (forall x z z'. DExt z z' => f x x z z')
-    -> (forall x y y' z z' z''. (DExt z z', DExt z' z'') => f x y z z' -> f y y' z' z'' -> f x y' z z'')
-    -> Scope o
-    -> pattern n l
-    -> (forall o'. DExt o o' => f n l o o' -> pattern o o' -> r)
-    -> r
-  withPattern = gunsafeWithPatternViaHasNameBinders
-
--- | Auxiliary data structure for collecting name binders. Used in 'nameBinderListOf'.
-newtype WithNameBinderList r n l (o :: S) (o' :: S) = WithNameBinderList (NameBinderList l r -> NameBinderList n r)
-
--- | Empty list of name binders (identity).
-idWithNameBinderList :: DExt o o' => WithNameBinderList r n n o o'
-idWithNameBinderList = WithNameBinderList id
-
--- | Concatenating lists of name binders (compose).
-compWithNameBinderList
-  :: (DExt o o', DExt o' o'')
-  => WithNameBinderList r n i o o'
-  -> WithNameBinderList r i l o' o''
-  -> WithNameBinderList r n l o o''
-compWithNameBinderList (WithNameBinderList f) (WithNameBinderList g) =
-  WithNameBinderList (f . g)
-
--- | Collect name binders of a generalized pattern into a name binder list,
--- which can be more easily traversed.
-nameBinderListOf :: (CoSinkable binder) => binder n l -> NameBinderList n l
-nameBinderListOf pat = withPattern
-  (\_scope' binder k ->
-    unsafeAssertFresh binder $ \binder' ->
-      k (WithNameBinderList (NameBinderListCons binder)) binder')
-  idWithNameBinderList
-  compWithNameBinderList
-  emptyScope
-  pat
-  (\(WithNameBinderList f) _ -> f NameBinderListEmpty)
-
-instance CoSinkable NameBinder where
-  coSinkabilityProof _rename (UnsafeNameBinder name) cont =
-    cont unsafeCoerce (UnsafeNameBinder name)
-
-  withPattern f _ _ = f
-
--- * Safe substitions
-
--- | A substitution is a mapping from names in scope @i@
--- to expressions @e o@ in scope @o@.
-newtype Substitution (e :: S -> Type) (i :: S) (o :: S) =
-  UnsafeSubstitution (IntMap (e o))
-
--- | Apply substitution to a given name.
-lookupSubst :: InjectName e => Substitution e i o -> Name i -> e o
-lookupSubst (UnsafeSubstitution env) (UnsafeName name) =
-    case IntMap.lookup name env of
-        Just ex -> ex
-        Nothing -> injectName (UnsafeName name)
-
--- | Identity substitution maps all names to expresion-variables.
-identitySubst
-  :: InjectName e => Substitution e i i
-identitySubst = UnsafeSubstitution IntMap.empty
-
--- | An empty substitution from an empty scope.
-voidSubst :: Substitution e VoidS n
-voidSubst = UnsafeSubstitution IntMap.empty
-
--- | Extend substitution with a particular mapping.
-addSubst
-  :: Substitution e i o
-  -> NameBinder i i'
-  -> e o
-  -> Substitution e i' o
-addSubst (UnsafeSubstitution env) (UnsafeNameBinder (UnsafeName name)) ex
-  = UnsafeSubstitution (IntMap.insert name ex env)
-
-addSubstPattern
-  :: CoSinkable binder
-  => Substitution e i o
-  -> binder i i'
-  -> [e o]
-  -> Substitution e i' o
-addSubstPattern subst pat = addSubstList subst (nameBinderListOf pat)
-
-addSubstList
-  :: Substitution e i o
-  -> NameBinderList i i'
-  -> [e o]
-  -> Substitution e i' o
-addSubstList subst NameBinderListEmpty _ = subst
-addSubstList subst (NameBinderListCons binder binders) (x:xs) =
-  addSubstList (addSubst subst binder x) binders xs
-addSubstList _ _ [] = error "cannot add a binder to Substitution since the value list does not have enough elements"
-
--- | Add variable renaming to a substitution.
---
--- When the binder is mapped to its own name, the name is /deleted/ from the
--- substitution rather than mapped to itself. This is an optimization, but it is
--- not only an optimization: it is also how the binder shadows an outer binding
--- of the same raw name, so the delete cannot be skipped even when nothing is
--- being renamed. See 'withRefreshedPattern' for why that rules out an
--- all-binders-fresh fast path.
-addRename :: InjectName e => Substitution e i o -> NameBinder i i' -> Name o -> Substitution e i' o
-addRename s@(UnsafeSubstitution env) b@(UnsafeNameBinder (UnsafeName name1)) n@(UnsafeName name2)
-    | name1 == name2 = UnsafeSubstitution (IntMap.delete name1 env)
-    | otherwise = addSubst s b (injectName n)
-
--- | Substitutions are sinkable as long as corresponding expressions are.
-instance (Sinkable e) => Sinkable (Substitution e i) where
-  sinkabilityProof rename (UnsafeSubstitution env) =
-    UnsafeSubstitution (fmap (sinkabilityProof rename) env)
-
--- * 'Name' maps
-
--- | A /total/ map from names in scope @n@ to elements of type @a@.
-newtype NameMap (n :: S) a = NameMap { getNameMap :: IntMap a } deriving (Functor, Foldable, Traversable)
-
--- | An empty map belongs in the empty scope.
-emptyNameMap :: NameMap VoidS a
-emptyNameMap = NameMap IntMap.empty
-
--- | Convert a 'NameMap' of expressions into a 'Substitution'.
-nameMapToSubstitution :: NameMap i (e o) -> Substitution e i o
-nameMapToSubstitution (NameMap m) = (UnsafeSubstitution m)
-
--- | Convert a 'NameMap' of expressions into a 'Scope'.
-nameMapToScope :: NameMap n a -> Scope n
-nameMapToScope (NameMap m) = UnsafeScope (IntMap.keysSet m)
-
--- | Extend a map with multiple mappings (by repeatedly applying 'addNameBinder').
---
--- Note that the input list is expected to have __at least__ the same number of elements
--- as there are binders in the input pattern (generalized binder).
-addNameBinders :: CoSinkable binder => binder n l -> [a] -> NameMap n a -> NameMap l a
-addNameBinders pat = addNameBinderList (nameBinderListOf pat)
-
--- | Extend a map with multiple mappings (by repeatedly applying 'addNameBinder').
---
--- Note that the input list is expected to have __at least__ the same number of elements
--- as there are binders in the input name binder list.
---
--- See also 'addNameBinders' for a generalized version.
-addNameBinderList :: NameBinderList n l -> [a] -> NameMap n a -> NameMap l a
-addNameBinderList NameBinderListEmpty _ = id
-addNameBinderList (NameBinderListCons binder binders) (x:xs) =
-  addNameBinderList binders xs . addNameBinder binder x
-addNameBinderList _ [] = error "cannot add a binder to NameMap since the value list does not have enough elements"
-
--- | Looking up a name should always succeed.
---
--- Note that since 'Name' is 'Sinkable', you can lookup a name from scope @n@ in a 'NameMap' for scope @l@ whenever @l@ extends @n@.
-lookupName :: Name n -> NameMap n a -> a
-lookupName name (NameMap m) =
-  case IntMap.lookup (nameId name) m of
-    Nothing -> error "impossible: unknown name in a NameMap"
-    Just x  -> x
-
--- | Extending a map with a single mapping.
---
--- Note that the scope parameter of the result differs from the initial map.
-addNameBinder :: NameBinder n l -> a -> NameMap n a -> NameMap l a
-addNameBinder name x (NameMap m) = NameMap (IntMap.insert (nameId (nameOf name)) x m)
-
--- | Remove the mapping for a binder, shrinking the map back to the outer scope.
---
--- This is the inverse of 'addNameBinder', and is what a type checker wants when
--- it leaves a binder it has entered.
-popNameBinder :: NameBinder n l -> NameMap l a -> NameMap n a
-popNameBinder binder (NameMap m) = NameMap (IntMap.delete (nameId (nameOf binder)) m)
-
--- | Allocate a fresh binder for each element of a list, binding each element to
--- its binder in the map.
---
--- The continuation receives the extended scope, the binders in the order of the
--- input list, and the extended map. This is the list-shaped counterpart of
--- 'withFresh', and saves a caller from threading the scope, the binders, and the
--- map through a recursion by hand.
-withFreshNameBinderList
-  :: forall n a r. Distinct n
-  => [a]                  -- ^ A value to bind to each fresh binder.
-  -> Scope n              -- ^ The ambient scope.
-  -> NameMap n a          -- ^ The map to extend.
-  -> (forall l. DExt n l => Scope l -> NameBinderList n l -> NameMap l a -> r)
-  -> r
-withFreshNameBinderList xs0 scope0 nameMap0 cont =
-    go xs0 scope0 NameBinderListEmpty nameMap0 cont
-  where
-    go :: forall i r'. Distinct i
-       => [a] -> Scope i -> NameBinderList n i -> NameMap i a
-       -> (forall l. DExt n l => Scope l -> NameBinderList n l -> NameMap l a -> r')
-       -> r'
-    go [] scope binders nameMap cont' =
-      case (assertDistinct binders, assertExt binders) of
-        (Distinct, Ext) -> cont' scope binders nameMap
-    go (x:xs) scope binders nameMap cont' =
-      withFresh scope $ \binder ->
-        go xs
-           (extendScope binder scope)
-           (snocNameBinderList binders binder)
-           (addNameBinder binder x nameMap)
-           cont'
-
--- * Raw types and operations
-
--- | We will use 'Int' for efficient representation of identifiers.
-type Id = Int
-
--- | Raw name is simply an identifier.
-type RawName = Id
-
--- | A raw scope is a set of raw names.
-type RawScope = IntSet
-
--- | \(O(\min(n, W))\).
--- Generate a fresh raw name that
--- does not appear in a given raw scope.
-rawFreshName :: RawScope -> RawName
-rawFreshName scope | IntSet.null scope = 0
-                   | otherwise = IntSet.findMax scope + 1
-
--- | Check if a raw name is contained in a raw scope.
-rawMember :: RawName -> RawScope -> Bool
-rawMember = IntSet.member
-
--- * Constraints
-
--- | Every scope is a (trivial) extension of itself.
---
--- __Important__: this class exists to assist tracking scope extensions
--- for type variables of kind 'S'.
--- Users of the foil are not supposed to implement any instances of 'ExtEndo'.
-class ExtEndo (n :: S)
-
--- | Some scopes are extensions of other scopes.
---
--- __Important__: this class exists to assist tracking scope extensions
--- for type variables of kind 'S'.
--- Users of the foil are not supposed to implement any instances of 'Ext'.
-class (ExtEndo n => ExtEndo l ) => Ext (n :: S) (l :: S)
-instance ( ExtEndo n => ExtEndo l ) => Ext n l
-
--- | Scopes with distinct names.
---
--- __Important__: this class exists to explicitly
--- mark scopes with distinct names.
--- Users of the foil are not supposed to implement any instances of 'Distinct'.
-class Distinct (n :: S)
-instance Distinct VoidS
-
--- | Scope extensions with distinct names.
-type DExt n l = (Distinct l, Ext n l)
-
--- | Instances of this typeclass possess the ability to inject names.
--- Usually, this is a variable data constructor.
-class InjectName (e :: S -> Type) where
-  -- | Inject names into expressions.
-  injectName :: Name n -> e n
-
--- * Kind-polymorphic sinkability
-
-data RenamingsK (as :: LoT k) (bs :: LoT k) where
-  RNil :: RenamingsK LoT0 LoT0
-  RCons :: (Name a -> Name b) -> RenamingsK as bs -> RenamingsK (a :&&: as) (b :&&: bs)
-  RSkip :: RenamingsK as bs -> RenamingsK (k :&&: as) (k :&&: bs)
-
-class SinkableK (f :: S -> k) where
-  sinkabilityProofK
-    :: forall as bs r.
-       RenamingsK as bs
-    -> f :@@: as
-    -> (forall cs. RenamingsK as cs -> f :@@: cs -> r)
-    -> r
-  default sinkabilityProofK :: forall as bs r.
-      (GenericK f, GSinkableK (RepK f))
-    => RenamingsK as bs
-    -> f :@@: as
-    -> (forall cs. RenamingsK as cs -> f :@@: cs -> r)
-    -> r
-  sinkabilityProofK rename e cont =
-    gsinkabilityProofK rename (fromK @_ @f e) $ \rename' e' ->
-      cont rename' (toK @_ @f e')
-
-sinkK :: GSinkableK f => RenamingsK xs as -> RenamingsK xs bs -> f :@@: as -> f :@@: bs
-sinkK _ _ = unsafeCoerce
-
-instance SinkableK Name where
-  sinkabilityProofK renameK@(RCons rename RNil) name cont = cont renameK (rename name)
-instance SinkableK NameBinder where
-  sinkabilityProofK (RCons _ RNil) (UnsafeNameBinder name) cont =
-    cont (RCons unsafeCoerce RNil) (UnsafeNameBinder name)
-instance SinkableK NameBinders where
-  sinkabilityProofK (RCons _ RNil) (UnsafeNameBinders s) cont =
-    cont (RCons unsafeCoerce RNil) (UnsafeNameBinders s)
-
-instance GenericK NameBinderList where
-  type RepK NameBinderList = ((Var0 :~~: Var1) :=>: U1) :+: Exists S
-    (Field (NameBinder :$: Var1 :@: Var0) :*: Field (NameBinderList :$: Var0 :@: Var2))
-  toK (L1 (SuchThat U1))                   = NameBinderListEmpty
-  toK (R1 (Exists (Field x :*: Field xs))) = NameBinderListCons x xs
-  fromK NameBinderListEmpty       = L1 (SuchThat U1)
-  fromK (NameBinderListCons x xs) = R1 (Exists (Field x :*: Field xs))
-
-instance GenericK V2 where
-  type RepK V2 = V1
-  toK _v1 = error "absurd: Generics.Kind.V1"
-  fromK = absurd2
-
-instance GenericK U2 where
-  type RepK U2 = ((Var0 :~~: Var1) :=>: U1)
-  toK (SuchThat U1) = U2
-  fromK U2 = SuchThat U1
-
-instance SinkableK NameBinderList
-instance SinkableK V2
-instance SinkableK U2
-
-sinkabilityProof1 :: SinkableK f => (Name n -> Name n') -> f n -> f n'
-sinkabilityProof1 rename e = sinkabilityProofK (RCons rename RNil) e $ \_ e' -> unsafeCoerce e'
-
-gsinkabilityProof1 :: GSinkableK f => (Name n -> Name n') -> f (n :&&: LoT0) -> f (n' :&&: LoT0)
-gsinkabilityProof1 rename e = gsinkabilityProofK (RCons rename RNil) e $ \_ e' -> unsafeCoerce e'
-
-gsinkabilityProof2
-  :: forall f n n' l r. GSinkableK f
-  => (Name n -> Name n') -> f (n :&&: l :&&: LoT0)
-  -> (forall l'. (Name l -> Name l') -> f (n' :&&: l' :&&: LoT0) -> r)
-  -> r
-gsinkabilityProof2 rename e cont =
-  gsinkabilityProofK (RCons rename (RCons id RNil)) e $ \case
-    RCons (_ :: Name n -> Name n'') (RCons rename' RNil) -> \e' ->
-      case unsafeCoerce (Type.Refl :: n' Type.:~: n') :: n' Type.:~: n'' of
-        Type.Refl -> cont rename' e'
-
-gsinkabilityProofK' :: GSinkableK f => RenamingsK as bs -> f as -> f bs
-gsinkabilityProofK' renameK e = gsinkabilityProofK renameK e $ \_ e' -> unsafeCoerce e'
-
-class GSinkableK p where
-  gsinkabilityProofK
-    :: forall as bs r.
-       RenamingsK as bs
-    -> p as
-    -> (forall cs. RenamingsK as cs -> p cs -> r)
-    -> r
-
-gsinkK :: GSinkableK f => RenamingsK xs as -> RenamingsK xs bs -> f as -> f bs
-gsinkK _ _ = unsafeCoerce
-
-instance GSinkableK V1 where
-  gsinkabilityProofK irename _v1 cont =
-    cont irename (error "absurd: Generics.Kind.V1")
-
-instance GSinkableK U1 where
-  gsinkabilityProofK irename U1 cont =
-    cont irename U1
-
-instance GSinkableK f => GSinkableK (M1 i c f) where
-  gsinkabilityProofK irename (M1 x) cont =
-    gsinkabilityProofK irename x $ \irename' x' ->
-      cont irename' (M1 x')
-
-instance (GSinkableK f, GSinkableK g) => GSinkableK (f :+: g) where
-  gsinkabilityProofK irename (L1 x) cont =
-    gsinkabilityProofK irename x $ \irename' x' ->
-      cont irename' (L1 x')
-  gsinkabilityProofK irename (R1 x) cont =
-    gsinkabilityProofK irename x $ \irename' x' ->
-      cont irename' (R1 x')
-
-instance (GSinkableK f, GSinkableK g) => GSinkableK (f :*: g) where
-  gsinkabilityProofK irename (x :*: y) cont =
-    gsinkabilityProofK irename x $ \irename' x' ->
-      gsinkabilityProofK irename' y $ \irename'' y' ->
-        cont irename'' (gsinkK irename' irename'' x' :*: y')
-
-instance GSinkableK f => GSinkableK (Exists S f) where
-  gsinkabilityProofK irename (Exists x) cont =
-    gsinkabilityProofK (RCons id irename) x $ \case
-      RCons _ irename' -> \x' ->
-        cont irename' (Exists x')
-
-instance {-# OVERLAPPABLE #-} GSinkableK f => GSinkableK (Exists k f) where
-  gsinkabilityProofK irename (Exists x) cont =
-    gsinkabilityProofK (RSkip irename) x $ \case
-      RSkip irename' -> \x' ->
-        cont irename' (Exists x')
-
-instance GSinkableK f => GSinkableK ((a :~~: b) :=>: f) where
-  gsinkabilityProofK irename (SuchThat x) cont =
-    gsinkabilityProofK irename x $ \(irename' :: RenamingsK as cs) x' ->
-      -- this is sort of safe...
-      case unsafeCoerce (Type.Refl :: Interpret a cs Type.:~: Interpret a cs) :: Interpret a cs Type.:~: Interpret b cs of
-        Type.Refl -> cont irename' (SuchThat x')
-
-instance GSinkableK (Field (Kon a)) where
-  gsinkabilityProofK irename (Field x) cont =
-    cont irename (Field x)
-
-instance GSinkableK (Field (Var a)) where
-  gsinkabilityProofK irename (Field x) cont =
-    cont irename (Field (unsafeCoerce x)) -- FIXME: unsafeCoerce?
-
-instance (SinkableK f, ExtractRenamingK i) => GSinkableK (Field (Kon f :@: Var i)) where
-  gsinkabilityProofK irename (Field x) cont =
-    sinkabilityProofK (RCons (extractRenamingK @_ @i irename) RNil) x $ \case
-      RCons rename' RNil -> \x' ->
-        cont (putBackRenamingK @_ @i rename' irename) (Field (unsafeCoerce x')) -- unsafeCoerce?
-
-instance SinkableK (f a) => GSinkableK (Field (Kon f :@: Kon a :@: Var0)) where
-  gsinkabilityProofK irename@(RCons _ RNil) (Field x) cont =
-    sinkabilityProofK irename x $ \rename' x' ->
-      cont rename' (Field x')
-
-instance SinkableK (f a b) => GSinkableK (Field (Kon f :@: Kon a :@: Kon b :@: Var0)) where
-  gsinkabilityProofK irename@(RCons _ RNil) (Field x) cont =
-    sinkabilityProofK irename x $ \rename' x' ->
-      cont rename' (Field x')
-
-class ExtractRenamingK (i :: TyVar k S) where
-  extractRenamingK :: forall (as :: LoT k) (bs :: LoT k).
-    RenamingsK as bs -> Name (Interpret (Var i) as) -> Name (Interpret (Var i) bs)
-  putBackRenamingK :: forall c (as :: LoT k) (bs :: LoT k).
-       (Name (Interpret (Var i) as) -> Name c)
-    -> RenamingsK as bs
-    -> RenamingsK as (PutBackLoT i c bs)
-
-instance ExtractRenamingK VZ where
-  extractRenamingK (RCons f _fs) = f
-  putBackRenamingK f (RCons _ gs) = RCons f gs
-
-instance ExtractRenamingK x => ExtractRenamingK (VS x) where
-  extractRenamingK (RCons _f fs) = extractRenamingK @_ @x fs
-  putBackRenamingK f (RCons g gs) = RCons g (putBackRenamingK @_ @x f gs)
-
-extractTwoRenamingsK :: forall k (i :: TyVar k S) (j :: TyVar k S) (as :: LoT k) (bs :: LoT k).
-    (ExtractRenamingK i, ExtractRenamingK j)
-  => RenamingsK as bs
-  -> RenamingsK
-      (Interpret (Var i) as :&&: Interpret (Var j) as :&&: LoT0)
-      (Interpret (Var i) bs :&&: Interpret (Var j) bs :&&: LoT0)
-extractTwoRenamingsK irename =
-  (RCons (extractRenamingK @_ @i irename) (RCons (extractRenamingK @_ @j irename) RNil))
-
-putBackTwoRenamingsK :: forall k (i :: TyVar k S) (j :: TyVar k S) c1 c2 (as :: LoT k) (bs :: LoT k).
-    (ExtractRenamingK i, ExtractRenamingK j)
-  => RenamingsK
-      (Interpret (Var i) as :&&: Interpret (Var j) as :&&: LoT0)
-      (c1 :&&: c2 :&&: LoT0)
-  -> RenamingsK as bs
-  -> RenamingsK as (PutBackLoT j c2 (PutBackLoT i c1 bs))
-putBackTwoRenamingsK (RCons f1 (RCons f2 RNil)) rename
-  = putBackRenamingK @_ @j f2 (putBackRenamingK @_ @i f1 rename)
-
-instance (SinkableK f, ExtractRenamingK i, ExtractRenamingK j) => GSinkableK (Field (Kon f :@: Var (i :: TyVar k S) :@: Var (j :: TyVar k S))) where
-  gsinkabilityProofK irename (Field x) cont =
-    sinkabilityProofK (extractTwoRenamingsK @_ @i @j irename) x $ \rename' x' ->
-      case rename' of
-        RCons _ (RCons _ RNil) ->
-          cont (putBackTwoRenamingsK @_ @i @j rename' irename)
-              (Field (unsafeCoerce x'))  -- FIXME: can we do better than unsafeCoerce?
-
-instance (Functor f, GSinkableK (Field x)) => GSinkableK (Field (Kon f :@: x)) where
-  gsinkabilityProofK irename (Field x) cont =
-    cont irename (Field (fmap
-      (unField . gsinkabilityProofK' @(Field x) irename . Field)
-      x))
-
-instance (Bifunctor f, GSinkableK (Field x), GSinkableK (Field y)) => GSinkableK (Field (Kon f :@: x :@: y)) where
-  gsinkabilityProofK irename (Field x) cont =
-    cont irename (Field (bimap
-      (unField . gsinkabilityProofK' @(Field x) irename . Field)
-      (unField . gsinkabilityProofK' @(Field y) irename . Field)
-      x))
-
--- * Kind-polymorphic types with binders
-
--- ** Generic version of 'withPattern'
-
--- | Generic generalized processing of a pattern via 'GHasNameBinders'.
---
--- This can be used as a default implementation of 'withPattern'.
-gunsafeWithPatternViaHasNameBinders
-  :: forall pattern f o n l r.
-      (Distinct o, GenericK pattern, GValidNameBinders pattern (RepK pattern), GHasNameBinders (RepK pattern))
-  => (forall x y z r'. Distinct z => Scope z -> NameBinder x y -> (forall z'. DExt z z' => f x y z z' -> NameBinder z z' -> r') -> r')
-  -- ^ Processing of a single 'NameBinder', this will be applied to each binder in a pattern.
-  -> (forall x z z'. DExt z z' => f x x z z')
-  -- ^ Result in case no binders are present. This can be seen as scope-indexed 'mempty'.
-  -> (forall x y y' z z' z''. (DExt z z', DExt z' z'') => f x y z z' -> f y y' z' z'' -> f x y' z z'')
-  -- ^ Composition of results for nested binders/patterns. This can be seen as scope-indexed 'mappend'.
-  -> Scope o
-  -- ^ Ambient scope.
-  -> pattern n l
-  -- ^ Pattern to process.
-  -> (forall o'. DExt o o' => f n l o o' -> pattern o o' -> r)
-  -- ^ Continuation, accepting result for the entire pattern and a (possibly refreshed) pattern.
-  -> r
-gunsafeWithPatternViaHasNameBinders withBinder id_ comp_ scope pat cont =
-  withPattern withBinder id_ comp_ scope (ggetNameBinders pat) $ \result binders ->
-    cont result (gunsafeSetNameBinders (unsafeCoerce pat) binders) -- FIXME: safer version
-
--- ** Manipulating nested 'NameBinder's
--- | If @'HasNameBinders' f@, then @f n l@ is expected to act as a binder,
--- introducing into scope @n@ some local variables, extending it to scope @l@.
--- This class allows to extract and modify the set of binders.
-class HasNameBinders f where
-  -- | Extract a set of binders from a pattern.
-  getNameBinders :: f n l -> NameBinders n l
-  getNameBinders = UnsafeNameBinders . IntSet.fromList . getNameBindersRaw
-
-  -- | Replace binders in a pattern.
-  --
-  -- This function is unsafe, because it does not check if the new set of binders
-  -- has the same size. It can therefore crash at runtime.
-  --
-  -- You should probably not use this.
-  -- This is only used for 'gunsafeWithPatternViaHasNameBinders', which is then safe to use.
-  unsafeSetNameBinders :: f n l -> NameBinders n l' -> f n l'
-  unsafeSetNameBinders e (UnsafeNameBinders m) = fst (reallyUnsafeSetNameBindersRaw e (IntSet.toList m))
-
-  -- | Extract 'RawName's of all binders occurring in a pattern.
-  getNameBindersRaw :: f n l -> [RawName]
-  default getNameBindersRaw :: forall n l. (GenericK f, GHasNameBinders (RepK f)) => f n l -> [RawName]
-  getNameBindersRaw = ggetNameBindersRaw . fromK @_ @f @(n :&&: l :&&: LoT0)
-
-  -- | This is a version of 'unsafeSetNameBinders'
-  -- that takes in a list of 'RawName's.
-  --
-  -- It does not check if the given list has enough elements.
-  -- It does not check if the raw names are fresh in the scope @n@.
-  -- It does not check if the raw names given are distinct.
-  --
-  -- You should never use this. This is only used for generic implementation of 'HasNameBinders'.
-  reallyUnsafeSetNameBindersRaw :: f n l -> [RawName] -> (f n l', [RawName])
-  default reallyUnsafeSetNameBindersRaw :: forall n l l'. (GenericK f, GValidNameBinders f (RepK f), GHasNameBinders (RepK f)) => f n l -> [RawName] -> (f n l', [RawName])
-  reallyUnsafeSetNameBindersRaw e names =
-    let (e', names') = greallyUnsafeSetNameBindersRaw (fromK @_ @f @(n :&&: l :&&: LoT0) e) names
-     in (toK @_ @f @(n :&&: l' :&&: LoT0) e', names')
-
-instance HasNameBinders NameBinder where
-  getNameBindersRaw (UnsafeNameBinder (UnsafeName name)) = [name]
-  reallyUnsafeSetNameBindersRaw _ (name:names) = (UnsafeNameBinder (UnsafeName name), names)
-
-instance HasNameBinders NameBinderList
-
--- ** Generic
-
-ggetNameBinders :: forall f n l. (GenericK f, GHasNameBinders (RepK f)) => f n l -> NameBinders n l
-ggetNameBinders = UnsafeNameBinders . IntSet.fromList . ggetNameBindersRaw . fromK @_ @f @(n :&&: l :&&: LoT0)
-
-gunsafeSetNameBinders :: forall f n l l'. (GenericK f, GValidNameBinders f (RepK f), GHasNameBinders (RepK f)) => f n l -> NameBinders n l' -> f n l'
-gunsafeSetNameBinders e (UnsafeNameBinders m) = toK @_ @f @(n :&&: l' :&&: LoT0) $
-  fst (greallyUnsafeSetNameBindersRaw (fromK @_ @f @(n :&&: l :&&: LoT0) e) (IntSet.toList m))
-
-class GHasNameBinders f where
-  ggetNameBindersRaw :: f as -> [RawName]
-  greallyUnsafeSetNameBindersRaw :: f as -> [RawName] -> (f bs, [RawName])
-
-instance GHasNameBinders V1 where
-  ggetNameBindersRaw _ = error "absurd: Generics.Kind.V1"
-  greallyUnsafeSetNameBindersRaw _ _ = error "absurd: Generics.Kind.V1"
-instance GHasNameBinders U1 where
-  ggetNameBindersRaw U1 = []
-  greallyUnsafeSetNameBindersRaw U1 names = (U1, names)
-
-instance (GHasNameBinders f, GHasNameBinders g) => GHasNameBinders (f :+: g) where
-  ggetNameBindersRaw (L1 x) = ggetNameBindersRaw x
-  ggetNameBindersRaw (R1 x) = ggetNameBindersRaw x
-
-  greallyUnsafeSetNameBindersRaw (L1 x) names = first L1 (greallyUnsafeSetNameBindersRaw x names)
-  greallyUnsafeSetNameBindersRaw (R1 x) names = first R1 (greallyUnsafeSetNameBindersRaw x names)
-
--- | FIXME: this is, perhaps, the most "unsafe" place for the user
--- since it does not reject "parallel" binders:
---
---    data BadPattern n l = BadPattern (NameBinder n l) (NameBinder n l)
---
--- This instance will treat both binders in the same way as "nested":
---
---    data GoodPattern n l = forall i. GoodPattern (NameBinder n i) (NameBinder i l)
---
--- However, Template Haskell code at the moment will never generate "parallel" binders,
--- and the very user is unlikely to misuse this instance, since "parallel" binders
--- require extra effort to support it.
---
--- Still, it would be better to detect and reject any "parallel" or otherwise improper binders.
+-- is either @IntMap@ or @IntSet@, many of the operations
+-- have a worst-case complexity of \(O(\min(n,W))\).
+-- This means that the operation can become linear in the size of the scope \(n\) with a
+-- maximum of \(W\), the number of bits in an 'Int' (32 or 64).
+module Control.Monad.Foil.Internal where
+
+import           Control.DeepSeq    (NFData (..))
+import           Data.Bifunctor
+import           Data.Coerce        (coerce)
+import           Data.Functor.Compose (Compose (..))
+import           Data.Bifunctor.Tannen (Tannen (..))
+import           Data.IntMap
+import qualified Data.IntMap        as IntMap
+import qualified Data.Map
+import           Data.IntSet
+import qualified Data.IntSet        as IntSet
+import           Data.Kind          (Type)
+import qualified Data.Type.Equality as Type
+import           Generics.Kind
+import           Unsafe.Coerce
+
+import Control.Monad.Foil.Internal.ValidNameBinders
+
+-- $setup
+-- >>> :set -XDataKinds
+-- >>> :set -XFlexibleContexts
+-- >>> :set -Wno-simplifiable-class-constraints
+-- >>> import qualified Data.Map as Map
+-- >>> import qualified Data.IntSet as IntSet
+-- >>> import Data.Bifunctor.Tannen
+
+-- * Safe types and operations
+
+-- | 'S' is a data kind of scope indices.
+--
+-- @since 0.0.1
+data S
+  = VoidS -- ^ 'VoidS' is the only explicit scope available to the users, representing an empty scope.
+          -- All other scopes are represented with type variables,
+          -- bound in rank-2 polymophic functions like 'withFreshBinder'.
+
+-- | A safe scope, indexed by a type-level scope index @n@.
+--
+-- @since 0.0.1
+newtype Scope (n :: S) = UnsafeScope RawScope
+  deriving newtype NFData
+
+-- | A name in a safe scope, indexed by a type-level scope index @n@.
+--
+-- @since 0.0.1
+newtype Name (n :: S) = UnsafeName RawName
+  deriving newtype (NFData, Eq, Ord, Show)
+
+-- | Convert 'Name' into an identifier.
+-- This may be useful for printing and debugging.
+--
+-- @since 0.0.1
+nameId :: Name l -> Id
+nameId (UnsafeName i) = i
+
+-- | A name binder is a name that extends scope @n@ to a (larger) scope @l@.
+--
+-- @since 0.0.1
+newtype NameBinder (n :: S) (l :: S) =
+  UnsafeNameBinder (Name l)
+    deriving newtype (NFData, Eq, Ord, Show)
+
+-- | An empty scope (without any names).
+--
+-- @since 0.0.1
+emptyScope :: Scope VoidS
+emptyScope = UnsafeScope IntSet.empty
+
+-- | A runtime check for potential name capture.
+--
+-- @since 0.0.1
+member :: Name l -> Scope n -> Bool
+member (UnsafeName name) (UnsafeScope s) = rawMember name s
+
+-- ** Extending scopes
+
+-- | \(O(\min(n,W))\).
+-- Extend a scope with one name (safely).
+-- Note that as long as the foil is used as intended,
+-- the name binder is guaranteed to introduce a name
+-- that does not appear in the initial scope.
+--
+-- @since 0.0.1
+{-# INLINABLE extendScope #-}
+extendScope :: NameBinder n l -> Scope n -> Scope l
+extendScope (UnsafeNameBinder (UnsafeName name)) (UnsafeScope scope) =
+  UnsafeScope (IntSet.insert name scope)
+
+-- | Extend scope with variables inside a pattern.
+-- This is a more flexible version of 'extendScope'.
+--
+-- @since 0.0.1
+{-# INLINABLE extendScopePattern #-}
+extendScopePattern
+  :: (Distinct n, CoSinkable pattern)
+  => pattern n l -> Scope n -> Scope l
+extendScopePattern pat scope = withPattern
+  (\_scope' binder k ->
+    unsafeAssertFresh binder $ \binder' ->
+      k (ExtendScope (extendScope binder)) binder')
+  idExtendScope
+  compExtendScope
+  scope
+  pat
+  (\(ExtendScope extend) _ _ -> extend scope)
+
+-- | Auxiliary data structure for scope extension. Used in 'extendScopePattern'.
+--
+-- @since 0.1.0
+newtype ExtendScope n l (o :: S) (o' :: S) = ExtendScope (Scope n -> Scope l)
+
+-- | Identity scope extension (no extension).
+--
+-- @since 0.1.0
+idExtendScope :: ExtendScope n n o o'
+idExtendScope = ExtendScope id
+
+-- | Compose scope extensions.
+--
+-- @since 0.1.0
+compExtendScope
+  :: ExtendScope n i o o'
+  -> ExtendScope i l o' o''
+  -> ExtendScope n l o o''
+compExtendScope (ExtendScope f) (ExtendScope g)
+  = ExtendScope (g . f)
+
+-- ** Collecting new names
+
+-- | Extract name from a name binder.
+--
+-- @since 0.0.1
+nameOf :: NameBinder n l -> Name l
+nameOf (UnsafeNameBinder name) = name
+
+-- | Extract names from a pattern.
+-- This is a more flexible version of 'nameOf'.
+--
+-- @since 0.1.0
+namesOfPattern
+  :: forall pattern n l. (Distinct n, CoSinkable pattern) => pattern n l -> [Name l]
+namesOfPattern pat = withPattern @_ @n
+  (\_scope' binder k ->
+    unsafeAssertFresh binder $ \binder' ->
+      k (NamesOf [nameOf binder]) binder')
+  idNamesOf compNamesOf (error "impossible") pat
+  (\(NamesOf names) _ _ -> names)
+
+-- | Auxiliary structure collecting names in scope @l@ that extend scope @n@.
+-- Used in 'namesOfPattern'.
+--
+-- @since 0.1.0
+newtype NamesOf (n :: S) l (o :: S) (o' :: S) = NamesOf [Name l]
+
+-- | Empty list of names in scope @n@.
+--
+-- @since 0.1.0
+idNamesOf :: NamesOf n n o o'
+idNamesOf = NamesOf []
+
+-- | Concatenation of names, resulting in a list of names in @l@ that extend scope @n@.
+--
+-- @since 0.1.0
+compNamesOf :: NamesOf n i o o' -> NamesOf i l o' o'' -> NamesOf n l o o''
+compNamesOf (NamesOf xs) (NamesOf ys) =
+  NamesOf (coerce xs ++ ys)
+
+-- ** Refreshing binders
+
+-- | Allocate a fresh binder for a given scope.
+--
+-- @since 0.0.1
+{-# INLINABLE withFreshBinder #-}
+withFreshBinder
+  :: Scope n
+  -> (forall l. NameBinder n l -> r) -> r
+withFreshBinder (UnsafeScope scope) cont =
+  cont binder
+  where
+    binder = UnsafeNameBinder (UnsafeName (rawFreshName scope))
+
+-- | Safely produce a fresh name binder with respect to a given scope.
+--
+-- @since 0.0.1
+{-# INLINABLE withFresh #-}
+withFresh
+  :: Distinct n => Scope n
+  -> (forall l. DExt n l => NameBinder n l -> r) -> r
+withFresh scope cont = withFreshBinder scope (`unsafeAssertFresh` cont)
+
+-- | Safely produce a fresh name binder, allocated within a given range.
+--
+-- The binder is fresh with respect to the whole ambient scope, not merely to
+-- its part inside the range. Indeed, the allocated name lies in the range and
+-- is greater than every scope member there, while a scope member outside the
+-- range cannot be equal to a name inside it (see 'rawFreshNameIn'). Thus the
+-- usual freshness evidence applies, and no invariant beyond the scope itself
+-- is required.
+--
+-- This is the primitive behind allocation policies such as per-module name
+-- blocks: reserve disjoint ranges for independently checked units, and the
+-- names allocated for them can never collide.
+--
+-- Fails with 'error' when the range is exhausted. Use 'tryWithFreshIn' to
+-- handle exhaustion instead.
+--
+-- >>> withFreshIn (NameRange 100 199) emptyScope (nameId . nameOf)
+-- 100
+--
+-- @since 0.4.0
+withFreshIn
+  :: Distinct n
+  => NameRange  -- ^ The reservation to allocate from.
+  -> Scope n    -- ^ The ambient scope.
+  -> (forall l. DExt n l => NameBinder n l -> r) -> r
+withFreshIn range scope cont =
+  case tryWithFreshIn range scope cont of
+    Just r  -> r
+    Nothing -> error ("withFreshIn: exhausted " <> show range)
+
+-- | A version of 'withFreshIn' that reports an exhausted range with 'Nothing'
+-- instead of failing. A driver that hands out ranges can then report which
+-- unit ran out of its reservation.
+--
+-- @since 0.4.0
+tryWithFreshIn
+  :: Distinct n
+  => NameRange  -- ^ The reservation to allocate from.
+  -> Scope n    -- ^ The ambient scope.
+  -> (forall l. DExt n l => NameBinder n l -> r) -> Maybe r
+tryWithFreshIn range (UnsafeScope rawScope) cont =
+  case rawFreshNameIn range rawScope of
+    Nothing   -> Nothing
+    Just name -> Just (unsafeAssertFresh (UnsafeNameBinder (UnsafeName name)) cont)
+
+-- | Rename a given pattern into a fresh version of it to extend a given scope.
+--
+-- This is similar to 'withRefreshedPattern', except here renaming always takes place.
+--
+-- @since 0.1.0
+withFreshPattern
+  :: (Distinct o, CoSinkable pattern, Sinkable e, InjectName e)
+  => Scope o      -- ^ Ambient scope.
+  -> pattern n l  -- ^ Pattern to refresh (if it clashes with the ambient scope).
+  -> (forall o'. DExt o o' => (Substitution e n o -> Substitution e l o') -> pattern o o' -> Scope o' -> r)
+  -- ^ Continuation, accepting the refreshed pattern and the extended scope.
+  -> r
+withFreshPattern scope pattern cont = withPattern
+  (\scope' binder f -> withFresh scope'
+    (\binder' -> f (WithRefreshedPattern (\subst -> addRename (sink subst) binder (nameOf binder'))) binder'))
+  idWithRefreshedPattern
+  compWithRefreshedPattern
+  scope
+  pattern
+  (\(WithRefreshedPattern f) pattern' scope' -> cont f pattern' scope')
+
+-- | Safely rename (if necessary) a given name to extend a given scope.
+-- This is similar to 'withFresh', except if the name does not clash with
+-- the scope, it can be used immediately, without renaming.
+--
+-- @since 0.0.1
+{-# INLINABLE withRefreshed #-}
+withRefreshed
+  :: Distinct o
+  => Scope o    -- ^ Ambient scope.
+  -> Name i     -- ^ Name to refresh (if it clashes with the ambient scope).
+  -> (forall o'. DExt o o' => NameBinder o o' -> r)
+  -- ^ Continuation, accepting the refreshed name.
+  -> r
+withRefreshed scope@(UnsafeScope rawScope) name@(UnsafeName rawName) cont
+  | IntSet.member rawName rawScope = withFresh scope cont
+  | otherwise = unsafeAssertFresh (UnsafeNameBinder name) cont
+
+-- | A version of 'withRefreshed' that allocates the replacement name within
+-- a given range when the candidate is taken. A client that reserves regions
+-- of the raw-name line (per-module stripes, a region for locals) uses this
+-- so that a rename cannot stray into someone else's reservation.
+--
+-- @since 0.4.0
+withRefreshedIn
+  :: Distinct o
+  => NameRange  -- ^ The reservation to allocate a replacement from.
+  -> Scope o    -- ^ Ambient scope.
+  -> Name i     -- ^ Name to refresh (if it clashes with the ambient scope).
+  -> (forall o'. DExt o o' => NameBinder o o' -> r)
+  -- ^ Continuation, accepting the refreshed name.
+  -> r
+withRefreshedIn range scope@(UnsafeScope rawScope) name@(UnsafeName rawName) cont
+  | IntSet.member rawName rawScope = withFreshIn range scope cont
+  | otherwise = unsafeAssertFresh (UnsafeNameBinder name) cont
+
+-- | Safely rename (if necessary) a given pattern to extend a given scope.
+-- This is similar to 'withFreshPattern', except if a name in the pattern
+-- does not clash with the scope, it can be used immediately, without renaming.
+--
+-- This is a more general version of 'withRefreshed'.
+--
+-- The continuation also receives the scope extended with the refreshed
+-- pattern: the traversal computes it along the way, so the caller does not
+-- recompute it with 'extendScopePattern' (a second traversal of the same
+-- pattern). The same holds for 'withFreshPattern' and 'withRefreshedPattern''.
+--
+-- Note that there is deliberately no fast path for the case when /every/ binder
+-- of the pattern is already fresh in the ambient scope. It is tempting to test
+-- all binders at once and, when none clashes, hand the continuation @sink@
+-- instead of a renaming composed per binder. That would be unsound.
+--
+-- Even when a binder is not renamed, the per-binder step is not the identity:
+-- 'addRename' /deletes/ the name from the substitution, which is how the binder
+-- shadows an outer binding of the same raw name. For skipping that delete to be
+-- harmless we would need the substitution's domain to avoid the pattern's binder
+-- names, but the substitution's domain lives in the pattern's own scope @n@,
+-- while freshness is tested against the unrelated ambient scope @o@.
+--
+-- The two can indeed disagree, because 'sink' is a coercion and does not
+-- rename: a term built in a small scope keeps its binder names when it is
+-- placed in a larger one, so a binder can share a raw name with its own
+-- enclosing scope. Ordinary evaluation produces such terms, with a @λ x1@
+-- nested inside another @λ x1@. Handing such a caller @sink@ would apply its
+-- substitution to a name the pattern binds, which is to say capture the bound
+-- variable.
+--
+-- @since 0.0.1
+{-# INLINABLE withRefreshedPattern #-}
+withRefreshedPattern
+  :: (Distinct o, CoSinkable pattern, Sinkable e, InjectName e)
+  => Scope o      -- ^ Ambient scope.
+  -> pattern n l  -- ^ Pattern to refresh (if it clashes with the ambient scope).
+  -> (forall o'. DExt o o' => (Substitution e n o -> Substitution e l o') -> pattern o o' -> Scope o' -> r)
+  -- ^ Continuation, accepting the refreshed pattern and the extended scope.
+  -> r
+withRefreshedPattern scope pattern cont = withPattern
+  (\scope' binder f -> withRefreshed scope' (nameOf binder)
+    (\binder' -> f (WithRefreshedPattern (\subst -> addRename (sink subst) binder (nameOf binder'))) binder'))
+  idWithRefreshedPattern
+  compWithRefreshedPattern
+  scope
+  pattern
+  (\(WithRefreshedPattern f) pattern' scope' -> cont f pattern' scope')
+
+-- | Refresh (if needed) bound variables introduced in a pattern.
+--
+-- This is a version of 'withRefreshedPattern' that uses functional renamings instead of 'Substitution'.
+--
+-- Like 'withRefreshedPattern', this has no all-binders-already-fresh fast path,
+-- and for the same reason. Here shadowing is handled by 'unsinkName' rather than
+-- by a delete: a name the pattern binds is routed to 'injectName' and never
+-- reaches the caller's renaming, whether or not the binder was refreshed.
+--
+-- @since 0.1.0
+withRefreshedPattern'
+  :: (CoSinkable pattern, Distinct o, InjectName e, Sinkable e)
+  => Scope o
+  -> pattern n l
+  -> (forall o'. DExt o o' => ((Name n -> e o) -> Name l -> e o') -> pattern o o' -> Scope o' -> r) -> r
+withRefreshedPattern' scope pattern cont = withPattern
+  (\scope' binder f -> withRefreshed scope' (nameOf binder)
+    (\binder' ->
+      let k subst name = case unsinkName binder name of
+              Nothing    -> injectName (nameOf binder')
+              Just name' -> sink (subst name')
+       in f (WithRefreshedPattern' k) binder'))
+  idWithRefreshedPattern'
+  compWithRefreshedPattern'
+  scope
+  pattern
+  (\(WithRefreshedPattern' f) pattern' scope' -> cont f pattern' scope')
+
+-- | Unsafely declare that a given name (binder)
+-- is already fresh in any scope @n'@.
+--
+-- @since 0.0.1
+{-# INLINABLE unsafeAssertFresh #-}
+unsafeAssertFresh :: forall n l n' l' r. NameBinder n l
+  -> (DExt n' l' => NameBinder n' l' -> r) -> r
+unsafeAssertFresh binder cont =
+  case unsafeDistinct @l' of
+    Distinct -> case unsafeExt @n' @l' of
+      Ext -> cont (unsafeCoerce binder)
+
+-- | Auxiliary structure to accumulate substitution extensions
+-- produced when refreshing a pattern.
+-- Used in 'withRefreshedPattern' and 'withFreshPattern'.
+--
+-- @since 0.1.0
+newtype WithRefreshedPattern e n l o o' = WithRefreshedPattern (Substitution e n o -> Substitution e l o')
+
+-- | Trivial substitution (coercion via 'sink').
+--
+-- @since 0.1.0
+idWithRefreshedPattern :: (Sinkable e, DExt o o') => WithRefreshedPattern e n n o o'
+idWithRefreshedPattern = WithRefreshedPattern sink
+
+-- | Composition of substitution extensions.
+--
+-- @since 0.1.0
+compWithRefreshedPattern
+  :: (DExt o o', DExt o' o'')
+  => WithRefreshedPattern e n i o o'
+  -> WithRefreshedPattern e i l o' o''
+  -> WithRefreshedPattern e n l o o''
+compWithRefreshedPattern (WithRefreshedPattern f) (WithRefreshedPattern g) =
+  WithRefreshedPattern (g . f)
+
+-- | Auxiliary structure to accumulate substitution extensions
+-- and the extended scope produced when refreshing a pattern.
+-- Similar to 'WithRefreshedPattern', except here substitutions are represented as functions.
+-- Used in 'withRefreshedPattern''.
+--
+-- @since 0.1.0
+newtype WithRefreshedPattern' e n l (o :: S) (o' :: S) = WithRefreshedPattern' ((Name n -> e o) -> Name l -> e o')
+
+-- | Trivial substitution extension (coercion via 'sink').
+--
+-- @since 0.1.0
+idWithRefreshedPattern' :: (Sinkable e, DExt o o') => WithRefreshedPattern' e n n o o'
+idWithRefreshedPattern' = WithRefreshedPattern' (\f n -> sink (f n))
+
+-- | Composition of substitution extensions.
+--
+-- @since 0.1.0
+compWithRefreshedPattern'
+  :: (DExt o o', DExt o' o'')
+  => WithRefreshedPattern' e n i o o'
+  -> WithRefreshedPattern' e i l o' o''
+  -> WithRefreshedPattern' e n l o o''
+compWithRefreshedPattern' (WithRefreshedPattern' f) (WithRefreshedPattern' g) =
+  WithRefreshedPattern' (g . f)
+
+-- ** Extracting proofs from binders and patterns
+
+-- | Evidence that scope @n@ contains distinct names.
+--
+-- @since 0.0.1
+data DistinctEvidence (n :: S) where
+  Distinct :: Distinct n => DistinctEvidence n
+
+-- | Evidence that scope @l@ extends scope @n@.
+--
+-- @since 0.0.1
+data ExtEvidence (n :: S) (l :: S) where
+  Ext :: Ext n l => ExtEvidence n l
+
+-- | A distinct scope extended with a 'NameBinder' is also distinct.
+--
+-- @since 0.0.1
+assertDistinct :: (Distinct n, CoSinkable pattern) => pattern n l -> DistinctEvidence l
+assertDistinct _ = unsafeDistinct
+
+-- | A distinct scope extended with a 'NameBinder' is also distinct.
+--
+-- @since 0.0.3
+assertExt :: CoSinkable pattern => pattern n l -> ExtEvidence n l
+assertExt _ = unsafeExt
+
+-- | Unsafely declare that scope @n@ is distinct.
+-- Used in 'unsafeAssertFresh'.
+--
+-- @since 0.0.1
+unsafeDistinct :: DistinctEvidence n
+unsafeDistinct = unsafeCoerce (Distinct :: DistinctEvidence VoidS)
+
+-- | Unsafely declare that scope @l@ extends scope @n@.
+-- Used in 'unsafeAssertFresh'.
+--
+-- @since 0.0.1
+unsafeExt :: ExtEvidence n l
+unsafeExt = unsafeCoerce (Ext :: ExtEvidence VoidS VoidS)
+
+-- ** Unsinking names
+
+-- | Try coercing the name back to the (smaller) scope,
+-- given a binder that extends that scope.
+--
+-- @since 0.0.1
+unsinkName :: NameBinder n l -> Name l -> Maybe (Name n)
+unsinkName binder name@(UnsafeName raw)
+  | nameOf binder == name = Nothing
+  | otherwise = Just (UnsafeName raw)
+
+-- | Check if a name in the extended context
+-- is introduced in a pattern or comes from the outer scope @n@.
+--
+-- This is a generalization of 'unsinkName'.
+--
+-- @since 0.1.0
+unsinkNamePattern
+  :: forall pattern n l. (Distinct n, CoSinkable pattern)
+  => pattern n l -> Name l -> Maybe (Name n)
+unsinkNamePattern pat = withPattern @_ @n
+  (\_scope' binder k ->
+      unsafeAssertFresh binder $ \binder' ->
+        k (UnsinkName (unsinkName binder)) binder')
+  idUnsinkName
+  compUnsinkName
+  (error "impossible")  -- scope is not used, but has to be provided in general
+  pat
+  (\(UnsinkName unsink) _ _ -> unsink)
+
+-- | Auxiliary structure for unsinking names.
+-- Used in 'unsinkNamePattern'.
+--
+-- @since 0.1.0
+newtype UnsinkName n l (o :: S) (o' :: S) = UnsinkName (Name l -> Maybe (Name n))
+
+-- | Trivial unsinking. If no scope extension took place, any name is free (since it cannot be bound by anything).
+--
+-- @since 0.1.0
+idUnsinkName :: UnsinkName n n o o'
+idUnsinkName = UnsinkName Just
+
+-- | Composition of unsinking for nested binders/patterns.
+--
+-- @since 0.1.0
+compUnsinkName
+  :: UnsinkName n i o o'
+  -> UnsinkName i l o' o''
+  -> UnsinkName n l o o''
+compUnsinkName (UnsinkName f) (UnsinkName g)
+  = UnsinkName (\name -> g name >>= f)
+
+-- * Sets of names, and scope restriction
+--
+-- The foil accounts for scope /extension/: 'NameBinder' adds names, 'Ext' is
+-- the erasable evidence, and 'sink' is a coercion. Restriction is the other
+-- direction, and it needs no new constraint class. Read from the other end,
+-- @'Ext' m n@ /is/ the statement that every name of @m@ is a name of @n@, and
+-- the runtime witness of it is the smaller 'Scope'.
+--
+-- What restriction does need is a way to talk about a /subset/ of the names in
+-- scope, which is 'NameSet', and a way to cut a scope down to one, which is
+-- 'withRestrictedScope'. Unlike extension, restriction cannot be a pure
+-- coercion. 'sink' is sound because a term\'s support is contained in its
+-- scope, and the converse has no such invariant, so it has to be tested.
+
+-- | A set of names of scope @n@.
+--
+-- This is not a 'Scope': a 'Scope' is /all/ the names in scope, and the foil
+-- relies on that (it is what freshness is tested against, and what 'Distinct'
+-- speaks about). A 'NameSet' is any subset of them, such as the names a term
+-- uses or the assumptions a declaration depends on, and carries no such
+-- invariant.
+--
+-- '<>' is union and 'mempty' is empty, so a 'NameSet' can be accumulated with
+-- 'foldMap'.
+--
+-- @since 0.4.0
+newtype NameSet (n :: S) = UnsafeNameSet RawScope
+  deriving newtype (NFData, Eq, Semigroup, Monoid)
+
+-- | An empty set of names.
+--
+-- @since 0.4.0
+emptyNameSet :: NameSet n
+emptyNameSet = UnsafeNameSet IntSet.empty
+
+-- | \(O(1)\). A set of one name.
+--
+-- @since 0.4.0
+nameSetSingleton :: Name n -> NameSet n
+nameSetSingleton (UnsafeName name) = UnsafeNameSet (IntSet.singleton name)
+
+-- | \(O(\min(n,W))\). Add a name to a set.
+--
+-- @since 0.4.0
+nameSetInsert :: Name n -> NameSet n -> NameSet n
+nameSetInsert (UnsafeName name) (UnsafeNameSet names) =
+  UnsafeNameSet (IntSet.insert name names)
+
+-- | \(O(\min(n,W))\). Is this name in the set?
+--
+-- @since 0.4.0
+nameSetMember :: Name n -> NameSet n -> Bool
+nameSetMember (UnsafeName name) (UnsafeNameSet names) = IntSet.member name names
+
+-- | Is the set empty?
+--
+-- @since 0.4.0
+nameSetNull :: NameSet n -> Bool
+nameSetNull (UnsafeNameSet names) = IntSet.null names
+
+-- | How many names are in the set?
+--
+-- @since 0.4.0
+nameSetSize :: NameSet n -> Int
+nameSetSize (UnsafeNameSet names) = IntSet.size names
+
+-- | The names in the set, in ascending order of their identifiers.
+--
+-- @since 0.4.0
+nameSetToList :: NameSet n -> [Name n]
+nameSetToList (UnsafeNameSet names) = Prelude.map UnsafeName (IntSet.toAscList names)
+
+-- | A set of the given names.
+--
+-- @since 0.4.0
+nameSetFromList :: [Name n] -> NameSet n
+nameSetFromList names = UnsafeNameSet (IntSet.fromList (Prelude.map nameId names))
+
+-- | A set of names sinks like anything else: rename each of its names.
+--
+-- As always, the proof is what makes 'sink' a coercion here, and a coercion is
+-- what it has to be for a support computed under a binder to be usable in the
+-- scope outside it without rebuilding the set.
+instance Sinkable NameSet where
+  sinkabilityProof rename = nameSetFromList . Prelude.map rename . nameSetToList
+
+-- | All the names in a scope.
+--
+-- @since 0.4.0
+scopeToNameSet :: Scope n -> NameSet n
+scopeToNameSet (UnsafeScope names) = UnsafeNameSet names
+
+-- | The names a pattern binds.
+--
+-- @since 0.4.0
+nameSetOfPattern :: CoSinkable binder => binder n l -> NameSet l
+nameSetOfPattern binder = UnsafeNameSet bound
+  where
+    UnsafeNameBinders bound = fromNameBindersList (nameBinderListOf binder)
+
+-- | \(O(\min(n,W))\). Does the scope contain every name in the set?
+--
+-- This is the test that restriction of a term comes down to, so it is the one
+-- place a restriction is paid for: compare a term\'s support against the scope
+-- it is to be restricted to.
+--
+-- @since 0.4.0
+nameSetSubsetOfScope :: NameSet l -> Scope n -> Bool
+nameSetSubsetOfScope (UnsafeNameSet names) (UnsafeScope scope) =
+  names `IntSet.isSubsetOf` scope
+
+-- | Drop the names a pattern binds, taking a set of names of the inner scope to
+-- a set of names of the outer one.
+--
+-- This is 'unsinkNamePattern' for a whole set at once, and \(O(\min(n,W))\)
+-- rather than one membership test per name. Removing the pattern\'s names is
+-- right even when one of them shares a raw name with the enclosing scope: inside
+-- the pattern that raw name denotes the binder, so no occurrence of it there is
+-- an occurrence of the outer name.
+--
+-- @since 0.4.0
+unsinkNameSet :: CoSinkable binder => binder n l -> NameSet l -> NameSet n
+unsinkNameSet binder (UnsafeNameSet names) = UnsafeNameSet (names IntSet.\\ bound)
+  where
+    UnsafeNameBinders bound = fromNameBindersList (nameBinderListOf binder)
+
+-- | Cut a scope down to a subset of its names.
+--
+-- The names must be names of @n@; nothing checks it, which is why this is the
+-- only entry point and takes a 'NameSet' rather than a bare @IntSet@. The
+-- continuation gets @'Ext' m n@, so anything living in the smaller scope can be
+-- 'sink'ed back into the larger one for free, and @'Distinct' m@, since a subset
+-- of distinct names is distinct.
+--
+-- __Note on allocation.__ A name allocated from the restricted scope is fresh
+-- with respect to @m@ and /not/ to @n@, so it may collide with a name of @n@
+-- that the restriction dropped. This is sound, since @'Ext' m n@ gives no way
+-- to move a term of @n@ into a scope extending @m@. It does mean that a
+-- restricted scope is for inspecting and restricting terms, and not a base to
+-- build new binders on and then mix with the original scope.
+--
+-- @since 0.4.0
+withRestrictedScope
+  :: forall n r. Distinct n
+  => NameSet n
+  -- ^ Names to keep. Must be names of @n@.
+  -> (forall m. (Ext m n, Distinct m) => Scope m -> r)
+  -> r
+withRestrictedScope (UnsafeNameSet names) cont =
+  unsafeAssertRestricted @n (UnsafeScope names) cont
+
+-- | Unsafely declare that a scope is a restriction of scope @n@.
+-- Used in 'withRestrictedScope'.
+--
+-- @since 0.4.0
+unsafeAssertRestricted
+  :: forall n m r. Scope m -> ((Ext m n, Distinct m) => Scope m -> r) -> r
+unsafeAssertRestricted scope cont =
+  case unsafeDistinct @m of
+    Distinct -> case unsafeExt @m @n of
+      Ext -> cont scope
+
+-- * Unification of binders
+
+-- | Unification result for two binders,
+-- extending some common scope to scopes @l@ and @r@ respectively.
+--
+-- Due to the implementation of the foil, we can often rename binders efficiently,
+-- by renaming binders only in one of the two unified terms.
+--
+-- @since 0.0.3
+data UnifyNameBinders (pattern :: S -> S -> Type) n l r where
+  -- | Binders are the same, proving that type parameters @l@ and @r@
+  -- are in fact equivalent.
+  SameNameBinders
+    :: NameBinders n l  -- ^ /Unordered/ set of binders in the unified pattern (from any of the original patterns).
+    -> UnifyNameBinders pattern n l l
+  -- | It is possible to safely rename the left binder
+  -- to match the right one.
+  RenameLeftNameBinder
+    :: NameBinders n r                    -- ^ /Unordered/ set of binders in the unified pattern (the binders from the right pattern).
+    -> (NameBinder n l -> NameBinder n r) -- ^ Binder renaming for the left pattern.
+    -> UnifyNameBinders pattern n l r
+  -- | It is possible to safely rename the right binder
+  -- to match the left one.
+  RenameRightNameBinder
+    :: NameBinders n l                    -- ^ /Unordered/ set of binders in the unified pattern (the binders from the left pattern).
+    -> (NameBinder n r -> NameBinder n l) -- ^ Binder renaming for the right pattern.
+    -> UnifyNameBinders pattern n l r
+  -- | It is necessary to rename both binders.
+  RenameBothBinders
+    :: NameBinders n lr                     -- ^ /Unordered/ set of binders in the unified pattern
+    -> (NameBinder n l -> NameBinder n lr)  -- ^ Binder renaming for the left pattern.
+    -> (NameBinder n r -> NameBinder n lr)  -- ^ Binder renaming for the right pattern.
+    -> UnifyNameBinders pattern n l r
+  -- | Cannot unify to (sub)patterns.
+  NotUnifiable :: UnifyNameBinders pattern n l r
+
+-- | Unify binders either by asserting that they are the same,
+-- or by providing a /safe/ renaming function to convert one binder to another.
+--
+-- When the binders differ, the one with the /larger/ name is renamed towards the
+-- one with the smaller name. The direction is deliberate, but it is not what
+-- makes the renaming safe.
+--
+-- The renaming returned here is not applied by substituting names blindly.
+-- Callers push it through a term with
+-- 'Control.Monad.Foil.Relative.liftRM', which refreshes a binder whenever it
+-- would capture. So the target name may well be used by a binder /inside/ the
+-- term being renamed, and the result is still correct. Binder names do not
+-- always grow with depth: a term built in a small scope keeps its small binder
+-- names when 'sink' places it in a larger one.
+--
+-- @since 0.0.3
+unifyNameBinders
+  :: forall i l r pattern. Distinct i
+  => NameBinder i l -- ^ Left pattern.
+  -> NameBinder i r -- ^ Right pattern.
+  -> UnifyNameBinders pattern i l r
+unifyNameBinders l@(UnsafeNameBinder (UnsafeName i1)) r@(UnsafeNameBinder (UnsafeName i2))
+  | i1 == i2  = case assertDistinct l of
+      Distinct -> unsafeCoerce (SameNameBinders (nameBindersSingleton l))  -- equal names extend scopes equally
+  | i1 < i2   = RenameRightNameBinder (nameBindersSingleton l) $ \(UnsafeNameBinder (UnsafeName i'')) ->
+      if i'' == i2 then UnsafeNameBinder (UnsafeName i1) else UnsafeNameBinder (UnsafeName i'')
+  | otherwise = RenameLeftNameBinder (nameBindersSingleton r) $ \(UnsafeNameBinder (UnsafeName i')) ->
+      if i'  == i1 then UnsafeNameBinder (UnsafeName i2) else UnsafeNameBinder (UnsafeName i')
+
+-- | Unsafely merge results of unification for nested binders/patterns.
+-- Used in 'andThenUnifyPatterns'.
+--
+-- @since 0.1.0
+unsafeMergeUnifyBinders :: UnifyNameBinders pattern a a' a'' -> UnifyNameBinders pattern a''' b' b'' -> UnifyNameBinders pattern a b' b''
+unsafeMergeUnifyBinders = \case
+
+  SameNameBinders x -> \case
+    SameNameBinders y -> SameNameBinders (x `unsafeMergeNameBinders` y)
+    RenameLeftNameBinder y f -> RenameLeftNameBinder (x `unsafeMergeNameBinders` y) (unsafeCoerce f)
+    RenameRightNameBinder y g -> RenameRightNameBinder (x `unsafeMergeNameBinders` y) (unsafeCoerce g)
+    RenameBothBinders y f g -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f) (unsafeCoerce g)
+    NotUnifiable -> NotUnifiable
+
+  RenameLeftNameBinder x f -> \case
+    SameNameBinders y -> RenameLeftNameBinder (x `unsafeMergeNameBinders` y) (unsafeCoerce f)
+    RenameLeftNameBinder y g -> RenameLeftNameBinder (x `unsafeMergeNameBinders` y) (unsafeCoerce f . unsafeCoerce g)
+    RenameRightNameBinder y g -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f) (unsafeCoerce g)
+    RenameBothBinders y f' g -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f . unsafeCoerce f') (unsafeCoerce g)
+    NotUnifiable -> NotUnifiable
+
+  RenameRightNameBinder x g -> \case
+    SameNameBinders y -> RenameRightNameBinder (x `unsafeMergeNameBinders` y) (unsafeCoerce g)
+    RenameLeftNameBinder y f -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f) (unsafeCoerce g)
+    RenameRightNameBinder y g' -> RenameRightNameBinder (x `unsafeMergeNameBinders` y) (unsafeCoerce g . unsafeCoerce g')
+    RenameBothBinders y f g' -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f) (unsafeCoerce g . unsafeCoerce g')
+    NotUnifiable -> NotUnifiable
+
+  RenameBothBinders x f g -> \case
+    SameNameBinders y -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f) (unsafeCoerce g)
+    RenameLeftNameBinder y f' -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f . unsafeCoerce f') (unsafeCoerce g)
+    RenameRightNameBinder y g' -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f) (unsafeCoerce g . unsafeCoerce g')
+    RenameBothBinders y f' g' -> RenameBothBinders (x `unsafeMergeNameBinders` y) (unsafeCoerce f . unsafeCoerce f') (unsafeCoerce g . unsafeCoerce g')
+    NotUnifiable -> NotUnifiable
+
+  NotUnifiable -> const (NotUnifiable)
+
+-- | Chain unification of nested patterns.
+--
+-- @since 0.1.0
+andThenUnifyPatterns
+  :: (UnifiablePattern pattern, Distinct l, Distinct l')
+  => UnifyNameBinders pattern n l l'    -- ^ Unifying action for some outer patterns.
+  -> (pattern l r, pattern l' r')       -- ^ Two nested patterns (cannot be unified directly since they extend different scopes).
+  -> UnifyNameBinders pattern n r r'
+andThenUnifyPatterns u (l, r) = unsafeMergeUnifyBinders u (unifyPatterns (unsafeCoerce l) r)
+
+-- | Chain unification of nested patterns with 'NameBinder's.
+--
+-- @since 0.1.0
+andThenUnifyNameBinders
+  :: (UnifiablePattern pattern, Distinct l, Distinct l')
+  => UnifyNameBinders pattern n l l'    -- ^ Unifying action for some outer patterns.
+  -> (NameBinder l r, NameBinder l' r') -- ^ Two nested binders (cannot be unified directly since they extend different scopes).
+  -> UnifyNameBinders pattern n r r'
+andThenUnifyNameBinders u (l, r) = unsafeMergeUnifyBinders u (unifyNameBinders (unsafeCoerce l) r)
+
+-- | An /unordered/ collection of 'NameBinder's, that together extend scope @n@ to scope @l@.
+--
+-- For an ordered version see 'NameBinderList'.
+--
+-- @since 0.1.0
+newtype NameBinders (n :: S) (l :: S) = UnsafeNameBinders IntSet
+
+-- | /Unsafely/ merge sets of binders (via set union).
+--
+-- @since 0.1.0
+unsafeMergeNameBinders :: NameBinders a b -> NameBinders c d -> NameBinders n l
+unsafeMergeNameBinders (UnsafeNameBinders x) (UnsafeNameBinders y) = UnsafeNameBinders (x <> y)
+
+-- | An empty set of binders keeps the scope as is.
+--
+-- @since 0.1.0
+emptyNameBinders :: NameBinders n n
+emptyNameBinders = UnsafeNameBinders IntSet.empty
+
+-- | Composition of sets of binders.
+--
+-- @since 0.1.0
+mergeNameBinders :: NameBinders n i -> NameBinders i l -> NameBinders n l
+mergeNameBinders = unsafeMergeNameBinders
+
+-- | A singleton name binder set.
+--
+-- @since 0.1.0
+nameBindersSingleton :: NameBinder n l -> NameBinders n l
+nameBindersSingleton binder = UnsafeNameBinders (IntSet.singleton (nameId (nameOf binder)))
+
+-- | An /ordered/ collection (list) of 'NameBinder's, that together extend scope @n@ to scope @l@.
+--
+-- For an unordered version see 'NameBinders'.
+--
+-- @since 0.1.0
+data NameBinderList n l where
+  -- | An empty list of binders keeps the scope as is.
+  NameBinderListEmpty :: NameBinderList n n
+  -- | A non-empty list of binders.
+  NameBinderListCons
+    :: NameBinder n i       -- ^ Outermost binder.
+    -> NameBinderList i l   -- ^ Remaining list of binders.
+    -> NameBinderList n l
+
+-- | Convert an unordered set of name binders into an ordered list (with some order).
+--
+-- @since 0.1.0
+nameBindersList :: NameBinders n l -> NameBinderList n l
+nameBindersList (UnsafeNameBinders names) = go (IntSet.toList names)
+  where
+    go []     = unsafeCoerce NameBinderListEmpty
+    go (x:xs) = NameBinderListCons (UnsafeNameBinder (UnsafeName x)) (go xs)
+
+-- | The raw names a list of binders binds, outermost first.
+--
+-- @since 0.4.0
+rawNameBinderList :: NameBinderList n l -> [RawName]
+rawNameBinderList NameBinderListEmpty = []
+rawNameBinderList (NameBinderListCons binder binders) =
+  nameId (nameOf binder) : rawNameBinderList binders
+
+-- | Keep only those binders of a list whose names are in a given set.
+--
+-- This is the /thinning/ of a chain of binders, and it is what turns a support
+-- into a smaller chain in one step. The alternative, asking
+-- 'Control.Monad.Free.Foil.unsinkAST' at
+-- every binder whether the term can do without it, walks the term once per
+-- binder, whereas a caller can compute the support once and thin against it.
+--
+-- The thinned scope @m@ is produced rather than given, because there is nothing
+-- to give: a term\'s relevant scope (see @withRelevantScope@) is a subset of
+-- @l@ and generally not an extension of @n@, since a term need not use
+-- everything already in scope. What comes back is @n@ extended by the binders
+-- that survived, with @Ext n m@ and @Ext m l@ to place it between the two.
+--
+-- The set is taken as given. For a chain whose binders carry types, or anything
+-- else living in the intermediate scopes, the caller has to close the set under
+-- whatever those mention before thinning by it, since dropping a binder that a
+-- surviving binder\'s type refers to would leave that type unplaceable. The
+-- library cannot do that closure, having no view of what a binder carries.
+--
+-- @since 0.4.0
+withThinnedNameBinderList
+  :: forall n l r. Distinct n
+  => NameSet l            -- ^ Names to keep, closed under whatever the binders carry.
+  -> NameBinderList n l   -- ^ The chain to thin.
+  -> (forall m. (Ext n m, Ext m l, Distinct m) => NameBinderList n m -> r)
+  -> r
+withThinnedNameBinderList (UnsafeNameSet keep) binders cont =
+    unsafeAssertThinned @n @l
+      (go (Prelude.filter (`IntSet.member` keep) (rawNameBinderList binders))) cont
+  where
+    go :: forall m m'. [RawName] -> NameBinderList m m'
+    go []       = unsafeCoerce NameBinderListEmpty
+    go (x : xs) = NameBinderListCons (UnsafeNameBinder (UnsafeName x)) (go xs)
+
+-- | Unsafely place a chain of binders between two scopes.
+--
+-- Sound for a chain thinned out of @n@ to @l@: its names are those of @n@ plus
+-- some of the binders between @n@ and @l@, so it extends @n@, is extended by
+-- @l@, and is distinct because @l@ was.
+--
+-- @since 0.4.0
+unsafeAssertThinned
+  :: forall n l m r
+   . NameBinderList n m
+  -> ((Ext n m, Ext m l, Distinct m) => NameBinderList n m -> r)
+  -> r
+unsafeAssertThinned binders cont =
+  case unsafeDistinct @m of
+    Distinct -> case unsafeExt @n @m of
+      Ext -> case unsafeExt @m @l of
+        Ext -> cont binders
+
+-- | Add a binder to the end of an (ordered) list of binders.
+--
+-- Note that 'NameBinderListCons' adds a binder to the /front/ of the list, which
+-- is the outermost position. This adds one to the innermost position instead.
+--
+-- @since 0.3.1
+snocNameBinderList :: NameBinderList n i -> NameBinder i l -> NameBinderList n l
+snocNameBinderList NameBinderListEmpty binder =
+  NameBinderListCons binder NameBinderListEmpty
+snocNameBinderList (NameBinderListCons binder binders) binder' =
+  NameBinderListCons binder (snocNameBinderList binders binder')
+
+-- | Concatenate two (ordered) lists of binders, the second extending the scope
+-- that the first extends to.
+--
+-- @since 0.3.1
+concatNameBinderLists :: NameBinderList n i -> NameBinderList i l -> NameBinderList n l
+concatNameBinderLists NameBinderListEmpty binders = binders
+concatNameBinderLists (NameBinderListCons binder binders) binders' =
+  NameBinderListCons binder (concatNameBinderLists binders binders')
+
+-- | Convert an ordered list of name binders into an unordered set.
+--
+-- @since 0.1.0
+fromNameBindersList :: NameBinderList n l -> NameBinders n l
+fromNameBindersList = UnsafeNameBinders . IntSet.fromList . go
+  where
+    go :: NameBinderList n l -> [RawName]
+    go NameBinderListEmpty                 = []
+    go (NameBinderListCons binder binders) = nameId (nameOf binder) : go binders
+
+instance CoSinkable NameBinders where
+  coSinkabilityProof _rename (UnsafeNameBinders names) cont =
+    cont unsafeCoerce (UnsafeNameBinders names)
+
+  withPattern withBinder unit comp scope binders cont =
+    withPattern withBinder unit comp scope (nameBindersList binders) $ \f binders' scope' ->
+      cont f (fromNameBindersList binders') scope'
+
+instance CoSinkable NameBinderList where
+  coSinkabilityProof rename NameBinderListEmpty cont = cont rename NameBinderListEmpty
+  coSinkabilityProof rename (NameBinderListCons binder binders) cont =
+    coSinkabilityProof rename binder $ \rename' binder' ->
+      coSinkabilityProof rename' binders $ \rename'' binders' ->
+        cont rename'' (NameBinderListCons binder' binders')
+
+  withPattern withBinder unit comp scope binders cont = case binders of
+    NameBinderListEmpty -> cont unit NameBinderListEmpty scope
+    NameBinderListCons x xs ->
+      withBinder scope x $ \f x' ->
+        let scope' = extendScope x' scope
+        in withPattern withBinder unit comp scope' xs $ \f' xs' scope'' ->
+            cont (comp f f') (NameBinderListCons x' xs') scope''
+
+-- ** Pattern combinators
+
+-- | An empty pattern type specifies zero possibilities for patterns.
+--
+-- This type can be used to specify that patterns are not possible.
+--
+-- @since 0.1.0
+data V2 (n :: S) (l :: S)
+
+-- | Since 'V2' values logically don't exist, this witnesses the logical reasoning tool of "ex falso quodlibet".
+--
+-- @since 0.1.0
+absurd2 :: V2 n l -> a
+absurd2 v2 = case v2 of {}
+
+instance CoSinkable V2 where
+  coSinkabilityProof _ v2 _ = absurd2 v2
+  withPattern _ _ _ _ v2 _ = absurd2 v2
+instance UnifiablePattern V2 where
+  unifyPatterns = absurd2
+
+-- | A unit pattern type corresponds to a wildcard pattern.
+--
+-- @since 0.1.0
+data U2 (n :: S) (l :: S) where
+  U2 :: U2 n n  -- ^ Wildcard patten does not modify the scope.
+
+instance CoSinkable U2 where
+  coSinkabilityProof rename U2 cont = cont rename U2
+  withPattern _withBinder unit _combine scope U2 cont = cont unit U2 scope
+instance UnifiablePattern U2 where
+  unifyPatterns U2 U2 = SameNameBinders emptyNameBinders
+
+-- ** Unifiable patterns
+
+-- | A pattern type is unifiable if it is possible to match two
+-- patterns and decide how to rename binders.
+--
+-- Note that the default implementation compares patterns only up to their
+-- binders. See 'unifyPatterns' for what that does and does not distinguish.
+--
+-- @since 0.0.1
+class CoSinkable pattern => UnifiablePattern pattern where
+  -- | Unify two patterns and decide which binders need to be renamed.
+  --
+  -- @since 0.1.0
+  unifyPatterns :: Distinct n => pattern n l -> pattern n r -> UnifyNameBinders pattern n l r
+
+  -- | The default implementation flattens both patterns to their binders (via
+  -- 'nameBinderListOf') and unifies the resulting 'NameBinderList's. It therefore
+  -- compares only the /number and order/ of binders, and ignores
+  --
+  -- * the constructor, so two patterns built from /different/ constructors with
+  --   the same number of binders unify;
+  -- * non-binding fields (locations, sorts, literals), whatever their values;
+  -- * the nesting of sub-patterns, so @(x, (y, z))@ unifies with @((x, y), z)@.
+  --
+  -- For most languages this is the intended notion of α-equivalence: what the
+  -- body of a binding construct can refer to is precisely the pattern's binders,
+  -- in order. Since α-equivalence is defined in terms of 'unifyPatterns', this
+  -- also means that terms differing only in such a pattern are α-equivalent.
+  --
+  -- A pattern that carries semantically relevant data needs the instance
+  -- written by hand instead. Use 'UnifiableInPattern' to compare non-binding
+  -- fields, which also lets an instance ignore some of them deliberately, as a
+  -- generated instance does for BNFC source positions.
+  --
+  -- A field that is /scope-indexed/, such as a telescope step's type, cannot be
+  -- compared here at all, since comparing it up to α needs the ambient scope
+  -- and this method is given only 'Distinct'. Write 'unifyPatternsIn' for that,
+  -- and leave this one as the binder-only approximation.
+  default unifyPatterns
+    :: (CoSinkable pattern, Distinct n)
+    => pattern n l -> pattern n r -> UnifyNameBinders pattern n l r
+  unifyPatterns l r = coerce (unifyPatterns (nameBinderListOf l) (nameBinderListOf r))
+
+  -- | Unify two patterns with the ambient scope at hand.
+  --
+  -- Everything in the library that compares patterns and holds a scope goes
+  -- through this method, α-equivalence included, so this is the one to
+  -- implement when the comparison needs a scope. Comparing the payloads of a
+  -- pattern that carries them does: 'alphaEquivIn' asks for a 'Scope'.
+  --
+  -- Note that the verdict speaks about binders, so an instance comparing
+  -- payloads has to apply the renaming the verdict prescribes before it
+  -- compares them, exactly as 'Control.Monad.Free.Foil.alphaEquivScoped'
+  -- applies it to the body of a scoped term. Two telescopes @(A : 𝕌) (x : A)@
+  -- and @(B : 𝕌) (y : B)@ are α-equivalent, and their second payloads are only
+  -- equal once the first binders have been identified.
+  --
+  -- The default ignores the scope and answers with 'unifyPatterns'. An instance
+  -- that overrides this one should leave 'unifyPatterns' in place as the
+  -- binder-only approximation rather than remove it. That is what
+  -- 'unsafeEqPattern' and any caller without a scope will get, and it may be
+  -- more permissive than this one, never less.
+  unifyPatternsIn
+    :: Distinct n
+    => Scope n -> pattern n l -> pattern n r -> UnifyNameBinders pattern n l r
+  unifyPatternsIn _scope = unifyPatterns
+
+instance UnifiablePattern NameBinderList where
+  unifyPatterns NameBinderListEmpty NameBinderListEmpty = SameNameBinders emptyNameBinders
+  unifyPatterns (NameBinderListCons x xs) (NameBinderListCons y ys) =
+    case (assertDistinct x, assertDistinct y) of
+      (Distinct, Distinct) -> unifyNameBinders x y `andThenUnifyPatterns` (xs, ys)
+  -- Lists of different lengths are not unifiable. This case is reachable
+  -- whenever a language has patterns that bind different numbers of names --
+  -- a wildcard and a variable, say -- since the default 'unifyPatterns'
+  -- flattens every pattern to a 'NameBinderList'. Note that this module sets
+  -- @-Wno-incomplete-patterns@, so its absence was not reported.
+  unifyPatterns _ _ = NotUnifiable
+
+-- | Comparison of scope-indexed values up to α, in a known scope.
+--
+-- 'unifyPatterns' is given only 'Distinct', which is enough to line up binders
+-- and not enough to compare anything living in a scope. A pattern that carries
+-- a payload needs this to compare its payloads against another's, which is what
+-- 'unifyPatternsIn' is for.
+--
+-- @since 0.4.0
+class AlphaEquiv (e :: S -> Type) where
+  -- | Are two values of one scope α-equivalent?
+  --
+  -- @since 0.4.0
+  alphaEquivIn :: Distinct n => Scope n -> e n -> e n -> Bool
+
+-- | A name is α-equivalent only to itself.
+instance AlphaEquiv Name where
+  alphaEquivIn _scope = (==)
+
+-- | Unification of values in patterns.
+-- By default, 'Eq' instance is used, but it may be useful to ignore
+-- some data in pattens (such as location annotations).
+--
+-- @since 0.1.0
+class UnifiableInPattern a where
+  -- | Unify non-binding components of a pattern.
+  --
+  -- @since 0.1.0
+  unifyInPattern :: a -> a -> Bool
+  default unifyInPattern :: Eq a => a -> a -> Bool
+  unifyInPattern = (==)
+
+instance UnifiablePattern NameBinder where
+  unifyPatterns = unifyNameBinders
+
+-- | The easiest way to compare two patterns is to check if they are the same.
+-- This function is labelled /unsafe/, since we generally are interested in proper α-equivalence
+-- instead of direct equality.
+--
+-- @since 0.1.0
+unsafeEqPattern :: (UnifiablePattern pattern, Distinct n) => pattern n l -> pattern n' l' -> Bool
+unsafeEqPattern l r =
+  case unifyPatterns l (unsafeCoerce r) of
+    SameNameBinders{} -> True
+    _                 -> False
+
+-- * Safe sinking
+
+-- | Sinking an expression from scope @n@ into a (usualy extended) scope @l@,
+-- given the renaming (injection from scope @n@ to scope @l@).
+--
+-- @since 0.0.1
+class Sinkable (e :: S -> Type) where
+  -- | An implementation of this method that typechecks
+  -- proves to the compiler that the expression is indeed
+  -- 'Sinkable'. However, instead of this implementation, 'sink'
+  -- should be used at all call sites for efficiency.
+  sinkabilityProof
+    :: (Name n -> Name l)   -- ^ Map names from scope @n@ to a (possibly larger) scope @l@.
+    -> e n                  -- ^ Expression with free variables in scope @n@.
+    -> e l
+
+  default sinkabilityProof
+    :: (GenericK e, GSinkableK (RepK e)) => (Name n -> Name l) -> e n -> e l
+  sinkabilityProof rename = toK . gsinkabilityProof1 rename . fromK
+
+-- | Sinking a 'Name' is as simple as applying the renaming.
+instance Sinkable Name where
+  sinkabilityProof rename = rename
+
+-- | A container of sinkable expressions is sinkable, elementwise.
+--
+-- The point of this instance is 'sinkContainer': since the proof typechecks,
+-- sinking the whole container is a coercion, and does not walk its spine.
+instance (Functor f, Sinkable e) => Sinkable (Compose f e) where
+  sinkabilityProof rename (Compose xs) = Compose (fmap (sinkabilityProof rename) xs)
+
+-- | Efficient version of 'sinkabilityProof'.
+-- In fact, once 'sinkabilityProof' typechecks,
+-- it is safe to 'sink' by coercion.
+-- See Section 3.5 in [«The Foil: Capture-Avoiding Substitution With No Sharp Edges»](https://doi.org/10.1145/3587216.3587224) for the details.
+--
+-- 'sink' is the base of a family of \(O(1)\) coercions, named after
+-- "Data.Functor.Classes": 'sink1' sinks through one 'Functor' layer and
+-- 'sink2' through a 'Bifunctor', each justified by a lifted sinkability
+-- proof of its own.
+--
+-- Tuples and records need no private @unsafeCoerce@ helpers either. A pair
+-- of sinkables is a 'sink2' ('Data.Bifunctor.Tannen.Tannen' for a whole
+-- container of them), and a pair whose first component is scope-free is a
+-- 'sink1' through @'Compose' f ((,) a)@. A record of sinkable fields derives
+-- 'Sinkable' through 'Generics.Kind.TH.deriveGenericK' and empty 'SinkableK'
+-- and 'Sinkable' instances, after which the whole record sinks in one
+-- coercion. A record holding the 'Scope' itself is rightly refused, since
+-- there is no @SinkableK Scope@: the scope must grow when a binder is
+-- entered, so keep it beside the sinkable part and not inside it.
+--
+-- __Do not map 'sink' over a container.__ @'fmap' 'sink'@ walks the whole
+-- spine to apply a per-element coercion, where 'sink1' is one coercion.
+-- Rewrite rules turn the elementwise forms into the corresponding family
+-- member where they fire, but they are best-effort (they need optimisation
+-- on, and 'fmap' at a known functor is often resolved to the instance
+-- method first), so write the family member directly.
+--
+-- @since 0.0.1
+sink :: (Sinkable e, DExt n l) => e n -> e l
+sink = unsafeCoerce
+{-# INLINE [0] sink #-}
+
+-- The phase gates on 'sink' and 'sink2' keep them from inlining before
+-- these can match. The map rules activate at phase 1, once list fusion has
+-- backed out and rewritten unfused pipelines back to 'map' (the same trick
+-- as base's @map/coerce@). The sink2 rules finish what "bimap/sink" starts:
+-- @map (bimap sink sink)@ first becomes @map sink2@, and a functor around a
+-- 'Bifunctor' is a 'Bifunctor' again ('Tannen'), so that map is one
+-- coercion too.
+--
+-- These rules mirror the hlint hints in @.hlint.yaml@; keep the two lists
+-- in step. The one deliberate difference: @sink '<$>'@ has a hint but no
+-- rule, since the operator inlines to 'fmap' before rules run and
+-- "fmap/sink" covers it, while hlint matches surface syntax.
+{-# RULES
+"map/sink" [1]    Prelude.map sink      = sink1
+"fmap/sink"       fmap sink             = sink1
+"IntMap.map/sink" Data.IntMap.map sink  = sink1
+"Map.map/sink"    Data.Map.map sink     = sink1
+"bimap/sink"      bimap sink sink       = sink2
+"map/sink2" [1]   Prelude.map sink2     = \xs -> runTannen (sink2 (Tannen xs))
+"fmap/sink2"      fmap sink2            = \xs -> runTannen (sink2 (Tannen xs))
+  #-}
+
+-- | Sink an entire container of sinkable expressions, in \(O(1)\): 'sink'
+-- lifted through one 'Functor' layer, justified by the 'Sinkable' instance
+-- of 'Compose'.
+--
+-- The soundness argument for 'sink' extends to a container of sinkables, such
+-- as an 'Data.IntMap.IntMap' of terms, a 'Data.Map.Map' keyed by something
+-- else, or a list of them. So there is no need to walk the spine with
+-- @'fmap' 'sink'@, and entering a binder need not be \(O(size)\).
+--
+-- >>> :{
+-- sinkEnv :: DExt n l => Map.Map String (Name n) -> Map.Map String (Name l)
+-- sinkEnv = sink1
+-- :}
+--
+-- A nested container is one 'Compose' away: @f (g (e n))@ is
+-- @'Compose' f g (e n)@, and the composition is again a 'Functor', so
+-- 'sink1' covers it too.
+--
+-- Two things this does /not/ cover:
+--
+-- * A 'Scope' is __not__ sinkable, and must not be sunk: it is the set of names
+--   /in/ scope @n@, and it has to grow when a binder is entered (see 'extendScope').
+-- * A 'NameMap' must stay __total__ on the names in scope ('lookupName' errors
+--   otherwise), so sinking one has to be paired with adding the new binder's
+--   entry (see 'addNameBinder').
+--
+-- @since 0.4.0
+sink1 :: (Functor f, Sinkable e, DExt n l) => f (e n) -> f (e l)
+sink1 = getCompose . sink . Compose
+
+-- | The name 'sink1' had before the family existed.
+--
+-- @since 0.3.2
+sinkContainer :: (Functor f, Sinkable e, DExt n l) => f (e n) -> f (e l)
+sinkContainer = sink1
+{-# DEPRECATED sinkContainer "Use sink1, its name in the sink family" #-}
+
+-- | The sinkability proof lifted through a 'Bifunctor', with one renaming
+-- per slot. Once this typechecks, sinking both slots at once is a coercion;
+-- 'sink2' is to this proof exactly what 'sink' is to 'sinkabilityProof'.
+--
+-- @since 0.4.0
+sinkabilityProof2
+  :: (Bifunctor p, Sinkable e1, Sinkable e2)
+  => (Name n -> Name n')    -- ^ Map names of scope @n@ into scope @n'@.
+  -> (Name m -> Name m')    -- ^ Map names of scope @m@ into scope @m'@.
+  -> p (e1 n) (e2 m)
+  -> p (e1 n') (e2 m')
+sinkabilityProof2 rename1 rename2 =
+  bimap (sinkabilityProof rename1) (sinkabilityProof rename2)
+
+-- | Sink both slots of a 'Bifunctor' of sinkables, in \(O(1)\), the two
+-- scopes moving independently: the shape of 'Data.Functor.Classes.liftEq2',
+-- with a coercion in place of each of the two functions.
+--
+-- >>> :{
+-- sinkBoth :: (DExt n n', DExt m m') => (Name n, Name m) -> (Name n', Name m')
+-- sinkBoth = sink2
+-- :}
+--
+-- A container of such pairs is a 'Bifunctor' again, via
+-- 'Data.Bifunctor.Tannen.Tannen', so a list of pairs of names, the shape an
+-- α-equivalence test threads, also sinks in one coercion:
+--
+-- >>> :{
+-- sinkPairs :: (DExt n n', DExt m m') => [(Name n, Name m)] -> [(Name n', Name m')]
+-- sinkPairs = runTannen . sink2 . Tannen
+-- :}
+--
+-- @since 0.4.0
+sink2
+  :: (Bifunctor p, Sinkable e1, Sinkable e2, DExt n n', DExt m m')
+  => p (e1 n) (e2 m) -> p (e1 n') (e2 m')
+sink2 = unsafeCoerce
+{-# INLINE [0] sink2 #-}
+
+-- | Extend renaming when going under a 'CoSinkable' pattern (generalized binder).
+-- Note that the scope under pattern is independent of the codomain of the renaming.
+--
+-- This function is used to go under binders when implementing 'sinkabilityProof'
+-- and is both a generalization of 'extendRenamingNameBinder' and an efficient implementation of 'coSinkabilityProof'.
+--
+-- @since 0.0.1
+extendRenaming
+  :: CoSinkable pattern
+  => (Name n -> Name n')  -- ^ Map names from scope @n@ to a (possibly larger) scope @n'@.
+  -> pattern n l          -- ^ A pattern that extends scope @n@ to another scope @l@.
+  -> (forall l'. (Name l -> Name l') -> pattern n' l' -> r )
+  -- ^ A continuation, accepting an extended renaming from @l@ to @l'@ (which itself extends @n'@)
+  -- and a (possibly refreshed) pattern that extends @n'@ to @l'@.
+  -> r
+extendRenaming _ pattern cont =
+  cont unsafeCoerce (unsafeCoerce pattern)
+
+-- | Extend renaming of binders when going under a 'CoSinkable' pattern (generalized binder).
+-- Note that the scope under pattern is independent of the codomain of the renaming.
+--
+-- @since 0.0.3
+extendNameBinderRenaming
+  :: CoSinkable pattern
+  => (NameBinder i n -> NameBinder i n')  -- ^ Map names from scope @n@ to a (possibly larger) scope @n'@.
+  -> pattern n l          -- ^ A pattern that extends scope @n@ to another scope @l@.
+  -> (forall l'. (NameBinder n' l -> NameBinder n' l') -> pattern n' l' -> r )
+  -- ^ A continuation, accepting an extended renaming from @l@ to @l'@ (which itself extends @n'@)
+  -- and a (possibly refreshed) pattern that extends @n'@ to @l'@.
+  -> r
+extendNameBinderRenaming _ pattern cont =
+  cont unsafeCoerce (unsafeCoerce pattern)
+
+-- | Safely compose renamings of name binders.
+-- The underlying implementation is
+--
+-- @since 0.0.3
+composeNameBinderRenamings
+  :: (NameBinder n i -> NameBinder n i')    -- ^ Rename binders extending scope @n@ from @i@ to @i'@.
+  -> (NameBinder i' l -> NameBinder i' l')  -- ^ Rename binders extending scope @i'@ from @l@ to @l'@.
+  -> (NameBinder n l -> NameBinder n l')
+composeNameBinderRenamings = unsafeCoerce (flip (.))
+
+-- | Convert renaming of name binders into renaming of names in the inner scopes.
+--
+-- @since 0.0.3
+fromNameBinderRenaming :: (NameBinder n l -> NameBinder n l') -> Name l -> Name l'
+fromNameBinderRenaming = coerce
+
+-- | Extend renaming when going under a 'NameBinder'.
+-- Note that the scope under binder is independent of the codomain of the renaming.
+--
+-- Semantically, this function may need to rename the binder (resulting in the new scope @l'@),
+-- to make sure it does not clash with scope @n'@.
+-- However, as it turns out, the foil makes it safe
+-- to implement this function as a coercion.
+-- See Appendix A in [«The Foil: Capture-Avoiding Substitution With No Sharp Edges»](https://doi.org/10.1145/3587216.3587224) for the details.
+--
+-- This function is used to go under binders when implementing 'sinkabilityProof'.
+-- A generalization of this function is 'extendRenaming' (which is an efficient version of 'coSinkabilityProof').
+--
+-- @since 0.0.1
+extendRenamingNameBinder
+  :: (Name n -> Name n')  -- ^ Map names from scope @n@ to a (possibly larger) scope @n'@.
+  -> NameBinder n l       -- ^ A name binder that extends scope @n@ to another scope @l@.
+  -> (forall l'. (Name l -> Name l') -> NameBinder n' l' -> r )
+  -- ^ A continuation, accepting an extended renaming from @l@ to @l'@ (which itself extends @n'@)
+  -- and a (possibly refreshed) binder that extends @n'@ to @l'@.
+  -> r
+extendRenamingNameBinder _ (UnsafeNameBinder name) cont =
+  cont unsafeCoerce (UnsafeNameBinder name)
+
+-- | 'CoSinkable' is to patterns (generalized binders)
+-- what 'Sinkable' is to expressions.
+--
+-- See Section 2.3 of [«Free Foil: Generating Efficient and Scope-Safe Abstract Syntax»](https://arxiv.org/abs/2405.16384) for more details.
+--
+-- @since 0.0.1
+class CoSinkable (pattern :: S -> S -> Type) where
+  -- | An implementation of this method that typechecks
+  -- proves to the compiler that the pattern is indeed
+  -- 'CoSinkable'. However, instead of this implementation,
+  -- 'extendRenaming' should be used at all call sites for efficiency.
+  coSinkabilityProof
+    :: (Name n -> Name n')  -- ^ Map names from scope @n@ to a (possibly larger) scope @n'@.
+    -> pattern n l          -- ^ A pattern that extends scope @n@ to another scope @l@.
+    -> (forall l'. (Name l -> Name l') -> pattern n' l' -> r)
+    -- ^ A continuation, accepting an extended renaming from @l@ to @l'@ (which itself extends @n'@)
+    -- and a (possibly refreshed) pattern that extends @n'@ to @l'@.
+    -> r
+  default coSinkabilityProof
+    :: (GenericK pattern, GSinkableK (RepK pattern))
+    => (Name n -> Name n')
+    -> pattern n l
+    -> (forall l'. (Name l -> Name l') -> pattern n' l' -> r)
+    -> r
+  coSinkabilityProof rename p cont = gsinkabilityProof2 rename (fromK @_ @pattern p) $ \rename' p' ->
+    cont rename' (toK @_ @pattern p')
+
+  -- | Generalized processing of a pattern.
+  --
+  -- You can see 'withPattern' as a CPS-style traversal over the binders in a pattern.
+  --
+  -- == Patterns that carry scoped payloads
+  --
+  -- Note that the ambient scope @o@ and the pattern's own scope @n@ are
+  -- unrelated: 'nameBinderListOf' passes 'emptyScope' and 'namesOfPattern'
+  -- passes no scope at all. The only thing relating the two is the pair of
+  -- binders each step of the traversal produces, the one the pattern has and
+  -- the one the callback hands back.
+  --
+  -- A pattern whose fields are all binders and plain data does not notice this,
+  -- and can take the default implementation. A pattern carrying a field indexed
+  -- by /its own scope/, such as the type of a telescope's step, does notice: to
+  -- rebuild that field at @o@ it needs a renaming, and the only honest one is
+  -- the identity on the raw names the pattern does not bind, corrected at the
+  -- binders that were refreshed. That renaming is 'PatternTransport', and such
+  -- a pattern should implement 'withPattern' by hand, threading one through the
+  -- traversal. See 'transportPayload' for the whole recipe.
+  --
+  -- The default implementation cannot do this, since it goes through
+  -- 'unsafeSetNameBinders', which replaces the binders and leaves every other
+  -- field as it stands: a payload mentioning a refreshed binder would keep the
+  -- name that binder used to have. Rather than answer wrongly, it refuses: a
+  -- field indexed by a scope is a type error in the generic implementation,
+  -- naming the field and pointing here.
+  withPattern
+    :: Distinct o
+    => (forall x y z r'. Distinct z => Scope z -> NameBinder x y -> (forall z'. DExt z z' => f x y z z' -> NameBinder z z' -> r') -> r')
+    -- ^ Processing of a single 'NameBinder', this will be applied to each binder in a pattern.
+    -> (forall x z z'. DExt z z' => f x x z z')
+    -- ^ Result in case no binders are present. This can be seen as scope-indexed 'mempty'.
+    -> (forall x y y' z z' z''. (DExt z z', DExt z' z'') => f x y z z' -> f y y' z' z'' -> f x y' z z'')
+    -- ^ Composition of results for nested binders/patterns. This can be seen as scope-indexed 'mappend'.
+    -> Scope o
+    -- ^ Ambient scope.
+    -> pattern n l
+    -- ^ Pattern to process.
+    -> (forall o'. DExt o o' => f n l o o' -> pattern o o' -> Scope o' -> r)
+    -- ^ Continuation, accepting the result for the entire pattern, a (possibly refreshed) pattern, and the scope extended by that pattern.
+    -> r
+  default withPattern
+    :: (Distinct o, GenericK pattern, GValidNameBinders pattern (RepK pattern), GHasNameBinders (RepK pattern))
+    => (forall x y z r'. Distinct z => Scope z -> NameBinder x y -> (forall z'. DExt z z' => f x y z z' -> NameBinder z z' -> r') -> r')
+    -> (forall x z z'. DExt z z' => f x x z z')
+    -> (forall x y y' z z' z''. (DExt z z', DExt z' z'') => f x y z z' -> f y y' z' z'' -> f x y' z z'')
+    -> Scope o
+    -> pattern n l
+    -> (forall o'. DExt o o' => f n l o o' -> pattern o o' -> Scope o' -> r)
+    -> r
+  withPattern = gunsafeWithPatternViaHasNameBinders
+
+-- ** Transporting a pattern's payloads
+
+-- | The renaming that carries a pattern's payloads into the ambient scope of
+-- 'withPattern'.
+--
+-- A pattern may carry fields indexed by its own scope, the standard example
+-- being a telescope, where each step has a type in the scope the steps before
+-- it extend to. Rebuilding such a pattern at the ambient scope means rebuilding
+-- those fields there too, and 'withPattern' hands the instance no renaming for
+-- it. This is that renaming, accumulated as the traversal goes.
+--
+-- It is abstract on purpose: the only ways to build one are 'verbatimTransport'
+-- and 'transportUnderBinder', which together are exactly what a correct
+-- 'withPattern' does.
+--
+-- Soundness rests on what 'withPattern' is allowed to do. It replaces binders
+-- and nothing else, so a raw name the pattern does not bind means in @o@ what
+-- it meant in @n@, and the identity on raw names is a renaming from the one to
+-- the other. That is the same coercion 'extendRenaming' and 'unsafeAssertFresh'
+-- already perform.
+--
+-- @since 0.4.0
+data PatternTransport (n :: S) (o :: S)
+  = TransportVerbatim
+    -- ^ No binder was refreshed, so raw names are unchanged throughout.
+  | TransportRenamed (Name n -> Name o)
+    -- ^ Some binder was refreshed, so payloads have to be traversed.
+
+-- | The transport to start a 'withPattern' traversal with, before any binder
+-- has been seen.
+--
+-- @since 0.4.0
+verbatimTransport :: PatternTransport n o
+verbatimTransport = TransportVerbatim
+
+-- | Extend a transport by one binder of the pattern.
+--
+-- The names of the inner scope are the binder's own, which goes to whatever the
+-- refreshed binder introduces, and the names of the outer scope, which the
+-- transport so far already answers for.
+--
+-- @since 0.4.0
+transportUnderBinder
+  :: PatternTransport n o
+  -> NameBinder n i    -- ^ The binder as the pattern has it.
+  -> NameBinder o o'   -- ^ The binder 'withPattern' handed back.
+  -> PatternTransport i o'
+transportUnderBinder transport binder binder'
+  | TransportVerbatim <- transport, unchanged = TransportVerbatim
+  | otherwise = TransportRenamed $ \name ->
+      if nameId name == nameId (nameOf binder)
+        then nameOf binder'
+        else unsafeCoerce (transportName transport (unsafeCoerce name))
+  where
+    unchanged = nameId (nameOf binder) == nameId (nameOf binder')
+
+-- | Carry a payload along a transport.
+--
+-- The 'Sinkable' instance does the walking, and only when it has to. While no
+-- binder has been refreshed the payload is taken over as it stands, so the
+-- traversals that never rename ('extendScopePattern', 'namesOfPattern',
+-- 'nameBinderListOf') do not walk payloads at all.
+--
+-- The whole recipe for a payload-carrying pattern, at a telescope of labelled
+-- steps:
+--
+-- > instance Sinkable e => CoSinkable (Telescope label e) where
+-- >   withPattern withBinder unit comp = go verbatimTransport
+-- >     where
+-- >       go _transport _scope TelescopeEmpty cont = cont unit TelescopeEmpty
+-- >       go transport scope (TelescopeCons label payload binder rest) cont =
+-- >         withBinder scope binder $ \fbinder binder' ->
+-- >           go (transportUnderBinder transport binder binder')
+-- >              (extendScope binder' scope) rest $ \frest rest' ->
+-- >             cont (comp fbinder frest)
+-- >               (TelescopeCons label (transportPayload transport payload)
+-- >                              binder' rest')
+--
+-- Note which transport each payload takes: the one accumulated /before/ its own
+-- binder, since that is the scope the payload lives in.
+--
+-- @since 0.4.0
+transportPayload :: Sinkable e => PatternTransport n o -> e n -> e o
+transportPayload TransportVerbatim         = unsafeCoerce
+transportPayload (TransportRenamed rename) = sinkabilityProof rename
+
+-- | Carry a single name along a transport.
+--
+-- @since 0.4.0
+transportName :: PatternTransport n o -> Name n -> Name o
+transportName TransportVerbatim         = unsafeCoerce
+transportName (TransportRenamed rename) = rename
+
+-- | Auxiliary data structure for collecting name binders. Used in 'nameBinderListOf'.
+--
+-- @since 0.2.0
+newtype WithNameBinderList r n l (o :: S) (o' :: S) = WithNameBinderList (NameBinderList l r -> NameBinderList n r)
+
+-- | Empty list of name binders (identity).
+--
+-- @since 0.2.0
+idWithNameBinderList :: DExt o o' => WithNameBinderList r n n o o'
+idWithNameBinderList = WithNameBinderList id
+
+-- | Concatenating lists of name binders (compose).
+--
+-- @since 0.2.0
+compWithNameBinderList
+  :: (DExt o o', DExt o' o'')
+  => WithNameBinderList r n i o o'
+  -> WithNameBinderList r i l o' o''
+  -> WithNameBinderList r n l o o''
+compWithNameBinderList (WithNameBinderList f) (WithNameBinderList g) =
+  WithNameBinderList (f . g)
+
+-- | Collect name binders of a generalized pattern into a name binder list,
+-- which can be more easily traversed.
+--
+-- @since 0.2.0
+nameBinderListOf :: (CoSinkable binder) => binder n l -> NameBinderList n l
+nameBinderListOf pat = withPattern
+  (\_scope' binder k ->
+    unsafeAssertFresh binder $ \binder' ->
+      k (WithNameBinderList (NameBinderListCons binder)) binder')
+  idWithNameBinderList
+  compWithNameBinderList
+  emptyScope
+  pat
+  (\(WithNameBinderList f) _ _ -> f NameBinderListEmpty)
+
+instance CoSinkable NameBinder where
+  coSinkabilityProof _rename (UnsafeNameBinder name) cont =
+    cont unsafeCoerce (UnsafeNameBinder name)
+
+  withPattern withBinder _ _ scope binder cont =
+    withBinder scope binder $ \f binder' ->
+      cont f binder' (extendScope binder' scope)
+
+-- * Safe substitions
+
+-- | A substitution is a mapping from names in scope @i@
+-- to expressions @e o@ in scope @o@.
+--
+-- @since 0.0.1
+newtype Substitution (e :: S -> Type) (i :: S) (o :: S) =
+  UnsafeSubstitution (IntMap (e o))
+
+-- | Apply substitution to a given name.
+--
+-- @since 0.0.1
+{-# INLINABLE lookupSubst #-}
+lookupSubst :: InjectName e => Substitution e i o -> Name i -> e o
+lookupSubst (UnsafeSubstitution env) (UnsafeName name) =
+    case IntMap.lookup name env of
+        Just ex -> ex
+        Nothing -> injectName (UnsafeName name)
+
+-- | Identity substitution maps all names to expresion-variables.
+--
+-- @since 0.0.1
+identitySubst
+  :: InjectName e => Substitution e i i
+identitySubst = UnsafeSubstitution IntMap.empty
+
+-- | Whether a substitution maps every name to itself (see 'addRename',
+-- which deletes identity renames, so this is one null test).
+--
+-- @since 0.4.0
+nullSubst :: Substitution e i o -> Bool
+nullSubst (UnsafeSubstitution env) = IntMap.null env
+
+-- | An empty substitution from an empty scope.
+--
+-- @since 0.2.0
+voidSubst :: Substitution e VoidS n
+voidSubst = UnsafeSubstitution IntMap.empty
+
+-- | Extend substitution with a particular mapping.
+--
+-- @since 0.0.1
+{-# INLINABLE addSubst #-}
+addSubst
+  :: Substitution e i o
+  -> NameBinder i i'
+  -> e o
+  -> Substitution e i' o
+addSubst (UnsafeSubstitution env) (UnsafeNameBinder (UnsafeName name)) ex
+  = UnsafeSubstitution (IntMap.insert name ex env)
+
+-- | Extend a substitution with a value for each binder of a pattern, in the
+-- order the pattern binds them.
+--
+-- @since 0.2.0
+addSubstPattern
+  :: CoSinkable binder
+  => Substitution e i o
+  -> binder i i'
+  -> [e o]
+  -> Substitution e i' o
+addSubstPattern subst pat = addSubstList subst (nameBinderListOf pat)
+
+-- | Extend a substitution with a value for each binder of a chain, in order.
+-- Fails with 'error' when the list of values is too short.
+--
+-- @since 0.2.0
+addSubstList
+  :: Substitution e i o
+  -> NameBinderList i i'
+  -> [e o]
+  -> Substitution e i' o
+addSubstList subst NameBinderListEmpty _ = subst
+addSubstList subst (NameBinderListCons binder binders) (x:xs) =
+  addSubstList (addSubst subst binder x) binders xs
+addSubstList _ _ [] = error "cannot add a binder to Substitution since the value list does not have enough elements"
+
+-- | Add variable renaming to a substitution.
+--
+-- When the binder is mapped to its own name, the name is /deleted/ from the
+-- substitution rather than mapped to itself. This is an optimization, but it is
+-- not only an optimization: it is also how the binder shadows an outer binding
+-- of the same raw name, so the delete cannot be skipped even when nothing is
+-- being renamed. See 'withRefreshedPattern' for why that rules out an
+-- all-binders-fresh fast path.
+--
+-- @since 0.0.1
+{-# INLINABLE addRename #-}
+addRename :: InjectName e => Substitution e i o -> NameBinder i i' -> Name o -> Substitution e i' o
+addRename s@(UnsafeSubstitution env) b@(UnsafeNameBinder (UnsafeName name1)) n@(UnsafeName name2)
+    | name1 == name2 = UnsafeSubstitution (IntMap.delete name1 env)
+    | otherwise = addSubst s b (injectName n)
+
+-- | Substitutions are sinkable as long as corresponding expressions are.
+instance (Sinkable e) => Sinkable (Substitution e i) where
+  sinkabilityProof rename (UnsafeSubstitution env) =
+    UnsafeSubstitution (fmap (sinkabilityProof rename) env)
+
+-- * 'Name' maps
+
+-- | A /total/ map from names in scope @n@ to elements of type @a@.
+--
+-- @since 0.0.1
+newtype NameMap (n :: S) a = NameMap { getNameMap :: IntMap a } deriving (Functor, Foldable, Traversable)
+
+-- | An empty map belongs in the empty scope.
+--
+-- @since 0.0.1
+emptyNameMap :: NameMap VoidS a
+emptyNameMap = NameMap IntMap.empty
+
+-- | Map over a 'NameMap', with the name each value belongs to.
+--
+-- This is the keyed version of the derived 'Functor' instance. It cannot change
+-- which names the map is defined on, so a map that was total stays total, which
+-- is what makes it a safe way to build a 'Substitution' out of one: see
+-- 'nameMapToSubstitution'.
+--
+-- @since 0.4.0
+mapWithName :: (Name n -> a -> b) -> NameMap n a -> NameMap n b
+mapWithName f (NameMap m) = NameMap (IntMap.mapWithKey (f . UnsafeName) m)
+
+-- | Convert a 'NameMap' of expressions into a 'Substitution'.
+--
+-- @since 0.2.0
+nameMapToSubstitution :: NameMap i (e o) -> Substitution e i o
+nameMapToSubstitution (NameMap m) = (UnsafeSubstitution m)
+
+-- | Convert a 'NameMap' of expressions into a 'Scope'.
+--
+-- @since 0.3.0
+nameMapToScope :: NameMap n a -> Scope n
+nameMapToScope (NameMap m) = UnsafeScope (IntMap.keysSet m)
+
+-- | Extend a map with multiple mappings (by repeatedly applying 'addNameBinder').
+--
+-- Note that the input list is expected to have __at least__ the same number of elements
+-- as there are binders in the input pattern (generalized binder).
+--
+-- @since 0.2.0
+addNameBinders :: CoSinkable binder => binder n l -> [a] -> NameMap n a -> NameMap l a
+addNameBinders pat = addNameBinderList (nameBinderListOf pat)
+
+-- | Extend a map with multiple mappings (by repeatedly applying 'addNameBinder').
+--
+-- Note that the input list is expected to have __at least__ the same number of elements
+-- as there are binders in the input name binder list.
+--
+-- See also 'addNameBinders' for a generalized version.
+--
+-- @since 0.2.0
+addNameBinderList :: NameBinderList n l -> [a] -> NameMap n a -> NameMap l a
+addNameBinderList NameBinderListEmpty _ = id
+addNameBinderList (NameBinderListCons binder binders) (x:xs) =
+  addNameBinderList binders xs . addNameBinder binder x
+addNameBinderList _ [] = error "cannot add a binder to NameMap since the value list does not have enough elements"
+
+-- | Looking up a name should always succeed.
+--
+-- Note that since 'Name' is 'Sinkable', a name of scope @n@ can be looked up in a 'NameMap' for scope @l@ whenever @l@ extends @n@.
+--
+-- @since 0.0.1
+lookupName :: Name n -> NameMap n a -> a
+lookupName name (NameMap m) =
+  case IntMap.lookup (nameId name) m of
+    Nothing -> error "impossible: unknown name in a NameMap"
+    Just x  -> x
+
+-- | Extending a map with a single mapping.
+--
+-- Note that the scope parameter of the result differs from the initial map.
+--
+-- @since 0.0.1
+addNameBinder :: NameBinder n l -> a -> NameMap n a -> NameMap l a
+addNameBinder name x (NameMap m) = NameMap (IntMap.insert (nameId (nameOf name)) x m)
+
+-- | Remove the mapping for a binder, shrinking the map back to the outer scope.
+--
+-- This is the inverse of 'addNameBinder', and is what a type checker wants when
+-- it leaves a binder it has entered.
+--
+-- @since 0.3.1
+popNameBinder :: NameBinder n l -> NameMap l a -> NameMap n a
+popNameBinder binder (NameMap m) = NameMap (IntMap.delete (nameId (nameOf binder)) m)
+
+-- | Allocate a fresh binder for each element of a list, binding each element to
+-- its binder in the map.
+--
+-- The continuation receives the extended scope, the binders in the order of the
+-- input list, and the extended map. This is the list-shaped counterpart of
+-- 'withFresh', and saves a caller from threading the scope, the binders, and the
+-- map through a recursion by hand.
+--
+-- @since 0.3.1
+withFreshNameBinderList
+  :: forall n a r. Distinct n
+  => [a]                  -- ^ A value to bind to each fresh binder.
+  -> Scope n              -- ^ The ambient scope.
+  -> NameMap n a          -- ^ The map to extend.
+  -> (forall l. DExt n l => Scope l -> NameBinderList n l -> NameMap l a -> r)
+  -> r
+withFreshNameBinderList = withFreshNameBinderListIn fullNameRange
+
+-- | A version of 'withFreshNameBinderList' that allocates within a given
+-- range (see 'withFreshIn'). This is the bulk form of range-guarded
+-- allocation: pre-allocating the names of a whole unit at once and
+-- allocating them one at a time are the same operation at different
+-- granularity, so both extend the scope index faithfully.
+--
+-- Fails with 'error' when the range is exhausted.
+--
+-- @since 0.4.0
+withFreshNameBinderListIn
+  :: forall n a r. Distinct n
+  => NameRange            -- ^ The reservation to allocate from.
+  -> [a]                  -- ^ A value to bind to each fresh binder.
+  -> Scope n              -- ^ The ambient scope.
+  -> NameMap n a          -- ^ The map to extend.
+  -> (forall l. DExt n l => Scope l -> NameBinderList n l -> NameMap l a -> r)
+  -> r
+withFreshNameBinderListIn range xs0 scope0 nameMap0 cont =
+    go xs0 scope0 NameBinderListEmpty nameMap0 cont
+  where
+    go :: forall i r'. Distinct i
+       => [a] -> Scope i -> NameBinderList n i -> NameMap i a
+       -> (forall l. DExt n l => Scope l -> NameBinderList n l -> NameMap l a -> r')
+       -> r'
+    go [] scope binders nameMap cont' =
+      case (assertDistinct binders, assertExt binders) of
+        (Distinct, Ext) -> cont' scope binders nameMap
+    go (x:xs) scope binders nameMap cont' =
+      withFreshIn range scope $ \binder ->
+        go xs
+           (extendScope binder scope)
+           (snocNameBinderList binders binder)
+           (addNameBinder binder x nameMap)
+           cont'
+
+-- * Raw types and operations
+
+-- | We will use 'Int' for efficient representation of identifiers.
+--
+-- @since 0.0.1
+type Id = Int
+
+-- | Raw name is simply an identifier.
+--
+-- @since 0.0.1
+type RawName = Id
+
+-- | A raw scope is a set of raw names.
+--
+-- @since 0.0.1
+type RawScope = IntSet
+
+-- | \(O(\min(n, W))\).
+-- Generate a fresh raw name that
+-- does not appear in a given raw scope.
+-- The guard keeps allocation out of the negative range: names below zero
+-- are reserved for interned constants, allocated by an explicit policy
+-- ('withFreshIn' at a negative range) and never by this successor. Without
+-- the guard, a scope holding only negative names would hand out the
+-- successor of its maximum, which is a "fresh" name inside the constants'
+-- region and may collide with a constant not in this scope. A scope that
+-- holds 'maxBound' is reported as exhausted rather than wrapped past,
+-- since the wrapped successor lands on an arbitrary small name that may
+-- well be taken.
+--
+-- @since 0.0.1
+rawFreshName :: RawScope -> RawName
+rawFreshName scope
+  | IntSet.null scope = 0
+  | otherwise = case IntSet.findMax scope of
+      m | m == maxBound -> error "rawFreshName: name space exhausted"
+        | otherwise     -> max 0 (m + 1)
+
+-- | An inclusive reservation of a contiguous range of raw names.
+--
+-- A range is a bound on an allocator (see 'withFreshIn'), not a set of names:
+-- its runtime content is two 'Int's. A range with @lo > hi@ is empty.
+--
+-- @since 0.4.0
+data NameRange = NameRange
+  { nameRangeLo :: !RawName  -- ^ The smallest name of the reservation.
+  , nameRangeHi :: !RawName  -- ^ The largest name of the reservation (inclusive).
+  } deriving (Eq, Show)
+
+-- | The range of all non-negative names.
+--
+-- On a scope without negative members, allocation within 'fullNameRange'
+-- agrees with 'rawFreshName'. The two diverge on a scope with negative
+-- members: 'rawFreshName' allocates right above the maximum, wherever that
+-- lands, while 'fullNameRange' clamps allocation to non-negative names.
+--
+-- @since 0.4.0
+fullNameRange :: NameRange
+fullNameRange = NameRange 0 maxBound
+
+-- | \(O(\min(n, W))\).
+-- Generate a fresh raw name within a given range: the successor of the
+-- largest scope member inside the range, or the range's low end when no
+-- scope member lies inside the range. Returns 'Nothing' when the range is
+-- exhausted (or empty to begin with).
+--
+-- The resulting name is fresh with respect to the /whole/ scope: it differs
+-- from scope members inside the range by being greater, and from members
+-- outside the range by being inside it.
+--
+-- >>> rawFreshNameIn (NameRange 10 19) (IntSet.fromList [-5, 3, 12, 100])
+-- Just 13
+-- >>> rawFreshNameIn (NameRange 10 19) (IntSet.fromList [42])
+-- Just 10
+-- >>> rawFreshNameIn (NameRange 10 19) (IntSet.fromList [3, 19])
+-- Nothing
+--
+-- Note that the implementation must not increment either bound of the range:
+-- @'IntSet.lookupLT' (hi + 1)@ would wrap around at @hi = maxBound@, and
+-- @x + 1@ would wrap around at @x = hi = maxBound@. Both are guarded here,
+-- and the property tests pin both cases.
+--
+-- @since 0.4.0
+rawFreshNameIn :: NameRange -> RawScope -> Maybe RawName
+rawFreshNameIn (NameRange lo hi) scope
+  | lo > hi   = Nothing
+  | otherwise = case IntSet.lookupLE hi scope of
+      Just x | x >= lo -> if x < hi then Just (x + 1) else Nothing
+      _                -> Just lo
+
+-- | Check if a raw name is contained in a raw scope.
+--
+-- @since 0.0.1
+rawMember :: RawName -> RawScope -> Bool
+rawMember = IntSet.member
+
+-- * Constraints
+
+-- | Every scope is a (trivial) extension of itself.
+--
+-- __Important__: this class exists to assist tracking scope extensions
+-- for type variables of kind 'S'.
+-- Users of the foil are not supposed to implement any instances of 'ExtEndo'.
+--
+-- @since 0.0.1
+class ExtEndo (n :: S)
+
+-- | Some scopes are extensions of other scopes.
+--
+-- __Important__: this class exists to assist tracking scope extensions
+-- for type variables of kind 'S'.
+-- Users of the foil are not supposed to implement any instances of 'Ext'.
+--
+-- @since 0.0.1
+class (ExtEndo n => ExtEndo l ) => Ext (n :: S) (l :: S)
+instance ( ExtEndo n => ExtEndo l ) => Ext n l
+
+-- | Scopes with distinct names.
+--
+-- __Important__: this class exists to explicitly
+-- mark scopes with distinct names.
+-- Users of the foil are not supposed to implement any instances of 'Distinct'.
+--
+-- @since 0.0.1
+class Distinct (n :: S)
+instance Distinct VoidS
+
+-- | Scope extensions with distinct names.
+--
+-- @since 0.0.1
+type DExt n l = (Distinct l, Ext n l)
+
+-- | Instances of this typeclass possess the ability to inject names.
+-- Usually, this is a variable data constructor.
+--
+-- @since 0.0.1
+class InjectName (e :: S -> Type) where
+  -- | Inject names into expressions.
+  --
+  -- @since 0.0.1
+  injectName :: Name n -> e n
+
+-- * Kind-polymorphic sinkability
+
+-- | One renaming per scope index of a kind-polymorphic type, which is what
+-- 'sinkabilityProofK' threads through a value.
+--
+-- @since 0.3.0
+data RenamingsK (as :: LoT k) (bs :: LoT k) where
+  RNil :: RenamingsK LoT0 LoT0
+  RCons :: (Name a -> Name b) -> RenamingsK as bs -> RenamingsK (a :&&: as) (b :&&: bs)
+  RSkip :: RenamingsK as bs -> RenamingsK (k :&&: as) (k :&&: bs)
+
+-- | 'Sinkable' for a type with any number of scope indices, and the class a
+-- pattern derives to obtain the foil's traversals. An instance is normally
+-- empty, leaving the generic implementation to walk the
+-- 'Generics.Kind.RepK' of the type.
+--
+-- @since 0.3.0
+class SinkableK (f :: S -> k) where
+  -- | Rename every scope index of a value, in continuation-passing style.
+  --
+  -- @since 0.3.0
+  sinkabilityProofK
+    :: forall as bs r.
+       RenamingsK as bs
+    -> f :@@: as
+    -> (forall cs. RenamingsK as cs -> f :@@: cs -> r)
+    -> r
+  default sinkabilityProofK :: forall as bs r.
+      (GenericK f, GSinkableK (RepK f))
+    => RenamingsK as bs
+    -> f :@@: as
+    -> (forall cs. RenamingsK as cs -> f :@@: cs -> r)
+    -> r
+  sinkabilityProofK rename e cont =
+    gsinkabilityProofK rename (fromK @_ @f e) $ \rename' e' ->
+      cont rename' (toK @_ @f e')
+
+-- | Move a value between two scope index lists reached from a common one, as
+-- a coercion.
+--
+-- @since 0.3.0
+sinkK :: GSinkableK f => RenamingsK xs as -> RenamingsK xs bs -> f :@@: as -> f :@@: bs
+sinkK _ _ = unsafeCoerce
+
+instance SinkableK Name where
+  sinkabilityProofK renameK@(RCons rename RNil) name cont = cont renameK (rename name)
+instance SinkableK NameBinder where
+  sinkabilityProofK (RCons _ RNil) (UnsafeNameBinder name) cont =
+    cont (RCons unsafeCoerce RNil) (UnsafeNameBinder name)
+instance SinkableK NameBinders where
+  sinkabilityProofK (RCons _ RNil) (UnsafeNameBinders s) cont =
+    cont (RCons unsafeCoerce RNil) (UnsafeNameBinders s)
+
+instance GenericK NameBinderList where
+  type RepK NameBinderList = ((Var0 :~~: Var1) :=>: U1) :+: Exists S
+    (Field (NameBinder :$: Var1 :@: Var0) :*: Field (NameBinderList :$: Var0 :@: Var2))
+  toK (L1 (SuchThat U1))                   = NameBinderListEmpty
+  toK (R1 (Exists (Field x :*: Field xs))) = NameBinderListCons x xs
+  fromK NameBinderListEmpty       = L1 (SuchThat U1)
+  fromK (NameBinderListCons x xs) = R1 (Exists (Field x :*: Field xs))
+
+instance GenericK V2 where
+  type RepK V2 = V1
+  toK _v1 = error "absurd: Generics.Kind.V1"
+  fromK = absurd2
+
+instance GenericK U2 where
+  type RepK U2 = ((Var0 :~~: Var1) :=>: U1)
+  toK (SuchThat U1) = U2
+  fromK U2 = SuchThat U1
+
+instance SinkableK NameBinderList
+instance SinkableK V2
+instance SinkableK U2
+
+-- | 'sinkabilityProofK' at a type with exactly one scope index.
+--
+-- @since 0.3.0
+sinkabilityProof1 :: SinkableK f => (Name n -> Name n') -> f n -> f n'
+sinkabilityProof1 rename e = sinkabilityProofK (RCons rename RNil) e $ \_ e' -> unsafeCoerce e'
+
+-- | 'gsinkabilityProofK' at a representation with one scope index.
+--
+-- @since 0.3.0
+gsinkabilityProof1 :: GSinkableK f => (Name n -> Name n') -> f (n :&&: LoT0) -> f (n' :&&: LoT0)
+gsinkabilityProof1 rename e = gsinkabilityProofK (RCons rename RNil) e $ \_ e' -> unsafeCoerce e'
+
+-- | 'gsinkabilityProofK' at a representation with two scope indices, the
+-- shape of a pattern: the outer scope is renamed by the given function, and
+-- the inner one by the renaming handed to the continuation.
+--
+-- @since 0.3.0
+gsinkabilityProof2
+  :: forall f n n' l r. GSinkableK f
+  => (Name n -> Name n') -> f (n :&&: l :&&: LoT0)
+  -> (forall l'. (Name l -> Name l') -> f (n' :&&: l' :&&: LoT0) -> r)
+  -> r
+gsinkabilityProof2 rename e cont =
+  gsinkabilityProofK (RCons rename (RCons id RNil)) e $ \case
+    RCons (_ :: Name n -> Name n'') (RCons rename' RNil) -> \e' ->
+      case unsafeCoerce (Type.Refl :: n' Type.:~: n') :: n' Type.:~: n'' of
+        Type.Refl -> cont rename' e'
+
+-- | 'gsinkabilityProofK' where the resulting index list is known, so that no
+-- continuation is needed.
+--
+-- @since 0.3.0
+gsinkabilityProofK' :: GSinkableK f => RenamingsK as bs -> f as -> f bs
+gsinkabilityProofK' renameK e = gsinkabilityProofK renameK e $ \_ e' -> unsafeCoerce e'
+
+-- | 'SinkableK' on the "Generics.Kind" representation of a type, which is
+-- what the default 'sinkabilityProofK' goes through.
+--
+-- @since 0.3.0
+class GSinkableK p where
+  -- | Rename every scope index of a representation.
+  --
+  -- @since 0.3.0
+  gsinkabilityProofK
+    :: forall as bs r.
+       RenamingsK as bs
+    -> p as
+    -> (forall cs. RenamingsK as cs -> p cs -> r)
+    -> r
+
+-- | 'sinkK' on a representation.
+--
+-- @since 0.3.0
+gsinkK :: GSinkableK f => RenamingsK xs as -> RenamingsK xs bs -> f as -> f bs
+gsinkK _ _ = unsafeCoerce
+
+instance GSinkableK V1 where
+  gsinkabilityProofK irename _v1 cont =
+    cont irename (error "absurd: Generics.Kind.V1")
+
+instance GSinkableK U1 where
+  gsinkabilityProofK irename U1 cont =
+    cont irename U1
+
+instance GSinkableK f => GSinkableK (M1 i c f) where
+  gsinkabilityProofK irename (M1 x) cont =
+    gsinkabilityProofK irename x $ \irename' x' ->
+      cont irename' (M1 x')
+
+instance (GSinkableK f, GSinkableK g) => GSinkableK (f :+: g) where
+  gsinkabilityProofK irename (L1 x) cont =
+    gsinkabilityProofK irename x $ \irename' x' ->
+      cont irename' (L1 x')
+  gsinkabilityProofK irename (R1 x) cont =
+    gsinkabilityProofK irename x $ \irename' x' ->
+      cont irename' (R1 x')
+
+instance (GSinkableK f, GSinkableK g) => GSinkableK (f :*: g) where
+  gsinkabilityProofK irename (x :*: y) cont =
+    gsinkabilityProofK irename x $ \irename' x' ->
+      gsinkabilityProofK irename' y $ \irename'' y' ->
+        cont irename'' (gsinkK irename' irename'' x' :*: y')
+
+instance GSinkableK f => GSinkableK (Exists S f) where
+  gsinkabilityProofK irename (Exists x) cont =
+    gsinkabilityProofK (RCons id irename) x $ \case
+      RCons _ irename' -> \x' ->
+        cont irename' (Exists x')
+
+instance {-# OVERLAPPABLE #-} GSinkableK f => GSinkableK (Exists k f) where
+  gsinkabilityProofK irename (Exists x) cont =
+    gsinkabilityProofK (RSkip irename) x $ \case
+      RSkip irename' -> \x' ->
+        cont irename' (Exists x')
+
+instance GSinkableK f => GSinkableK ((a :~~: b) :=>: f) where
+  gsinkabilityProofK irename (SuchThat x) cont =
+    gsinkabilityProofK irename x $ \(irename' :: RenamingsK as cs) x' ->
+      -- this is sort of safe...
+      case unsafeCoerce (Type.Refl :: Interpret a cs Type.:~: Interpret a cs) :: Interpret a cs Type.:~: Interpret b cs of
+        Type.Refl -> cont irename' (SuchThat x')
+
+instance GSinkableK (Field (Kon a)) where
+  gsinkabilityProofK irename (Field x) cont =
+    cont irename (Field x)
+
+instance GSinkableK (Field (Var a)) where
+  gsinkabilityProofK irename (Field x) cont =
+    cont irename (Field (unsafeCoerce x)) -- FIXME: unsafeCoerce?
+
+instance (SinkableK f, ExtractRenamingK i) => GSinkableK (Field (Kon f :@: Var i)) where
+  gsinkabilityProofK irename (Field x) cont =
+    sinkabilityProofK (RCons (extractRenamingK @_ @i irename) RNil) x $ \case
+      RCons rename' RNil -> \x' ->
+        cont (putBackRenamingK @_ @i rename' irename) (Field (unsafeCoerce x')) -- unsafeCoerce?
+
+instance SinkableK (f a) => GSinkableK (Field (Kon f :@: Kon a :@: Var0)) where
+  gsinkabilityProofK irename@(RCons _ RNil) (Field x) cont =
+    sinkabilityProofK irename x $ \rename' x' ->
+      cont rename' (Field x')
+
+instance SinkableK (f a b) => GSinkableK (Field (Kon f :@: Kon a :@: Kon b :@: Var0)) where
+  gsinkabilityProofK irename@(RCons _ RNil) (Field x) cont =
+    sinkabilityProofK irename x $ \rename' x' ->
+      cont rename' (Field x')
+
+-- | Reading one scope index out of a list of them, and putting a renaming
+-- back at that position. This is what lets a generic traversal work on the
+-- index a field actually mentions.
+--
+-- @since 0.3.0
+class ExtractRenamingK (i :: TyVar k S) where
+  -- | The renaming at this index.
+  --
+  -- @since 0.3.0
+  extractRenamingK :: forall (as :: LoT k) (bs :: LoT k).
+    RenamingsK as bs -> Name (Interpret (Var i) as) -> Name (Interpret (Var i) bs)
+  -- | Replace the renaming at this index.
+  --
+  -- @since 0.3.0
+  putBackRenamingK :: forall c (as :: LoT k) (bs :: LoT k).
+       (Name (Interpret (Var i) as) -> Name c)
+    -> RenamingsK as bs
+    -> RenamingsK as (PutBackLoT i c bs)
+
+instance ExtractRenamingK VZ where
+  extractRenamingK (RCons f _fs) = f
+  putBackRenamingK f (RCons _ gs) = RCons f gs
+
+instance ExtractRenamingK x => ExtractRenamingK (VS x) where
+  extractRenamingK (RCons _f fs) = extractRenamingK @_ @x fs
+  putBackRenamingK f (RCons g gs) = RCons g (putBackRenamingK @_ @x f gs)
+
+-- | 'extractRenamingK' at two indices at once, as a pattern's traversal needs.
+--
+-- @since 0.3.0
+extractTwoRenamingsK :: forall k (i :: TyVar k S) (j :: TyVar k S) (as :: LoT k) (bs :: LoT k).
+    (ExtractRenamingK i, ExtractRenamingK j)
+  => RenamingsK as bs
+  -> RenamingsK
+      (Interpret (Var i) as :&&: Interpret (Var j) as :&&: LoT0)
+      (Interpret (Var i) bs :&&: Interpret (Var j) bs :&&: LoT0)
+extractTwoRenamingsK irename =
+  (RCons (extractRenamingK @_ @i irename) (RCons (extractRenamingK @_ @j irename) RNil))
+
+-- | 'putBackRenamingK' at two indices at once.
+--
+-- @since 0.3.0
+putBackTwoRenamingsK :: forall k (i :: TyVar k S) (j :: TyVar k S) c1 c2 (as :: LoT k) (bs :: LoT k).
+    (ExtractRenamingK i, ExtractRenamingK j)
+  => RenamingsK
+      (Interpret (Var i) as :&&: Interpret (Var j) as :&&: LoT0)
+      (c1 :&&: c2 :&&: LoT0)
+  -> RenamingsK as bs
+  -> RenamingsK as (PutBackLoT j c2 (PutBackLoT i c1 bs))
+putBackTwoRenamingsK (RCons f1 (RCons f2 RNil)) rename
+  = putBackRenamingK @_ @j f2 (putBackRenamingK @_ @i f1 rename)
+
+instance (SinkableK f, ExtractRenamingK i, ExtractRenamingK j) => GSinkableK (Field (Kon f :@: Var (i :: TyVar k S) :@: Var (j :: TyVar k S))) where
+  gsinkabilityProofK irename (Field x) cont =
+    sinkabilityProofK (extractTwoRenamingsK @_ @i @j irename) x $ \rename' x' ->
+      case rename' of
+        RCons _ (RCons _ RNil) ->
+          cont (putBackTwoRenamingsK @_ @i @j rename' irename)
+              (Field (unsafeCoerce x'))  -- FIXME: can we do better than unsafeCoerce?
+
+instance (Functor f, GSinkableK (Field x)) => GSinkableK (Field (Kon f :@: x)) where
+  gsinkabilityProofK irename (Field x) cont =
+    cont irename (Field (fmap
+      (unField . gsinkabilityProofK' @(Field x) irename . Field)
+      x))
+
+instance (Bifunctor f, GSinkableK (Field x), GSinkableK (Field y)) => GSinkableK (Field (Kon f :@: x :@: y)) where
+  gsinkabilityProofK irename (Field x) cont =
+    cont irename (Field (bimap
+      (unField . gsinkabilityProofK' @(Field x) irename . Field)
+      (unField . gsinkabilityProofK' @(Field y) irename . Field)
+      x))
+
+-- * Kind-polymorphic types with binders
+
+-- ** Generic version of 'withPattern'
+
+-- | Generic generalized processing of a pattern via 'GHasNameBinders'.
+--
+-- This can be used as a default implementation of 'withPattern'.
+--
+-- @since 0.3.0
+gunsafeWithPatternViaHasNameBinders
+  :: forall pattern f o n l r.
+      (Distinct o, GenericK pattern, GValidNameBinders pattern (RepK pattern), GHasNameBinders (RepK pattern))
+  => (forall x y z r'. Distinct z => Scope z -> NameBinder x y -> (forall z'. DExt z z' => f x y z z' -> NameBinder z z' -> r') -> r')
+  -- ^ Processing of a single 'NameBinder', this will be applied to each binder in a pattern.
+  -> (forall x z z'. DExt z z' => f x x z z')
+  -- ^ Result in case no binders are present. This can be seen as scope-indexed 'mempty'.
+  -> (forall x y y' z z' z''. (DExt z z', DExt z' z'') => f x y z z' -> f y y' z' z'' -> f x y' z z'')
+  -- ^ Composition of results for nested binders/patterns. This can be seen as scope-indexed 'mappend'.
+  -> Scope o
+  -- ^ Ambient scope.
+  -> pattern n l
+  -- ^ Pattern to process.
+  -> (forall o'. DExt o o' => f n l o o' -> pattern o o' -> Scope o' -> r)
+  -- ^ Continuation, accepting the result for the entire pattern, a (possibly refreshed) pattern, and the scope extended by that pattern.
+  -> r
+gunsafeWithPatternViaHasNameBinders withBinder id_ comp_ scope pat cont =
+  withPattern withBinder id_ comp_ scope (ggetNameBinders pat) $ \result binders scope' ->
+    cont result (gunsafeSetNameBinders (unsafeCoerce pat) binders) scope' -- FIXME: safer version
+
+-- ** Manipulating nested 'NameBinder's
+-- | If @'HasNameBinders' f@, then @f n l@ is expected to act as a binder,
+-- introducing into scope @n@ some local variables, extending it to scope @l@.
+-- This class allows to extract and modify the set of binders.
+--
+-- @since 0.3.0
+class HasNameBinders f where
+  -- | Extract a set of binders from a pattern.
+  --
+  -- @since 0.3.0
+  getNameBinders :: f n l -> NameBinders n l
+  getNameBinders = UnsafeNameBinders . IntSet.fromList . getNameBindersRaw
+
+  -- | Replace binders in a pattern.
+  --
+  -- This function is unsafe, because it does not check if the new set of binders
+  -- has the same size. It can therefore crash at runtime.
+  --
+  -- You should probably not use this.
+  -- This is only used for 'gunsafeWithPatternViaHasNameBinders', which is then safe to use.
+  --
+  -- @since 0.3.0
+  unsafeSetNameBinders :: f n l -> NameBinders n l' -> f n l'
+  unsafeSetNameBinders e (UnsafeNameBinders m) = fst (reallyUnsafeSetNameBindersRaw e (IntSet.toList m))
+
+  -- | Extract 'RawName's of all binders occurring in a pattern.
+  --
+  -- @since 0.3.0
+  getNameBindersRaw :: f n l -> [RawName]
+  default getNameBindersRaw :: forall n l. (GenericK f, GHasNameBinders (RepK f)) => f n l -> [RawName]
+  getNameBindersRaw = ggetNameBindersRaw . fromK @_ @f @(n :&&: l :&&: LoT0)
+
+  -- | This is a version of 'unsafeSetNameBinders'
+  -- that takes in a list of 'RawName's.
+  --
+  -- It does not check if the given list has enough elements.
+  -- It does not check if the raw names are fresh in the scope @n@.
+  -- It does not check if the raw names given are distinct.
+  --
+  -- You should never use this. This is only used for generic implementation of 'HasNameBinders'.
+  --
+  -- @since 0.3.0
+  reallyUnsafeSetNameBindersRaw :: f n l -> [RawName] -> (f n l', [RawName])
+  default reallyUnsafeSetNameBindersRaw :: forall n l l'. (GenericK f, GValidNameBinders f (RepK f), GHasNameBinders (RepK f)) => f n l -> [RawName] -> (f n l', [RawName])
+  reallyUnsafeSetNameBindersRaw e names =
+    let (e', names') = greallyUnsafeSetNameBindersRaw (fromK @_ @f @(n :&&: l :&&: LoT0) e) names
+     in (toK @_ @f @(n :&&: l' :&&: LoT0) e', names')
+
+instance HasNameBinders NameBinder where
+  getNameBindersRaw (UnsafeNameBinder (UnsafeName name)) = [name]
+  reallyUnsafeSetNameBindersRaw _ (name:names) = (UnsafeNameBinder (UnsafeName name), names)
+
+instance HasNameBinders NameBinderList
+
+-- ** Generic
+
+-- | 'getNameBinders' through the generic representation.
+--
+-- @since 0.3.0
+ggetNameBinders :: forall f n l. (GenericK f, GHasNameBinders (RepK f)) => f n l -> NameBinders n l
+ggetNameBinders = UnsafeNameBinders . IntSet.fromList . ggetNameBindersRaw . fromK @_ @f @(n :&&: l :&&: LoT0)
+
+-- | 'unsafeSetNameBinders' through the generic representation.
+--
+-- @since 0.3.0
+gunsafeSetNameBinders :: forall f n l l'. (GenericK f, GValidNameBinders f (RepK f), GHasNameBinders (RepK f)) => f n l -> NameBinders n l' -> f n l'
+gunsafeSetNameBinders e (UnsafeNameBinders m) = toK @_ @f @(n :&&: l' :&&: LoT0) $
+  fst (greallyUnsafeSetNameBindersRaw (fromK @_ @f @(n :&&: l :&&: LoT0) e) (IntSet.toList m))
+
+-- | 'HasNameBinders' on the "Generics.Kind" representation of a pattern.
+--
+-- @since 0.3.0
+class GHasNameBinders f where
+  -- | The raw names the representation binds, in order.
+  --
+  -- @since 0.3.0
+  ggetNameBindersRaw :: f as -> [RawName]
+
+  -- | Replace those names, returning what is left of the list.
+  --
+  -- @since 0.3.0
+  greallyUnsafeSetNameBindersRaw :: f as -> [RawName] -> (f bs, [RawName])
+
+instance GHasNameBinders V1 where
+  ggetNameBindersRaw _ = error "absurd: Generics.Kind.V1"
+  greallyUnsafeSetNameBindersRaw _ _ = error "absurd: Generics.Kind.V1"
+instance GHasNameBinders U1 where
+  ggetNameBindersRaw U1 = []
+  greallyUnsafeSetNameBindersRaw U1 names = (U1, names)
+
+instance (GHasNameBinders f, GHasNameBinders g) => GHasNameBinders (f :+: g) where
+  ggetNameBindersRaw (L1 x) = ggetNameBindersRaw x
+  ggetNameBindersRaw (R1 x) = ggetNameBindersRaw x
+
+  greallyUnsafeSetNameBindersRaw (L1 x) names = first L1 (greallyUnsafeSetNameBindersRaw x names)
+  greallyUnsafeSetNameBindersRaw (R1 x) names = first R1 (greallyUnsafeSetNameBindersRaw x names)
+
+-- | __A caveat.__ This instance treats the two factors as /nested/ binders,
+-- and does not reject /parallel/ ones:
+--
+-- > data BadPattern n l = BadPattern (NameBinder n l) (NameBinder n l)
+--
+-- The intended shape is a chain, in which each binder extends the scope the
+-- next one starts from:
+--
+-- > data GoodPattern n l = forall i. GoodPattern (NameBinder n i) (NameBinder i l)
+--
+-- Template Haskell never generates parallel binders, and writing one by hand
+-- takes deliberate effort, so this is unlikely to be reached by accident.
+-- Detecting and rejecting such a pattern would still be better.
 instance (GHasNameBinders f, GHasNameBinders g) => GHasNameBinders (f :*: g) where
   ggetNameBindersRaw (x :*: y) = ggetNameBindersRaw x <> ggetNameBindersRaw y
   greallyUnsafeSetNameBindersRaw (x :*: y) names =
diff --git a/src/Control/Monad/Foil/Internal/ValidNameBinders.hs b/src/Control/Monad/Foil/Internal/ValidNameBinders.hs
--- a/src/Control/Monad/Foil/Internal/ValidNameBinders.hs
+++ b/src/Control/Monad/Foil/Internal/ValidNameBinders.hs
@@ -77,6 +77,20 @@
       :$$: 'Text "  " :<>: ShowKindedScope oo n ll
       :$$: ShowLocalizeError msg icon ifield pattern oo ll
       )
+  GInnerScopeOfAtom msg icon ifield pattern (Kon f :@: (i :: Atom d s)) oo n ll =
+    TypeError
+      ('Text "A field of the binder/pattern is indexed by a Foil scope"
+      :$$: 'Text "  " :<>: 'ShowType f :<>: 'Text " " :<>: ShowKindedScope oo i ll
+      :$$: 'Text "A field like this is a payload and not a binder: it does not extend"
+      :$$: 'Text "the scope, it lives in one. The generic implementation of withPattern"
+      :$$: 'Text "cannot rebuild it, because it replaces the binders and leaves every"
+      :$$: 'Text "other field as it stands, so a payload naming one of the pattern's own"
+      :$$: 'Text "binders would keep the name that binder had before it was refreshed."
+      :$$: 'Text "Write the CoSinkable instance by hand for this type, threading a"
+      :$$: 'Text "PatternTransport through withPattern; see the recipe in the"
+      :$$: 'Text "documentation of Control.Monad.Foil.transportPayload."
+      :$$: ShowLocalizeError msg icon ifield pattern oo ll
+      )
   GInnerScopeOfAtom msg icon ifield pattern atom oo n ll = n
 
 type SameInnerScope :: ErrorMessage -> Nat -> (s -> s -> Type) -> Atom k s -> Atom k s -> Atom k s
diff --git a/src/Control/Monad/Foil/Registry.hs b/src/Control/Monad/Foil/Registry.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Foil/Registry.hs
@@ -0,0 +1,229 @@
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-- | Deterministic stripe assignment for separately checked units.
+--
+-- Each unit of a module system allocates its top-level names inside its own
+-- reservation (see "Control.Monad.Foil.Blocks"), and the assignment of
+-- reservations has to be /deterministic/: a unit's declarations are numbered
+-- @base@, @base + 1@, and so on in declaration order, whatever else is
+-- checked around it. Determinism is what makes raw names cacheable, since a
+-- unit checked today and a unit loaded tomorrow then agree name for name. It
+-- is also what discharges the trust obligation of
+-- 'Control.Monad.Foil.Blocks.checkExtScope'.
+--
+-- The registry is that assignment: an append-only map from unit names to
+-- stripe indices, handing out the next index on first use. A build persists
+-- it beside the build products, since a cached artifact survives a change
+-- elsewhere in the build exactly when the assignment does not move.
+--
+-- Where the stripes lie on the raw-name line is a 'StripeLayout' and a
+-- policy of the client. The library is region-agnostic, and the allocator
+-- admits negative names.
+module Control.Monad.Foil.Registry (
+  -- * Stripe indices
+  StripeIndex (..),
+  -- * Layouts
+  StripeSize (..),
+  StripeLayout (..),
+  stripesBelowZero,
+  stripesAbove,
+  -- * Local-region layouts
+  RegionWidth (..),
+  RegionsPerUnit (..),
+  RegionLayout (..),
+  regionsAbove,
+  -- * The registry
+  Registry,
+  emptyRegistry,
+  registrySize,
+  registerUnit,
+) where
+
+import           Data.Binary                 (Binary)
+import           Data.Map                    (Map)
+import qualified Data.Map                    as Map
+
+import           Control.Monad.Foil.Internal (NameRange (..), RawName)
+
+-- $setup
+-- >>> import Control.Monad.Foil.Internal
+
+-- | A stripe's position in the registry: which run of names a unit draws
+-- from. Its own type, so that a stripe index cannot be confused with a name,
+-- a count, or an offset.
+--
+-- @since 0.4.0
+newtype StripeIndex = StripeIndex Int
+  deriving newtype (Eq, Ord, Show, Read, Binary)
+
+-- | How many names a unit may declare: the width of every stripe a layout
+-- hands out. Its own type, so that a size cannot be confused with a name, an
+-- index, or a base.
+--
+-- @since 0.4.0
+newtype StripeSize = StripeSize Int
+  deriving newtype (Eq, Ord, Show, Read)
+
+-- | Where stripe @i@ lies on the raw-name line.
+--
+-- The library does not choose: whether stripes descend below zero, ascend
+-- from some base, or interleave with other reservations is a policy of the
+-- client, and everything in "Control.Monad.Foil.Blocks" works from the
+-- resulting 'NameRange's alone. A layout should give disjoint ranges to
+-- distinct indices. Nothing checks this here, but
+-- 'Control.Monad.Foil.Blocks.withDisjointUnion' refuses the overlap at the
+-- point where it would do harm.
+--
+-- @since 0.4.0
+newtype StripeLayout = StripeLayout
+  { stripeRange :: StripeIndex -> NameRange
+  }
+
+-- | Stripe @i@ is the @i@-th run of @size@ names below zero, counting
+-- downwards, so stripe 0 is @[-size .. -1]@. Within a stripe, allocation
+-- still ascends (see 'Control.Monad.Foil.withFreshIn'), so declaration order
+-- is ascending name order.
+--
+-- This layout leaves the whole non-negative range free for a client's local
+-- names.
+--
+-- >>> stripeRange (stripesBelowZero (StripeSize 100)) (StripeIndex 0)
+-- NameRange {nameRangeLo = -100, nameRangeHi = -1}
+-- >>> stripeRange (stripesBelowZero (StripeSize 100)) (StripeIndex 2)
+-- NameRange {nameRangeLo = -300, nameRangeHi = -201}
+--
+-- @since 0.4.0
+stripesBelowZero :: StripeSize -> StripeLayout
+stripesBelowZero (StripeSize size) = StripeLayout $ \(StripeIndex i) ->
+  let hi = negate (i * size) - 1
+   in NameRange (hi - size + 1) hi
+
+-- | Stripe @i@ is the @i@-th run of @size@ names at or above a base,
+-- counting upwards, so stripe 0 is @[base .. base + size - 1]@.
+--
+-- >>> stripeRange (stripesAbove 0 (StripeSize 100)) (StripeIndex 1)
+-- NameRange {nameRangeLo = 100, nameRangeHi = 199}
+--
+-- @since 0.4.0
+stripesAbove
+  :: RawName     -- ^ The base: the low end of stripe 0.
+  -> StripeSize
+  -> StripeLayout
+stripesAbove base (StripeSize size) = StripeLayout $ \(StripeIndex i) ->
+  let lo = base + i * size
+   in NameRange lo (lo + size - 1)
+
+-- | Which stripe each unit's declarations live in, by the unit's name.
+--
+-- Append-only: a name, once registered, keeps its stripe for the lifetime of
+-- the registry, and the next stripe index is always the registry's size.
+--
+-- @since 0.4.0
+type Registry name = Map name StripeIndex
+
+-- | The registry before any unit has ever been checked.
+--
+-- @since 0.4.0
+emptyRegistry :: Registry name
+emptyRegistry = Map.empty
+
+-- | How many units have been registered, which is also the next free stripe.
+--
+-- @since 0.4.0
+registrySize :: Registry name -> Int
+registrySize = Map.size
+
+-- | The stripe index of a unit, assigning the next one on first use.
+--
+-- Registration hands out the index and not a range. A unit's index
+-- determines /every/ reservation derived for it: its stripe under a
+-- 'StripeLayout', and its runs of local names under a 'RegionLayout'. The
+-- layouts interpret the index, rather than being consulted here.
+--
+-- >>> let layout = stripesBelowZero (StripeSize 10)
+-- >>> let (r1, iA) = registerUnit "A" emptyRegistry
+-- >>> stripeRange layout iA
+-- NameRange {nameRangeLo = -10, nameRangeHi = -1}
+-- >>> stripeRange layout (snd (registerUnit "B" r1))
+-- NameRange {nameRangeLo = -20, nameRangeHi = -11}
+--
+-- Registration is idempotent, which is the determinism a cache rests on:
+--
+-- >>> snd (registerUnit "A" r1) == iA
+-- True
+--
+-- @since 0.4.0
+registerUnit
+  :: Ord name
+  => name -> Registry name -> (Registry name, StripeIndex)
+registerUnit name registry = case Map.lookup name registry of
+  Just i  -> (registry, i)
+  Nothing ->
+    let i = StripeIndex (Map.size registry)
+     in (Map.insert name i registry, i)
+
+-- * Local-region layouts
+
+-- | How far apart consecutive local-region floors sit within a unit's runs.
+-- This is spacing, not a hard width: a run is open-ended above its floor,
+-- and a scope-driven allocator would have to hold this many names /in scope
+-- at once/ to reach the next floor.
+--
+-- @since 0.4.0
+newtype RegionWidth = RegionWidth Int
+  deriving newtype (Eq, Ord, Show, Read)
+
+-- | How many runs of local names a unit may hold before its runs would
+-- spill into the next unit's. A spill is not unsound for a client that
+-- refreshes on clash. It only forfeits the disjointness described under
+-- 'RegionLayout' for the runs past the cap.
+--
+-- @since 0.4.0
+newtype RegionsPerUnit = RegionsPerUnit Int
+  deriving newtype (Eq, Ord, Show, Read)
+
+-- | Where a unit's runs of /local/ names lie: one open-ended region per
+-- declaration (or command) of the unit, advanced with 'nextRegion' as the
+-- unit's declarations are processed.
+--
+-- Stripes make a unit's top-level names disjoint from every other unit's,
+-- and runs of local regions do the same for the names a checker invents
+-- /inside/ a declaration. A term stored under one declaration then never
+-- collides with another declaration's live locals when it is reopened, so a
+-- refreshing substitution takes its no-rename fast path throughout.
+--
+-- The first run is derived from the unit's stripe index rather than from a
+-- counter shared across units, so a unit's elaboration depends only on the
+-- unit itself and editing a neighbour moves no name. That is the
+-- determinism a cache rests on.
+--
+-- The trade-off is that local names carry large offsets. A client that
+-- shows raw indices directly may prefer a single flat region, and accept
+-- the transient renames instead.
+--
+-- @since 0.4.0
+data RegionLayout = RegionLayout
+  { firstRegionOf :: StripeIndex -> NameRange
+    -- ^ The run of the unit's first declaration.
+  , nextRegion    :: NameRange -> NameRange
+    -- ^ The next declaration's run.
+  }
+
+-- | Runs ascending from a base: the unit with stripe index @i@ starts its
+-- runs at @base + i * perUnit * width@, and each declaration's floor sits
+-- @width@ above the previous one. The top of every run is open.
+--
+-- >>> let locals = regionsAbove 0 (RegionsPerUnit 0x10) (RegionWidth 0x100)
+-- >>> nameRangeLo (firstRegionOf locals (StripeIndex 2))
+-- 8192
+-- >>> nameRangeLo (nextRegion locals (firstRegionOf locals (StripeIndex 2)))
+-- 8448
+--
+-- @since 0.4.0
+regionsAbove :: RawName -> RegionsPerUnit -> RegionWidth -> RegionLayout
+regionsAbove base (RegionsPerUnit perUnit) (RegionWidth w) = RegionLayout
+  { firstRegionOf = \(StripeIndex i) ->
+      NameRange (base + i * perUnit * w) maxBound
+  , nextRegion = \(NameRange lo _) -> NameRange (lo + w) maxBound
+  }
diff --git a/src/Control/Monad/Foil/Relative.hs b/src/Control/Monad/Foil/Relative.hs
--- a/src/Control/Monad/Foil/Relative.hs
+++ b/src/Control/Monad/Foil/Relative.hs
@@ -7,8 +7,12 @@
 import           Data.Kind          (Type)
 
 -- | Relative monads, restricted to types indexed by scopes in kind 'S'.
+--
+-- @since 0.0.1
 class RelMonad (f :: S -> Type) (m :: S -> Type) where
   -- | Relative version of 'return'.
+  --
+  -- @since 0.0.1
   rreturn :: f a -> m a
 
   -- | Relative version of '>>='.
@@ -21,8 +25,12 @@
   -- Technically, it is also possible add similar components for @a@ parameter.
   -- Also, we could probably treat types in 'S' as singletons and extract distinct scopes that way,
   -- preserving the more general type signature for 'rbind'.
+  --
+  -- @since 0.0.1
   rbind :: Distinct b => Scope b -> m a -> (f a -> m b) -> m b
 
--- | Relative version of 'liftM' (an 'fmap' restricted to 'Monad').
+-- | Relative version of @liftM@ (an 'fmap' restricted to 'Monad').
+--
+-- @since 0.0.3
 liftRM :: (RelMonad f m, Distinct b) => Scope b -> (f a -> f b) -> m a -> m b
 liftRM scope f m = rbind scope m (rreturn . f)
diff --git a/src/Control/Monad/Foil/TH/MkFoilData.hs b/src/Control/Monad/Foil/TH/MkFoilData.hs
--- a/src/Control/Monad/Foil/TH/MkFoilData.hs
+++ b/src/Control/Monad/Foil/TH/MkFoilData.hs
@@ -12,6 +12,8 @@
 import Control.Monad.Foil.TH.Util
 
 -- | Generate scope-safe variants given names of types for the raw representation.
+--
+-- @since 0.0.1
 mkFoilData
   :: Name -- ^ Type name for raw terms.
   -> Name -- ^ Type name for raw variable identifiers.
@@ -68,6 +70,8 @@
         toTermParam _bangType = _bangType
 
 -- | Generate just the scope-safe patterns.
+--
+-- @since 0.1.0
 mkFoilPattern
   :: Name -- ^ Type name for raw variable identifiers.
   -> Name -- ^ Type name for raw patterns.
diff --git a/src/Control/Monad/Foil/TH/MkFromFoil.hs b/src/Control/Monad/Foil/TH/MkFromFoil.hs
--- a/src/Control/Monad/Foil/TH/MkFromFoil.hs
+++ b/src/Control/Monad/Foil/TH/MkFromFoil.hs
@@ -13,6 +13,8 @@
 import Control.Monad.Foil.TH.Util
 
 -- | Generate conversion functions from raw to scope-safe representation.
+--
+-- @since 0.0.1
 mkFromFoil
   :: Name -- ^ Type name for raw terms.
   -> Name -- ^ Type name for raw variable identifiers.
@@ -232,6 +234,8 @@
         toMatch RecGadtC{} = error "Record GADT constructors (RecGadtC) are not supported yet!"
 
 -- | Generate conversion function from raw to scope-safe pattern.
+--
+-- @since 0.1.0
 mkFromFoilPattern
   :: Name -- ^ Type name for raw variable identifiers.
   -> Name -- ^ Type name for raw patterns.
diff --git a/src/Control/Monad/Foil/TH/MkInstancesFoil.hs b/src/Control/Monad/Foil/TH/MkInstancesFoil.hs
--- a/src/Control/Monad/Foil/TH/MkInstancesFoil.hs
+++ b/src/Control/Monad/Foil/TH/MkInstancesFoil.hs
@@ -12,6 +12,8 @@
 import           Data.List                  (nub)
 
 -- | Generate 'Foil.Sinkable' and 'Foil.CoSinkable' instances.
+--
+-- @since 0.0.1
 mkInstancesFoil
   :: Name -- ^ Type name for raw terms.
   -> Name -- ^ Type name for raw variable identifiers.
@@ -79,6 +81,8 @@
             xi = mkName ("x" ++ show i)
 
 -- | Generate 'Foil.Sinkable' and 'Foil.CoSinkable' instances.
+--
+-- @since 0.1.0
 deriveCoSinkable
   :: Name -- ^ Type name for raw variable identifiers.
   -> Name -- ^ Type name for raw patterns.
@@ -150,19 +154,18 @@
         conParamPatterns = zipWith mkConParamPattern params [1..]
         mkConParamPattern _ i = VarP (mkName ("x" ++ show i))
 
-        go _i _scope' rename' p [] = AppE (AppE (VarE cont) rename') p
+        go _i scope' rename' p [] = AppE (AppE (AppE (VarE cont) rename') p) (VarE scope')
         go i scope' rename' p ((_bang, PeelConT tyName _tyParams) : conParams)
           | tyName == nameT || tyName == patternT =
               AppE
                 (foldl AppE (VarE 'Foil.withPattern) [VarE withNameBinder, VarE id', VarE comp, VarE scope', VarE xi])
-                (LamE [VarP renamei, VarP xi']
-                  (LetE [ValD (VarP scopei) (NormalB (AppE (AppE (VarE 'Foil.extendScopePattern) (VarE xi')) (VarE scope'))) []]
-                    (go (i + 1) scopei (foldl AppE (VarE comp) [rename', VarE renamei]) (AppE p (VarE xi')) conParams)))
+                (LamE [VarP renamei, VarP xi', VarP scopei]
+                  (go (i + 1) scopei (foldl AppE (VarE comp) [rename', VarE renamei]) (AppE p (VarE xi')) conParams))
           where
             xi = mkName ("x" ++ show i)
             xi' = mkName ("x" ++ show i ++ "'")
             renamei = mkName ("f" ++ show i)
-            scopei = mkName ("_scope" ++ show i)
+            scopei = mkName ("scope" ++ show i)
         go i scope' rename' p (_ : conPatterns) =
           go (i + 1) scope' rename' (AppE p (VarE xi)) conPatterns
           where
@@ -171,7 +174,9 @@
 -- | Generate a structural 'Foil.UnifiablePattern' instance, comparing
 -- constructors and non-binding fields rather than only the binders.
 --
--- This deriver does not work and has no call sites; see the deprecation note.
+-- This deriver does not work and has no call sites. See the deprecation note.
+--
+-- @since 0.1.0
 deriveUnifiablePattern
   :: Name -- ^ Type name for raw variable identifiers.
   -> Name -- ^ Type name for raw patterns.
diff --git a/src/Control/Monad/Foil/TH/MkToFoil.hs b/src/Control/Monad/Foil/TH/MkToFoil.hs
--- a/src/Control/Monad/Foil/TH/MkToFoil.hs
+++ b/src/Control/Monad/Foil/TH/MkToFoil.hs
@@ -16,6 +16,8 @@
 import Control.Monad.Foil.TH.Util
 
 -- | Generate conversion functions from raw to scope-safe representation.
+--
+-- @since 0.0.1
 mkToFoil
   :: Name -- ^ Type name for raw terms.
   -> Name -- ^ Type name for raw variable identifiers.
@@ -33,6 +35,8 @@
     )
 
 -- | Generate a function to extend scope with variables from a given pattern.
+--
+-- @since 0.0.1
 mkExtendScopeFoilPattern
   :: Name -- ^ Type name for raw variable identifiers.
   -> Name -- ^ Type name for raw patterns.
@@ -99,6 +103,8 @@
         toMatch RecGadtC{} = error "Record GADT constructors (RecGadtC) are not supported yet!"
 
 -- | Generate a function to extend scope with variables from a given pattern.
+--
+-- @since 0.0.1
 mkWithRefreshedFoilPattern
   :: Name -- ^ Type name for raw variable identifiers.
   -> Name -- ^ Type name for raw patterns.
@@ -221,6 +227,8 @@
         toMatch RecGadtC{} = error "Record GADT constructors (RecGadtC) are not supported yet!"
 
 -- | Generate a conversion function from raw terms to scope-safe terms.
+--
+-- @since 0.0.1
 mkToFoilTerm
   :: Name -- ^ Type name for raw terms.
   -> Name -- ^ Type name for raw variable identifiers.
@@ -462,6 +470,8 @@
         toMatch RecGadtC{} = error "Record GADT constructors (RecGadtC) are not supported yet!"
 
 -- | Generate a conversion function from raw terms to scope-safe terms.
+--
+-- @since 0.1.0
 mkToFoilPattern
   :: Name -- ^ Type name for raw variable identifiers.
   -> Name -- ^ Type name for raw patterns.
diff --git a/src/Control/Monad/Foil/Telescope.hs b/src/Control/Monad/Foil/Telescope.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Foil/Telescope.hs
@@ -0,0 +1,254 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE InstanceSigs        #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
+
+-- | The labelled telescope: a chain of binders, each carrying a label and a
+-- payload in the scope before it.
+--
+-- This is the pattern behind a module's parameter block, a record signature,
+-- or an algebraic theory: @(A : 𝕌) (m : A → A → A)@ is a two-step
+-- telescope whose second payload mentions the first binder. Because a
+-- telescope is a pattern ('CoSinkable', 'UnifiablePattern'), scope extension,
+-- the names of a block, and α-equivalence of blocks come from the pattern
+-- machinery, with the payloads compared through 'AlphaEquiv'.
+--
+-- What this module does not fix is what a payload /is/. The payload type is a
+-- parameter, and the operations that need to look inside one, such as the
+-- support a dependency closure needs, take the looking function as an
+-- argument. A client instantiates the labels and payloads to its own types.
+-- To close a declaration over the fields it uses, apply 'closeOverTelescope'
+-- and then 'withThinnedNameBinderList'.
+module Control.Monad.Foil.Telescope where
+
+import           Control.Monad.Foil.Internal
+import           Control.Monad.Foil.Relative (RelMonad, liftRM)
+
+-- | A labelled telescope: a chain of binders, each carrying a label and a
+-- payload in the scope before it.
+--
+-- The payload of a step lives in the scope the steps before it extend to, which
+-- is what makes this a telescope rather than a list. For a module's parameters
+-- the label is how the parameter is spelled and the payload is its type, so
+-- that @(A : 𝕌) (m : A → A → A)@ is a two-step telescope whose second payload
+-- mentions the first binder.
+--
+-- See 'NameBinderList', which this follows almost line for line.
+--
+-- @since 0.4.0
+data Telescope label e n l where
+  TelescopeEmpty :: Telescope label e n n
+  TelescopeCons
+    :: label                        -- ^ How the step is labelled.
+    -> e n                          -- ^ Its payload, in the scope before it.
+    -> NameBinder n i          -- ^ The binder it introduces.
+    -> Telescope label e i l        -- ^ The steps after it.
+    -> Telescope label e n l
+
+-- | A telescope is a pattern, so the foil's own machinery walks it.
+--
+-- 'coSinkabilityProof' typechecks only because a payload is sunk by the
+-- renaming of the scope /before/ its binder, rather than by the extended one.
+--
+-- 'withPattern' has to be written out rather than derived. The generic
+-- implementation refuses a pattern with a field indexed by a scope, since it
+-- would leave a payload that names a refreshed binder pointing at the name
+-- that binder used to have. This instance follows the recipe in
+-- 'transportPayload': a 'PatternTransport' threaded through the traversal,
+-- with each payload moved by the transport accumulated /before/ its own
+-- binder, that being the scope the payload lives in.
+instance Sinkable e => CoSinkable (Telescope label e) where
+  coSinkabilityProof rename TelescopeEmpty cont = cont rename TelescopeEmpty
+  coSinkabilityProof rename (TelescopeCons label payload binder rest) cont =
+    coSinkabilityProof rename binder $ \rename' binder' ->
+      coSinkabilityProof rename' rest $ \rename'' rest' ->
+        cont rename''
+          (TelescopeCons label (sinkabilityProof rename payload) binder' rest')
+
+  withPattern
+    :: forall f o n l r. Distinct o
+    => (forall x y z r'. Distinct z
+          => Scope z
+          -> NameBinder x y
+          -> (forall z'. DExt z z' => f x y z z' -> NameBinder z z' -> r')
+          -> r')
+    -> (forall x z z'. DExt z z' => f x x z z')
+    -> (forall x y y' z z' z''. (DExt z z', DExt z' z'')
+          => f x y z z' -> f y y' z' z'' -> f x y' z z'')
+    -> Scope o
+    -> Telescope label e n l
+    -> (forall o'. DExt o o' => f n l o o' -> Telescope label e o o' -> Scope o' -> r)
+    -> r
+  withPattern withBinder unit comp = go verbatimTransport
+    where
+      go :: forall n' l' o' r'. Distinct o'
+         => PatternTransport n' o'
+         -> Scope o'
+         -> Telescope label e n' l'
+         -> (forall o''. DExt o' o''
+               => f n' l' o' o'' -> Telescope label e o' o'' -> Scope o'' -> r')
+         -> r'
+      go _transport scope TelescopeEmpty cont = cont unit TelescopeEmpty scope
+      go transport scope (TelescopeCons label payload binder rest) cont =
+        withBinder scope binder $ \fbinder binder' ->
+          go (transportUnderBinder transport binder binder')
+             (extendScope binder' scope)
+             rest $ \frest rest' scope'' ->
+            cont (comp fbinder frest)
+              (TelescopeCons label (transportPayload transport payload) binder' rest')
+              scope''
+
+-- | Two telescopes unify when their binders line up and their payloads agree.
+--
+-- Labels are ignored, which is what α-equivalence should do with a label: a
+-- parameter's spelling is no more relevant than a bound variable's. Payloads
+-- are not, since two telescopes agreeing on binders may well disagree on types.
+--
+-- 'unifyPatterns' is the binder-only approximation, which is all a caller
+-- without a scope can be given. 'unifyPatternsIn' is the real answer, and
+-- it is what the library's α-equivalence calls.
+instance (Sinkable e, AlphaEquiv e, RelMonad Name e)
+    => UnifiablePattern (Telescope label e) where
+  unifyPatterns TelescopeEmpty TelescopeEmpty =
+    SameNameBinders emptyNameBinders
+  unifyPatterns (TelescopeCons _ _ x xs) (TelescopeCons _ _ y ys) =
+    case (assertDistinct x, assertDistinct y) of
+      (Distinct, Distinct) ->
+        unifyNameBinders x y `andThenUnifyPatterns` (xs, ys)
+  -- Telescopes of different lengths bind different numbers of names.
+  unifyPatterns _ _ = NotUnifiable
+
+  unifyPatternsIn scope tele1 tele2
+    | payloadsAgree scope tele1 tele2 verdict = verdict
+    | otherwise                               = NotUnifiable
+    where
+      verdict = unifyPatterns tele1 tele2
+
+-- | The payloads of a telescope, each moved into its innermost scope.
+--
+-- Sinking is free, so putting them all in one scope costs nothing and lets a
+-- renaming be applied to the whole block at once.
+--
+-- @since 0.4.0
+telescopePayloads
+  :: (Sinkable e, Distinct l) => Telescope label e n l -> [e l]
+telescopePayloads = map paramType . telescopeParams
+
+-- | Do the payloads of two telescopes agree, under the way their binders were
+-- unified?
+--
+-- The verdict speaks about binders only, so the renaming it prescribes has to
+-- be applied before the payloads are compared, which is exactly what
+-- 'Control.Monad.Free.alphaEquivScoped' does to the body of a scoped term.
+-- Comparing them as they stand would report @(A : 𝕌) (x : A)@ and
+-- @(B : 𝕌) (y : B)@ as different, since the second payloads name different
+-- binders until the first ones have been identified.
+--
+-- @since 0.4.0
+payloadsAgree
+  :: forall label e n l r.
+     (Sinkable e, AlphaEquiv e, RelMonad Name e, Distinct n)
+  => Scope n
+  -> Telescope label e n l
+  -> Telescope label e n r
+  -> UnifyNameBinders (Telescope label e) n l r
+  -> Bool
+payloadsAgree scope tele1 tele2 verdict =
+  case (assertDistinct tele1, assertDistinct tele2) of
+    (Distinct, Distinct) ->
+      let payloads1 = telescopePayloads tele1
+          payloads2 = telescopePayloads tele2
+       in case verdict of
+            NotUnifiable -> False
+            -- The binders are the same, so the payloads already compare.
+            SameNameBinders{} ->
+              agree (extendScopePattern tele1 scope) payloads1 payloads2
+            -- The left telescope's binders become the right's, so its payloads
+            -- have to follow them before they can be compared.
+            RenameLeftNameBinder _ renameL ->
+              let scope' = extendScopePattern tele2 scope
+               in agree scope' (map (rename scope' renameL) payloads1) payloads2
+            RenameRightNameBinder _ renameR ->
+              let scope' = extendScopePattern tele1 scope
+               in agree scope' payloads1 (map (rename scope' renameR) payloads2)
+            -- Neither side's binders survive, so both blocks move to the
+            -- unified ones.
+            RenameBothBinders binders renameL renameR ->
+              case assertDistinct binders of
+                Distinct ->
+                  let scope' = extendScopePattern binders scope
+                   in agree scope' (map (rename scope' renameL) payloads1)
+                                   (map (rename scope' renameR) payloads2)
+  where
+    -- Lengths cannot disagree here: a verdict other than 'NotUnifiable'
+    -- says the two telescopes bind the same number of names.
+    agree :: forall m. Distinct m => Scope m -> [e m] -> [e m] -> Bool
+    agree scope' xs ys = and (zipWith (alphaEquivIn scope') xs ys)
+
+    rename
+      :: forall i m. Distinct m
+      => Scope m -> (NameBinder n i -> NameBinder n m) -> e i -> e m
+    rename scope' f = liftRM scope' (fromNameBinderRenaming f)
+
+-- | One step of a telescope, with everything about it moved into the innermost
+-- scope.
+--
+-- Sinking is free, so this is the convenient form for anything that has to
+-- compare parameters with the names of a term checked under all of them.
+--
+-- @since 0.4.0
+data Param label e l = Param
+  { paramLabel :: label
+  , paramName  :: Name l
+  , paramType  :: e l
+  }
+
+-- | The steps of a telescope, outermost first.
+--
+-- @since 0.4.0
+telescopeParams
+  :: (Sinkable e, Distinct l)
+  => Telescope label e n l -> [Param label e l]
+telescopeParams TelescopeEmpty = []
+telescopeParams (TelescopeCons label ty binder rest) =
+  case (assertExt binder, assertExt rest) of
+    (Ext, Ext) ->
+      Param label (sink (nameOf binder)) (sink ty)
+        : telescopeParams rest
+
+-- | The chain of binders a telescope forms.
+--
+-- This is 'nameBinderListOf' at a telescope, written out. The general one
+-- goes through 'withPattern' and so rebuilds the telescope only to throw it
+-- away, which is worth avoiding on the checking path.
+--
+-- @since 0.4.0
+telescopeBinders :: Telescope label e n l -> NameBinderList n l
+telescopeBinders TelescopeEmpty = NameBinderListEmpty
+telescopeBinders (TelescopeCons _ _ binder rest) =
+  NameBinderListCons binder (telescopeBinders rest)
+
+-- | Close a set of parameters under the parameters their payloads need.
+--
+-- Keeping a parameter puts its payload into the result, so whatever that
+-- payload mentions has to be kept too. A payload mentions only the parameters
+-- before it, so working from the inside out settles it in one pass.
+--
+-- The support of a payload is the caller's to supply, since the library does
+-- not know what a payload is. For terms of the free foil it is
+-- 'Control.Monad.Free.Foil.supportOf'.
+--
+-- @since 0.4.0
+closeOverTelescope
+  :: Distinct l
+  => (e l -> NameSet l)  -- ^ The support of a payload.
+  -> [Param label e l] -> NameSet l -> NameSet l
+closeOverTelescope supportOfPayload params wanted = foldr close wanted params
+  where
+    close p keep
+      | nameSetMember (paramName p) keep = keep <> supportOfPayload (paramType p)
+      | otherwise                        = keep
+
diff --git a/src/Control/Monad/Free/Foil.hs b/src/Control/Monad/Free/Foil.hs
--- a/src/Control/Monad/Free/Foil.hs
+++ b/src/Control/Monad/Free/Foil.hs
@@ -2,6 +2,9 @@
 {-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE TypeFamilies         #-}
 {-# LANGUAGE DeriveAnyClass        #-}
+{-# LANGUAGE DeriveFoldable        #-}
+{-# LANGUAGE DeriveFunctor         #-}
+{-# LANGUAGE DeriveTraversable     #-}
 {-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
@@ -31,13 +34,16 @@
 import qualified Generics.Kind as Kind
 import Generics.Kind (GenericK(..), Field, Exists, Var0, Var1, (:$:), Atom((:@:), Kon), (:+:), (:*:))
 import           Data.Coerce                 (coerce)
+import           Data.IntMap.Strict          (IntMap)
+import qualified Data.IntMap.Strict          as IntMap
 import           Data.Map                    (Map)
 import qualified Data.Map                    as Map
-import           Data.Maybe                  (mapMaybe)
 import           GHC.Generics                (Generic)
 import           Unsafe.Coerce               (unsafeCoerce)
 
 -- | Scoped term under a (single) name binder.
+--
+-- @since 0.0.1
 data ScopedAST binder sig n where
   ScopedAST :: binder n l -> AST binder sig l -> ScopedAST binder sig n
 
@@ -46,9 +52,11 @@
 
 -- | A term, generated by a signature 'Bifunctor' @sig@,
 -- with (free) variables in scope @n@.
+--
+-- @since 0.0.1
 data AST binder sig n where
   -- | A (free) variable in scope @n@.
-  Var :: Foil.Name n -> AST binder sig n
+  Var :: {-# UNPACK #-} !(Foil.Name n) -> AST binder sig n
   -- | A non-variable syntactic construction specified by the signature 'Bifunctor' @sig@.
   Node :: sig (ScopedAST binder sig n) (AST binder sig n) -> AST binder sig n
 
@@ -82,6 +90,8 @@
 -- * Substitution
 
 -- | Substitution for free (scoped monads).
+--
+-- @since 0.0.1
 {-# INLINABLE substitute #-}
 substitute
   :: (Bifunctor sig, Foil.Distinct o, Foil.CoSinkable binder, Foil.SinkableK binder)
@@ -89,14 +99,27 @@
   -> Foil.Substitution (AST binder sig) i o
   -> AST binder sig i
   -> AST binder sig o
-substitute scope subst = \case
-  Var name -> Foil.lookupSubst subst name
-  Node node -> Node (bimap f (substitute scope subst) node)
+substitute scope subst term
+  -- An empty substitution maps every name to itself ('addRename' deletes
+  -- identity renames), so the result is the very term, and the coercion is
+  -- the one 'Foil.sink' performs. Substitutions go empty often: opening a
+  -- scoped term with its own binder's name is an identity rename, and under
+  -- a deterministic allocation policy a refreshed binder usually keeps its
+  -- name, deleting its entry. Binders that shadow the ambient scope are
+  -- left as they stand, as on the no-clash path below. A caller that wants
+  -- them refreshed asks 'substituteRefreshed'.
+  | Foil.nullSubst subst = unsafeCoerce term
+  | otherwise = go term
   where
+    -- The substitution is known non-empty here, and it can only change
+    -- under a binder, so the walk between binders is unchecked and each
+    -- binder entry re-enters 'substitute', testing emptiness exactly once.
+    go = \case
+      Var name -> Foil.lookupSubst subst name
+      Node node -> Node (bimap f go node)
     f (ScopedAST binder body) =
-      Foil.withRefreshedPattern scope binder $ \extendSubst binder' ->
+      Foil.withRefreshedPattern scope binder $ \extendSubst binder' scope' ->
         let subst' = extendSubst (Foil.sink subst)
-            scope' = Foil.extendScopePattern binder' scope
             body' = substitute scope' subst' body
         in ScopedAST binder' body'
 
@@ -108,6 +131,8 @@
 -- > substituteRefreshed scope subst = refreshAST scope . subtitute scope subst
 --
 -- In general, 'substitute' is more efficient since it does not always refresh binders.
+--
+-- @since 0.0.3
 {-# INLINABLE substituteRefreshed #-}
 substituteRefreshed
   :: (Bifunctor sig, Foil.Distinct o, Foil.CoSinkable binder, Foil.SinkableK binder)
@@ -120,9 +145,8 @@
   Node node -> Node (bimap f (substituteRefreshed scope subst) node)
   where
     f (ScopedAST binder body) =
-      Foil.withFreshPattern scope binder $ \extendSubst binder' ->
+      Foil.withFreshPattern scope binder $ \extendSubst binder' scope' ->
         let subst' = extendSubst (Foil.sink subst)
-            scope' = Foil.extendScopePattern binder' scope
             body' = substituteRefreshed scope' subst' body
         in ScopedAST binder' body'
 
@@ -137,12 +161,13 @@
     where
       g x = Foil.rbind scope x subst
       g' (ScopedAST binder body) =
-        Foil.withRefreshedPattern' scope binder $ \extendSubst binder' ->
-          let scope' = Foil.extendScopePattern binder' scope
-              subst' = extendSubst subst
+        Foil.withRefreshedPattern' scope binder $ \extendSubst binder' scope' ->
+          let subst' = extendSubst subst
            in ScopedAST binder' (Foil.rbind scope' body subst')
 
 -- | Substitution for a single generalized pattern.
+--
+-- @since 0.2.0
 substitutePattern
   :: (Bifunctor sig, Foil.Distinct o, Foil.CoSinkable binder', Foil.CoSinkable binder, Foil.SinkableK binder)
   => Foil.Scope o                           -- ^ Resulting scope.
@@ -159,6 +184,8 @@
 -- * \(\alpha\)-equivalence
 
 -- | Refresh (force) all binders in a term, minimizing the used indices.
+--
+-- @since 0.0.3
 {-# INLINABLE refreshAST #-}
 refreshAST
   :: (Bifunctor sig, Foil.Distinct n, Foil.CoSinkable binder, Foil.SinkableK binder)
@@ -170,22 +197,26 @@
   Node t -> Node (bimap (refreshScopedAST scope) (refreshAST scope) t)
 
 -- | Similar to `refreshAST`, but for scoped terms.
+--
+-- @since 0.0.3
 {-# INLINABLE refreshScopedAST #-}
 refreshScopedAST :: (Bifunctor sig, Foil.Distinct n, Foil.CoSinkable binder, Foil.SinkableK binder)
   => Foil.Scope n
   -> ScopedAST binder sig n
   -> ScopedAST binder sig n
 refreshScopedAST scope (ScopedAST binder body) =
-  Foil.withFreshPattern scope binder $ \extendSubst binder' ->
-    let scope' = Foil.extendScopePattern binder' scope
-        subst = extendSubst (Foil.sink Foil.identitySubst)
+  Foil.withFreshPattern scope binder $ \extendSubst binder' scope' ->
+    let subst = extendSubst (Foil.sink Foil.identitySubst)
     in ScopedAST binder' (substituteRefreshed scope' subst body)
 
 -- | \(\alpha\)-equivalence check for two terms in one scope
 -- via normalization of bound identifiers (via 'refreshAST').
 --
--- Compared to 'alphaEquiv', this function may perform some unnecessary
--- changes of bound variables when the binders are the same on both sides.
+-- Compared to 'alphaEquiv', this function renames every binder on both sides
+-- unconditionally, so it does strictly more work. It remains as an
+-- independent implementation of the same test.
+--
+-- @since 0.0.3
 {-# INLINABLE alphaEquivRefreshed #-}
 alphaEquivRefreshed
   :: (Bitraversable sig, ZipMatchK sig, Foil.Distinct n, Foil.UnifiablePattern binder, Foil.SinkableK binder)
@@ -195,11 +226,23 @@
   -> Bool
 alphaEquivRefreshed scope t1 t2 = refreshAST scope t1 `unsafeEqAST` refreshAST scope t2
 
+-- | A term is a scope-indexed value that can be compared up to α, which is what
+-- a pattern carrying terms as payloads needs of them.
+instance (Bitraversable sig, ZipMatchK sig, Foil.UnifiablePattern binder, Foil.SinkableK binder)
+    => Foil.AlphaEquiv (AST binder sig) where
+  alphaEquivIn = alphaEquiv
+
 -- | \(\alpha\)-equivalence check for two terms in one scope
 -- via unification of bound variables (via 'unifyNameBinders').
 --
--- Compared to 'alphaEquivRefreshed', this function might skip unnecessary
--- changes of bound variables when both binders in two matching scoped terms coincide.
+-- When two matching binders coincide, comparison continues with no work at
+-- all. When they differ, the prescribed renaming is /threaded down the
+-- recursion/ (see 'alphaEquivEnv') and consulted at variables only, so
+-- nothing is ever copied. Applying the renaming eagerly instead would
+-- materialise a renamed copy of the remaining body at every mismatched
+-- binder, which is quadratic on a chain of them.
+--
+-- @since 0.0.3
 {-# INLINABLE alphaEquiv #-}
 alphaEquiv
   :: (Bitraversable sig, ZipMatchK sig, Foil.Distinct n, Foil.UnifiablePattern binder, Foil.SinkableK binder)
@@ -217,9 +260,15 @@
 alphaEquiv _ _ _ = False
 
 -- | Same as 'alphaEquiv' but for scoped terms.
+--
+-- While the binders of the two sides coincide, this runs with no renaming
+-- state at all. The first pair that differs switches to 'alphaEquivEnv',
+-- which threads the renamings down and switches back when they empty out.
+--
+-- @since 0.0.3
 {-# INLINABLE alphaEquivScoped #-}
 alphaEquivScoped
-  :: (Bitraversable sig, ZipMatchK sig, Foil.Distinct n, Foil.UnifiablePattern binder, Foil.SinkableK binder)
+  :: forall sig binder n. (Bitraversable sig, ZipMatchK sig, Foil.Distinct n, Foil.UnifiablePattern binder, Foil.SinkableK binder)
   => Foil.Scope n
   -> ScopedAST binder sig n
   -> ScopedAST binder sig n
@@ -227,42 +276,208 @@
 alphaEquivScoped scope
   (ScopedAST binder1 body1)
   (ScopedAST binder2 body2) =
-    case Foil.unifyPatterns binder1 binder2 of
-      -- if binders are the same, then we can safely compare bodies
+    case Foil.unifyPatternsIn scope binder1 binder2 of
+      -- the binders coincide: compare the bodies as they stand
       Foil.SameNameBinders{} ->  -- after seeing this we know that body scopes are the same
         case Foil.assertDistinct binder1 of
           Foil.Distinct ->
             let scope1 = Foil.extendScopePattern binder1 scope
             in alphaEquiv scope1 body1 body2
-      -- if we can safely rename first binder into second
+      -- the left binder is renamed towards the right one
       Foil.RenameLeftNameBinder _ rename1to2 ->
         case Foil.assertDistinct binder2 of
           Foil.Distinct ->
             let scope2 = Foil.extendScopePattern binder2 scope
-            in alphaEquiv scope2 (Foil.liftRM scope2 (Foil.fromNameBinderRenaming rename1to2) body1) body2
-      -- if we can safely rename second binder into first
+                pairs = [ (Foil.nameId x, renamedId rename1to2 x)
+                        | x <- Foil.namesOfPattern binder1 ]
+            in enterEnv pairs scope2 body1 body2
+      -- the right binder is renamed towards the left one
       Foil.RenameRightNameBinder _ rename2to1 ->
         case Foil.assertDistinct binder1 of
           Foil.Distinct ->
             let scope1 = Foil.extendScopePattern binder1 scope
-            in alphaEquiv scope1 body1 (Foil.liftRM scope1 (Foil.fromNameBinderRenaming rename2to1) body2)
-      -- if we need to rename both patterns
+                pairs = [ (renamedId rename2to1 y, Foil.nameId y)
+                        | y <- Foil.namesOfPattern binder2 ]
+            in enterEnv pairs scope1 body1 body2
+      -- both are renamed towards a unified pattern: pair the two sides'
+      -- names through the unified name each maps to
       Foil.RenameBothBinders binder' rename1 rename2 ->
         case Foil.assertDistinct binder' of
           Foil.Distinct ->
             let scope' = Foil.extendScopePattern binder' scope
-            in alphaEquiv scope'
-                (Foil.liftRM scope' (Foil.fromNameBinderRenaming rename1) body1)
-                (Foil.liftRM scope' (Foil.fromNameBinderRenaming rename2) body2)
+                leftU = IntMap.fromList
+                  [ (renamedId rename1 x, Foil.nameId x)
+                  | x <- Foil.namesOfPattern binder1 ]
+                rightU = IntMap.fromList
+                  [ (renamedId rename2 y, Foil.nameId y)
+                  | y <- Foil.namesOfPattern binder2 ]
+                pairs = IntMap.elems (IntMap.intersectionWith (,) leftU rightU)
+            in enterEnv pairs scope' body1 body2
       -- if we cannot unify patterns then scopes are not alpha-equivalent
       Foil.NotUnifiable -> False
+  where
+    enterEnv
+      :: forall m l1 l2. Foil.Distinct m
+      => [(Int, Int)] -> Foil.Scope m
+      -> AST binder sig l1 -> AST binder sig l2 -> Bool
+    enterEnv pairs scope' = bindPairs 0 IntMap.empty IntMap.empty pairs scope'
 
+-- | The raw name a verdict's renaming assigns to a pattern's name.
+--
+-- @since 0.4.0
+renamedId :: (Foil.NameBinder n a -> Foil.NameBinder n b) -> Foil.Name a -> Int
+renamedId rename = Foil.nameId . Foil.nameOf . rename . Foil.UnsafeNameBinder
+
+-- | Bind the paired names of a binder pair. A pair whose names coincide
+-- shadows both sides identically and is deleted from the environments. A pair
+-- whose names differ binds both to one fresh level. Continues with
+-- 'alphaEquivEnv' on the bodies.
+--
+-- @since 0.4.0
+bindPairs
+  :: forall sig binder m l1 l2. (Bitraversable sig, ZipMatchK sig, Foil.Distinct m, Foil.UnifiablePattern binder, Foil.SinkableK binder)
+  => Int -> IntMap Int -> IntMap Int -> [(Int, Int)]
+  -> Foil.Scope m
+  -> AST binder sig l1 -> AST binder sig l2 -> Bool
+bindPairs lvl envL envR pairs scope body1 body2 = case pairs of
+  [] -> alphaEquivEnv lvl envL envR scope body1 body2
+  ((x, y) : rest)
+    | x == y    -> bindPairs lvl (IntMap.delete x envL) (IntMap.delete y envR) rest scope body1 body2
+    | otherwise -> bindPairs (lvl + 1) (IntMap.insert x lvl envL) (IntMap.insert y lvl envR) rest scope body1 body2
+
+-- | The renaming-threading worker behind 'alphaEquiv': compare two terms
+-- under partial renamings of their names into shared /levels/.
+--
+-- Each environment maps a raw name to the level of the binder pair that bound
+-- it on the comparison path, and a name outside its environment stands for
+-- itself. A variable occurrence then compares as a level against a level, or
+-- as a raw name against a raw name, and the two can never be conflated. This
+-- is what makes threading sound where applying a raw renaming at the variables
+-- would not be, since a renamed name could collide with one that passes
+-- through unchanged and happens to share the target spelling. Levels are also
+-- why no capture check is needed: a level is never a name, so there is nothing
+-- for a binder to capture.
+--
+-- A binder pair whose names coincide /deletes/ those names from both
+-- environments, the pair shadowing both sides identically. When the
+-- environments empty out the comparison drops back to the stateless
+-- 'alphaEquiv', so only the region of the terms below a mismatched binder,
+-- and above the point where the mismatch is shadowed away, pays for the
+-- threading at all.
+--
+-- The indices of the two terms are deliberately independent, in the style
+-- of 'unsafeEqAST': the terms are never renamed into a common scope, so
+-- no common index exists to give them.
+--
+-- @since 0.4.0
+{-# INLINABLE alphaEquivEnv #-}
+alphaEquivEnv
+  :: forall sig binder n n1 n2. (Bitraversable sig, ZipMatchK sig, Foil.Distinct n, Foil.UnifiablePattern binder, Foil.SinkableK binder)
+  => Int          -- ^ Next fresh level.
+  -> IntMap Int   -- ^ Left renaming: raw name to the level that bound it.
+  -> IntMap Int   -- ^ Right renaming.
+  -> Foil.Scope n -- ^ Scope along the unified path (consulted by 'Foil.unifyPatternsIn').
+  -> AST binder sig n1
+  -> AST binder sig n2
+  -> Bool
+alphaEquivEnv lvl envL envR scope t1 t2
+  | IntMap.null envL && IntMap.null envR =
+      -- The renamings have emptied out (or never held anything): the
+      -- terms coincide raw-for-raw from here on, so compare them where
+      -- they stand. The coercion brings both indices to the scope's,
+      -- which is the unified path the comparison speaks of.
+      alphaEquiv scope (unsafeCoerce t1 :: AST binder sig n) (unsafeCoerce t2 :: AST binder sig n)
+  | otherwise = case (t1, t2) of
+      (Var x, Var y) ->
+        case (IntMap.lookup (Foil.nameId x) envL, IntMap.lookup (Foil.nameId y) envR) of
+          (Just k1, Just k2) -> k1 == k2
+          (Nothing, Nothing) -> Foil.nameId x == Foil.nameId y
+          _                  -> False
+      (Node l, Node r) ->
+        case zipMatchWith2
+               (unit . alphaEquivScopedEnv lvl envL envR scope)
+               (unit . alphaEquivEnv lvl envL envR scope) l r of
+          Nothing -> False
+          Just _  -> True
+      _ -> False
+  where
+    unit f x = if f x then Just () else Nothing
+
+-- | The scoped half of 'alphaEquivEnv': get the verdict from
+-- 'Foil.unifyPatternsIn', extend the environments as it prescribes, and
+-- recurse into the bodies as they stand.
+--
+-- @since 0.4.0
+{-# INLINABLE alphaEquivScopedEnv #-}
+alphaEquivScopedEnv
+  :: forall sig binder n n1 n2. (Bitraversable sig, ZipMatchK sig, Foil.Distinct n, Foil.UnifiablePattern binder, Foil.SinkableK binder)
+  => Int
+  -> IntMap Int
+  -> IntMap Int
+  -> Foil.Scope n
+  -> ScopedAST binder sig n1
+  -> ScopedAST binder sig n2
+  -> Bool
+alphaEquivScopedEnv lvl envL envR scope scoped1 scoped2 =
+  -- The scoped terms are compared where they stand; the coercion only
+  -- brings their indices to the scope's, which is the unified path the
+  -- environments and the verdicts speak of.
+  case (unsafeCoerce scoped1 :: ScopedAST binder sig n, unsafeCoerce scoped2 :: ScopedAST binder sig n) of
+    (ScopedAST binder1 body1, ScopedAST binder2 body2) ->
+      case Foil.unifyPatternsIn scope binder1 binder2 of
+        -- the binders coincide: the pair shadows both sides identically
+        Foil.SameNameBinders{} ->
+          case Foil.assertDistinct binder1 of
+            Foil.Distinct ->
+              let scope' = Foil.extendScopePattern binder1 scope
+                  names = map Foil.nameId (Foil.namesOfPattern binder1)
+                  envL' = deleteAll names envL
+                  envR' = deleteAll names envR
+               in alphaEquivEnv lvl envL' envR' scope' body1 body2
+        -- the left binder is renamed towards the right one
+        Foil.RenameLeftNameBinder _ rename1to2 ->
+          case Foil.assertDistinct binder2 of
+            Foil.Distinct ->
+              let scope' = Foil.extendScopePattern binder2 scope
+                  pairs = [ (Foil.nameId x, renamedId rename1to2 x)
+                          | x <- Foil.namesOfPattern binder1 ]
+               in bindPairs lvl envL envR pairs scope' body1 body2
+        -- the right binder is renamed towards the left one
+        Foil.RenameRightNameBinder _ rename2to1 ->
+          case Foil.assertDistinct binder1 of
+            Foil.Distinct ->
+              let scope' = Foil.extendScopePattern binder1 scope
+                  pairs = [ (renamedId rename2to1 y, Foil.nameId y)
+                          | y <- Foil.namesOfPattern binder2 ]
+               in bindPairs lvl envL envR pairs scope' body1 body2
+        -- both are renamed towards a unified pattern: pair the two sides'
+        -- names through the unified name each maps to
+        Foil.RenameBothBinders binder' rename1 rename2 ->
+          case Foil.assertDistinct binder' of
+            Foil.Distinct ->
+              let scope' = Foil.extendScopePattern binder' scope
+                  leftU = IntMap.fromList
+                    [ (renamedId rename1 x, Foil.nameId x)
+                    | x <- Foil.namesOfPattern binder1 ]
+                  rightU = IntMap.fromList
+                    [ (renamedId rename2 y, Foil.nameId y)
+                    | y <- Foil.namesOfPattern binder2 ]
+                  pairs = IntMap.elems (IntMap.intersectionWith (,) leftU rightU)
+               in bindPairs lvl envL envR pairs scope' body1 body2
+        Foil.NotUnifiable -> False
+  where
+    deleteAll names env = case names of
+      []       -> env
+      (i : is) -> deleteAll is (IntMap.delete i env)
+
 -- ** Unsafe equality checks
 
 -- | /Unsafe/ equality check for two terms.
 -- This check ignores the possibility that two terms might have different
 -- scope extensions under binders (which might happen due to substitution
 -- under a binder in absence of name conflicts).
+--
+-- @since 0.0.3
 {-# INLINABLE unsafeEqAST #-}
 unsafeEqAST
   :: (Bitraversable sig, ZipMatchK sig, Foil.UnifiablePattern binder, Foil.Distinct n, Foil.Distinct l)
@@ -279,6 +494,8 @@
 unsafeEqAST _ _ = False
 
 -- | A version of 'unsafeEqAST' for scoped terms.
+--
+-- @since 0.0.3
 {-# INLINABLE unsafeEqScopedAST #-}
 unsafeEqScopedAST
   :: (Bitraversable sig, ZipMatchK sig, Foil.UnifiablePattern binder, Foil.Distinct n, Foil.Distinct l)
@@ -295,8 +512,189 @@
 
 -- ** Convert to free foil
 
--- | Convert a raw term into a scope-safe term.
-convertToAST
+-- | An identifier a raw term mentions that the names given for conversion do
+-- not account for.
+--
+-- Note what this does and does not carry. It cannot carry a position: the
+-- conversion functions are generic in the raw term and only ever see it through
+-- @toSig@, so a source location, if the syntax has one, is not theirs to read.
+-- What they do know, and a caller checking names beforehand does not, is which
+-- names were in scope /at the occurrence/, the binders passed on the way down
+-- included. That is what a \"did you mean\" needs.
+--
+-- @since 0.4.0
+data UnresolvedName rawIdent = UnresolvedName
+  { unresolvedIdent   :: rawIdent
+    -- ^ The identifier that did not resolve.
+  , unresolvedInScope :: [rawIdent]
+    -- ^ What was in scope where it occurred.
+  } deriving (Eq, Show, Functor, Foldable, Traversable)
+
+-- | The identifiers a raw term mentions that a set of names cannot resolve, in
+-- the order they occur.
+--
+-- This is 'unsafeConvertToAST' with the conversion left out, so it descends
+-- under binders in the same way and accounts for what they bind.
+--
+-- @since 0.4.0
+unresolvedNames
+  :: forall sig binder rawIdent rawTerm rawPattern rawScopedTerm n.
+     (Foil.Distinct n, Bifoldable sig, Ord rawIdent, Foil.CoSinkable binder)
+  => (rawTerm -> Either rawIdent (sig (rawPattern, rawScopedTerm) rawTerm))
+  -- ^ Unpeel one syntax node (or a variable) from a raw term.
+  -> (forall x z. Foil.Distinct x
+      => Foil.Scope x
+      -> Map rawIdent (Foil.Name x)
+      -> rawPattern
+      -> (forall y. Foil.DExt x y
+          => binder x y
+          -> Map rawIdent (Foil.Name y)
+          -> z)
+      -> z)
+  -- ^ Convert raw pattern into a scope-safe pattern.
+  -> (rawScopedTerm -> rawTerm)
+  -- ^ Extract a term from a scoped term (or crash).
+  -> Foil.Scope n
+  -- ^ Resulting scope of the constructed term.
+  -> Map rawIdent (Foil.Name n)
+  -- ^ Known names of free variables in scope @n@.
+  -> rawTerm
+  -- ^ Raw term.
+  -> [UnresolvedName rawIdent]
+unresolvedNames toSig fromRawPattern getScopedTerm = go
+  where
+    go :: forall x. Foil.Distinct x
+       => Foil.Scope x -> Map rawIdent (Foil.Name x) -> rawTerm -> [UnresolvedName rawIdent]
+    go scope names t = case toSig t of
+      Left x
+        | Map.member x names -> []
+        | otherwise          -> [UnresolvedName x (Map.keys names)]
+      Right node -> bifoldMap (goScoped scope names) (go scope names) node
+
+    goScoped :: forall x. Foil.Distinct x
+             => Foil.Scope x -> Map rawIdent (Foil.Name x)
+             -> (rawPattern, rawScopedTerm) -> [UnresolvedName rawIdent]
+    goScoped scope names (pat, scopedTerm) =
+      fromRawPattern scope names pat $ \binder' names' ->
+        go (Foil.extendScopePattern binder' scope) names' (getScopedTerm scopedTerm)
+
+-- | Convert a raw term into a scope-safe term, reporting the first identifier
+-- that does not resolve.
+--
+-- One pass, short-circuiting at the first failure, so a term that resolves
+-- costs no more than 'unsafeConvertToAST' does. The report is complete for
+-- that one identifier, since 'unresolvedInScope' is built where the conversion
+-- fails and is never computed on the way through.
+--
+-- A caller wanting /every/ unresolved identifier rather than the first pays a
+-- second pass for it, with 'unresolvedNames'. The successful path stays fast
+-- that way, and a failure can afford to be walked again for a better message.
+--
+-- @since 0.4.0
+tryConvertToAST
+  :: forall sig binder rawIdent rawTerm rawPattern rawScopedTerm n.
+     (Foil.Distinct n, Bitraversable sig, Ord rawIdent,
+      Foil.CoSinkable binder, Foil.SinkableK binder)
+  => (rawTerm -> Either rawIdent (sig (rawPattern, rawScopedTerm) rawTerm))
+  -- ^ Unpeel one syntax node (or a variable) from a raw term.
+  -> (forall x z. Foil.Distinct x
+      => Foil.Scope x
+      -> Map rawIdent (Foil.Name x)
+      -> rawPattern
+      -> (forall y. Foil.DExt x y
+          => binder x y
+          -> Map rawIdent (Foil.Name y)
+          -> z)
+      -> z)
+  -- ^ Convert raw pattern into a scope-safe pattern.
+  -> (rawScopedTerm -> rawTerm)
+  -- ^ Extract a term from a scoped term (or crash).
+  -> Foil.Scope n
+  -- ^ Resulting scope of the constructed term.
+  -> Map rawIdent (Foil.Name n)
+  -- ^ Known names of free variables in scope @n@.
+  -> rawTerm
+  -- ^ Raw term.
+  -> Either (UnresolvedName rawIdent) (AST binder sig n)
+tryConvertToAST toSig fromRawPattern getScopedTerm scope names =
+  tryConvertToASTWith toSig fromRawPattern getScopedTerm scope names Map.empty
+
+-- | Convert a raw term into a scope-safe term, resolving some identifiers to
+-- whole terms rather than to variables.
+--
+-- The extra table is what a language with /constants/ needs: an identifier that
+-- denotes a top-level declaration, a primitive, or an abbreviation stands for
+-- something that is not a variable, and resolving it during conversion is the
+-- only place where the binders are known. Doing it in a pass of one's own means
+-- writing a binder-aware traversal of the raw syntax by hand.
+--
+-- Variables win: the table of names is consulted first, so a binder shadows an
+-- entry here, and an entry here shadows nothing. The table is sunk when going
+-- under a binder, exactly as the names are, so its entries may mention anything
+-- in scope where conversion started and need not be closed.
+--
+-- @since 0.4.0
+tryConvertToASTWith
+  :: forall sig binder rawIdent rawTerm rawPattern rawScopedTerm n.
+     (Foil.Distinct n, Bitraversable sig, Ord rawIdent,
+      Foil.CoSinkable binder, Foil.SinkableK binder)
+  => (rawTerm -> Either rawIdent (sig (rawPattern, rawScopedTerm) rawTerm))
+  -- ^ Unpeel one syntax node (or a variable) from a raw term.
+  -> (forall x z. Foil.Distinct x
+      => Foil.Scope x
+      -> Map rawIdent (Foil.Name x)
+      -> rawPattern
+      -> (forall y. Foil.DExt x y
+          => binder x y
+          -> Map rawIdent (Foil.Name y)
+          -> z)
+      -> z)
+  -- ^ Convert raw pattern into a scope-safe pattern.
+  -> (rawScopedTerm -> rawTerm)
+  -- ^ Extract a term from a scoped term (or crash).
+  -> Foil.Scope n
+  -- ^ Resulting scope of the constructed term.
+  -> Map rawIdent (Foil.Name n)
+  -- ^ Known names of free variables in scope @n@.
+  -> Map rawIdent (AST binder sig n)
+  -- ^ Identifiers that denote a term rather than a variable.
+  -> rawTerm
+  -- ^ Raw term.
+  -> Either (UnresolvedName rawIdent) (AST binder sig n)
+tryConvertToASTWith toSig fromRawPattern getScopedTerm = go
+  where
+    go :: forall x. Foil.Distinct x
+       => Foil.Scope x -> Map rawIdent (Foil.Name x)
+       -> Map rawIdent (AST binder sig x) -> rawTerm
+       -> Either (UnresolvedName rawIdent) (AST binder sig x)
+    go scope names terms t = case toSig t of
+      Left x -> case Map.lookup x names of
+        Just name -> Right (Var name)
+        Nothing   -> case Map.lookup x terms of
+          Just term -> Right term
+          Nothing   -> Left (UnresolvedName x (Map.keys names <> Map.keys terms))
+      Right node ->
+        Node <$> bitraverse (goScoped scope names terms) (go scope names terms) node
+
+    goScoped :: forall x. Foil.Distinct x
+             => Foil.Scope x -> Map rawIdent (Foil.Name x)
+             -> Map rawIdent (AST binder sig x)
+             -> (rawPattern, rawScopedTerm)
+             -> Either (UnresolvedName rawIdent) (ScopedAST binder sig x)
+    goScoped scope names terms (pat, scopedTerm) =
+      fromRawPattern scope names pat $ \binder' names' ->
+        ScopedAST binder'
+          <$> go (Foil.extendScopePattern binder' scope) names'
+                 (Foil.sink1 terms) (getScopedTerm scopedTerm)
+
+-- | Convert a raw term into a scope-safe term, calling 'error' on an
+-- identifier that does not resolve.
+--
+-- Prefer 'tryConvertToAST', which reports such identifiers. This is for callers
+-- that have already established that every name resolves.
+--
+-- @since 0.4.0
+unsafeConvertToAST
   :: (Foil.Distinct n, Bifunctor sig, Ord rawIdent, Foil.CoSinkable binder)
   => (rawTerm -> Either rawIdent (sig (rawPattern, rawScopedTerm) rawTerm))
   -- ^ Unpeel one syntax node (or a variable) from a raw term.
@@ -319,7 +717,7 @@
   -> rawTerm
   -- ^ Raw term.
   -> AST binder sig n
-convertToAST toSig fromRawPattern getScopedTerm scope names t =
+unsafeConvertToAST toSig fromRawPattern getScopedTerm scope names t =
   case toSig t of
     Left x ->
       case Map.lookup x names of
@@ -327,12 +725,14 @@
         Just name -> Var name
     Right node -> Node $
       bimap
-        (convertToScopedAST toSig fromRawPattern getScopedTerm scope names)
-        (convertToAST toSig fromRawPattern getScopedTerm scope names)
+        (unsafeConvertToScopedAST toSig fromRawPattern getScopedTerm scope names)
+        (unsafeConvertToAST toSig fromRawPattern getScopedTerm scope names)
         node
 
--- | Same as 'convertToAST' but for scoped terms.
-convertToScopedAST
+-- | Same as 'unsafeConvertToAST' but for scoped terms.
+--
+-- @since 0.4.0
+unsafeConvertToScopedAST
   :: (Foil.Distinct n, Bifunctor sig, Ord rawIdent, Foil.CoSinkable binder)
   => (rawTerm -> Either rawIdent (sig (rawPattern, rawScopedTerm) rawTerm))
   -- ^ Unpeel one syntax node (or a variable) from a raw term.
@@ -355,14 +755,62 @@
   -> (rawPattern, rawScopedTerm)
   -- ^ A pair of a pattern and a corresponding scoped term.
   -> ScopedAST binder sig n
-convertToScopedAST toSig fromRawPattern getScopedTerm scope names (pat, scopedTerm) =
+unsafeConvertToScopedAST toSig fromRawPattern getScopedTerm scope names (pat, scopedTerm) =
   fromRawPattern scope names pat $ \binder' names' ->
     let scope' = Foil.extendScopePattern binder' scope
-     in ScopedAST binder' (convertToAST toSig fromRawPattern getScopedTerm scope' names' (getScopedTerm scopedTerm))
+     in ScopedAST binder' (unsafeConvertToAST toSig fromRawPattern getScopedTerm scope' names' (getScopedTerm scopedTerm))
 
+-- | Convert a raw term into a scope-safe term.
+--
+-- @since 0.0.3
+convertToAST
+  :: (Foil.Distinct n, Bifunctor sig, Ord rawIdent, Foil.CoSinkable binder)
+  => (rawTerm -> Either rawIdent (sig (rawPattern, rawScopedTerm) rawTerm))
+  -> (forall x z. Foil.Distinct x
+      => Foil.Scope x
+      -> Map rawIdent (Foil.Name x)
+      -> rawPattern
+      -> (forall y. Foil.DExt x y
+          => binder x y
+          -> Map rawIdent (Foil.Name y)
+          -> z)
+      -> z)
+  -> (rawScopedTerm -> rawTerm)
+  -> Foil.Scope n
+  -> Map rawIdent (Foil.Name n)
+  -> rawTerm
+  -> AST binder sig n
+convertToAST = unsafeConvertToAST
+{-# DEPRECATED convertToAST "Renamed to unsafeConvertToAST, since it calls error on an unresolved identifier. Use tryConvertToAST to report them instead." #-}
+
+-- | Same as 'convertToAST' but for scoped terms.
+--
+-- @since 0.0.3
+convertToScopedAST
+  :: (Foil.Distinct n, Bifunctor sig, Ord rawIdent, Foil.CoSinkable binder)
+  => (rawTerm -> Either rawIdent (sig (rawPattern, rawScopedTerm) rawTerm))
+  -> (forall x z. Foil.Distinct x
+      => Foil.Scope x
+      -> Map rawIdent (Foil.Name x)
+      -> rawPattern
+      -> (forall y. Foil.DExt x y
+          => binder x y
+          -> Map rawIdent (Foil.Name y)
+          -> z)
+      -> z)
+  -> (rawScopedTerm -> rawTerm)
+  -> Foil.Scope n
+  -> Map rawIdent (Foil.Name n)
+  -> (rawPattern, rawScopedTerm)
+  -> ScopedAST binder sig n
+convertToScopedAST = unsafeConvertToScopedAST
+{-# DEPRECATED convertToScopedAST "Renamed to unsafeConvertToScopedAST, since it calls error on an unresolved identifier." #-}
+
 -- ** Convert from free foil
 
 -- | Convert a scope-safe term back into a raw term.
+--
+-- @since 0.0.3
 convertFromAST
   :: Bifunctor sig
   => (sig (rawPattern, rawScopedTerm) rawTerm -> rawTerm)
@@ -387,6 +835,8 @@
       node
 
 -- | Same as 'convertFromAST' but for scoped terms.
+--
+-- @since 0.0.3
 convertFromScopedAST
   :: Bifunctor sig
   => (sig (rawPattern, rawScopedTerm) rawTerm -> rawTerm)
@@ -407,22 +857,137 @@
     ( makePattern binder
     , makeScoped (convertFromAST fromSig fromVar makePattern makeScoped f body))
 
+-- | Convert a scope-safe term back into a raw term, naming the variables that
+-- occur /free in the whole term/ separately from the bound ones.
+--
+-- 'convertFromAST' applies one naming function to every variable it meets,
+-- bound or free, and gives it only a raw name. That is often not enough, since
+-- raw names are not unique across scope indices: a binder inside a term may
+-- share one with a name of the ambient scope, so naming by raw name alone can
+-- print a bound variable as whatever the ambient scope calls that name.
+--
+-- Keeping the typed name is what distinguishes them, and 'Foil.unsinkNamePattern'
+-- is the operation for it: composing one per binder on the way down builds a
+-- @'Foil.Name' x -> 'Maybe' ('Foil.Name' n)@ that answers exactly the question.
+--
+-- @since 0.4.0
+convertFromASTWith
+  :: forall sig binder rawIdent rawTerm rawPattern rawScopedTerm n.
+     (Bifunctor sig, Foil.Distinct n, Foil.CoSinkable binder)
+  => (sig (rawPattern, rawScopedTerm) rawTerm -> rawTerm)
+  -- ^ Peel back one layer of syntax.
+  -> (rawIdent -> rawTerm)
+  -- ^ Convert identifier into a raw variable term.
+  -> (forall x y. binder x y -> rawPattern)
+  -- ^ Convert scope-safe pattern into a raw pattern.
+  -> (rawTerm -> rawScopedTerm)
+  -- ^ Wrap raw term into a scoped term.
+  -> (Foil.Name n -> rawIdent)
+  -- ^ Name a variable that is free in the whole term.
+  -> (Int -> rawIdent)
+  -- ^ Name a bound variable, from its underlying integer identifier.
+  -> AST binder sig n
+  -- ^ Scope-safe term.
+  -> rawTerm
+convertFromASTWith fromSig fromVar makePattern makeScoped freeName boundName =
+    go Just
+  where
+    go :: forall x. Foil.Distinct x
+       => (Foil.Name x -> Maybe (Foil.Name n)) -> AST binder sig x -> rawTerm
+    go unsink = \case
+      Var x -> fromVar $ case unsink x of
+        Just name -> freeName name
+        Nothing   -> boundName (Foil.nameId x)
+      Node node -> fromSig (bimap (goScoped unsink) (go unsink) node)
+
+    goScoped :: forall x. Foil.Distinct x
+             => (Foil.Name x -> Maybe (Foil.Name n))
+             -> ScopedAST binder sig x -> (rawPattern, rawScopedTerm)
+    goScoped unsink (ScopedAST binder body) =
+      case Foil.assertDistinct binder of
+        Foil.Distinct ->
+          ( makePattern binder
+          , makeScoped
+              (go (\name -> Foil.unsinkNamePattern binder name >>= unsink) body) )
+
 -- ** Unsinking AST
 
+-- | The support of a term: exactly the names that occur free in it.
+--
+-- This is the annotation that co-de-Bruijn syntax carries intrinsically and
+-- that the foil, having global names and therefore free weakening, does not.
+-- Computing it is \(O(size)\); a client that restricts often should cache it.
+--
+-- @since 0.4.0
+supportOf
+  :: (Foil.Distinct n, Foil.CoSinkable binder, Bifoldable sig)
+  => AST binder sig n -> Foil.NameSet n
+supportOf = \case
+  Var name  -> Foil.nameSetSingleton name
+  Node node -> bifoldMap supportOfScopedAST supportOf node
+
+-- | The support of a scoped term, in the scope /outside/ its binder.
+--
+-- @since 0.4.0
+supportOfScopedAST
+  :: (Foil.Distinct n, Foil.CoSinkable binder, Bifoldable sig)
+  => ScopedAST binder sig n -> Foil.NameSet n
+supportOfScopedAST (ScopedAST binder body) =
+  case Foil.assertDistinct binder of
+    Foil.Distinct -> Foil.unsinkNameSet binder (supportOf body)
+
+-- | Cut a term down to the scope of exactly the names it uses.
+--
+-- This is the a-priori form of restriction, and the cheap one: the term
+-- inhabits the smaller scope /by construction/, so nothing is tested and
+-- nothing can fail. @'Foil.Ext' m n@ comes back with it, so the term can be
+-- 'Foil.sink'ed to where it came from for free.
+--
+-- Verifying a declared dependency, such as a @uses@ clause or a module's
+-- parameters, is this plus a comparison: compute the scope a term really
+-- inhabits, and check the declared one against it.
+--
+-- @since 0.4.0
+withRelevantScope
+  :: (Foil.Distinct n, Foil.CoSinkable binder, Bifoldable sig)
+  => AST binder sig n
+  -> (forall m. (Foil.Ext m n, Foil.Distinct m)
+      => Foil.Scope m -> AST binder sig m -> r)
+  -> r
+withRelevantScope term cont =
+  Foil.withRestrictedScope (supportOf term) $ \scope ->
+    cont scope (unsafeCoerce term)
+
 -- | Unsink an AST from a larger scope to a smaller scope.
-unsinkAST :: (Foil.Distinct l, Foil.CoSinkable binder, Bifoldable sig) => Foil.Scope n -> AST binder sig l -> Maybe (AST binder sig n)
+--
+-- This is the a-posteriori form, and the one that has to be paid for: the
+-- term's support is computed and compared against the scope. When it succeeds
+-- the term itself is untouched, since restriction of a term that does inhabit
+-- the smaller scope is a coercion.
+--
+-- @since 0.3.0
+unsinkAST
+  :: (Foil.Distinct l, Foil.CoSinkable binder, Bifoldable sig)
+  => Foil.Scope n -> AST binder sig l -> Maybe (AST binder sig n)
 unsinkAST scope term
-  | all (`Foil.member` scope) (freeVarsOf term) = Just (unsafeCoerce term)
+  | Foil.nameSetSubsetOfScope (supportOf term) scope = Just (unsafeCoerce term)
   | otherwise = Nothing
 
 -- | Get the free variables of an AST.
-freeVarsOf :: (Foil.Distinct n, Foil.CoSinkable binder, Bifoldable sig) => AST binder sig n -> [Foil.Name n]
-freeVarsOf = \case
-  Var name -> [name]
-  Node node -> bifoldMap freeVarsOfScopedAST freeVarsOf node
+--
+-- These come from 'supportOf', so they are distinct and in ascending order of
+-- their identifiers.
+--
+-- @since 0.3.0
+freeVarsOf
+  :: (Foil.Distinct n, Foil.CoSinkable binder, Bifoldable sig)
+  => AST binder sig n -> [Foil.Name n]
+freeVarsOf = Foil.nameSetToList . supportOf
 
--- | Get the free variables of a scoped AST.
-freeVarsOfScopedAST :: (Foil.Distinct n, Foil.CoSinkable binder, Bifoldable sig) => ScopedAST binder sig n -> [Foil.Name n]
-freeVarsOfScopedAST (ScopedAST binder body) =
-  case Foil.assertDistinct binder of
-    Foil.Distinct -> mapMaybe (Foil.unsinkNamePattern binder) (freeVarsOf body)
+-- | Get the free variables of a scoped AST, in the scope outside its binder.
+--
+-- @since 0.3.0
+freeVarsOfScopedAST
+  :: (Foil.Distinct n, Foil.CoSinkable binder, Bifoldable sig)
+  => ScopedAST binder sig n -> [Foil.Name n]
+freeVarsOfScopedAST = Foil.nameSetToList . supportOfScopedAST
diff --git a/src/Control/Monad/Free/Foil/Annotated.hs b/src/Control/Monad/Free/Foil/Annotated.hs
--- a/src/Control/Monad/Free/Foil/Annotated.hs
+++ b/src/Control/Monad/Free/Foil/Annotated.hs
@@ -21,12 +21,12 @@
 --
 -- The annotation is a /functor of the term/, and that is what lets it depend on
 -- the node's scope. In @'AST' binder sig n@ the signature's term parameter /is/
--- the AST at the node's own scope, so an annotation built from it holds terms in
--- that scope — which is what a type annotation in a dependent language needs.
+-- the AST at the node's own scope, so an annotation built from it holds terms
+-- in that scope, which is what a type annotation in a dependent language needs.
 -- An annotation that ignores the term (a source position, say) is @'Const' a@.
 --
 -- Whether two annotations must agree for their nodes to match is a property of
--- @ann@, not of 'AnnSig'. Two examples, and they are the two you will want:
+-- @ann@, and not of 'AnnSig'. Two examples:
 --
 -- An annotation that ignores the term (a source position) and /is/ compared:
 --
@@ -46,16 +46,18 @@
 -- >     Just (TypeOf (do { a <- l; b <- r; f a b }))
 --
 -- __The instance must return 'Just' unconditionally, and lazily.__ Matching is
--- annotation-blind, so it must succeed whatever the annotations are; the paired
--- annotation is a thunk the (annotation-skipping) 'Bifoldable' never forces. A
--- /strict/ shape — @TypeOf '<$>' f l r@, or anything that yields 'Nothing' when
--- @f@ fails — is a footgun twice over: it breaks blindness (two nodes with
--- different types would fail to match), and it /diverges/ for a finite or
--- lazily-bottomed annotation (a universe tower ending in 'error', say), because
--- forcing the annotation runs off the end. This is why the held term is a 'Maybe':
--- a plain @term@ field would have no value to pair when @f@ fails, forcing a
--- bottom into the result.
+-- annotation-blind, so it must succeed whatever the annotations are, and the
+-- paired annotation is a thunk that the annotation-skipping 'Bifoldable' never
+-- forces.
 --
+-- A /strict/ shape, such as @TypeOf '<$>' f l r@ or anything else that yields
+-- 'Nothing' when @f@ fails, goes wrong twice over. It breaks blindness, since
+-- two nodes with different types would then fail to match. And it /diverges/
+-- for a finite or lazily-bottomed annotation (a universe tower ending in
+-- 'error', say), because forcing the annotation runs off the end. This is why
+-- the held term is a 'Maybe': a plain @term@ field would have no value to pair
+-- when @f@ fails, forcing a bottom into the result.
+--
 -- __Do not reach for the generic instance here.__ It compares the annotation's
 -- /shape/, so a node carrying a memoised normal form would fail to match the same
 -- node without one. (Nor is 'zipMatchViaChooseLeft' available: an annotation
@@ -63,8 +65,8 @@
 -- pick a side.)
 --
 -- __Note the asymmetry__ in the instances below: 'Bifunctor' and 'Bitraversable'
--- traverse the annotation, but 'Bifoldable' does /not/. This is deliberate — see
--- 'AnnSig'.
+-- traverse the annotation, but 'Bifoldable' does /not/. This is deliberate.
+-- See 'AnnSig'.
 module Control.Monad.Free.Foil.Annotated (
   AnnSig(..),
   AnnAST,
@@ -99,6 +101,8 @@
 -- 'Control.Monad.Free.Foil.freeVarsOf', which is also 'Bifoldable', does not see
 -- variables occurring inside annotations. Use 'freeVarsOfAnnotated' when those
 -- matter.
+--
+-- @since 0.3.2
 data AnnSig (ann :: Type -> Type) (sig :: Type -> Type -> Type) scope term
   = AnnSig (ann term) (sig scope term)
   deriving (GHC.Generic)
@@ -128,20 +132,26 @@
 --
 -- The generic default would rebuild the "Generics.Kind" view of every node on
 -- every comparison, and comparing terms is most of what a typechecker does, so
--- for an annotated signature — where it lands on the hottest path — that is a
+-- for an annotated signature, where it lands on the hottest path, that is a
 -- measurable cost. 'Data.ZipMatchK.TH.deriveZipMatchK2' generates the
 -- written-out instance instead: the annotation matched with the term zipper (an
--- annotation is a functor of the term), the inner signature with both. Write
--- @deriveZipMatchK2 ''YourAnnSig@ for a bespoke annotated signature.
+-- annotation is a functor of the term), and the inner signature with both.
+-- Write @deriveZipMatchK2 ''YourAnnSig@ for a bespoke annotated signature.
 deriveZipMatchK2 ''AnnSig
 
 -- | An annotated scope-safe term.
+--
+-- @since 0.3.2
 type AnnAST binder ann sig = AST binder (AnnSig ann sig)
 
 -- | An annotated scope-safe term under a binder.
+--
+-- @since 0.3.2
 type AnnScopedAST binder ann sig = ScopedAST binder (AnnSig ann sig)
 
 -- | An annotated node.
+--
+-- @since 0.3.2
 pattern AnnNode
   :: ann (AnnAST binder ann sig n)
   -> sig (AnnScopedAST binder ann sig n) (AnnAST binder ann sig n)
@@ -152,6 +162,8 @@
 
 -- | The annotation of a term, unless it is a variable (which is not a node, so it
 -- carries none).
+--
+-- @since 0.3.2
 annotationOf :: AnnAST binder ann sig n -> Maybe (ann (AnnAST binder ann sig n))
 annotationOf = \case
   Var _         -> Nothing
@@ -162,6 +174,8 @@
 --
 -- 'Control.Monad.Free.Foil.freeVarsOf' misses the latter, since 'Bifoldable' skips
 -- the annotation (see 'AnnSig').
+--
+-- @since 0.3.2
 freeVarsOfAnnotated
   :: (Foil.Distinct n, Foil.CoSinkable binder, Bifoldable sig, Foldable ann)
   => AnnAST binder ann sig n -> [Foil.Name n]
diff --git a/src/Control/Monad/Free/Foil/Artifact.hs b/src/Control/Monad/Free/Foil/Artifact.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Free/Foil/Artifact.hs
@@ -0,0 +1,342 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE DeriveAnyClass      #-}
+{-# LANGUAGE DeriveFunctor       #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+-- | Serialisation support for checked units: stored terms, spelling tables,
+-- name-range metadata, and relocation.
+--
+-- The machinery here assumes only that a unit's /interned constants/ and its
+-- /locals/ (the names its binders bind) occupy disjoint name ranges, and it
+-- checks that assumption from the recorded metadata rather than taking it on
+-- faith. A stored term is then meaningful verbatim: a local keeps its raw id,
+-- and a constant is resolved through a spelling table on load.
+--
+-- One policy that provides the disjointness globally and by construction is
+-- to keep constants below zero and locals at or above, which is what the
+-- guarded successor allocator protects.
+--
+-- What loading trusts, and what it checks, is the client's decision, and the
+-- functions here supply the checkable facts. 'checkStoredLayout' judges the
+-- recorded ranges and 'constantRelocation' judges the constants, both from
+-- metadata alone, so no stored term is ever walked for checking. Only
+-- 'relocateConstants' walks a term, and only when a constant actually moved.
+module Control.Monad.Free.Foil.Artifact (
+  -- * Errors
+  ArtifactError (..),
+  prettyArtifactError,
+  -- * Stored terms
+  StoredTerm (..),
+  storeTerm,
+  decodeStored,
+  -- * Spelling tables and locals
+  termSpellings,
+  localsOf,
+  spanOfNames,
+  -- * Range metadata and its checks
+  StoredLayout (..),
+  nameRangeSize,
+  nameRangeContains,
+  nameRangesOverlap,
+  checkStoredLayout,
+  -- * Relocation
+  constantRelocation,
+  relocateConstants,
+) where
+
+import           Data.Binary                    (Binary, get)
+import qualified Data.Binary                    as Binary
+import           Data.Binary.Get                (runGetOrFail)
+import           Data.Bifoldable                (Bifoldable, bifoldMap)
+import           Data.Bifunctor                 (Bifunctor, bimap)
+import qualified Data.ByteString.Lazy           as BSL
+import qualified Data.IntMap                    as IntMap
+import qualified Data.IntSet                    as IntSet
+import           Data.Map                       (Map)
+import qualified Data.Map                       as Map
+import           GHC.Generics                   (Generic)
+import           Unsafe.Coerce                  (unsafeCoerce)
+
+import           Control.Monad.Foil.Internal
+import           Control.Monad.Free.Foil        (AST (..), ScopedAST (..),
+                                                 supportOf)
+import           Control.Monad.Free.Foil.Binary ()
+
+-- $setup
+-- >>> import Control.Monad.Foil (NameRange (..))
+-- >>> import qualified Data.Map as Map
+
+-- * Errors
+
+-- | What the machinery here can report. The type is parametric in the
+-- spelling, as the tables are, and a 'Functor' over it.
+--
+-- @since 0.4.0
+data ArtifactError ident
+  = MalformedStoredTerm String
+      -- ^ The bytes did not decode. The message is the decoder's.
+  | OverlappingRegions NameRange NameRange
+      -- ^ The recorded constants and locals ranges share a name.
+  | SpellingForLocal RawName
+      -- ^ The spelling table names something inside the locals region.
+  | WrongDeclarationCount NameRange Int
+      -- ^ The constants range does not hold one name per declaration.
+  | UnknownConstant ident
+      -- ^ A spelling the loading world does not know.
+  | ConstantAmongLocals ident RawName
+      -- ^ A relocation target inside the locals region, where the verbatim
+      -- locals could capture it.
+  deriving (Eq, Show, Functor)
+
+-- | Render an error, given a renderer for the spellings.
+--
+-- @since 0.4.0
+prettyArtifactError :: (ident -> String) -> ArtifactError ident -> String
+prettyArtifactError prettyIdent = \case
+  MalformedStoredTerm msg -> "malformed stored term: " <> msg
+  OverlappingRegions _ _ -> "the constants and locals regions overlap"
+  SpellingForLocal i -> "a spelling for local " <> show i
+  WrongDeclarationCount range count ->
+    "the constants range holds " <> show (nameRangeSize range)
+      <> " names for " <> show count <> " declarations"
+  UnknownConstant x -> "not in scope: " <> prettyIdent x
+  ConstantAmongLocals x _ ->
+    "constant " <> prettyIdent x <> " would land in the locals region"
+
+-- * Stored terms
+
+-- | A term as stored: canonical bytes. Equality of stored terms is byte
+-- equality, which is what a canonical-artifact property tests.
+--
+-- @since 0.4.0
+newtype StoredTerm = StoredTerm { storedBytes :: BSL.ByteString }
+  deriving (Eq, Show, Generic, Binary)
+
+-- | Store a term verbatim, through the instances of
+-- "Control.Monad.Free.Foil.Binary".
+--
+-- The disjoint layout is what makes verbatim enough. A constant's spelling
+-- goes into the unit's table ('termSpellings'), and a local needs no
+-- table: its id is expected to be canonical, which it is when elaboration
+-- allocates locals in a region of their own.
+--
+-- @since 0.4.0
+storeTerm :: Binary (AST binder sig n) => AST binder sig n -> StoredTerm
+storeTerm = StoredTerm . Binary.encode
+
+-- | Decode a stored term's bytes: the instances alone, no meaning yet.
+-- Meaning is given per unit, by 'constantRelocation' and
+-- 'relocateConstants'.
+--
+-- @since 0.4.0
+decodeStored
+  :: Binary (AST binder sig n)
+  => StoredTerm -> Either (ArtifactError ident) (AST binder sig n)
+decodeStored (StoredTerm bytes) =
+  case runGetOrFail get bytes of
+    Left (_, _, err) -> Left (MalformedStoredTerm err)
+    Right (rest, _, term)
+      | not (BSL.null rest) -> Left (MalformedStoredTerm "trailing bytes")
+      | otherwise -> Right term
+
+-- * Spelling tables and locals
+
+-- | The spelling-table entries a term needs. Its free variables are exactly
+-- its constants, provided the stored declaration is closed over everything
+-- local. Each is mapped to its spelling from the display table.
+--
+-- Note that the table should cover the referenced constants and only
+-- those. A table of everything in scope would let an unused import dirty a
+-- dependant's content hash, and would differ between build schedules.
+--
+-- @since 0.4.0
+termSpellings
+  :: (Distinct n, CoSinkable binder, Bifoldable sig)
+  => NameMap n ident      -- ^ Spellings of the top-level names.
+  -> AST binder sig n
+  -> Map RawName ident
+termSpellings display t = Map.fromList
+  [ (nameId x, lookupName x display)
+  | x <- nameSetToList (supportOf t)
+  ]
+
+-- | The names a term's binders bind: what a unit's locals range covers.
+-- Note that 'supportOf' cannot see them, since they are bound and not free.
+--
+-- @since 0.4.0
+localsOf
+  :: (Bifoldable sig, HasNameBinders binder)
+  => AST binder sig n -> [RawName]
+localsOf = \case
+  Var _    -> []
+  Node sig -> bifoldMap scopedLocals localsOf sig
+  where
+    scopedLocals (ScopedAST pat body) =
+      binderNames pat <> localsOf body
+    binderNames pat = case getNameBinders pat of
+      UnsafeNameBinders ids -> IntSet.toList ids
+
+-- | The tightest range covering the given names, or 'Nothing' for none.
+-- The caller picks its own convention for the empty range.
+--
+-- >>> spanOfNames [7, 3, 5]
+-- Just (NameRange {nameRangeLo = 3, nameRangeHi = 7})
+--
+-- @since 0.4.0
+spanOfNames :: [RawName] -> Maybe NameRange
+spanOfNames [] = Nothing
+spanOfNames ids = Just (NameRange (minimum ids) (maximum ids))
+
+-- * Range metadata and its checks
+
+-- | A unit's recorded name layout: the actual names of its own constants, and
+-- of its locals. The two travel together, so that they cannot be mixed up with
+-- the ranges of the loading world. An artifact records them as one field, and
+-- the checks and the relocation consume them as one value.
+--
+-- @since 0.4.0
+data StoredLayout = StoredLayout
+  { storedConstants :: NameRange
+  , storedLocals    :: NameRange
+  }
+  deriving (Eq, Show, Generic, Binary)
+
+-- | How many names a range holds.
+--
+-- >>> nameRangeSize (NameRange 3 5)
+-- 3
+--
+-- @since 0.4.0
+nameRangeSize :: NameRange -> Int
+nameRangeSize (NameRange lo hi) = max 0 (hi - lo + 1)
+
+-- | Whether a raw name lies in a range.
+--
+-- @since 0.4.0
+nameRangeContains :: NameRange -> RawName -> Bool
+nameRangeContains (NameRange lo hi) i = lo <= i && i <= hi
+
+-- | Whether two ranges share a name. An empty range overlaps nothing.
+--
+-- >>> nameRangesOverlap (NameRange 0 4) (NameRange 4 9)
+-- True
+-- >>> nameRangesOverlap (NameRange 0 4) (NameRange 5 9)
+-- False
+--
+-- @since 0.4.0
+nameRangesOverlap :: NameRange -> NameRange -> Bool
+nameRangesOverlap (NameRange lo1 hi1) (NameRange lo2 hi2) =
+  lo1 <= hi1 && lo2 <= hi2 && lo1 <= hi2 && lo2 <= hi1
+
+-- | The checks a unit's recorded layout admits, judged from metadata alone.
+-- The constants and locals ranges must not overlap, no spelling may be
+-- recorded for a local, and the constants range must hold exactly one name
+-- per declaration, since allocation is dense from the range's low end.
+--
+-- >>> layout = StoredLayout (NameRange (-10) (-9)) (NameRange 0 5)
+-- >>> checkStoredLayout layout (Map.fromList [(-20, "P.base")]) 2
+-- Right ()
+-- >>> checkStoredLayout layout (Map.fromList [(3, "q")]) 2
+-- Left (SpellingForLocal 3)
+--
+-- @since 0.4.0
+checkStoredLayout
+  :: StoredLayout         -- ^ The unit's recorded layout.
+  -> Map RawName ident    -- ^ Its spelling table.
+  -> Int                  -- ^ Its declaration count.
+  -> Either (ArtifactError ident) ()
+checkStoredLayout (StoredLayout constants locals) table declCount
+  | nameRangesOverlap constants locals =
+      Left (OverlappingRegions constants locals)
+  | (i : _) <- filter (nameRangeContains locals) (Map.keys table) =
+      Left (SpellingForLocal i)
+  | nameRangeSize constants /= declCount =
+      Left (WrongDeclarationCount constants declCount)
+  | otherwise = Right ()
+
+-- * Relocation
+
+-- | What a unit's constants need in the loading world, judged once, from
+-- the spelling table alone. 'Nothing' says every constant already has the
+-- id its spelling means here, which is the fast path, on which no term is
+-- walked at all. Otherwise the result is the renaming to apply. Its domain
+-- is a scope of the unit's world, which no longer exists, so its index is
+-- the caller's phantom.
+--
+-- The unit's own constants (table entries inside the recorded range) do
+-- not consult the world: they are being loaded right now, in the same
+-- order they were allocated, so their relocation is the affine shift
+-- between the recorded range and the one this run assigned. Their new
+-- names are thereby minted ahead of their allocation, which the caller's
+-- trust covers. An imported constant resolves by its spelling, and one this
+-- world does not know is reported. Finally, no relocation target may land
+-- among the locals, since verbatim locals rest on the two never meeting.
+--
+-- @since 0.4.0
+constantRelocation
+  :: Ord ident
+  => StoredLayout         -- ^ The unit's recorded layout.
+  -> NameRange            -- ^ The range this run assigned to the unit.
+  -> Map RawName ident    -- ^ Its spelling table.
+  -> Map ident (Name n')  -- ^ What each spelling means here.
+  -> Either (ArtifactError ident) (Maybe (NameMap old (Name n')))
+constantRelocation (StoredLayout old locals) (NameRange newLo _) table globals = do
+  entries <- Map.foldrWithKey step (Right []) table
+  pure $
+    if any (\(i, name) -> nameId name /= i) entries
+      then Just (NameMap (IntMap.fromList entries))
+      else Nothing
+  where
+    NameRange oldLo _ = old
+    shift = newLo - oldLo
+    step i spelling acc = do
+      rest <- acc
+      name <-
+        if nameRangeContains old i
+          then Right (UnsafeName (i + shift))
+          else case Map.lookup spelling globals of
+            Nothing   -> Left (UnknownConstant spelling)
+            Just name -> Right name
+      if nameRangeContains locals (nameId name)
+        then Left (ConstantAmongLocals spelling (nameId name))
+        else pure ((i, name) : rest)
+
+-- | Rename every constant reference through the map, moving the term from
+-- the unit's world into the loading one. This is the restriction to
+-- constants of a general renaming @'Name' n -> 'Name' n'@.
+-- 'sinkabilityProof' embodies the general renaming, but its efficient
+-- implementations degenerate the renaming to a coercion under binders,
+-- which is sound only for inclusions, whereas this walk carries an arbitrary
+-- map through.
+--
+-- The invariant that lets the walk ignore the binders is the disjointness
+-- the recorded layout certifies: every name in the map's domain is a
+-- constant, and a binder binds locals, so no binder can shadow a name in
+-- the domain and no local can be in it. Note that this covers imported
+-- constants too, since 'checkStoredLayout' refuses a spelling for any name
+-- among the locals. Thus the map never needs extending under a binder, and
+-- locals and patterns cross by coercion. A constant outside the map (bytes
+-- referencing something the spelling table does not cover) is re-minted
+-- unchanged, trusted like everything else about the term. Note that a map
+-- that is the identity on raw ids would make the whole walk a coercion,
+-- which is why 'constantRelocation' reports it as no relocation at all.
+--
+-- @since 0.4.0
+relocateConstants
+  :: forall binder sig n n'. Bifunctor sig
+  => NameMap n (Name n') -> AST binder sig n -> AST binder sig n'
+relocateConstants (NameMap moved) = walk
+  where
+    walk :: forall o o'. AST binder sig o -> AST binder sig o'
+    walk = \case
+      Var x -> case IntMap.lookup (nameId x) moved of
+        Just new -> Var (UnsafeName (nameId new))
+        Nothing  -> Var (UnsafeName (nameId x))
+      Node sig -> Node (bimap walkScoped walk sig)
+
+    walkScoped :: forall o o'. ScopedAST binder sig o -> ScopedAST binder sig o'
+    walkScoped (ScopedAST pat body) = ScopedAST (unsafeCoerce pat) (walk body)
diff --git a/src/Control/Monad/Free/Foil/Binary.hs b/src/Control/Monad/Free/Foil/Binary.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Free/Foil/Binary.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE UndecidableInstances  #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+-- | 'Binary' instances for the scope-safe syntax: the wire view of a term
+-- is the term itself, raw ids and all.
+--
+-- The instances are deliberately orphans in a module of their own, so that
+-- they are opt-in: importing this module is what brings them into scope,
+-- and nothing else in the library does. (The dependency this costs is
+-- @binary@, a GHC boot library.)
+--
+-- Note that decoding /mints/ scope evidence: a 'Foil.Name' comes back at
+-- whatever scope index the context asks for, and the existential scope
+-- under a binder is chosen arbitrarily. Thus the instances are a trust
+-- boundary, in the sense of 'Control.Monad.Foil.Blocks.checkExtScope'. The
+-- bytes are meaningful only under the discipline of the layer that wrote
+-- them, and that layer is expected to validate what it can on the way in.
+-- In particular, it should resolve the references it made
+-- world-independent, and check that the names it left verbatim lie where its
+-- allocation policy says. "Control.Monad.Free.Foil.Artifact" supplies those
+-- checks.
+module Control.Monad.Free.Foil.Binary () where
+
+import           Data.Binary                 (Binary (..))
+import           Data.Binary.Get             (Get, getWord8)
+import           Data.Binary.Put             (putWord8)
+
+import           Control.Monad.Foil.Internal
+import           Control.Monad.Free.Foil     (AST (..), ScopedAST (..))
+
+-- | The raw id and nothing else. See the module documentation for what
+-- decoding trusts.
+instance Binary (Name n) where
+  put (UnsafeName raw) = put raw
+  get = UnsafeName <$> get
+
+-- | See the 'Binary' instance of 'Name'.
+instance Binary (NameBinder n l) where
+  put (UnsafeNameBinder name) = put name
+  get = UnsafeNameBinder <$> get
+
+-- | The two bounds. A range carries no scope index, so nothing is minted:
+-- this instance is layout metadata for the serialising layer.
+instance Binary NameRange where
+  put (NameRange lo hi) = put lo <> put hi
+  get = NameRange <$> get <*> get
+
+-- | The binder and the body, one after the other. Decoding mints the scope
+-- under the binder. See the module documentation.
+instance (forall x y. Binary (binder x y), forall l. Binary (AST binder sig l))
+    => Binary (ScopedAST binder sig n) where
+  put (ScopedAST binder body) = put binder <> put body
+  get = do
+    binder <- get :: Get (binder n n)
+    body <- get
+    pure (ScopedAST binder body)
+
+-- | A tag byte, then the name or the node.
+instance ( forall x y. Binary (binder x y)
+         , forall scope term. (Binary scope, Binary term) => Binary (sig scope term)
+         ) => Binary (AST binder sig n) where
+  put (Var x)     = putWord8 0 <> put x
+  put (Node node) = putWord8 1 <> put node
+  get = getWord8 >>= \case
+    0   -> Var <$> get
+    1   -> Node <$> get
+    tag -> fail ("unknown AST tag " <> show tag)
diff --git a/src/Control/Monad/Free/Foil/Binary/TH.hs b/src/Control/Monad/Free/Foil/Binary/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Free/Foil/Binary/TH.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE TemplateHaskell #-}
+-- | Derive the 'Binary' instance a client's pattern (binder) type needs,
+-- alongside the hand-written instances of "Control.Monad.Free.Foil.Binary".
+--
+-- A pattern type is a GADT over two scope indices, so its instance cannot
+-- come from "GHC.Generics". What the deriver writes is the shape one would
+-- write by hand: one tag byte per constructor in declaration order, then
+-- the fields in order. Decoding happens /at the diagonal/, with every
+-- scope index of a constructor instantiated to the same variable, which any
+-- chain of binder indices admits. A single coercion then moves the result to
+-- the requested indices. That coercion mints scope evidence, so a derived
+-- instance is part of the same trust boundary as the library's own. See the
+-- module documentation of "Control.Monad.Free.Foil.Binary".
+module Control.Monad.Free.Foil.Binary.TH (deriveBinaryPattern) where
+
+import           Control.Monad       (unless, zipWithM)
+import           Data.Binary         (Binary (..))
+import           Data.Binary.Get     (Get, getWord8)
+import           Data.Binary.Put     (putWord8)
+import qualified Data.Map            as Map
+import           Language.Haskell.TH
+import           Unsafe.Coerce       (unsafeCoerce)
+
+-- | @'deriveBinaryPattern' ''Pattern@ writes
+-- @instance (Binary p1, …) => Binary (Pattern p1 … n l)@ for a pattern
+-- type of kind @… -> S -> S -> Type@ whose fields are parameters, name
+-- binders, or nested patterns.
+--
+-- @since 0.4.0
+deriveBinaryPattern :: Name -> Q [Dec]
+deriveBinaryPattern tyName = do
+  info <- reify tyName
+  (tvs, cons) <- case info of
+    TyConI (DataD _ _ tvs _ cons _)    -> pure (tvs, cons)
+    TyConI (NewtypeD _ _ tvs _ con _)  -> pure (tvs, [con])
+    _ -> fail ("deriveBinaryPattern: " <> show tyName <> " is not a data type")
+  unless (length tvs >= 2) $
+    fail "deriveBinaryPattern: expected a type of kind ... -> S -> S -> Type"
+  params <- mapM (\i -> newName ("p" <> show (i :: Int))) [1 .. length tvs - 2]
+  nVar <- newName "n"
+  lVar <- newName "l"
+  ctors <- concat <$> mapM flatten cons
+  unless (length ctors <= 256) $
+    fail "deriveBinaryPattern: more than 256 constructors"
+  putClauses <- zipWithM (putClause) [0 ..] ctors
+  getMatches <- zipWithM (getMatch params nVar) [0 ..] ctors
+  tagName <- newName "tag"
+  let headTy = foldl AppT (ConT tyName) (map VarT (params <> [nVar, lVar]))
+      context = [AppT (ConT ''Binary) (VarT p) | p <- params]
+      failMatch = Match WildP
+        (NormalB (AppE (VarE 'fail) (LitE (StringL "unknown pattern tag")))) []
+      getBody = InfixE (Just (VarE 'getWord8)) (VarE '(>>=))
+        (Just (LamE [VarP tagName]
+          (CaseE (VarE tagName) (getMatches <> [failMatch]))))
+  pure
+    [ InstanceD Nothing context (AppT (ConT ''Binary) headTy)
+        [ FunD 'put putClauses
+        , ValD (VarP 'get) (NormalB getBody) []
+        ]
+    ]
+  where
+    flatten (ForallC _ _ con)   = flatten con
+    flatten (GadtC names bts t) = pure [(c, map snd bts, t) | c <- names]
+    flatten _ =
+      fail "deriveBinaryPattern: expected GADT constructors (a pattern's indices vary per constructor)"
+
+    putClause tag (cname, fields, _) = do
+      args <- mapM (\i -> newName ("x" <> show (i :: Int))) [1 .. length fields]
+      let puts = AppE (VarE 'putWord8) (LitE (IntegerL tag))
+                   : [AppE (VarE 'put) (VarE a) | a <- args]
+      pure (Clause [ConP cname [] (map VarP args)]
+                   (NormalB (AppE (VarE 'mconcat) (ListE puts))) [])
+
+    -- Decode at the diagonal: the constructor's own scope variables (the
+    -- result indices and any intermediates) all become @n@, and its
+    -- parameter variables become the instance's parameters. The chain of a
+    -- pattern's indices always admits the diagonal. Each field's 'get' is
+    -- annotated with the substituted type, pinning the intermediates.
+    getMatch params nVar tag (cname, fields, result) = do
+      let (_, resultArgs) = unfoldApps result
+          paramPairs =
+            [ (v, VarT p)
+            | (VarT v, p) <- zip (take (length params) resultArgs) params ]
+          subst = Map.fromList paramPairs
+          substTy t = case t of
+            VarT v    -> Map.findWithDefault (VarT nVar) v subst
+            AppT f x  -> AppT (substTy f) (substTy x)
+            SigT x k  -> SigT (substTy x) k
+            ParensT x -> ParensT (substTy x)
+            _         -> t
+          getField ft = SigE (VarE 'get) (AppT (ConT ''Get) (substTy ft))
+          chain = case fields of
+            [] -> AppE (VarE 'pure) (ConE cname)
+            (f : fs) -> foldl
+              (\acc ft -> InfixE (Just acc) (VarE '(<*>)) (Just (getField ft)))
+              (InfixE (Just (ConE cname)) (VarE '(<$>)) (Just (getField f)))
+              fs
+          diagTy = AppT (ConT ''Get) (substTy result)
+          body = AppE (AppE (VarE 'fmap) (VarE 'unsafeCoerce)) (SigE chain diagTy)
+      pure (Match (LitP (IntegerL tag)) (NormalB body) [])
+
+    unfoldApps = go []
+      where
+        go args (AppT f x) = go (x : args) f
+        go args t          = (t, args)
diff --git a/src/Control/Monad/Free/Foil/Example.hs b/src/Control/Monad/Free/Foil/Example.hs
--- a/src/Control/Monad/Free/Foil/Example.hs
+++ b/src/Control/Monad/Free/Foil/Example.hs
@@ -17,6 +17,8 @@
 -- >>> import Control.Monad.Foil
 
 -- | Untyped \(\lambda\)-terms in scope @n@.
+--
+-- @since 0.0.1
 data ExprF scope term
   -- | Application of one term to another: \((t_1, t_2)\)
   = AppF term term
@@ -25,14 +27,24 @@
   deriving (Functor)
 deriveBifunctor ''ExprF
 
+-- | Application of one term to another.
+--
+-- @since 0.0.1
 pattern AppE :: AST binder ExprF n -> AST binder ExprF n -> AST binder ExprF n
 pattern AppE x y = Node (AppF x y)
 
+-- | A \(\lambda\)-abstraction, binding a pattern in a term of the extended
+-- scope.
+--
+-- @since 0.0.1
 pattern LamE :: binder n l -> AST binder ExprF l -> AST binder ExprF n
 pattern LamE binder body = Node (LamF (ScopedAST binder body))
 
 {-# COMPLETE Var, AppE, LamE #-}
 
+-- | A scope-safe \(\lambda\)-term with one name per binder.
+--
+-- @since 0.0.1
 type Expr = AST NameBinder ExprF
 
 -- | Use 'ppExpr' to show \(\lambda\)-terms.
@@ -43,6 +55,8 @@
 --
 -- >>> whnf emptyScope (AppE (churchN 2) (churchN 2))
 -- λx1. (λx0. λx1. (x0 (x0 x1)) (λx0. λx1. (x0 (x0 x1)) x1))
+--
+-- @since 0.0.1
 whnf :: Distinct n => Scope n -> Expr n -> Expr n
 whnf scope = \case
   AppE fun arg ->
@@ -57,6 +71,8 @@
 --
 -- >>> whnf' (AppE (churchN 2) (churchN 2))
 -- λx1. (λx0. λx1. (x0 (x0 x1)) (λx0. λx1. (x0 (x0 x1)) x1))
+--
+-- @since 0.0.1
 whnf' :: Expr VoidS -> Expr VoidS
 whnf' = whnf emptyScope
 
@@ -64,6 +80,8 @@
 --
 -- >>> nf emptyScope (AppE (churchN 2) (churchN 2))
 -- λx1. λx2. (x1 (x1 (x1 (x1 x2))))
+--
+-- @since 0.0.1
 nf :: Distinct n => Scope n -> Expr n -> Expr n
 nf scope expr = case expr of
   LamE binder body ->
@@ -86,10 +104,14 @@
 --
 -- >>> nf' (AppE (churchN 2) (churchN 2))
 -- λx1. λx2. (x1 (x1 (x1 (x1 x2))))
+--
+-- @since 0.0.1
 nf' :: Expr VoidS -> Expr VoidS
 nf' = nf emptyScope
 
 -- | Pretty print a name.
+--
+-- @since 0.0.1
 ppName :: Name n -> String
 ppName name = "x" <> show (nameId name)
 
@@ -97,6 +119,8 @@
 --
 -- >>> ppExpr (churchN 3)
 -- "\955x0. \955x1. (x0 (x0 (x0 x1)))"
+--
+-- @since 0.0.1
 ppExpr :: Expr n -> String
 ppExpr = \case
   Var name -> ppName name
@@ -104,6 +128,8 @@
   LamE binder body -> "λ" <> ppName (nameOf binder) <> ". " <> ppExpr body
 
 -- | A helper for constructing \(\lambda\)-abstractions.
+--
+-- @since 0.0.1
 lam :: Distinct n => Scope n -> (forall l. DExt n l => Scope l -> NameBinder n l -> Expr l) -> Expr n
 lam scope mkBody = withFresh scope $ \x ->
   let scope' = extendScope x scope
@@ -116,6 +142,8 @@
 --
 -- >>> churchN 3
 -- λx0. λx1. (x0 (x0 (x0 x1)))
+--
+-- @since 0.0.1
 churchN :: Int -> Expr VoidS
 churchN n =
   lam emptyScope $ \sx nx ->
diff --git a/src/Control/Monad/Free/Foil/TH/Convert.hs b/src/Control/Monad/Free/Foil/TH/Convert.hs
--- a/src/Control/Monad/Free/Foil/TH/Convert.hs
+++ b/src/Control/Monad/Free/Foil/TH/Convert.hs
@@ -12,6 +12,8 @@
 
 -- | Generate helpers for conversion to scope-safe representation.
 -- Includes 'mkConvertToSig', 'mkGetPatternBinder', and 'mkGetScopedTerm'.
+--
+-- @since 0.0.3
 mkConvertToFreeFoil
   :: Name -- ^ Type name for raw terms.
   -> Name -- ^ Type name for raw variable identifiers.
@@ -26,6 +28,8 @@
 
 -- | Generate helpers for conversion from scope-safe representation.
 -- Includes 'mkConvertFromSig'.
+--
+-- @since 0.0.3
 mkConvertFromFreeFoil
   :: Name -- ^ Type name for raw terms.
   -> Name -- ^ Type name for raw variable identifiers.
@@ -39,6 +43,8 @@
 -- * Individual generators
 
 -- | Generate conversion helper that goes unpeels one node from a raw term.
+--
+-- @since 0.0.3
 mkConvertToSig
   :: Name -- ^ Type name for raw terms.
   -> Name -- ^ Type name for raw variable identifiers.
@@ -109,6 +115,8 @@
           ]
 
 -- | Generate conversion helper that peels back one node to a raw term.
+--
+-- @since 0.0.3
 mkConvertFromSig
   :: Name -- ^ Type name for raw terms.
   -> Name -- ^ Type name for raw variable identifiers.
@@ -169,6 +177,8 @@
           ]
 
 -- | Generate a helper that extracts at most one binder from a pattern.
+--
+-- @since 0.0.3
 mkGetPatternBinder
   :: Name -- ^ Type name for raw variable identifiers.
   -> Name -- ^ Type name for raw patterns.
@@ -221,6 +231,8 @@
           ]
 
 -- | Generate a helper that extracts a term from a scoped term.
+--
+-- @since 0.0.3
 mkGetScopedTerm
   :: Name -- ^ Type name for raw terms.
   -> Name -- ^ Type name for raw scoped terms.
diff --git a/src/Control/Monad/Free/Foil/TH/MkFreeFoil.hs b/src/Control/Monad/Free/Foil/TH/MkFreeFoil.hs
--- a/src/Control/Monad/Free/Foil/TH/MkFreeFoil.hs
+++ b/src/Control/Monad/Free/Foil/TH/MkFreeFoil.hs
@@ -20,8 +20,9 @@
 import           Control.Monad.Foil.TH.Util
 import qualified Control.Monad.Free.Foil    as Foil
 import           Data.Bifunctor
+import           Data.Char                  (toUpper)
 import           Data.List                  (find, unzip4, (\\), nub)
-import           Data.Maybe                 (catMaybes, listToMaybe, mapMaybe,
+import           Data.Maybe                 (fromMaybe, isJust, catMaybes, listToMaybe, mapMaybe,
                                              maybeToList)
 import Data.Map (Map)
 import qualified Data.Map as Map
@@ -30,6 +31,8 @@
 -- | Config for the Template Haskell generation of data types,
 -- pattern synonyms, and conversion functions for the Free Foil representation,
 -- based on a raw recursive representation.
+--
+-- @since 0.2.0
 data FreeFoilConfig = FreeFoilConfig
   { rawQuantifiedNames        :: [Name]
   -- ^ Names of raw types that may include other binders and terms as components.
@@ -65,6 +68,8 @@
 -- for the Template Haskell generation of data types,
 -- pattern synonyms, and conversion functions for the Free Foil representation,
 -- based on a raw recursive representation.
+--
+-- @since 0.2.0
 data FreeFoilTermConfig = FreeFoilTermConfig
   { rawIdentName          :: Name
     -- ^ The type name for the identifiers.
@@ -108,6 +113,11 @@
     -- Normally, this is something like @(\(ScopedTerm term) -> term)@.
   }
 
+-- | Capitalize the first letter, so that @toTerm'@ gives @tryToTerm'@.
+capitalizeFirst :: String -> String
+capitalizeFirst []       = []
+capitalizeFirst (c : cs) = toUpper c : cs
+
 toFreeFoilName :: FreeFoilConfig -> Name -> Name
 toFreeFoilName FreeFoilConfig{..} name = mkName (freeFoilNameModifier (nameBase name))
 
@@ -117,6 +127,16 @@
 toFreeFoilNameTo :: FreeFoilConfig -> Name -> Name
 toFreeFoilNameTo FreeFoilConfig{..} name = mkName (freeFoilConvertToName (nameBase name))
 
+-- | The name of the range-parametric sibling of a generated definition
+-- (see 'Foil.withFreshIn'): @toPatternIn@ beside @toPattern@.
+toNameIn :: Name -> Name
+toNameIn name = mkName (nameBase name ++ "In")
+
+-- | The name of the naming-parametric sibling of a generated definition:
+-- @fromPatternWith@ beside @fromPattern@.
+toNameWith :: Name -> Name
+toNameWith name = mkName (nameBase name ++ "With")
+
 toFreeFoilScopedName :: FreeFoilConfig -> Name -> Name
 toFreeFoilScopedName FreeFoilConfig{..} name = mkName (freeFoilScopeNameModifier (nameBase name))
 
@@ -351,6 +371,167 @@
   PeelConT typeName _ | Just _ <- lookupScopeName typeName freeFoilTermConfigs -> True
   _ -> False
 
+-- | What a raw binding constructor's field becomes in the scope-safe binding
+-- type. Mirrors the classification in 'toFreeFoilBindingCon': an identifier
+-- becomes a 'Foil.NameBinder' and threads the scope; a binding type becomes a
+-- nested binding type and threads the scope; anything else is a payload that
+-- binds nothing.
+data BindingFieldSort = FieldBinder | FieldPattern | FieldPayload
+  deriving (Eq)
+
+bindingFieldSortOf :: FreeFoilConfig -> Type -> BindingFieldSort
+bindingFieldSortOf FreeFoilConfig{..} = \case
+  PeelConT typeName _typeParams
+    | typeName `elem` map rawIdentName freeFoilTermConfigs -> FieldBinder
+    | Just _ <- lookupBindingName typeName freeFoilTermConfigs -> FieldPattern
+  _ -> FieldPayload
+
+-- | Does this field introduce binders (and so thread the scope)?
+isBindingFieldSort :: BindingFieldSort -> Bool
+isBindingFieldSort = \case
+  FieldPayload -> False
+  _ -> True
+
+-- | Does this raw payload type mention anything that converts to a
+-- scope-indexed type in the binding type (a term, a scoped term, an
+-- identifier, or a nested binding under a type constructor)? Such a payload
+-- cannot be rebuilt by the generated 'Foil.CoSinkable' instance, rebuilding it
+-- at another scope being what 'Foil.transportPayload' exists for. Generation
+-- refuses such a payload, matching the GenericK-side refusal for derived
+-- patterns.
+mentionsScopeIndexed :: FreeFoilConfig -> Type -> Bool
+mentionsScopeIndexed FreeFoilConfig{..} = go
+  where
+    isIndexedName typeName = or
+      [ typeName `elem` rawQuantifiedNames
+      , typeName `elem` map rawIdentName freeFoilTermConfigs
+      , isJust (lookupTermName typeName freeFoilTermConfigs)
+      , isJust (lookupSubTermName typeName freeFoilTermConfigs)
+      , isJust (lookupScopeName typeName freeFoilTermConfigs)
+      , isJust (lookupSubScopeName typeName freeFoilTermConfigs)
+      , isJust (lookupBindingName typeName freeFoilTermConfigs)
+      ]
+    go = \case
+      PeelConT typeName typeParams -> isIndexedName typeName || any go typeParams
+      AppT f x -> go f || go x
+      SigT t _ -> go t
+      ParensT t -> go t
+      _ -> False
+
+-- | The constructors of a raw type as (name, field types), with every
+-- constructor syntax flattened to the same shape.
+flattenCons :: [Con] -> [(Name, [Type])]
+flattenCons = concatMap go
+  where
+    go = \case
+      NormalC name types -> [(name, map snd types)]
+      RecC name types -> [(name, map (\(_, _, t) -> t) types)]
+      InfixC l name r -> [(name, [snd l, snd r])]
+      GadtC names types _retType -> [ (name, map snd types) | name <- names ]
+      RecGadtC names types _retType -> [ (name, map (\(_, _, t) -> t) types) | name <- names ]
+      ForallC _ _ con -> go con
+
+-- | One 'Foil.coSinkabilityProof' clause for a generated binding constructor:
+--
+-- > coSinkabilityProof rename (Con x1 x2 x3) cont =
+-- >   coSinkabilityProof rename x1 $ \rename' x1' ->
+-- >     coSinkabilityProof rename' x2 $ \rename'' x2' ->
+-- >       cont rename'' (Con x1' x2' x3)
+--
+-- Binder and nested-pattern fields thread the renaming left to right (each via
+-- its own 'Foil.CoSinkable' instance); payload fields pass through untouched.
+mkCoSinkabilityProofClause :: FreeFoilConfig -> (Name, [Type]) -> Q Clause
+mkCoSinkabilityProofClause config (rawConName, rawFieldTypes) = do
+  let conName = toConName config rawConName
+      sorts = map (bindingFieldSortOf config) rawFieldTypes
+      -- Underscore-prefix the binders the clause will not use, so that the
+      -- generated code triggers no -Wunused-matches in the client module.
+      hasBinding = any isBindingFieldSort sorts
+  rename <- newName (if hasBinding then "rename" else "_rename")
+  cont <- newName "cont"
+  xs <- mapM (\i -> newName ("x" <> show i)) [1 .. length sorts]
+  -- fields collects the rebuilt constructor arguments in order (as a
+  -- difference list, since each step appends on the right).
+  let go renameCur [] fields =
+        return (VarE cont `AppE` VarE renameCur
+                  `AppE` foldl AppE (ConE conName) (fields []))
+      go renameCur ((FieldPayload, x) : rest) fields =
+        go renameCur rest (fields . (VarE x :))
+      go renameCur ((_, x) : rest) fields = do
+        x' <- newName (nameBase x <> "'")
+        renameNext <- newName "rename'"
+        body <- go renameNext rest (fields . (VarE x' :))
+        return (VarE 'Foil.coSinkabilityProof `AppE` VarE renameCur `AppE` VarE x
+                  `AppE` LamE [VarP renameNext, VarP x'] body)
+  body <- go rename (zip sorts xs) id
+  return (Clause [VarP rename, ConP conName [] (map VarP xs), VarP cont] (NormalB body) [])
+
+-- | One 'Foil.withPattern' clause for a generated binding constructor:
+--
+-- > withPattern withBinder unit_ comp_ scope (Con x1 x2 x3) cont =
+-- >   withBinder scope x1 $ \f1 x1' ->
+-- >     let scope' = extendScope x1' scope
+-- >     in withPattern withBinder unit_ comp_ scope' x2 $ \f2 x2' scope'' ->
+-- >          cont (comp_ f1 f2) (Con x1' x2' x3) scope''
+--
+-- A 'Foil.NameBinder' field is processed with @withBinder@ directly and
+-- extends the ambient scope for the fields to its right; a nested binding
+-- field recurses through its own 'Foil.withPattern', which hands the extended
+-- scope to its continuation. Results compose left to right with @comp_@; the
+-- final continuation receives the scope after the whole constructor, and a
+-- constructor that binds nothing hands @unit_@ and the ambient scope over.
+mkWithPatternClause :: FreeFoilConfig -> (Name, [Type]) -> Q Clause
+mkWithPatternClause config (rawConName, rawFieldTypes) = do
+  let conName = toConName config rawConName
+      sorts = map (bindingFieldSortOf config) rawFieldTypes
+      -- Underscore-prefix the binders the clause will not use, so that the
+      -- generated code triggers no -Wunused-matches in the client module: a
+      -- nested binding field keeps everything alive (its recursive call takes
+      -- unit_ and comp_ along), otherwise usage depends on how many fields
+      -- bind at all.
+      nBinding = length (filter isBindingFieldSort sorts)
+      hasNested = FieldPattern `elem` sorts
+      usedIf b n = if b then n else '_' : n
+  withBinder <- newName (usedIf (nBinding > 0) "withBinder")
+  unit_ <- newName (usedIf (nBinding == 0 || hasNested) "unit_")
+  comp_ <- newName (usedIf (nBinding >= 2 || hasNested) "comp_")
+  scope <- newName "scope"
+  cont <- newName "cont"
+  xs <- mapM (\i -> newName ("x" <> show i)) [1 .. length sorts]
+  -- acc is the composition of the binder results so far (Nothing before the
+  -- first one), composed left to right as each field is passed; fields
+  -- collects the rebuilt constructor arguments in order (as a difference
+  -- list, since each step appends on the right).
+  let go scopeCur acc [] fields =
+        return (VarE cont `AppE` fromMaybe (VarE unit_) acc
+                  `AppE` foldl AppE (ConE conName) (fields [])
+                  `AppE` VarE scopeCur)
+      go scopeCur acc ((FieldPayload, x) : rest) fields =
+        go scopeCur acc rest (fields . (VarE x :))
+      go scopeCur acc ((sort, x) : rest) fields = do
+        x' <- newName (nameBase x <> "'")
+        f <- newName "f"
+        scopeNext <- newName "scope'"
+        let acc' = case acc of
+              Nothing -> VarE f
+              Just a  -> VarE comp_ `AppE` a `AppE` VarE f
+        body <- go scopeNext (Just acc') rest (fields . (VarE x' :))
+        return $ case sort of
+          FieldBinder ->
+            VarE withBinder `AppE` VarE scopeCur `AppE` VarE x
+              `AppE` LamE [VarP f, VarP x']
+                  (LetE [ValD (VarP scopeNext)
+                           (NormalB (VarE 'Foil.extendScope `AppE` VarE x' `AppE` VarE scopeCur)) []]
+                     body)
+          _ ->
+            VarE 'Foil.withPattern `AppE` VarE withBinder `AppE` VarE unit_
+              `AppE` VarE comp_ `AppE` VarE scopeCur `AppE` VarE x
+              `AppE` LamE [VarP f, VarP x', VarP scopeNext] body
+  body <- go scope Nothing (zip sorts xs) id
+  return (Clause
+    [VarP withBinder, VarP unit_, VarP comp_, VarP scope, ConP conName [] (map VarP xs), VarP cont]
+    (NormalB body) [])
+
 termConToPat :: Name -> FreeFoilConfig -> FreeFoilTermConfig -> Con -> Q [([Name], Pat, Pat, [Exp])]
 termConToPat rawTypeName config@FreeFoilConfig{..} FreeFoilTermConfig{..} = go
   where
@@ -446,8 +627,8 @@
       ForallC _params _ctx con -> go con
       RecGadtC conNames argTypes retType -> go (GadtC conNames (map removeName argTypes) retType)
 
-termConToPatBinding :: Name -> FreeFoilConfig -> FreeFoilTermConfig -> Con -> Q [([Name], Pat, Pat, [Exp])]
-termConToPatBinding rawTypeName config@FreeFoilConfig{..} FreeFoilTermConfig{..} = go
+termConToPatBinding :: Name -> Name -> FreeFoilConfig -> FreeFoilTermConfig -> Con -> Q [([Name], Pat, Pat, [Exp])]
+termConToPatBinding named rawTypeName config@FreeFoilConfig{..} FreeFoilTermConfig{..} = go
   where
     rawRetType = error "impossible happened!"
 
@@ -456,11 +637,11 @@
       PeelConT typeName _params
         | typeName == rawIdentName -> do
             x <- newName "x"
-            return ([x], [VarP x], [VarP x], [VarE intToRawIdentName `AppE` (VarE 'Foil.nameId `AppE` (VarE 'Foil.nameOf `AppE` VarE x))])
+            return ([x], [VarP x], [VarP x], [VarE named `AppE` (VarE 'Foil.nameId `AppE` (VarE 'Foil.nameOf `AppE` VarE x))])
         | Just _ <- lookupBindingName typeName freeFoilTermConfigs -> do
-            let funName = toFreeFoilNameFrom config typeName
+            let funName = toNameWith (toFreeFoilNameFrom config typeName)
             x <- newName "x"
-            return ([x], [VarP x], [VarP x], [VarE funName `AppE` VarE x])
+            return ([x], [VarP x], [VarP x], [VarE funName `AppE` VarE named `AppE` VarE x])
         | Just _ <- lookupScopeName typeName freeFoilTermConfigs -> do
             binder <- newName "binder"
             body <- newName "body"
@@ -662,15 +843,15 @@
       ForallC _params _ctx con -> go con
       RecGadtC conNames argTypes retType -> go (GadtC conNames (map removeName argTypes) retType)
 
-toFreeFoilClauseFromBinding :: FreeFoilConfig -> FreeFoilTermConfig -> Type -> Con -> Q [Clause]
-toFreeFoilClauseFromBinding config termConfig@FreeFoilTermConfig{..} rawRetType = go
+toFreeFoilClauseFromBinding :: Name -> FreeFoilConfig -> FreeFoilTermConfig -> Type -> Con -> Q [Clause]
+toFreeFoilClauseFromBinding named config termConfig@FreeFoilTermConfig{..} rawRetType = go
   where
     go = \case
       GadtC conNames rawArgTypes rawRetType' -> concat <$> do
         forM (conNames \\ [rawVarConName]) $ \conName -> do
-          [(_vars, _pat, pat, exps)] <- termConToPatBinding rawBindingName config termConfig
+          [(_vars, _pat, pat, exps)] <- termConToPatBinding named rawBindingName config termConfig
             (GadtC [conName] rawArgTypes rawRetType')    -- FIXME: unsafe matching!
-          return [ Clause [pat] (NormalB (foldl AppE (ConE conName) exps)) [] ]
+          return [ Clause [VarP named, pat] (NormalB (foldl AppE (ConE conName) exps)) [] ]
 
       NormalC conName types -> go (GadtC [conName] types rawRetType)
       RecC conName types -> go (NormalC conName (map removeName types))
@@ -701,10 +882,13 @@
 --  3. Scope-safe patterns.
 --  4. Signatures for terms, subterms, and scoped subterms.
 --  5. Pattern synonyms for terms, subterms, and scoped subterms.
+--
+-- @since 0.2.0
 mkFreeFoil :: FreeFoilConfig -> Q [Dec]
 mkFreeFoil config@FreeFoilConfig{..} = concat <$> sequence
   [ mapM mkQuantifiedType rawQuantifiedNames
   , mapM mkBindingType freeFoilTermConfigs
+  , concat <$> mapM mkPatternCoSinkable freeFoilTermConfigs
   , concat <$> mapM mkSignatureTypes freeFoilTermConfigs
   , concat <$> mapM mkPatternSynonyms freeFoilTermConfigs
   ]
@@ -750,6 +934,36 @@
         ("/Generated/ with '" ++ show 'mkFreeFoil ++ "'. A binding type, scope-safe version of '" ++ show rawBindingName ++ "'.")
       return (DataD [] bindingName newParams Nothing newCons [])
 
+    -- A concrete 'Foil.CoSinkable' instance for the generated binding type,
+    -- one clause per constructor, delegating to the fields' instances. The
+    -- GenericK default routes every binder operation through a generic
+    -- representation traversal, which costs a measurable constant per binder
+    -- at runtime (see issue #82); the concrete instance removes it, and a
+    -- client no longer declares (or hand-writes) the instance itself.
+    mkPatternCoSinkable FreeFoilTermConfig{..} = do
+      (tvars, cons) <- reifyDataOrNewtype rawBindingName
+      let bindingName = toFreeFoilName config rawBindingName
+          bindingT = PeelConT bindingName (map (VarT . tvarName) tvars)
+          flatCons = flattenCons cons
+      forM_ flatCons $ \(conName, fieldTypes) ->
+        forM_ fieldTypes $ \fieldType ->
+          case bindingFieldSortOf config fieldType of
+            FieldPayload | mentionsScopeIndexed config fieldType -> fail $ unlines
+              [ "mkFreeFoil: cannot generate a CoSinkable instance for " <> show bindingName
+              , "  constructor " <> show conName <> " has a payload of raw type " <> pprint fieldType
+              , "  which becomes scope-indexed; write the instance by hand"
+              , "  (transportPayload is the sanctioned way to rebuild such a field)"
+              ]
+            _ -> return ()
+      coSinkClauses <- mapM (mkCoSinkabilityProofClause config) flatCons
+      withPatClauses <- mapM (mkWithPatternClause config) flatCons
+      return
+        [ InstanceD Nothing [] (AppT (ConT ''Foil.CoSinkable) bindingT)
+            [ FunD 'Foil.coSinkabilityProof coSinkClauses
+            , FunD 'Foil.withPattern withPatClauses
+            ]
+        ]
+
     mkSignatureTypes termConfig@FreeFoilTermConfig{..} = do
       sig <- mkSignatureType termConfig rawTermName
       subsigs <- concat <$> mapM (mkSignatureType termConfig) (rawSubTermNames <> rawSubScopeNames)
@@ -805,6 +1019,8 @@
 --  2. Conversions for scope-safe terms, scoped terms, subterms, scoped subterms.
 --  3. CPS-style conversions for scope-safe patterns.
 --  4. Helpers for signatures of terms, subterms, and scoped subterms.
+--
+-- @since 0.2.0
 mkFreeFoilConversions :: FreeFoilConfig -> Q [Dec]
 mkFreeFoilConversions config@FreeFoilConfig{..} = concat <$> sequence
   [ concat <$> mapM mkConvertFrom freeFoilTermConfigs
@@ -907,15 +1123,24 @@
 
     mkConvertFromBinding termConfig@FreeFoilTermConfig{..} = do
       (tvars, cons) <- reifyDataOrNewtype rawBindingName
+      (itvars, _cons) <- reifyDataOrNewtype rawIdentName
+      named <- newName "_named"
       let funName = toFreeFoilNameFrom config rawBindingName
+          funWithName = toNameWith funName
           rawRetType = PeelConT rawBindingName (map (VarT . tvarName) tvars)
+          rawIdentType = PeelConT rawIdentName (map (VarT . tvarName) (take (length itvars) tvars)) -- FIXME: undocumented hack :(
           bindingType = toFreeFoilType SortBinder config (VarT outerScope) (VarT innerScope) rawRetType
-      clauses <- concat <$> mapM (toFreeFoilClauseFromBinding config termConfig rawRetType) cons
+      clauses <- concat <$> mapM (toFreeFoilClauseFromBinding named config termConfig rawRetType) cons
+      addModFinalizer $ putDoc (DeclDoc funWithName)
+        ("/Generated/ with '" ++ show 'mkFreeFoil ++ "'. Convert a scope-safe to a raw binding, naming the binders from their indices with the given function. The same function must name the bound-variable references, or a reference comes out free of its own binder.")
       addModFinalizer $ putDoc (DeclDoc funName)
-        ("/Generated/ with '" ++ show 'mkFreeFoil ++ "'. Convert a scope-safe to a raw binding.")
+        ("/Generated/ with '" ++ show 'mkFreeFoil ++ "'. Convert a scope-safe to a raw binding, with the display naming.")
       return
-        [ SigD funName (bindingType --> rawRetType)
-        , FunD funName clauses ]
+        [ SigD funWithName ((ConT ''Int --> rawIdentType) --> bindingType --> rawRetType)
+        , FunD funWithName clauses
+        , SigD funName (bindingType --> rawRetType)
+        , FunD funName [ Clause [] (NormalB (VarE funWithName `AppE` VarE intToRawIdentName)) [] ]
+        ]
 
     mkConvertTo termConfig@FreeFoilTermConfig{..} = concat <$> sequence
       [ mkConvertToSig SortTerm termConfig rawTermName
@@ -961,25 +1186,67 @@
           funBindingName = toFreeFoilNameTo config rawBindingName
           rawTermType = PeelConT rawTermName (map (VarT . tvarName) tvars)
           termType =  toFreeFoilType SortTerm config (VarT outerScope) (VarT innerScope) rawTermType
+          tryFunName = mkName ("try" ++ capitalizeFirst (nameBase funName))
+          tryWithFunName = mkName (nameBase tryFunName ++ "With")
+          unresolvedType = ConT ''Foil.UnresolvedName `AppT` rawIdentType
+          tryTermType = ConT ''Either `AppT` unresolvedType `AppT` termType
+          convertArgs f = VarE f
+            `AppE` VarE funSigName
+            `AppE` VarE funBindingName
+            `AppE` VarE rawScopeToTermName
+          convertArgsIn f range = VarE f
+            `AppE` VarE funSigName
+            `AppE` (VarE (toNameIn funBindingName) `AppE` VarE range)
+            `AppE` VarE rawScopeToTermName
       addModFinalizer $ putDoc (DeclDoc funName)
-        ("/Generated/ with '" ++ show 'mkFreeFoil ++ "'. Convert from scope-safe to raw representation.")
-      return
-        [ SigD funName $
+        ("/Generated/ with '" ++ show 'mkFreeFoil ++ "'. Convert from raw to scope-safe representation, calling 'error' on an identifier that does not resolve. See '" ++ nameBase tryFunName ++ "'.")
+      addModFinalizer $ putDoc (DeclDoc tryFunName)
+        ("/Generated/ with '" ++ show 'mkFreeFoil ++ "'. Convert from raw to scope-safe representation, reporting the first identifier that does not resolve.")
+      addModFinalizer $ putDoc (DeclDoc tryWithFunName)
+        ("/Generated/ with '" ++ show 'mkFreeFoil ++ "'. Same as '" ++ nameBase tryFunName ++ "', except that some identifiers may resolve to a whole term rather than to a variable.")
+      range <- newName "range"
+      let mkSig body =
             ForallT
               (PlainTV outerScope SpecifiedSpec : map (SpecifiedSpec <$) tvars)
               [ ConT ''Foil.Distinct `AppT` VarT outerScope
-              , ConT ''Ord `AppT` rawIdentType ] $
+              , ConT ''Ord `AppT` rawIdentType ]
+              body
+          plainSigTail =
                 (ConT ''Foil.Scope `AppT` VarT outerScope)
                 --> (ConT ''Map `AppT` rawIdentType `AppT` (ConT ''Foil.Name `AppT` VarT outerScope))
                 --> rawTermType
                 --> termType
-        , FunD funName [
-            Clause [] (NormalB
-              (VarE 'Foil.convertToAST
-                `AppE` VarE funSigName
-                `AppE` VarE funBindingName
-                `AppE` VarE rawScopeToTermName)) []
+          trySigTail =
+                (ConT ''Foil.Scope `AppT` VarT outerScope)
+                --> (ConT ''Map `AppT` rawIdentType `AppT` (ConT ''Foil.Name `AppT` VarT outerScope))
+                --> rawTermType
+                --> tryTermType
+          tryWithSigTail =
+                (ConT ''Foil.Scope `AppT` VarT outerScope)
+                --> (ConT ''Map `AppT` rawIdentType `AppT` (ConT ''Foil.Name `AppT` VarT outerScope))
+                --> (ConT ''Map `AppT` rawIdentType `AppT` termType)
+                --> rawTermType
+                --> tryTermType
+      forM_ [funName, tryFunName, tryWithFunName] $ \name ->
+        addModFinalizer $ putDoc (DeclDoc (toNameIn name))
+          ("/Generated/ with '" ++ show 'mkFreeFoil ++ "'. Same as '" ++ nameBase name ++ "', except that the binders introduced by the conversion are allocated within the given range; see 'Foil.withFreshIn'.")
+      return $
+        [ SigD funName (mkSig plainSigTail)
+        , FunD funName [ Clause [] (NormalB (convertArgs 'Foil.unsafeConvertToAST)) [] ]
+        , SigD tryFunName (mkSig trySigTail)
+        , FunD tryFunName [ Clause [] (NormalB (convertArgs 'Foil.tryConvertToAST)) [] ]
+        , SigD tryWithFunName (mkSig tryWithSigTail)
+        , FunD tryWithFunName [ Clause [] (NormalB (convertArgs 'Foil.tryConvertToASTWith)) [] ]
+        ] ++ concat
+        [ [ SigD inName (mkSig (ConT ''Foil.NameRange --> sigTail))
+          , FunD inName [ Clause [VarP range] (NormalB (convertArgsIn f range)) [] ]
           ]
+        | (name, sigTail, f) <-
+            [ (funName, plainSigTail, 'Foil.unsafeConvertToAST)
+            , (tryFunName, trySigTail, 'Foil.tryConvertToAST)
+            , (tryWithFunName, tryWithSigTail, 'Foil.tryConvertToASTWith)
+            ]
+        , let inName = toNameIn name
         ]
 
     mkConvertToSig sort termConfig@FreeFoilTermConfig{..} rawName = do
@@ -1015,14 +1282,8 @@
           safeType = toFreeFoilType SortBinder config (VarT outerScope) (VarT innerScope) rawBindingType
       clauses <- concat <$> mapM (bindingConToClause rawBindingType config termConfig) cons
       r <- newName "r"
-      addModFinalizer $ putDoc (DeclDoc funName)
-        ("/Generated/ with '" ++ show 'mkFreeFoil ++ "'. Convert from raw to scope-safe binding (CPS-style).")
-      return
-        [ SigD funName $
-            ForallT
-              (PlainTV outerScope SpecifiedSpec : map (SpecifiedSpec <$) tvars ++ [PlainTV r SpecifiedSpec])
-              [ ConT ''Foil.Distinct `AppT` VarT outerScope
-              , ConT ''Ord `AppT` rawIdentType ] $
+      let funInName = toNameIn funName
+          bindingSigTail =
                 (ConT ''Foil.Scope `AppT` VarT outerScope)
                 --> (ConT ''Map `AppT` rawIdentType `AppT` (ConT ''Foil.Name `AppT` VarT outerScope))
                 --> rawBindingType
@@ -1032,7 +1293,22 @@
                         --> (ConT ''Map `AppT` rawIdentType `AppT` (ConT ''Foil.Name `AppT` VarT innerScope))
                         --> VarT r)
                 --> VarT r
-        , FunD funName clauses ]
+          bindingForall body =
+            ForallT
+              (PlainTV outerScope SpecifiedSpec : map (SpecifiedSpec <$) tvars ++ [PlainTV r SpecifiedSpec])
+              [ ConT ''Foil.Distinct `AppT` VarT outerScope
+              , ConT ''Ord `AppT` rawIdentType ]
+              body
+      addModFinalizer $ putDoc (DeclDoc funInName)
+        ("/Generated/ with '" ++ show 'mkFreeFoil ++ "'. Convert from raw to scope-safe binding (CPS-style), allocating the binders within a given range; see 'Foil.withFreshIn'.")
+      addModFinalizer $ putDoc (DeclDoc funName)
+        ("/Generated/ with '" ++ show 'mkFreeFoil ++ "'. Convert from raw to scope-safe binding (CPS-style). This is '" ++ nameBase funInName ++ "' at 'Foil.fullNameRange'.")
+      return
+        [ SigD funInName (bindingForall (ConT ''Foil.NameRange --> bindingSigTail))
+        , FunD funInName clauses
+        , SigD funName (bindingForall bindingSigTail)
+        , FunD funName [ Clause [] (NormalB (VarE funInName `AppE` VarE 'Foil.fullNameRange)) [] ]
+        ]
 
     mkConvertToQuantified rawName = do
       (tvars, cons) <- reifyDataOrNewtype rawName
@@ -1230,18 +1506,18 @@
 bindingConToClause :: Type -> FreeFoilConfig -> FreeFoilTermConfig -> Con -> Q [Clause]
 bindingConToClause rawType config FreeFoilTermConfig{..} = go
   where
-    goArgTypes :: Name -> Name -> [Type] -> Q ([Pat], [Exp], Exp -> Exp, Name)
-    goArgTypes _scope env [] = return ([], [], id, env)
-    goArgTypes scope env (t:ts) = case t of
+    goArgTypes :: Name -> Name -> Name -> [Type] -> Q ([Pat], [Exp], Exp -> Exp, Name)
+    goArgTypes _range _scope env [] = return ([], [], id, env)
+    goArgTypes range scope env (t:ts) = case t of
       PeelConT typeName _params
         | typeName == rawIdentName -> do
             x <- newName "_x"
             x' <- newName "_x'"
             scope' <- newName "_scope"
             env' <- newName "_env"
-            (pats, exps, wrap, env'') <- goArgTypes scope' env' ts
+            (pats, exps, wrap, env'') <- goArgTypes range scope' env' ts
             return (VarP x : pats, VarE x' : exps, \e ->
-              VarE 'Foil.withFresh `AppE` VarE scope `AppE`
+              VarE 'Foil.withFreshIn `AppE` VarE range `AppE` VarE scope `AppE`
                 LamE [VarP x']
                   (LetE [ ValD (VarP scope') (NormalB (VarE 'Foil.extendScope `AppE` VarE x' `AppE` VarE scope)) []
                         , ValD (VarP env') (NormalB (VarE 'Map.insert `AppE` VarE x `AppE` (VarE 'Foil.nameOf `AppE` VarE x') `AppE` (VarE 'fmap `AppE` VarE 'Foil.sink `AppE` VarE env))) []]
@@ -1251,29 +1527,30 @@
             x' <- newName "_x'"
             scope' <- newName "_scope"
             env' <- newName "_env"
-            let funName = toFreeFoilNameTo config typeName
-            (pats, exps, wrap, env'') <- goArgTypes scope' env' ts
+            let funName = toNameIn (toFreeFoilNameTo config typeName)
+            (pats, exps, wrap, env'') <- goArgTypes range scope' env' ts
             return (VarP x : pats, VarE x' : exps, \e ->
-              VarE funName `AppE` VarE scope `AppE` VarE env `AppE` VarE x `AppE`
+              VarE funName `AppE` VarE range `AppE` VarE scope `AppE` VarE env `AppE` VarE x `AppE`
                 LamE [VarP x', VarP env']
                   (LetE [ ValD (VarP scope') (NormalB (VarE 'Foil.extendScopePattern `AppE` VarE x' `AppE` VarE scope)) []]
                     (wrap e)), env'')
       _ -> do
         x <- newName "_x"
-        (pats, exps, wrap, env') <- goArgTypes scope env ts
+        (pats, exps, wrap, env') <- goArgTypes range scope env ts
         return (VarP x : pats, VarE x : exps, wrap, env')
 
     go :: Con -> Q [Clause]
     go = \case
       GadtC conNames rawArgTypes _rawRetType -> concat <$> do
+        range <- newName "_range"
         scope <- newName "_scope"
         env <- newName "_env"
         cont <- newName "_cont"
         forM conNames $ \conName -> do
           let newConName = toConName config conName
-          (pats, exps, wrap, env') <- goArgTypes scope env (map snd rawArgTypes)
+          (pats, exps, wrap, env') <- goArgTypes range scope env (map snd rawArgTypes)
           return
-            [ Clause [VarP scope, VarP env, ConP conName [] pats, VarP cont]
+            [ Clause [VarP range, VarP scope, VarP env, ConP conName [] pats, VarP cont]
                 (NormalB (wrap (VarE cont `AppE` foldl AppE (ConE newConName) exps `AppE` VarE env'))) [] ]
       NormalC conName types -> go (GadtC [conName] types rawType)
       RecC conName types -> go (NormalC conName (map removeName types))
diff --git a/src/Control/Monad/Free/Foil/TH/PatternSynonyms.hs b/src/Control/Monad/Free/Foil/TH/PatternSynonyms.hs
--- a/src/Control/Monad/Free/Foil/TH/PatternSynonyms.hs
+++ b/src/Control/Monad/Free/Foil/TH/PatternSynonyms.hs
@@ -13,6 +13,8 @@
 import           Language.Haskell.TH.Syntax
 
 -- | Generate helpful pattern synonyms given a signature bifunctor.
+--
+-- @since 0.0.3
 mkPatternSynonyms
   :: Name -- ^ Type name for the signature bifunctor.
   -> Q [Dec]
diff --git a/src/Control/Monad/Free/Foil/TH/Signature.hs b/src/Control/Monad/Free/Foil/TH/Signature.hs
--- a/src/Control/Monad/Free/Foil/TH/Signature.hs
+++ b/src/Control/Monad/Free/Foil/TH/Signature.hs
@@ -13,6 +13,8 @@
 -- based on a naïve recursive abstract syntax representation,
 -- with clearly separated types for terms, variable identifiers, scoped terms,
 -- and patterns (binders).
+--
+-- @since 0.0.3
 mkSignature
   :: Name -- ^ Type name for raw terms.
   -> Name -- ^ Type name for raw variable identifiers.
diff --git a/src/Data/ZipMatchK.hs b/src/Data/ZipMatchK.hs
--- a/src/Data/ZipMatchK.hs
+++ b/src/Data/ZipMatchK.hs
@@ -34,11 +34,15 @@
 -- | Perform one level of equality testing for two values and pair up components using @(,)@:
 --
 -- > zipMatchK = zipMatchWithK (\x y -> Just (,) :^: M0)
+--
+-- @since 0.2.0
 zipMatchK :: forall f as bs. (ZipMatchK f, PairMappings as bs) => f :@@: as -> f :@@: bs -> Maybe (f :@@: ZipLoT as bs)
 zipMatchK = zipMatchWithK @_ @f @as @bs pairMappings
 
 -- | Unify values via 'Eq'.
 -- Can be used as an implementation of 'zipMatchWithK' when @k = 'Data.Kind.Type'@.
+--
+-- @since 0.2.0
 zipMatchViaEq :: Eq a => Mappings as bs cs -> a -> a -> Maybe a
 zipMatchViaEq _ x y
   | x == y = Just x
@@ -46,12 +50,16 @@
 
 -- | Always successfully unify any two values of type @a@ by preferring the left value.
 -- Can be used as an implementation of 'zipMatchWithK' when @k = 'Data.Kind.Type'@.
+--
+-- @since 0.2.0
 zipMatchViaChooseLeft :: Mappings as bs cs -> a -> a -> Maybe a
 zipMatchViaChooseLeft _ x _ = Just x
 
 -- | 'zipMatchWithK' specialised to functors.
 --
 -- Note: 'Traversable' is a morally correct constraint here.
+--
+-- @since 0.3.0
 zipMatchWith1
   :: (Traversable f, ZipMatchK f)
   => (a -> a' -> Maybe a'')
@@ -61,11 +69,15 @@
 -- | 'zipMatchK' specialised to functors.
 --
 -- Note: 'Traversable' is a morally correct constraint here.
+--
+-- @since 0.3.0
 zipMatch1 :: (Traversable f, ZipMatchK f) => f a -> f a' -> Maybe (f (a, a'))
 zipMatch1 = zipMatchWith1 pairA
 -- | 'zipMatchWithK' specialised to bifunctors.
 --
 -- Note: 'Bitraversable' is a morally correct constraint here.
+--
+-- @since 0.3.0
 zipMatchWith2
   :: (Bitraversable f, ZipMatchK f)
   => (a -> a' -> Maybe a'')
@@ -76,5 +88,7 @@
 -- | 'zipMatchK' specialised to bifunctors.
 --
 -- Note: 'Bitraversable' is a morally correct constraint here.
+--
+-- @since 0.3.0
 zipMatch2 :: (Bitraversable f, ZipMatchK f) => f a b -> f a' b' -> Maybe (f (a, a') (b, b'))
 zipMatch2 = zipMatchWith2 pairA pairA
diff --git a/src/Data/ZipMatchK/Generic.hs b/src/Data/ZipMatchK/Generic.hs
--- a/src/Data/ZipMatchK/Generic.hs
+++ b/src/Data/ZipMatchK/Generic.hs
@@ -27,25 +27,29 @@
 
 -- | Kind-polymorphic syntactic (first-order) unification of two values.
 --
--- Note: @f@ is expected to be a traversable n-functor,
--- but at the moment we lack a @TraversableK@ constraint.
+-- Note that @f@ is expected to be a traversable n-functor. There is no
+-- @TraversableK@ constraint to say so at the moment.
 --
 -- The default implementation is generic, via 'Generics.Kind.RepK'. It is
--- convenient, but it reflects each node into a representation and back on every
--- comparison, and a constructor is represented as a chain of @L1@\/@R1@ wrappers
--- as long as its index, so the cost grows with the size of the signature. On a
--- 44-constructor signature it costs about 1.8 times the time and 2.3 times the
--- allocation of the written-out instance, and comparing terms is most of what a
--- typechecker does. Use 'Data.ZipMatchK.TH.deriveZipMatchK' (or
+-- convenient, but it reflects each node into a representation and back on
+-- every comparison, and a constructor is represented as a chain of
+-- @L1@\/@R1@ wrappers as long as its index, so the cost grows with the size of
+-- the signature. Comparing terms is most of what a typechecker does, and on a
+-- large signature the generic instance costs roughly twice what the
+-- written-out one does. Use 'Data.ZipMatchK.TH.deriveZipMatchK' (or
 -- 'Data.ZipMatchK.TH.deriveZipMatchK2', for a signature bifunctor with extra
 -- parameters) to generate the written-out instance instead.
+--
+-- @since 0.2.0
 class ZipMatchK (f :: k) where
   -- | Perform one level of equality testing:
   --
   -- * when @k = 'Type'@, values are compared directly (e.g. via 'Eq');
-  -- * when @k = 'Type' -> 'Type'@, we compare term constructors;
-  --   if term constructors are unequal, we return 'Nothing';
-  --   otherwise, we pair up all components with a given function.
+  -- * when @k = 'Type' -> 'Type'@, term constructors are compared. Unequal
+  --   constructors give 'Nothing', and equal ones have all their components
+  --   paired up with a given function.
+  --
+  -- @since 0.2.0
   zipMatchWithK :: forall as bs cs. Mappings as bs cs -> f :@@: as -> f :@@: bs -> Maybe (f :@@: cs)
   default zipMatchWithK :: forall as bs cs.
     (GenericK f, GZipMatch (RepK f), ReqsZipMatchWith (RepK f) as bs cs)
@@ -53,12 +57,16 @@
   zipMatchWithK = genericZipMatchWithK @f @as @bs @cs
 
 -- | Generic implementation of 'Data.ZipMatch.zipMatchK'.
+--
+-- @since 0.2.0
 genericZipMatchK :: forall f as bs.
     (GenericK f, GZipMatch (RepK f), ReqsZipMatch (RepK f) as bs, PairMappings as bs)
     => f :@@: as -> f :@@: bs -> Maybe (f :@@: (ZipLoT as bs))
 genericZipMatchK = genericZipMatchWithK @f @as @bs pairMappings
 
 -- | Generic implementation of 'zipMatchWithK'.
+--
+-- @since 0.2.0
 genericZipMatchWithK :: forall f as bs cs.
     (GenericK f, GZipMatch (RepK f), ReqsZipMatchWith (RepK f) as bs cs)
     => Mappings as bs cs -> f :@@: as -> f :@@: bs -> Maybe (f :@@: cs)
@@ -81,9 +89,25 @@
 instance ZipMatchK a => ZipMatchK (Either a)
 instance ZipMatchK NonEmpty
 
+-- | What 'gzipMatchWith' requires when the components are paired up.
+--
+-- @since 0.2.0
 type ReqsZipMatch f as bs = ReqsZipMatchWith f as bs (ZipLoT as bs)
+
+-- | Matching on the "Generics.Kind" representation of a type, which is what
+-- the default 'Data.ZipMatchK.ZipMatchK' instance goes through.
+--
+-- @since 0.2.0
 class GZipMatch (f :: LoT k -> Type) where
+  -- | What matching this representation requires of its components.
+  --
+  -- @since 0.2.0
   type ReqsZipMatchWith f (as :: LoT k) (bs :: LoT k) (cs :: LoT k) :: Constraint
+
+  -- | Match two representations, pairing up their components with the given
+  -- functions.
+  --
+  -- @since 0.2.0
   gzipMatchWith :: ReqsZipMatchWith f as bs cs => Mappings as bs cs -> f as -> f bs -> Maybe (f cs)
 
 instance GZipMatch V1 where
@@ -123,8 +147,18 @@
   type ReqsZipMatchWith (Exists k f) as bs cs = TypeError ('Text "Existentials are not supported")
   gzipMatchWith = undefined
 
+-- | Matching a single field of a constructor, by the shape of its type.
+--
+-- @since 0.2.0
 class ZipMatchFields (t :: Atom d Type) where
+  -- | What matching this field requires.
+  --
+  -- @since 0.2.0
   type ReqsZipMatchFieldsWith t (as :: LoT d) (bs :: LoT d) (cs :: LoT d) :: Constraint
+
+  -- | Match two fields, pairing up their contents.
+  --
+  -- @since 0.2.0
   zipMatchFieldsWith :: ReqsZipMatchFieldsWith t as bs cs => Mappings as bs cs -> Field t as -> Field t bs -> Maybe (Field t cs)
 
 instance ApplyMappings v => ZipMatchFields (Var v) where
diff --git a/src/Data/ZipMatchK/Mappings.hs b/src/Data/ZipMatchK/Mappings.hs
--- a/src/Data/ZipMatchK/Mappings.hs
+++ b/src/Data/ZipMatchK/Mappings.hs
@@ -15,6 +15,8 @@
 import           Generics.Kind
 
 -- | Zip to lists of types into a single list of pair types.
+--
+-- @since 0.2.0
 type ZipLoT :: LoT k -> LoT k -> LoT k
 type family ZipLoT as bs where
   ZipLoT LoT0 LoT0 = LoT0
@@ -23,6 +25,8 @@
 infixr 5 :^:
 type Mappings :: LoT k -> LoT k -> LoT k -> Type
 -- | A collection of zipping functions for 'Data.ZipMatchK.zipMatchWithK'.
+--
+-- @since 0.2.0
 data Mappings (as :: LoT k) (bs :: LoT k) (cs :: LoT k) where
   -- | An empty collection (when there no (more) type parameters).
   M0 :: Mappings LoT0 LoT0 LoT0
@@ -31,8 +35,13 @@
         -> Mappings as bs cs      -- ^ Zipping for other type parameters.
         -> Mappings (a :&&: as) (b :&&: bs) (c :&&: cs)
 
+-- | Type parameter lists that can be paired up componentwise.
+--
+-- @since 0.2.0
 class PairMappings (as :: LoT k) (bs :: LoT k) where
   -- | A collection of pairing functions @(\\x y -> Just (x, y))@ for 'Data.ZipMatchK.zipMatchK'.
+  --
+  -- @since 0.2.0
   pairMappings :: Mappings as bs (ZipLoT as bs)
 
 instance PairMappings LoT0 LoT0 where
@@ -41,8 +50,13 @@
 instance PairMappings as bs => PairMappings ((a :: Type) :&&: as) ((b :: Type) :&&: bs) where
   pairMappings = pairA :^: pairMappings
 
+-- | Type variables at which a collection of zipping functions can be applied.
+--
+-- @since 0.2.0
 class ApplyMappings (v :: TyVar d Type) where
   -- | Apply a collection of zipping functions to collections of values.
+  --
+  -- @since 0.2.0
   applyMappings :: forall (as :: LoT d) (bs :: LoT d) (cs :: LoT d).
        Mappings as bs cs      -- ^ A collection of zipping functions.
     -> Interpret (Var v) as   -- ^ First collection of values (one per type parameter).
@@ -56,5 +70,7 @@
   applyMappings (_ :^: fs) x y = applyMappings @_ @v fs x y
 
 -- | Pair two values in a context.
+--
+-- @since 0.3.0
 pairA :: Applicative f => a -> b -> f (a, b)
 pairA x y = pure (x, y)
diff --git a/src/Data/ZipMatchK/TH.hs b/src/Data/ZipMatchK/TH.hs
--- a/src/Data/ZipMatchK/TH.hs
+++ b/src/Data/ZipMatchK/TH.hs
@@ -3,19 +3,19 @@
 {-# LANGUAGE ViewPatterns    #-}
 -- | Template Haskell derivation of 'ZipMatchK' instances.
 --
--- The generic instance (the one you get by writing @instance ZipMatchK TermSig@
+-- The generic instance (the one obtained by writing @instance ZipMatchK TermSig@
 -- with no body) converts a node into its "Generics.Kind" representation on
 -- every comparison, and converts the result back. The representation of a
 -- constructor is a chain of @L1@\/@R1@ wrappers as long as that constructor's
 -- index, so the cost grows with the number of constructors in the signature,
 -- and comparing terms is most of what a typechecker does.
 --
--- The derivers here generate the instance that one would otherwise write out by
--- hand: a @case@ over the two nodes, allocating only its result. On a
--- 44-constructor signature that is worth a factor of 1.8 in time and 2.3 in
--- allocation on 'Control.Monad.Free.Foil.alphaEquiv' (see the @zipmatchk@
--- benchmark), and the derived instance does not get slower as the signature
--- grows.
+-- The derivers here generate the instance that one would otherwise write out
+-- by hand: a @case@ over the two nodes, allocating only its result. On a large
+-- signature that is worth roughly a factor of two in time and in allocation on
+-- 'Control.Monad.Free.Foil.alphaEquiv' (see the @zipmatchk@ benchmark), and
+-- unlike the generic instance the derived one does not get slower as the
+-- signature grows.
 --
 -- The module the splice appears in needs at least
 --
@@ -23,11 +23,11 @@
 -- > {-# LANGUAGE TemplateHaskell #-}
 -- > {-# LANGUAGE TypeFamilies #-}
 --
--- Signatures that refer to one another — as the ones generated by
--- 'Control.Monad.Free.Foil.TH.MkFreeFoil.mkFreeFoil' from a grammar with
--- several syntactic categories do — have to be derived in a __single splice__,
--- since a top-level splice ends a declaration group and an instance from a later
--- group is not visible to an earlier one:
+-- Signatures that refer to one another have to be derived in a __single
+-- splice__, since a top-level splice ends a declaration group and an instance
+-- from a later group is not visible to an earlier one. The signatures that
+-- 'Control.Monad.Free.Foil.TH.MkFreeFoil.mkFreeFoil' generates from a grammar
+-- with several syntactic categories are of that kind:
 --
 -- > concat <$> traverse deriveZipMatchK2 [''Term'Sig, ''OpArg'Sig, ''Type'Sig]
 module Data.ZipMatchK.TH (
@@ -63,11 +63,15 @@
 -- Use 'deriveZipMatchK2' when the type has extra parameters that should stay
 -- fixed (an annotation, say), as a signature generated by
 -- "Control.Monad.Free.Foil.TH.MkFreeFoil" does.
+--
+-- @since 0.3.2
 deriveZipMatchK :: Name -> Q [Dec]
 deriveZipMatchK = deriveZipMatchKWith Nothing
 
 -- | Derive a 'ZipMatchK' instance for a functor, zipping the last type parameter
 -- and fixing the rest.
+--
+-- @since 0.3.2
 deriveZipMatchK1 :: Name -> Q [Dec]
 deriveZipMatchK1 = deriveZipMatchKWith (Just 1)
 
@@ -86,6 +90,8 @@
 -- >     (AppSig l1 l2 l3, AppSig r1 r2 r3) ->
 -- >       AppSig <$> zipMatchWithK M0 l1 r1 <*> g l2 r2 <*> g l3 r3
 -- >     ...
+--
+-- @since 0.3.2
 deriveZipMatchK2 :: Name -> Q [Dec]
 deriveZipMatchK2 = deriveZipMatchKWith (Just 2)
 
@@ -94,6 +100,8 @@
 --
 -- Every fixed parameter that occurs in a field gets a 'ZipMatchK' constraint in
 -- the instance context.
+--
+-- @since 0.3.2
 deriveZipMatchKWith :: Maybe Int -> Name -> Q [Dec]
 deriveZipMatchKWith arity typeName = do
   (tvars, cons) <- reifyDataType typeName
diff --git a/test/Control/Monad/Foil/BlocksSpec.hs b/test/Control/Monad/Foil/BlocksSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Control/Monad/Foil/BlocksSpec.hs
@@ -0,0 +1,141 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | Blocks: extension-within-a-range evidence, disjoint union, re-attachment.
+module Control.Monad.Foil.BlocksSpec (spec) where
+
+import           Data.Maybe                  (isJust)
+import           Test.Hspec
+
+import qualified Control.Monad.Foil          as Foil
+import           Control.Monad.Foil.Blocks
+import           Control.Monad.Foil.Internal (NameRange (..),
+                                              rawNameBinderList)
+
+-- | The raw names of a scope, in ascending order.
+scopeIds :: Foil.Scope n -> [Int]
+scopeIds = map Foil.nameId . Foil.nameSetToList . Foil.scopeToNameSet
+
+ra, rb :: NameRange
+ra = NameRange 100 199
+rb = NameRange 200 299
+
+spec :: Spec
+spec = do
+  describe "extWithinStep" $ do
+    it "accepts a binder allocated inside the range" $
+      Foil.withFreshIn ra Foil.emptyScope $ \b ->
+        fmap extWithinRanges (extWithinStep b (extWithinRefl ra))
+          `shouldBe` Just [ra]
+
+    it "rejects a binder allocated outside the range" $
+      Foil.withFresh Foil.emptyScope $ \b ->  -- allocates the name 0
+        case extWithinStep b (extWithinRefl ra) of
+          Nothing -> pure () :: IO ()
+          Just _  -> expectationFailure "a name escaped the reservation"
+
+  describe "withExtendScopeRange" $ do
+    it "hands back consecutive binders, the scope, and the evidence" $
+      case withExtendScopeRange Foil.emptyScope ra 3 $ \scope binders ext ->
+             (scopeIds scope, rawNameBinderList binders, extWithinRanges ext) of
+        Just result -> result `shouldBe` ([100, 101, 102], [100, 101, 102], [ra])
+        Nothing     -> expectationFailure "the range was refused"
+
+    it "refuses a range the scope already touches" $
+      Foil.withFreshIn ra Foil.emptyScope $ \b ->
+        let scope = Foil.extendScope b Foil.emptyScope
+         in withExtendScopeRange scope ra 1 (\_ _ _ -> ()) `shouldBe` Nothing
+
+    it "refuses more names than the range holds" $
+      withExtendScopeRange Foil.emptyScope (NameRange 0 1) 3 (\_ _ _ -> ())
+        `shouldBe` Nothing
+
+  describe "withFreshInBlock" $
+    it "allocates from the range, stepping the evidence in the same motion" $
+      withFreshInBlock (beginBlock (NameRange 7 9)) Foil.emptyScope $ \b1 block1 ->
+        withFreshInBlock block1 (Foil.extendScope b1 Foil.emptyScope) $ \b2 block2 -> do
+          Foil.nameId (Foil.nameOf b1) `shouldBe` 7
+          Foil.nameId (Foil.nameOf b2) `shouldBe` 8
+          extWithinRanges (blockExt block2) `shouldBe` [NameRange 7 9]
+
+  describe "composeExtWithin" $ do
+    it "collects a chain's reservations exactly, coalescing adjacent ones" $ do
+      extWithinRanges
+        (composeExtWithin (extWithinRefl (NameRange 0 9)) (extWithinRefl (NameRange 30 39)))
+        `shouldBe` [NameRange 0 9, NameRange 30 39]
+      extWithinRanges
+        (composeExtWithin (extWithinRefl (NameRange 0 9)) (extWithinRefl (NameRange 10 19)))
+        `shouldBe` [NameRange 0 19]
+
+    it "links two chains whose stripes interleave" $
+      -- Chains {10-19, 30-39} and {20-29, 40-49}: the convex hulls overlap,
+      -- the reservations do not. This is the diamond-of-chains shape that a
+      -- single-range evidence could not link.
+      let linked =
+            withExtendScopeRange Foil.emptyScope (NameRange 10 19) 1 $ \s1 _ e1 ->
+              withExtendScopeRange s1 (NameRange 30 39) 1 $ \s2 _ e2 ->
+                withExtendScopeRange Foil.emptyScope (NameRange 20 29) 1 $ \t1 _ f1 ->
+                  withExtendScopeRange t1 (NameRange 40 49) 1 $ \t2 _ f2 ->
+                    withDisjointUnion (composeExtWithin e1 e2) (composeExtWithin f1 f2)
+                      s2 t2 (\s _ _ -> scopeIds s)
+       in linked `shouldBe` Just (Just (Just (Just (Just [10, 20, 30, 40]))))
+
+  describe "withDisjointUnion" $ do
+    it "links two units over a shared import scope" $
+      Foil.withFresh Foil.emptyScope $ \bi ->  -- the shared import, name 0
+        let c = Foil.extendScope bi Foil.emptyScope
+            linked =
+              withExtendScopeRange c ra 2 $ \sa _ ea ->
+                withExtendScopeRange c rb 1 $ \sb _ eb ->
+                  withDisjointUnion ea eb sa sb (\s _ _ -> scopeIds s)
+         in linked `shouldBe` Just (Just (Just [0, 100, 101, 200]))
+
+    it "refuses overlapping reservations" $
+      let linked =
+            withExtendScopeRange Foil.emptyScope ra 2 $ \sa _ ea ->
+              withExtendScopeRange Foil.emptyScope ra 1 $ \sb _ eb ->
+                withDisjointUnion ea eb sa sb (\s _ _ -> scopeIds s)
+       in linked `shouldBe` Just (Just Nothing)
+
+    it "extends both sides' maps to the union" $
+      let looked =
+            withExtendScopeRange Foil.emptyScope ra 1 $ \sa bsa ea ->
+              withExtendScopeRange Foil.emptyScope rb 1 $ \sb bsb eb ->
+                let m1 = Foil.addNameBinderList bsa ["a"] Foil.emptyNameMap
+                    m2 = Foil.addNameBinderList bsb ["b"] Foil.emptyNameMap
+                 in case (Foil.namesOfPattern bsa, Foil.namesOfPattern bsb) of
+                      ([x1], [x2]) ->
+                        withDisjointUnion ea eb sa sb $ \_scope union _ext ->
+                          let u = unionNameMaps union m1 m2
+                           in ( Foil.lookupName (Foil.sink x1) u
+                              , Foil.lookupName (Foil.sink x2) u
+                              )
+                      _ -> Nothing
+       in looked `shouldBe` Just (Just (Just ("a", "b")))
+
+  describe "checkScopeUnion" $ do
+    it "witnesses the union and nothing else" $
+      let checked =
+            withExtendScopeRange Foil.emptyScope ra 1 $ \sa _ ea ->
+              withExtendScopeRange Foil.emptyScope rb 1 $ \sb _ eb ->
+                withDisjointUnion ea eb sa sb $ \scope _ _ ->
+                  ( isJust (checkScopeUnion sa sb scope)
+                  , isJust (checkScopeUnion sa sa scope)  -- misses b's delta
+                  )
+       in checked `shouldBe` Just (Just (Just (True, False)))
+
+  describe "checkExtScope" $ do
+    it "mints evidence for a subset" $
+      case withExtendScopeRange Foil.emptyScope ra 2 $ \sa _ _ ->
+             isJust (checkExtScope Foil.emptyScope sa) of
+        Just ok -> ok `shouldBe` True
+        Nothing -> expectationFailure "the range was refused"
+
+    it "refuses a non-extension" $
+      let checked =
+            withExtendScopeRange Foil.emptyScope ra 1 $ \sa _ _ ->
+              withExtendScopeRange Foil.emptyScope rb 1 $ \sb _ _ ->
+                isJust (checkExtScope sa sb)
+       in checked `shouldBe` Just (Just False)
diff --git a/test/Control/Monad/Foil/NameRangeSpec.hs b/test/Control/Monad/Foil/NameRangeSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Control/Monad/Foil/NameRangeSpec.hs
@@ -0,0 +1,172 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs     #-}
+
+-- | Properties of range-guarded allocation ('Foil.rawFreshNameIn',
+-- 'Foil.withFreshIn'), including scopes with negative and extreme names.
+--
+-- Allocation is a soundness surface: 'Foil.sink' rests on every allocated
+-- name being fresh in the ambient scope. The properties here pin the
+-- freshness claim, the exhaustion behaviour, and the overflow guards, and
+-- check that 'Data.IntSet' handles the sign bit the way the allocator
+-- assumes (against a 'Data.Set' model).
+module Control.Monad.Foil.NameRangeSpec (spec) where
+
+import           Data.IntSet                 (IntSet)
+import qualified Data.IntSet                 as IntSet
+import           Data.List                   (sort)
+import           Data.Maybe                  (isNothing)
+import qualified Data.Set                    as Set
+import           Test.Hspec
+import           Test.Hspec.QuickCheck       (prop)
+import           Test.QuickCheck
+
+import qualified Control.Monad.Foil          as Foil
+import           Control.Monad.Foil.Internal (NameRange (..), rawFreshName,
+                                              rawFreshNameIn)
+
+-- | Raw names biased towards small values, negatives, and the extremes,
+-- so that the sign bit and the overflow guards are actually exercised.
+genRawName :: Gen Int
+genRawName = frequency
+  [ (4, choose (-20, 20))
+  , (2, arbitrary)
+  , (1, elements [minBound, minBound + 1, -1, 0, 1, maxBound - 1, maxBound])
+  ]
+
+genRawScope :: Gen IntSet
+genRawScope = IntSet.fromList <$> listOf genRawName
+
+-- | A (possibly empty) range with the same bias as 'genRawName'.
+genNameRange :: Gen NameRange
+genNameRange = do
+  a <- genRawName
+  b <- genRawName
+  frequency
+    [ (4, pure (NameRange (min a b) (max a b)))
+    , (1, pure (NameRange a b))  -- possibly empty (lo > hi)
+    ]
+
+spec :: Spec
+spec = do
+  describe "rawFreshNameIn" $ do
+    prop "allocates inside the range and fresh in the whole scope" $
+      forAll genNameRange $ \range@(NameRange lo hi) ->
+        forAll genRawScope $ \scope ->
+          case rawFreshNameIn range scope of
+            Nothing -> discard
+            Just x  -> conjoin
+              [ counterexample "below range" (x >= lo)
+              , counterexample "above range" (x <= hi)
+              , counterexample "not fresh" (not (IntSet.member x scope))
+              ]
+
+    prop "is exhausted exactly when the range is empty or its top is taken" $
+      forAll genNameRange $ \range@(NameRange lo hi) ->
+        forAll genRawScope $ \scope ->
+          isNothing (rawFreshNameIn range scope)
+            === (lo > hi || IntSet.member hi scope)
+
+    prop "agrees with rawFreshName on non-negative scopes" $
+      forAll (IntSet.fromList . map getNonNegative <$> arbitrary) $ \scope ->
+        rawFreshNameIn Foil.fullNameRange scope === Just (rawFreshName scope)
+
+    it "does not reuse a taken name at hi = maxBound (lookupLT overflow)" $
+      -- The formulation via @IntSet.lookupLT (hi + 1)@ would wrap around
+      -- and return 'Just 0' here.
+      rawFreshNameIn (NameRange 0 maxBound) (IntSet.fromList [0])
+        `shouldBe` Just 1
+
+    it "does not wrap past a taken maxBound (successor overflow)" $
+      -- The successor of @maxBound@ wraps to @minBound@; the range must
+      -- report exhaustion instead.
+      rawFreshNameIn (NameRange maxBound maxBound) (IntSet.fromList [maxBound])
+        `shouldBe` Nothing
+
+    it "allocates minBound from an empty scope" $
+      rawFreshNameIn (NameRange minBound minBound) IntSet.empty
+        `shouldBe` Just minBound
+
+    it "reports an empty range as exhausted" $
+      rawFreshNameIn (NameRange 5 4) IntSet.empty `shouldBe` Nothing
+
+  describe "rawFreshName" $ do
+    it "allocates 0 over a scope of negative names only" $
+      Foil.withFreshIn (NameRange (-10) (-1)) Foil.emptyScope $ \bneg ->
+        let scope = Foil.extendScope bneg Foil.emptyScope
+         in Foil.withFresh scope $ \b ->
+              Foil.nameId (Foil.nameOf b) `shouldBe` 0
+
+    prop "stays non-negative and fresh" $
+      forAll (IntSet.filter (/= maxBound) <$> genRawScope) $ \scope ->
+        let x = rawFreshName scope
+         in conjoin
+              [ counterexample "dipped below zero" (x >= 0)
+              , counterexample "not fresh" (not (IntSet.member x scope))
+              ]
+
+  describe "withFreshIn" $ do
+    it "allocates the low end of an untouched range" $
+      Foil.withFreshIn (NameRange 100 199) Foil.emptyScope $ \binder ->
+        Foil.nameId (Foil.nameOf binder) `shouldBe` 100
+
+    it "skips scope members inside the range, ignores those outside" $
+      Foil.withFresh Foil.emptyScope $ \b0 ->                      -- name 0
+        let scope0 = Foil.extendScope b0 Foil.emptyScope
+         in Foil.withFreshIn (NameRange (-10) (-1)) scope0 $ \bneg ->  -- name -10
+              let scope1 = Foil.extendScope bneg scope0
+               in Foil.withFreshIn (NameRange (-10) (-1)) scope1 $ \bneg' -> do
+                    Foil.nameId (Foil.nameOf bneg) `shouldBe` (-10)
+                    Foil.nameId (Foil.nameOf bneg') `shouldBe` (-9)
+
+    it "reports exhaustion through tryWithFreshIn" $
+      Foil.withFresh Foil.emptyScope $ \b0 ->
+        let scope0 = Foil.extendScope b0 Foil.emptyScope
+         in Foil.tryWithFreshIn (NameRange 0 0) scope0 (\_ -> ())
+              `shouldBe` Nothing
+
+  describe "withFreshNameBinderListIn" $
+    it "allocates consecutive names from the range's low end" $
+      Foil.withFreshNameBinderListIn (NameRange 50 59) "abc"
+        Foil.emptyScope Foil.emptyNameMap $ \_scope binders _nameMap ->
+          binderIds binders `shouldBe` [50, 51, 52]
+
+  describe "NameMap over negative names" $
+    it "addNameBinder/lookupName/popNameBinder round-trip" $
+      Foil.withFreshIn (NameRange (-100) (-1)) Foil.emptyScope $ \binder -> do
+        let nameMap = Foil.addNameBinder binder 'x' Foil.emptyNameMap
+        Foil.lookupName (Foil.nameOf binder) nameMap `shouldBe` 'x'
+        null (Foil.popNameBinder binder nameMap) `shouldBe` True
+
+  describe "Data.IntSet over the sign bit (model: Data.Set)" $ do
+    prop "toAscList is sorted across the sign boundary" $
+      forAll (listOf genRawName) $ \xs ->
+        IntSet.toAscList (IntSet.fromList xs)
+          === Set.toAscList (Set.fromList xs)
+
+    prop "findMin and findMax agree with the model" $
+      forAll (listOf1 genRawName) $ \xs ->
+        let s = IntSet.fromList xs
+            m = Set.fromList xs
+         in (IntSet.findMin s, IntSet.findMax s)
+              === (Set.findMin m, Set.findMax m)
+
+    prop "lookupLE agrees with the model" $
+      forAll genRawName $ \k ->
+        forAll (listOf genRawName) $ \xs ->
+          IntSet.lookupLE k (IntSet.fromList xs)
+            === Set.lookupLE k (Set.fromList xs)
+
+    prop "split separates below and above across the sign boundary" $
+      forAll genRawName $ \k ->
+        forAll (listOf genRawName) $ \xs ->
+          let (below, above) = IntSet.split k (IntSet.fromList xs)
+           in sort (IntSet.toList below ++ IntSet.toList above)
+                === sort [ x | x <- Set.toList (Set.fromList xs), x /= k ]
+                .&&. all (< k) (IntSet.toList below)
+                .&&. all (> k) (IntSet.toList above)
+
+-- | The raw names bound by a list of binders, outermost first.
+binderIds :: Foil.NameBinderList n l -> [Int]
+binderIds Foil.NameBinderListEmpty = []
+binderIds (Foil.NameBinderListCons binder binders) =
+  Foil.nameId (Foil.nameOf binder) : binderIds binders
diff --git a/test/Control/Monad/Foil/PatternTransportSpec.hs b/test/Control/Monad/Foil/PatternTransportSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Control/Monad/Foil/PatternTransportSpec.hs
@@ -0,0 +1,165 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE InstanceSigs        #-}
+{-# LANGUAGE KindSignatures      #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | A pattern may carry fields indexed by its own scope, the standard example
+-- being a telescope, where each step has a type in the scope the steps before
+-- it extend to. 'Foil.withPattern' rebuilds a pattern at an /unrelated/ ambient
+-- scope, and hands the instance no renaming for such a field: the only thing
+-- relating the two scopes is the pair of binders each step produces.
+--
+-- 'Foil.PatternTransport' is that missing renaming. This module pins down what
+-- it has to do, on the smallest pattern that can tell the difference: a chain
+-- of binders where each step carries a name from the scope before it, so that a
+-- payload can point at a binder the traversal is about to refresh.
+--
+-- The two halves are: a payload naming something the pattern does not bind is
+-- left alone, and a payload naming one of the pattern's own binders follows
+-- that binder when it is refreshed.
+--
+-- The second half is what the generic implementation of 'Foil.withPattern'
+-- cannot do, since it replaces the binders and leaves the other fields as they
+-- stand. That is now refused rather than answered wrongly: deriving the
+-- instances for 'Chain' below — @deriveGenericK ''Chain@ and then an empty
+-- @HasNameBinders@ instance — is a type error naming the offending field,
+--
+-- > A field of the binder/pattern is indexed by a Foil scope
+-- >   Foil.Name outerScope : S
+--
+-- so the refusal cannot be tested here, only recorded. Before it, the derived
+-- route compiled and gave the binders @[3,4]@ with the payloads left at
+-- @[0,1]@.
+module Control.Monad.Foil.PatternTransportSpec (spec) where
+
+import           Test.Hspec
+
+import qualified Control.Monad.Foil as Foil
+
+-- | A chain of binders, each carrying a name in the scope before it.
+data Chain (n :: Foil.S) (l :: Foil.S) where
+  ChainEmpty :: Chain n n
+  ChainCons  :: Foil.Name n -> Foil.NameBinder n i -> Chain i l -> Chain n l
+
+instance Foil.CoSinkable Chain where
+  coSinkabilityProof rename ChainEmpty cont = cont rename ChainEmpty
+  coSinkabilityProof rename (ChainCons payload binder rest) cont =
+    Foil.coSinkabilityProof rename binder $ \rename' binder' ->
+      Foil.coSinkabilityProof rename' rest $ \rename'' rest' ->
+        cont rename'' (ChainCons (rename payload) binder' rest')
+
+  withPattern
+    :: forall f o n l r. Foil.Distinct o
+    => (forall x y z r'. Foil.Distinct z
+          => Foil.Scope z
+          -> Foil.NameBinder x y
+          -> (forall z'. Foil.DExt z z' => f x y z z' -> Foil.NameBinder z z' -> r')
+          -> r')
+    -> (forall x z z'. Foil.DExt z z' => f x x z z')
+    -> (forall x y y' z z' z''. (Foil.DExt z z', Foil.DExt z' z'')
+          => f x y z z' -> f y y' z' z'' -> f x y' z z'')
+    -> Foil.Scope o
+    -> Chain n l
+    -> (forall o'. Foil.DExt o o' => f n l o o' -> Chain o o' -> Foil.Scope o' -> r)
+    -> r
+  withPattern withBinder unit comp = go Foil.verbatimTransport
+    where
+      go :: forall n' l' o' r'. Foil.Distinct o'
+         => Foil.PatternTransport n' o'
+         -> Foil.Scope o'
+         -> Chain n' l'
+         -> (forall o''. Foil.DExt o' o'' => f n' l' o' o'' -> Chain o' o'' -> Foil.Scope o'' -> r')
+         -> r'
+      go _transport scope ChainEmpty cont = cont unit ChainEmpty scope
+      go transport scope (ChainCons payload binder rest) cont =
+        withBinder scope binder $ \fbinder binder' ->
+          go (Foil.transportUnderBinder transport binder binder')
+             (Foil.extendScope binder' scope)
+             rest $ \frest rest' scope'' ->
+            cont (comp fbinder frest)
+              (ChainCons (Foil.transportPayload transport payload) binder' rest')
+              scope''
+
+-- | The result of processing one binder, when there is nothing to carry.
+data NoInfo (x :: Foil.S) (y :: Foil.S) (z :: Foil.S) (z' :: Foil.S) = NoInfo
+
+-- | Refresh a chain against an ambient scope, renaming only the binders that
+-- clash with it. This is 'Foil.withRefreshedPattern' without the substitution.
+refreshChain
+  :: Foil.Distinct o
+  => Foil.Scope o
+  -> Chain n l
+  -> (forall o'. Foil.DExt o o' => Chain o o' -> r)
+  -> r
+refreshChain scope chain cont =
+  Foil.withPattern
+    (\scope' binder k ->
+      Foil.withRefreshed scope' (Foil.nameOf binder) (k NoInfo))
+    NoInfo
+    (\NoInfo NoInfo -> NoInfo)
+    scope
+    chain
+    (\NoInfo chain' _scope' -> cont chain')
+
+-- | A chain of two binders, allocated under one binder that it does not bind.
+--
+-- The binders are the raw names 1 and 2. The first payload is the raw name 0,
+-- which the chain does not bind; the second is the raw name 1, which it does.
+withChain
+  :: (forall i l. Foil.Distinct i => Chain i l -> r) -> r
+withChain cont =
+  Foil.withFresh Foil.emptyScope $ \b0 ->
+    let scope0 = Foil.extendScope b0 Foil.emptyScope
+     in Foil.withFresh scope0 $ \b1 ->
+          let scope1 = Foil.extendScope b1 scope0
+           in Foil.withFresh scope1 $ \b2 ->
+                cont (ChainCons (Foil.nameOf b0) b1
+                       (ChainCons (Foil.nameOf b1) b2 ChainEmpty))
+
+-- | A scope holding the raw names 0, 1 and 2, so that both of the chain's
+-- binders clash with it.
+withClashingScope :: (forall o. Foil.Distinct o => Foil.Scope o -> r) -> r
+withClashingScope cont =
+  Foil.withFresh Foil.emptyScope $ \b0 ->
+    let scope0 = Foil.extendScope b0 Foil.emptyScope
+     in Foil.withFresh scope0 $ \b1 ->
+          let scope1 = Foil.extendScope b1 scope0
+           in Foil.withFresh scope1 $ \b2 ->
+                cont (Foil.extendScope b2 scope1)
+
+binders :: Chain n l -> [Foil.RawName]
+binders ChainEmpty                  = []
+binders (ChainCons _ binder rest)   = Foil.nameId (Foil.nameOf binder) : binders rest
+
+payloads :: Chain n l -> [Foil.RawName]
+payloads ChainEmpty                 = []
+payloads (ChainCons payload _ rest) = Foil.nameId payload : payloads rest
+
+spec :: Spec
+spec = do
+  describe "a pattern with scoped payloads" $ do
+    it "is built with the binders and payloads the tests expect" $
+      withChain $ \chain ->
+        (binders chain, payloads chain) `shouldBe` ([1, 2], [0, 1])
+
+    it "keeps its payloads when no binder is refreshed" $
+      withChain $ \chain ->
+        refreshChain Foil.emptyScope chain $ \chain' ->
+          (binders chain', payloads chain') `shouldBe` ([1, 2], [0, 1])
+
+    it "carries a payload along the binder it names when that binder moves" $
+      -- Both binders clash and are refreshed to 3 and 4. The payload naming the
+      -- chain's own first binder has to become 3; the payload naming something
+      -- outside the chain stays 0. Coercing the payloads instead, as the
+      -- default implementation does, would leave the first one at 1.
+      withChain $ \chain ->
+        withClashingScope $ \scope ->
+          refreshChain scope chain $ \chain' ->
+            (binders chain', payloads chain') `shouldBe` ([3, 4], [0, 3])
+
+  describe "the traversals that never refresh" $
+    it "see the binders without walking the payloads" $
+      withChain $ \chain ->
+        map Foil.nameId (Foil.namesOfPattern chain) `shouldBe` binders chain
diff --git a/test/Control/Monad/Foil/SinkableSpec.hs b/test/Control/Monad/Foil/SinkableSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Control/Monad/Foil/SinkableSpec.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE DeriveFunctor        #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE TemplateHaskell      #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- | A record of sinkable fields is itself sinkable, with nothing written by
+-- hand: 'deriveGenericK' plus empty 'SinkableK' and 'Sinkable' instances,
+-- and the whole record then sinks in one coercion. This is the supported
+-- alternative to a private @unsafeCoerce@ helper for environment records.
+-- (A record holding the 'Scope' itself is refused — no @SinkableK Scope@ —
+-- which is exactly the field such a helper would coerce unsoundly.)
+module Control.Monad.Foil.SinkableSpec (spec) where
+
+import           Data.Bifunctor.TH       (deriveBifunctor)
+import qualified Data.Map                as Map
+import           Generics.Kind.TH        (deriveGenericK)
+import           Test.Hspec
+
+import           Control.Monad.Foil
+import           Control.Monad.Free.Foil (AST (Var))
+
+-- | A miniature term type, enough for a table of terms in the record.
+data ExprSig scope term = AppSig term term | LamSig scope
+  deriving (Functor)
+deriveBifunctor ''ExprSig
+
+type Expr = AST NameBinder ExprSig
+
+-- | The shape of a type checker's environment: scope-free fields next to
+-- names, terms, tables, and pairs whose first component is scope-free.
+data Env (n :: S) = Env
+  { envDepth   :: Int
+  , envNames   :: [Name n]
+  , envTable   :: Map.Map String (Expr n)
+  , envGoal    :: Maybe (Expr n, Expr n)
+  , envSpelled :: [(String, Name n)]
+  }
+
+deriveGenericK ''Env
+
+instance SinkableK Env
+instance Sinkable Env
+
+-- | 'sink', with the target scope pinned by a binder the caller holds.
+sunkVia :: (Sinkable e, DExt n l) => NameBinder n l -> e n -> e l
+sunkVia _ = sink
+
+spec :: Spec
+spec = describe "a record of sinkable fields" $
+  it "derives Sinkable and sinks whole, contents untouched" $
+    withFresh emptyScope $ \binder ->
+      let x = nameOf binder
+          env = Env 7 [x] (Map.singleton "f" (Var x)) (Just (Var x, Var x)) [("x", x)]
+       in withFresh (extendScope binder emptyScope) $ \binder2 -> do
+            let env' = sunkVia binder2 env   -- one coercion for the whole record
+            envDepth env' `shouldBe` 7
+            map nameId (envNames env') `shouldBe` [nameId x]
+            Map.keys (envTable env') `shouldBe` ["f"]
+            [nameId y | (_, y) <- envSpelled env'] `shouldBe` [nameId x]
+            case envGoal env' of
+              Just (Var a, Var b) -> (nameId a, nameId b) `shouldBe` (nameId x, nameId x)
+              _                   -> expectationFailure "the goal lost its shape"
diff --git a/test/Control/Monad/Free/Foil/AlphaEquivSpec.hs b/test/Control/Monad/Free/Foil/AlphaEquivSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Control/Monad/Free/Foil/AlphaEquivSpec.hs
@@ -0,0 +1,178 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE DeriveTraversable   #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
+
+-- | Properties of 'alphaEquiv' with threaded renamings.
+--
+-- Two soundness surfaces are pinned here. The rename path must stay
+-- /linear/: a chain of binders that mismatch at every level (the shifted
+-- chain below) used to make the eager implementation rename the whole
+-- remaining body per level. And the environments must not conflate a
+-- renamed bound name with a name that passes through unchanged and
+-- happens to share the spelling; the hand-built terms below are exactly
+-- the conflations a raw-name-target environment would commit.
+module Control.Monad.Free.Foil.AlphaEquivSpec (spec) where
+
+import           Data.Bifunctor.TH
+import           Data.Maybe                  (fromMaybe)
+import           Test.Hspec
+import           Test.Hspec.QuickCheck       (prop)
+import           Test.QuickCheck
+
+import qualified Control.Monad.Foil          as Foil
+import           Control.Monad.Foil.Internal (Name (..), NameBinder (..),
+                                              unsafeAssertFresh)
+import           Control.Monad.Free.Foil
+import           Data.ZipMatchK.TH           (deriveZipMatchK)
+
+data LamSig scope term
+  = App term term
+  | Lam scope
+  deriving (Functor, Foldable, Traversable)
+
+deriveBifunctor ''LamSig
+deriveBifoldable ''LamSig
+deriveBitraversable ''LamSig
+deriveZipMatchK ''LamSig
+
+type Term = AST Foil.NameBinder LamSig
+
+-- * Hand-built terms with chosen binder names
+
+-- | A binder with a chosen raw name — either fresh for the scope, or
+-- deliberately equal to an enclosing binder's, which a term is allowed to
+-- carry (shadowing) and which the comparison must handle.
+lam :: Int -> (forall l. Foil.DExt n l => Foil.Name l -> Term l) -> Term n
+lam raw mkBody =
+  unsafeAssertFresh (UnsafeNameBinder (UnsafeName raw)) $ \binder ->
+    Node (Lam (ScopedAST binder (mkBody (Foil.nameOf binder))))
+
+app :: Term n -> Term n -> Term n
+app f x = Node (App f x)
+
+-- * The shifted chain (the quadratic-rename regression)
+
+-- | λx1. λx2. … λxn. xn, allocated in the given scope.
+chainIn :: Foil.Distinct n => Foil.Scope n -> Int -> Foil.Name n -> Term n
+chainIn _scope 0 x = Var x
+chainIn scope k _x = Foil.withFresh scope $ \binder ->
+  let scope' = Foil.extendScope binder scope
+   in Node (Lam (ScopedAST binder (chainIn scope' (k - 1) (Foil.nameOf binder))))
+
+-- | The chain over the empty scope: binders 0, 1, …, n−1.
+plainChain :: Int -> Term Foil.VoidS
+plainChain n = Foil.withFresh Foil.emptyScope $ \b0 ->
+  let scope0 = Foil.extendScope b0 Foil.emptyScope
+   in Node (Lam (ScopedAST b0 (chainIn scope0 (n - 1) (Foil.nameOf b0))))
+
+-- | The same chain built under one dummy binder and cut back down:
+-- binders 1, 2, …, n, so every level differs from 'plainChain' by one.
+shiftedChain :: Int -> Term Foil.VoidS
+shiftedChain n = Foil.withFresh Foil.emptyScope $ \dummy ->
+  let scope1 = Foil.extendScope dummy Foil.emptyScope
+      t = Foil.withFresh scope1 $ \b1 ->
+            let scope2 = Foil.extendScope b1 scope1
+             in Node (Lam (ScopedAST b1 (chainIn scope2 (n - 1) (Foil.nameOf b1))))
+   in fromMaybe (error "the chain uses the dummy binder")
+        (unsinkAST Foil.emptyScope t)
+
+-- * Random terms, via a scope-free skeleton
+
+-- | A closed λ-term skeleton: de Bruijn indices, so one skeleton renders
+-- at any choice of binder names.
+data Skel = SVar Int | SApp Skel Skel | SLam Skel
+  deriving (Show)
+
+genSkel :: Int -> Int -> Gen Skel
+genSkel depth size
+  | size <= 1 && depth > 0 = SVar <$> chooseInt (0, depth - 1)
+  | otherwise = oneof $ concat
+      [ [ SVar <$> chooseInt (0, depth - 1) | depth > 0 ]
+      , [ SApp <$> genSkel depth (size `div` 2) <*> genSkel depth (size `div` 2) ]
+      , [ SLam <$> genSkel (depth + 1) (size - 1) ]
+      ]
+
+instance Arbitrary Skel where
+  arbitrary = sized (\s -> SLam <$> genSkel 1 s)
+
+-- | Render a skeleton, allocating binder names with 'Foil.withFresh'.
+renderIn :: Foil.Distinct n => Foil.Scope n -> [Foil.Name n] -> Skel -> Term n
+renderIn scope env = \case
+  SVar i      -> Var (env !! (i `mod` length env))
+  SApp f x    -> app (renderIn scope env f) (renderIn scope env x)
+  SLam body   -> Foil.withFresh scope $ \binder ->
+    let scope' = Foil.extendScope binder scope
+     in Node (Lam (ScopedAST binder
+          (renderIn scope' (Foil.nameOf binder : map Foil.sink env) body)))
+
+-- | Render over the empty scope; the top of every skeleton is a 'SLam',
+-- so the environment is never consulted empty.
+render :: Skel -> Term Foil.VoidS
+render s = case s of
+  SLam{} -> renderIn Foil.emptyScope [] s
+  _      -> renderIn Foil.emptyScope [] (SLam s)
+
+-- | Render under @k@ dummy binders and cut back down, so every binder
+-- name shifts by @k@ and each level takes a rename branch.
+renderShifted :: Int -> Skel -> Term Foil.VoidS
+renderShifted k s = go k Foil.emptyScope
+  where
+    go :: Foil.Distinct n => Int -> Foil.Scope n -> Term Foil.VoidS
+    go 0 scope =
+      fromMaybe (error "the term uses a dummy binder")
+        (unsinkAST Foil.emptyScope (renderIn scope [] (case s of SLam{} -> s; _ -> SLam s)))
+    go j scope = Foil.withFresh scope $ \dummy ->
+      go (j - 1) (Foil.extendScope dummy scope)
+
+spec :: Spec
+spec = do
+  describe "the rename path" $ do
+    it "accepts the shifted chain (every binder differs)" $ do
+      alphaEquiv Foil.emptyScope (plainChain 300) (shiftedChain 300)
+        `shouldBe` True
+    it "agrees with alphaEquivRefreshed on the shifted chain" $ do
+      alphaEquivRefreshed Foil.emptyScope (plainChain 300) (shiftedChain 300)
+        `shouldBe` True
+
+  describe "no conflation of renamed and passthrough names" $ do
+    -- λ7. λ5. (7,7) vs λ5. λ9. (5,9): a raw-name-target environment maps
+    -- both sides to (5,5) and wrongly accepts; the terms differ.
+    it "rejects λa.λb.(a,a) against λa.λb.(a,b) with adversarial names" $ do
+      let t1 = lam 7 (\a -> lam 5 (\_b -> app (Var (Foil.sink a)) (Var (Foil.sink a))))
+          t2 = lam 5 (\a -> lam 9 (\b -> app (Var (Foil.sink a)) (Var b)))
+      alphaEquiv Foil.emptyScope t1 t2 `shouldBe` False
+    it "accepts λa.λb.(a,b) against λa.λb.(a,b) with adversarial names" $ do
+      let t1 = lam 7 (\a -> lam 5 (\b -> app (Var (Foil.sink a)) (Var b)))
+          t2 = lam 5 (\a -> lam 9 (\b -> app (Var (Foil.sink a)) (Var b)))
+      alphaEquiv Foil.emptyScope t1 t2 `shouldBe` True
+    -- λ7. λ5. 7 vs λ5. λ5. 5: on the right the inner binder shadows the
+    -- outer, so the bodies pick out different binders.
+    it "rejects λa.λb.a against λa.λb.b when the right side shadows" $ do
+      let t1 = lam 7 (\a -> lam 5 (\_b -> Var (Foil.sink a)))
+          t2 = lam 5 (\_a -> lam 5 (\b -> Var b))
+      alphaEquiv Foil.emptyScope t1 t2 `shouldBe` False
+    it "accepts λa.λb.b against λa.λb.b when the right side shadows" $ do
+      let t1 = lam 7 (\_a -> lam 5 (\b -> Var b))
+          t2 = lam 5 (\_a -> lam 5 (\b -> Var b))
+      alphaEquiv Foil.emptyScope t1 t2 `shouldBe` True
+
+  describe "agreement with alphaEquivRefreshed" $ do
+    prop "on a term against its shifted rendering" $ \s (Positive k) ->
+      let t1 = render s
+          t2 = renderShifted (k `mod` 5 + 1) s
+       in alphaEquiv Foil.emptyScope t1 t2
+            && alphaEquivRefreshed Foil.emptyScope t1 t2
+    prop "on two independent terms" $ \s1 s2 ->
+      let t1 = render s1
+          t2 = render s2
+       in alphaEquiv Foil.emptyScope t1 t2
+            == alphaEquivRefreshed Foil.emptyScope t1 t2
+    prop "on a term against a shifted different term" $ \s1 s2 (Positive k) ->
+      let t1 = render s1
+          t2 = renderShifted (k `mod` 5 + 1) s2
+       in alphaEquiv Foil.emptyScope t1 t2
+            == alphaEquivRefreshed Foil.emptyScope t1 t2
diff --git a/test/Control/Monad/Free/Foil/SupportSpec.hs b/test/Control/Monad/Free/Foil/SupportSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Control/Monad/Free/Foil/SupportSpec.hs
@@ -0,0 +1,205 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE DeriveTraversable   #-}
+{-# LANGUAGE LambdaCase          #-}
+-- @Ext VoidS n@ is simplifiable against the @Ext@ instance; this is what GHC
+-- suggests instead of unfolding it by hand.
+{-# LANGUAGE MonoLocalBinds      #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+-- | Supports and scope restriction.
+--
+-- The foil accounts for scope extension, where 'Foil.sink' is a coercion.
+-- Restriction is the other direction and cannot be: a term's support is
+-- contained in its scope, and the converse has to be tested. These are the
+-- properties of that test, and of the support it is made from.
+--
+-- The case worth reading is the last one. Raw names are not unique across scope
+-- indices — 'Foil.sink' is a coercion and does not rename, so a term carried
+-- into a larger scope keeps its binder names, and one of them may coincide with
+-- a name already there. This is not a contrived configuration: it is what makes
+-- 'Foil.withRefreshedPattern' unable to take an all-binders-already-fresh fast
+-- path, and one \(\beta\)-step is enough to produce it. It is also why a support
+-- has to drop binder names one binder at a time: dropping /all/ of a term's
+-- binder names from /all/ of its variables at the end would be wrong.
+module Control.Monad.Free.Foil.SupportSpec (spec) where
+
+import           Data.Bifoldable
+import           Data.Bifunctor
+import           Test.Hspec
+
+import qualified Control.Monad.Foil      as Foil
+import           Control.Monad.Free.Foil
+
+-- | Untyped λ-calculus: the smallest signature with a binder in it.
+data LamSig scope term
+  = AppSig term term
+  | LamSig scope
+  deriving (Functor, Foldable, Traversable)
+
+instance Bifunctor LamSig where
+  bimap f g = \case
+    AppSig fun arg -> AppSig (g fun) (g arg)
+    LamSig body    -> LamSig (f body)
+
+instance Bifoldable LamSig where
+  bifoldMap f g = \case
+    AppSig fun arg -> g fun <> g arg
+    LamSig body    -> f body
+
+type Lam = AST Foil.NameBinder LamSig
+
+var :: Foil.Name n -> Lam n
+var = Var
+
+app :: Lam n -> Lam n -> Lam n
+app fun arg = Node (AppSig fun arg)
+
+-- | @λ x. body x@, with a binder fresh in the given scope.
+lam
+  :: Foil.Distinct n
+  => Foil.Scope n
+  -> (forall l. Foil.DExt n l => Foil.Scope l -> Foil.Name l -> Lam l)
+  -> Lam n
+lam scope body = Foil.withFresh scope $ \binder ->
+  Node (LamSig (ScopedAST binder
+    (body (Foil.extendScope binder scope) (Foil.nameOf binder))))
+
+-- | One \(\beta\)-step at the head, via the library's own substitution.
+beta :: Foil.Distinct n => Foil.Scope n -> Lam n -> Lam n
+beta scope = \case
+  Node (AppSig (Node (LamSig (ScopedAST binder body))) arg) ->
+    substitute scope (Foil.addSubst Foil.identitySubst binder arg) body
+  term -> term
+
+-- | Work in a scope holding one name.
+withOne
+  :: (forall n. Foil.DExt Foil.VoidS n => Foil.Scope n -> Foil.Name n -> r) -> r
+withOne k = Foil.withFresh Foil.emptyScope $ \binder ->
+  k (Foil.extendScope binder Foil.emptyScope) (Foil.nameOf binder)
+
+-- | Work in a scope holding two names.
+withTwo
+  :: (forall n. Foil.DExt Foil.VoidS n
+      => Foil.Scope n -> Foil.Name n -> Foil.Name n -> r)
+  -> r
+withTwo k = Foil.withFresh Foil.emptyScope $ \b0 ->
+  let scope0 = Foil.extendScope b0 Foil.emptyScope
+   in Foil.withFresh scope0 $ \b1 ->
+        k (Foil.extendScope b1 scope0)
+          (Foil.sink (Foil.nameOf b0))
+          (Foil.nameOf b1)
+
+-- | Work with a chain of three binders, and the set of all their names.
+withThree
+  :: (forall l. Foil.NameBinderList Foil.VoidS l -> Foil.NameSet l -> r) -> r
+withThree k =
+  Foil.withFresh Foil.emptyScope $ \b0 ->
+    let scope0 = Foil.extendScope b0 Foil.emptyScope
+     in Foil.withFresh scope0 $ \b1 ->
+          let scope1 = Foil.extendScope b1 scope0
+           in Foil.withFresh scope1 $ \b2 ->
+                let chain = Foil.NameBinderListCons b0
+                          ( Foil.NameBinderListCons b1
+                          ( Foil.NameBinderListCons b2 Foil.NameBinderListEmpty ))
+                 in k chain (Foil.nameSetOfPattern chain)
+
+-- | The raw identifiers a chain of binders binds, outermost first.
+binderNames :: Foil.NameBinderList n l -> [Int]
+binderNames Foil.NameBinderListEmpty = []
+binderNames (Foil.NameBinderListCons binder binders) =
+  Foil.nameId (Foil.nameOf binder) : binderNames binders
+
+-- | Thin a chain down to the binders whose identifiers pass a test.
+thinnedBy
+  :: (Int -> Bool) -> Foil.NameBinderList Foil.VoidS l -> Foil.NameSet l -> [Int]
+thinnedBy p chain names = Foil.withThinnedNameBinderList keep chain binderNames
+  where
+    keep = Foil.nameSetFromList
+      [x | x <- Foil.nameSetToList names, p (Foil.nameId x)]
+
+-- | The raw identifiers of a term's support, which is what the assertions
+-- compare.
+support :: Foil.Distinct n => Lam n -> [Int]
+support = map Foil.nameId . freeVarsOf
+
+-- | The raw identifiers a term binds, so that the shadowing case below can
+-- assert that it really is one.
+binderIds :: Lam n -> [Int]
+binderIds = \case
+  Var _     -> []
+  Node node -> bifoldMap
+    (\(ScopedAST binder body) ->
+      Foil.nameId (Foil.nameOf binder) : binderIds body)
+    binderIds
+    node
+
+spec :: Spec
+spec = do
+  describe "supportOf" $ do
+    it "is empty for a closed term" $
+      support (lam Foil.emptyScope (\_ x -> var x)) `shouldBe` []
+
+    it "is the variable itself for a free variable" $
+      withOne (\_ x -> support (var x)) `shouldBe` [0]
+
+    it "drops what a binder binds and keeps what it does not" $
+      withOne (\scope x ->
+        support (lam scope (\_ y -> app (var (Foil.sink x)) (var y))))
+        `shouldBe` [0]
+
+    it "reports each free variable once, in ascending order" $
+      withTwo (\_ x y -> support (app (app (var y) (var x)) (var y)))
+        `shouldBe` [0, 1]
+
+  describe "unsinkAST" $ do
+    it "restricts a term that does not use what was dropped" $
+      withOne (\scope _ ->
+        fmap support (unsinkAST Foil.emptyScope (lam scope (\_ y -> var y))))
+        `shouldBe` Just []
+
+    it "refuses a term that does use it" $
+      withOne (\_ x ->
+        case unsinkAST Foil.emptyScope (var x) of
+          Nothing                    -> True
+          Just (_ :: Lam Foil.VoidS) -> False)
+        `shouldBe` True
+
+  describe "withRelevantScope" $
+    it "always succeeds, and keeps exactly the support" $
+      withTwo (\scope x y ->
+        let term = app (var y) (lam scope (\_ z -> var z))
+         in withRelevantScope term $ \relevant term' ->
+              ( Foil.nameSetSize (Foil.scopeToNameSet relevant)
+              , support term'
+              , Foil.member x relevant ))
+        `shouldBe` (1, [1], False)
+
+  describe "withThinnedNameBinderList" $ do
+    it "keeps exactly the binders in the set, in order" $
+      withThree (thinnedBy (/= 1)) `shouldBe` [0, 2]
+
+    it "keeps all of them when the set has all of them" $
+      withThree (thinnedBy (const True)) `shouldBe` [0, 1, 2]
+
+    it "keeps none when the set has none" $
+      withThree (thinnedBy (const False)) `shouldBe` []
+
+  describe "a binder sharing a raw name with the enclosing scope" $
+    it "does not remove the enclosing name from the support" $
+      -- Reducing `(λ g. g x) two`, where `two = λ s. λ z. s z` was built
+      -- elsewhere and so binds raw name 0, places that binder in a scope where
+      -- 0 is already the free variable `x`. The result, `two x`, must still
+      -- have support {0}: the binder shadows nothing, because inside it raw 0
+      -- denotes the bound variable. Removing every binder name from every
+      -- variable would wrongly give an empty support here. The second
+      -- component asserts that the reduct does bind raw 0, so that the case
+      -- cannot quietly stop being the one it claims to be.
+      withOne (\scope x ->
+        let two = lam Foil.emptyScope (\scope' s ->
+                    lam scope' (\_ z -> app (var (Foil.sink s)) (var z)))
+            redex = app (lam scope (\_ g -> app (var g) (var (Foil.sink x))))
+                        (Foil.sink two)
+            reduct = beta scope redex
+         in (support reduct, binderIds reduct))
+        `shouldBe` ([0], [0, 1])
diff --git a/test/Control/Monad/Free/Foil/TH/MkFreeFoilSpec/Syntax.hs b/test/Control/Monad/Free/Foil/TH/MkFreeFoilSpec/Syntax.hs
--- a/test/Control/Monad/Free/Foil/TH/MkFreeFoilSpec/Syntax.hs
+++ b/test/Control/Monad/Free/Foil/TH/MkFreeFoilSpec/Syntax.hs
@@ -38,7 +38,7 @@
 deriveGenericK ''FFPattern
 instance Foil.SinkableK FFPattern
 instance Foil.HasNameBinders FFPattern
-instance Foil.CoSinkable FFPattern
+-- Foil.CoSinkable FFPattern is generated by mkFreeFoil.
 instance Foil.UnifiablePattern FFPattern
 
 deriveBifunctor ''TermSig
diff --git a/test/SpecHook.hs b/test/SpecHook.hs
new file mode 100644
--- /dev/null
+++ b/test/SpecHook.hs
@@ -0,0 +1,23 @@
+-- | Set Unicode-capable input and output before any test runs; hspec
+-- discovers this module and wraps every spec in 'hook'.
+--
+-- On Windows, GHC encodes handles with the local code page, which cannot
+-- represent characters such as Π or 𝟙: the reporter used to die printing a
+-- test description (@commitBuffer: invalid argument@), and a spec that
+-- 'readFile's a UTF-8 example mis-decoded it and failed to parse. Setting
+-- the standard handles and the locale default (which every newly opened
+-- file inherits) to UTF-8 in-process covers both, including redirected
+-- output that a @chcp@ call in the workflow never reached.
+module SpecHook (hook) where
+
+import           GHC.IO.Encoding (setLocaleEncoding)
+import           System.IO       (hSetEncoding, stderr, stdout, utf8)
+import           Test.Hspec      (Spec, runIO)
+
+hook :: Spec -> Spec
+hook spec = runIO setUtf8 >> spec
+  where
+    setUtf8 = do
+      setLocaleEncoding utf8
+      hSetEncoding stdout utf8
+      hSetEncoding stderr utf8
