diff --git a/app/Main.hs b/app/Main.hs
index c656b90..ff9e0c6 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -4,7 +4,7 @@ import Clash.Prelude hiding (Log, Ordering (..), Word, break, def, init, lift, l
 import Control.Exception (catch)
 import Control.Monad (when)
 import Control.Monad.IO.Class (MonadIO, liftIO)
-import qualified Core as Core
+import qualified Core.Pipeline as Core
 import Data.IORef
 import Elf.ElfLoader
 import Elf.Syscall (ProgramExitException (..), handleSyscall)
diff --git a/package.yaml b/package.yaml
index a49a311..4ef1ca0 100644
--- a/package.yaml
+++ b/package.yaml
@@ -108,13 +108,18 @@ library:
   when:
     - condition: flag(smt-proof)
       exposed-modules:
-        - Proof.Cache.Functional.Solver
+        - Proof.Memory.Cache4K.Server.Functional.Solver
+        - Proof.Memory.Cache4K.Server.Leakage.Solver
+        - Proof.Memory.Cache4K.CachedCore.Functional.Solver
+        - Proof.Memory.Cache4K.CachedCore.Leakage.Solver
         - Proof.Core.Functional.Solver
         - Proof.Core.Leakage.Solver
         - Proof.SMT.Axioms
-        - Proof.Cache.SMT.Array
-        - Proof.Cache.SMT.Axioms
-        - Proof.Cache.SMT.Coherent
+        - Proof.Core.SMT.Array
+        - Proof.Core.SMT.Axioms
+        - Proof.Memory.Cache4K.SMT.Array
+        - Proof.Memory.Cache4K.SMT.Axioms
+        - Proof.Memory.Cache4K.SMT.Coherent
         - Proof.SMT.Logged
         - Proof.SMT.Sanity
         - Proof.Core.Functional.System
@@ -123,11 +128,24 @@ library:
   # live in proof/ too, and must only be built with the smt-proof flag.
   other-modules: []
   exposed-modules:
-    - Proof.Cache.Functional.Contract
-    - Proof.Cache.Functional.Driver
-    - Proof.Cache.Functional.Invariant
-    - Proof.Cache.Functional.Obligation
-    - Proof.Cache.SMT.Raw
+    - Proof.Memory.Cache4K.Server.Functional.Contract
+    - Proof.Memory.Cache4K.Server.Functional.Driver
+    - Proof.Memory.Cache4K.Server.Functional.Invariant
+    - Proof.Memory.Cache4K.Server.Functional.Obligation
+    - Proof.Memory.Cache4K.Server.Leakage.Driver
+    - Proof.Memory.Cache4K.Server.Leakage.Invariant
+    - Proof.Memory.Cache4K.Server.Leakage.Model
+    - Proof.Memory.Cache4K.Server.Leakage.Obligation
+    - Proof.Memory.Cache4K.Server.Leakage.Simulator
+    - Proof.Memory.Cache4K.CachedCore.Functional.Driver
+    - Proof.Memory.Cache4K.CachedCore.Functional.Invariant
+    - Proof.Memory.Cache4K.CachedCore.Functional.Machine
+    - Proof.Memory.Cache4K.CachedCore.Functional.Obligation
+    - Proof.Memory.Cache4K.CachedCore.Leakage.Driver
+    - Proof.Memory.Cache4K.CachedCore.Leakage.Invariant
+    - Proof.Memory.Cache4K.CachedCore.Leakage.Obligation
+    - Proof.Memory.Cache4K.CachedCore.Leakage.Simulator
+    - Proof.Memory.Cache4K.SMT.Raw
     - Proof.SMT.Array
     - Proof.Core.Functional.Machine
     - Proof.Core.Functional.Driver
@@ -138,12 +156,13 @@ library:
     - Proof.Core.Leakage.Driver
     - Proof.Core.Leakage.Invariant
     - Proof.Core.Leakage.Obligation
-    - Core
     - Elf.ElfLoader
     - Elf.Syscall
     - HardwareSim
+    - Core.Alu
     - Core.Instruction
     - Core.ISA
+    - Core.Pipeline
     - Memory.Types
     - Memory.Ideal
     - Memory.Vec
@@ -173,10 +192,10 @@ tests:
   aimcore-test:
     main:                Spec.hs
     source-dirs:         test
-    # Listed explicitly: Cache4KSpec and CompositionSpec are still written
-    # against the cache's old interface and wait for the cache's leakage proof.
     other-modules:
       - BenchmarkSpec
+      - Cache4KSpec
+      - CacheProofSpec
       - InstructionSpec
       - IsaSpec
       - ProofSpec
diff --git a/proof/Proof/Cache/Functional/Contract.hs b/proof/Proof/Cache/Functional/Contract.hs
deleted file mode 100644
index 865378b..0000000
--- a/proof/Proof/Cache/Functional/Contract.hs
+++ /dev/null
@@ -1,83 +0,0 @@
--- | The contract between the core and the 4 KiB cache in front of memory: what
--- each side promises beyond the cache's proof against ideal memory
--- ("Proof.Cache.Functional.Obligation"), so that the core runs behind the
--- cache as it would behind ideal memory, with stutter steps inserted.
---
--- The two sides are not symmetric: the core makes the requests and the cache
--- answers them.
---
---   * The core waits for what it asked for ('waitsAfterRequest'): after a
---     request, given no answer, it makes no request and its state stays the
---     same.
---   * The cache answers 'Nothing' only while a request is outstanding: a
---     server related to ideal memory by the invariant is ready
---     ('readyUnderInv'), and a ready server asked nothing answers within the
---     cycle ('readyIdleNoWait'). While a request is outstanding, the driver and the
---     cache's step obligations say how it answers: 'Nothing' for as many cycles
---     as the driver counts, then ideal memory's answer.
---
--- The properties are checked in "Proof.Cache.Functional.Solver".
-module Proof.Cache.Functional.Contract
-  ( isReady,
-    readyUnderInv,
-    readyIdleNoWait,
-    sameCoreAt,
-    waitsAfterRequest,
-  )
-where
-
-import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
-import Core (Input (..), Output (..), StateG (..), circuit)
-import Data.Maybe (isNothing)
-import Memory.Cache4KServer (CacheSrv (..), CacheSrvState (..))
-import Memory.Types (MemOps)
-import Proof.Cache.Functional.Driver (driver)
-import Proof.Cache.Functional.Invariant (srvInvAt)
-import Core.RegFile (RegFileOps (..))
-import Types (Address, RegIdx)
-import Memory.Cache4K (SetIdx, WordIdx)
-import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
-
--- The cache's side --------------------------------------------------------------
-
--- | Is the server ready for a request: no read waiting for memory?
-isReady :: CacheSrv m -> Bool
-isReady (CacheSrv _ _ st) = st == CacheSrvReady
-
--- | A server related to ideal memory by the invariant is ready.
-readyUnderInv :: (MemOps m) => Address -> SetIdx -> WordIdx -> m -> CacheSrv m -> Bool
-readyUnderInv wa wsi wwi ideal srv = not (srvInvAt wa wsi wwi ideal srv) || isReady srv
-
--- | A ready server that is asked nothing answers within the cycle.
-readyIdleNoWait :: CacheSrv m -> Bool
-readyIdleNoWait srv = not (isReady srv) || driver srv Nothing == 0
-
--- The core's side ---------------------------------------------------------------
-
--- | Two core states agree at register @wr@: every field is equal, the register
--- file at @wr@. Quantifying over @wr@ gives equality of the states.
-sameCoreAt :: (RegFileOps r) => RegIdx -> StateG r -> StateG r -> Bool
-sameCoreAt wr s1 s2 =
-  stateFePc s1 == stateFePc s2
-    && stateDePc s1 == stateDePc s2
-    && stateDeExpInstr s1 == stateDeExpInstr s2
-    && stateExPc s1 == stateExPc s2
-    && stateExInstr s1 == stateExInstr s2
-    && stateMeInstr s1 == stateMeInstr s2
-    && stateMeRes s1 == stateMeRes s2
-    && stateMeAddr s1 == stateMeAddr s2
-    && stateWbInstr s1 == stateWbInstr s2
-    && stateWbRes s1 == stateWbRes s2
-    && lookupRFg wr (stateRegFile s1) == lookupRFg wr (stateRegFile s2)
-    && stateCtrl s1 == stateCtrl s2
-    && stateHalt s1 == stateHalt s2
-
--- | The core waits for what it asked for: after a request, given no answer, it
--- makes no request and stays where it was (at register @wr@).
-waitsAfterRequest :: (RegFileOps r) => RegIdx -> StateG r -> Input -> Bool
-waitsAfterRequest wr s inp = case outMem o of
-  Nothing -> True
-  Just _ -> isNothing (outMem o') && sameCoreAt wr s'' s'
-  where
-    (s', o) = circuit s inp
-    (s'', o') = circuit s' (Input Nothing)
diff --git a/proof/Proof/Cache/Functional/Driver.hs b/proof/Proof/Cache/Functional/Driver.hs
deleted file mode 100644
index a699231..0000000
--- a/proof/Proof/Cache/Functional/Driver.hs
+++ /dev/null
@@ -1,54 +0,0 @@
--- | The cache's driver: how many cycles after a request the cache's answer is
--- final -- the cache's counterpart of "Proof.Core.Functional.Driver".
---
---   * 'driver', a case table over the cache and the request, and
---   * 'driverRef', the operational reading, obtained by actually serving.
-module Proof.Cache.Functional.Driver
-  ( driver,
-    driverRef,
-  )
-where
-
-import Core (MemAccess (..), Request)
-import Memory.Cache4K (cacheHit, setOf)
-import Memory.Cache4KServer
-import Memory.Types (MemOps (..))
-import Types
-
--- | The cycles after the request until the cache's answer is final: 'penalty'
--- for every line a data read misses, nothing for anything else. A read touches
--- the lines of its first and last byte; within four bytes those are different
--- lines exactly when they are in different sets. The driver is only ever run
--- from servers that satisfy the invariant
--- ('Proof.Cache.Functional.Invariant.srvInvAt'), which are ready, so the
--- server's state is not consulted; elsewhere it need not agree with
--- 'driverRef'.
-driver :: CacheSrv m -> Request -> Cycles
-driver (CacheSrv c _ _) req = case req of
-  Just (MemRead addr size) ->
-    let off = case size of
-          Byte -> 0
-          Half -> 1
-          Word -> 3
-
-        hit1stLine = cacheHit addr c
-        penalty1stLine = if hit1stLine then 0 else penalty
-
-        hit2ndLine = setOf (addr + off) == setOf addr || cacheHit (addr + off) c
-        penalty2ndLine = if hit2ndLine then 0 else penalty
-
-    in penalty1stLine + penalty2ndLine
-  _ -> 0
-
--- | The operational reading of 'driver': serve the request, then serve without
--- one until the server is ready again, and count every cycle of the hop,
--- including the request's. So, from a server that satisfies the invariant,
--- @'driverRef' fuel srv0 req == Just ('driver' srv0 req + 1)@. 'Nothing' if the
--- hop takes more than @fuel@ cycles.
-driverRef :: (MemOps m) => Int -> CacheSrv m -> Request -> Maybe Int
-driverRef fuel srv0 req = go 1 (fst (serve srv0 req))
-  where
-    go n srv
-      | srvState srv == CacheSrvReady = Just n
-      | n >= fuel = Nothing
-      | otherwise = go (n + 1) (fst (serve srv Nothing))
diff --git a/proof/Proof/Cache/Functional/Obligation.hs b/proof/Proof/Cache/Functional/Obligation.hs
deleted file mode 100644
index 0943dfe..0000000
--- a/proof/Proof/Cache/Functional/Obligation.hs
+++ /dev/null
@@ -1,139 +0,0 @@
-{-# LANGUAGE InstanceSigs #-}
--- | The cache's proof obligations, in one place: the cache's counterpart of
--- "Proof.Core.Functional.Obligation".
---
--- They relate the cached memory to ideal memory ("Memory.Ideal") one request at
--- a time: ideal memory answers in one cycle, the cached memory in
--- 'Proof.Cache.Functional.Driver.driver' + 1 cycles. As the core's obligations
--- build the ISA state from the system ('Proof.Core.Functional.Obligation.isaAt'),
--- these take ideal memory to be the server's memory before the hop; the
--- conclusion compares the memory ideal memory steps to with the server's after
--- the hop.
---
--- From a server that satisfies the invariant the driver is 0, 'penalty' or
--- twice 'penalty' (no, one or two lines missed), so there is one step
--- obligation per hop length, named after it for @'penalty' = 4@. Split by
--- length because Pantomime unrolls recursion only when its count is concrete.
-module Proof.Cache.Functional.Obligation
-  ( CoherentOps (..),
-    mkDataMem,
-    baseCase,
-    indStep0,
-    indStep4,
-    indStep8,
-  )
-where
-
-import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
-import Core (Input (..), Request)
-import Memory.Cache4K
-import Memory.Cache4KServer
-import Memory.Ideal (idealServe)
-import Memory.Types (MemOps (..))
-import Proof.Cache.Functional.Driver (driver)
-import Proof.Cache.Functional.Invariant (srvInvAt)
-import Proof.Cache.SMT.Raw (RawData (..))
-import Proof.SMT.Array (MemArr)
-import Types (Address, Word)
-import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
-
--- | Memories a coherent cache can be built from. A class, as memory's
--- operations are ('MemOps'), so that the obligations stay polymorphic in memory
--- and the solver only meets the monomorphic 'mkDataMem'.
-class (MemOps m) => CoherentOps m where
-  -- | The data array of a coherent cache with tags @t@ in front of @mem@: a
-  -- valid line holds memory's words at the address its tag gives, an invalid
-  -- line the words of @raw@.
-  mkData :: m -> TagArr -> RawData -> DataArr
-
-instance CoherentOps MemArr where
-  mkData :: MemArr -> TagArr -> RawData -> DataArr
-  mkData = mkDataMem
-
--- | 'mkData' on the solver's memory. The solver does not run this body:
--- 'Proof.Cache.SMT.Axioms.coherentAxioms' replaces it by
--- 'Proof.Cache.SMT.Coherent.mkDataC'.
-{-# OPAQUE mkDataMem #-}
-mkDataMem :: MemArr -> TagArr -> RawData -> DataArr
-mkDataMem mem t (RawData raw) = DataArr (imap word raw)
-  where
-    word :: Index 1024 -> Word -> Word
-    word i w
-      | entryValid e = memReadWord (wordAddr (entryTag e) si wi 0) mem
-      | otherwise = w
-      where
-        idx = fromIntegral i :: BitVector 10
-        si = slice d9 d2 idx
-        wi = slice d1 d0 idx
-        e = tagRead si t
-
--- | The base case: the server at start, in front of any memory, satisfies the
--- invariant against that memory.
-baseCase ::
-  (MemOps m) => Address -> SetIdx -> WordIdx -> m -> Bool
-baseCase wa wsi wwi mem =
-  srvInvAt wa wsi wwi mem (initCacheSrv mem)
-
--- | The one-cycle hop: a request the cache answers at once.
-indStep0 ::
-  (CoherentOps m) => Address -> SetIdx -> WordIdx -> m -> TagArr -> RawData -> Request -> Bool
-indStep0 wa wsi wwi mem t raw req =
-  not premises || conclusion
-  where
-    ideal = mem
-    srv = CacheSrv (Cache4K t (mkData mem t raw)) mem CacheSrvReady
-
-    (ideal', idealAns) = idealServe ideal req
-
-    premises =
-      srvInvAt wa wsi wwi ideal srv
-        && driver srv req == 0
-
-    conclusion = conclusionN 0 wa wsi wwi ideal' idealAns srv req
-
--- | The hop of a read that misses one line: 'penalty' + 1 cycle.
-indStep4 ::
-  (CoherentOps m) => Address -> SetIdx -> WordIdx -> m -> TagArr -> RawData -> Request -> Bool
-indStep4 wa wsi wwi mem t raw req =
-  not premises || conclusion
-  where
-    ideal = mem
-    srv = CacheSrv (Cache4K t (mkData mem t raw)) mem CacheSrvReady
-
-    (ideal', idealAns) = idealServe ideal req
-
-    premises =
-      srvInvAt wa wsi wwi ideal srv
-        && driver srv req == penalty
-
-    conclusion = conclusionN penalty wa wsi wwi ideal' idealAns srv req
-
--- | The hop of a read that misses both its lines: 2 * 'penalty' + 1 cycle.
-indStep8 ::
-  (CoherentOps m) => Address -> SetIdx -> WordIdx -> m -> TagArr -> RawData -> Request -> Bool
-indStep8 wa wsi wwi mem t raw req =
-  not premises || conclusion
-  where
-    ideal = mem
-    srv = CacheSrv (Cache4K t (mkData mem t raw)) mem CacheSrvReady
-
-    (ideal', idealAns) = idealServe ideal req
-
-    premises =
-      srvInvAt wa wsi wwi ideal srv
-        && driver srv req == 2 * penalty
-
-    conclusion = conclusionN (2 * penalty) wa wsi wwi ideal' idealAns srv req
-
--- | The conclusion of a hop of @n@ + 1 cycles: serve the request, then @n@
--- cycles without one. A stalling server ignores its requests, so this covers
--- any requests in those cycles. The first @n@
--- answers are 'Nothing', the last is ideal memory's answer @idealAns@, and after it
--- the server satisfies the invariant against @ideal'@, the memory ideal memory
--- stepped to. Recursive on @n@, which each obligation fixes to a constant.
-conclusionN :: (MemOps m) => Cycles -> Address -> SetIdx -> WordIdx -> m -> Input -> CacheSrv m -> Request -> Bool
-conclusionN n wa wsi wwi ideal' idealAns srv req
-  | n == 0 = ans == idealAns && srvInvAt wa wsi wwi ideal' srv'
-  | otherwise =
-      ans == Input Nothing && conclusionN (n - 1) wa wsi wwi ideal' idealAns srv' Nothing
-  where (srv', ans) = serve srv req
diff --git a/proof/Proof/Cache/Functional/Solver.hs b/proof/Proof/Cache/Functional/Solver.hs
deleted file mode 100644
index d136a5a..0000000
--- a/proof/Proof/Cache/Functional/Solver.hs
+++ /dev/null
@@ -1,180 +0,0 @@
--- | The cache's functional proof, checked symbolically: the cache's counterpart
--- of "Proof.Core.Functional.Solver".
---
--- 'baseCase' plus one property per hop length: on a hop of that length, the
--- corresponding obligation in "Proof.Cache.Functional.Obligation" holds. The
--- statements live there; this module only instantiates them, over every tag
--- array, data array, memory, request and witness.
---
--- Each step starts from a ready server whose cache is coherent by
--- construction ('mkData').
---
--- == Running them
---
--- Under Bitwuzla, not Z3:
---
--- > SBV_Z3=/usr/local/bin/bitwuzla SBV_Z3_OPTIONS="--produce-models" stack build
-module Proof.Cache.Functional.Solver
-  ( cacheArraysP,
-    coherentDataP,
-    coherentWriteP,
-    coherentLayoutP,
-    baseCaseP,
-    indStep0P,
-    indStep4P,
-    indStep8P,
-    readyUnderInvP,
-    readyIdleNoWaitP,
-    waitsAfterRequestP,
-    results,
-  )
-where
-
-import Clash.Prelude (BitVector, d0, d1, d2, d9, not, slice, (++#), (||))
-import Core (Request)
-import qualified Core
-import Memory.Cache4KServer (CacheSrv (..), CacheSrvState)
-import Memory.Cache4K
-import Memory.Types (MemOps (..))
-import Pantomime (Theory (..))
-import qualified Pantomime.BuiltIn as Pantomime
-import Proof.Cache.SMT.Axioms (cacheAxioms, coherentAxioms)
-import Proof.Cache.SMT.Raw (RawData, rawRead)
-import Proof.Cache.Functional.Contract (readyIdleNoWait, readyUnderInv, waitsAfterRequest)
-import Proof.Cache.Functional.Obligation
-import Proof.Core.Functional.Machine (SysG (..))
-import Proof.Core.Functional.System (KState, sysOf)
-import Proof.SMT.Array (MemArr, RegArr)
-import Proof.SMT.Axioms (arrayAxioms)
-import Proof.SMT.Logged (pantomime)
-import Types
-import Prelude hiding (Word, not, (||))
-
--- Sanity probes for the trusted embeddings -------------------------------------
-
--- | The tag and data array embeddings, which are trusted, against facts a
--- broken one would get wrong.
-{-# ANN cacheArraysP (Theory cacheAxioms) #-}
-cacheArraysP ::
-  TagArr -> DataArr -> SetIdx -> BitVector 21 -> BitVector 10 -> Word -> Pantomime.Bool
-cacheArraysP t d s e i w =
-  Pantomime.boolean $
-    tagRead s (tagWrite s e t) == e
-      && dataRead i (dataWrite i w d) == w
-      && tagRead s tagEmpty == 0
-      && dataRead i dataZero == 0
-
--- | The embedding of the coherent cache ('mkData' as
--- 'Proof.Cache.SMT.Coherent.DataC'), which is trusted, against what 'mkData'
--- defines: a read of the constructed array is memory's word if the line is
--- valid, else the raw word. Writes are checked by 'coherentWrite'.
-{-# ANN coherentDataP (Theory coherentAxioms) #-}
-coherentDataP :: MemArr -> TagArr -> RawData -> BitVector 10 -> Pantomime.Bool
-coherentDataP ma t raw i =
-  Pantomime.boolean $ dataRead i (mkData ma t raw) == constructed i
-  where
-    constructed k
-      | entryValid e = memReadWord (wordAddr (entryTag e) si (slice d1 d0 k) 0) ma
-      | otherwise = rawRead k raw
-      where
-        si = slice d9 d2 k
-        e = tagRead si t
-
--- | A write on any data array of the coherent cache's embedding, including one
--- that already holds writes: a read after it gives the written word at its
--- index and leaves the other slots as they were. Since it holds for every
--- array, it covers any sequence of writes.
-{-# ANN coherentWriteP (Theory coherentAxioms) #-}
-coherentWriteP :: DataArr -> BitVector 10 -> BitVector 10 -> Word -> Pantomime.Bool
-coherentWriteP d i j w =
-  Pantomime.boolean $
-    dataRead i (dataWrite i w d) == w
-      && (i == j || dataRead j (dataWrite i w d) == dataRead j d)
-
--- | The coherent cache's index layout agrees with the cache's addressing: at
--- any address whose line is valid and holds its block, the cache's word (index
--- set, then word, as 'Memory.Cache4K' composes it) is memory's word there.
-{-# ANN coherentLayoutP (Theory coherentAxioms) #-}
-coherentLayoutP :: MemArr -> TagArr -> RawData -> Address -> Pantomime.Bool
-coherentLayoutP ma t raw a =
-  Pantomime.boolean $
-    not (entryValid e && entryTag e == tagOf a)
-      || dataRead (setOf a ++# wordOf a) (mkData ma t raw)
-        == memReadWord (wordAddr (tagOf a) (setOf a) (wordOf a) 0) ma
-  where
-    e = tagRead (setOf a) t
-
--- The base case ----------------------------------------------------------------
-
--- | Under 'cacheAxioms': the initial cache is the empty one ('Memory.Cache4K.dataZero'),
--- not a constructed one.
-{-# ANN baseCaseP (Theory cacheAxioms) #-}
-baseCaseP ::
-  Address -> SetIdx -> WordIdx -> MemArr -> Pantomime.Bool
-baseCaseP wa wsi wwi ma =
-  Pantomime.boolean $ baseCase wa wsi wwi ma
-
--- The inductive steps ----------------------------------------------------------
-
--- | The one-cycle hop: a request the cache answers at once.
-{-# ANN indStep0P (Theory coherentAxioms) #-}
-indStep0P ::
-  Address -> SetIdx -> WordIdx -> MemArr -> TagArr -> RawData -> Request -> Pantomime.Bool
-indStep0P wa wsi wwi ma t raw req =
-  Pantomime.boolean $ indStep0 wa wsi wwi ma t raw req
-
--- | The hop of a read that misses one line.
-{-# ANN indStep4P (Theory coherentAxioms) #-}
-indStep4P ::
-  Address -> SetIdx -> WordIdx -> MemArr -> TagArr -> RawData -> Request -> Pantomime.Bool
-indStep4P wa wsi wwi ma t raw req =
-  Pantomime.boolean $ indStep4 wa wsi wwi ma t raw req
-
--- | The hop of a read that misses both its lines.
-{-# ANN indStep8P (Theory coherentAxioms) #-}
-indStep8P ::
-  Address -> SetIdx -> WordIdx -> MemArr -> TagArr -> RawData -> Request -> Pantomime.Bool
-indStep8P wa wsi wwi ma t raw req =
-  Pantomime.boolean $ indStep8 wa wsi wwi ma t raw req
-
--- The contract -----------------------------------------------------------------
---
--- The properties of "Proof.Cache.Functional.Contract": the cache's over a
--- server with arbitrary tags, data, memory and state, the core's over a core
--- state built from symbolic parts as in the core's proof
--- ('Proof.Core.Functional.System.sysOf').
-
--- | A server related to ideal memory by the invariant is ready.
-{-# ANN readyUnderInvP (Theory cacheAxioms) #-}
-readyUnderInvP ::
-  Address -> SetIdx -> WordIdx -> MemArr -> TagArr -> DataArr -> MemArr -> CacheSrvState -> Pantomime.Bool
-readyUnderInvP wa wsi wwi ideal t d ma st =
-  Pantomime.boolean $ readyUnderInv wa wsi wwi ideal (CacheSrv (Cache4K t d) ma st)
-
--- | A ready server that is asked nothing answers within the cycle.
-{-# ANN readyIdleNoWaitP (Theory cacheAxioms) #-}
-readyIdleNoWaitP :: TagArr -> DataArr -> MemArr -> CacheSrvState -> Pantomime.Bool
-readyIdleNoWaitP t d ma st = Pantomime.boolean $ readyIdleNoWait (CacheSrv (Cache4K t d) ma st)
-
--- | The core waits for what it asked for.
-{-# ANN waitsAfterRequestP (Theory arrayAxioms) #-}
-waitsAfterRequestP :: RegIdx -> KState -> Core.Input -> RegArr -> MemArr -> Pantomime.Bool
-waitsAfterRequestP wr ss i ra ma =
-  Pantomime.boolean $ waitsAfterRequest wr (sysCore (sysOf ss i ra ma)) i
-
--- | The verdicts, spliced in by the plugin at compile time: 'Nothing' when the
--- property is valid.
-results :: [(String, Maybe String)]
-results =
-  [ ("cacheArraysP", $(pantomime 'cacheArraysP)),
-    ("coherentDataP", $(pantomime 'coherentDataP)),
-    ("coherentWriteP", $(pantomime 'coherentWriteP)),
-    ("coherentLayoutP", $(pantomime 'coherentLayoutP)),
-    ("baseCaseP", $(pantomime 'baseCaseP)),
-    ("indStep0P", $(pantomime 'indStep0P)),
-    ("indStep4P", $(pantomime 'indStep4P)),
-    ("indStep8P", $(pantomime 'indStep8P)),
-    ("readyUnderInvP", $(pantomime 'readyUnderInvP)),
-    ("readyIdleNoWaitP", $(pantomime 'readyIdleNoWaitP)),
-    ("waitsAfterRequestP", $(pantomime 'waitsAfterRequestP))
-  ]
diff --git a/proof/Proof/Cache/Induction4K.hs b/proof/Proof/Cache/Induction4K.hs
deleted file mode 100644
index 00806e6..0000000
--- a/proof/Proof/Cache/Induction4K.hs
+++ /dev/null
@@ -1,52 +0,0 @@
--- | The server proof for the 4 KiB cache ("Proof.Cache.Server4K"), checked
--- symbolically, over every tag array, data array, memory and request, with the
--- witnesses quantified. The array embeddings are checked in
--- 'Proof.Cache.Server.Functional.Induction.cacheArrays'.
-module Proof.Cache.Induction4K
-  ( srvInitP,
-    srvRefineP,
-    srvLeakP,
-    stallsOnReadsP,
-    results,
-  )
-where
-
-import qualified Core
-import Data.Functor.Identity
-import Memory.Cache4K
-import Pantomime (Theory (..))
-import qualified Pantomime.BuiltIn as Pantomime
-import Proof.Cache.Server4K (srvInit, srvLeak, srvRefine, stallsOnReads)
-import Memory.Cache4KServer (CacheSrv (..))
-import Proof.SMT.Array (MemArr)
-import Proof.Cache.SMT.Axioms (cacheAxioms)
-import Proof.SMT.Logged (pantomime)
-import Clash.Prelude (BitVector)
-import Types
-import Prelude hiding (Word)
-
-{-# ANN srvInitP (Theory cacheAxioms) #-}
-srvInitP :: SetIdx -> WordIdx -> MemArr -> Pantomime.Bool
-srvInitP s w ma = Pantomime.boolean $ srvInit s w ma
-
-{-# ANN srvRefineP (Theory cacheAxioms) #-}
-srvRefineP :: Address -> SetIdx -> WordIdx -> TagArr -> DataArr -> MemArr -> Maybe (Core.MemAccess Identity) -> Pantomime.Bool
-srvRefineP wa ws ww t d ma q = Pantomime.boolean $ srvRefine wa ws ww (CacheSrv (Cache4K t d) Nothing ma) q
-
-{-# ANN srvLeakP (Theory cacheAxioms) #-}
-srvLeakP :: SetIdx -> TagArr -> DataArr -> MemArr -> Maybe (Core.MemAccess Identity) -> Pantomime.Bool
-srvLeakP ws t d ma q = Pantomime.boolean $ srvLeak ws (CacheSrv (Cache4K t d) Nothing ma) q
-
-{-# ANN stallsOnReadsP (Theory cacheAxioms) #-}
-stallsOnReadsP :: TagArr -> DataArr -> MemArr -> Maybe (Core.MemAccess Identity) -> Pantomime.Bool
-stallsOnReadsP t d ma q = Pantomime.boolean $ stallsOnReads (CacheSrv (Cache4K t d) Nothing ma) q
-
--- | The verdicts, spliced in by the plugin at compile time: 'Nothing' when the
--- property is valid.
-results :: [(String, Maybe String)]
-results =
-  [ ("srvInitP", $(pantomime 'srvInitP)),
-    ("srvRefineP", $(pantomime 'srvRefineP)),
-    ("srvLeakP", $(pantomime 'srvLeakP)),
-    ("stallsOnReadsP", $(pantomime 'stallsOnReadsP))
-  ]
diff --git a/proof/Proof/Cache/Server4K.hs b/proof/Proof/Cache/Server4K.hs
deleted file mode 100644
index 84ddbac..0000000
--- a/proof/Proof/Cache/Server4K.hs
+++ /dev/null
@@ -1,157 +0,0 @@
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE UndecidableInstances #-}
-
--- | The server proof for the 4 KiB cache ("Memory.Cache4K"), served by
--- 'Memory.Cache4KServer.serve'.
---
--- The artifacts: the hop of a request ('Proof.Cache.Server.Functional.Driver.driver'
--- cycles after it),
--- the invariant (no miss pending, every valid line holds memory's words), the
--- flush 'srvMem', the censor 'srvTag' (the tag array), and the simulator
--- 'simStep', derived from the cache itself.
---
--- The cache holds 1024 words, so the invariant is stated at one word,
--- 'srvInvAt', and the obligations quantify over that word, as the functional
--- invariant does over a register and a byte. 'srvRefine' also assumes the
--- invariant at the word the request accesses. Both assumptions are instances of
--- the invariant at every word, so 'srvRefine' for every witness gives the
--- obligation for the whole invariant.
-module Proof.Cache.Server4K
-  ( srvTag,
-    simStep,
-    simBus,
-    srvInit,
-    srvRefine,
-    srvLeak,
-    stallsOnReads,
-    CacheSys (..),
-    initCacheSys,
-    stepCachedOut,
-  )
-where
-
-import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
-import Core (Input (..), MemAccess (..), Output (..), Request, circuit)
-import Data.Functor.Identity
-import Memory.Cache4K
-import Memory.Types (MemOps (..))
-import Proof.Core.Leakage.Model (Obs (..), obsReq)
-import Memory.Cache4KServer
-import Proof.Cache.Server.Functional.Driver (driver)
-import Proof.Cache.Server.Functional.Invariant (noMiss, srvInvAt)
-import Proof.Core.Functional.Machine (SysG (..))
-import Memory.Ideal (idealServe)
-import Core.RegFile (RegFileOps)
-import Types
-import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
-import qualified Prelude as P
-
--- | The censor: the tags.
-srvTag :: CacheSrv m -> TagArr
-srvTag y = tagArr (srvCache y)
-
--- | The simulator's memory: zeros, and writes are dropped. The simulator knows
--- no data.
-data NoMem = NoMem
-  deriving (Eq, Show)
-
-instance MemOps NoMem where
-  memReadWord _ _ = 0
-  memWrite _ _ _ m = m
-  memReadByte _ _ = 0
-
--- | A request with a given observation: a fetch of a word, and a write of zero.
-reqOf :: Obs -> Request
-reqOf o = case o of
-  NoAccess -> Nothing
-  Fetch addr -> Just (MemAccess True addr Types.Word Nothing)
-  DataRead addr size -> Just (MemAccess False addr size Nothing)
-  DataWrite addr size -> Just (MemAccess False addr size (Just (Identity 0)))
-
--- | The simulator: the cache's own hop, on the tags with no data, in front of
--- 'NoMem', on a request with the observation. Returns the next tags and how many
--- responses are not ready.
-simStep :: TagArr -> Obs -> (TagArr, Cycles)
-simStep t o = (srvTag y', k)
-  where
-    y0 = CacheSrv (Cache4K t dataZero) Nothing NoMem
-    q = reqOf o
-    n = driver y0 q
-    k = fromIntegral n
-    (y', _) = serveN n y0 q
-
--- | The simulator as it shows on the bus: the observed request, then one cycle
--- without a request per response that is not ready.
-simBus :: TagArr -> Obs -> (TagArr, [Obs])
-simBus t o = (t', o : P.replicate (fromIntegral k) NoAccess)
-  where
-    (t', k) = simStep t o
-
-sameInput :: Input Identity -> Input Identity -> Bool
-sameInput a b =
-  runIdentity (inputMem a) == runIdentity (inputMem b)
-    && inputMemReady a == inputMemReady b
-
--- | The empty cache, in front of any memory, satisfies the invariant. Its
--- censor is 'tagEmpty' for every memory by definition.
-srvInit :: (MemOps m) => SetIdx -> WordIdx -> m -> Bool
-srvInit s w mem = srvInvAt s w (CacheSrv emptyCache4K Nothing mem)
-
--- | The refinement proof, at witnesses: memory at byte @wa@ and the invariant at
--- word @ww@ of set @ws@. The hop of a request ends with ideal memory's response,
--- and with memory and the invariant as ideal memory leaves them.
-srvRefine :: (MemOps m) => Address -> SetIdx -> WordIdx -> CacheSrv m -> Request -> Bool
-srvRefine wa ws ww y q =
-  not (srvInvAt ws ww y && accessed)
-    || ( sameInput x xI
-           && srvInvAt ws ww y'
-           && memReadByte wa (srvMem y') == memReadByte wa mI
-       )
-  where
-    (y', x) = serveN (driver y q) y q
-    (mI, xI) = idealServe (srvMem y) q
-    accessed = case q of
-      Just (MemAccess _ addr _ _) -> srvInvAt (setOf addr) (wordOf addr) y
-      Nothing -> True
-
--- | The leakage proof, at a witness set: with no miss pending, how many
--- responses of the hop are not ready, and the next tags, are what 'simStep' computes
--- from the tags and the observation of the request.
-srvLeak :: (MemOps m) => SetIdx -> CacheSrv m -> Request -> Bool
-srvLeak ws y q =
-  not (noMiss y) || (k == fromIntegral kS && tagRead ws (srvTag y') == tagRead ws tS)
-  where
-    k = driver y q
-    (y', _) = serveN k y q
-    (tS, kS) = simStep (srvTag y) (obsReq q)
-
--- | The cache answers late only to a data read. With the core's patience
--- ('Proof.CachedCore.Obligation.waitObligation'), the core's leakage proof carries
--- over to the core behind this cache too.
-stallsOnReads :: (MemOps m) => CacheSrv m -> Request -> Bool
-stallsOnReads y q = not (noMiss y) || inputMemReady x || isDataRead
-  where
-    (_, x) = serve y q
-    isDataRead = case q of
-      Just (MemAccess False _ _ Nothing) -> True
-      _ -> False
-
--- | System state paired with a cache model.
-data CacheSys r m c = CacheSys
-  { cacheSysCore :: SysG r m,
-    cacheSysCache :: c,
-    -- | A read waiting for memory: its address and width, and the cycles left.
-    cacheSysPending :: Maybe (Address, Size, Cycles)
-  }
-
-deriving instance (Show (r Identity), Show m, Show c) => Show (CacheSys r m c)
-
-initCacheSys :: SysG r m -> c -> CacheSys r m c
-initCacheSys sys cache = CacheSys sys cache Nothing
-
--- | The core in a loop with the cache in front of memory.
-stepCachedOut :: (RegFileOps r, MemOps m) => CacheSys r m Cache4K -> (CacheSys r m Cache4K, Output Identity)
-stepCachedOut (CacheSys (Sys s i m) cache pending) =
-  let (s', o) = circuit s i
-      (CacheSrv cache' pending' m', i') = serve (CacheSrv cache pending m) (outMem o)
-   in (CacheSys (Sys s' i' m') cache' pending', o)
diff --git a/proof/Proof/Core/Functional/Driver.hs b/proof/Proof/Core/Functional/Driver.hs
index 5ddf546..c85bf04 100644
--- a/proof/Proof/Core/Functional/Driver.hs
+++ b/proof/Proof/Core/Functional/Driver.hs
@@ -1,10 +1,10 @@
--- | The driver: how many cycles 'Proof.Core.Functional.Machine.stepSys' should advance the core
--- before its state is compared against the ISA again. Its stated invariant is
--- operational -- \"step until the instruction in the execute phase is no longer
--- a no-op\" -- so this module provides both:
+-- | The driver: how many cycles 'Proof.Core.Functional.Machine.stepSys' should
+-- advance the core before its state is compared against the ISA again. Its
+-- stated invariant is operational -- \"step until the instruction in the
+-- execute phase is no longer a no-op\" -- so this module provides both:
 --
 --   * 'driver', a case table over the pipeline state, and
---   * 'driverRef', the operational reading, obtained by actually stepping.
+--   * 'driverSpec', the operational reading, obtained by actually stepping.
 --
 -- Checking these two against each other is the first thing the test suite does.
 --
@@ -16,7 +16,10 @@
 module Proof.Core.Functional.Driver
   ( driver,
     driverCaseName,
-    driverRef,
+    driverSpec,
+    driverMatchesSpecInit,
+    driverMatchesSpec,
+    driverValues,
     takingJump,
     storeHazard,
     loadHazard,
@@ -26,11 +29,14 @@ module Proof.Core.Functional.Driver
 where
 
 import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
-import Core
-import Data.Maybe (fromMaybe)
+import Core.Alu (alu, branch)
+import Core.Pipeline as Core
+import Data.Maybe (fromMaybe, isNothing)
 import Core.Instruction hiding (loadHazard, storeHazard)
 import qualified Core.Instruction
 import Memory.Types (MemOps (..))
+import Core.ISA (IsaStateG)
+import Proof.Core.Functional.Invariant (invAt)
 import Proof.Core.Functional.Machine
 import Core.RegFile
 import Types
@@ -57,7 +63,8 @@ wbFwd (Sys core inp _) =
   case stateWbInstr core of
     RType _ rd _ _ -> Just (rd, res)
     IType (Arith _) rd _ _ -> Just (rd, res)
-    IType (Load size sign) rd _ _ -> Just (rd, loadExtend size sign (fromMaybe 0 (inputMem inp)))
+    IType (Load size sign) rd _ _ ->
+      Just (rd, loadExtend size sign (fromMaybe 0 (inputMem inp)))
     JType rd _ -> Just (rd, res)
     IType Jump rd _ _ -> Just (rd, res)
     UType _ rd _ -> Just (rd, res)
@@ -83,7 +90,7 @@ takingJump :: (RegFileOps r) => SysG r m -> Bool
 takingJump sys@(Sys core _ _) =
   case stateExInstr core of
     BType cmp _ rs1 rs2 ->
-      (branch cmp (exArg sys rs1) (exArg sys rs2))
+      branch cmp (exArg sys rs1) (exArg sys rs2)
     JType _ _ -> True
     IType Jump _ _ _ -> True
     _ -> False
@@ -92,12 +99,13 @@ takingJump sys@(Sys core _ _) =
 -- decode-stage PC overlaps a store either in the execute stage or in the memory
 -- stage.
 --
--- The overlap test is 'Core.Instruction.storeHazard', the core's own, which is why
--- the store's size is carried alongside its address: a byte store and a word
--- store at the same address clash with different sets of PCs. 'Core.decode'
--- reads the pair off @ctrlExStoreAddrSize@ / @ctrlMeStoreAddrSize@; here the
--- execute-stage address is recomputed from the forwarded operand, as
--- 'Core.execute' would, and the memory-stage one is already in @stateMeAddr@.
+-- The overlap test is 'Core.Instruction.storeHazard', the core's own, which is
+-- why the store's size is carried alongside its address: a byte store and a
+-- word store at the same address clash with different sets of PCs.
+-- 'Core.decode' reads the pair off @ctrlExStoreAddrSize@ /
+-- @ctrlMeStoreAddrSize@; here the execute-stage address is recomputed from the
+-- forwarded operand, as 'Core.execute' would, and the memory-stage one is
+-- already in @stateMeAddr@.
 storeHazard :: (RegFileOps r) => SysG r m -> Bool
 storeHazard sys@(Sys core _ _) =
   maybe False (Core.Instruction.storeHazard dePc) exStore
@@ -129,7 +137,7 @@ loadHazard (Sys core inp _) =
 -- | The driver's case table. The cases are checked in order. The driver is
 -- only ever run from states that satisfy the invariant
 -- ('Proof.Core.Functional.Invariant.invAt'); elsewhere it need not agree
--- with 'driverRef'.
+-- with 'driverSpec'.
 driver :: (RegFileOps r) => SysG r m -> Int
 driver sys@(Sys core _ _)
   | stateExInstr core == Nop FirstCycle = 1
@@ -143,6 +151,14 @@ driver sys@(Sys core _ _)
   | not (isMemInstr (stateExInstr core)) = 2
   | otherwise = 3
 
+-- | The driver is 0 to 3: the hop lengths of the core's steps
+-- ('Proof.Core.Functional.Obligation.indStep0' to
+-- 'Proof.Core.Functional.Obligation.indStep3'), which so cover every hop.
+driverValues :: (RegFileOps r) => SysG r m -> Bool
+driverValues sys = k == 0 || k == 1 || k == 2 || k == 3
+  where
+    k = driver sys
+
 -- | Which case of the table 'driver' fired. Used to measure how much of the
 -- table the tests actually reach.
 driverCaseName :: (RegFileOps r) => SysG r m -> String
@@ -151,38 +167,70 @@ driverCaseName sys@(Sys core _ _)
   | stateExInstr core == Nop Halted = "halted"
   | isEnvInstr (stateExInstr core) = "env"
   | takingJump sys = "jump"
-  | storeHazard sys = if isMemInstr (stateExInstr core) then "storeHazard/mem" else "storeHazard/nomem"
+  | storeHazard sys =
+      if isMemInstr (stateExInstr core)
+        then "storeHazard/mem"
+        else "storeHazard/nomem"
   | loadHazard sys = "loadHazard"
   | not (isMemInstr (stateWbInstr core)) = "steady/wb-nomem"
   | not (isMemInstr (stateMeInstr core)) = "steady/me-nomem"
   | not (isMemInstr (stateExInstr core)) = "steady/ex-nomem"
   | otherwise = "steady/all-mem"
 
--- | Is this a pipeline bubble, as opposed to a real instruction?
+-- | Does the execute stage hold a pipeline bubble, as opposed to a real
+-- instruction?
 --
 -- The driver's stated invariant is \"step until the execute stage is no longer
 -- a no-op\", but that is slightly too coarse: @Nop DecodeFail@ is what an
 -- undecodable memory word decodes to, so it /is/ the architectural instruction
--- at that PC and the ISA steps over it like any other. Only the stall reasons
--- are genuine bubbles.
-isBubble :: Instruction -> Bool
-isBubble (Nop DecodeFail) = False
-isBubble (Nop _) = True
-isBubble _ = False
+-- at that PC and the ISA steps over it like any other. Nor is @Nop Halted@
+-- once the core has halted: it then stays where it is, as the ISA does. While
+-- the halt is still on its way through the pipeline -- an @ecall@ or @ebreak@
+-- that has left the execute stage but not yet halted the core -- @Nop Halted@
+-- is a bubble like the stall reasons, so the hop runs on until the core halts.
+isBubble :: SysG r m -> Bool
+isBubble (Sys core _ _) = case stateExInstr core of
+  Nop DecodeFail -> False
+  Nop Halted -> isNothing (stateHalt core)
+  Nop _ -> True
+  _ -> False
 
 -- | The operational reading of the driver's stated invariant: step until the
 -- execute stage holds something that is not a no-op. Returns the number of
--- 'Proof.Core.Functional.Machine.stepSys' steps taken, or 'Nothing' if @fuel@ ran out (which is what
--- happens once the core has halted, since the execute stage then holds
--- @Nop Halted@ forever).
+-- 'Proof.Core.Functional.Machine.stepSys' steps taken after the first, so that
+-- it agrees with 'driver', or 'Nothing' if @fuel@ ran out.
 --
 -- \"No longer a no-op\" is read as 'isBubble': @Nop DecodeFail@ counts
 -- as a real instruction, since it is what an undecodable word in memory
 -- decodes to.
-driverRef :: (RegFileOps r, MemOps m) => Int -> SysG r m -> Maybe Int
-driverRef fuel sys0 = go 1 (stepSys sys0)
+driverSpec :: (RegFileOps r, MemOps m) => Int -> SysG r m -> Maybe Int
+driverSpec fuel sys0 = go 0 (stepSys sys0)
   where
-    go n s@(Sys core _ _)
-      | not (isBubble (stateExInstr core)) = Just n
+    go n s
+      | not (isBubble s) = Just n
       | n >= fuel = Nothing
       | otherwise = go (n + 1) (stepSys s)
+
+-- | On the initial system the driver agrees with its operational reading: the
+-- first hop, from the start PC @pc@ with register file @rf@ and memory @mem@
+-- ('Proof.Core.Functional.Machine.initSys'). The invariant does not cover the
+-- initial system, so 'driverMatchesSpec' does not either.
+driverMatchesSpecInit ::
+  (RegFileOps r, MemOps m) => Address -> r -> m -> Bool
+driverMatchesSpecInit pc rf mem =
+  driverSpec 3 sys == Just (driver sys)
+  where
+    sys = initSys pc rf mem
+
+-- | On every other hop -- from the states the invariant relates to an ISA
+-- state -- the driver agrees with its operational reading as well. Three cycles
+-- of fuel cover the longest hop.
+driverMatchesSpec ::
+  (RegFileOps r, MemOps m) =>
+  RegIdx -> Address -> IsaStateG r m -> SysG r m -> Bool
+driverMatchesSpec wr wa isa sys =
+  not premises || conclusion
+  where
+    premises = invAt wr wa isa sys
+
+    conclusion = driverSpec 3 sys == Just (driver sys)
diff --git a/proof/Proof/Core/Functional/Invariant.hs b/proof/Proof/Core/Functional/Invariant.hs
index 123f834..b09d6bf 100644
--- a/proof/Proof/Core/Functional/Invariant.hs
+++ b/proof/Proof/Core/Functional/Invariant.hs
@@ -20,11 +20,11 @@
 -- from drifting.
 --
 -- The invariant describes the core attached to memory that answers every
--- request in the next cycle ('Proof.Core.Functional.Machine.stepSys'), so the bus always holds
--- an answer ('Core.inputMem' is 'Just').
+-- request in the next cycle ('Proof.Core.Functional.Machine.stepSys'), so the
+-- bus always holds an answer ('Core.inputMem' is 'Just').
 module Proof.Core.Functional.Invariant
-  ( flushWbStage,
-    flushMeStage,
+  ( applyWbStage,
+    applyMeStage,
     Case (..),
     inv,
     invAtList,
@@ -32,11 +32,20 @@ module Proof.Core.Functional.Invariant
     invCasesAt,
     invAt,
     explain,
+    isaOf,
+    sysInvAt,
+    archPc,
+    archRegFile,
+    archMem,
+    pcUnderInv,
+    regFileUnderInv,
+    memUnderInv,
+    invFunctional,
   )
 where
 
 import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
-import Core
+import Core.Pipeline as Core
 import Data.Maybe (fromMaybe, isJust)
 import Core.Instruction
 import Memory.Types
@@ -49,18 +58,19 @@ import qualified Prelude as P
 
 -- | Apply the pending effect of the writeback-stage instruction. The load case
 -- reads its value off @inputMem@, matching 'Core.writeback'.
-flushWbStage ::
+applyWbStage ::
   (RegFileOps r) =>
   Instruction ->
   Word ->
   Word ->
   (m, r) ->
   (m, r)
-flushWbStage ir res inputWord (mem, rf) =
+applyWbStage ir res inputWord (mem, rf) =
   case ir of
     RType _ rd _ _ -> (mem, put rd res)
     IType (Arith _) rd _ _ -> (mem, put rd res)
-    IType (Load size sign) rd _ _ -> (mem, put rd (loadExtend size sign inputWord))
+    IType (Load size sign) rd _ _ ->
+      (mem, put rd (loadExtend size sign inputWord))
     SType {} -> (mem, rf)
     BType {} -> (mem, rf)
     JType rd _ -> (mem, put rd res)
@@ -73,17 +83,17 @@ flushWbStage ir res inputWord (mem, rf) =
 
 -- | Apply the pending effect of the memory-stage instruction.
 --
--- The two jump cases write @rd@, matching 'flushWbStage': an instruction in the
--- memory stage this cycle is in the writeback stage the next one, so its pending
--- effect has to be counted the same way in both.
-flushMeStage ::
+-- The two jump cases write @rd@, matching 'applyWbStage': an instruction in the
+-- memory stage this cycle is in the writeback stage the next one, so its
+-- pending effect has to be counted the same way in both.
+applyMeStage ::
   (RegFileOps r, MemOps m) =>
   Instruction ->
   Word ->
   Address ->
   (m, r) ->
   (m, r)
-flushMeStage ir res addr (mem, rf) =
+applyMeStage ir res addr (mem, rf) =
   case ir of
     RType _ rd _ _ -> (mem, put rd res)
     IType (Arith _) rd _ _ -> (mem, put rd res)
@@ -120,7 +130,9 @@ inv isa sys = P.any holds (invCases isa sys)
 --
 -- Built from the named cases ('invCasesAt'), for the tests; the proofs use the
 -- fold-free 'invAt', which the tests check agrees with it.
-invAtList :: (RegFileOps r, MemOps m) => RegIdx -> Address -> IsaStateG r m -> SysG r m -> Bool
+invAtList ::
+  (RegFileOps r, MemOps m) =>
+  RegIdx -> Address -> IsaStateG r m -> SysG r m -> Bool
 invAtList wr wa isa sys = P.any holds (invCasesAt wr wa isa sys)
 
 -- | Human-readable account of why the invariant failed: for each case, the
@@ -128,7 +140,10 @@ invAtList wr wa isa sys = P.any holds (invCasesAt wr wa isa sys)
 explain :: IsaState -> Sys -> String
 explain isa sys =
   unlines
-    [ "  case " P.++ caseName c P.++ ": failed " P.++ show (P.map fst (P.filter (P.not . snd) (caseConjuncts c)))
+    [ "  case "
+        P.++ caseName c
+        P.++ ": failed "
+        P.++ show (P.map fst (P.filter (P.not . snd) (caseConjuncts c)))
       | c <- invCases isa sys
     ]
 
@@ -148,9 +163,9 @@ invCasesAt wr wa =
 -- | The cases of the invariant, parameterised over how register files and
 -- memories are compared.
 --
--- No case constrains @stateCtrl@. The control lines carry no information between
--- cycles: 'Core.pipe' resets them at the start of each cycle, before any stage
--- reads them.
+-- No case constrains @stateCtrl@. The control lines carry no information
+-- between cycles: 'Core.pipe' resets them at the start of each cycle, before
+-- any stage reads them.
 invCasesGen ::
   (RegFileOps r, MemOps m) =>
   (r -> r -> Bool) ->
@@ -186,19 +201,30 @@ invCasesGen eqRF eqMem (IsaState ipc irf imem) (Sys core inp mem) =
       Case "running" $
         [ ("running", stateHalt core == Nothing),
           ("memory answered", isJust (inputMem inp)),
-          ("wb is not an env instruction", P.not (isEnvInstr (stateWbInstr core))),
-          ("me is not an env instruction", P.not (isEnvInstr (stateMeInstr core))),
+          ( "wb is not an env instruction",
+            P.not (isEnvInstr (stateWbInstr core))
+          ),
+          ( "me is not an env instruction",
+            P.not (isEnvInstr (stateMeInstr core))
+          ),
           ("exPc == isaPc", stateExPc core == ipc),
           ("ex == decode (mem[isaPc])", stateExInstr core == isaInstr),
           ("dePc == exPc + 4", stateDePc core == stateExPc core + 4),
-          ("no load-use hazard me->ex", P.not (loadHazard (stateExInstr core) (stateMeInstr core))),
-          ( "(isaMem, isaRegFile) == flush",
+          ( "no load-use hazard me->ex",
+            P.not (loadHazard (stateExInstr core) (stateMeInstr core))
+          ),
+          ( "(isaMem, isaRegFile) == pending writes applied",
             let (fm, frf) =
-                  flushMeStage
+                  applyMeStage
                     (stateMeInstr core)
                     (stateMeRes core)
                     (stateMeAddr core)
-                    (flushWbStage (stateWbInstr core) (stateWbRes core) inputWord (mem, stateRegFile core))
+                    ( applyWbStage
+                        (stateWbInstr core)
+                        (stateWbRes core)
+                        inputWord
+                        (mem, stateRegFile core)
+                    )
              in eqMem imem fm && eqRF irf frf
           )
         ]
@@ -213,10 +239,11 @@ invCasesGen eqRF eqMem (IsaState ipc irf imem) (Sys core inp mem) =
                 ("fePc == exPc + 8", stateFePc core == stateExPc core + 8)
               ]
 
-    -- The halt carries the address the core would resume at, which 'Core.execute'
-    -- set from the trapping instruction's own PC. Pinning it to @isaPc + 4@ is
-    -- what fixes @isaPc@ as that instruction's address; "Core.ISA" leaves
-    -- the architectural state where it was, so the ISA is still \"at\" the trap.
+    -- The halt carries the address the core would resume at, which
+    -- 'Core.execute' set from the trapping instruction's own PC. Pinning it to
+    -- @isaPc + 4@ is what fixes @isaPc@ as that instruction's address;
+    -- "Core.ISA" leaves the architectural state where it was, so the ISA is
+    -- still \"at\" the trap.
     haltedCase name isKind expected =
       Case
         name
@@ -264,7 +291,9 @@ runningCaseAt wr wa (IsaState ipc irf imem) (Sys core inp mem) =
     && stateDePc core == stateExPc core + 4
     && not (loadHazard (stateExInstr core) (stateMeInstr core))
     && ( if isMemInstr (stateWbInstr core)
-           then not (stateDeExpInstr core) && stateFePc core == stateExPc core + 4
+           then
+             not (stateDeExpInstr core)
+               && stateFePc core == stateExPc core + 4
            else
              stateDeExpInstr core
                && inputMem inp == Just (memReadWord (stateDePc core) mem)
@@ -273,17 +302,16 @@ runningCaseAt wr wa (IsaState ipc irf imem) (Sys core inp mem) =
     && memReadByte wa imem == memReadByte wa fm
     && lookupRFg wr irf == lookupRFg wr frf
   where
-    -- The same flush the container form applies, read at the witness. Writing
-    -- it out pointwise by hand would duplicate 'flushMeStage' and 'memWrite'
-    -- for no gain: 'Proof.Core.Functional.Obligation.isaAt' already puts this flush
-    -- into every query, and the solver rewrites @select@ over a @store@ chain
-    -- natively.
+    -- The pending writes the container form applies, read at the witness.
+    -- Writing it out pointwise by hand would duplicate 'applyMeStage' and
+    -- 'memWrite' for no gain: 'isaOf' already puts them into every query, and
+    -- the solver rewrites @select@ over a @store@ chain natively.
     (fm, frf) =
-      flushMeStage
+      applyMeStage
         (stateMeInstr core)
         (stateMeRes core)
         (stateMeAddr core)
-        ( flushWbStage
+        ( applyWbStage
             (stateWbInstr core)
             (stateWbRes core)
             (fromMaybe 0 (inputMem inp))
@@ -310,3 +338,120 @@ haltedCaseAt kind wr wa (IsaState ipc irf imem) (Sys core inp mem) =
     expected = case kind of
       HaltBreak -> EBreak (ipc + 4)
       HaltCall -> Syscall (ipc + 4)
+
+-- The architectural state, and properties of the invariant --------------------
+
+-- | The architectural state that the invariant claims @sys@ corresponds to:
+-- its PC, register file and memory ('archPc', 'archRegFile', 'archMem').
+--
+-- The containers are /derived/ from @sys@ ('archRegFile', 'archMem') rather
+-- than taken as further inputs. They have to be: the invariant compares them
+-- pointwise, at one witness register and one witness byte, so a freely
+-- quantified register file and memory would be tied to @sys@ only at those two
+-- points. 'Core.ISA.isaStep' reads memory at @isaPc@ and registers at
+-- @rs1@/@rs2@, which are elsewhere, so the solver could pick an architectural
+-- state whose instruction at @isaPc@ bears no relation to the one the core is
+-- executing. Deriving them makes the container equalities hold by construction,
+-- and what is left in the premise is the scalar conjuncts, assumed in full.
+--
+-- @isaPc@ is derived as well. The invariant pins it via a different conjunct
+-- in each case -- @stateExPc@ when running and @stateHalt@ once halted -- and
+-- 'archPc' splits on the case accordingly, so deriving it makes neither case
+-- unsatisfiable as a premise.
+isaOf :: (RegFileOps r, MemOps m) => SysG r m -> IsaStateG r m
+isaOf sys =
+  IsaState
+    { isaPc = archPc sys,
+      isaRegFile = archRegFile sys,
+      isaMem = archMem sys
+    }
+
+-- | The system is one the invariant covers: it is related to its own
+-- architectural state ('isaOf'), at register @wr@ and byte @wa@.
+sysInvAt :: (RegFileOps r, MemOps m) => RegIdx -> Address -> SysG r m -> Bool
+sysInvAt wr wa sys = invAt wr wa (isaOf sys) sys
+
+-- | The PC the core stands for: the execute stage's while running; once halted,
+-- the trapping instruction's, which is the resume address the halt carries
+-- minus 4.
+archPc :: SysG r m -> Address
+archPc (Sys core _ _) = case Core.stateHalt core of
+  Nothing -> Core.stateExPc core
+  Just (EBreak resume) -> resume - 4
+  Just (Syscall resume) -> resume - 4
+
+-- | The register file the core stands for: its own, with the writes still in
+-- the pipeline (the memory and writeback stages) applied.
+archRegFile :: (RegFileOps r, MemOps m) => SysG r m -> r
+archRegFile = snd . archMemRegFile
+
+-- | The memory the core stands for: its own, with the stores still in the
+-- pipeline (the memory and writeback stages) applied.
+archMem :: (RegFileOps r, MemOps m) => SysG r m -> m
+archMem = fst . archMemRegFile
+
+-- | The pipeline's pending writes applied to memory and the register file.
+archMemRegFile :: (RegFileOps r, MemOps m) => SysG r m -> (m, r)
+archMemRegFile (Sys core inp mem) =
+  applyMeStage
+    (Core.stateMeInstr core)
+    (Core.stateMeRes core)
+    (Core.stateMeAddr core)
+    ( applyWbStage
+        (Core.stateWbInstr core)
+        (Core.stateWbRes core)
+        (fromMaybe 0 (Core.inputMem inp))
+        (mem, Core.stateRegFile core)
+    )
+
+-- | The invariant relating the core to the ISA implies that the ISA's PC is
+-- the core's architectural one ('archPc').
+pcUnderInv ::
+  (RegFileOps r, MemOps m) =>
+  RegIdx -> Address -> IsaStateG r m -> SysG r m -> Bool
+pcUnderInv wr wa isa sys =
+  not premises || conclusion
+  where
+    premises = invAt wr wa isa sys
+
+    conclusion = isaPc isa == archPc sys
+
+-- | The invariant relating the core to the ISA implies that the ISA's register
+-- file is the core's architectural one ('archRegFile'), at register @wr@.
+regFileUnderInv ::
+  (RegFileOps r, MemOps m) =>
+  RegIdx -> Address -> IsaStateG r m -> SysG r m -> Bool
+regFileUnderInv wr wa isa sys =
+  not premises || conclusion
+  where
+    premises = invAt wr wa isa sys
+
+    conclusion = lookupRFg wr (isaRegFile isa) == lookupRFg wr (archRegFile sys)
+
+-- | The invariant relating the core to the ISA implies that the ISA's memory is
+-- the core's architectural one ('archMem'), at byte @wa@.
+memUnderInv ::
+  (RegFileOps r, MemOps m) =>
+  RegIdx -> Address -> IsaStateG r m -> SysG r m -> Bool
+memUnderInv wr wa isa sys =
+  not premises || conclusion
+  where
+    premises = invAt wr wa isa sys
+
+    conclusion = memReadByte wa (isaMem isa) == memReadByte wa (archMem sys)
+
+-- | The invariant is functional: two ISA states it relates to the same system
+-- are equal, at register @wr@ and byte @wa@. Quantifying over @wr@ and @wa@
+-- gives equality of the states.
+invFunctional ::
+  (RegFileOps r, MemOps m) =>
+  RegIdx -> Address -> IsaStateG r m -> IsaStateG r m -> SysG r m -> Bool
+invFunctional wr wa isa1 isa2 sys =
+  not premises || conclusion
+  where
+    premises = invAt wr wa isa1 sys && invAt wr wa isa2 sys
+
+    conclusion =
+      isaPc isa1 == isaPc isa2
+        && lookupRFg wr (isaRegFile isa1) == lookupRFg wr (isaRegFile isa2)
+        && memReadByte wa (isaMem isa1) == memReadByte wa (isaMem isa2)
diff --git a/proof/Proof/Core/Functional/Machine.hs b/proof/Proof/Core/Functional/Machine.hs
index 50bfa25..58ab3ba 100644
--- a/proof/Proof/Core/Functional/Machine.hs
+++ b/proof/Proof/Core/Functional/Machine.hs
@@ -13,16 +13,18 @@
 module Proof.Core.Functional.Machine
   ( SysG (..),
     Sys,
+    initSys,
     stepSys,
     stepSysOut,
   )
 where
 
 import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
-import Core
+import Core.Pipeline as Core
 import Memory.Types
 import Memory.Ideal (idealServe)
 import Core.RegFile
+import Types (Address)
 import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
 
 -- | Core state, the input it is about to consume, and memory.
@@ -44,6 +46,11 @@ instance (Eq r, Eq m) => Eq (SysG r m) where
       && inputMem i1 == inputMem i2
       && m1 == m2
 
+-- | The system at start: the core at start with PC @pc@ and register file @rf@
+-- ('Core.initAt'), its input at start ('Core.initInput'), and memory @mem@.
+initSys :: Address -> r -> m -> SysG r m
+initSys pc rf mem = Sys (Core.initAt pc rf) Core.initInput mem
+
 -- | One system step: run the pipeline for a cycle, then service whatever
 -- memory access it emitted. Mirrors 'Simulate.simulator', except that a halted
 -- core simply stops changing instead of ending the stream.
@@ -61,5 +68,5 @@ stepSys = fst . stepSysOut
 stepSysOut :: (RegFileOps r, MemOps m) => SysG r m -> (SysG r m, Output)
 stepSysOut (Sys core inp mem) =
   let (core', o) = Core.circuit core inp
-      (mem', inp') = idealServe mem (outMem o)
+      (mem', inp') = idealServe mem (outputMem o)
    in (Sys core' inp' mem', o)
diff --git a/proof/Proof/Core/Functional/Obligation.hs b/proof/Proof/Core/Functional/Obligation.hs
index 706f17b..df02844 100644
--- a/proof/Proof/Core/Functional/Obligation.hs
+++ b/proof/Proof/Core/Functional/Obligation.hs
@@ -1,17 +1,12 @@
 -- | The proof obligations, in one place.
 --
--- Both the symbolic properties ("Proof.Core.Functional.Solver") and the QuickCheck harness
--- ("ProofSpec") go through these definitions, so the two cannot drift apart.
--- The only thing they are allowed to differ in is how the system state is
--- built: symbolic scalars on one side, a generator on the other. That is the
--- input space, not the property.
+-- Both the symbolic properties ("Proof.Core.Functional.Solver") and the
+-- QuickCheck harness ("ProofSpec") go through these definitions, so the two
+-- cannot drift apart. The only thing they are allowed to differ in is how the
+-- system state is built: symbolic scalars on one side, a generator on the
+-- other. That is the input space, not the property.
 module Proof.Core.Functional.Obligation
-  ( isaAt,
-    flushedRegFile,
-    flushedMem,
-    regFileUnderInv,
-    memUnderInv,
-    baseCase,
+  ( baseCase,
     indStep0,
     indStep1,
     indStep2,
@@ -20,8 +15,6 @@ module Proof.Core.Functional.Obligation
 where
 
 import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
-import Data.Maybe (fromMaybe)
-import qualified Core
 import Proof.Core.Functional.Driver (driver)
 import Core.ISA (IsaStateG (..), StepG (..), isaStep)
 import Proof.Core.Functional.Invariant
@@ -31,64 +24,7 @@ import Core.RegFile
 import Types
 import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
 
--- | The architectural register file and memory that the invariant claims @sys@
--- corresponds to, at an architectural PC supplied by the caller.
---
--- The containers are /derived/ from @sys@ by the flush rather than taken as
--- further inputs. They have to be: the invariant compares them pointwise, at one
--- witness register and one witness byte, so a freely quantified register file
--- and memory would be tied to @sys@ only at those two points. 'Core.ISA.isaStep'
--- reads memory at @isaPc@ and registers at @rs1@/@rs2@, which are elsewhere, so
--- the solver could pick an architectural state whose instruction at @isaPc@
--- bears no relation to the one the core is executing. Deriving them makes the
--- container equalities hold by construction, and what is left in the premise is
--- the scalar conjuncts, assumed in full.
---
--- @isaPc@ is different, and is quantified rather than derived. It is a scalar,
--- so the invariant pins it exactly -- but via a different conjunct in each case:
--- @stateExPc@ when running and @stateHalt@ once halted. Deriving it from either
--- one would make the other case unsatisfiable as a premise.
-isaAt :: (RegFileOps r, MemOps m) => Address -> SysG r m -> IsaStateG r m
-isaAt ipc sys =
-  IsaState {isaPc = ipc, isaRegFile = flushedRegFile sys, isaMem = flushedMem sys}
-
--- | The register file the core stands for: its own, with the writes still in
--- the pipeline (the memory and writeback stages) applied.
-flushedRegFile :: (RegFileOps r, MemOps m) => SysG r m -> r
-flushedRegFile = snd . flushed
-
--- | The memory the core stands for: its own, with the stores still in the
--- pipeline (the memory and writeback stages) applied.
-flushedMem :: (RegFileOps r, MemOps m) => SysG r m -> m
-flushedMem = fst . flushed
-
--- | The pipeline's pending writes applied to memory and the register file.
-flushed :: (RegFileOps r, MemOps m) => SysG r m -> (m, r)
-flushed (Sys core inp mem) =
-  flushMeStage
-    (Core.stateMeInstr core)
-    (Core.stateMeRes core)
-    (Core.stateMeAddr core)
-    ( flushWbStage
-        (Core.stateWbInstr core)
-        (Core.stateWbRes core)
-        (fromMaybe 0 (Core.inputMem inp))
-        (mem, Core.stateRegFile core)
-    )
-
--- | The invariant relating the core to the ISA implies that the ISA's register
--- file is the core's, flushed ('flushedRegFile'), at register @wr@.
-regFileUnderInv :: (RegFileOps r, MemOps m) => RegIdx -> Address -> IsaStateG r m -> SysG r m -> Bool
-regFileUnderInv wr wa isa sys =
-  not (invAt wr wa isa sys)
-    || lookupRFg wr (isaRegFile isa) == lookupRFg wr (flushedRegFile sys)
-
--- | The invariant relating the core to the ISA implies that the ISA's memory is
--- the core's, flushed ('flushedMem'), at byte @wa@.
-memUnderInv :: (RegFileOps r, MemOps m) => RegIdx -> Address -> IsaStateG r m -> SysG r m -> Bool
-memUnderInv wr wa isa sys =
-  not (invAt wr wa isa sys)
-    || memReadByte wa (isaMem isa) == memReadByte wa (flushedMem sys)
+-- The base case ----------------------------------------------------------------
 
 -- | The base case: the invariant holds once the initial state has taken its
 -- first hop.
@@ -98,17 +34,17 @@ memUnderInv wr wa isa sys =
 -- the invariant relates the core to the ISA at every state the driver lands on
 -- after the start.
 --
--- The initial state itself is not a case of the invariant. 'Core.init' has
--- nothing in the pipeline, so the driver gives it a two-cycle hop that fetches
--- and decodes the first instruction without executing anything. This property
--- states that hop directly: the driver does assign it two cycles, and after
--- them the running case relates the core to the ISA's /initial/ state -- zero
--- ISA steps. Handling it here rather than as a case of the invariant is what
--- lets every inductive step retire exactly one instruction.
+-- The initial state itself is not a case of the invariant. 'Core.Pipeline.init'
+-- has nothing in the pipeline, so the driver gives it a two-cycle hop that
+-- fetches and decodes the first instruction without executing anything. This
+-- property states that hop directly: the driver does assign it two cycles, and
+-- after them the running case relates the core to the ISA's /initial/ state --
+-- zero ISA steps. Handling it here rather than as a case of the invariant is
+-- what lets every inductive step retire exactly one instruction.
 --
 -- The start PC, the register file and memory are parameters, used for both the
--- core and the ISA; every other field comes from 'Core.init' itself, so the
--- initial pipeline shape cannot drift from the real one. Taking them as
+-- core and the ISA; every other field comes from 'Core.Pipeline.init' itself,
+-- so the initial pipeline shape cannot drift from the real one. Taking them as
 -- parameters makes the base case cover any loaded program and any initial PC
 -- and register contents, such as the ELF entry point and stack pointer the ELF
 -- runners start the core with.
@@ -117,28 +53,28 @@ memUnderInv wr wa isa sys =
 -- values on both sides, and the first hop writes neither, so the invariant's
 -- two container equalities hold by construction here and this property alone
 -- would not notice if the core's initial register file and the ISA's
--- ('Core.RegFile.initRF') disagreed. The concrete test in "ProofSpec" closes that
--- gap -- it runs on the real 'Vec'-backed state, where both files are built
--- independently.
+-- ('Core.RegFile.initRF') disagreed. The concrete test in "ProofSpec" closes
+-- that gap -- it runs on the real 'Vec'-backed state, where both files are
+-- built independently.
 baseCase ::
   (RegFileOps r, MemOps m) => RegIdx -> Address -> Address -> r -> m -> Bool
 baseCase wr wa pc rf mem =
-  driver sys == 1 && invAt wr wa isa sys2
+  driver sys == 1 && invAt wr wa isa sys'
   where
     isa = IsaState {isaPc = pc, isaRegFile = rf, isaMem = mem}
-    sys = Sys (Core.initAt pc rf) Core.initInput mem
+    sys = initSys pc rf mem
+    sys' = stepSysN 1 sys
 
-    sys1 = stepSys sys
-    sys2 = stepSys sys1
+-- The inductive steps ----------------------------------------------------------
 
 -- | The @k = 0@ inductive step: the driver's one-cycle hop.
 --
 -- > inv(a, c) /\ driver(c) = 0  ==>  inv(isaStep(a), stepSys(c))
 --
--- There is no side condition about aliasing stores: 'Core.decode' detects a
--- store overlapping the instruction word being decoded and stalls, so a store
--- that rewrites an instruction in flight is handled by the core rather than
--- assumed away here.
+-- There is no side condition about aliasing stores: 'Core.Pipeline.decode'
+-- detects a store overlapping the instruction word being decoded and stalls, so
+-- a store that rewrites an instruction in flight is handled by the core rather
+-- than assumed away here.
 --
 -- @driver == 0@ covers two shapes: a running state whose hop retires one
 -- instruction, and a halted one. The @IsaHalted@ branch is what says the halted
@@ -146,11 +82,11 @@ baseCase wr wa pc rf mem =
 -- architectural register file and memory to equal the core's, so carrying the
 -- same @isa@ across the step asserts that neither changed.
 indStep0 ::
-  (RegFileOps r, MemOps m) => RegIdx -> Address -> Address -> SysG r m -> Bool
-indStep0 wr wa ipc sys =
+  (RegFileOps r, MemOps m) => RegIdx -> Address -> SysG r m -> Bool
+indStep0 wr wa sys =
   not premises || conclusion
   where
-    isa = isaAt ipc sys
+    isa = isaOf sys
     isa' = case isaStep isa of
       Next next -> next
       IsaHalted -> isa
@@ -169,23 +105,22 @@ indStep0 wr wa ipc sys =
 -- covers it: the invariant does not admit the reset state, and
 -- 'Proof.Core.Functional.Solver.baseCase' states that hop directly.
 indStep1 ::
-  (RegFileOps r, MemOps m) => RegIdx -> Address -> Address -> SysG r m -> Bool
-indStep1 wr wa ipc sys =
+  (RegFileOps r, MemOps m) => RegIdx -> Address -> SysG r m -> Bool
+indStep1 wr wa sys =
   not premises || conclusion
   where
-    isa = isaAt ipc sys
+    isa = isaOf sys
     isa' = case isaStep isa of
       Next next -> next
       IsaHalted -> isa
 
-    sys1 = stepSys sys
-    sys2 = stepSys sys1
+    sys' = stepSysN 1 sys
 
     premises =
       invAt wr wa isa sys
         && driver sys == 1
 
-    conclusion = invAt wr wa isa' sys2
+    conclusion = invAt wr wa isa' sys'
 
 -- | The @k = 2@ inductive step: the driver's three-cycle hop.
 --
@@ -193,24 +128,22 @@ indStep1 wr wa ipc sys =
 -- The architectural state then stays at the trapping instruction while the
 -- core reaches one of the two halted invariant cases.
 indStep2 ::
-  (RegFileOps r, MemOps m) => RegIdx -> Address -> Address -> SysG r m -> Bool
-indStep2 wr wa ipc sys =
+  (RegFileOps r, MemOps m) => RegIdx -> Address -> SysG r m -> Bool
+indStep2 wr wa sys =
   not premises || conclusion
   where
-    isa = isaAt ipc sys
+    isa = isaOf sys
     isa' = case isaStep isa of
       Next next -> next
       IsaHalted -> isa
 
-    sys1 = stepSys sys
-    sys2 = stepSys sys1
-    sys3 = stepSys sys2
+    sys' = stepSysN 2 sys
 
     premises =
       invAt wr wa isa sys
         && driver sys == 2
 
-    conclusion = invAt wr wa isa' sys3
+    conclusion = invAt wr wa isa' sys'
 
 -- | The @k = 3@ inductive step: the driver's four-cycle hop, the longest.
 --
@@ -220,22 +153,29 @@ indStep2 wr wa ipc sys =
 -- covering it costs nothing and assuming it away would be an unchecked side
 -- argument.
 indStep3 ::
-  (RegFileOps r, MemOps m) => RegIdx -> Address -> Address -> SysG r m -> Bool
-indStep3 wr wa ipc sys =
+  (RegFileOps r, MemOps m) => RegIdx -> Address -> SysG r m -> Bool
+indStep3 wr wa sys =
   not premises || conclusion
   where
-    isa = isaAt ipc sys
+    isa = isaOf sys
     isa' = case isaStep isa of
       Next next -> next
       IsaHalted -> isa
 
-    sys1 = stepSys sys
-    sys2 = stepSys sys1
-    sys3 = stepSys sys2
-    sys4 = stepSys sys3
+    sys' = stepSysN 3 sys
 
     premises =
       invAt wr wa isa sys
         && driver sys == 3
 
-    conclusion = invAt wr wa isa' sys4
+    conclusion = invAt wr wa isa' sys'
+
+-- Helpers ----------------------------------------------------------------------
+
+-- | A hop of the system: @n + 1@ steps, the cycle the hop starts with and the
+-- @n@ cycles the driver counts after it. Recursive on @n@, which each step
+-- fixes to a literal.
+stepSysN :: (RegFileOps r, MemOps m) => Int -> SysG r m -> SysG r m
+stepSysN n sys
+  | n == 0 = stepSys sys
+  | otherwise = stepSysN (n - 1) (stepSys sys)
diff --git a/proof/Proof/Core/Functional/Solver.hs b/proof/Proof/Core/Functional/Solver.hs
index 9f2f7ca..70b9774 100644
--- a/proof/Proof/Core/Functional/Solver.hs
+++ b/proof/Proof/Core/Functional/Solver.hs
@@ -1,11 +1,11 @@
 -- | The inductive steps of the refinement proof, checked symbolically.
 --
 -- 'baseCase' says the invariant holds once the reset state has taken its first
--- hop. Then one property per driver
--- delay: if the invariant relates @(isa, sys)@ and the driver says the hop takes
--- @k + 1@ cycles, then after those cycles (and one ISA step, where the hop
--- retires an instruction) the invariant relates them again. Base case plus the
--- four steps is the whole refinement theorem.
+-- hop. Then one property per driver delay: if the invariant relates @(isa,
+-- sys)@ and the driver says the hop takes @k + 1@ cycles, then after those
+-- cycles (and one ISA step, where the hop retires an instruction) the invariant
+-- relates them again. Base case plus the four steps is the whole refinement
+-- theorem.
 --
 -- Checking one @k@ at a time keeps the number of unrolled cycles concrete,
 -- which sidesteps Pantomime's termination check: @stepSysN (driver sys + 1)@
@@ -13,33 +13,51 @@
 --
 -- Each property is checked by the plugin at compile time and spliced into
 -- 'results': 'Nothing' when valid, @'Just' counterexample@ when not. The
--- statements themselves live in "Proof.Core.Functional.Obligation", shared with the QuickCheck
--- harness so the two cannot drift.
+-- statements themselves live in "Proof.Core.Functional.Obligation", shared with
+-- the QuickCheck harness so the two cannot drift.
 --
 -- The pipeline state is passed as a 'KState' plus SMT-array register file and
 -- memory; see "Proof.Core.Functional.System".
 module Proof.Core.Functional.Solver
   ( arrRoundTripP,
     shiftsSaneP,
+    driverMatchesSpecP,
+    driverMatchesSpecInitP,
+    driverValuesP,
     baseCaseP,
     indStep0P,
     indStep1P,
     indStep2P,
     indStep3P,
+    pcUnderInvP,
     regFileUnderInvP,
     memUnderInvP,
+    invFunctionalP,
     results,
   )
 where
 
 import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
-import qualified Core
+import qualified Core.Alu
+import qualified Core.Pipeline as Core
 import Core.ISA (IsaStateG (..))
 import Pantomime (Theory (..))
 import qualified Pantomime.BuiltIn as Pantomime
+import Proof.Core.Functional.Driver
+  ( driverMatchesSpec,
+    driverMatchesSpecInit,
+    driverValues,
+  )
+import Proof.Core.Functional.Invariant
+  ( invFunctional,
+    memUnderInv,
+    pcUnderInv,
+    regFileUnderInv,
+  )
 import Proof.Core.Functional.Obligation
+import Proof.Core.SMT.Array
 import Proof.SMT.Array
-import Proof.SMT.Axioms (arrayAxioms)
+import Proof.Core.SMT.Axioms (arrayAxioms)
 import Proof.SMT.Logged (pantomime)
 import Proof.Core.Functional.System
 import Types
@@ -47,9 +65,9 @@ import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&
 
 -- Sanity probes for the trusted embeddings -------------------------------------
 --
--- The term axioms in "Proof.SMT.Axioms" replace Haskell functions by hand-written SMT
--- counterparts, so they are trusted, not proved. These two probes check each
--- embedding against facts a broken one would get wrong.
+-- The term axioms in "Proof.SMT.Axioms" replace Haskell functions by
+-- hand-written SMT counterparts, so they are trusted, not proved. These two
+-- probes check each embedding against facts a broken one would get wrong.
 
 -- | The register-file array embedding: a read after a write at the same index
 -- gives the written value.
@@ -64,15 +82,96 @@ arrRoundTripP a i v = Pantomime.boolean $ loadRA (storeRA a i v) i == v
 shiftsSaneP :: Word -> Pantomime.Bool
 shiftsSaneP x =
   Pantomime.boolean $
-    Core.sllWord x 0 == x
-      && Core.srlWord x 0 == x
-      && Core.sraWord x 0 == x
-      && Core.sllWord x 1 == x + x
-      && Core.srlWord x 31 == (if sign == 1 then 1 else 0)
-      && Core.sraWord x 31 == (if sign == 1 then 0xFFFFFFFF else 0)
+    Core.Alu.sllWord x 0 == x
+      && Core.Alu.srlWord x 0 == x
+      && Core.Alu.sraWord x 0 == x
+      && Core.Alu.sllWord x 1 == x + x
+      && Core.Alu.srlWord x 31 == (if sign == 1 then 1 else 0)
+      && Core.Alu.sraWord x 31 == (if sign == 1 then 0xFFFFFFFF else 0)
   where
     sign = slice d31 d31 x
 
+-- The driver -------------------------------------------------------------------
+
+-- | The driver is 0 to 3, on any system.
+{-# ANN driverValuesP (Theory arrayAxioms) #-}
+driverValuesP :: KState -> Core.Input -> RegArr -> MemArr -> Pantomime.Bool
+driverValuesP ss i ra ma =
+  Pantomime.boolean $ driverValues (sysOf ss i ra ma)
+
+-- | On states the invariant relates to a free ISA state, the driver agrees
+-- with its operational reading.
+{-# ANN driverMatchesSpecP (Theory arrayAxioms) #-}
+driverMatchesSpecP ::
+  RegIdx -> Address -> Address -> RegArr -> MemArr ->
+  KState -> Core.Input -> RegArr -> MemArr ->
+  Pantomime.Bool
+driverMatchesSpecP wr wa ipc ira ima ss i ra ma =
+  Pantomime.boolean $
+    driverMatchesSpec wr wa (IsaState ipc (RegArrF ira) ima) (sysOf ss i ra ma)
+
+-- | On the initial system, the driver agrees with its operational reading, for
+-- any start PC, register file and memory.
+{-# ANN driverMatchesSpecInitP (Theory arrayAxioms) #-}
+driverMatchesSpecInitP :: Address -> RegArr -> MemArr -> Pantomime.Bool
+driverMatchesSpecInitP pc ra ma =
+  Pantomime.boolean $ driverMatchesSpecInit pc (RegArrF ra) ma
+
+-- The invariant and the architectural state -------------------------------------
+
+-- | The invariant relating the core to the ISA implies that the ISA's PC is
+-- the core's architectural one. The ISA state is free, not derived from the
+-- core.
+{-# ANN pcUnderInvP (Theory arrayAxioms) #-}
+pcUnderInvP ::
+  RegIdx -> Address -> Address -> RegArr -> MemArr ->
+  KState -> Core.Input -> RegArr -> MemArr ->
+  Pantomime.Bool
+pcUnderInvP wr wa ipc ira ima ss i ra ma =
+  Pantomime.boolean $
+    pcUnderInv wr wa (IsaState ipc (RegArrF ira) ima) (sysOf ss i ra ma)
+
+-- | The invariant relating the core to the ISA implies that the ISA's register
+-- file is the core's architectural one. The ISA state is free, not derived from
+-- the core.
+{-# ANN regFileUnderInvP (Theory arrayAxioms) #-}
+regFileUnderInvP ::
+  RegIdx -> Address -> Address -> RegArr -> MemArr ->
+  KState -> Core.Input -> RegArr -> MemArr ->
+  Pantomime.Bool
+regFileUnderInvP wr wa ipc ira ima ss i ra ma =
+  Pantomime.boolean $
+    regFileUnderInv wr wa (IsaState ipc (RegArrF ira) ima) (sysOf ss i ra ma)
+
+-- | The invariant relating the core to the ISA implies that the ISA's memory is
+-- the core's architectural one.
+{-# ANN memUnderInvP (Theory arrayAxioms) #-}
+memUnderInvP ::
+  RegIdx -> Address -> Address -> RegArr -> MemArr ->
+  KState -> Core.Input -> RegArr -> MemArr ->
+  Pantomime.Bool
+memUnderInvP wr wa ipc ira ima ss i ra ma =
+  Pantomime.boolean $
+    memUnderInv wr wa (IsaState ipc (RegArrF ira) ima) (sysOf ss i ra ma)
+
+-- | The invariant is functional: two ISA states, both free, related to the
+-- same system are equal.
+{-# ANN invFunctionalP (Theory arrayAxioms) #-}
+invFunctionalP ::
+  RegIdx -> Address ->
+  Address -> RegArr -> MemArr ->
+  Address -> RegArr -> MemArr ->
+  KState -> Core.Input -> RegArr -> MemArr ->
+  Pantomime.Bool
+invFunctionalP wr wa ipc1 ira1 ima1 ipc2 ira2 ima2 ss i ra ma =
+  Pantomime.boolean $
+    invFunctional
+      wr
+      wa
+      (IsaState ipc1 (RegArrF ira1) ima1)
+      (IsaState ipc2 (RegArrF ira2) ima2)
+      (sysOf ss i ra ma)
+
 -- The base case ----------------------------------------------------------------
 
 {-# ANN baseCaseP (Theory arrayAxioms) #-}
@@ -84,58 +183,53 @@ baseCaseP wr wa pc ra ma =
 
 -- | @k = 0@: the one-cycle hop (steady, writeback non-memory).
 {-# ANN indStep0P (Theory arrayAxioms) #-}
-indStep0P :: RegIdx -> Address -> Address -> KState -> Core.Input -> RegArr -> MemArr -> Pantomime.Bool
-indStep0P wr wa ipc ss i ra ma =
-  Pantomime.boolean $ indStep0 wr wa ipc (sysOf ss i ra ma)
+indStep0P ::
+  RegIdx -> Address -> KState -> Core.Input -> RegArr -> MemArr ->
+  Pantomime.Bool
+indStep0P wr wa ss i ra ma =
+  Pantomime.boolean $ indStep0 wr wa (sysOf ss i ra ma)
 
 -- | @k = 1@: the two-cycle hop (a memory instruction in writeback).
 {-# ANN indStep1P (Theory arrayAxioms) #-}
-indStep1P :: RegIdx -> Address -> Address -> KState -> Core.Input -> RegArr -> MemArr -> Pantomime.Bool
-indStep1P wr wa ipc ss i ra ma =
-  Pantomime.boolean $ indStep1 wr wa ipc (sysOf ss i ra ma)
+indStep1P ::
+  RegIdx -> Address -> KState -> Core.Input -> RegArr -> MemArr ->
+  Pantomime.Bool
+indStep1P wr wa ss i ra ma =
+  Pantomime.boolean $ indStep1 wr wa (sysOf ss i ra ma)
 
 -- | @k = 2@: the three-cycle hop (environment, taken jump, store hazard with a
 -- non-memory execute instruction, or memory instructions in both older stages).
 -- The hop on which the ISA enters a halt; a halted state then sits at k = 0.
 {-# ANN indStep2P (Theory arrayAxioms) #-}
-indStep2P :: RegIdx -> Address -> Address -> KState -> Core.Input -> RegArr -> MemArr -> Pantomime.Bool
-indStep2P wr wa ipc ss i ra ma =
-  Pantomime.boolean $ indStep2 wr wa ipc (sysOf ss i ra ma)
+indStep2P ::
+  RegIdx -> Address -> KState -> Core.Input -> RegArr -> MemArr ->
+  Pantomime.Bool
+indStep2P wr wa ss i ra ma =
+  Pantomime.boolean $ indStep2 wr wa (sysOf ss i ra ma)
 
 -- | @k = 3@: the four-cycle hop (store hazard with a memory execute
 -- instruction, load hazard, or all three stages holding memory instructions).
 {-# ANN indStep3P (Theory arrayAxioms) #-}
-indStep3P :: RegIdx -> Address -> Address -> KState -> Core.Input -> RegArr -> MemArr -> Pantomime.Bool
-indStep3P wr wa ipc ss i ra ma =
-  Pantomime.boolean $ indStep3 wr wa ipc (sysOf ss i ra ma)
-
--- The invariant and the flush ---------------------------------------------------
-
--- | The invariant relating the core to the ISA implies that the ISA's register
--- file is the core's, flushed. The ISA state is free, not derived from the core.
-{-# ANN regFileUnderInvP (Theory arrayAxioms) #-}
-regFileUnderInvP ::
-  RegIdx -> Address -> Address -> RegArr -> MemArr -> KState -> Core.Input -> RegArr -> MemArr -> Pantomime.Bool
-regFileUnderInvP wr wa ipc ira ima ss i ra ma =
-  Pantomime.boolean $ regFileUnderInv wr wa (IsaState ipc (RegArrF ira) ima) (sysOf ss i ra ma)
-
--- | The invariant relating the core to the ISA implies that the ISA's memory is
--- the core's, flushed.
-{-# ANN memUnderInvP (Theory arrayAxioms) #-}
-memUnderInvP ::
-  RegIdx -> Address -> Address -> RegArr -> MemArr -> KState -> Core.Input -> RegArr -> MemArr -> Pantomime.Bool
-memUnderInvP wr wa ipc ira ima ss i ra ma =
-  Pantomime.boolean $ memUnderInv wr wa (IsaState ipc (RegArrF ira) ima) (sysOf ss i ra ma)
+indStep3P ::
+  RegIdx -> Address -> KState -> Core.Input -> RegArr -> MemArr ->
+  Pantomime.Bool
+indStep3P wr wa ss i ra ma =
+  Pantomime.boolean $ indStep3 wr wa (sysOf ss i ra ma)
 
 results :: [(String, Maybe String)]
 results =
   [ ("arrRoundTripP", $(pantomime 'arrRoundTripP)),
     ("shiftsSaneP", $(pantomime 'shiftsSaneP)),
+    ("driverMatchesSpecP", $(pantomime 'driverMatchesSpecP)),
+    ("driverMatchesSpecInitP", $(pantomime 'driverMatchesSpecInitP)),
+    ("driverValuesP", $(pantomime 'driverValuesP)),
     ("baseCaseP", $(pantomime 'baseCaseP)),
     ("indStep0P", $(pantomime 'indStep0P)),
     ("indStep1P", $(pantomime 'indStep1P)),
     ("indStep2P", $(pantomime 'indStep2P)),
     ("indStep3P", $(pantomime 'indStep3P)),
+    ("pcUnderInvP", $(pantomime 'pcUnderInvP)),
     ("regFileUnderInvP", $(pantomime 'regFileUnderInvP)),
-    ("memUnderInvP", $(pantomime 'memUnderInvP))
+    ("memUnderInvP", $(pantomime 'memUnderInvP)),
+    ("invFunctionalP", $(pantomime 'invFunctionalP))
   ]
diff --git a/proof/Proof/Core/Functional/System.hs b/proof/Proof/Core/Functional/System.hs
index 5d35ac7..2eed781 100644
--- a/proof/Proof/Core/Functional/System.hs
+++ b/proof/Proof/Core/Functional/System.hs
@@ -20,9 +20,10 @@ module Proof.Core.Functional.System
 where
 
 import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
-import qualified Core
+import qualified Core.Pipeline as Core
 import Core.Instruction (Instruction)
 import Proof.Core.Functional.Machine
+import Proof.Core.SMT.Array
 import Proof.SMT.Array
 import Types
 import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
diff --git a/proof/Proof/Core/Leakage/Driver.hs b/proof/Proof/Core/Leakage/Driver.hs
index e84a71d..7a9900f 100644
--- a/proof/Proof/Core/Leakage/Driver.hs
+++ b/proof/Proof/Core/Leakage/Driver.hs
@@ -1,9 +1,13 @@
 -- | The simulator's driver: how many cycles the simulator takes for an
 -- instruction, computed from its own state and the instruction's leakage. The
--- counterpart of 'Proof.Core.Functional.Driver.driver', case for case; the leakage
--- proof's first step is that the two agree.
+-- counterpart of 'Proof.Core.Functional.Driver.driver', case for case; the
+-- leakage proof's first step is that the two agree.
 module Proof.Core.Leakage.Driver
   ( simDriver,
+    simDriverSpec,
+    simDriverMatchesSpecInit,
+    simDriverMatchesSpec,
+    simIsBubble,
     simStoreHazard,
     simLoadHazard
   )
@@ -11,13 +15,19 @@ where
 
 import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
 import qualified Core.Instruction
+import Core.RegFile (RegFileOps)
+import Memory.Types (MemOps)
+import Proof.Core.Functional.Invariant (sysInvAt)
+import Proof.Core.Functional.Machine (SysG)
+import Proof.Core.Leakage.Invariant (simInv)
 import Proof.Core.Leakage.Model
 import Proof.Core.Leakage.Simulator
+import Types (Address, RegIdx)
 import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
 
--- | The store-hazard condition of 'Core.decode': the instruction word at the
--- decode-stage PC overlaps a store either in the execute stage or in the memory
--- stage.
+-- | The store-hazard condition of 'Core.Pipeline.decode': the instruction word
+-- at the decode-stage PC overlaps a store either in the execute stage or in the
+-- memory stage.
 simStoreHazard :: SimInput -> SimState -> Bool
 simStoreHazard inp st =
   maybe False (Core.Instruction.storeHazard dePc) exStore
@@ -31,8 +41,8 @@ simStoreHazard inp st =
       LStore size addr -> Just (addr, size)
       _ -> Nothing
 
--- | The load-hazard condition of 'Core.decode', computed by the ISA as part of
--- the leakage.
+-- | The load-hazard condition of 'Core.Pipeline.decode', computed by the ISA as
+-- part of the leakage.
 simLoadHazard :: SimInput -> SimState -> Bool
 simLoadHazard (Just (LLoad _ _ haz)) st = simStateDeExpInstr st && haz
 simLoadHazard _ _ = False
@@ -49,3 +59,57 @@ simDriver inp st
   | not (isMemLeak (simStateMeInstr st)) = 1
   | not (maybe False isMemLeak inp) = 2
   | otherwise = 3
+
+-- | Is the simulator's execute stage a pipeline bubble, as opposed to an
+-- instruction? The counterpart of 'Proof.Core.Functional.Driver.isBubble': a
+-- decoded instruction is not, and neither is a halted simulator; the stall
+-- reasons are.
+simIsBubble :: SimState -> Bool
+simIsBubble sim = case simStateExInstrType sim of
+  DecodedInstr -> False
+  Halted -> False
+  _ -> True
+
+-- | The operational reading of 'simDriver', as
+-- 'Proof.Core.Functional.Driver.driverSpec' is of the core's: step on the
+-- instruction's leakage, then with no input until the execute stage is no
+-- longer a bubble ('simIsBubble'), and count the steps after the first.
+-- 'Nothing' if @fuel@ ran out.
+simDriverSpec :: Int -> SimInput -> SimState -> Maybe Int
+simDriverSpec fuel inp sim0 = go 0 (fst (simCircuit sim0 inp))
+  where
+    go n sim
+      | not (simIsBubble sim) = Just n
+      | n >= fuel = Nothing
+      | otherwise = go (n + 1) (fst (simCircuit sim Nothing))
+
+-- | On the initial simulator its driver agrees with its operational reading:
+-- the first hop, from the start PC @pc@, which starts with no input
+-- ('simInit'). The invariant does not cover the initial simulator, so
+-- 'simDriverMatchesSpec' does not either.
+simDriverMatchesSpecInit :: Address -> Bool
+simDriverMatchesSpecInit pc =
+  simDriverSpec 3 Nothing sim == Just (simDriver Nothing sim)
+  where
+    sim = simInit {simStateFePc = pc}
+
+-- | On every other hop the simulator's driver agrees with its operational
+-- reading as well, as 'Proof.Core.Functional.Driver.driverMatchesSpec' for the
+-- core: the simulator is related to a system ('simInv') that the core's
+-- invariant covers ('Proof.Core.Functional.Invariant.sysInvAt'), and the input
+-- is the leakage of any instruction -- every hop but the first starts with one.
+-- The core's invariant is needed for the
+-- pipeline's shape: without it, the fetch and decode PCs, which 'simInv' copies
+-- from the core, are not related, and a store hazard between the input's store
+-- and the fetch PC would go unseen by the driver. Three cycles of fuel cover
+-- the longest hop.
+simDriverMatchesSpec ::
+  (RegFileOps r, MemOps m) =>
+  RegIdx -> Address -> Leak -> SimState -> SysG r m -> Bool
+simDriverMatchesSpec wr wa leak sim sys =
+  not premises || conclusion
+  where
+    premises = sysInvAt wr wa sys && simInv sim sys
+
+    conclusion =
+      simDriverSpec 3 (Just leak) sim == Just (simDriver (Just leak) sim)
diff --git a/proof/Proof/Core/Leakage/Invariant.hs b/proof/Proof/Core/Leakage/Invariant.hs
index 4740b21..70481a4 100644
--- a/proof/Proof/Core/Leakage/Invariant.hs
+++ b/proof/Proof/Core/Leakage/Invariant.hs
@@ -6,7 +6,7 @@ module Proof.Core.Leakage.Invariant
 where
 
 import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
-import Core
+import Core.Pipeline as Core
 import Data.Maybe (isJust, isNothing)
 import Core.Instruction hiding (Halted)
 import Proof.Core.Leakage.Model
diff --git a/proof/Proof/Core/Leakage/Model.hs b/proof/Proof/Core/Leakage/Model.hs
index e14c7fb..c1c7c3f 100644
--- a/proof/Proof/Core/Leakage/Model.hs
+++ b/proof/Proof/Core/Leakage/Model.hs
@@ -1,8 +1,8 @@
 -- | What an attacker sees, and what one architectural instruction leaks.
 --
--- The leakage proof ("Proof.Core.Leakage.Obligation") establishes that an attacker
--- watching the memory bus learns nothing beyond 'Leak'. Two definitions carry
--- that statement:
+-- The leakage proof ("Proof.Core.Leakage.Obligation") establishes that an
+-- attacker watching the memory bus learns nothing beyond 'Leak'. Two
+-- definitions carry that statement:
 --
 --   * 'obsOf' -- what the attacker sees in one cycle: the kind of access, its
 --     address, and for a data access its width.
@@ -43,7 +43,8 @@ module Proof.Core.Leakage.Model
 where
 
 import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
-import Core
+import Core.Alu (branch)
+import Core.Pipeline as Core
 import Core.Instruction
 import Core.ISA (IsaStateG (..), isaInstrAt)
 import Memory.Types (MemOps (..))
@@ -71,13 +72,9 @@ instance Monoid Obs where
 
 -- | The observation a cycle's 'Core.Output' produces: that of its request.
 obsOf :: Output -> Obs
-obsOf o = obsReq (outMem o)
+obsOf o = obsReq (outputMem o)
 
 -- | The observation of a request on the bus: the request without its data.
---
--- This is also what a cache in front of the core leaks about each request it
--- receives ("Proof.Cache.Server4K"), which is what lets the core's leakage proof
--- and the cache's compose.
 obsReq :: Request -> Obs
 obsReq req = case req of
   Nothing -> NoAccess
@@ -93,11 +90,11 @@ obsReq req = case req of
 -- instruction set:
 --
 --   * 'LArith' -- nothing beyond the fetch trace. No data access, and the next
---     fetch is @pc + 4@. Arithmetic, upper immediates, an untaken branch, and an
---     undecodable word all land here, and are indistinguishable.
+--     fetch is @pc + 4@. Arithmetic, upper immediates, an untaken branch, and
+--     an undecodable word all land here, and are indistinguishable.
 --   * 'LJump' -- control goes somewhere other than @pc + 4@, and the target is
---     the next fetch address. A taken branch, @jal@ and @jalr@ are one case: the
---     attacker sees an address, not which instruction produced it.
+--     the next fetch address. A taken branch, @jal@ and @jalr@ are one case:
+--     the attacker sees an address, not which instruction produced it.
 --   * 'LLoad' -- a data read of the given width at the given address, plus
 --     whether the instruction at @pc + 4@ has a load-use hazard against this
 --     load. That bit is the one thing here not already in the fetch trace: it
diff --git a/proof/Proof/Core/Leakage/Obligation.hs b/proof/Proof/Core/Leakage/Obligation.hs
index f527e81..ebc30b4 100644
--- a/proof/Proof/Core/Leakage/Obligation.hs
+++ b/proof/Proof/Core/Leakage/Obligation.hs
@@ -20,11 +20,9 @@ module Proof.Core.Leakage.Obligation
 where
 
 import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
-import Core
 import Memory.Types (MemOps (..))
 import Proof.Core.Functional.Driver
-import Proof.Core.Functional.Invariant (invAt)
-import Proof.Core.Functional.Obligation
+import Proof.Core.Functional.Invariant (invAt, isaOf)
 import Proof.Core.Leakage.Driver
 import Proof.Core.Leakage.Invariant
 import Proof.Core.Leakage.Model
@@ -34,6 +32,15 @@ import Core.RegFile
 import Types
 import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
 
+-- | The observations of a run, cycle by cycle: what the attacker sees over a
+-- hop. A type of its own, rather than a list, so that its equality is derived
+-- here and the solver can unroll it; the equality of lists comes from @base@,
+-- whose definitions the solver cannot see.
+data Trace = TraceSingle Obs | TraceCons Obs Trace
+  deriving (Show, Eq)
+
+-- The base case ----------------------------------------------------------------
+
 -- | The base case: from the initial state, the core and the simulator agree
 -- on the first hop.
 --
@@ -47,132 +54,143 @@ baseCaseLeak ::
   (RegFileOps r, MemOps m) => Address -> r -> m -> Bool
 baseCaseLeak pc rf mem =
   simDriver Nothing sim == 1
-    && obs1 == obsOf out1
-    && obs2 == obsOf out2
-    && simInv sim2 sys2
+    && tr1 == tr2
+    && simInv sim' sys'
   where
-    sys = Sys (Core.initAt pc rf) Core.initInput mem
+    sys = initSys pc rf mem
     sim = simInit {simStateFePc = pc}
 
-    (sys1, out1) = stepSysOut sys
-    (sim1, obs1) = simCircuit sim Nothing
+    (tr1, sys') = stepSysOutN 1 sys
+    (tr2, sim') = simCircuitN 1 sim Nothing
 
-    (sys2, out2) = stepSysOut sys1
-    (sim2, obs2) = simCircuit sim1 Nothing
+-- The inductive steps ----------------------------------------------------------
 
 -- | The @k = 0@ leakage step: the one-cycle hop.
 --
 -- > inv(isa, sys) /\ simInv(sim, sys) /\ driver(sys) = 0
--- >   ==>  simDriver(leak, sim) = 0 /\ obs(sim) = obs(sys) /\ simInv(sim', sys')
+-- >   ==>  simDriver(leak, sim) = 0 /\ obs(sim) = obs(sys)
+-- >          /\ simInv(sim', sys')
 --
 -- The simulator gets @leakOf isa@ on the hop's first cycle and nothing after.
 indStepLeak0 ::
-  (RegFileOps r, MemOps m) => RegIdx -> Address -> Address -> SysG r m -> SimState -> Bool
-indStepLeak0 wr wa ipc sys sim =
+  (RegFileOps r, MemOps m) => RegIdx -> Address -> SysG r m -> SimState -> Bool
+indStepLeak0 wr wa sys sim =
   not premises || conclusion
   where
-    isa = isaAt ipc sys
+    isa = isaOf sys
     leak = leakOf isa
 
-    (sys', out') = stepSysOut sys
-    (sim', obs') = simCircuit sim (Just leak)
+    hopLength = 0
+
+    (tr1, sys') = stepSysOutN hopLength sys
+    (tr2, sim') = simCircuitN hopLength sim (Just leak)
 
     premises =
       invAt wr wa isa sys
-        && driver sys == 0
         && simInv sim sys
+        && driver sys == hopLength
 
     conclusion =
-      simDriver (Just leak) sim == 0
-        && obs' == obsOf out'
+      simDriver (Just leak) sim == hopLength
+        && tr1 == tr2
         && simInv sim' sys'
 
 -- | The @k = 1@ leakage step: the two-cycle hop.
 indStepLeak1 ::
-  (RegFileOps r, MemOps m) => RegIdx -> Address -> Address -> SysG r m -> SimState -> Bool
-indStepLeak1 wr wa ipc sys sim =
+  (RegFileOps r, MemOps m) => RegIdx -> Address -> SysG r m -> SimState -> Bool
+indStepLeak1 wr wa sys sim =
   not premises || conclusion
   where
-    isa = isaAt ipc sys
+    isa = isaOf sys
     leak = leakOf isa
 
-    (sys1, out1) = stepSysOut sys
-    (sim1, obs1) = simCircuit sim (Just leak)
+    hopLength = 1
 
-    (sys2, out2) = stepSysOut sys1
-    (sim2, obs2) = simCircuit sim1 Nothing
+    (tr1, sys') = stepSysOutN hopLength sys
+    (tr2, sim') = simCircuitN hopLength sim (Just leak)
 
     premises =
       invAt wr wa isa sys
-        && driver sys == 1
         && simInv sim sys
+        && driver sys == hopLength
 
     conclusion =
-      simDriver (Just leak) sim == 1
-        && obs1 == obsOf out1
-        && obs2 == obsOf out2
-        && simInv sim2 sys2
+      simDriver (Just leak) sim == hopLength
+        && tr1 == tr2
+        && simInv sim' sys'
 
 -- | The @k = 2@ leakage step: the three-cycle hop.
 indStepLeak2 ::
-  (RegFileOps r, MemOps m) => RegIdx -> Address -> Address -> SysG r m -> SimState -> Bool
-indStepLeak2 wr wa ipc sys sim =
+  (RegFileOps r, MemOps m) => RegIdx -> Address -> SysG r m -> SimState -> Bool
+indStepLeak2 wr wa sys sim =
   not premises || conclusion
   where
-    isa = isaAt ipc sys
+    isa = isaOf sys
     leak = leakOf isa
 
-    (sys1, out1) = stepSysOut sys
-    (sim1, obs1) = simCircuit sim (Just leak)
-
-    (sys2, out2) = stepSysOut sys1
-    (sim2, obs2) = simCircuit sim1 Nothing
+    hopLength = 2
 
-    (sys3, out3) = stepSysOut sys2
-    (sim3, obs3) = simCircuit sim2 Nothing
+    (tr1, sys') = stepSysOutN hopLength sys
+    (tr2, sim') = simCircuitN hopLength sim (Just leak)
 
     premises =
       invAt wr wa isa sys
-        && driver sys == 2
         && simInv sim sys
+        && driver sys == hopLength
 
     conclusion =
-      simDriver (Just leak) sim == 2
-        && obs1 == obsOf out1
-        && obs2 == obsOf out2
-        && obs3 == obsOf out3
-        && simInv sim3 sys3
+      simDriver (Just leak) sim == hopLength
+        && tr1 == tr2
+        && simInv sim' sys'
 
 -- | The @k = 3@ leakage step: the four-cycle hop, the longest.
 indStepLeak3 ::
-  (RegFileOps r, MemOps m) => RegIdx -> Address -> Address -> SysG r m -> SimState -> Bool
-indStepLeak3 wr wa ipc sys sim =
+  (RegFileOps r, MemOps m) => RegIdx -> Address -> SysG r m -> SimState -> Bool
+indStepLeak3 wr wa sys sim =
   not premises || conclusion
   where
-    isa = isaAt ipc sys
+    isa = isaOf sys
     leak = leakOf isa
 
-    (sys1, out1) = stepSysOut sys
-    (sim1, obs1) = simCircuit sim (Just leak)
+    hopLength = 3
 
-    (sys2, out2) = stepSysOut sys1
-    (sim2, obs2) = simCircuit sim1 Nothing
-
-    (sys3, out3) = stepSysOut sys2
-    (sim3, obs3) = simCircuit sim2 Nothing
-
-    (sys4, out4) = stepSysOut sys3
-    (sim4, obs4) = simCircuit sim3 Nothing
+    (tr1, sys') = stepSysOutN hopLength sys
+    (tr2, sim') = simCircuitN hopLength sim (Just leak)
 
     premises =
       invAt wr wa isa sys
-        && driver sys == 3
         && simInv sim sys
+        && driver sys == hopLength
 
     conclusion =
-      simDriver (Just leak) sim == 3
-        && obs1 == obsOf out1
-        && obs2 == obsOf out2
-        && obs3 == obsOf out3
-        && obs4 == obsOf out4
-        && simInv sim4 sys4
+      simDriver (Just leak) sim == hopLength
+        && tr1 == tr2
+        && simInv sim' sys'
+
+-- Helpers ----------------------------------------------------------------------
+
+-- | A hop of the system: @n + 1@ steps ('stepSysOut' repeated). Returns the
+-- trace of its bus observations and the system after the hop. Recursive on
+-- @n@, which each step fixes to a literal.
+stepSysOutN ::
+  (RegFileOps r, MemOps m) => Int -> SysG r m -> (Trace, SysG r m)
+stepSysOutN n sys
+  | n == 0 = (TraceSingle obs, sys')
+  | otherwise =
+    let (tr, sys'') = stepSysOutN (n - 1) sys'
+    in (TraceCons obs tr, sys'')
+  where
+    (sys', out) = stepSysOut sys
+    obs = obsOf out
+
+-- | The simulator's counterpart of 'stepSysOutN' ('simCircuit' repeated): its
+-- input in the first cycle, then no input, as in the middle of a driver hop.
+-- Returns the trace of its bus observations and the simulator after the hop.
+simCircuitN :: Int -> SimState -> SimInput -> (Trace, SimState)
+simCircuitN n sim inp
+  | n == 0 = (TraceSingle obs, sim')
+  | otherwise =
+    let (tr, sim'') = simCircuitN (n - 1) sim' Nothing
+    in (TraceCons obs tr, sim'')
+  where
+    (sim', obs) = simCircuit sim inp
diff --git a/proof/Proof/Core/Leakage/Simulator.hs b/proof/Proof/Core/Leakage/Simulator.hs
index d36a964..2c337cf 100644
--- a/proof/Proof/Core/Leakage/Simulator.hs
+++ b/proof/Proof/Core/Leakage/Simulator.hs
@@ -1,6 +1,6 @@
 -- | The leakage simulator: a pipeline with the same stage structure and timing
--- as "Core", which sees only the leakage -- never the program, the register
--- file or memory contents.
+-- as "Core.Pipeline", which sees only the leakage -- never the program, the
+-- register file or memory contents.
 --
 -- Each cycle it may receive the 'Leak' of the instruction entering its execute
 -- stage ('SimInput'; 'Nothing' when there is none) and emits the bus
@@ -31,7 +31,8 @@ import Proof.Core.Leakage.Model
 import Types
 import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
 
--- | The input of the simulator.
+-- | The input of the simulator: the leakage of the instruction a hop starts
+-- with, or 'Nothing' in the middle of a driver hop.
 type SimInput = Maybe Leak
 
 -- | The output of the simulator.
@@ -57,6 +58,12 @@ data SimExInstrType
     StallNoInstruction
   | -- | First cycle.
     FirstCycle
+  | -- | First cycle after an environment instruction: the halt is on its way
+    -- through the pipeline, in the memory stage.
+    PendingHaltFirstCycle
+  | -- | Second cycle after an environment instruction: the halt is in the
+    -- writeback stage, which halts the core.
+    PendingHaltSecondCycle
   | -- | The core has halted.
     Halted
   deriving (Eq, Show, Generic, NFDataX)
@@ -87,8 +94,8 @@ data SimControl = SimControl
     --   a store hazard with the instruction in the `execute` stage or the
     --   instruction in the `memory` stage.
     simCtrlDeStoreHazard :: Maybe Address,
-    -- | Stores the type of instruction in the `execute` stage (if it's a decoded
-    -- instruction versus various stalls).
+    -- | Stores the type of instruction in the `execute` stage (if it's a
+    -- decoded instruction versus various stalls).
     simCtrlExInstrType :: Maybe SimExInstrType,
     -- | `True` when the leaked instruction is an environment instruction. To
     -- maintain consistency with the core, the execute stage is the only one
@@ -97,7 +104,8 @@ data SimControl = SimControl
     -- | Stores the jump address if the instruction in the `execute` stage
     --   results in a jump.
     simCtrlExJumpAddr :: Maybe Address,
-    -- | Stores the write address and size if the instruction in the `execute` stage
+    -- | Stores the write address and size if the instruction in the `execute`
+    -- stage
     --   is a store.
     simCtrlExStoreAddrSize :: Maybe (Address, Size),
     -- | Stores the load hazard bit if the instruction in the `execute` stage
@@ -105,7 +113,8 @@ data SimControl = SimControl
     simCtrlExLoadHazard :: Maybe Bool,
     -- | `True` when the instruction in the `memory` stage is a store or a load.
     simCtrlMeMemInstr :: Bool,
-    -- | Stores the write address and size if the instruction in the `memory` stage
+    -- | Stores the write address and size if the instruction in the `memory`
+    -- stage
     --   is a store.
     simCtrlMeStoreAddrSize :: Maybe (Address, Size)
   }
@@ -130,6 +139,9 @@ simPipe = do
   simExecute
   simDecode
   simFetch
+  -- The lines only carry values within a tick, so none of them survives it,
+  -- as in 'Core.Pipeline.pipe'.
+  modify $ \s -> s {simStateCtrl = simInitCtrl}
 
 simInit :: SimState
 simInit =
@@ -198,31 +210,41 @@ simDecode = do
   let irt = if expInstr then DecodedInstr else StallNoInstruction
 
   let halted = simCtrlExInstrType ctrl == Just Halted
-  let env_instr_current_cycle = simCtrlExEnvInstr ctrl
-  
+  let env_instr_two_cycles_ago =
+        simCtrlExInstrType ctrl == Just PendingHaltSecondCycle
+  let env_instr_previous_cycle =
+        simCtrlExInstrType ctrl == Just PendingHaltFirstCycle
   let jump_previous_cycle = simCtrlExInstrType ctrl == Just StallJumpFirstCycle
-  let store_hazard_previous_cycle = simCtrlExInstrType ctrl == Just StallStoreHazardFirstCycle
-  let load_hazard_previous_cycle = simCtrlExInstrType ctrl == Just StallLoadHazardFirstCycle
+  let store_hazard_previous_cycle =
+        simCtrlExInstrType ctrl == Just StallStoreHazardFirstCycle
+  let load_hazard_previous_cycle =
+        simCtrlExInstrType ctrl == Just StallLoadHazardFirstCycle
 
+  let env_instr_current_cycle = simCtrlExEnvInstr ctrl
   let jump_current_cycle = isJust (simCtrlExJumpAddr ctrl)
 
   let store_hazard_current_cycle =
         maybe False (storeHazard pc) (simCtrlExStoreAddrSize ctrl) ||
         maybe False (storeHazard pc) (simCtrlMeStoreAddrSize ctrl)
 
-  let load_hazard_current_cycle = expInstr && fromMaybe False (simCtrlExLoadHazard ctrl)
+  let load_hazard_current_cycle =
+        expInstr && fromMaybe False (simCtrlExLoadHazard ctrl)
 
   let irt'
-        -- Halt if the core is not running anymore.
+        -- Stay halted once the core has halted.
         | halted = Halted
-        -- Halt if there is an environment instruction in this cycle.
-        | env_instr_current_cycle = Halted
+        -- The halt reaches the writeback stage after the second pending cycle.
+        | env_instr_two_cycles_ago = Halted
+        -- The halt moves on from the memory stage to the writeback stage.
+        | env_instr_previous_cycle = PendingHaltSecondCycle
         -- Stall if there was a jump in the previous cycle.
         | jump_previous_cycle = StallJumpSecondCycle
         -- Stall if there was a store hazard in the previous cycle.
         | store_hazard_previous_cycle = StallStoreHazardSecondCycle
         -- Stall if there was a load hazard in the previous cycle.
         | load_hazard_previous_cycle = StallLoadHazardSecondCycle
+        -- An environment instruction in this cycle starts the halt.
+        | env_instr_current_cycle = PendingHaltFirstCycle
         -- Stall if there is a jump in this cycle.
         | jump_current_cycle = StallJumpFirstCycle
         -- Stall if there is a store hazard in this cycle.
@@ -247,7 +269,7 @@ simExecute = do
   irt <- gets simStateExInstrType
 
   simSetLines $ \c -> c {simCtrlExInstrType = Just irt}
-  
+
   case irt of
     DecodedInstr ->
       case input of
diff --git a/proof/Proof/Core/Leakage/Solver.hs b/proof/Proof/Core/Leakage/Solver.hs
index c431935..a705956 100644
--- a/proof/Proof/Core/Leakage/Solver.hs
+++ b/proof/Proof/Core/Leakage/Solver.hs
@@ -1,24 +1,24 @@
 -- | The leakage proof, checked symbolically.
 --
 -- 'baseCaseLeak' plus one property per driver delay: on a hop of that length,
--- the corresponding obligation in "Proof.Core.Leakage.Obligation" holds. Split by
--- @k@ because the number of unrolled cycles has to be concrete -- Pantomime
+-- the corresponding obligation in "Proof.Core.Leakage.Obligation" holds. Split
+-- by @k@ because the number of unrolled cycles has to be concrete -- Pantomime
 -- cannot recurse on a symbolic count -- and each property pins @driver == k@ so
 -- it carries one unrolling rather than four.
 --
--- Together with "Proof.Core.Functional.Solver" these are the leakage theorem: the
--- functional proof establishes that the invariant holds wherever the driver
+-- Together with "Proof.Core.Functional.Solver" these are the leakage theorem:
+-- the functional proof establishes that the invariant holds wherever the driver
 -- lands, which each step here assumes as a premise.
 --
 -- Each query runs both the core and the simulator over the hop and compares
 -- their per-cycle bus observations, the two drivers' hop lengths and the
 -- simulator invariant, so they are larger than the corresponding functional
--- ones. The statements live in "Proof.Core.Leakage.Obligation"; this module only
--- instantiates them.
+-- ones. The statements live in "Proof.Core.Leakage.Obligation"; this module
+-- only instantiates them.
 --
 -- The system state is passed as a 'KState' plus SMT-array register file and
--- memory (see "Proof.Core.Functional.System"); the simulator state is passed directly,
--- since it holds no register file or memory.
+-- memory (see "Proof.Core.Functional.System"); the simulator state is passed
+-- directly, since it holds no register file or memory.
 --
 -- == Running them
 --
@@ -26,7 +26,9 @@
 --
 -- > SBV_Z3=/usr/local/bin/bitwuzla SBV_Z3_OPTIONS="--produce-models" stack build
 module Proof.Core.Leakage.Solver
-  ( baseCaseLeakP,
+  ( simDriverMatchesSpecP,
+    simDriverMatchesSpecInitP,
+    baseCaseLeakP,
     indStepLeak0P,
     indStepLeak1P,
     indStepLeak2P,
@@ -36,18 +38,43 @@ module Proof.Core.Leakage.Solver
 where
 
 import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
-import qualified Core
+import qualified Core.Pipeline as Core
 import Pantomime (Theory (..))
 import qualified Pantomime.BuiltIn as Pantomime
+import Proof.Core.Leakage.Driver
+  ( simDriverMatchesSpec,
+    simDriverMatchesSpecInit,
+  )
+import Proof.Core.Leakage.Model (Leak)
 import Proof.Core.Leakage.Obligation
 import Proof.Core.Leakage.Simulator
+import Proof.Core.SMT.Array
 import Proof.SMT.Array
-import Proof.SMT.Axioms (arrayAxioms)
+import Proof.Core.SMT.Axioms (arrayAxioms)
 import Proof.SMT.Logged (pantomime)
 import Proof.Core.Functional.System
 import Types
 import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
 
+-- The driver -------------------------------------------------------------------
+
+-- | On the simulator states the invariant covers, the simulator's driver agrees
+-- with its operational reading, for the leakage of any instruction.
+{-# ANN simDriverMatchesSpecP (Theory arrayAxioms) #-}
+simDriverMatchesSpecP ::
+  RegIdx -> Address ->
+  Leak -> SimState -> KState -> Core.Input -> RegArr -> MemArr ->
+  Pantomime.Bool
+simDriverMatchesSpecP wr wa leak sim ss i ra ma =
+  Pantomime.boolean $ simDriverMatchesSpec wr wa leak sim (sysOf ss i ra ma)
+
+-- | On the initial simulator, its driver agrees with its operational reading,
+-- for any start PC.
+{-# ANN simDriverMatchesSpecInitP (Theory arrayAxioms) #-}
+simDriverMatchesSpecInitP :: Address -> Pantomime.Bool
+simDriverMatchesSpecInitP pc =
+  Pantomime.boolean $ simDriverMatchesSpecInit pc
+
 -- The base case ----------------------------------------------------------------
 
 -- | The first hop from the initial state, for any start PC, register file and
@@ -61,34 +88,44 @@ baseCaseLeakP pc ra ma =
 
 -- | @k = 0@: the one-cycle hop (steady, writeback non-memory).
 {-# ANN indStepLeak0P (Theory arrayAxioms) #-}
-indStepLeak0P :: RegIdx -> Address -> Address -> KState -> Core.Input -> RegArr -> MemArr -> SimState -> Pantomime.Bool
-indStepLeak0P wr wa ipc ss i ra ma sim =
-  Pantomime.boolean $ indStepLeak0 wr wa ipc (sysOf ss i ra ma) sim
+indStepLeak0P ::
+  RegIdx -> Address -> KState -> Core.Input -> RegArr -> MemArr -> SimState ->
+  Pantomime.Bool
+indStepLeak0P wr wa ss i ra ma sim =
+  Pantomime.boolean $ indStepLeak0 wr wa (sysOf ss i ra ma) sim
 
 -- | @k = 1@: the two-cycle hop (a memory instruction in writeback).
 {-# ANN indStepLeak1P (Theory arrayAxioms) #-}
-indStepLeak1P :: RegIdx -> Address -> Address -> KState -> Core.Input -> RegArr -> MemArr -> SimState -> Pantomime.Bool
-indStepLeak1P wr wa ipc ss i ra ma sim =
-  Pantomime.boolean $ indStepLeak1 wr wa ipc (sysOf ss i ra ma) sim
+indStepLeak1P ::
+  RegIdx -> Address -> KState -> Core.Input -> RegArr -> MemArr -> SimState ->
+  Pantomime.Bool
+indStepLeak1P wr wa ss i ra ma sim =
+  Pantomime.boolean $ indStepLeak1 wr wa (sysOf ss i ra ma) sim
 
 -- | @k = 2@: the three-cycle hop (environment, taken jump, store hazard with a
 -- non-memory execute instruction, or memory instructions in both older stages).
 -- The hop on which the ISA enters a halt; a halted state then sits at k = 0.
 {-# ANN indStepLeak2P (Theory arrayAxioms) #-}
-indStepLeak2P :: RegIdx -> Address -> Address -> KState -> Core.Input -> RegArr -> MemArr -> SimState -> Pantomime.Bool
-indStepLeak2P wr wa ipc ss i ra ma sim =
-  Pantomime.boolean $ indStepLeak2 wr wa ipc (sysOf ss i ra ma) sim
+indStepLeak2P ::
+  RegIdx -> Address -> KState -> Core.Input -> RegArr -> MemArr -> SimState ->
+  Pantomime.Bool
+indStepLeak2P wr wa ss i ra ma sim =
+  Pantomime.boolean $ indStepLeak2 wr wa (sysOf ss i ra ma) sim
 
 -- | @k = 3@: the four-cycle hop (store hazard with a memory execute
 -- instruction, load hazard, or all three stages holding memory instructions).
 {-# ANN indStepLeak3P (Theory arrayAxioms) #-}
-indStepLeak3P :: RegIdx -> Address -> Address -> KState -> Core.Input -> RegArr -> MemArr -> SimState -> Pantomime.Bool
-indStepLeak3P wr wa ipc ss i ra ma sim =
-  Pantomime.boolean $ indStepLeak3 wr wa ipc (sysOf ss i ra ma) sim
+indStepLeak3P ::
+  RegIdx -> Address -> KState -> Core.Input -> RegArr -> MemArr -> SimState ->
+  Pantomime.Bool
+indStepLeak3P wr wa ss i ra ma sim =
+  Pantomime.boolean $ indStepLeak3 wr wa (sysOf ss i ra ma) sim
 
 results :: [(String, Maybe String)]
 results =
-  [ ("baseCaseLeakP", $(pantomime 'baseCaseLeakP)),
+  [ ("simDriverMatchesSpecP", $(pantomime 'simDriverMatchesSpecP)),
+    ("simDriverMatchesSpecInitP", $(pantomime 'simDriverMatchesSpecInitP)),
+    ("baseCaseLeakP", $(pantomime 'baseCaseLeakP)),
     ("indStepLeak0P", $(pantomime 'indStepLeak0P)),
     ("indStepLeak1P", $(pantomime 'indStepLeak1P)),
     ("indStepLeak2P", $(pantomime 'indStepLeak2P)),
diff --git a/proof/Proof/Core/SMT/Array.hs b/proof/Proof/Core/SMT/Array.hs
new file mode 100644
index 0000000..527df35
--- /dev/null
+++ b/proof/Proof/Core/SMT/Array.hs
@@ -0,0 +1,198 @@
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MonoLocalBinds #-}
+
+-- | The core's register file embedded as an SMT array, in the pattern
+-- "Proof.SMT.Array" describes for memory, and the ALU's shifts
+-- ('Core.Alu.sllWord' and friends) as SMT bitvector shifts.
+module Proof.Core.SMT.Array
+  ( RegArr (..),
+    RegArrF (..),
+    RegArrSMT (..),
+    loadRA,
+    storeRA,
+    zeroRA,
+    zeroRAE,
+    loadRAE,
+    storeRAE,
+    eqRA,
+    eqRAE,
+    sllWordE,
+    srlWordE,
+    sraWordE,
+  )
+where
+
+import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
+import Data.Coerce (Coercible, coerce)
+import qualified Pantomime.BuiltIn as P
+import qualified Pantomime.Clash as Clash
+import Core.RegFile (RegFileOps (..))
+import Types
+import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
+
+-- The register file as an SMT array -------------------------------------------
+
+-- | The Haskell-side register file: 32 entries, so the index is exactly a
+-- 'RegIdx' with no offset arithmetic. Slot 0 is present but never used --
+-- @x0@ is handled by the caller, outside the array operations.
+newtype RegArr = RegArr (Vec 32 Word)
+
+-- | The SMT-side counterpart. Same arity (zero), which is what lets the type
+-- axiom relate them.
+newtype RegArrSMT = RegArrSMT (P.Array (P.BitVec 5) (P.BitVec 32))
+
+-- | Read. Replaced by 'loadRAE' under the term axiom.
+--
+-- OPAQUE is essential: the axiom is keyed on this /name/, so if GHC inlines
+-- the wrapper then only the polymorphic @index_int@ survives into Core and the
+-- axiom never fires.
+{-# OPAQUE loadRA #-}
+loadRA :: RegArr -> RegIdx -> Word
+loadRA (RegArr v) i = v !! i
+
+-- | Write. Replaced by 'storeRAE' under the term axiom. OPAQUE for the same
+-- reason as 'loadRA'.
+{-# OPAQUE storeRA #-}
+storeRA :: RegArr -> RegIdx -> Word -> RegArr
+storeRA (RegArr v) i x = RegArr (replace i x v)
+
+-- | Embedding of 'loadRA' as an array select.
+--
+-- Two subtleties. First, the source types are type /variables/ with
+-- constructor-level 'Coercible' givens: congruence lifts @Coercible f g@ to
+-- @Coercible (f a) (g a)@ when the head is a variable, but not through a
+-- concrete constructor with nominal parameter roles.
+--
+-- Second, the array is indexed by the /primitive/ @Pantomime.BuiltIn.BitVec@,
+-- not by pantomime-clash's @BitVec@. The latter is a GADT admitting
+-- zero-width vectors, so it is neither coercible to the primitive nor a
+-- 'P.Primitive' itself, and cannot be an array index or element. So we unwrap
+-- at the boundary with 'Clash.BitVecP'.
+loadRAE ::
+  forall arr (bvI :: Nat -> Type) (bvV :: Nat -> Type).
+  (Coercible RegArrSMT arr) =>
+  (Coercible Clash.BitVec bvI) =>
+  (Coercible Clash.BitVec bvV) =>
+  arr ->
+  bvI 5 ->
+  bvV 32
+loadRAE = coerce go
+  where
+    go :: RegArrSMT -> Clash.BitVec 5 -> Clash.BitVec 32
+    go (RegArrSMT arr) (Clash.BitVecP k) = Clash.BitVecP (P.aselect arr k)
+
+-- | Embedding of 'storeRA' as an array store.
+storeRAE ::
+  forall arr (bvI :: Nat -> Type) (bvV :: Nat -> Type).
+  (Coercible RegArrSMT arr) =>
+  (Coercible Clash.BitVec bvI) =>
+  (Coercible Clash.BitVec bvV) =>
+  arr ->
+  bvI 5 ->
+  bvV 32 ->
+  arr
+storeRAE = coerce go
+  where
+    go :: RegArrSMT -> Clash.BitVec 5 -> Clash.BitVec 32 -> RegArrSMT
+    go (RegArrSMT arr) (Clash.BitVecP k) (Clash.BitVecP v) =
+      RegArrSMT (P.astore arr k v)
+
+-- | Equality, so that whole register files can be compared. Replaced by 'eqRAE'
+-- under the term axiom; OPAQUE for the same reason as 'loadRA'.
+{-# OPAQUE eqRA #-}
+eqRA :: RegArr -> RegArr -> Bool
+eqRA (RegArr v) (RegArr w) = v == w
+
+instance Eq RegArr where
+  (==) = eqRA
+
+-- | Embedding of 'eqRA' as array equality.
+eqRAE :: forall arr. (Coercible RegArrSMT arr) => arr -> arr -> Bool
+eqRAE = coerce go
+  where
+    go :: RegArrSMT -> RegArrSMT -> Bool
+    go (RegArrSMT a) (RegArrSMT b) = a == b
+
+-- | The all-zero register file.
+--
+-- 'Proof.Core.Leakage.Simulator.censor' installs this on every state it builds,
+-- so unlike 'Core.Pipeline.init' it is on the symbolic path and has to be
+-- embeddable. 'Clash.Prelude.repeat' gives the Haskell semantics; 'zeroRAE'
+-- replaces it under the term axiom, which is keyed on this name -- hence
+-- OPAQUE, for the same reason as 'loadRA'.
+{-# OPAQUE zeroRA #-}
+zeroRA :: RegArr
+zeroRA = RegArr (Clash.Prelude.repeat 0)
+
+-- | Embedding of 'zeroRA' as a constant array.
+zeroRAE :: forall arr. (Coercible RegArrSMT arr) => arr
+zeroRAE = coerce (RegArrSMT (P.aconst 0))
+
+-- | The array-backed register file, wrapped so it fits 'RegFileOps'. A
+-- verification-only representation.
+newtype RegArrF = RegArrF RegArr
+  deriving (Eq)
+
+instance RegFileOps RegArrF where
+  lookupRFg idx (RegArrF a) = if idx == 0 then 0 else loadRA a idx
+  modifyRFg idx v rf@(RegArrF a)
+    | idx == 0 = rf
+    | otherwise = RegArrF (storeRA a idx v)
+
+  -- On the symbolic path; see 'zeroRA'.
+  initRFg = RegArrF zeroRA
+
+-- Shifts as SMT bitvector shifts ----------------------------------------------
+--
+-- Embeddings for 'Core.Alu.sllWord', 'Core.Alu.srlWord' and
+-- 'Core.Alu.sraWord'. See the note on those functions for why they exist:
+-- without them each shift site converts its five-bit amount through 'Integer',
+-- and the resulting
+-- @ubv_to_int@ / @int_to_bv@ pair makes every query unreadable to the
+-- bitvector-only solvers.
+--
+-- The amount is zero-extended to the word width because SMT's shifts require
+-- both operands to have the same sort. That is exact rather than a choice: the
+-- amount is five bits, so it is always less than 32 and no shift saturates.
+
+-- | @shiftL@ on a 'Word' as @bvshl@.
+sllWordE ::
+  forall (bvX :: Nat -> Type) (bvN :: Nat -> Type).
+  (Coercible Clash.BitVec bvX) =>
+  (Coercible Clash.BitVec bvN) =>
+  bvX 32 ->
+  bvN 5 ->
+  bvX 32
+sllWordE = coerce go
+  where
+    go :: Clash.BitVec 32 -> Clash.BitVec 5 -> Clash.BitVec 32
+    go (Clash.BitVecP x) (Clash.BitVecP n) =
+      Clash.BitVecP (P.bvshl x (P.bvzext n))
+
+-- | @shiftR@ on a 'Word' as @bvlshr@.
+srlWordE ::
+  forall (bvX :: Nat -> Type) (bvN :: Nat -> Type).
+  (Coercible Clash.BitVec bvX) =>
+  (Coercible Clash.BitVec bvN) =>
+  bvX 32 ->
+  bvN 5 ->
+  bvX 32
+srlWordE = coerce go
+  where
+    go :: Clash.BitVec 32 -> Clash.BitVec 5 -> Clash.BitVec 32
+    go (Clash.BitVecP x) (Clash.BitVecP n) =
+      Clash.BitVecP (P.bvlshr x (P.bvzext n))
+
+-- | Arithmetic @shiftR@ on a 'Word' as @bvashr@.
+sraWordE ::
+  forall (bvX :: Nat -> Type) (bvN :: Nat -> Type).
+  (Coercible Clash.BitVec bvX) =>
+  (Coercible Clash.BitVec bvN) =>
+  bvX 32 ->
+  bvN 5 ->
+  bvX 32
+sraWordE = coerce go
+  where
+    go :: Clash.BitVec 32 -> Clash.BitVec 5 -> Clash.BitVec 32
+    go (Clash.BitVecP x) (Clash.BitVecP n) =
+      Clash.BitVecP (P.bvashr x (P.bvzext n))
diff --git a/proof/Proof/Core/SMT/Axioms.hs b/proof/Proof/Core/SMT/Axioms.hs
new file mode 100644
index 0000000..4804451
--- /dev/null
+++ b/proof/Proof/Core/SMT/Axioms.hs
@@ -0,0 +1,50 @@
+-- | The axioms for the properties about the core: those every proof builds on
+-- ("Proof.SMT.Axioms"), plus the core's shift wrappers and its register file as
+-- an SMT array ("Proof.Core.SMT.Array").
+--
+-- This lives in its own module because GHC's stage restriction requires a value
+-- mentioned in an @ANN@ pragma to be imported rather than defined locally.
+module Proof.Core.SMT.Axioms (arrayAxioms) where
+
+import Core.Alu (sllWord, sraWord, srlWord)
+import qualified Data.Map as Map
+import Pantomime (PluginAxioms (..))
+import Proof.Core.SMT.Array
+import Proof.SMT.Axioms (memAxioms)
+
+-- | The ALU shifts, mapped to the SMT bitvector shifts.
+--
+-- They are part of the core's semantics, not of the container encoding: any
+-- property that runs the ALU needs them. Without them 'Core.Alu.sllWord' and
+-- friends are OPAQUE names with no unfolding, and symbolic execution stops
+-- with \"Unbound variable in symbolise\". See 'Core.Alu.sllWord' for why the
+-- wrappers exist: they keep the shift amount a bitvector, so a query stays in
+-- the bitvector-and-array fragment that Bitwuzla and Yices can read.
+shiftAxioms :: PluginAxioms
+shiftAxioms =
+  PluginAxioms
+    { typeAxioms = Map.empty,
+      termAxioms =
+        [ ('sllWord, 'sllWordE),
+          ('srlWord, 'srlWordE),
+          ('sraWord, 'sraWordE)
+        ]
+    }
+
+-- | The register-file-as-SMT-array embedding and the shifts, on top of memory
+-- and the base set.
+--
+-- Monomorphic by necessity: an array needs concrete index and element sorts.
+arrayAxioms :: PluginAxioms
+arrayAxioms =
+  memAxioms
+    <> shiftAxioms
+    <> PluginAxioms
+      { typeAxioms = Map.fromList [(''RegArr, ''RegArrSMT)],
+        termAxioms =
+          [ ('loadRA, 'loadRAE),
+            ('zeroRA, 'zeroRAE),
+            ('storeRA, 'storeRAE),
+            ('eqRA, 'eqRAE)
+          ]
+      }
diff --git a/proof/Proof/Memory/Cache4K/CachedCore/Functional/Driver.hs b/proof/Proof/Memory/Cache4K/CachedCore/Functional/Driver.hs
new file mode 100644
index 0000000..a65bf89
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/CachedCore/Functional/Driver.hs
@@ -0,0 +1,86 @@
+-- | The driver of link 2: how many cycles the core behind the cache
+-- ("Proof.Memory.Cache4K.CachedCore.Functional.Machine") takes beyond one cycle
+-- of the core behind ideal memory, before the two can be compared again -- the
+-- counterpart of "Proof.Memory.Cache4K.Server.Functional.Driver".
+--
+--   * 'cachedDriver', the server's driver on the request the core makes, and
+--   * 'cachedDriverSpec', the operational reading, obtained by actually
+--     stepping.
+module Proof.Memory.Cache4K.CachedCore.Functional.Driver
+  ( cachedDriver,
+    cachedDriverValues,
+    cachedDriverSpec,
+    cachedDriverMatchesSpec,
+  )
+where
+
+import Core.Pipeline as Core (Input (..), Output (..))
+import qualified Core.Pipeline as Core
+import Core.RegFile (RegFileOps)
+import Data.Maybe (isJust)
+import Memory.Cache4K (SetIdx, WordIdx)
+import Memory.Cache4KServer
+import Memory.Types (MemOps (..))
+import Proof.Memory.Cache4K.CachedCore.Functional.Invariant (cachedInvAt)
+import Proof.Memory.Cache4K.CachedCore.Functional.Machine (CachedSysG (..), stepCached)
+import Proof.Memory.Cache4K.Server.Functional.Driver (srvDriver)
+import Proof.Core.Functional.Machine (SysG)
+import Types
+
+-- | The cycles after this one until the cache has answered the request the core
+-- makes in this cycle: the server's driver
+-- ('Proof.Memory.Cache4K.Server.Functional.Driver.srvDriver') on that request.
+-- The driver is only ever run from systems that satisfy the invariant
+-- ('Proof.Memory.Cache4K.CachedCore.Functional.Invariant.cachedInvAt'), whose
+-- cache is ready; elsewhere it need not agree with 'cachedDriverSpec'.
+cachedDriver :: (RegFileOps r) => CachedSysG r m -> Int
+cachedDriver (CachedSys core inp srv) =
+  let (_, Output req) = Core.circuit core inp
+  in srvDriver srv req
+
+-- | The driver is 0, 'penalty' or twice 'penalty': the hop lengths of the steps
+-- ('Proof.Memory.Cache4K.CachedCore.Functional.Obligation.indStep0',
+-- 'Proof.Memory.Cache4K.CachedCore.Functional.Obligation.indStep4',
+-- 'Proof.Memory.Cache4K.CachedCore.Functional.Obligation.indStep8'), which so
+-- cover every hop. Follows from the server's
+-- ('Proof.Memory.Cache4K.Server.Functional.Driver.srvDriverValues'), since
+-- 'cachedDriver' is the server's driver on the core's request.
+cachedDriverValues :: (RegFileOps r) => CachedSysG r m -> Bool
+cachedDriverValues csys =
+  k == 0 || k == fromIntegral penalty || k == 2 * fromIntegral penalty
+  where
+    k = cachedDriver csys
+
+-- | The operational reading of 'cachedDriver': step the system until the cache
+-- answers the core, and count the cycles after the first. 'Nothing' if more
+-- than @fuel@ cycles follow the first.
+cachedDriverSpec ::
+  (RegFileOps r, MemOps m) => Int -> CachedSysG r m -> Maybe Int
+cachedDriverSpec fuel csys0 = go 0 (stepCached csys0)
+  where
+    go n csys
+      | isJust (inputMem (cachedInput csys)) = Just n
+      | n >= fuel = Nothing
+      | otherwise = go (n + 1) (stepCached csys)
+
+-- | On systems the invariant relates to an ideal system, the driver agrees with
+-- its operational reading, as 'Proof.Core.Functional.Driver.driverMatchesSpec'
+-- for the core: the driver reads the core's request, which only matches the
+-- stepping on states the invariant covers. Eight cycles of fuel, 2 * 'penalty',
+-- cover the longest hop, two missed lines. Follows from the server's
+-- ('Proof.Memory.Cache4K.Server.Functional.Contract.srvDriverMatchesSpec'):
+-- under the invariant the server is ready
+-- ('Proof.Memory.Cache4K.Server.Functional.Contract.srvReadyUnderInv'), and
+-- while it has not answered, the core makes no request
+-- ('Proof.Memory.Cache4K.Server.Functional.Contract.corePatient'), so the
+-- server is stepped exactly as
+-- 'Proof.Memory.Cache4K.Server.Functional.Contract.srvDriverSpec' steps it.
+cachedDriverMatchesSpec ::
+  (RegFileOps r, Eq r, MemOps m) =>
+  Address -> SetIdx -> WordIdx -> SysG r m -> CachedSysG r m -> Bool
+cachedDriverMatchesSpec wa wsi wwi sys csys =
+  not premises || conclusion
+  where
+    premises = cachedInvAt wa wsi wwi sys csys
+
+    conclusion = cachedDriverSpec 8 csys == Just (cachedDriver csys)
diff --git a/proof/Proof/Memory/Cache4K/CachedCore/Functional/Invariant.hs b/proof/Proof/Memory/Cache4K/CachedCore/Functional/Invariant.hs
new file mode 100644
index 0000000..f52f5e9
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/CachedCore/Functional/Invariant.hs
@@ -0,0 +1,54 @@
+-- | The invariant of link 2, relating the core behind the cache to the core
+-- behind ideal memory -- the counterpart of "Proof.Core.Functional.Invariant".
+--
+-- The two cores are the same, and so are their inputs; the cache relates to
+-- ideal memory as in the cache's own proof
+-- ('Proof.Memory.Cache4K.Server.Functional.Invariant.srvInvAt'): ready, holding
+-- ideal memory's byte @wa@, and coherent at word @wwi@ of set @wsi@. The cache
+-- holds 1024 words and memory many more bytes, so the invariant is stated at
+-- witnesses, and the obligations quantify over them.
+module Proof.Memory.Cache4K.CachedCore.Functional.Invariant
+  ( cachedInvAt,
+    cachedInvFunctional,
+  )
+where
+
+import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
+import Memory.Cache4K (SetIdx, WordIdx)
+import Memory.Types (MemOps (..))
+import Proof.Memory.Cache4K.Server.Functional.Invariant (srvInvAt)
+import Proof.Memory.Cache4K.CachedCore.Functional.Machine (CachedSysG (..))
+import Proof.Core.Functional.Machine (SysG (..))
+import Types (Address)
+import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
+
+-- | The invariant at byte @wa@ and word @wwi@ of set @wsi@: the cores and their
+-- inputs are equal, and the server satisfies the cache's invariant against
+-- ideal memory.
+cachedInvAt ::
+  (Eq r, MemOps m) =>
+  Address -> SetIdx -> WordIdx -> SysG r m -> CachedSysG r m -> Bool
+cachedInvAt wa wsi wwi (Sys core inp mem) (CachedSys ccore cinp srv) =
+  ccore == core
+    && cinp == inp
+    && srvInvAt wa wsi wwi mem srv
+
+-- | The invariant is functional: two ideal systems it relates to the same
+-- cached system are equal, at byte @wa@. Quantifying over @wa@ gives equality
+-- of the systems. Follows from the server's invariant being functional
+-- ('Proof.Memory.Cache4K.Server.Functional.Invariant.srvInvFunctional'): the
+-- cores and inputs are each equal to the cached system's, and the memories are
+-- the ones the server's invariant relates to the same server.
+cachedInvFunctional ::
+  (Eq r, MemOps m) =>
+  Address -> SetIdx -> WordIdx -> SysG r m -> SysG r m -> CachedSysG r m -> Bool
+cachedInvFunctional wa wsi wwi sys1 sys2 csys =
+  not premises || conclusion
+  where
+    premises =
+      cachedInvAt wa wsi wwi sys1 csys && cachedInvAt wa wsi wwi sys2 csys
+
+    conclusion =
+      sysCore sys1 == sysCore sys2
+        && sysInput sys1 == sysInput sys2
+        && memReadByte wa (sysMem sys1) == memReadByte wa (sysMem sys2)
diff --git a/proof/Proof/Memory/Cache4K/CachedCore/Functional/Machine.hs b/proof/Proof/Memory/Cache4K/CachedCore/Functional/Machine.hs
new file mode 100644
index 0000000..0fcf64e
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/CachedCore/Functional/Machine.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- | The system link 2 reasons about: the core together with the cache in front
+-- of memory -- the counterpart of
+-- "Proof.Core.Functional.Machine", with the cache server ('serve') in place of
+-- ideal memory ('Memory.Ideal.idealServe').
+--
+-- A single system step is one 'Core.circuit' step plus the cache server's
+-- answer, and the state the proofs reason about is the triple
+--
+-- > (Core.State, Input, cache server)
+module Proof.Memory.Cache4K.CachedCore.Functional.Machine
+  ( CachedSysG (..),
+    CachedSys,
+    initCachedSys,
+    stepCached,
+    stepCachedOut,
+  )
+where
+
+import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
+import Core.Pipeline as Core
+import Memory.Cache4KServer
+import Memory.Types
+import Core.RegFile
+import Types (Address)
+import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
+
+-- | Core state, the input it is about to consume, and the cache server.
+data CachedSysG r m = CachedSys
+  { cachedCore :: Core.StateG r,
+    cachedInput :: Input,
+    cachedSrv :: CacheSrv m
+  }
+
+-- | The concrete system the QuickCheck harness runs: @Vec@-backed throughout.
+type CachedSys = CachedSysG RegFile MemBytes
+
+deriving instance (Show r, Show m) => Show (CachedSysG r m)
+
+deriving instance (Eq r, Eq m) => Eq (CachedSysG r m)
+
+-- | The system at start: the core at start with PC @pc@ and register file @rf@
+-- ('Core.initAt'), its input at start ('Core.initInput'), and the cache server
+-- at start in front of memory @mem@ ('Memory.Cache4KServer.initCacheSrv').
+initCachedSys :: Address -> r -> m -> CachedSysG r m
+initCachedSys pc rf mem =
+  CachedSys (Core.initAt pc rf) Core.initInput (initCacheSrv mem)
+
+-- | One system step: run the pipeline for a cycle, then let the cache server
+-- answer whatever memory access it emitted.
+stepCached :: (RegFileOps r, MemOps m) => CachedSysG r m -> CachedSysG r m
+stepCached = fst . stepCachedOut
+
+-- | 'stepCached', but also returning the pipeline's 'Output' for that cycle.
+--
+-- The system is the core in a loop with 'serve': the core's request goes to the
+-- cache, and the cache's answer is the core's input in the next cycle.
+stepCachedOut ::
+  (RegFileOps r, MemOps m) => CachedSysG r m -> (CachedSysG r m, Output)
+stepCachedOut (CachedSys core inp srv) =
+  let (core', o) = Core.circuit core inp
+      (srv', inp') = serve srv (outputMem o)
+   in (CachedSys core' inp' srv', o)
diff --git a/proof/Proof/Memory/Cache4K/CachedCore/Functional/Obligation.hs b/proof/Proof/Memory/Cache4K/CachedCore/Functional/Obligation.hs
new file mode 100644
index 0000000..ab6fc09
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/CachedCore/Functional/Obligation.hs
@@ -0,0 +1,175 @@
+-- | The obligations of link 2, in one place: the core behind the cache refines
+-- the core behind ideal memory -- the counterpart of
+-- "Proof.Core.Functional.Obligation".
+--
+-- One cycle of the core behind ideal memory ("Memory.Ideal") corresponds to
+-- 'Proof.Memory.Cache4K.CachedCore.Functional.Driver.cachedDriver' + 1 cycles
+-- of the core behind the cache. As the core's obligations build the ISA state
+-- from the system ('Proof.Core.Functional.Invariant.isaOf'), these build the
+-- cached system from the ideal one ('cachedOf'), with a cache that is coherent
+-- by construction; the conclusion compares the two after the hop.
+--
+-- From a system that satisfies the invariant the driver is 0, 'penalty' or
+-- twice 'penalty' (no, one or two lines missed;
+-- 'Proof.Memory.Cache4K.CachedCore.Functional.Driver.cachedDriverValues'), so
+-- there is one step per hop length, named after it for @'penalty' = 4@. Split
+-- by length because Pantomime unrolls recursion only when its count is
+-- concrete.
+--
+-- == Why they hold
+--
+-- The base case and the steps follow from the standalone cache's proof
+-- ("Proof.Memory.Cache4K.Server.Functional") and the contract between core and
+-- cache ("Proof.Memory.Cache4K.Server.Functional.Contract"); they are checked
+-- here only as a sanity check of that argument.
+--
+--   * Base case: the server at start satisfies the cache's invariant against
+--     its memory
+--     ('Proof.Memory.Cache4K.Server.Functional.Obligation.baseCase'), and the
+--     cores and inputs are the same by construction.
+--
+--   * Step of length @k@: the invariant ('cachedInvAt') gives the same core,
+--     the same input, and the cache's invariant against ideal memory. In the
+--     first cycle both cores therefore make the same request. The server is
+--     ready
+--     ('Proof.Memory.Cache4K.Server.Functional.Contract.srvReadyUnderInv') and
+--     answers it @k@ cycles later
+--     ('Proof.Memory.Cache4K.Server.Functional.Contract.srvDriverMatchesSpec'),
+--     with ideal memory's answer and its invariant again
+--     ('Proof.Memory.Cache4K.Server.Functional.Obligation.indStep0',
+--     'Proof.Memory.Cache4K.Server.Functional.Obligation.indStep4',
+--     'Proof.Memory.Cache4K.Server.Functional.Obligation.indStep8'). In the @k@
+--     cycles in between it answers 'Nothing', and the core, given 'Nothing'
+--     after a request, makes no request and stays the same
+--     ('Proof.Memory.Cache4K.Server.Functional.Contract.corePatient', once per
+--     cycle), so the server is served no request, as its own steps assume.
+--     After the hop the cores and inputs are those of the ideal system after
+--     one step, and the cache's invariant holds: 'cachedInvAt' again.
+module Proof.Memory.Cache4K.CachedCore.Functional.Obligation
+  ( cachedOf,
+    baseCase,
+    indStep0,
+    indStep4,
+    indStep8,
+  )
+where
+
+import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
+import Core.RegFile (RegFileOps)
+import Memory.Cache4K
+import Memory.Cache4KServer
+import Memory.Types (MemOps (..))
+import Proof.Memory.Cache4K.Server.Functional.Obligation (CoherentOps (..))
+import Proof.Memory.Cache4K.SMT.Raw (RawData (..))
+import Proof.Memory.Cache4K.CachedCore.Functional.Driver (cachedDriver)
+import Proof.Memory.Cache4K.CachedCore.Functional.Invariant (cachedInvAt)
+import Proof.Memory.Cache4K.CachedCore.Functional.Machine
+  ( CachedSysG (..),
+    initCachedSys,
+    stepCached,
+  )
+import Proof.Core.Functional.Machine (SysG (..), initSys, stepSys)
+import Types (Address)
+import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
+
+-- The starting state -----------------------------------------------------------
+
+-- | The cached system for the ideal system @sys@: the same core and input, and
+-- in front of its memory a ready cache with the tag array @tags@ that is
+-- coherent by construction -- valid lines hold memory's words, invalid lines
+-- those of @raw@. The steps start from it, as the cache's own steps do
+-- ('Proof.Memory.Cache4K.Server.Functional.Obligation.indStep0'), so that
+-- coherence holds by construction instead of being assumed; it shows what the
+-- cache adds to the ideal system: its tags and the contents of its invalid
+-- lines.
+cachedOf :: (CoherentOps m) => SysG r m -> TagArr -> RawData -> CachedSysG r m
+cachedOf (Sys core inp mem) tags raw =
+  CachedSys core inp (CacheSrv cache mem CacheSrvReady)
+  where
+    cache = Cache4K tags (mkData mem tags raw)
+
+-- The base case ----------------------------------------------------------------
+
+-- | The base case: the core at start behind the cache at start, in front of
+-- any memory, and the same core behind ideal memory satisfy the invariant. A
+-- sanity check: it follows from the cache's base case (see the module header).
+baseCase ::
+  (Eq r, MemOps m) =>
+  Address -> SetIdx -> WordIdx -> Address -> r -> m -> Bool
+baseCase wa wsi wwi pc rf mem =
+  cachedInvAt wa wsi wwi sys csys
+  where
+    sys = initSys pc rf mem
+    csys = initCachedSys pc rf mem
+
+-- The inductive steps ----------------------------------------------------------
+
+-- | The one-cycle hop: a request the cache answers at once. A sanity check:
+-- it follows from the cache's step and the contract (see the module header).
+indStep0 ::
+  (RegFileOps r, Eq r, CoherentOps m) =>
+  Address -> SetIdx -> WordIdx -> SysG r m -> TagArr -> RawData -> Bool
+indStep0 wa wsi wwi sys tags raw =
+  not premises || conclusion
+  where
+    sys' = stepSys sys
+
+    csys = cachedOf sys tags raw
+    csys' = stepCached csys
+
+    premises =
+      cachedInvAt wa wsi wwi sys csys
+        && cachedDriver csys == 0
+
+    conclusion = cachedInvAt wa wsi wwi sys' csys'
+
+-- | The hop of a read that misses one line: 'penalty' + 1 cycle. A sanity
+-- check: it follows from the cache's step and the contract (see the module
+-- header).
+indStep4 ::
+  (RegFileOps r, Eq r, CoherentOps m) =>
+  Address -> SetIdx -> WordIdx -> SysG r m -> TagArr -> RawData -> Bool
+indStep4 wa wsi wwi sys tags raw =
+  not premises || conclusion
+  where
+    sys' = stepSys sys
+
+    csys = cachedOf sys tags raw
+    csys' = stepCachedN (fromIntegral penalty) csys
+
+    premises =
+      cachedInvAt wa wsi wwi sys csys
+        && cachedDriver csys == fromIntegral penalty
+
+    conclusion = cachedInvAt wa wsi wwi sys' csys'
+
+-- | The hop of a read that misses both its lines: 2 * 'penalty' + 1 cycle. A
+-- sanity check: it follows from the cache's step and the contract (see the
+-- module header).
+indStep8 ::
+  (RegFileOps r, Eq r, CoherentOps m) =>
+  Address -> SetIdx -> WordIdx -> SysG r m -> TagArr -> RawData -> Bool
+indStep8 wa wsi wwi sys tags raw =
+  not premises || conclusion
+  where
+    sys' = stepSys sys
+
+    csys = cachedOf sys tags raw
+    csys' = stepCachedN (2 * fromIntegral penalty) csys
+
+    premises =
+      cachedInvAt wa wsi wwi sys csys
+        && cachedDriver csys == 2 * fromIntegral penalty
+
+    conclusion = cachedInvAt wa wsi wwi sys' csys'
+
+-- Helpers ----------------------------------------------------------------------
+
+-- | A hop of the cached system: @n + 1@ steps, the request's cycle and the @n@
+-- cycles the driver counts after it. Recursive on @n@, which each step fixes
+-- to a constant, so that the solver can unroll it.
+stepCachedN ::
+  (RegFileOps r, MemOps m) => Int -> CachedSysG r m -> CachedSysG r m
+stepCachedN n csys
+  | n == 0 = stepCached csys
+  | otherwise = stepCachedN (n - 1) (stepCached csys)
diff --git a/proof/Proof/Memory/Cache4K/CachedCore/Functional/Solver.hs b/proof/Proof/Memory/Cache4K/CachedCore/Functional/Solver.hs
new file mode 100644
index 0000000..8a4493b
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/CachedCore/Functional/Solver.hs
@@ -0,0 +1,179 @@
+-- | The proof that the core behind the cache refines the core behind ideal
+-- memory, checked symbolically: the counterpart of
+-- "Proof.Core.Functional.Solver".
+--
+-- The statements live in "Proof.Memory.Cache4K.CachedCore.Functional.Driver"
+-- and "Proof.Memory.Cache4K.CachedCore.Functional.Obligation"; this module only
+-- instantiates them, over every core state, input, register file, memory, tag
+-- array, request and witness. Each property is named after the statement it
+-- checks, with a @P@:
+--
+--   * the driver against its operational reading
+--     ('cachedDriverMatchesSpecP'), and its values, the hop lengths of the
+--     steps ('cachedDriverValuesP');
+--   * the invariant being functional ('cachedInvFunctionalP');
+--   * the base case, and one step per hop length (0, 'penalty',
+--     2 * 'penalty'), each starting from a cache coherent by construction
+--     ('Proof.Memory.Cache4K.Server.Functional.Obligation.mkData').
+--
+-- The array embeddings these rely on are checked in
+-- "Proof.Memory.Cache4K.Server.Functional.Solver".
+--
+-- == Running them
+--
+-- Under Bitwuzla, not Z3:
+--
+-- > SBV_Z3=/usr/local/bin/bitwuzla SBV_Z3_OPTIONS="--produce-models" stack build
+module Proof.Memory.Cache4K.CachedCore.Functional.Solver
+  ( cachedDriverMatchesSpecP,
+    cachedDriverValuesP,
+    cachedInvFunctionalP,
+    baseCaseP,
+    indStep0P,
+    indStep4P,
+    indStep8P,
+    results,
+  )
+where
+
+import qualified Core.Pipeline as Core
+import Memory.Cache4K
+import Memory.Cache4KServer (CacheSrv (..), CacheSrvState)
+import Pantomime (Theory (..))
+import qualified Pantomime.BuiltIn as Pantomime
+import Proof.Memory.Cache4K.SMT.Axioms (cacheAxioms, coherentAxioms)
+import Proof.Memory.Cache4K.SMT.Raw (RawData)
+import Proof.Memory.Cache4K.CachedCore.Functional.Driver
+  ( cachedDriverMatchesSpec,
+    cachedDriverValues,
+  )
+import Proof.Memory.Cache4K.CachedCore.Functional.Invariant (cachedInvFunctional)
+import Proof.Memory.Cache4K.CachedCore.Functional.Machine (CachedSysG (..))
+import Proof.Memory.Cache4K.CachedCore.Functional.Obligation
+import Proof.Core.Functional.Machine (SysG (..))
+import Proof.Core.Functional.System (KState, sysOf)
+import Proof.Core.SMT.Array (RegArr, RegArrF (..))
+import Proof.SMT.Array (MemArr)
+import Proof.SMT.Logged (pantomime)
+import Types
+
+-- The driver -------------------------------------------------------------------
+--
+-- The cached system has the ideal system's core and input, and a cache with
+-- arbitrary tags, data, memory and state.
+
+-- | On systems the invariant relates to an ideal system, the driver agrees with
+-- its operational reading.
+{-# ANN cachedDriverMatchesSpecP (Theory cacheAxioms) #-}
+cachedDriverMatchesSpecP ::
+  Address -> SetIdx -> WordIdx ->
+  KState -> Core.Input -> RegArr -> MemArr ->
+  TagArr -> DataArr -> MemArr -> CacheSrvState ->
+  Pantomime.Bool
+cachedDriverMatchesSpecP wa wsi wwi ss i ra ma tags dat cma st =
+  Pantomime.boolean $ cachedDriverMatchesSpec wa wsi wwi sys csys
+  where
+    sys = sysOf ss i ra ma
+    csys =
+      CachedSys
+        (sysCore sys)
+        (sysInput sys)
+        (CacheSrv (Cache4K tags dat) cma st)
+
+-- | The driver is 0, 'penalty' or twice 'penalty', on any system.
+{-# ANN cachedDriverValuesP (Theory cacheAxioms) #-}
+cachedDriverValuesP ::
+  KState -> Core.Input -> RegArr -> MemArr ->
+  TagArr -> DataArr -> MemArr -> CacheSrvState ->
+  Pantomime.Bool
+cachedDriverValuesP ss i ra ma tags dat cma st =
+  Pantomime.boolean $ cachedDriverValues csys
+  where
+    sys = sysOf ss i ra ma
+    csys =
+      CachedSys
+        (sysCore sys)
+        (sysInput sys)
+        (CacheSrv (Cache4K tags dat) cma st)
+
+-- The invariant ----------------------------------------------------------------
+
+-- | The invariant is functional: two ideal systems related to the same cached
+-- system are equal. The cached system's core and input come from a third
+-- symbolic system; its cache is arbitrary.
+{-# ANN cachedInvFunctionalP (Theory cacheAxioms) #-}
+cachedInvFunctionalP ::
+  Address -> SetIdx -> WordIdx ->
+  KState -> Core.Input -> RegArr -> MemArr ->
+  KState -> Core.Input -> RegArr -> MemArr ->
+  KState -> Core.Input -> RegArr ->
+  TagArr -> DataArr -> MemArr -> CacheSrvState ->
+  Pantomime.Bool
+cachedInvFunctionalP
+  wa wsi wwi ss1 i1 ra1 ma1 ss2 i2 ra2 ma2 ss i ra tags dat cma st =
+    Pantomime.boolean $ cachedInvFunctional wa wsi wwi sys1 sys2 csys
+  where
+    sys1 = sysOf ss1 i1 ra1 ma1
+    sys2 = sysOf ss2 i2 ra2 ma2
+    csys0 = sysOf ss i ra cma
+    csys =
+      CachedSys
+        (sysCore csys0)
+        (sysInput csys0)
+        (CacheSrv (Cache4K tags dat) cma st)
+
+-- The base case ----------------------------------------------------------------
+
+-- | Under 'cacheAxioms': the initial cache is the empty one
+-- ('Memory.Cache4K.dataZero'), not a constructed one.
+{-# ANN baseCaseP (Theory cacheAxioms) #-}
+baseCaseP ::
+  Address -> SetIdx -> WordIdx -> Address -> RegArr -> MemArr -> Pantomime.Bool
+baseCaseP wa wsi wwi pc ra ma =
+  Pantomime.boolean $ baseCase wa wsi wwi pc (RegArrF ra) ma
+
+-- The inductive steps ----------------------------------------------------------
+--
+-- The ideal system is built from symbolic parts as in the core's proof
+-- ('Proof.Core.Functional.System.sysOf'); the cache adds its tags and the
+-- contents of its invalid lines.
+
+-- | The one-cycle hop: a request the cache answers at once.
+{-# ANN indStep0P (Theory coherentAxioms) #-}
+indStep0P ::
+  Address -> SetIdx -> WordIdx ->
+  KState -> Core.Input -> RegArr -> MemArr ->
+  TagArr -> RawData -> Pantomime.Bool
+indStep0P wa wsi wwi ss i ra ma tags raw =
+  Pantomime.boolean $ indStep0 wa wsi wwi (sysOf ss i ra ma) tags raw
+
+-- | The hop of a read that misses one line.
+{-# ANN indStep4P (Theory coherentAxioms) #-}
+indStep4P ::
+  Address -> SetIdx -> WordIdx ->
+  KState -> Core.Input -> RegArr -> MemArr ->
+  TagArr -> RawData -> Pantomime.Bool
+indStep4P wa wsi wwi ss i ra ma tags raw =
+  Pantomime.boolean $ indStep4 wa wsi wwi (sysOf ss i ra ma) tags raw
+
+-- | The hop of a read that misses both its lines.
+{-# ANN indStep8P (Theory coherentAxioms) #-}
+indStep8P ::
+  Address -> SetIdx -> WordIdx ->
+  KState -> Core.Input -> RegArr -> MemArr ->
+  TagArr -> RawData -> Pantomime.Bool
+indStep8P wa wsi wwi ss i ra ma tags raw =
+  Pantomime.boolean $ indStep8 wa wsi wwi (sysOf ss i ra ma) tags raw
+
+-- | The verdicts, spliced in by the plugin at compile time: 'Nothing' when the
+-- property is valid.
+results :: [(String, Maybe String)]
+results =
+  [ ("cachedDriverMatchesSpecP", $(pantomime 'cachedDriverMatchesSpecP)),
+    ("cachedDriverValuesP", $(pantomime 'cachedDriverValuesP)),
+    ("cachedInvFunctionalP", $(pantomime 'cachedInvFunctionalP)),
+    ("baseCaseP", $(pantomime 'baseCaseP)),
+    ("indStep0P", $(pantomime 'indStep0P)),
+    ("indStep4P", $(pantomime 'indStep4P)),
+    ("indStep8P", $(pantomime 'indStep8P))
+  ]
diff --git a/proof/Proof/Memory/Cache4K/CachedCore/Leakage/Driver.hs b/proof/Proof/Memory/Cache4K/CachedCore/Leakage/Driver.hs
new file mode 100644
index 0000000..0540698
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/CachedCore/Leakage/Driver.hs
@@ -0,0 +1,65 @@
+-- | The driver of link 2's leakage half: how many cycles the core behind the
+-- cache waits after a request, computed from the request's observation alone
+-- -- the counterpart of "Proof.Memory.Cache4K.CachedCore.Functional.Driver".
+module Proof.Memory.Cache4K.CachedCore.Leakage.Driver
+  ( simCachedDriver,
+    simCachedDriverSpec,
+    simCachedDriverMatchesSpec,
+  )
+where
+
+import Data.Maybe (fromMaybe)
+import Proof.Memory.Cache4K.Server.Leakage.Driver (simSrvDriver)
+import Proof.Memory.Cache4K.CachedCore.Leakage.Simulator
+  ( SimCachedInput,
+    SimCachedSys (..),
+    simStepCached,
+  )
+import Proof.Memory.Cache4K.Server.Leakage.Simulator (simSrvReady)
+import Proof.Core.Leakage.Model (Obs (..))
+
+-- | The cycles the core waits after a request observed as @inp@: the cache
+-- simulator's driver
+-- ('Proof.Memory.Cache4K.Server.Leakage.Driver.simSrvDriver') on that
+-- observation. Only ever run from a ready simulator, so whether the last cycle
+-- brought an answer is not consulted.
+simCachedDriver :: SimCachedSys -> SimCachedInput -> Int
+simCachedDriver (SimCachedSys sim _) inp =
+  simSrvDriver sim (fromMaybe NoAccess inp)
+
+-- | The operational reading of 'simCachedDriver', as
+-- 'Proof.Memory.Cache4K.Server.Leakage.Driver.simSrvDriverSpec' is of the cache
+-- simulator's: step on the observed request, then with no input until the
+-- simulator answers, and count the cycles after the request's. 'Nothing' if
+-- more than @fuel@ cycles follow the request's.
+simCachedDriverSpec :: Int -> SimCachedSys -> SimCachedInput -> Maybe Int
+simCachedDriverSpec fuel sim0 inp = go 0 (fst (simStepCached sim0 inp))
+  where
+    go n sim
+      | simCachedAnswered sim = Just n
+      | n >= fuel = Nothing
+      | otherwise = go (n + 1) (fst (simStepCached sim Nothing))
+
+-- | From a ready simulator -- its last cycle brought an answer, and the cache's
+-- simulator is ready
+-- ('Proof.Memory.Cache4K.Server.Leakage.Simulator.simSrvReady') -- its driver
+-- agrees with its operational reading, for the observation of any request: a
+-- hop starts with one, never in the middle of a driver hop. Eight cycles of
+-- fuel, 2 * 'penalty', cover the longest hop.
+--
+-- Follows from the cache simulator's
+-- ('Proof.Memory.Cache4K.Server.Leakage.Driver.simSrvDriverMatchesSpec'): since
+-- the last cycle brought an answer, 'simStepCached' passes the input on to the
+-- cache's simulator, and until it answers again passes it no input, so the
+-- cache's simulator is stepped exactly as
+-- 'Proof.Memory.Cache4K.Server.Leakage.Driver.simSrvDriverSpec' steps it, and
+-- 'simCachedDriver' is its driver.
+simCachedDriverMatchesSpec :: SimCachedSys -> Obs -> Bool
+simCachedDriverMatchesSpec sim@(SimCachedSys srvSim answered) obs =
+  not premises || conclusion
+  where
+    premises = answered && simSrvReady srvSim
+
+    conclusion =
+      simCachedDriverSpec 8 sim (Just obs)
+        == Just (simCachedDriver sim (Just obs))
diff --git a/proof/Proof/Memory/Cache4K/CachedCore/Leakage/Invariant.hs b/proof/Proof/Memory/Cache4K/CachedCore/Leakage/Invariant.hs
new file mode 100644
index 0000000..db27b78
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/CachedCore/Leakage/Invariant.hs
@@ -0,0 +1,33 @@
+-- | The invariant of link 2's leakage half: the cache's simulator agrees with
+-- the server of the core behind the cache -- the counterpart of
+-- "Proof.Memory.Cache4K.CachedCore.Functional.Invariant".
+--
+-- The steps assume link 2's functional invariant
+-- ('Proof.Memory.Cache4K.CachedCore.Functional.Invariant.cachedInvAt') as well,
+-- so this only adds the simulator
+-- ("Proof.Memory.Cache4K.CachedCore.Leakage.Simulator").
+module Proof.Memory.Cache4K.CachedCore.Leakage.Invariant
+  ( cachedSimInvAt,
+    simCachedOf,
+  )
+where
+
+import Memory.Cache4K (SetIdx)
+import Proof.Memory.Cache4K.CachedCore.Functional.Machine (CachedSysG (..))
+import Proof.Memory.Cache4K.Server.Leakage.Invariant (simOf, srvSimInvAt)
+import Proof.Memory.Cache4K.CachedCore.Leakage.Simulator (SimCachedSys (..))
+
+-- | The simulator agrees with the cached system at a hop boundary: the cache's
+-- simulator agrees with the server at set @wsi@, as in the cache's leakage
+-- proof ('Proof.Memory.Cache4K.Server.Leakage.Invariant.srvSimInvAt'), and the
+-- simulator records that an answer has just arrived.
+cachedSimInvAt :: SetIdx -> SimCachedSys -> CachedSysG r m -> Bool
+cachedSimInvAt wsi (SimCachedSys sim answered) (CachedSys _ _ srv) =
+  srvSimInvAt wsi sim srv && answered
+
+-- | The simulator a cached system determines at the start of a hop: the
+-- cache's simulator built from its server
+-- ('Proof.Memory.Cache4K.Server.Leakage.Invariant.simOf'), and an answer in the
+-- previous cycle, as at every hop boundary.
+simCachedOf :: CachedSysG r m -> SimCachedSys
+simCachedOf (CachedSys _ _ srv) = SimCachedSys (simOf srv) True
diff --git a/proof/Proof/Memory/Cache4K/CachedCore/Leakage/Obligation.hs b/proof/Proof/Memory/Cache4K/CachedCore/Leakage/Obligation.hs
new file mode 100644
index 0000000..047923a
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/CachedCore/Leakage/Obligation.hs
@@ -0,0 +1,224 @@
+-- | The obligations of link 2's leakage half, in one place: what the bus
+-- between the core and the cache shows follows from what the bus between the
+-- core and ideal memory shows -- the counterpart of
+-- "Proof.Memory.Cache4K.CachedCore.Functional.Obligation".
+--
+-- One cycle of the core behind ideal memory, with observation @o@, corresponds
+-- to @k + 1@ cycles of the core behind the cache: the first shows @o@ too, the
+-- other @k@ show no request. The cache's simulator, given @o@ alone, computes
+-- @k@ ('Proof.Memory.Cache4K.CachedCore.Leakage.Driver.simCachedDriver') and
+-- answers in the same cycles as the server. Together with the core's leakage
+-- proof, which gives the ideal observations from the ISA leakage, this gives
+-- the observations of the core behind the cache from the ISA leakage, with no
+-- combination of stalls to consider: the stalls are inserted one ideal cycle
+-- at a time.
+--
+-- The steps build the cached system from the ideal system, as the functional
+-- half does ('Proof.Memory.Cache4K.CachedCore.Functional.Obligation.cachedOf'),
+-- and the simulator from the cached system ('simCachedOf'), as the cache's
+-- leakage proof does from the server
+-- ('Proof.Memory.Cache4K.Server.Leakage.Invariant.simOf'). They assume link 2's
+-- functional invariant, which the functional half establishes, and add only the
+-- simulator's. One step per hop length, as in the functional half.
+--
+-- == Why they hold
+--
+-- The base case and the steps follow from the cache's leakage proof
+-- ("Proof.Memory.Cache4K.Server.Leakage.Obligation"), the contract
+-- ("Proof.Memory.Cache4K.Server.Functional.Contract") and link 2's functional
+-- half; they are checked here only as a sanity check of that argument.
+--
+--   * Base case: the cache's simulator and the server at start agree
+--     ('Proof.Memory.Cache4K.Server.Leakage.Obligation.baseCaseLeak'), and the
+--     core's input at start holds an answer, as the simulator at start records.
+--     The functional invariant at start is the functional half's base case.
+--
+--   * Step of length @k@: by the functional half, the first cycle's request is
+--     the ideal one, and in the @k@ cycles after it the core makes no request
+--     ('Proof.Memory.Cache4K.Server.Functional.Contract.corePatient'). In every
+--     cycle, the simulator, given the observation of the request, answers
+--     exactly when the server does and agrees with it afterwards
+--     ('Proof.Memory.Cache4K.Server.Leakage.Obligation.indStepLeak', once per
+--     cycle). The simulator's wait is the functional driver's: both are the
+--     cache's drivers, which agree with their operational readings
+--     ('Proof.Memory.Cache4K.Server.Functional.Contract.srvDriverMatchesSpec',
+--     'Proof.Memory.Cache4K.Server.Leakage.Driver.simSrvDriverMatchesSpec').
+module Proof.Memory.Cache4K.CachedCore.Leakage.Obligation
+  ( baseCaseLeak,
+    indStepLeak0,
+    indStepLeak4,
+    indStepLeak8,
+  )
+where
+
+import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
+import Core.RegFile (RegFileOps)
+import Memory.Cache4K
+import Memory.Cache4KServer
+import Memory.Types (MemOps (..))
+import Proof.Memory.Cache4K.CachedCore.Functional.Driver (cachedDriver)
+import Proof.Memory.Cache4K.CachedCore.Functional.Invariant (cachedInvAt)
+import Proof.Memory.Cache4K.CachedCore.Functional.Machine
+  ( CachedSysG (..),
+    initCachedSys,
+    stepCachedOut,
+  )
+import Proof.Memory.Cache4K.CachedCore.Functional.Obligation (cachedOf)
+import Proof.Memory.Cache4K.CachedCore.Leakage.Driver (simCachedDriver)
+import Proof.Memory.Cache4K.CachedCore.Leakage.Invariant
+  ( cachedSimInvAt,
+    simCachedOf,
+  )
+import Proof.Memory.Cache4K.CachedCore.Leakage.Simulator
+  ( SimCachedInput,
+    SimCachedSys (..),
+    simInitCachedSys,
+    simStepCached,
+  )
+import Proof.Memory.Cache4K.Server.Functional.Obligation (CoherentOps (..))
+import Proof.Memory.Cache4K.SMT.Raw (RawData (..))
+import Proof.Core.Functional.Machine (SysG (..), stepSysOut)
+import Proof.Core.Leakage.Model (Obs, obsOf)
+import Types (Address)
+import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
+
+-- | The observations of a run, cycle by cycle: what the attacker sees over a
+-- hop. A type of its own, rather than a list, so that its equality is derived
+-- here and the solver can unroll it; the equality of lists comes from @base@,
+-- whose definitions the solver cannot see.
+data Trace = TraceSingle Obs | TraceCons Obs Trace
+  deriving (Show, Eq)
+
+-- The base case ----------------------------------------------------------------
+
+-- | The base case: the simulator at start agrees with the core at start behind
+-- the cache at start, in front of any memory. Link 2's functional invariant at
+-- start is its functional base case
+-- ('Proof.Memory.Cache4K.CachedCore.Functional.Obligation.baseCase'). A sanity
+-- check: it follows from the cache's leakage base case (see the module header).
+baseCaseLeak :: SetIdx -> Address -> r -> m -> Bool
+baseCaseLeak wsi pc rf mem =
+  cachedSimInvAt wsi simInitCachedSys (initCachedSys pc rf mem)
+
+-- The inductive steps ----------------------------------------------------------
+
+-- | The one-cycle hop: a request the cache answers at once. A sanity check: it
+-- follows from the cache's leakage step and the contract (see the module
+-- header).
+indStepLeak0 ::
+  (RegFileOps r, Eq r, CoherentOps m) =>
+  Address -> SetIdx -> WordIdx -> SysG r m -> TagArr -> RawData -> Bool
+indStepLeak0 wa wsi wwi sys tags raw =
+  not premises || conclusion
+  where
+    csys = cachedOf sys tags raw
+    sim = simCachedOf csys
+
+    (_, out) = stepSysOut sys
+    obs = obsOf out
+
+    hopLength = 0
+
+    (tr1, csys') = stepCachedOutN hopLength csys
+    (tr2, sim') = simStepCachedN hopLength sim (Just obs)
+
+    premises =
+      cachedInvAt wa wsi wwi sys csys
+        && cachedSimInvAt wsi sim csys
+        && cachedDriver csys == hopLength
+
+    conclusion =
+      simCachedDriver sim (Just obs) == hopLength
+        && tr1 == tr2
+        && cachedSimInvAt wsi sim' csys'
+
+-- | The hop of a read that misses one line: 'penalty' + 1 cycle. A sanity
+-- check: it follows from the cache's leakage step and the contract (see the
+-- module header).
+indStepLeak4 ::
+  (RegFileOps r, Eq r, CoherentOps m) =>
+  Address -> SetIdx -> WordIdx -> SysG r m -> TagArr -> RawData -> Bool
+indStepLeak4 wa wsi wwi sys tags raw =
+  not premises || conclusion
+  where
+    csys = cachedOf sys tags raw
+    sim = simCachedOf csys
+
+    (_, out) = stepSysOut sys
+    obs = obsOf out
+
+    hopLength = fromIntegral penalty
+
+    (tr1, csys') = stepCachedOutN hopLength csys
+    (tr2, sim') = simStepCachedN hopLength sim (Just obs)
+
+    premises =
+      cachedInvAt wa wsi wwi sys csys
+        && cachedSimInvAt wsi sim csys
+        && cachedDriver csys == hopLength
+
+    conclusion =
+      simCachedDriver sim (Just obs) == hopLength
+        && tr1 == tr2
+        && cachedSimInvAt wsi sim' csys'
+
+-- | The hop of a read that misses both its lines: 2 * 'penalty' + 1 cycle. A
+-- sanity check: it follows from the cache's leakage step and the contract (see
+-- the module header).
+indStepLeak8 ::
+  (RegFileOps r, Eq r, CoherentOps m) =>
+  Address -> SetIdx -> WordIdx -> SysG r m -> TagArr -> RawData -> Bool
+indStepLeak8 wa wsi wwi sys tags raw =
+  not premises || conclusion
+  where
+    csys = cachedOf sys tags raw
+    sim = simCachedOf csys
+
+    (_, out) = stepSysOut sys
+    obs = obsOf out
+
+    hopLength = 2 * fromIntegral penalty
+
+    (tr1, csys') = stepCachedOutN hopLength csys
+    (tr2, sim') = simStepCachedN hopLength sim (Just obs)
+
+    premises =
+      cachedInvAt wa wsi wwi sys csys
+        && cachedSimInvAt wsi sim csys
+        && cachedDriver csys == hopLength
+
+    conclusion =
+      simCachedDriver sim (Just obs) == hopLength
+        && tr1 == tr2
+        && cachedSimInvAt wsi sim' csys'
+
+-- Helpers ----------------------------------------------------------------------
+
+-- | A hop of the cached system: @n + 1@ steps, the request's cycle and the @n@
+-- cycles the driver counts after it ('stepCachedOut' repeated). Returns the
+-- trace of the bus's observations and the system after the hop. Recursive on
+-- @n@, which each step fixes to a literal.
+stepCachedOutN ::
+  (RegFileOps r, MemOps m) =>
+  Int -> CachedSysG r m -> (Trace, CachedSysG r m)
+stepCachedOutN n csys
+  | n == 0 = (TraceSingle obs, csys')
+  | otherwise =
+    let (tr, csys'') = stepCachedOutN (n - 1) csys'
+    in (TraceCons obs tr, csys'')
+  where
+    (csys', out) = stepCachedOut csys
+    obs = obsOf out
+
+-- | The simulator's counterpart of 'stepCachedOutN' ('simStepCached'
+-- repeated): its input in the first cycle, then no input, as in the middle of
+-- a driver hop. Returns the trace of what it shows on the bus and the
+-- simulator after the hop.
+simStepCachedN :: Int -> SimCachedSys -> SimCachedInput -> (Trace, SimCachedSys)
+simStepCachedN n sim inp
+  | n == 0 = (TraceSingle bus, sim')
+  | otherwise =
+    let (tr, sim'') = simStepCachedN (n - 1) sim' Nothing
+    in (TraceCons bus tr, sim'')
+  where
+    (sim', bus) = simStepCached sim inp
diff --git a/proof/Proof/Memory/Cache4K/CachedCore/Leakage/Simulator.hs b/proof/Proof/Memory/Cache4K/CachedCore/Leakage/Simulator.hs
new file mode 100644
index 0000000..d532d11
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/CachedCore/Leakage/Simulator.hs
@@ -0,0 +1,70 @@
+-- | The simulator of link 2's leakage half: what the bus between the core and
+-- the cache shows, computed from what the bus between the core and ideal
+-- memory shows -- the counterpart of
+-- "Proof.Memory.Cache4K.CachedCore.Functional.Machine".
+--
+-- It runs cycle by cycle, as the core behind the cache does. In a cycle in
+-- which the core does not wait, its input is the observation the core behind
+-- ideal memory makes; while the core waits, it has no input. It carries only
+-- the cache's simulator ("Proof.Memory.Cache4K.Server.Leakage.Simulator"),
+-- which decides from the observations alone in which cycles the answer comes.
+module Proof.Memory.Cache4K.CachedCore.Leakage.Simulator
+  ( SimCachedInput,
+    SimCachedSys (..),
+    simInitCachedSys,
+    simStepCached,
+  )
+where
+
+import Data.Maybe (fromMaybe)
+import Proof.Memory.Cache4K.Server.Leakage.Simulator
+  ( SimCacheSrv,
+    simInitCacheSrv,
+    simServe,
+  )
+import Proof.Core.Leakage.Model (Obs (..))
+
+-- | The simulator's input in one cycle: the observation of the core behind
+-- ideal memory, or 'Nothing' while the core behind the cache waits.
+--
+-- 'Nothing' means the simulator is in the middle of a driver hop: the core
+-- behind ideal memory has no cycle here, and its trace does not advance. It is
+-- not the same as @'Just' 'NoAccess'@, a cycle of that core with no request,
+-- which does advance it.
+type SimCachedInput = Maybe Obs
+
+-- | The simulator's counterpart of
+-- 'Proof.Memory.Cache4K.CachedCore.Functional.Machine.CachedSysG': the cache's
+-- simulator, and what the core can see of its input -- whether the cache
+-- answered in the previous cycle, and so whether the core is no longer
+-- waiting.
+data SimCachedSys = SimCachedSys
+  { -- | The cache's simulator.
+    simCachedSrv :: SimCacheSrv,
+    -- | Did the cache answer in the previous cycle?
+    simCachedAnswered :: Bool
+  }
+  deriving (Show, Eq)
+
+-- | The simulator at start: the cache's simulator at start
+-- ('Proof.Memory.Cache4K.Server.Leakage.Simulator.simInitCacheSrv'), and an
+-- answer in the previous cycle, as the core's input at start holds one
+-- ('Core.Pipeline.initInput').
+simInitCachedSys :: SimCachedSys
+simInitCachedSys = SimCachedSys simInitCacheSrv True
+
+-- | One cycle of the core behind the cache, as
+-- 'Proof.Memory.Cache4K.CachedCore.Functional.Machine.stepCachedOut'. If the
+-- cache answered in the previous cycle, the core makes the ideal observation,
+-- and the cache's simulator is given it; otherwise the core waits, the bus
+-- shows no request and the simulator has no input. Returns the simulator
+-- afterwards and the bus's observation.
+simStepCached :: SimCachedSys -> SimCachedInput -> (SimCachedSys, Obs)
+simStepCached (SimCachedSys sim answered) inp
+  | answered =
+      let obs = fromMaybe NoAccess inp
+          (sim', ans) = simServe sim obs
+      in (SimCachedSys sim' ans, obs)
+  | otherwise =
+      let (sim', ans) = simServe sim NoAccess
+      in (SimCachedSys sim' ans, NoAccess)
diff --git a/proof/Proof/Memory/Cache4K/CachedCore/Leakage/Solver.hs b/proof/Proof/Memory/Cache4K/CachedCore/Leakage/Solver.hs
new file mode 100644
index 0000000..9c4d356
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/CachedCore/Leakage/Solver.hs
@@ -0,0 +1,109 @@
+-- | Link 2's leakage half, checked symbolically: the counterpart of
+-- "Proof.Memory.Cache4K.CachedCore.Functional.Solver".
+--
+-- The statements live in "Proof.Memory.Cache4K.CachedCore.Leakage.Driver" and
+-- "Proof.Memory.Cache4K.CachedCore.Leakage.Obligation"; this module only
+-- instantiates them, over every core state, input, register file, memory, tag
+-- array and witness. Each property is named after the statement it checks, with
+-- a @P@:
+--
+--   * the simulator's driver against its operational reading
+--     ('simCachedDriverMatchesSpecP');
+--   * the base case, and one step per hop length (0, 'penalty',
+--     2 * 'penalty'), each starting from a cache coherent by construction.
+--
+-- == Running them
+--
+-- Under Bitwuzla, not Z3:
+--
+-- > SBV_Z3=/usr/local/bin/bitwuzla SBV_Z3_OPTIONS="--produce-models" stack build
+module Proof.Memory.Cache4K.CachedCore.Leakage.Solver
+  ( simCachedDriverMatchesSpecP,
+    baseCaseLeakP,
+    indStepLeak0P,
+    indStepLeak4P,
+    indStepLeak8P,
+    results,
+  )
+where
+
+import qualified Core.Pipeline as Core
+import Memory.Cache4K
+import Pantomime (Theory (..))
+import qualified Pantomime.BuiltIn as Pantomime
+import Proof.Memory.Cache4K.CachedCore.Leakage.Driver (simCachedDriverMatchesSpec)
+import Proof.Memory.Cache4K.CachedCore.Leakage.Simulator (SimCachedSys (..))
+import Proof.Core.Leakage.Model (Obs)
+import Proof.Memory.Cache4K.Server.Leakage.Simulator
+  ( SimCacheSrv (..),
+    SimCacheSrvState,
+  )
+import Proof.Memory.Cache4K.CachedCore.Leakage.Obligation
+import Proof.Memory.Cache4K.SMT.Axioms (cacheAxioms, coherentAxioms)
+import Proof.Memory.Cache4K.SMT.Raw (RawData)
+import Proof.Core.Functional.System (KState, sysOf)
+import Proof.Core.SMT.Array (RegArr, RegArrF (..))
+import Proof.SMT.Array (MemArr)
+import Proof.SMT.Logged (pantomime)
+import Types
+
+-- The driver -------------------------------------------------------------------
+
+-- | From a ready simulator, its driver agrees with its operational reading, for
+-- the observation of any request.
+{-# ANN simCachedDriverMatchesSpecP (Theory cacheAxioms) #-}
+simCachedDriverMatchesSpecP ::
+  TagArr -> SimCacheSrvState -> Bool -> Obs -> Pantomime.Bool
+simCachedDriverMatchesSpecP tags sst answered obs =
+  Pantomime.boolean $ simCachedDriverMatchesSpec sim obs
+  where
+    sim = SimCachedSys (SimCacheSrv tags sst) answered
+
+-- The base case ----------------------------------------------------------------
+
+-- | The simulator at start agrees with the system at start, for any start
+-- PC, register file and memory.
+{-# ANN baseCaseLeakP (Theory cacheAxioms) #-}
+baseCaseLeakP :: SetIdx -> Address -> RegArr -> MemArr -> Pantomime.Bool
+baseCaseLeakP wsi pc ra ma =
+  Pantomime.boolean $ baseCaseLeak wsi pc (RegArrF ra) ma
+
+-- The inductive steps ----------------------------------------------------------
+
+-- | The one-cycle hop: a request the cache answers at once.
+{-# ANN indStepLeak0P (Theory coherentAxioms) #-}
+indStepLeak0P ::
+  Address -> SetIdx -> WordIdx ->
+  KState -> Core.Input -> RegArr -> MemArr ->
+  TagArr -> RawData -> Pantomime.Bool
+indStepLeak0P wa wsi wwi ss i ra ma tags raw =
+  Pantomime.boolean $ indStepLeak0 wa wsi wwi (sysOf ss i ra ma) tags raw
+
+-- | The hop of a read that misses one line.
+{-# ANN indStepLeak4P (Theory coherentAxioms) #-}
+indStepLeak4P ::
+  Address -> SetIdx -> WordIdx ->
+  KState -> Core.Input -> RegArr -> MemArr ->
+  TagArr -> RawData -> Pantomime.Bool
+indStepLeak4P wa wsi wwi ss i ra ma tags raw =
+  Pantomime.boolean $ indStepLeak4 wa wsi wwi (sysOf ss i ra ma) tags raw
+
+-- | The hop of a read that misses both its lines.
+{-# ANN indStepLeak8P (Theory coherentAxioms) #-}
+indStepLeak8P ::
+  Address -> SetIdx -> WordIdx ->
+  KState -> Core.Input -> RegArr -> MemArr ->
+  TagArr -> RawData -> Pantomime.Bool
+indStepLeak8P wa wsi wwi ss i ra ma tags raw =
+  Pantomime.boolean $ indStepLeak8 wa wsi wwi (sysOf ss i ra ma) tags raw
+
+-- | The verdicts, spliced in by the plugin at compile time: 'Nothing' when the
+-- property is valid.
+results :: [(String, Maybe String)]
+results =
+  [ ("simCachedDriverMatchesSpecP", $(pantomime 'simCachedDriverMatchesSpecP)),
+    ("baseCaseLeakP", $(pantomime 'baseCaseLeakP)),
+    ("indStepLeak0P", $(pantomime 'indStepLeak0P)),
+    ("indStepLeak4P", $(pantomime 'indStepLeak4P)),
+    ("indStepLeak8P", $(pantomime 'indStepLeak8P))
+  ]
diff --git a/proof/Proof/Cache/SMT/Array.hs b/proof/Proof/Memory/Cache4K/SMT/Array.hs
similarity index 76%
rename from proof/Proof/Cache/SMT/Array.hs
rename to proof/Proof/Memory/Cache4K/SMT/Array.hs
index 8391abe..911a605 100644
--- a/proof/Proof/Cache/SMT/Array.hs
+++ b/proof/Proof/Memory/Cache4K/SMT/Array.hs
@@ -2,17 +2,19 @@
 
 -- | The arrays of "Memory.Cache4K" embedded as SMT arrays, as "Proof.SMT.Array"
 -- embeds the register file and memory: a monomorphic SMT newtype per array, and
--- an embedding per wrapper, which the term axioms in "Proof.Cache.SMT.Axioms"
--- put in place of the wrapper.
-module Proof.Cache.SMT.Array
+-- an embedding per wrapper, which the term axioms in
+-- "Proof.Memory.Cache4K.SMT.Axioms" put in place of the wrapper.
+module Proof.Memory.Cache4K.SMT.Array
   ( TagArrSMT (..),
     tagReadE,
     tagWriteE,
     tagEmptyE,
+    tagEqE,
     DataArrSMT (..),
     dataReadE,
     dataWriteE,
     dataZeroE,
+    dataEqE,
   )
 where
 
@@ -50,11 +52,18 @@ tagWriteE ::
 tagWriteE = coerce go
   where
     go :: Clash.BitVec 8 -> Clash.BitVec 21 -> TagArrSMT -> TagArrSMT
-    go (Clash.BitVecP k) (Clash.BitVecP v) (TagArrSMT arr) = TagArrSMT (P.astore arr k v)
+    go (Clash.BitVecP k) (Clash.BitVecP v) (TagArrSMT arr) =
+      TagArrSMT (P.astore arr k v)
 
 tagEmptyE :: forall arr. (Coercible TagArrSMT arr) => arr
 tagEmptyE = coerce (TagArrSMT (P.aconst 0))
 
+tagEqE :: forall arr. (Coercible TagArrSMT arr) => arr -> arr -> Bool
+tagEqE = coerce go
+  where
+    go :: TagArrSMT -> TagArrSMT -> Bool
+    go (TagArrSMT a) (TagArrSMT b) = a == b
+
 -- | 'Memory.Cache4K.DataArr' on the SMT side.
 newtype DataArrSMT = DataArrSMT (P.Array (P.BitVec 10) (P.BitVec 32))
 
@@ -83,7 +92,14 @@ dataWriteE ::
 dataWriteE = coerce go
   where
     go :: Clash.BitVec 10 -> Clash.BitVec 32 -> DataArrSMT -> DataArrSMT
-    go (Clash.BitVecP k) (Clash.BitVecP v) (DataArrSMT arr) = DataArrSMT (P.astore arr k v)
+    go (Clash.BitVecP k) (Clash.BitVecP v) (DataArrSMT arr) =
+      DataArrSMT (P.astore arr k v)
 
 dataZeroE :: forall arr. (Coercible DataArrSMT arr) => arr
 dataZeroE = coerce (DataArrSMT (P.aconst 0))
+
+dataEqE :: forall arr. (Coercible DataArrSMT arr) => arr -> arr -> Bool
+dataEqE = coerce go
+  where
+    go :: DataArrSMT -> DataArrSMT -> Bool
+    go (DataArrSMT a) (DataArrSMT b) = a == b
diff --git a/proof/Proof/Cache/SMT/Axioms.hs b/proof/Proof/Memory/Cache4K/SMT/Axioms.hs
similarity index 58%
rename from proof/Proof/Cache/SMT/Axioms.hs
rename to proof/Proof/Memory/Cache4K/SMT/Axioms.hs
index 351d8d0..e116f9f 100644
--- a/proof/Proof/Cache/SMT/Axioms.hs
+++ b/proof/Proof/Memory/Cache4K/SMT/Axioms.hs
@@ -1,16 +1,27 @@
 -- | The axioms for the properties about "Memory.Cache4K": those of the register
 -- file and memory, and the two cache arrays. In its own module for the same
 -- reason as "Proof.SMT.Axioms".
-module Proof.Cache.SMT.Axioms (cacheAxioms, coherentAxioms) where
+module Proof.Memory.Cache4K.SMT.Axioms (cacheAxioms, coherentAxioms) where
 
 import qualified Data.Map as Map
-import Memory.Cache4K (DataArr, TagArr, dataRead, dataWrite, dataZero, tagEmpty, tagRead, tagWrite)
+import Memory.Cache4K
+  ( DataArr,
+    TagArr,
+    dataEq,
+    dataRead,
+    dataWrite,
+    dataZero,
+    tagEmpty,
+    tagEq,
+    tagRead,
+    tagWrite,
+  )
 import Pantomime (PluginAxioms (..))
-import Proof.SMT.Axioms (arrayAxioms)
-import Proof.Cache.SMT.Array
-import Proof.Cache.Functional.Obligation (mkDataMem)
-import Proof.Cache.SMT.Coherent
-import Proof.Cache.SMT.Raw
+import Proof.Core.SMT.Axioms (arrayAxioms)
+import Proof.Memory.Cache4K.SMT.Array
+import Proof.Memory.Cache4K.Server.Functional.Obligation (mkDataMem)
+import Proof.Memory.Cache4K.SMT.Coherent
+import Proof.Memory.Cache4K.SMT.Raw
 
 cacheAxioms :: PluginAxioms
 cacheAxioms =
@@ -25,19 +36,22 @@ cacheAxioms =
           [ ('tagRead, 'tagReadE),
             ('tagWrite, 'tagWriteE),
             ('tagEmpty, 'tagEmptyE),
+            ('tagEq, 'tagEqE),
             ('dataRead, 'dataReadE),
             ('dataWrite, 'dataWriteE),
-            ('dataZero, 'dataZeroE)
+            ('dataZero, 'dataZeroE),
+            ('dataEq, 'dataEqE)
           ]
       }
 
 -- | The axioms for the cache's proof: as 'cacheAxioms', but the data array is
--- embedded as 'Proof.Cache.SMT.Coherent.DataC', so that
--- 'Proof.Cache.Functional.Obligation.mkData' builds a cache coherent by
--- construction (through its 'MemArr' instance,
--- 'Proof.Cache.Functional.Obligation.mkDataMem'). The raw-array and tag axioms
--- come first: an embedding that calls another wrapper ('dataReadC' calls
--- 'rawRead' and 'tagRead') only sees the axioms listed before its own.
+-- embedded as 'Proof.Memory.Cache4K.SMT.Coherent.DataC', so that
+-- 'Proof.Memory.Cache4K.Server.Functional.Obligation.mkData' builds a cache
+-- coherent by construction (through its 'MemArr' instance,
+-- 'Proof.Memory.Cache4K.Server.Functional.Obligation.mkDataMem'). The raw-array
+-- and tag axioms come first: an embedding that calls another wrapper
+-- ('dataReadC' calls 'rawRead' and 'tagRead') only sees the axioms listed
+-- before its own.
 coherentAxioms :: PluginAxioms
 coherentAxioms =
   arrayAxioms
diff --git a/proof/Proof/Cache/SMT/Coherent.hs b/proof/Proof/Memory/Cache4K/SMT/Coherent.hs
similarity index 75%
rename from proof/Proof/Cache/SMT/Coherent.hs
rename to proof/Proof/Memory/Cache4K/SMT/Coherent.hs
index 562158b..a89e244 100644
--- a/proof/Proof/Cache/SMT/Coherent.hs
+++ b/proof/Proof/Memory/Cache4K/SMT/Coherent.hs
@@ -1,6 +1,7 @@
 -- | The SMT side of a cache that is coherent by construction
--- ('Proof.Cache.Functional.Obligation.cachedOf'): the term axioms in
--- "Proof.Cache.SMT.Axioms" ('Proof.Cache.SMT.Axioms.coherentAxioms') embed
+-- ('Proof.Memory.Cache4K.Server.Functional.Obligation.cachedOf'): the term
+-- axioms in "Proof.Memory.Cache4K.SMT.Axioms"
+-- ('Proof.Memory.Cache4K.SMT.Axioms.coherentAxioms') embed
 -- 'Memory.Cache4K.DataArr' as 'DataC', which carries only arrays:
 --
 --   * the words written since construction, and which slots were written;
@@ -10,7 +11,7 @@
 -- is valid, else the raw word. Everything stays an array, so the solver can
 -- share it across the cache's branches; a Haskell function in its place makes
 -- the longest hop exhaust memory before the query is even built.
-module Proof.Cache.SMT.Coherent
+module Proof.Memory.Cache4K.SMT.Coherent
   ( DataC (..),
     dataReadC,
     dataWriteC,
@@ -22,7 +23,7 @@ import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
 import Data.Coerce (Coercible, coerce)
 import Memory.Cache4K
 import Memory.Types (MemOps (..))
-import Proof.Cache.SMT.Raw
+import Proof.Memory.Cache4K.SMT.Raw
 import Proof.SMT.Array (MemArr)
 import Types (Word)
 import Prelude hiding (Ordering (..), Word, init, log, not, repeat, undefined, (!!), (&&), (++), (||))
@@ -46,12 +47,16 @@ dataReadC i a
     e = tagRead si tags
 
 -- | The embedding of 'Memory.Cache4K.dataWrite'.
-dataWriteC :: forall arr. (Coercible DataC arr) => BitVector 10 -> Word -> arr -> arr
-dataWriteC i v a = coerce (DataC (rawWrite i v ws) (rawWrite i 1 written) mem tags raw)
+dataWriteC ::
+  forall arr. (Coercible DataC arr) => BitVector 10 -> Word -> arr -> arr
+dataWriteC i v a =
+  coerce (DataC (rawWrite i v ws) (rawWrite i 1 written) mem tags raw)
   where
     DataC ws written mem tags raw = coerce a
 
--- | The embedding of 'Proof.Cache.Functional.Obligation.mkDataMem': nothing
+-- | The embedding of
+-- 'Proof.Memory.Cache4K.Server.Functional.Obligation.mkDataMem': nothing
 -- written yet.
-mkDataC :: forall arr. (Coercible DataC arr) => MemArr -> TagArr -> RawData -> arr
+mkDataC ::
+  forall arr. (Coercible DataC arr) => MemArr -> TagArr -> RawData -> arr
 mkDataC mem t raw = coerce (DataC rawZero rawZero mem t raw)
diff --git a/proof/Proof/Cache/SMT/Raw.hs b/proof/Proof/Memory/Cache4K/SMT/Raw.hs
similarity index 79%
rename from proof/Proof/Cache/SMT/Raw.hs
rename to proof/Proof/Memory/Cache4K/SMT/Raw.hs
index 24adb26..dfbe140 100644
--- a/proof/Proof/Cache/SMT/Raw.hs
+++ b/proof/Proof/Memory/Cache4K/SMT/Raw.hs
@@ -1,11 +1,12 @@
 -- | A raw array of 1024 words, indexed like the cache's data array: the
 -- arbitrary contents of a coherent cache's invalid lines
--- ('Proof.Cache.Functional.Obligation.cachedOf'). The term axioms in
--- "Proof.Cache.SMT.Axioms" embed it as 'Proof.Cache.SMT.Array.DataArrSMT'.
+-- ('Proof.Memory.Cache4K.Server.Functional.Obligation.cachedOf'). The term
+-- axioms in "Proof.Memory.Cache4K.SMT.Axioms" embed it as
+-- 'Proof.Memory.Cache4K.SMT.Array.DataArrSMT'.
 --
 -- In a module of its own, without the solver's types, so that the obligations
 -- can mention it and still build without the solver.
-module Proof.Cache.SMT.Raw
+module Proof.Memory.Cache4K.SMT.Raw
   ( RawData (..),
     rawRead,
     rawWrite,
diff --git a/proof/Proof/Memory/Cache4K/Server/Functional/Contract.hs b/proof/Proof/Memory/Cache4K/Server/Functional/Contract.hs
new file mode 100644
index 0000000..7b76c44
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/Server/Functional/Contract.hs
@@ -0,0 +1,120 @@
+-- | The contract between the core and the 4 KiB cache in front of memory: what
+-- each side promises beyond the cache's proof against ideal memory
+-- ("Proof.Memory.Cache4K.Server.Functional.Obligation"), so that the core runs
+-- behind the cache as it would behind ideal memory, with stutter steps
+-- inserted.
+--
+-- The two sides are not symmetric: the core makes the requests and the cache
+-- answers them.
+--
+--   * The core waits for what it asked for ('corePatient'): after a request,
+--     given no answer, it makes no request and its state stays the same.
+--   * The cache answers 'Nothing' only while a request is outstanding. Ready
+--     is defined by behaviour ('srvReady'): asked nothing, the server answers
+--     within the cycle and stays the same. After a step, a server is ready
+--     exactly when it has answered ('srvReadyIffAnswered'), a server related
+--     to ideal memory by the invariant is ready ('srvReadyUnderInv'), and from
+--     a ready server the driver agrees with its operational reading
+--     ('srvDriverMatchesSpec').
+--     While a request is outstanding, the driver and the cache's step
+--     obligations say how it answers: 'Nothing' for as many cycles as the
+--     driver counts, then ideal memory's answer.
+--
+-- Both sides are treated as opaque: states are compared whole, with '==',
+-- not field by field.
+--
+-- The properties are checked in
+-- "Proof.Memory.Cache4K.Server.Functional.Solver".
+module Proof.Memory.Cache4K.Server.Functional.Contract
+  ( srvReady,
+    srvDriverSpec,
+    srvReadyIffAnswered,
+    srvReadyUnderInv,
+    srvDriverMatchesSpec,
+    corePatient,
+  )
+where
+
+import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
+import Core.Pipeline (Input (..), Output (..), Request, StateG (..), circuit)
+import Data.Maybe (isJust, isNothing)
+import Memory.Cache4KServer (CacheSrv (..), serve)
+import Memory.Types (MemOps)
+import Proof.Memory.Cache4K.Server.Functional.Driver (srvDriver)
+import Proof.Memory.Cache4K.Server.Functional.Invariant (srvInvAt)
+import Core.RegFile (RegFileOps (..))
+import Types (Address)
+import Memory.Cache4K (SetIdx, WordIdx)
+import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
+
+-- The cache's side --------------------------------------------------------------
+
+-- | Is the server ready for a request? Defined by its behaviour, not by its
+-- fields: asked nothing, it answers within the cycle and stays the same.
+srvReady :: (MemOps m, Eq m) => CacheSrv m -> Bool
+srvReady srv =
+  let (srv', ans) = serve srv Nothing
+  in srv' == srv && ans == Input (Just 0)
+
+-- | After a step, the server is ready exactly when it has answered.
+srvReadyIffAnswered :: (MemOps m, Eq m) => CacheSrv m -> Request -> Bool
+srvReadyIffAnswered srv req =
+  let (srv', ans) = serve srv req
+  in srvReady srv' == isJust (inputMem ans)
+
+-- | A server related to ideal memory by the invariant is ready.
+srvReadyUnderInv ::
+  (MemOps m, Eq m) =>
+  Address -> SetIdx -> WordIdx -> m -> CacheSrv m -> Bool
+srvReadyUnderInv wa wsi wwi ideal srv =
+  not premises || conclusion
+  where
+    premises = srvInvAt wa wsi wwi ideal srv
+
+    conclusion = srvReady srv
+
+-- | How many cycles after a request the server answers, by serving: serve the
+-- request, then serve without one until the server answers, and count the
+-- cycles after the request's. 'Nothing' if more than @fuel@ cycles follow the
+-- request's. The operational reading of a memory's driver, such as
+-- 'Proof.Memory.Cache4K.Server.Functional.Driver.srvDriver'
+-- ('srvDriverMatchesSpec').
+srvDriverSpec :: (MemOps m) => Int -> CacheSrv m -> Request -> Maybe Int
+srvDriverSpec fuel srv0 req =
+  let (srv', ans) = serve srv0 req
+  in go 0 srv' (isJust (inputMem ans))
+  where
+    go n srv answered
+      | answered = Just n
+      | n >= fuel = Nothing
+      | otherwise =
+        let (srv', ans) = serve srv Nothing
+        in go (n + 1) srv' (isJust (inputMem ans))
+
+-- | From a ready server ('srvReady'), the driver
+-- ('Proof.Memory.Cache4K.Server.Functional.Driver.srvDriver') agrees with its
+-- operational reading ('srvDriverSpec').
+-- Eight cycles of fuel, 2 * 'penalty', cover the longest hop, two missed
+-- lines, and no more, since Pantomime unrolls all of them. Readiness suffices,
+-- unlike for the core ('Proof.Core.Functional.Driver.driverMatchesSpec'): the
+-- driver only asks which lines hit, so every ready server is a valid start,
+-- and the invariant, which implies readiness, would only narrow the statement.
+srvDriverMatchesSpec :: (MemOps m, Eq m) => CacheSrv m -> Request -> Bool
+srvDriverMatchesSpec srv req =
+  not premises || conclusion
+  where
+    premises = srvReady srv
+
+    conclusion = srvDriverSpec 8 srv req == Just (srvDriver srv req)
+
+-- The core's side ---------------------------------------------------------------
+
+-- | The core waits for what it asked for: after a request, given no answer, it
+-- makes no request and stays where it was.
+corePatient :: (RegFileOps r, Eq r) => StateG r -> Input -> Bool
+corePatient s inp = case outputMem o of
+  Nothing -> True
+  Just _ -> s'' == s' && isNothing (outputMem o')
+  where
+    (s', o) = circuit s inp
+    (s'', o') = circuit s' (Input Nothing)
diff --git a/proof/Proof/Memory/Cache4K/Server/Functional/Driver.hs b/proof/Proof/Memory/Cache4K/Server/Functional/Driver.hs
new file mode 100644
index 0000000..1d4ce3d
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/Server/Functional/Driver.hs
@@ -0,0 +1,54 @@
+-- | The cache's driver: how many cycles after a request the cache's answer is
+-- final -- the cache's counterpart of "Proof.Core.Functional.Driver".
+--
+-- 'srvDriver' is a case table over the cache and the request. Its operational
+-- reading, obtained by actually serving, makes sense for any memory and so
+-- lives in the contract
+-- ('Proof.Memory.Cache4K.Server.Functional.Contract.srvDriverSpec'), together
+-- with the property that the two agree.
+module Proof.Memory.Cache4K.Server.Functional.Driver
+  ( srvDriver,
+    srvDriverValues,
+  )
+where
+
+import Core.Pipeline (MemAccess (..), Request)
+import Memory.Cache4K (cacheHit, setOf)
+import Memory.Cache4KServer
+import Types
+
+-- | The cycles after the request until the cache's answer is final: 'penalty'
+-- for every line a data read misses, nothing for anything else. A read touches
+-- the lines of its first and last byte; within four bytes those are different
+-- lines exactly when they are in different sets. The driver is only ever run
+-- from servers that satisfy the invariant
+-- ('Proof.Memory.Cache4K.Server.Functional.Invariant.srvInvAt'), which are
+-- ready, so the server's state is not consulted; elsewhere it need not agree
+-- with 'srvDriverSpec'.
+srvDriver :: CacheSrv m -> Request -> Int
+srvDriver (CacheSrv c _ _) req = case req of
+  Just (MemRead addr size) ->
+    let off = case size of
+          Byte -> 0
+          Half -> 1
+          Word -> 3
+
+        hit1stLine = cacheHit addr c
+        penalty1stLine = if hit1stLine then 0 else fromIntegral penalty
+
+        hit2ndLine = setOf (addr + off) == setOf addr || cacheHit (addr + off) c
+        penalty2ndLine = if hit2ndLine then 0 else fromIntegral penalty
+
+    in penalty1stLine + penalty2ndLine
+  _ -> 0
+
+-- | The driver is 0, 'penalty' or twice 'penalty': the hop lengths of the
+-- cache's steps ('Proof.Memory.Cache4K.Server.Functional.Obligation.indStep0',
+-- 'Proof.Memory.Cache4K.Server.Functional.Obligation.indStep4',
+-- 'Proof.Memory.Cache4K.Server.Functional.Obligation.indStep8'), which so cover
+-- every hop.
+srvDriverValues :: CacheSrv m -> Request -> Bool
+srvDriverValues srv req =
+  k == 0 || k == fromIntegral penalty || k == 2 * fromIntegral penalty
+  where
+    k = srvDriver srv req
diff --git a/proof/Proof/Cache/Functional/Invariant.hs b/proof/Proof/Memory/Cache4K/Server/Functional/Invariant.hs
similarity index 68%
rename from proof/Proof/Cache/Functional/Invariant.hs
rename to proof/Proof/Memory/Cache4K/Server/Functional/Invariant.hs
index bfb678d..1c8a72b 100644
--- a/proof/Proof/Cache/Functional/Invariant.hs
+++ b/proof/Proof/Memory/Cache4K/Server/Functional/Invariant.hs
@@ -3,9 +3,10 @@
 -- many more bytes, so the invariant is stated at a witness byte and a witness
 -- word, and the obligations quantify over them, as the core's invariant does
 -- over a register and a byte.
-module Proof.Cache.Functional.Invariant
+module Proof.Memory.Cache4K.Server.Functional.Invariant
   ( coherentAt,
-    srvInvAt
+    srvInvAt,
+    srvInvFunctional,
   )
 where
 
@@ -30,8 +31,23 @@ coherentAt wsi wwi mem c =
 -- server to ideal memory @ideal@: no miss is pending, the server's memory holds
 -- ideal memory's byte @wa@, and if the line is valid, its word @wwi@ is the
 -- server's memory's.
-srvInvAt :: (MemOps m) => Address -> SetIdx -> WordIdx -> m -> CacheSrv m -> Bool
+srvInvAt ::
+  (MemOps m) => Address -> SetIdx -> WordIdx -> m -> CacheSrv m -> Bool
 srvInvAt wa wsi wwi ideal (CacheSrv c mem st) =
   st == CacheSrvReady &&
   memReadByte wa ideal == memReadByte wa mem &&
   coherentAt wsi wwi mem c
+
+-- | The invariant is functional: two ideal memories it relates to the same
+-- server are equal, at byte @wa@. Quantifying over @wa@ gives equality of the
+-- memories.
+srvInvFunctional ::
+  (MemOps m) =>
+  Address -> SetIdx -> WordIdx -> m -> m -> CacheSrv m -> Bool
+srvInvFunctional wa wsi wwi ideal1 ideal2 srv =
+  not premises || conclusion
+  where
+    premises =
+      srvInvAt wa wsi wwi ideal1 srv && srvInvAt wa wsi wwi ideal2 srv
+
+    conclusion = memReadByte wa ideal1 == memReadByte wa ideal2
diff --git a/proof/Proof/Memory/Cache4K/Server/Functional/Obligation.hs b/proof/Proof/Memory/Cache4K/Server/Functional/Obligation.hs
new file mode 100644
index 0000000..e61c213
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/Server/Functional/Obligation.hs
@@ -0,0 +1,212 @@
+{-# LANGUAGE InstanceSigs #-}
+-- | The cache's proof obligations, in one place: the cache's counterpart of
+-- "Proof.Core.Functional.Obligation".
+--
+-- They relate the cached memory to ideal memory ("Memory.Ideal") one request at
+-- a time: ideal memory answers in one cycle, the cached memory in
+-- 'Proof.Memory.Cache4K.Server.Functional.Driver.srvDriver' + 1 cycles. As the
+-- core's obligations build the ISA state from the system
+-- ('Proof.Core.Functional.Invariant.isaOf'), these take ideal memory to be the
+-- server's memory before the hop; the conclusion compares the memory ideal
+-- memory steps to with the server's after the hop.
+--
+-- Every step starts from a ready server whose cache is coherent by
+-- construction ('mkData'): valid lines hold memory's words, invalid lines
+-- arbitrary ones. So coherence is not assumed but built in, as the core's ISA
+-- state is built from the system.
+--
+-- From a server that satisfies the invariant the driver is 0, 'penalty' or
+-- twice 'penalty' (no, one or two lines missed), so there is one step
+-- obligation per hop length, named after it for @'penalty' = 4@. Split by
+-- length because Pantomime unrolls recursion only when its count is concrete.
+-- A step states only the last answer and the invariant after the hop; that the
+-- answers before the last are 'Nothing' is stated apart, as a sanity check
+-- ('indStepWaits4', 'indStepWaits8'), since it follows from the driver's
+-- agreement with its operational reading.
+module Proof.Memory.Cache4K.Server.Functional.Obligation
+  ( CoherentOps (..),
+    mkDataMem,
+    baseCase,
+    indStep0,
+    indStep4,
+    indStepWaits4,
+    indStep8,
+    indStepWaits8,
+  )
+where
+
+import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
+import Core.Pipeline (Input (..), Request)
+import Memory.Cache4K
+import Memory.Cache4KServer
+import Memory.Ideal (idealServe)
+import Memory.Types (MemOps (..))
+import Proof.Memory.Cache4K.Server.Functional.Driver (srvDriver)
+import Proof.Memory.Cache4K.Server.Functional.Invariant (srvInvAt)
+import Proof.Memory.Cache4K.SMT.Raw (RawData (..))
+import Proof.SMT.Array (MemArr)
+import Types (Address, Word)
+import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
+
+-- The coherent cache -----------------------------------------------------------
+
+-- | Memories a coherent cache can be built from. A class, as memory's
+-- operations are ('MemOps'), so that the obligations stay polymorphic in memory
+-- and the solver only meets the monomorphic 'mkDataMem'.
+class (MemOps m) => CoherentOps m where
+  -- | The data array of a coherent cache with the tag array @tags@ in front of
+  -- @mem@: a valid line holds memory's words at the address its tag gives, an
+  -- invalid line the words of @raw@.
+  mkData :: m -> TagArr -> RawData -> DataArr
+
+instance CoherentOps MemArr where
+  mkData :: MemArr -> TagArr -> RawData -> DataArr
+  mkData = mkDataMem
+
+-- | 'mkData' on the solver's memory. The solver does not run this body:
+-- 'Proof.Memory.Cache4K.SMT.Axioms.coherentAxioms' replaces it by
+-- 'Proof.Memory.Cache4K.SMT.Coherent.mkDataC'.
+{-# OPAQUE mkDataMem #-}
+mkDataMem :: MemArr -> TagArr -> RawData -> DataArr
+mkDataMem mem tags (RawData raw) = DataArr (imap word raw)
+  where
+    word :: Index 1024 -> Word -> Word
+    word i w
+      | entryValid e = memReadWord (wordAddr (entryTag e) si wi 0) mem
+      | otherwise = w
+      where
+        idx = fromIntegral i :: BitVector 10
+        si = slice d9 d2 idx
+        wi = slice d1 d0 idx
+        e = tagRead si tags
+
+-- The base case ----------------------------------------------------------------
+
+-- | The base case: the server at start, in front of any memory, satisfies the
+-- invariant against that memory.
+baseCase ::
+  (MemOps m) => Address -> SetIdx -> WordIdx -> m -> Bool
+baseCase wa wsi wwi mem =
+  srvInvAt wa wsi wwi mem (initCacheSrv mem)
+
+-- The inductive steps ----------------------------------------------------------
+
+-- | The one-cycle hop: a request the cache answers at once.
+indStep0 ::
+  (CoherentOps m) =>
+  Address -> SetIdx -> WordIdx -> m -> TagArr -> RawData -> Request -> Bool
+indStep0 wa wsi wwi mem tags raw req =
+  not premises || conclusion
+  where
+    ideal = mem
+    srv = CacheSrv (Cache4K tags (mkData mem tags raw)) mem CacheSrvReady
+
+    (ideal', idealAns) = idealServe ideal req
+    (srv', ans) = serve srv req
+
+    premises =
+      srvInvAt wa wsi wwi ideal srv
+        && srvDriver srv req == 0
+
+    conclusion =
+      ans == idealAns
+        && srvInvAt wa wsi wwi ideal' srv'
+
+-- | The hop of a read that misses one line: 'penalty' + 1 cycle.
+indStep4 ::
+  (CoherentOps m) =>
+  Address -> SetIdx -> WordIdx -> m -> TagArr -> RawData -> Request -> Bool
+indStep4 wa wsi wwi mem tags raw req =
+  not premises || conclusion
+  where
+    ideal = mem
+    srv = CacheSrv (Cache4K tags (mkData mem tags raw)) mem CacheSrvReady
+
+    (ideal', idealAns) = idealServe ideal req
+    (srv', ans) = serveN (fromIntegral penalty) srv req
+
+    premises =
+      srvInvAt wa wsi wwi ideal srv
+        && srvDriver srv req == fromIntegral penalty
+
+    conclusion =
+      ans == idealAns
+        && srvInvAt wa wsi wwi ideal' srv'
+
+-- | Sanity check for 'indStep4': during the hop, the first 'penalty' answers
+-- are 'Nothing'. Implied by
+-- 'Proof.Memory.Cache4K.Server.Functional.Contract.srvDriverMatchesSpec':
+-- 'Proof.Memory.Cache4K.Server.Functional.Contract.srvDriverSpec' counts the
+-- cycles until the first answer.
+indStepWaits4 ::
+  (CoherentOps m) =>
+  Address -> SetIdx -> WordIdx -> m -> TagArr -> RawData -> Request -> Bool
+indStepWaits4 wa wsi wwi mem tags raw req =
+  not premises || conclusion
+  where
+    srv = CacheSrv (Cache4K tags (mkData mem tags raw)) mem CacheSrvReady
+
+    premises =
+      srvInvAt wa wsi wwi mem srv
+        && srvDriver srv req == fromIntegral penalty
+
+    conclusion = stallsFor (fromIntegral penalty) srv req
+
+-- | The hop of a read that misses both its lines: 2 * 'penalty' + 1 cycle.
+indStep8 ::
+  (CoherentOps m) =>
+  Address -> SetIdx -> WordIdx -> m -> TagArr -> RawData -> Request -> Bool
+indStep8 wa wsi wwi mem tags raw req =
+  not premises || conclusion
+  where
+    ideal = mem
+    srv = CacheSrv (Cache4K tags (mkData mem tags raw)) mem CacheSrvReady
+
+    (ideal', idealAns) = idealServe ideal req
+    (srv', ans) = serveN (2 * fromIntegral penalty) srv req
+
+    premises =
+      srvInvAt wa wsi wwi ideal srv
+        && srvDriver srv req == 2 * fromIntegral penalty
+
+    conclusion =
+      ans == idealAns
+        && srvInvAt wa wsi wwi ideal' srv'
+
+-- | Sanity check for 'indStep8': during the hop, the first 2 * 'penalty'
+-- answers are 'Nothing'. Implied by
+-- 'Proof.Memory.Cache4K.Server.Functional.Contract.srvDriverMatchesSpec':
+-- 'Proof.Memory.Cache4K.Server.Functional.Contract.srvDriverSpec' counts the
+-- cycles until the first answer.
+indStepWaits8 ::
+  (CoherentOps m) =>
+  Address -> SetIdx -> WordIdx -> m -> TagArr -> RawData -> Request -> Bool
+indStepWaits8 wa wsi wwi mem tags raw req =
+  not premises || conclusion
+  where
+    srv = CacheSrv (Cache4K tags (mkData mem tags raw)) mem CacheSrvReady
+
+    premises =
+      srvInvAt wa wsi wwi mem srv
+        && srvDriver srv req == 2 * fromIntegral penalty
+
+    conclusion = stallsFor (2 * fromIntegral penalty) srv req
+
+-- Helpers ----------------------------------------------------------------------
+
+-- | Serve a request, then @n@ - 1 cycles without one: are all @n@ answers
+-- 'Nothing'?
+stallsFor :: (MemOps m) => Int -> CacheSrv m -> Request -> Bool
+stallsFor n srv req
+  | n == 0 = True
+  | otherwise =
+      ans == Input Nothing && stallsFor (n - 1) srv' Nothing
+      where (srv', ans) = serve srv req
+
+-- | Serve a request, then @n@ cycles without one: the server and the last
+-- answer. Recursive on @n@, which each obligation fixes to a constant.
+serveN :: (MemOps m) => Int -> CacheSrv m -> Request -> (CacheSrv m, Input)
+serveN n srv req
+  | n == 0 = (srv', ans)
+  | otherwise = serveN (n - 1) srv' Nothing
+  where (srv', ans) = serve srv req
diff --git a/proof/Proof/Memory/Cache4K/Server/Functional/Solver.hs b/proof/Proof/Memory/Cache4K/Server/Functional/Solver.hs
new file mode 100644
index 0000000..fe204d4
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/Server/Functional/Solver.hs
@@ -0,0 +1,263 @@
+-- | The cache's functional proof, checked symbolically: the cache's counterpart
+-- of "Proof.Core.Functional.Solver".
+--
+-- The statements live in "Proof.Memory.Cache4K.Server.Functional.Obligation",
+-- "Proof.Memory.Cache4K.Server.Functional.Driver" and
+-- "Proof.Memory.Cache4K.Server.Functional.Contract"; this module only
+-- instantiates them, over every tag array, data array, memory, request and
+-- witness. Each property is named after the statement it checks, with a @P@:
+--
+--   * sanity probes for the trusted array embeddings;
+--   * the driver against its operational reading ('srvDriverMatchesSpecP'), and
+--     its values, the hop lengths of the steps ('srvDriverValuesP');
+--   * the base case, and one step per hop length (0, 'penalty', 2 * 'penalty'),
+--     each starting from a ready server whose cache is coherent by construction
+--     ('mkData'); for the hops that stall, a sanity check that the answers
+--     before the last are 'Nothing' ('indStepWaits4P', 'indStepWaits8P');
+--   * the contract between core and cache.
+--
+-- == Running them
+--
+-- Under Bitwuzla, not Z3:
+--
+-- > SBV_Z3=/usr/local/bin/bitwuzla SBV_Z3_OPTIONS="--produce-models" stack build
+module Proof.Memory.Cache4K.Server.Functional.Solver
+  ( cacheArraysP,
+    coherentDataP,
+    coherentWriteP,
+    coherentLayoutP,
+    srvDriverMatchesSpecP,
+    srvDriverValuesP,
+    srvInvFunctionalP,
+    baseCaseP,
+    indStep0P,
+    indStep4P,
+    indStepWaits4P,
+    indStep8P,
+    indStepWaits8P,
+    srvReadyIffAnsweredP,
+    srvReadyUnderInvP,
+    corePatientP,
+    results,
+  )
+where
+
+import Clash.Prelude (BitVector, d0, d1, d2, d9, not, slice, (++#), (||))
+import Core.Pipeline as Core (Request)
+import qualified Core.Pipeline as Core
+import Memory.Cache4KServer (CacheSrv (..), CacheSrvState (..))
+import Memory.Cache4K
+import Memory.Types (MemOps (..))
+import Pantomime (Theory (..))
+import qualified Pantomime.BuiltIn as Pantomime
+import Proof.Memory.Cache4K.SMT.Axioms (cacheAxioms, coherentAxioms)
+import Proof.Memory.Cache4K.SMT.Raw (RawData, rawRead)
+import Proof.Memory.Cache4K.Server.Functional.Contract
+  ( srvReadyIffAnswered,
+    srvReadyUnderInv,
+    corePatient,
+    srvDriverMatchesSpec,
+  )
+import Proof.Memory.Cache4K.Server.Functional.Driver (srvDriverValues)
+import Proof.Memory.Cache4K.Server.Functional.Invariant (srvInvFunctional)
+import Proof.Memory.Cache4K.Server.Functional.Obligation
+import Proof.Core.Functional.Machine (SysG (..))
+import Proof.Core.Functional.System (KState, sysOf)
+import Proof.Core.SMT.Array (RegArr)
+import Proof.SMT.Array (MemArr)
+import Proof.Core.SMT.Axioms (arrayAxioms)
+import Proof.SMT.Logged (pantomime)
+import Types
+import Prelude hiding (Word, not, (||))
+
+-- Sanity probes for the trusted embeddings -------------------------------------
+
+-- | The tag and data array embeddings, which are trusted, against facts a
+-- broken one would get wrong.
+{-# ANN cacheArraysP (Theory cacheAxioms) #-}
+cacheArraysP ::
+  TagArr -> DataArr -> SetIdx -> BitVector 21 -> BitVector 10 -> Word ->
+  Pantomime.Bool
+cacheArraysP tags dat s e i w =
+  Pantomime.boolean $
+    tagRead s (tagWrite s e tags) == e
+      && dataRead i (dataWrite i w dat) == w
+      && tagRead s tagEmpty == 0
+      && dataRead i dataZero == 0
+
+-- | The embedding of the coherent cache ('mkData' as
+-- 'Proof.Memory.Cache4K.SMT.Coherent.DataC'), which is trusted, against what
+-- 'mkData' defines: a read of the constructed array is memory's word if the
+-- line is valid, else the raw word. Writes are checked by 'coherentWriteP'.
+{-# ANN coherentDataP (Theory coherentAxioms) #-}
+coherentDataP :: MemArr -> TagArr -> RawData -> BitVector 10 -> Pantomime.Bool
+coherentDataP ma tags raw i =
+  Pantomime.boolean $ dataRead i (mkData ma tags raw) == constructed i
+  where
+    constructed k
+      | entryValid e =
+          memReadWord (wordAddr (entryTag e) si (slice d1 d0 k) 0) ma
+      | otherwise = rawRead k raw
+      where
+        si = slice d9 d2 k
+        e = tagRead si tags
+
+-- | A write on any data array of the coherent cache's embedding, including one
+-- that already holds writes: a read after it gives the written word at its
+-- index and leaves the other slots as they were. Since it holds for every
+-- array, it covers any sequence of writes.
+{-# ANN coherentWriteP (Theory coherentAxioms) #-}
+coherentWriteP ::
+  DataArr -> BitVector 10 -> BitVector 10 -> Word -> Pantomime.Bool
+coherentWriteP dat i j w =
+  Pantomime.boolean $
+    dataRead i (dataWrite i w dat) == w
+      && (i == j || dataRead j (dataWrite i w dat) == dataRead j dat)
+
+-- | The coherent cache's index layout agrees with the cache's addressing: at
+-- any address whose line is valid and holds its block, the cache's word (index
+-- set, then word, as 'Memory.Cache4K' composes it) is memory's word there.
+{-# ANN coherentLayoutP (Theory coherentAxioms) #-}
+coherentLayoutP :: MemArr -> TagArr -> RawData -> Address -> Pantomime.Bool
+coherentLayoutP ma tags raw a =
+  Pantomime.boolean $
+    not (entryValid e && entryTag e == tagOf a)
+      || dataRead (setOf a ++# wordOf a) (mkData ma tags raw)
+        == memReadWord (wordAddr (tagOf a) (setOf a) (wordOf a) 0) ma
+  where
+    e = tagRead (setOf a) tags
+
+-- The driver -------------------------------------------------------------------
+
+-- | The driver is 0, 'penalty' or twice 'penalty', on any server.
+{-# ANN srvDriverValuesP (Theory cacheAxioms) #-}
+srvDriverValuesP ::
+  TagArr -> DataArr -> MemArr -> CacheSrvState -> Request -> Pantomime.Bool
+srvDriverValuesP tags dat ma st req =
+  Pantomime.boolean $ srvDriverValues (CacheSrv (Cache4K tags dat) ma st) req
+
+-- | From a ready server, the driver agrees with its operational reading.
+{-# ANN srvDriverMatchesSpecP (Theory cacheAxioms) #-}
+srvDriverMatchesSpecP ::
+  TagArr -> DataArr -> MemArr -> CacheSrvState -> Request -> Pantomime.Bool
+srvDriverMatchesSpecP tags dat ma st req =
+  Pantomime.boolean $
+    srvDriverMatchesSpec (CacheSrv (Cache4K tags dat) ma st) req
+
+-- The invariant ----------------------------------------------------------------
+
+-- | The invariant is functional: two ideal memories related to the same server
+-- are equal.
+{-# ANN srvInvFunctionalP (Theory cacheAxioms) #-}
+srvInvFunctionalP ::
+  Address -> SetIdx -> WordIdx -> MemArr -> MemArr ->
+  TagArr -> DataArr -> MemArr -> CacheSrvState -> Pantomime.Bool
+srvInvFunctionalP wa wsi wwi ideal1 ideal2 tags dat ma st =
+  Pantomime.boolean $
+    srvInvFunctional wa wsi wwi ideal1 ideal2 srv
+  where
+    srv = CacheSrv (Cache4K tags dat) ma st
+
+-- The base case ----------------------------------------------------------------
+
+-- | Under 'cacheAxioms': the initial cache is the empty one
+-- ('Memory.Cache4K.dataZero'), not a constructed one.
+{-# ANN baseCaseP (Theory cacheAxioms) #-}
+baseCaseP ::
+  Address -> SetIdx -> WordIdx -> MemArr -> Pantomime.Bool
+baseCaseP wa wsi wwi ma =
+  Pantomime.boolean $ baseCase wa wsi wwi ma
+
+-- The inductive steps ----------------------------------------------------------
+
+-- | The one-cycle hop: a request the cache answers at once.
+{-# ANN indStep0P (Theory coherentAxioms) #-}
+indStep0P ::
+  Address -> SetIdx -> WordIdx -> MemArr -> TagArr -> RawData -> Request ->
+  Pantomime.Bool
+indStep0P wa wsi wwi ma tags raw req =
+  Pantomime.boolean $ indStep0 wa wsi wwi ma tags raw req
+
+-- | The hop of a read that misses one line: 'penalty' + 1 cycles.
+{-# ANN indStep4P (Theory coherentAxioms) #-}
+indStep4P ::
+  Address -> SetIdx -> WordIdx -> MemArr -> TagArr -> RawData -> Request ->
+  Pantomime.Bool
+indStep4P wa wsi wwi ma tags raw req =
+  Pantomime.boolean $ indStep4 wa wsi wwi ma tags raw req
+
+-- | Sanity check: during that hop, the answers before the last are 'Nothing'.
+{-# ANN indStepWaits4P (Theory coherentAxioms) #-}
+indStepWaits4P ::
+  Address -> SetIdx -> WordIdx -> MemArr -> TagArr -> RawData -> Request ->
+  Pantomime.Bool
+indStepWaits4P wa wsi wwi ma tags raw req =
+  Pantomime.boolean $ indStepWaits4 wa wsi wwi ma tags raw req
+
+-- | The hop of a read that misses both its lines: 2 * 'penalty' + 1 cycles.
+{-# ANN indStep8P (Theory coherentAxioms) #-}
+indStep8P ::
+  Address -> SetIdx -> WordIdx -> MemArr -> TagArr -> RawData -> Request ->
+  Pantomime.Bool
+indStep8P wa wsi wwi ma tags raw req =
+  Pantomime.boolean $ indStep8 wa wsi wwi ma tags raw req
+
+-- | Sanity check: during that hop, the answers before the last are 'Nothing'.
+{-# ANN indStepWaits8P (Theory coherentAxioms) #-}
+indStepWaits8P ::
+  Address -> SetIdx -> WordIdx -> MemArr -> TagArr -> RawData -> Request ->
+  Pantomime.Bool
+indStepWaits8P wa wsi wwi ma tags raw req =
+  Pantomime.boolean $ indStepWaits8 wa wsi wwi ma tags raw req
+
+-- The contract -----------------------------------------------------------------
+--
+-- The properties of "Proof.Memory.Cache4K.Server.Functional.Contract": the
+-- cache's over a server with arbitrary tags, data, memory and state, the core's
+-- over a core state built from symbolic parts as in the core's proof
+-- ('Proof.Core.Functional.System.sysOf').
+
+-- | After a step, the server is ready exactly when it has answered.
+{-# ANN srvReadyIffAnsweredP (Theory cacheAxioms) #-}
+srvReadyIffAnsweredP ::
+  TagArr -> DataArr -> MemArr -> CacheSrvState -> Request -> Pantomime.Bool
+srvReadyIffAnsweredP tags dat ma st req =
+  Pantomime.boolean $
+    srvReadyIffAnswered (CacheSrv (Cache4K tags dat) ma st) req
+
+-- | A server related to ideal memory by the invariant is ready.
+{-# ANN srvReadyUnderInvP (Theory cacheAxioms) #-}
+srvReadyUnderInvP ::
+  Address -> SetIdx -> WordIdx -> MemArr ->
+  TagArr -> DataArr -> MemArr -> CacheSrvState -> Pantomime.Bool
+srvReadyUnderInvP wa wsi wwi ideal tags dat ma st =
+  Pantomime.boolean $
+    srvReadyUnderInv wa wsi wwi ideal (CacheSrv (Cache4K tags dat) ma st)
+
+-- | The core waits for what it asked for.
+{-# ANN corePatientP (Theory arrayAxioms) #-}
+corePatientP :: KState -> Core.Input -> RegArr -> MemArr -> Pantomime.Bool
+corePatientP ss i ra ma =
+  Pantomime.boolean $ corePatient (sysCore (sysOf ss i ra ma)) i
+
+-- | The verdicts, spliced in by the plugin at compile time: 'Nothing' when the
+-- property is valid.
+results :: [(String, Maybe String)]
+results =
+  [ ("cacheArraysP", $(pantomime 'cacheArraysP)),
+    ("coherentDataP", $(pantomime 'coherentDataP)),
+    ("coherentWriteP", $(pantomime 'coherentWriteP)),
+    ("coherentLayoutP", $(pantomime 'coherentLayoutP)),
+    ("srvDriverMatchesSpecP", $(pantomime 'srvDriverMatchesSpecP)),
+    ("srvDriverValuesP", $(pantomime 'srvDriverValuesP)),
+    ("srvInvFunctionalP", $(pantomime 'srvInvFunctionalP)),
+    ("baseCaseP", $(pantomime 'baseCaseP)),
+    ("indStep0P", $(pantomime 'indStep0P)),
+    ("indStep4P", $(pantomime 'indStep4P)),
+    ("indStepWaits4P", $(pantomime 'indStepWaits4P)),
+    ("indStep8P", $(pantomime 'indStep8P)),
+    ("indStepWaits8P", $(pantomime 'indStepWaits8P)),
+    ("srvReadyIffAnsweredP", $(pantomime 'srvReadyIffAnsweredP)),
+    ("srvReadyUnderInvP", $(pantomime 'srvReadyUnderInvP)),
+    ("corePatientP", $(pantomime 'corePatientP))
+  ]
diff --git a/proof/Proof/Memory/Cache4K/Server/Leakage/Driver.hs b/proof/Proof/Memory/Cache4K/Server/Leakage/Driver.hs
new file mode 100644
index 0000000..454ac56
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/Server/Leakage/Driver.hs
@@ -0,0 +1,78 @@
+-- | The cache simulator's driver: how many cycles after an observed request the
+-- simulator answers -- the counterpart of
+-- "Proof.Memory.Cache4K.Server.Functional.Driver" for
+-- "Proof.Memory.Cache4K.Server.Leakage.Simulator".
+--
+-- The cache's leakage proof does not need it: the simulator runs cycle by
+-- cycle. The proof of the core behind the cache does, to know how long a hop
+-- takes from the simulators alone.
+module Proof.Memory.Cache4K.Server.Leakage.Driver
+  ( simSrvDriver,
+    simSrvDriverSpec,
+    simSrvDriverMatchesSpec,
+  )
+where
+
+import Memory.Cache4K (setOf)
+import Memory.Cache4KServer (penalty)
+import Proof.Memory.Cache4K.Server.Leakage.Simulator
+  ( SimCacheSrv (..),
+    simServe,
+    simSrvReady,
+    tagHit,
+  )
+import Proof.Core.Leakage.Model (Obs (..))
+import Types
+
+-- | The cycles after the observed request until the simulator answers:
+-- 'penalty' for every line a data read misses, nothing for anything else, as
+-- 'Proof.Memory.Cache4K.Server.Functional.Driver.srvDriver' computes for the
+-- server. Only ever run from a ready simulator, so its state is not consulted.
+simSrvDriver :: SimCacheSrv -> Obs -> Int
+simSrvDriver (SimCacheSrv t _) obs = case obs of
+  DataRead addr size ->
+    let off = case size of
+          Byte -> 0
+          Half -> 1
+          Word -> 3
+
+        hit1stLine = tagHit addr t
+        penalty1stLine = if hit1stLine then 0 else fromIntegral penalty
+
+        hit2ndLine = setOf (addr + off) == setOf addr || tagHit (addr + off) t
+        penalty2ndLine = if hit2ndLine then 0 else fromIntegral penalty
+
+    in penalty1stLine + penalty2ndLine
+  _ -> 0
+
+-- | The operational reading of 'simSrvDriver', as
+-- 'Proof.Memory.Cache4K.Server.Functional.Contract.srvDriverSpec' is of the
+-- server's: step on the observed request, then with no input until the
+-- simulator answers, and count the cycles after the request's. 'Nothing' if
+-- more than
+-- @fuel@ cycles follow the request's.
+simSrvDriverSpec :: Int -> SimCacheSrv -> Obs -> Maybe Int
+simSrvDriverSpec fuel sim0 obs =
+  let (sim', ans) = simServe sim0 obs
+  in go 0 sim' ans
+  where
+    go n sim answered
+      | answered = Just n
+      | n >= fuel = Nothing
+      | otherwise =
+        let (sim', ans) = simServe sim NoAccess
+        in go (n + 1) sim' ans
+
+-- | From a ready simulator ('simSrvReady'), its driver agrees with its
+-- operational reading, as
+-- 'Proof.Memory.Cache4K.Server.Functional.Contract.srvDriverMatchesSpec' for
+-- the server. Eight cycles of fuel, 2 * 'penalty', cover the longest hop, two
+-- missed lines. Readiness suffices, as for the server: the driver only asks
+-- which lines hit.
+simSrvDriverMatchesSpec :: SimCacheSrv -> Obs -> Bool
+simSrvDriverMatchesSpec sim obs =
+  not premises || conclusion
+  where
+    premises = simSrvReady sim
+
+    conclusion = simSrvDriverSpec 8 sim obs == Just (simSrvDriver sim obs)
diff --git a/proof/Proof/Memory/Cache4K/Server/Leakage/Invariant.hs b/proof/Proof/Memory/Cache4K/Server/Leakage/Invariant.hs
new file mode 100644
index 0000000..c9953df
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/Server/Leakage/Invariant.hs
@@ -0,0 +1,43 @@
+-- | The invariant of the cache's leakage proof: the simulator's tags are the
+-- server's, at a witness set, and both wait for memory alike -- the leakage
+-- counterpart of "Proof.Memory.Cache4K.Server.Functional.Invariant".
+module Proof.Memory.Cache4K.Server.Leakage.Invariant
+  ( srvSimInvAt,
+    simOf,
+  )
+where
+
+import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
+import Memory.Cache4K
+import Memory.Cache4KServer (CacheSrv (..), CacheSrvState (..))
+import Proof.Memory.Cache4K.Server.Leakage.Simulator
+  ( SimCacheSrv (..),
+    SimCacheSrvState (..),
+  )
+import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
+
+-- | The simulator and the server agree at set @wsi@: their tags are equal
+-- there, and they are in the same state ('sameSrvState').
+srvSimInvAt :: SetIdx -> SimCacheSrv -> CacheSrv m -> Bool
+srvSimInvAt wsi (SimCacheSrv tags sst) (CacheSrv c _ st) =
+  tagRead wsi tags == tagRead wsi (tagArr c)
+    && sameSrvState sst st
+
+-- | Both are ready, or both wait for memory with the same number of cycles
+-- left. The word the server will answer is not compared: the simulator does
+-- not know it.
+sameSrvState :: SimCacheSrvState -> CacheSrvState -> Bool
+sameSrvState SimCacheSrvReady CacheSrvReady = True
+sameSrvState (SimCacheSrvStall n) (CacheSrvStall m _) = n == m
+sameSrvState _ _ = False
+
+-- | The simulator a server determines: its tags, and its state without the
+-- word it will answer. The simulator the invariant relates to the server, as
+-- 'Proof.Core.Functional.Invariant.isaOf' is the ISA state the core's
+-- invariant relates to the system.
+simOf :: CacheSrv m -> SimCacheSrv
+simOf (CacheSrv c _ st) = SimCacheSrv (tagArr c) simSt
+  where
+    simSt = case st of
+      CacheSrvReady -> SimCacheSrvReady
+      CacheSrvStall n _ -> SimCacheSrvStall n
diff --git a/proof/Proof/Memory/Cache4K/Server/Leakage/Model.hs b/proof/Proof/Memory/Cache4K/Server/Leakage/Model.hs
new file mode 100644
index 0000000..1178c83
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/Server/Leakage/Model.hs
@@ -0,0 +1,28 @@
+-- | What an attacker sees of the cache server: the cache's counterpart of
+-- "Proof.Core.Leakage.Model".
+--
+-- The attacker watches the bus between the core and the server. In one cycle
+-- it sees:
+--
+--   * the request without its data ('obsReq', the core's observation: the same
+--     bus), and
+--   * whether the server answers, not the answer itself ('obsAns').
+--
+-- The server's internals -- the cache's contents, line fills, write-through to
+-- memory, the stall counter -- are hidden. What the cache adds to the bus is
+-- timing: the cycles in which it does not answer.
+module Proof.Memory.Cache4K.Server.Leakage.Model
+  ( Obs (..),
+    obsReq,
+    obsAns,
+  )
+where
+
+import Core.Pipeline as Core (Input (..))
+import Data.Maybe (isJust)
+import Proof.Core.Leakage.Model (Obs (..), obsReq)
+
+-- | What the attacker sees of the server's answer in one cycle: whether there
+-- is one.
+obsAns :: Input -> Bool
+obsAns ans = isJust (inputMem ans)
diff --git a/proof/Proof/Memory/Cache4K/Server/Leakage/Obligation.hs b/proof/Proof/Memory/Cache4K/Server/Leakage/Obligation.hs
new file mode 100644
index 0000000..f1303fa
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/Server/Leakage/Obligation.hs
@@ -0,0 +1,56 @@
+-- | The cache's leakage obligations: the simulator
+-- ("Proof.Memory.Cache4K.Server.Leakage.Simulator"), which sees only the
+-- observations of the requests, answers in the same cycles as the server.
+--
+-- The simulator runs cycle by cycle, as the server does, so there is no driver
+-- and one step obligation, for one cycle, from any state of the server: ready
+-- or waiting for memory.
+--
+-- As in the functional proof, the simulator is built from the server ('simOf'),
+-- as the core's ISA state is built from the system
+-- ('Proof.Core.Functional.Invariant.isaOf'): a simulator that satisfies the
+-- invariant at every set is the one built from the server. The conclusion
+-- compares the two after the cycle, at a witness set.
+module Proof.Memory.Cache4K.Server.Leakage.Obligation
+  ( baseCaseLeak,
+    indStepLeak,
+  )
+where
+
+import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
+import Core.Pipeline (Request)
+import Memory.Cache4K
+import Memory.Cache4KServer
+import Memory.Types (MemOps)
+import Proof.Memory.Cache4K.Server.Leakage.Invariant (simOf, srvSimInvAt)
+import Proof.Memory.Cache4K.Server.Leakage.Model (obsAns, obsReq)
+import Proof.Memory.Cache4K.Server.Leakage.Simulator
+import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
+
+-- The base case ----------------------------------------------------------------
+
+-- | The base case: the server at start, in front of any memory, and the
+-- simulator at start agree.
+baseCaseLeak :: SetIdx -> m -> Bool
+baseCaseLeak wsi mem = srvSimInvAt wsi simInitCacheSrv (initCacheSrv mem)
+
+-- The inductive step -----------------------------------------------------------
+
+-- | The step: in one cycle, the simulator, given the observation of the
+-- request, answers exactly when the server does, and the two agree afterwards.
+indStepLeak ::
+  (MemOps m) =>
+  SetIdx -> CacheSrv m -> Request -> Bool
+indStepLeak wsi srv req =
+  not premises || conclusion
+  where
+    sim = simOf srv
+
+    (srv', ans) = serve srv req
+    (sim', simAns) = simServe sim (obsReq req)
+
+    premises = srvSimInvAt wsi sim srv
+
+    conclusion =
+      simAns == obsAns ans
+        && srvSimInvAt wsi sim' srv'
diff --git a/proof/Proof/Memory/Cache4K/Server/Leakage/Simulator.hs b/proof/Proof/Memory/Cache4K/Server/Leakage/Simulator.hs
new file mode 100644
index 0000000..de1c1ab
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/Server/Leakage/Simulator.hs
@@ -0,0 +1,114 @@
+-- | The simulator for the cache's leakage proof: what an attacker on the bus
+-- between core and server can reconstruct of the server. It knows only the
+-- cache's tags, and it is driven only by the observations of the requests
+-- ('Proof.Core.Leakage.Model.obsReq'), never by data.
+--
+-- It runs cycle by cycle, as the server does ('simServe' against
+-- 'Memory.Cache4KServer.serve'): from the tags and the observation of a cycle's
+-- request it computes whether the server answers in that cycle, and the tags
+-- and stall counter afterwards. The leakage proof
+-- ("Proof.Memory.Cache4K.Server.Leakage.Obligation") shows that the server
+-- agrees, so the stalls -- the only thing the cache adds to the bus trace --
+-- depend on the observations alone.
+--
+-- Readiness is defined by behaviour, as for the server ('simSrvReady'), with
+-- its property ('simSrvReadyIffAnswered').
+module Proof.Memory.Cache4K.Server.Leakage.Simulator
+  ( SimCacheSrvState (..),
+    SimCacheSrv (..),
+    simInitCacheSrv,
+    simServe,
+    simSrvReady,
+    simSrvReadyIffAnswered,
+    tagHit,
+  )
+where
+
+import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
+import Memory.Cache4K
+import Memory.Cache4KServer (Cycles, penalty)
+import Proof.Core.Leakage.Model (Obs (..))
+import Types (Address, Size (..))
+import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
+
+-- | The simulator's counterpart of 'Memory.Cache4KServer.CacheSrvState': ready,
+-- or waiting for memory with the cycles left. Unlike the server, it does not
+-- know the word it will answer.
+data SimCacheSrvState = SimCacheSrvReady | SimCacheSrvStall Cycles
+  deriving (Show, Eq)
+
+-- | The simulator's counterpart of 'Memory.Cache4KServer.CacheSrv': the cache's
+-- tags, without its data or memory.
+data SimCacheSrv = SimCacheSrv
+  { -- | The tag entries, one per set, as in the cache.
+    simTagArr :: TagArr,
+    -- | Ready, or waiting for memory with the cycles left.
+    simSrvState :: SimCacheSrvState
+  }
+  deriving (Show, Eq)
+
+-- | The simulator at start, as 'Memory.Cache4KServer.initCacheSrv': no line
+-- valid and no read waiting.
+simInitCacheSrv :: SimCacheSrv
+simInitCacheSrv = SimCacheSrv tagEmpty SimCacheSrvReady
+
+-- | One cycle, as 'Memory.Cache4KServer.serve', from the observation of the
+-- cycle's request ('Nothing' for no input): whether the server answers in this
+-- cycle ('Proof.Memory.Cache4K.Server.Leakage.Model.obsAns'), and the simulator
+-- afterwards. A read that misses fills the line's tag and stalls 'penalty'
+-- cycles per missed line; everything else is answered at once.
+simServe :: SimCacheSrv -> Obs -> (SimCacheSrv, Bool)
+simServe (SimCacheSrv t st) obs = case st of
+  SimCacheSrvStall n
+    | n > 0 ->
+        (SimCacheSrv t (SimCacheSrvStall (n - 1)), False)
+    | otherwise ->
+        (SimCacheSrv t SimCacheSrvReady, True)
+  SimCacheSrvReady -> case obs of
+    DataRead addr size ->
+      let off = case size of
+            Byte -> 0
+            Half -> 1
+            Word -> 3
+
+          hit1stLine = tagHit addr t
+          penalty1stLine = if hit1stLine then 0 else penalty
+          t1 = if hit1stLine then t else tagFill addr t
+
+          hit2ndLine = tagHit (addr + off) t1
+          penalty2ndLine = if hit2ndLine then 0 else penalty
+          t2 = if hit2ndLine then t1 else tagFill (addr + off) t1
+
+          n = penalty1stLine + penalty2ndLine
+
+      in if n > 0
+           then (SimCacheSrv t2 (SimCacheSrvStall (n - 1)), False)
+           else (SimCacheSrv t2 SimCacheSrvReady, True)
+    _ -> (SimCacheSrv t SimCacheSrvReady, True)
+
+-- | Does the line of an address hold its block?
+tagHit :: Address -> TagArr -> Bool
+tagHit addr t = entryValid e && entryTag e == tagOf addr
+  where
+    e = tagRead (setOf addr) t
+
+-- | Mark the line of an address as holding its block: valid, with its tag.
+{- HLINT ignore tagFill "Eta reduce" -}
+tagFill :: Address -> TagArr -> TagArr
+tagFill addr t = tagWrite (setOf addr) ((1 :: BitVector 1) ++# tagOf addr) t
+
+-- | Is the simulator ready for a request? As
+-- 'Proof.Memory.Cache4K.Server.Functional.Contract.srvReady', defined by its
+-- behaviour: given no input, it answers within the cycle and stays the same.
+simSrvReady :: SimCacheSrv -> Bool
+simSrvReady sim =
+  let (sim', ans) = simServe sim NoAccess
+  in sim' == sim && ans
+
+-- | After a step, the simulator is ready exactly when it has answered: the
+-- counterpart of
+-- 'Proof.Memory.Cache4K.Server.Functional.Contract.srvReadyIffAnswered'.
+simSrvReadyIffAnswered :: SimCacheSrv -> Obs -> Bool
+simSrvReadyIffAnswered sim obs =
+  let (sim', ans) = simServe sim obs
+  in simSrvReady sim' == ans
diff --git a/proof/Proof/Memory/Cache4K/Server/Leakage/Solver.hs b/proof/Proof/Memory/Cache4K/Server/Leakage/Solver.hs
new file mode 100644
index 0000000..b39014b
--- /dev/null
+++ b/proof/Proof/Memory/Cache4K/Server/Leakage/Solver.hs
@@ -0,0 +1,76 @@
+-- | The cache's leakage proof, checked symbolically: the cache's counterpart of
+-- "Proof.Core.Leakage.Solver".
+--
+-- The statements live in "Proof.Memory.Cache4K.Server.Leakage.Obligation"; this
+-- module only instantiates them, over every memory, request and witness set,
+-- and for the step over a server with arbitrary tags, data, memory and state.
+-- Each property is named after the statement it checks, with a @P@.
+--
+-- == Running them
+--
+-- Under Bitwuzla, not Z3:
+--
+-- > SBV_Z3=/usr/local/bin/bitwuzla SBV_Z3_OPTIONS="--produce-models" stack build
+module Proof.Memory.Cache4K.Server.Leakage.Solver
+  ( simSrvReadyIffAnsweredP,
+    simSrvDriverMatchesSpecP,
+    baseCaseLeakP,
+    indStepLeakP,
+    results,
+  )
+where
+
+import Core.Pipeline (Request)
+import Memory.Cache4K
+import Memory.Cache4KServer (CacheSrv (..), CacheSrvState)
+import Proof.Memory.Cache4K.Server.Leakage.Simulator
+  ( SimCacheSrv (..),
+    SimCacheSrvState (..),
+    simSrvReadyIffAnswered,
+  )
+import Pantomime (Theory (..))
+import qualified Pantomime.BuiltIn as Pantomime
+import Proof.Memory.Cache4K.Server.Leakage.Driver (simSrvDriverMatchesSpec)
+import Proof.Memory.Cache4K.Server.Leakage.Obligation
+import Proof.Memory.Cache4K.Server.Leakage.Model (Obs)
+import Proof.Memory.Cache4K.SMT.Axioms (cacheAxioms)
+import Proof.SMT.Array (MemArr)
+import Proof.SMT.Logged (pantomime)
+
+-- | After a step, the simulator is ready exactly when it has answered.
+{-# ANN simSrvReadyIffAnsweredP (Theory cacheAxioms) #-}
+simSrvReadyIffAnsweredP ::
+  TagArr -> SimCacheSrvState -> Obs -> Pantomime.Bool
+simSrvReadyIffAnsweredP tags sst obs =
+  Pantomime.boolean $ simSrvReadyIffAnswered (SimCacheSrv tags sst) obs
+
+-- | From a ready simulator, its driver agrees with its operational reading.
+{-# ANN simSrvDriverMatchesSpecP (Theory cacheAxioms) #-}
+simSrvDriverMatchesSpecP ::
+  TagArr -> SimCacheSrvState -> Obs -> Pantomime.Bool
+simSrvDriverMatchesSpecP tags sst obs =
+  Pantomime.boolean $ simSrvDriverMatchesSpec (SimCacheSrv tags sst) obs
+
+-- | The base case: the server and the simulator at start agree.
+{-# ANN baseCaseLeakP (Theory cacheAxioms) #-}
+baseCaseLeakP :: SetIdx -> MemArr -> Pantomime.Bool
+baseCaseLeakP wsi ma = Pantomime.boolean $ baseCaseLeak wsi ma
+
+-- | The step: in one cycle, the simulator answers exactly when the server does,
+-- and the two agree afterwards.
+{-# ANN indStepLeakP (Theory cacheAxioms) #-}
+indStepLeakP ::
+  SetIdx -> TagArr -> DataArr -> MemArr -> CacheSrvState -> Request ->
+  Pantomime.Bool
+indStepLeakP wsi tags dat ma st req =
+  Pantomime.boolean $ indStepLeak wsi (CacheSrv (Cache4K tags dat) ma st) req
+
+-- | The verdicts, spliced in by the plugin at compile time: 'Nothing' when the
+-- property is valid.
+results :: [(String, Maybe String)]
+results =
+  [ ("simSrvReadyIffAnsweredP", $(pantomime 'simSrvReadyIffAnsweredP)),
+    ("simSrvDriverMatchesSpecP", $(pantomime 'simSrvDriverMatchesSpecP)),
+    ("baseCaseLeakP", $(pantomime 'baseCaseLeakP)),
+    ("indStepLeakP", $(pantomime 'indStepLeakP))
+  ]
diff --git a/proof/Proof/SMT/Array.hs b/proof/Proof/SMT/Array.hs
index f06519e..571ee8a 100644
--- a/proof/Proof/SMT/Array.hs
+++ b/proof/Proof/SMT/Array.hs
@@ -1,16 +1,18 @@
 {-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MonoLocalBinds #-}
 
--- | A register file embedded as an SMT array.
+-- | Memory embedded as an SMT array, shared by every proof, and the
+-- conversion of 'Unsigned' to 'Integer' that pantomime-clash leaves out. The
+-- core's register file is embedded the same way in "Proof.Core.SMT.Array".
 --
 -- The embedding has to be /monomorphic/: an SMT array needs concrete index and
 -- element sorts, so there is no way to map @Vec n a@ polymorphically. The
 -- pattern is therefore:
 --
---   * a monomorphic newtype ('RegArr') for the Haskell side,
---   * a matching newtype ('RegArrSMT') wrapping the SMT array,
+--   * a monomorphic newtype ('MemArr') for the Haskell side,
+--   * a matching newtype ('MemArrSMT') wrapping the SMT array,
 --   * a type axiom relating the two,
---   * monomorphic wrappers ('loadRA', 'storeRA') that the verified code calls
+--   * monomorphic wrappers ('loadM', 'storeM') that the verified code calls
 --     instead of Clash's polymorphic @(!!)@ and @replace@, each with a term
 --     axiom pointing at an embedding written with 'coerce'.
 --
@@ -19,24 +21,15 @@
 -- Haskell implementations, which the axioms replace before symbolic execution
 -- ever sees them.
 module Proof.SMT.Array
-  ( RegArr (..),
-    RegArrF (..),
-    MemArr (..),
+  ( MemArr (..),
     MemArrSMT (..),
     loadM,
     storeM,
     loadME,
     storeME,
-    RegArrSMT (..),
-    loadRA,
-    storeRA,
-    zeroRA,
-    zeroRAE,
-    loadRAE,
-    storeRAE,
-    sllWordE,
-    srlWordE,
-    sraWordE,
+    eqM,
+    eqME,
+    unsignedToIntegerE,
   )
 where
 
@@ -45,166 +38,19 @@ import Data.Coerce (Coercible, coerce)
 import qualified Pantomime.BuiltIn as P
 import qualified Pantomime.Clash as Clash
 import Memory.Types (MEM_SIZE_BYTES, MemOps (..))
-import Core.RegFile (RegFileOps (..))
 import Types
 import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
 
--- | The Haskell-side register file: 32 entries, so the index is exactly a
--- 'RegIdx' with no offset arithmetic. Slot 0 is present but never used --
--- @x0@ is handled by the caller, outside the array operations.
-newtype RegArr = RegArr (Vec 32 Word)
-
--- | The SMT-side counterpart. Same arity (zero), which is what lets the type
--- axiom relate them.
-newtype RegArrSMT = RegArrSMT (P.Array (P.BitVec 5) (P.BitVec 32))
-
--- | Read. Replaced by 'loadRAE' under the term axiom.
---
--- OPAQUE is essential: the axiom is keyed on this /name/, so if GHC inlines
--- the wrapper then only the polymorphic @index_int@ survives into Core and the
--- axiom never fires.
-{-# OPAQUE loadRA #-}
-loadRA :: RegArr -> RegIdx -> Word
-loadRA (RegArr v) i = v !! i
-
--- | Write. Replaced by 'storeRAE' under the term axiom. OPAQUE for the same
--- reason as 'loadRA'.
-{-# OPAQUE storeRA #-}
-storeRA :: RegArr -> RegIdx -> Word -> RegArr
-storeRA (RegArr v) i x = RegArr (replace i x v)
-
--- | Embedding of 'loadRA' as an array select.
---
--- Two subtleties. First, the source types are type /variables/ with
--- constructor-level 'Coercible' givens: congruence lifts @Coercible f g@ to
--- @Coercible (f a) (g a)@ when the head is a variable, but not through a
--- concrete constructor with nominal parameter roles.
---
--- Second, the array is indexed by the /primitive/ @Pantomime.BuiltIn.BitVec@,
--- not by pantomime-clash's @BitVec@. The latter is a GADT admitting
--- zero-width vectors, so it is neither coercible to the primitive nor a
--- 'P.Primitive' itself, and cannot be an array index or element. So we unwrap
--- at the boundary with 'Clash.BitVecP'.
-loadRAE ::
-  forall arr (bvI :: Nat -> Type) (bvV :: Nat -> Type).
-  (Coercible RegArrSMT arr) =>
-  (Coercible Clash.BitVec bvI) =>
-  (Coercible Clash.BitVec bvV) =>
-  arr ->
-  bvI 5 ->
-  bvV 32
-loadRAE = coerce go
-  where
-    go :: RegArrSMT -> Clash.BitVec 5 -> Clash.BitVec 32
-    go (RegArrSMT arr) (Clash.BitVecP k) = Clash.BitVecP (P.aselect arr k)
-
--- | Embedding of 'storeRA' as an array store.
-storeRAE ::
-  forall arr (bvI :: Nat -> Type) (bvV :: Nat -> Type).
-  (Coercible RegArrSMT arr) =>
-  (Coercible Clash.BitVec bvI) =>
-  (Coercible Clash.BitVec bvV) =>
-  arr ->
-  bvI 5 ->
-  bvV 32 ->
-  arr
-storeRAE = coerce go
-  where
-    go :: RegArrSMT -> Clash.BitVec 5 -> Clash.BitVec 32 -> RegArrSMT
-    go (RegArrSMT arr) (Clash.BitVecP k) (Clash.BitVecP v) =
-      RegArrSMT (P.astore arr k v)
-
--- | The all-zero register file.
---
--- 'Proof.Core.Leakage.Simulator.censor' installs this on every state it builds, so
--- unlike 'Core.init' it is on the symbolic path and has to be embeddable.
--- 'Clash.Prelude.repeat' gives the Haskell semantics; 'zeroRAE' replaces it
--- under the term axiom, which is keyed on this name -- hence OPAQUE, for the
--- same reason as 'loadRA'.
-{-# OPAQUE zeroRA #-}
-zeroRA :: RegArr
-zeroRA = RegArr (Clash.Prelude.repeat 0)
-
--- | Embedding of 'zeroRA' as a constant array.
-zeroRAE :: forall arr. (Coercible RegArrSMT arr) => arr
-zeroRAE = coerce (RegArrSMT (P.aconst 0))
-
--- | The array-backed register file, wrapped so it fits 'RegFileOps'. A
--- verification-only representation.
-newtype RegArrF = RegArrF RegArr
-
-instance RegFileOps RegArrF where
-  lookupRFg idx (RegArrF a) = if idx == 0 then 0 else loadRA a idx
-  modifyRFg idx v rf@(RegArrF a)
-    | idx == 0 = rf
-    | otherwise = RegArrF (storeRA a idx v)
-
-  -- On the symbolic path; see 'zeroRA'.
-  initRFg = RegArrF zeroRA
-
--- Shifts as SMT bitvector shifts ----------------------------------------------
---
--- Embeddings for 'Core.sllWord', 'Core.srlWord' and 'Core.sraWord'. See the note
--- on those functions for why they exist: without them each shift site converts
--- its five-bit amount through 'Integer', and the resulting @ubv_to_int@ /
--- @int_to_bv@ pair makes every query unreadable to the bitvector-only solvers.
---
--- The amount is zero-extended to the word width because SMT's shifts require
--- both operands to have the same sort. That is exact rather than a choice: the
--- amount is five bits, so it is always less than 32 and no shift saturates.
-
--- | @shiftL@ on a 'Word' as @bvshl@.
-sllWordE ::
-  forall (bvX :: Nat -> Type) (bvN :: Nat -> Type).
-  (Coercible Clash.BitVec bvX) =>
-  (Coercible Clash.BitVec bvN) =>
-  bvX 32 ->
-  bvN 5 ->
-  bvX 32
-sllWordE = coerce go
-  where
-    go :: Clash.BitVec 32 -> Clash.BitVec 5 -> Clash.BitVec 32
-    go (Clash.BitVecP x) (Clash.BitVecP n) =
-      Clash.BitVecP (P.bvshl x (P.bvzext n))
-
--- | @shiftR@ on a 'Word' as @bvlshr@.
-srlWordE ::
-  forall (bvX :: Nat -> Type) (bvN :: Nat -> Type).
-  (Coercible Clash.BitVec bvX) =>
-  (Coercible Clash.BitVec bvN) =>
-  bvX 32 ->
-  bvN 5 ->
-  bvX 32
-srlWordE = coerce go
-  where
-    go :: Clash.BitVec 32 -> Clash.BitVec 5 -> Clash.BitVec 32
-    go (Clash.BitVecP x) (Clash.BitVecP n) =
-      Clash.BitVecP (P.bvlshr x (P.bvzext n))
-
--- | Arithmetic @shiftR@ on a 'Word' as @bvashr@.
-sraWordE ::
-  forall (bvX :: Nat -> Type) (bvN :: Nat -> Type).
-  (Coercible Clash.BitVec bvX) =>
-  (Coercible Clash.BitVec bvN) =>
-  bvX 32 ->
-  bvN 5 ->
-  bvX 32
-sraWordE = coerce go
-  where
-    go :: Clash.BitVec 32 -> Clash.BitVec 5 -> Clash.BitVec 32
-    go (Clash.BitVecP x) (Clash.BitVecP n) =
-      Clash.BitVecP (P.bvashr x (P.bvzext n))
-
 -- Memory as an SMT array ------------------------------------------------------
 
 -- | The Haskell-side memory.
 --
--- A 'Vec', mirroring 'RegArr'. The size is irrelevant to verification: the type
--- axiom maps this to an array over the whole 32-bit address space, and the body
--- is never symbolically executed, because 'loadM' and 'storeM' are replaced by
--- their embeddings first. A function would arguably be the more honest Haskell
--- representation, since memory spans 32 bits; whether one would also work here
--- is untested.
+-- A 'Vec', mirroring 'Proof.Core.SMT.Array.RegArr'. The size is irrelevant to
+-- verification: the type axiom maps this to an array over the whole 32-bit
+-- address space, and the body is never symbolically executed, because 'loadM'
+-- and 'storeM' are replaced by their embeddings first. A function would
+-- arguably be the more honest Haskell representation, since memory spans 32
+-- bits; whether one would also work here is untested.
 newtype MemArr = MemArr (Vec MEM_SIZE_BYTES Byte)
 
 -- | The SMT-side counterpart: byte-granular, so sub-word stores stay natural.
@@ -249,6 +95,22 @@ storeME = coerce go
     go (MemArrSMT arr) (Clash.BitVecP a) (Clash.BitVecP v) =
       MemArrSMT (P.astore arr a v)
 
+-- | Equality, so that whole memories can be compared. Replaced by 'eqME' under
+-- the term axiom; OPAQUE for the same reason as 'loadM'.
+{-# OPAQUE eqM #-}
+eqM :: MemArr -> MemArr -> Bool
+eqM (MemArr v) (MemArr w) = v == w
+
+instance Eq MemArr where
+  (==) = eqM
+
+-- | Embedding of 'eqM' as array equality.
+eqME :: forall arr. (Coercible MemArrSMT arr) => arr -> arr -> Bool
+eqME = coerce go
+  where
+    go :: MemArrSMT -> MemArrSMT -> Bool
+    go (MemArrSMT a) (MemArrSMT b) = a == b
+
 instance MemOps MemArr where
   memReadByte a m = loadM m a
 
@@ -259,10 +121,32 @@ instance MemOps MemArr where
     case size of
       Types.Byte -> put a b0 m
       Types.Half -> put (a + 1) b1 (put a b0 m)
-      Types.Word -> put (a + 3) b3 (put (a + 2) b2 (put (a + 1) b1 (put a b0 m)))
+      Types.Word ->
+        put (a + 3) b3 (put (a + 2) b2 (put (a + 1) b1 (put a b0 m)))
     where
       b0 = slice d7 d0 w
       b1 = slice d15 d8 w
       b2 = slice d23 d16 w
       b3 = slice d31 d24 w
       put i v mm = storeM mm i v
+
+-- Unsigned to Integer ---------------------------------------------------------
+--
+-- pantomime-clash embeds @toInteger@ on 'BitVector' but not on 'Unsigned', and
+-- Clash's primitive is @OPAQUE@, so even a literal such as
+-- 'Memory.Cache4KServer.penalty' converted with 'fromIntegral' stops symbolic
+-- execution. Both types are embedded as 'Clash.BitVec', so the embedding is
+-- the same. On a constant, the solver library folds the conversion away, so
+-- the query stays in the bitvector fragment.
+
+-- | @toInteger@ on an 'Unsigned' as @ubv_to_int@.
+unsignedToIntegerE ::
+  forall (bv :: Nat -> Type) (n :: Nat).
+  (Coercible Clash.BitVec bv) =>
+  bv n ->
+  Integer
+unsignedToIntegerE = coerce go
+  where
+    go :: Clash.BitVec n -> Integer
+    go Clash.BitVecZ = 0
+    go (Clash.BitVecP x) = P.toInteger (P.bvu2i x)
diff --git a/proof/Proof/SMT/Axioms.hs b/proof/Proof/SMT/Axioms.hs
index 5b235ae..b4a59b8 100644
--- a/proof/Proof/SMT/Axioms.hs
+++ b/proof/Proof/SMT/Axioms.hs
@@ -1,61 +1,45 @@
--- | The axiom set used by the proof properties.
+{-# LANGUAGE MagicHash #-}
+
+-- | The axiom sets every proof builds on: the embeddings of 'base' and of the
+-- Clash numeric types, and memory as an SMT array ("Proof.SMT.Array"). The
+-- core's register file and shifts add theirs in "Proof.Core.SMT.Axioms".
 --
 -- This lives in its own module because GHC's stage restriction requires a value
 -- mentioned in an @ANN@ pragma to be imported rather than defined locally.
-module Proof.SMT.Axioms (axioms, arrayAxioms) where
+module Proof.SMT.Axioms (axioms, memAxioms) where
 
 import Proof.SMT.Array
-import Core (sllWord, sraWord, srlWord)
 import qualified Data.Map as Map
 import Pantomime (PluginAxioms (..))
 import qualified Pantomime.Base as Base
 import qualified Pantomime.Clash as Clash
+import qualified Clash.Sized.Internal.Unsigned as Unsigned
 
 -- | 'base' embeddings plus the Clash numeric types ('BitVector', 'Unsigned',
--- 'Signed', 'Bit'), which is what this core's types are built from, plus this
--- core's own shift wrappers.
---
--- The shift axioms belong here rather than in 'arrayAxioms' because they are
--- part of the core's semantics, not of the container encoding: any property that
--- runs the ALU needs them. Without them 'Core.sllWord' and friends are OPAQUE
--- names with no unfolding, and symbolic execution stops with \"Unbound variable
--- in symbolise\".
+-- 'Signed', 'Bit'), which is what this core's types are built from.
 axioms :: PluginAxioms
-axioms = Base.axioms <> Clash.axioms <> shiftAxioms
+axioms = Base.axioms <> Clash.axioms <> unsignedAxioms
 
--- | The ALU shifts, mapped to the SMT bitvector shifts.
---
--- See 'Core.sllWord' for why the wrappers exist: they keep the shift amount a
--- bitvector, so a query stays in the bitvector-and-array fragment that Bitwuzla
--- and Yices can read.
-shiftAxioms :: PluginAxioms
-shiftAxioms =
+-- | What pantomime-clash leaves out for 'Unsigned': its conversion to
+-- 'Integer', which 'fromIntegral' goes through.
+unsignedAxioms :: PluginAxioms
+unsignedAxioms =
   PluginAxioms
     { typeAxioms = Map.empty,
-      termAxioms =
-        [ ('sllWord, 'sllWordE),
-          ('srlWord, 'srlWordE),
-          ('sraWord, 'sraWordE)
-        ]
+      termAxioms = [('Unsigned.toInteger#, 'unsignedToIntegerE)]
     }
 
--- | The register-file-as-SMT-array embedding, on top of the base set.
+-- | The memory-as-SMT-array embedding, on top of the base set.
 --
 -- Monomorphic by necessity: an array needs concrete index and element sorts.
-arrayAxioms :: PluginAxioms
-arrayAxioms =
+memAxioms :: PluginAxioms
+memAxioms =
   axioms
     <> PluginAxioms
-      { typeAxioms =
-          Map.fromList
-            [ (''RegArr, ''RegArrSMT),
-              (''MemArr, ''MemArrSMT)
-            ],
+      { typeAxioms = Map.fromList [(''MemArr, ''MemArrSMT)],
         termAxioms =
-          [ ('loadRA, 'loadRAE),
-            ('zeroRA, 'zeroRAE),
-            ('storeRA, 'storeRAE),
-            ('loadM, 'loadME),
-            ('storeM, 'storeME)
+          [ ('loadM, 'loadME),
+            ('storeM, 'storeME),
+            ('eqM, 'eqME)
           ]
       }
diff --git a/proof/Proof/SMT/Sanity.hs b/proof/Proof/SMT/Sanity.hs
index 441ecf3..daf5938 100644
--- a/proof/Proof/SMT/Sanity.hs
+++ b/proof/Proof/SMT/Sanity.hs
@@ -35,7 +35,8 @@ deMorgan :: Bool -> Bool -> Pantomime.Bool
 deMorgan x y = Pantomime.boolean $ (not x && not y) == not (x || y)
 
 -- | The example from the Pantomime install guide, which additionally exercises
--- the 'base' axioms (i.e. the embedding of 'Int' into the theory of bitvectors).
+-- the 'base' axioms (i.e. the embedding of 'Int' into the theory of
+-- bitvectors).
 {-# ANN doubling (Theory Base.axioms) #-}
 doubling :: Int -> Pantomime.Bool
 doubling x = Pantomime.boolean $ x + x == 2 * x
diff --git a/proof/README.md b/proof/README.md
new file mode 100644
index 0000000..71d3cf0
--- /dev/null
+++ b/proof/README.md
@@ -0,0 +1,54 @@
+# The proofs
+
+Everything here is checked at compile time by Pantomime and Bitwuzla. The
+statements are ordinary Haskell over the code in `src/`. `proof/` may import
+`src/`, never the reverse: the ISA (`Core.ISA`) and ideal memory
+(`Memory.Ideal`), which the proofs are checked against, live in `src/`.
+
+## Layout
+
+`proof/Proof/` mirrors `src/`:
+
+```
+Proof/
+  Core/                     the core (src/Core): the pipeline behind ideal memory
+    Functional/             link 1: the core behind ideal memory refines the ISA
+    Leakage/                link 1: and leaks only what the ISA-level leakage says
+    SMT/                    the register file and ALU shifts as SMT terms
+  Memory/Cache4K/           the 4 KiB cache (src/Memory/Cache4K*)
+    Server/Functional/      the cache on its own refines ideal memory, with delay;
+                            Contract.hs: what the core and any memory promise each other
+    Server/Leakage/         the cache leaks only its requests' observations
+    CachedCore/Functional/  link 2: the core behind the cache refines the core
+                            behind ideal memory
+    CachedCore/Leakage/     link 2: and leaks only what that core leaks
+    SMT/                    the cache's tag and data arrays as SMT arrays
+  SMT/                      shared: memory as an SMT array, the base axioms,
+                            Logged (marks each query in the build log, so a
+                            timeout can be traced to its property), Sanity
+                            (checks that the plugin runs)
+```
+
+Link 1 and link 2 are composed on paper, not in code. `test/CacheProofSpec.hs` checks the
+composition on real programs.
+
+## Inside a proof folder
+
+Each `Functional/` or `Leakage/` folder splits a proof into modules of the same
+kinds, using the ones it needs:
+
+| Module        | Holds |
+|---------------|-------|
+| `Machine`     | the system being proved, where `src/` does not already define it: the core with memory, or the core behind the cache |
+| `Model`       | (leakage) what the attacker observes |
+| `Simulator`   | (leakage) the machine that predicts the observations from leakage alone |
+| `Driver`      | how many cycles one step of the spec takes, and its operational reading |
+| `Invariant`   | the relation between the implementation and its spec |
+| `Obligation`  | the base case and one inductive step per hop length |
+| `Solver`      | the properties as Pantomime queries, collected in `results` |
+| `System`      | (core) how a system state is passed to the solver: SMT arrays for the register file and memory |
+
+Only the `Solver` modules (and the `SMT` axioms they use) run the solver. They
+are built only with the `smt-proof` flag, and `test/Spec.hs` checks that every
+entry in each `results` list is valid. Load or build them one module at a
+time: a single module needs about 2 GB.
diff --git a/src/Core/Alu.hs b/src/Core/Alu.hs
new file mode 100644
index 0000000..4f5bced
--- /dev/null
+++ b/src/Core/Alu.hs
@@ -0,0 +1,81 @@
+-- | The arithmetic and comparison semantics of instructions: what the ALU
+-- computes for an operation, and whether a branch's comparison holds. Shared
+-- by the pipeline ("Core.Pipeline") and the ISA ("Core.ISA"), so that neither
+-- depends on the other.
+module Core.Alu
+  ( alu,
+    branch,
+    sllWord,
+    srlWord,
+    sraWord,
+  )
+where
+
+import Clash.Prelude hiding (Ordering (..), Word, def, init, lift)
+import Core.Instruction (Arith (..), Comparison (..))
+import Types (Word)
+import Prelude hiding (Ordering (..), Word, init, not, undefined, (&&), (||))
+
+-- | What the ALU computes for an arithmetic operation on two words.
+alu :: Arith -> Word -> Word -> Word
+alu op lhs rhs = case op of
+  ADD -> lhs + rhs
+  SUB -> lhs - rhs
+  XOR -> lhs .^. rhs
+  OR -> lhs .|. rhs
+  AND -> lhs .&. rhs
+  SLL -> sllWord lhs (shiftBits rhs)
+  SRL -> srlWord lhs (shiftBits rhs)
+  SRA -> sraWord lhs (shiftBits rhs)
+  SLT -> set (sign lhs < sign rhs)
+  SLTU -> set (lhs < rhs)
+  where
+    shiftBits = slice d4 d0
+    sign = unpack @(Signed 32)
+    set b = if b then 1 else 0
+
+-- | The three RISC-V shifts, with the shift amount kept as a bitvector.
+--
+-- RISC-V takes the amount from the low five bits of the second operand, so no
+-- amount can reach the word width and these agree with the SMT shifts on the
+-- nose.
+--
+-- They exist as named 'OPAQUE' functions, rather than 'shiftL' applied inline,
+-- for the verifier's sake. 'Data.Bits.shiftL' takes an 'Int', so an inline
+-- amount forces @fromIntegral@ on the five-bit slice, and that is modelled
+-- through 'Integer': every shift site then emits an integer round trip
+-- (@ubv_to_int@ to @int_to_bv@) wrapped in two overflow guards. Those few terms
+-- pull integer arithmetic into a query that is otherwise pure bitvectors and
+-- arrays, and Bitwuzla and Yices have no integer theory at all -- they reject
+-- such a query outright rather than solve it slowly. Keeping the amount a
+-- 'BitVector' behind a name lets "Proof.SMT.Axioms" map each shift to its SMT
+-- counterpart; see 'Proof.SMT.Array.sllWordE'.
+--
+-- OPAQUE is essential, for the same reason as 'Proof.SMT.Array.loadRA': the
+-- axiom is keyed on the name, so an inlined wrapper would leave nothing to
+-- rewrite.
+{-# OPAQUE sllWord #-}
+sllWord :: Word -> BitVector 5 -> Word
+sllWord x n = shiftL x (fromIntegral n)
+
+-- | Logical right shift; 'BitVector' is unsigned, so 'shiftR' is @bvlshr@.
+{-# OPAQUE srlWord #-}
+srlWord :: Word -> BitVector 5 -> Word
+srlWord x n = shiftR x (fromIntegral n)
+
+-- | Arithmetic right shift, via 'Signed' as the ISA prescribes.
+{-# OPAQUE sraWord #-}
+sraWord :: Word -> BitVector 5 -> Word
+sraWord x n = pack (shiftR (unpack x :: Signed 32) (fromIntegral n))
+
+-- | Does a branch's comparison hold of two words?
+branch :: Comparison -> Word -> Word -> Bool
+branch op lhs rhs = case op of
+  EQ -> lhs == rhs
+  NE -> lhs /= rhs
+  LT -> sign lhs < sign rhs
+  GE -> sign lhs >= sign rhs
+  LTU -> lhs < rhs
+  GEU -> lhs >= rhs
+  where
+    sign = unpack @(Signed 32)
diff --git a/src/Core/ISA.hs b/src/Core/ISA.hs
index 8ae7a67..071aa12 100644
--- a/src/Core/ISA.hs
+++ b/src/Core/ISA.hs
@@ -5,10 +5,11 @@
 -- | The ISA specification: what each instruction means, and how the
 -- architectural state evolves.
 --
--- Two halves, both semantics. 'interp' turns an 'Core.Instruction.Instruction' into
--- an @'Instr' 'Func'@ -- the effect it denotes -- and 'apply' evaluates one of
--- those 'Func's against the two source-register values and the PC. On top of
--- that, 'isaStep' says how the @(isaPc, isaRegFile, isaMem)@ triple moves.
+-- Two halves, both semantics. 'interp' turns an 'Core.Instruction.Instruction'
+-- into an @'Instr' 'Func'@ -- the effect it denotes -- and 'apply' evaluates
+-- one of those 'Func's against the two source-register values and the PC. On
+-- top of that, 'isaStep' says how the @(isaPc, isaRegFile, isaMem)@ triple
+-- moves.
 --
 -- The architectural state is parameterised over the register-file and memory
 -- representations because the @Vec@-backed ones cannot be symbolically
@@ -37,8 +38,9 @@ module Core.ISA
   )
 where
 
-import Clash.Prelude hiding (Const, Log, Ordering (..), Word, def, init, lift, log)
-import Core hiding (Syscall)
+import Clash.Prelude
+  hiding (Const, Log, Ordering (..), Word, def, init, lift, log)
+import Core.Alu (alu, branch)
 import Core.Instruction (Instruction, Sign, decode', loadExtend)
 import qualified Core.Instruction
 import Memory.Types (MemBytes, MemOps (..))
@@ -200,7 +202,7 @@ deriving instance (Show r, Show m) => Show (IsaStateG r m)
 deriving instance (Eq r, Eq m) => Eq (IsaStateG r m)
 
 -- | The result of one architectural step. 'IsaHalted' covers @ebreak@ and
--- @ecall@, which is where 'Core' parks in a 'Core.HaltState'.
+-- @ecall@, which is where "Core.Pipeline" parks in a 'Core.Pipeline.HaltState'.
 data StepG r m
   = Next (IsaStateG r m)
   | IsaHalted
@@ -244,7 +246,11 @@ isaStepDecoded ir st@(IsaState pc rf mem) =
             isaRegFile = modifyRFg rd (bitCoerce (ap link)) rf
           }
     Store size addr rs2 ->
-      Next st {isaPc = pc + 4, isaMem = memWrite (ap addr) size (reg (Just rs2)) mem}
+      Next
+        st
+          { isaPc = pc + 4,
+            isaMem = memWrite (ap addr) size (reg (Just rs2)) mem
+          }
     Branch cond target ->
       Next st {isaPc = if ap cond then ap target else pc + 4}
     Nop -> Next st {isaPc = pc + 4}
diff --git a/src/Core/Instruction.hs b/src/Core/Instruction.hs
index c5f39bc..df707fe 100644
--- a/src/Core/Instruction.hs
+++ b/src/Core/Instruction.hs
@@ -103,7 +103,8 @@ data IOperation
   | Jump
   deriving (Eq, Show, Generic, NFDataX)
 
--- | Reason for replacing an instruction with a nop. Some of these can be collapsed if we want to optimize later.
+-- | Reason for replacing an instruction with a nop. Some of these can be
+-- collapsed if we want to optimize later.
 data Reason4Stall
   = -- | First instruction discarded because of a jump.
     JumpFirstCycle
@@ -373,7 +374,9 @@ encode' instruction =
 
       let rs1' = pack rs1
       let rs2' = pack rs2
-      pure $ imm12 ++# imm10to5 ++# rs2' ++# rs1' ++# funct3 ++# imm4to1 ++# imm11 ++# opcode
+      pure $
+        imm12 ++# imm10to5 ++# rs2' ++# rs1' ++# funct3 ++# imm4to1 ++# imm11
+          ++# opcode
     UType base rd imm -> do
       let opcode :: BitVector 7 = case base of
             Zero -> 0b011_0111
diff --git a/src/Core.hs b/src/Core/Pipeline.hs
similarity index 86%
rename from src/Core.hs
rename to src/Core/Pipeline.hs
index 32a9f9e..3ac7ff0 100644
--- a/src/Core.hs
+++ b/src/Core/Pipeline.hs
@@ -6,7 +6,7 @@
 {-# LANGUAGE InstanceSigs #-}
 {- HLINT ignore "Functor law" -}
 
-module Core
+module Core.Pipeline
   ( initInput,
     initAt,
     init,
@@ -26,11 +26,6 @@ module Core
     MemAccess (..),
     Request,
     Control (..),
-    alu,
-    branch,
-    sllWord,
-    srlWord,
-    sraWord,
     topEntity,
   )
 where
@@ -39,6 +34,7 @@ import Clash.Prelude hiding (Ordering (..), Word, def, init, lift)
 import Control.Monad
 import Control.Monad.RWS
 import Data.Maybe (fromMaybe, isJust, isNothing)
+import Core.Alu (alu, branch)
 import Core.Instruction hiding (decode)
 import Memory.Types
 import Core.RegFile
@@ -74,7 +70,7 @@ type Request = Maybe MemAccess
 -- | The output of the CPU.
 newtype Output = Output
   { -- | A memory access.
-    outMem :: Request
+    outputMem :: Request
   }
   deriving (Show, Generic, NFDataX)
 
@@ -152,12 +148,14 @@ data Control = Control
     -- | Stores the jump address if the instruction in the `execute` stage
     --   results in a jump.
     ctrlExJumpAddr :: Maybe Address,
-    -- | Stores the write address and size if the instruction in the `execute` stage
+    -- | Stores the write address and size if the instruction in the `execute`
+    -- stage
     --   is a store.
     ctrlExStoreAddrSize :: Maybe (Address, Size),
     -- | `True` when the instruction in the `memory` stage is a store or a load.
     ctrlMeMemInstr :: Bool,
-    -- | Stores the write address and size if the instruction in the `memory` stage
+    -- | Stores the write address and size if the instruction in the `memory`
+    -- stage
     --   is a store.
     ctrlMeStoreAddrSize :: Maybe (Address, Size),
     -- | Forwards the `rd` register from the `memory` stage to the `execute`
@@ -234,9 +232,9 @@ initCtrl =
       ctrlMemNotReady = False
     }
 
--- | Fetch stage. Holds while memory has not answered (see 'writeback'), like the
--- other stages before writeback: a stall then leaves every pipeline register
--- as it was.
+-- | Fetch stage. Holds while memory has not answered (see 'writeback'), like
+-- the other stages before writeback: a stall then leaves every pipeline
+-- register as it was.
 fetch :: CPUM r ()
 fetch = do
   notReady <- gets (ctrlMemNotReady . stateCtrl)
@@ -297,8 +295,10 @@ decodeFresh = do
   let break_current_cycle = maybe False isBreak (ctrlExInstr ctrl)
 
   let jump_previous_cycle = ctrlExInstr ctrl == Just (Nop JumpFirstCycle)
-  let store_hazard_previous_cycle = ctrlExInstr ctrl == Just (Nop StoreHazardFirstCycle)
-  let load_hazard_previous_cycle = ctrlExInstr ctrl == Just (Nop LoadHazardFirstCycle)
+  let store_hazard_previous_cycle =
+        ctrlExInstr ctrl == Just (Nop StoreHazardFirstCycle)
+  let load_hazard_previous_cycle =
+        ctrlExInstr ctrl == Just (Nop LoadHazardFirstCycle)
 
   let jump_current_cycle = isJust (ctrlExJumpAddr ctrl)
 
@@ -439,67 +439,6 @@ executeFresh = do
             pure fwdVal
       pure $ fromMaybe def (pick ctrlMeRegFwd <|> pick ctrlWbRegFwd)
 
-alu :: Arith -> Word -> Word -> Word
-alu op lhs rhs = case op of
-  ADD -> lhs + rhs
-  SUB -> lhs - rhs
-  XOR -> lhs .^. rhs
-  OR -> lhs .|. rhs
-  AND -> lhs .&. rhs
-  SLL -> sllWord lhs (shiftBits rhs)
-  SRL -> srlWord lhs (shiftBits rhs)
-  SRA -> sraWord lhs (shiftBits rhs)
-  SLT -> set (sign lhs < sign rhs)
-  SLTU -> set (lhs < rhs)
-  where
-    shiftBits = slice d4 d0
-    sign = unpack @(Signed 32)
-    set b = if b then 1 else 0
-
--- | The three RISC-V shifts, with the shift amount kept as a bitvector.
---
--- RISC-V takes the amount from the low five bits of the second operand, so no
--- amount can reach the word width and these agree with the SMT shifts on the
--- nose.
---
--- They exist as named 'OPAQUE' functions, rather than 'shiftL' applied inline,
--- for the verifier's sake. 'Data.Bits.shiftL' takes an 'Int', so an inline
--- amount forces @fromIntegral@ on the five-bit slice, and that is modelled
--- through 'Integer': every shift site then emits an integer round trip
--- (@ubv_to_int@ to @int_to_bv@) wrapped in two overflow guards. Those few terms
--- pull integer arithmetic into a query that is otherwise pure bitvectors and
--- arrays, and Bitwuzla and Yices have no integer theory at all -- they reject
--- such a query outright rather than solve it slowly. Keeping the amount a
--- 'BitVector' behind a name lets "Axioms" map each shift to its SMT
--- counterpart; see 'ArrayRF.sllWordE'.
---
--- OPAQUE is essential, for the same reason as 'ArrayRF.loadRA': the axiom is
--- keyed on the name, so an inlined wrapper would leave nothing to rewrite.
-{-# OPAQUE sllWord #-}
-sllWord :: Word -> BitVector 5 -> Word
-sllWord x n = shiftL x (fromIntegral n)
-
--- | Logical right shift; 'BitVector' is unsigned, so 'shiftR' is @bvlshr@.
-{-# OPAQUE srlWord #-}
-srlWord :: Word -> BitVector 5 -> Word
-srlWord x n = shiftR x (fromIntegral n)
-
--- | Arithmetic right shift, via 'Signed' as the ISA prescribes.
-{-# OPAQUE sraWord #-}
-sraWord :: Word -> BitVector 5 -> Word
-sraWord x n = pack (shiftR (unpack x :: Signed 32) (fromIntegral n))
-
-branch :: Comparison -> Word -> Word -> Bool
-branch op lhs rhs = case op of
-  EQ -> lhs == rhs
-  NE -> lhs /= rhs
-  LT -> sign lhs < sign rhs
-  GE -> sign lhs >= sign rhs
-  LTU -> lhs < rhs
-  GEU -> lhs >= rhs
-  where
-    sign = unpack @(Signed 32)
-
 -- | Memory stage. Holds while memory has not answered (see 'writeback').
 memory :: CPUM r ()
 memory = do
@@ -596,16 +535,16 @@ readPC :: (MonadWriter Output m) => Address -> m ()
 readPC addr =
   tell $
     (mempty :: Output)
-      { outMem = pure $ MemFetch addr }
+      { outputMem = pure $ MemFetch addr }
 
 readRAM :: (MonadWriter Output m) => Address -> Size -> m ()
 readRAM addr size =
   tell $
     (mempty :: Output)
-      { outMem = pure $ MemRead addr size }
+      { outputMem = pure $ MemRead addr size }
 
 writeRAM :: (MonadWriter Output m) => Address -> Size -> Word -> m ()
 writeRAM addr size val =
   tell $
     (mempty :: Output)
-      { outMem = pure $ MemWrite addr size val }
+      { outputMem = pure $ MemWrite addr size val }
diff --git a/src/Core/RegFile.hs b/src/Core/RegFile.hs
index 13bf6af..20a97e7 100644
--- a/src/Core/RegFile.hs
+++ b/src/Core/RegFile.hs
@@ -26,7 +26,11 @@ newtype RegFile = RegFile (Vec ((2 ^ 5) - 1) Word)
 
 regIdxName :: RegIdx -> String
 regIdxName idx =
-  ["zero", "ra", "sp", "gp", "tp", "t0", "t1", "t2", "s0", "s1", "a0", "a1", "a2", "a3", "a4", "a5", "a6", "a7", "s2", "s3", "s4", "s5", "s6", "s7", "s8", "s9", "s10", "s11", "t3", "t4", "t5", "t6"]
+  [ "zero", "ra", "sp", "gp", "tp", "t0", "t1", "t2",
+    "s0", "s1", "a0", "a1", "a2", "a3", "a4", "a5",
+    "a6", "a7", "s2", "s3", "s4", "s5", "s6", "s7",
+    "s8", "s9", "s10", "s11", "t3", "t4", "t5", "t6"
+  ]
     P.!! (fromIntegral idx)
 
 instance Show RegFile where
@@ -60,10 +64,10 @@ censorRF _ = initRF
 
 -- | The operations the pipeline needs from a register file.
 --
--- 'Core.StateG' is parameterised over this so that the same pipeline can run on
--- two representations: the synthesisable 'RegFile' (a 'Vec'), and 'RegFn' (a
--- function) which is what symbolic execution can actually handle. See
--- "Induction" for why the 'Vec' one cannot be symbolically executed.
+-- 'Core.Pipeline.StateG' is parameterised over this so that the same pipeline
+-- can run on two representations: the synthesisable 'RegFile' (a 'Vec'), and
+-- 'RegFn' (a function) which is what symbolic execution can actually handle.
+-- See "Induction" for why the 'Vec' one cannot be symbolically executed.
 class RegFileOps r where
   lookupRFg :: RegIdx -> r -> Word
   modifyRFg :: RegIdx -> Word -> r -> r
@@ -77,9 +81,9 @@ instance RegFileOps RegFile where
 -- | Verification-only register file: a function rather than a container.
 --
 -- Not synthesisable -- Clash cannot turn a function into hardware -- so this
--- must never reach 'Core.topEntity'. It exists purely so that reads become
--- applications and writes become lambdas, both of which the symbolic executor
--- handles natively.
+-- must never reach 'Core.Pipeline.topEntity'. It exists purely so that reads
+-- become applications and writes become lambdas, both of which the symbolic
+-- executor handles natively.
 newtype RegFn = RegFn (RegIdx -> Word)
 
 instance RegFileOps RegFn where
diff --git a/src/Elf/ElfLoader.hs b/src/Elf/ElfLoader.hs
index 24cf652..3d82cb0 100644
--- a/src/Elf/ElfLoader.hs
+++ b/src/Elf/ElfLoader.hs
@@ -13,7 +13,7 @@ import Clash.Explicit.Prelude (Unsigned, bitCoerce, zeroExtend)
 import Clash.Explicit.Prelude.Safe ((.&.))
 import Control.Monad (forM_, forM)
 import Control.Monad.Catch
-import qualified Core
+import qualified Core.Pipeline as Core
 import qualified Data.ByteString.Lazy as BSL
 import qualified Data.ByteString as BS
 import Data.Char (chr)
@@ -37,22 +37,26 @@ loadElf elf@(Elf classS _) = withSingElfClassI classS $ do
     forM_ (zip [0 ..] bytes) $ \(i, byte) ->
       ramWrite (addr + fromIntegral i) Byte (zeroExtend $ bitCoerce byte)
 
--- | Extract all loadable sections from an ELF into a list of (Address, ByteString)
+-- | Extract all loadable sections from an ELF into a list of (Address,
+-- ByteString)
 getElfSegments :: Elf -> [(Address, BS.ByteString)]
 getElfSegments (Elf classS elfs) = withSingElfClassI classS $
   let loadable = loadableSegments elfs
    in P.concatMap extractSegmentSections loadable
   where
-    extractSegmentSections :: (SingElfClassI a) => ElfXX 'Segment a -> [(Address, BS.ByteString)]
+    extractSegmentSections ::
+      (SingElfClassI a) => ElfXX 'Segment a -> [(Address, BS.ByteString)]
     extractSegmentSections ElfSegment {..} =
       let sections = gatherSections epData
        in -- We ignore epAddMemSize here to avoid massive allocations;
           -- BSS should be handled by the memory model (zero-initialized).
           sections
 
-    gatherSections :: (SingElfClassI a) => ElfListXX a -> [(Address, BS.ByteString)]
+    gatherSections ::
+      (SingElfClassI a) => ElfListXX a -> [(Address, BS.ByteString)]
     gatherSections ElfListNull = []
-    gatherSections (ElfListCons (ElfSection {esData = ElfSectionData d, ..}) xs) =
+    gatherSections
+      (ElfListCons (ElfSection {esData = ElfSectionData d, ..}) xs) =
       (fromIntegral esAddr, BSL.toStrict d) : gatherSections xs
     gatherSections (ElfListCons _ xs) = gatherSections xs
 
@@ -84,7 +88,8 @@ baseAddr (Elf SELFCLASS32 elfs) = go elfs
     go ElfListNull = pure 0
 
 -- | Read a string from memory starting at the given address for count bytes
-readStringFromMemory :: (MonadMemory m) => Unsigned 32 -> Unsigned 32 -> m String
+readStringFromMemory ::
+  (MonadMemory m) => Unsigned 32 -> Unsigned 32 -> m String
 readStringFromMemory addr count = do
   bytes <-
     forM [0 .. count - 1] $ \i -> do
@@ -92,10 +97,16 @@ readStringFromMemory addr count = do
       pure $ fromIntegral (byte .&. 0xFF)
   pure $ P.map chr $ takeWhile (/= 0) bytes
 
--- | Called when the core halts with a syscall. Return the value to write to a0, or Nothing to truly exit.
+-- | Called when the core halts with a syscall. Return the value to write to a0,
+-- or Nothing to truly exit.
 type Instrument m = Core.State -> m (Maybe Types.Word)
 
-runElf :: forall m. (MonadIO m, MonadMemory m) => Instrument m -> CircuitSim m Core.Input Core.State Core.Output -> m ()
+runElf ::
+  forall m.
+  (MonadIO m, MonadMemory m) =>
+  Instrument m ->
+  CircuitSim m Core.Input Core.State Core.Output ->
+  m ()
 runElf instr c = go c
   where
     go sim@(CircuitSim i s step next) = do
@@ -111,6 +122,7 @@ runElf instr c = go c
           case mRet of
             Nothing -> pure ()
             Just ret -> do
-              let s'' = Core.initAt resumePc (modifyRF 10 ret (Core.stateRegFile s'))
+              let rf' = modifyRF 10 ret (Core.stateRegFile s')
+                  s'' = Core.initAt resumePc rf'
               go $ sim {circuitInput = Core.initInput, circuitState = s''}
         Just (Core.EBreak _) -> pure ()
\ No newline at end of file
diff --git a/src/Elf/Syscall.hs b/src/Elf/Syscall.hs
index ef28693..2c0ba46 100644
--- a/src/Elf/Syscall.hs
+++ b/src/Elf/Syscall.hs
@@ -2,7 +2,20 @@
 
 module Elf.Syscall (handleSyscall, ProgramExitException(..)) where
 
-import Clash.Prelude hiding (Log, Ordering (..), Word, break, def, init, lift, log, resize, zip, (++))
+import Clash.Prelude
+  hiding
+    ( Log,
+      Ordering (..),
+      Word,
+      break,
+      def,
+      init,
+      lift,
+      log,
+      resize,
+      zip,
+      (++)
+    )
 import Prelude hiding (Ordering (..), Word, break, init, log, map, not, repeat, undefined, (&&), (||))
 import Memory.Types
 import Elf.ElfLoader
@@ -14,7 +27,7 @@ import System.Entropy
 import qualified Data.ByteString as BS
 
 import Types
-import qualified Core
+import qualified Core.Pipeline as Core
 import Core.RegFile
 
 -- Custom exception type for non-zero program exit codes
@@ -76,7 +89,8 @@ handleSyscall s = do
         "/dev/random"  -> randomFd
         "/dev/urandom" -> randomFd
         _              -> bitCoerce (-1 :: Int32)
-    676767 -> -- mark_memory_region: accepted and ignored; the core tracks no secrets
+    -- mark_memory_region: accepted and ignored; the core tracks no secrets
+    676767 ->
       pure $ Just 0
     n -> do
       liftIO $ putStrLn $ "Syscall: Unknown " ++ show (toInteger n)
diff --git a/src/HardwareSim.hs b/src/HardwareSim.hs
index 5ee0611..3de508a 100644
--- a/src/HardwareSim.hs
+++ b/src/HardwareSim.hs
@@ -5,7 +5,7 @@
 module HardwareSim (topEntity) where
 
 import Clash.Prelude hiding (Log, Ordering (..), Word, def, init, lift, log)
-import Core hiding (topEntity)
+import Core.Pipeline hiding (topEntity)
 import Data.Maybe (fromMaybe)
 import qualified GHC.TypeNats
 import Core.Instruction hiding (decode)
@@ -21,20 +21,34 @@ topEntity ::
   Signal System Output
 topEntity = exposeClockResetEnable $ system prog3
 
-cpu :: forall dom. (HiddenClockResetEnable dom) => Signal dom Input -> Signal dom Output
+cpu ::
+  forall dom.
+  (HiddenClockResetEnable dom) =>
+  Signal dom Input ->
+  Signal dom Output
 cpu = mealy (circuit @RegFile) (init @RegFile)
 
-system :: forall dom. (HiddenClockResetEnable dom) => Vec PROG_SIZE Word -> Signal dom Output
+system ::
+  forall dom.
+  (HiddenClockResetEnable dom) =>
+  Vec PROG_SIZE Word ->
+  Signal dom Output
 system prog = cpuOut
   where
     cpuInput :: Signal dom Input
     cpuInput = register initInput input
     cpuOut = cpu cpuInput
-    ram = HardwareSim.mkRAM @PROG_SIZE @RAM_SIZE prog (fromMaybe (MemRead 0 Word) . outMem <$> cpuOut)
+    ram =
+      HardwareSim.mkRAM @PROG_SIZE @RAM_SIZE prog
+        (fromMaybe (MemRead 0 Word) . outputMem <$> cpuOut)
     input = Input . Just <$> ram
 
 mkRAM :: forall progSize ramSize dom.
-  (HiddenClockResetEnable dom, KnownNat ((GHC.TypeNats.*) ramSize 4), KnownNat (progSize + ramSize), KnownNat ((GHC.TypeNats.*) (progSize + ramSize) 4)) =>
+  ( HiddenClockResetEnable dom,
+    KnownNat ((GHC.TypeNats.*) ramSize 4),
+    KnownNat (progSize + ramSize),
+    KnownNat ((GHC.TypeNats.*) (progSize + ramSize) 4)
+  ) =>
   Vec progSize Word ->
   Signal dom MemAccess ->
   Signal dom Word
diff --git a/src/Memory/Cache4K.hs b/src/Memory/Cache4K.hs
index c364a27..642748c 100644
--- a/src/Memory/Cache4K.hs
+++ b/src/Memory/Cache4K.hs
@@ -8,18 +8,21 @@
 --
 -- The arrays are 'Vec's, read and written only through the wrappers below.
 -- Those are @OPAQUE@ so that the proof can replace them by SMT array operations
--- ("Proof.Cache.Array"), as it does for the register file and memory: the
--- Clash 'Vec' operations themselves cannot be symbolically executed.
+-- ("Proof.Memory.Cache4K.SMT.Array"), as it does for the register file and
+-- memory: the Clash 'Vec' operations themselves cannot be symbolically
+-- executed.
 module Memory.Cache4K
   ( -- * Arrays
     TagArr (..),
     tagRead,
     tagWrite,
     tagEmpty,
+    tagEq,
     DataArr (..),
     dataRead,
     dataWrite,
     dataZero,
+    dataEq,
 
     -- * Addresses
     Tag,
@@ -53,7 +56,10 @@ import Prelude hiding (Ordering (..), Word, init, log, not, repeat, undefined, (
 
 -- | The tag entries, one per set: the valid bit, then the tag.
 newtype TagArr = TagArr (Vec 256 (BitVector 21))
-  deriving (Eq, Show)
+  deriving (Show)
+
+instance Eq TagArr where
+  (==) = tagEq
 
 -- | The tag entry of set @si@.
 {-# OPAQUE tagRead #-}
@@ -70,9 +76,17 @@ tagWrite si e (TagArr v) = TagArr (replace si e v)
 tagEmpty :: TagArr
 tagEmpty = TagArr (repeat 0)
 
+-- | Are two tag arrays equal at every set?
+{-# OPAQUE tagEq #-}
+tagEq :: TagArr -> TagArr -> Bool
+tagEq (TagArr v) (TagArr w) = v == w
+
 -- | The data, one word per set and word within the line.
 newtype DataArr = DataArr (Vec 1024 Word)
-  deriving (Eq, Show)
+  deriving (Show)
+
+instance Eq DataArr where
+  (==) = dataEq
 
 -- | The word at index @i@ (set, then word within the line).
 {-# OPAQUE dataRead #-}
@@ -89,6 +103,11 @@ dataWrite i w (DataArr v) = DataArr (replace i w v)
 dataZero :: DataArr
 dataZero = DataArr (repeat 0)
 
+-- | Are two data arrays equal at every index?
+{-# OPAQUE dataEq #-}
+dataEq :: DataArr -> DataArr -> Bool
+dataEq (DataArr v) (DataArr w) = v == w
+
 -- Addresses ---------------------------------------------------------------------
 
 -- | Which block of memory a line holds, among those that map to its set: bits
@@ -211,15 +230,17 @@ cacheWriteByteInWord bi b w = case bi of
 -- address's block; otherwise leave the cache alone (no allocation).
 cacheWriteByte :: Address -> Byte -> Cache4K -> Cache4K
 cacheWriteByte addr b c
-  | cacheHit addr c = c {dataArr = dataWrite i (cacheWriteByteInWord (byteOf addr) b w) (dataArr c)}
+  | cacheHit addr c =
+      c {dataArr = dataWrite i (cacheWriteByteInWord (byteOf addr) b w) dat}
   | otherwise = c
   where
     i = setOf addr ++# wordOf addr
-    w = dataRead i (dataArr c)
+    dat = dataArr c
+    w = dataRead i dat
 
 -- | What a write does to the cache. Memory always takes the write
--- (write-through); the cache only makes sure its copy does not go stale. Byte by
--- byte, as memory stores it ('Memory.Types.memWrite'): each byte goes into
+-- (write-through); the cache only makes sure its copy does not go stale. Byte
+-- by byte, as memory stores it ('Memory.Types.memWrite'): each byte goes into
 -- its cached word if its line hits, so a write may cross a word or line
 -- boundary.
 cacheWrite :: Address -> Size -> Word -> Cache4K -> Cache4K
diff --git a/src/Memory/Cache4KServer.hs b/src/Memory/Cache4KServer.hs
index 0d447b4..b2474dc 100644
--- a/src/Memory/Cache4KServer.hs
+++ b/src/Memory/Cache4KServer.hs
@@ -4,12 +4,12 @@
 -- | The 4 KiB cache ("Memory.Cache4K") as a server between the core and memory:
 -- how it answers the core's memory requests, cycle by cycle.
 --
--- A read miss takes 'penalty' extra cycles and then fills the line with the
--- four words of its block; a read that leaves its word bypasses the cache with
--- the same delay. A write goes through to memory at once: inside one word, on a
--- hit, it is merged into the cached word; if it crosses a word boundary, the
--- lines it touches are invalidated instead ('Memory.Cache4K.write'). Fetches
--- bypass the cache.
+-- A read touches the lines of its first and last byte. Each of them that misses
+-- takes 'penalty' extra cycles and is filled with the four words of its block;
+-- the read is then answered from the cache. A write goes through to memory at
+-- once, and each of its bytes is merged into its cached word if that word's
+-- line holds its block; a line that misses is left alone, with no allocation
+-- ('Memory.Cache4K.cacheWrite'). Fetches bypass the cache.
 module Memory.Cache4KServer
   ( Cycles,
     CacheSrv (..),
@@ -21,36 +21,39 @@ module Memory.Cache4KServer
 where
 
 import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
-import Core (Input (..), MemAccess (..), Request)
+import Core.Pipeline (Input (..), MemAccess (..), Request)
 import Memory.Cache4K
 import Memory.Types (MemOps (..))
 import Types
 import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
 
 -- | Cycles of a miss penalty: a small counter, sized as hardware would size it.
--- (This also keeps the symbolic proof in the bitvector fragment Bitwuzla reads.)
+-- (This also keeps the symbolic proof in the bitvector fragment Bitwuzla
+-- reads.)
 type Cycles = Unsigned 8
 
 -- | Extra cycles of a read miss: the four words of a line.
 penalty :: Cycles
 penalty = 4
 
--- | The address of the last byte of an access. An access touches at most two
--- lines: the lines of its first and last byte.
+-- | Ready for a request, or waiting for memory: the cycles left, and the word a
+-- read will be answered with.
 data CacheSrvState = CacheSrvReady | CacheSrvStall Cycles Word
   deriving (Show, Eq)
 
--- | A cache in front of memory, as a server: the cache, a read waiting for
--- memory, and memory.
+-- | A cache in front of memory, as a server: the cache, memory, and whether a
+-- read is waiting for memory.
 data CacheSrv m = CacheSrv
   { srvCache :: Cache4K,
     srvMem :: m,
-    -- | A read waiting for memory: its address and width, and the cycles left.
+    -- | Ready, or a read waiting for memory.
     srvState :: CacheSrvState
   }
 
 deriving instance (Show m) => Show (CacheSrv m)
 
+deriving instance (Eq m) => Eq (CacheSrv m)
+
 -- | The cache server at start: no line valid and no read waiting, in front of
 -- memory @mem@.
 initCacheSrv :: m -> CacheSrv m
@@ -73,7 +76,7 @@ serve (CacheSrv c mem st) req = case st of
             Byte -> 0
             Half -> 1
             Word -> 3
-            
+
           hit1stLine = cacheHit addr c
           penalty1stLine = if hit1stLine then 0 else penalty
           c1 = if hit1stLine then c else cacheFill addr mem c
@@ -87,7 +90,7 @@ serve (CacheSrv c mem st) req = case st of
 
       in if n > 0
            then (CacheSrv c2 mem (CacheSrvStall (n - 1) w), Input Nothing)
-           else (CacheSrv c2 mem CacheSrvReady, Input $ Just w)
+           else (CacheSrv c2 mem CacheSrvReady, Input (Just w))
     Just (MemWrite addr size val) ->
       ( CacheSrv
           (cacheWrite addr size val c)
diff --git a/src/Memory/IO.hs b/src/Memory/IO.hs
index 094d699..4c5a801 100644
--- a/src/Memory/IO.hs
+++ b/src/Memory/IO.hs
@@ -7,7 +7,8 @@ module Memory.IO
   )
 where
 
-import Clash.Prelude hiding (Log, Ordering (..), Word, break, def, init, lift, log, resize)
+import Clash.Prelude
+  hiding (Log, Ordering (..), Word, break, def, init, lift, log, resize)
 import Clash.Sized.Vector (unsafeFromList)
 import Control.Monad (forM_)
 import Control.Monad.Reader
@@ -69,6 +70,10 @@ instance {-# OVERLAPPING #-} MonadMemory (IOMemT IO) where
           forM_ (P.zip [0 ..] bytes) $ \(i, byte) ->
             lift $ writeArray ramArray (fromIntegral addr + i) byte
     case size of
-      Byte -> writeBytes [bitCoerce b0] -- Write 1 byte
-      Half -> writeBytes [bitCoerce b0, bitCoerce b1] -- Write 2 bytes (halfword)
-      Word -> writeBytes [bitCoerce b0, bitCoerce b1, bitCoerce b2, bitCoerce b3] -- Write 4 bytes (word)
+      -- Write 1 byte
+      Byte -> writeBytes [bitCoerce b0]
+      -- Write 2 bytes (halfword)
+      Half -> writeBytes [bitCoerce b0, bitCoerce b1]
+      -- Write 4 bytes (word)
+      Word ->
+        writeBytes [bitCoerce b0, bitCoerce b1, bitCoerce b2, bitCoerce b3]
diff --git a/src/Memory/Ideal.hs b/src/Memory/Ideal.hs
index 79276db..befe7ce 100644
--- a/src/Memory/Ideal.hs
+++ b/src/Memory/Ideal.hs
@@ -7,7 +7,7 @@ module Memory.Ideal
 where
 
 import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
-import Core (Input (..), MemAccess (..))
+import Core.Pipeline (Input (..), MemAccess (..))
 import Memory.Types (MemOps (..))
 import Types (Address, Size (..), Word)
 import Prelude hiding (Ordering (..), Word, init, log, not, undefined, (!!), (&&), (++), (||))
diff --git a/src/Memory/ST.hs b/src/Memory/ST.hs
index 91a1f72..f0eafe2 100644
--- a/src/Memory/ST.hs
+++ b/src/Memory/ST.hs
@@ -16,7 +16,7 @@ import Clash.Prelude hiding (Ordering (..), Word, init, lift)
 import Control.Monad (when)
 import Control.Monad.Reader
 import Control.Monad.ST (RealWorld, ST, stToIO)
-import Core
+import Core.Pipeline as Core
 import Data.Array.ST (STUArray, newArray, readArray, writeArray)
 import Data.Word (Word8)
 import Memory.Types
@@ -39,12 +39,21 @@ data STMemory s = STMemory
 
 -- | STMemory monad transformer.
 newtype STMemoryT s m a = STMemoryT {unSTMemoryT :: ReaderT (STMemory s) m a}
-  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader (STMemory s), MonadTrans)
+  deriving newtype
+    ( Functor,
+      Applicative,
+      Monad,
+      MonadIO,
+      MonadReader (STMemory s),
+      MonadTrans
+    )
 
 runSTMemoryT :: STMemory s -> STMemoryT s m a -> m a
 runSTMemoryT mem (STMemoryT m) = runReaderT m mem
 
-instance {-# OVERLAPPING #-} (MonadIO m) => MonadMemory (STMemoryT RealWorld m) where
+instance {-# OVERLAPPING #-}
+  (MonadIO m) => MonadMemory (STMemoryT RealWorld m)
+  where
   ramRead addr size = do
     st <- ask
     let offset = addr - stDataBase st
@@ -74,7 +83,11 @@ readDataArray addr size arr = case size of
     b1 <- readArray arr (addr + 1)
     b2 <- readArray arr (addr + 2)
     b3 <- readArray arr (addr + 3)
-    pure $ (bitCoerce b3 :: Byte) ++# (bitCoerce b2 :: Byte) ++# (bitCoerce b1 :: Byte) ++# (bitCoerce b0 :: Byte)
+    pure $
+      (bitCoerce b3 :: Byte)
+        ++# (bitCoerce b2 :: Byte)
+        ++# (bitCoerce b1 :: Byte)
+        ++# (bitCoerce b0 :: Byte)
 
 -- | Write a sized value to the data array.
 writeDataArray :: Address -> Size -> Word -> STUArray s Address Word8 -> ST s ()
@@ -98,12 +111,20 @@ newSTMemory entry base = do
   pure $ STMemory arr base entry
 
 -- | Run a simulation in the ST monad.
-runSTSim :: forall i s o a. (forall st. CircuitSim (ST st) i s o -> ST st a) -> CircuitSim (ST s) i s o -> ST s a
+runSTSim ::
+  forall i s o a.
+  (forall st. CircuitSim (ST st) i s o -> ST st a) ->
+  CircuitSim (ST s) i s o ->
+  ST s a
 runSTSim f sim = f sim
 
 -- | Utility to run a full simulation until halt.
---   Uses deepseqX to ensure the state is fully evaluated and prevent thunk leaks.
-runUntilHalt :: (MonadMemory m) => CircuitSim m Core.Input Core.State Core.Output -> m Core.State
+--   Uses deepseqX to ensure the state is fully evaluated and prevent thunk
+--   leaks.
+runUntilHalt ::
+  (MonadMemory m) =>
+  CircuitSim m Core.Input Core.State Core.Output ->
+  m Core.State
 runUntilHalt sim = go sim
   where
     go sim' = do
diff --git a/src/Memory/Types.hs b/src/Memory/Types.hs
index d10e4b4..64235dd 100644
--- a/src/Memory/Types.hs
+++ b/src/Memory/Types.hs
@@ -36,9 +36,9 @@ type MemBytes = Vec MEM_SIZE_BYTES Byte
 
 -- | The operations a memory representation has to provide.
 --
--- Parameterised for the same reason as 'Core.RegFile.RegFileOps': the @Vec@-backed
--- 'MemBytes' cannot be symbolically executed, while the function-backed 'MemFn'
--- can.
+-- Parameterised for the same reason as 'Core.RegFile.RegFileOps': the
+-- @Vec@-backed 'MemBytes' cannot be symbolically executed, while the
+-- function-backed 'MemFn' can.
 class MemOps m where
   memReadWord :: Address -> m -> Word
   memWrite :: Address -> Size -> Word -> m -> m
@@ -121,7 +121,11 @@ mkProg prog =
 type MemSizeFrom progSize ramSizeBytes =
   ramSizeBytes + ((GHC.TypeNats.*) progSize 4)
 
-mkRAM :: forall progSize ramSize. (KnownNat ramSize) => Vec progSize Word -> Vec (MemSizeFrom progSize ramSize) Byte
+mkRAM ::
+  forall progSize ramSize.
+  (KnownNat ramSize) =>
+  Vec progSize Word ->
+  Vec (MemSizeFrom progSize ramSize) Byte
 mkRAM prog =
   (repeat 0 :: Vec ramSize Byte) ++ Clash.Prelude.concatMap splitWord prog
   where
diff --git a/src/Simulate.hs b/src/Simulate.hs
index f5fa58e..38f29b5 100644
--- a/src/Simulate.hs
+++ b/src/Simulate.hs
@@ -16,8 +16,8 @@ where
 import Clash.Prelude hiding (Log, Ordering (..), Word, def, init, lift, log)
 import Control.Monad.RWS
 import Control.Monad.State
-import Core hiding (State)
-import qualified Core
+import Core.Pipeline as Core hiding (State)
+import qualified Core.Pipeline as Core
 import Data.Maybe (isJust)
 import Memory.Types
 import Memory.Vec
@@ -56,15 +56,27 @@ simulator =
 runSimulator ::
   forall ramSize progSize a.
   (KnownNat ramSize, KnownNat (MemSizeFrom progSize ramSize)) =>
-  ( CircuitSim (State (Mem (MemSizeFrom progSize ramSize))) Input Core.State Output ->
+  ( CircuitSim
+      (State (Mem (MemSizeFrom progSize ramSize)))
+      Input
+      Core.State
+      Output ->
     State (Mem (MemSizeFrom progSize ramSize)) a
   ) ->
   Vec progSize Word ->
   a
 runSimulator f = evalState (f simulator) . Mem . mkRAM
 
-watchSim :: forall ramSize progSize. (KnownNat ramSize, KnownNat (MemSizeFrom progSize ramSize)) => Vec progSize Word -> [(Core.State, Output, Maybe Input)]
+watchSim ::
+  forall ramSize progSize.
+  (KnownNat ramSize, KnownNat (MemSizeFrom progSize ramSize)) =>
+  Vec progSize Word ->
+  [(Core.State, Output, Maybe Input)]
 watchSim = runSimulator @ramSize @progSize watch
 
-simResult :: forall ramSize progSize. (KnownNat ramSize, KnownNat (MemSizeFrom progSize ramSize)) => Vec progSize Word -> Vec (MemSizeFrom progSize ramSize) Byte
+simResult ::
+  forall ramSize progSize.
+  (KnownNat ramSize, KnownNat (MemSizeFrom progSize ramSize)) =>
+  Vec progSize Word ->
+  Vec (MemSizeFrom progSize ramSize) Byte
 simResult = runSimulator result
diff --git a/test/BenchmarkSpec.hs b/test/BenchmarkSpec.hs
index b9e30ac..83c4076 100644
--- a/test/BenchmarkSpec.hs
+++ b/test/BenchmarkSpec.hs
@@ -11,7 +11,7 @@ import Control.Exception (throwIO)
 import Control.Monad (when)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.ST (stToIO, RealWorld)
-import qualified Core as Core
+import qualified Core.Pipeline as Core
 import Elf.ElfLoader
 import Elf.Syscall (handleSyscall)
 import Numeric (showHex)
@@ -69,7 +69,7 @@ mkBenchmarkTest testName _benchmark =
     -- Run the simulator with STMemory and MonadMemory interface; loadElf
     -- copies the program's segments into memory.
     stMem <- stToIO $ newSTMemory (fromIntegral entryOffset) (fromIntegral base)
-    
+
     _ <- runSTMemoryT stMem $ do
       loadElf elf
       let sim :: CircuitSim (STMemoryT RealWorld IO) (Core.Input) (Core.State) (Core.Output)
diff --git a/test/Cache4KSpec.hs b/test/Cache4KSpec.hs
index a4c09d8..d34fd47 100644
--- a/test/Cache4KSpec.hs
+++ b/test/Cache4KSpec.hs
@@ -1,30 +1,25 @@
 {-# LANGUAGE PackageImports #-}
 
--- | The 4 KiB cache ("Memory.Cache4K"): a few concrete runs, its server proof
--- ("Proof.Cache.Server4K") on random states, and the composition end to end.
+-- | The 4 KiB cache ("Memory.Cache4K") and its server ("Memory.Cache4KServer")
+-- on their own: reads that cross lines, and a few concrete runs. The cache's
+-- proof and the core behind the cache are tested in "CacheProofSpec".
 module Cache4KSpec
   ( cache4KTests,
+    TestMem (..),
+    genMem,
+    genTag,
+    genAddr,
+    genWord,
   )
 where
 
 import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
-import Clash.Sized.Vector (unsafeFromList)
-import CompositionSpec (coreDiff, ctTrace, genByteProg, genCTProg, genData, genSecretFreeProg, genWord, sameModuloCtrl, simHops, withData)
-import Core
-import Data.Functor.Identity (Identity (..))
-import Data.Maybe (isNothing)
-import Core.Instruction
+import Core.Pipeline (Input (..), MemAccess (..), Request)
 import Memory.Cache4K
 import Memory.Cache4KServer
+import Memory.Ideal (idealServe)
 import Memory.Types
-import Proof.Cache.Server.Functional.Driver (driver)
-import Proof.Cache.Server.Functional.Invariant (coherentAt, srvInvAt)
-import Proof.Cache.Server4K
-import Proof.Core.Functional.Obligation (isaAt)
-import Proof.Core.Leakage.Model
-import Proof.Core.Functional.Machine
-import ProofSpec (initSys)
-import Core.RegFile (RegFile)
+import Proof.Memory.Cache4K.Server.Functional.Driver (srvDriver)
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (testCase, (@?=))
 import Test.Tasty.QuickCheck
@@ -35,144 +30,54 @@ import qualified Prelude as P
 cache4KTests :: TestTree
 cache4KTests =
   testGroup
-    "Core behind a 4 KiB cache"
-    [ runTests,
-      testProperty "read, from the lines of the first and last byte, answers as memory does" $
+    "4 KiB cache"
+    [ testProperty "a read, from the lines of its first and last byte, answers as memory does" $
         withMaxSuccess 2000 $ checkCoverage $
-          forAllShow genMem (const "<memory>") $ \mem -> forAll genAddr $ \a -> forAll (elements [Byte, Half, Types.Word]) $ \size ->
+          forAll genMem $ \mem -> forAll genAddr $ \a -> forAll (elements [Byte, Half, Types.Word]) $ \size ->
             let c = cacheFill (lastByteOf a size) mem (cacheFill a mem emptyCache4K)
-             in cover 10 (straddles a size) "straddling" (cacheRead a size c == readResp a size mem),
-      serverTests,
-      testProperty "composition: the cached core's bus trace follows from the leakage alone" $
-        withMaxSuccess 300 $ checkCoverage $
-          forAll genCTProg $ \prog ->
-            let sys = initSys prog
-                r = compositeReport sys
-             in cover 30 (stallCycles sys > 0) "the core waits for the cache" (counterexample r (P.null r)),
-      testProperty "... also with reads and writes of every width and alignment" $
-        withMaxSuccess 300 $ checkCoverage $
-          forAll genByteProg $ \prog -> forAll genData $ \ds ->
-            let sys = withData ds (initSys prog)
-                r = compositeReport sys
-             in cover 30 (stallCycles sys > 0) "the core waits for the cache" (counterexample r (P.null r)),
-      testProperty "the cached run is the ideal run with stall cycles inserted" $
-        withMaxSuccess 300 $
-          forAll genCTProg $ \prog ->
-            let r = stutterReport 300 (initSys prog)
-             in counterexample r (P.null r),
-      testProperty "... also with reads and writes of every width and alignment" $
-        withMaxSuccess 300 $
-          forAll genByteProg $ \prog ->
-            forAll genData $ \ds ->
-              let r = stutterReport 300 (withData ds (initSys prog))
-               in counterexample r (P.null r),
-      testProperty "a secret-free program leaks nothing about its data, behind the cache" $
-        withMaxSuccess 300 $
-          forAll genSecretFreeProg $ \prog ->
-            forAll genData $ \da ->
-              forAll genData $ \db ->
-                let s1 = withData da (initSys prog)
-                    s2 = withData db (initSys prog)
-                 in ctTrace 100 (isaAt initPc s1) == ctTrace 100 (isaAt initPc s2)
-                      P.&& cachedObs 300 s1 == cachedObs 300 s2,
-      testProperty "a load through a loaded pointer leaks it, even to a timing attacker" $
-        -- The control: @lw x5, 0(x0); lw x1, 0(x5); lw x2, 0(x0); ebreak@. The
-        -- second load's address is data. With the pointer at 0 the second load
-        -- hits the line the first one filled; with the pointer at 16, in the next
-        -- set, it misses. So even an attacker who sees only in which cycles a
-        -- request is made tells the two apart.
-        let prog =
-              map encode $
-                unsafeFromList $
-                  [ IType (Load Types.Word Signed) 5 0 0,
-                    IType (Load Types.Word Signed) 1 5 0,
-                    IType (Load Types.Word Signed) 2 0 0
-                  ]
-                    P.++ P.replicate 47 Core.Instruction.break
-            timing p = P.map (/= NoAccess) (cachedObs 100 (withData [(0, p)] (initSys prog)))
-         in once (timing 0 /= timing 16)
+             in cover 10 (straddles a size) "straddling" $
+                  Just (cacheRead a size c) == idealAnswer mem (Just (MemRead a size)),
+      runTests
     ]
 
--- Concrete runs -------------------------------------------------------------------
-
-memU :: MemFn
-memU = MemFn (\a -> slice d7 d0 (pack (a * 13 + 7)))
-
-rdReq :: Address -> Size -> Request
-rdReq a sz = Just (MemAccess False a sz Nothing)
-
-wrReq :: Address -> Size -> Word -> Request
-wrReq a sz v = Just (MemAccess False a sz (Just (Identity v)))
-
--- | Serve requests one hop each, from the empty cache in front of 'memU':
--- the stall count and the response word of each.
-hops :: [Request] -> [(Cycles, Word)]
-hops = go (CacheSrv emptyCache4K Nothing memU)
-  where
-    go _ [] = []
-    go y (q : qs) =
-      let k = driver y q
-          (y', x) = serveN k y q
-       in (fromIntegral k, runIdentity (inputMem x)) : go y' qs
-
-runTests :: TestTree
-runTests =
-  testGroup
-    "concrete runs"
-    [ testCase "a read miss stalls, then the rest of its line hits" $
-        hops [rdReq 0x100 Types.Word, rdReq 0x10C Types.Word, rdReq 0x106 Half]
-          @?= [ (penalty, memReadWord 0x100 memU),
-                (0, memReadWord 0x10C memU),
-                (0, loadExtend Half Unsigned (memReadWord 0x106 memU))
-              ],
-      testCase "lines 4 KiB apart evict each other" $
-        P.map fst (hops [rdReq 0x100 Types.Word, rdReq 0x1100 Types.Word, rdReq 0x100 Types.Word])
-          @?= [penalty, penalty, penalty],
-      testCase "a write hit is merged into the cached word" $
-        hops [rdReq 0x100 Types.Word, wrReq 0x101 Byte 0xAB, rdReq 0x100 Types.Word]
-          @?= [ (penalty, memReadWord 0x100 memU),
-                (0, 0),
-                (0, memReadWord 0x100 (memWrite 0x101 Byte 0xAB memU))
-              ],
-      testCase "a write that leaves its word drops its lines" $
-        P.map fst (hops [rdReq 0x100 Types.Word, rdReq 0x110 Types.Word, wrReq 0x10E Types.Word 1, rdReq 0x100 Types.Word, rdReq 0x110 Types.Word])
-          @?= [penalty, penalty, 0, penalty, penalty]
-    ]
-
--- The server proof on random states -------------------------------------------------
-
--- | A memory whose bytes are a function of their address, different in every
--- test.
-genMem :: Gen MemFn
-genMem = do
-  k1 <- genU32
-  k2 <- genU32
-  pure (MemFn (\a -> slice d7 d0 (pack ((a * (k1 .|. 1) + k2) `xor` (a `shiftR` 9)))))
+-- Memory --------------------------------------------------------------------------
+
+-- | A memory for the tests: bytes that are a function of their address and two
+-- seeds, and the bytes written since, newest first. Unlike 'MemFn' it has
+-- equality, which 'Proof.Memory.Cache4K.Server.Functional.Contract.srvReady' needs, and
+-- it shows. Equality compares the representation, so two memories that agree
+-- byte for byte may still differ; a server that leaves memory alone leaves it
+-- equal.
+data TestMem = TestMem (Unsigned 32) (Unsigned 32) [(Address, Byte)]
+  deriving (Eq, Show)
+
+instance MemOps TestMem where
+  memReadByte a (TestMem k1 k2 ws) = case P.lookup a ws of
+    Just b -> b
+    Nothing -> slice d7 d0 (pack ((a * (k1 .|. 1) + k2) `xor` (a `shiftR` 9)))
+  memReadWord a m =
+    memReadByte (a + 3) m ++# memReadByte (a + 2) m ++# memReadByte (a + 1) m ++# memReadByte a m
+  memWrite a size w (TestMem k1 k2 ws) = TestMem k1 k2 (bytes P.++ ws)
+    where
+      bytes = case size of
+        Byte -> [(a, b0)]
+        Half -> [(a + 1, b1), (a, b0)]
+        Types.Word -> [(a + 3, b3), (a + 2, b2), (a + 1, b1), (a, b0)]
+      b0 = slice d7 d0 w
+      b1 = slice d15 d8 w
+      b2 = slice d23 d16 w
+      b3 = slice d31 d24 w
+
+-- | A memory different in every test, nothing written yet.
+genMem :: Gen TestMem
+genMem = (\k1 k2 -> TestMem k1 k2 []) <$> genU32 <*> genU32
   where
-    genU32 = fromIntegral <$> choose (0 :: Integer, 0xFFFFFFFF) :: Gen (Unsigned 32)
+    genU32 = fromIntegral <$> choose (0 :: Integer, 0xFFFFFFFF)
 
 -- | Tags of the first three 4 KiB blocks of memory, sometimes others.
 genTag :: Gen Tag
 genTag = frequency [(10, elements [0, 1, 2]), (1, fromIntegral <$> choose (0 :: Int, 0xFFFFF))]
 
--- | The cache in front of memory, with no miss pending: lines mostly valid,
--- holding memory's words, and rarely a wrong word, which takes the server out of
--- its invariant at that word.
-genSrv :: Gen (CacheSrv MemFn)
-genSrv = do
-  mem <- genMem
-  es <- vectorOf 256 (frequency [(2, pure 0), (8, ((1 :: BitVector 1) ++#) <$> genTag)])
-  ws <- P.mapM (genData1 mem es) [0 .. 1023]
-  pure (CacheSrv (Cache4K (TagArr (unsafeFromList es)) (DataArr (unsafeFromList ws))) Nothing mem)
-  where
-    genData1 mem es i =
-      let s = fromIntegral (i `P.div` 4) :: SetIdx
-          w = fromIntegral (i `P.mod` 4) :: WordIdx
-          e = es P.!! (i `P.div` 4)
-       in if entryValid e
-            then frequency [(60, pure (memReadWord (wordAddr (entryTag e) s w 0) mem)), (1, genWord)]
-            else genWord
-
 -- | Addresses in the first three 4 KiB blocks, sometimes anywhere.
 genAddr :: Gen Address
 genAddr =
@@ -181,185 +86,86 @@ genAddr =
       (1, fromIntegral <$> choose (0 :: Integer, 0xFFFFFFFF))
     ]
 
--- | Requests: none, fetches, and reads and writes of every width and alignment,
--- and also requests the core never makes.
-genReq :: Gen Request
-genReq =
-  frequency
-    [ (1, pure Nothing),
-      (2, (\a -> Just (MemAccess True a Types.Word Nothing)) <$> genAddr),
-      (1, (\a sz -> Just (MemAccess True a sz Nothing)) <$> genAddr <*> genSize),
-      (1, (\a sz v -> Just (MemAccess True a sz (Just (Identity v)))) <$> genAddr <*> genSize <*> genWord),
-      (8, (\a sz -> Just (MemAccess False a sz Nothing)) <$> genAddr <*> genSize),
-      (4, (\a sz v -> Just (MemAccess False a sz (Just (Identity v)))) <$> genAddr <*> genSize <*> genWord)
-    ]
-  where
-    genSize = elements [Byte, Half, Types.Word]
-
--- | Witnesses, half of the time at the request's own set, word and bytes.
-genWitness :: Request -> Gen (Address, SetIdx, WordIdx)
-genWitness q = do
-  let a = maybe 0 memAddress q
-  wa <- frequency [(1, (\o -> a + fromIntegral o) <$> choose (0 :: Int, 4)), (1, genAddr)]
-  ws <- frequency [(1, pure (setOf a)), (1, fromIntegral <$> choose (0 :: Int, 255))]
-  ww <- frequency [(1, pure (wordOf a)), (1, fromIntegral <$> choose (0 :: Int, 3))]
-  pure (wa, ws, ww)
-
--- | Serve a request, then @n@ cycles without one. A harness helper: the proofs
--- write their cycles out.
-serveN :: (MemOps m) => Int -> CacheSrv m -> Request -> (CacheSrv m, Input)
-serveN n srv req = go n (serve srv req)
-  where
-    go k (y', x)
-      | k <= 0 = (y', x)
-      | otherwise = go (k - 1) (serve y' Nothing)
+genWord :: Gen Word
+genWord = oneof [elements [0, 1, 0xFF, 0x1234, 0x80000000, 0xDEADBEEF], fromIntegral <$> (arbitrary :: Gen Int)]
 
--- | Has the core not halted yet?
-running :: SysG r m -> Bool
-running = isNothing . stateHalt . sysCore
+-- | Ideal memory's answer to a request.
+idealAnswer :: (MemOps m) => m -> Request -> Maybe Word
+idealAnswer mem req = inputMem (snd (idealServe mem req))
 
 -- | The address of the last byte of an access.
 lastByteOf :: Address -> Size -> Address
-lastByteOf a sz =
-  a + case sz of
+lastByteOf a size =
+  a + case size of
     Byte -> 0
     Half -> 1
     Types.Word -> 3
 
 -- | Does an access cross a word boundary?
 straddles :: Address -> Size -> Bool
-straddles a sz = a `shiftR` 2 /= lastByteOf a sz `shiftR` 2
+straddles a size = a `shiftR` 2 /= lastByteOf a size `shiftR` 2
 
--- | What kind of request, against what cache.
-reqKind :: CacheSrv MemFn -> Request -> String
-reqKind y q = case q of
-  Nothing -> "none"
-  Just (MemAccess _ a sz (Just _))
-    | straddles a sz -> "straddling write"
-    | hit a c -> "write hit"
-    | otherwise -> "write miss"
-  Just (MemAccess True _ _ Nothing) -> "fetch"
-  Just (MemAccess False a sz Nothing)
-    | straddles a sz -> "straddling read"
-    | hit a c -> "hit"
-    | otherwise -> "miss"
-  where
-    c = srvCache y
-
-coverKinds :: CacheSrv MemFn -> Request -> Property -> Property
-coverKinds y q =
-  P.foldr
-    (\k f -> cover 3 (reqKind y q == k) k . f)
-    id
-    ["none", "fetch", "write hit", "write miss", "straddling write", "hit", "miss", "straddling read"]
-
-serverTests :: TestTree
-serverTests =
-  testGroup
-    "server proof"
-    [ testProperty "the empty cache starts in the invariant" $
-        forAllShow genMem (const "<memory>") $ \mem ->
-          forAll (fromIntegral <$> choose (0 :: Int, 255)) $ \s ->
-            forAll (fromIntegral <$> choose (0 :: Int, 3)) $ \w -> srvInit s w mem,
-      testProperty "refinement: the hop of a request ends with ideal memory's response" $
-        withMaxSuccess 4000 $ checkCoverage $
-          forAllShow genSrv (const "<server>") $ \y -> forAll genReq $ \q -> forAll (genWitness q) $ \(wa, ws, ww) ->
-            coverKinds y q $
-              cover 80 (srvInvAt ws ww y) "in the invariant at the witness" $
-                cover 10 (ws == maybe 0 (setOf . memAddress) q P.&& ww == maybe 0 (wordOf . memAddress) q) "the witness is the accessed word" $
-                  srvRefine wa ws ww y q,
-      testProperty "leakage: the stalls and the next tags follow from the tags and the observed request" $
-        withMaxSuccess 4000 $ checkCoverage $
-          forAllShow genSrv (const "<server>") $ \y -> forAll genReq $ \q -> forAll (genWitness q) $ \(_, ws, _) ->
-            coverKinds y q (property (srvLeak ws y q)),
-      testProperty "the cache answers late only to a data read" $
-        withMaxSuccess 2000 $
-          forAllShow genSrv (const "<server>") $ \y -> forAll genReq $ \q -> stallsOnReads y q
-    ]
+-- Concrete runs -------------------------------------------------------------------
 
--- Composition, end to end -----------------------------------------------------------
+memU :: MemFn
+memU = MemFn (\a -> slice d7 d0 (pack (a * 13 + 7)))
 
--- | The requests the core makes behind the 4 KiB cache, cycle by cycle, until it
--- halts.
-cachedObs :: Int -> Sys -> [Obs]
-cachedObs n sys = go n (initCacheSys sys emptyCache4K)
-  where
-    go :: Int -> CacheSys RegFile MemBytes Cache4K -> [Obs]
-    go 0 _ = []
-    go j cs
-      | P.not (running (cacheSysCore cs)) = []
-      | otherwise = let (cs', o) = stepCachedOut cs in obsOf o : go (j - 1) cs'
+rdReq :: Address -> Size -> Request
+rdReq a size = Just (MemRead a size)
 
--- | The same trace from the leakage alone: the core's simulator produces each
--- hop's requests as behind ideal memory, and the cache's simulator adds the
--- cycles in which the core waits.
-compositeTrace :: Int -> Sys -> [Obs]
-compositeTrace n sys0 = go (P.take n (simHops sys0)) tagEmpty
-  where
-    go [] _ = []
-    go (os : rest) t =
-      let (t', bus) = serveAll t os
-       in bus P.++ go rest t'
-    serveAll t [] = (t, [])
-    serveAll t (o : os) =
-      let (t1, xs) = simBus t o
-          (t2, ys) = serveAll t1 os
-       in (t2, xs P.++ ys)
+wrReq :: Address -> Size -> Word -> Request
+wrReq a size v = Just (MemWrite a size v)
 
-compositeReport :: Sys -> String
-compositeReport sys0
-  | cached == P.take (P.length cached) composite = ""
-  | otherwise = "first difference at cycle " P.++ show i P.++ ": " P.++ show (P.take 6 (P.drop i cached)) P.++ " vs " P.++ show (P.take 6 (P.drop i composite))
+-- | Serve requests one hop each, from the server at start in front of 'memU':
+-- the driver's count of each hop, and the answer that ends it.
+hops :: [Request] -> [(Int, Maybe Word)]
+hops = go (initCacheSrv memU)
   where
-    cached = cachedObs 600 sys0
-    composite = compositeTrace 600 sys0
-    i = P.length (P.takeWhile id (P.zipWith (==) cached composite))
+    go _ [] = []
+    go srv (req : reqs) =
+      let k = srvDriver srv req
+          (srv', ans) = serveN k srv req
+       in (k, inputMem ans) : go srv' reqs
 
--- | The cycles in which the core behind the cache waits, until it halts.
-stallCycles :: Sys -> Int
-stallCycles sys0 = go (600 :: Int) (initCacheSys sys0 emptyCache4K)
-  where
-    go 0 _ = 0
-    go j cs
-      | P.not (running (cacheSysCore cs)) = 0
-      | otherwise =
-          (if inputMemReady (sysInput (cacheSysCore cs)) then 0 else 1)
-            + go (j - 1) (fst (stepCachedOut cs))
+-- | Serve a request, then @n@ cycles without one.
+serveN :: (MemOps m) => Int -> CacheSrv m -> Request -> (CacheSrv m, Input)
+serveN n srv req
+  | n <= 0 = serve srv req
+  | otherwise = serveN (n - 1) (fst (serve srv req)) Nothing
 
--- | Is the cache coherent with memory at every set the harness's memory can
--- fill? Memory is 'MEM_SIZE' words, below address 512, so only sets 0 to 31.
-coherentLow :: MemBytes -> Cache4K -> Bool
-coherentLow mem c = P.and [coherentAt mem s w c | s <- [0 .. 31], w <- [0 .. 3]]
+p :: Int
+p = fromIntegral penalty
 
--- | Walk the cached system and the ideal one together for @n@ cycles of the
--- cached one, skipping the cached run's stall cycles -- those whose bus input is
--- not ready -- in the ideal one. Returns @\"\"@ if every stall cycle makes no
--- request and leaves the core alone, the cache stays coherent with memory, and
--- every other cycle makes the ideal run's request from the ideal run's state, up
--- to 'sameModuloCtrl'.
-stutterReport :: Int -> Sys -> String
-stutterReport n sys0 = go n (0 :: Int) (initCacheSys sys0 emptyCache4K) sys0
+runTests :: TestTree
+runTests =
+  testGroup
+    "concrete runs"
+    [ testCase "a read miss stalls, then the rest of its line hits" $
+        hops [rdReq 0x100 Types.Word, rdReq 0x10C Types.Word, rdReq 0x106 Half]
+          @?= [ (p, idealAnswer memU (rdReq 0x100 Types.Word)),
+                (0, idealAnswer memU (rdReq 0x10C Types.Word)),
+                (0, idealAnswer memU (rdReq 0x106 Half))
+              ],
+      testCase "a read that crosses into a missing line stalls for both" $
+        P.map fst (hops [rdReq 0x10E Types.Word, rdReq 0x100 Types.Word, rdReq 0x110 Types.Word])
+          @?= [2 * p, 0, 0],
+      testCase "lines 4 KiB apart evict each other" $
+        P.map fst (hops [rdReq 0x100 Types.Word, rdReq 0x1100 Types.Word, rdReq 0x100 Types.Word])
+          @?= [p, p, p],
+      testCase "a write hit is merged into the cached word" $
+        hops [rdReq 0x100 Types.Word, wrReq 0x101 Byte 0xAB, rdReq 0x100 Types.Word]
+          @?= [ (p, idealAnswer memU (rdReq 0x100 Types.Word)),
+                (0, Just 0),
+                (0, idealAnswer (memWrite 0x101 Byte 0xAB memU) (rdReq 0x100 Types.Word))
+              ],
+      testCase "a write that crosses into the next line is merged into both" $
+        hops [rdReq 0x100 Types.Word, rdReq 0x110 Types.Word, wrReq 0x10E Types.Word 0x01020304, rdReq 0x10C Types.Word, rdReq 0x110 Types.Word]
+          @?= [ (p, idealAnswer memU (rdReq 0x100 Types.Word)),
+                (p, idealAnswer memU (rdReq 0x110 Types.Word)),
+                (0, Just 0),
+                (0, idealAnswer memW (rdReq 0x10C Types.Word)),
+                (0, idealAnswer memW (rdReq 0x110 Types.Word))
+              ]
+    ]
   where
-    go :: Int -> Int -> CacheSys RegFile MemBytes Cache4K -> Sys -> String
-    go 0 _ _ _ = ""
-    go j c cs ideal
-      | P.not (running core) = ""
-      | P.not (coherentLow (sysMem core) (cacheSysCache cs)) = failAt "the cache is not coherent with memory" ""
-      | P.not ready =
-          if obsOf oC /= NoAccess
-            then failAt "a stall cycle made a request: " (show (obsOf oC))
-            else
-              -- The bus input is the memory's answer, which may arrive now.
-              if P.not (sameModuloCtrl (withInput (cacheSysCore cs')) core)
-                then failAt "a stall cycle changed the core: " (P.unwords (coreDiff core (cacheSysCore cs')))
-                else go (j - 1) (c + 1) cs' ideal
-      | P.not (sameModuloCtrl core ideal) = failAt "the cached core left the ideal run: " (P.unwords (coreDiff ideal core))
-      | obsOf oC /= obsOf oI = failAt "different requests: " (show (obsOf oC, obsOf oI))
-      | otherwise = go (j - 1) (c + 1) cs' ideal'
-      where
-        core = cacheSysCore cs
-        ready = inputMemReady (sysInput core)
-        withInput (Sys st _ m) = Sys st (sysInput core) m
-        (cs', oC) = stepCachedOut cs
-        (ideal', oI) = stepSysOut ideal
-        failAt what detail = "\ncycle " P.++ show c P.++ ": " P.++ what P.++ detail P.++ "\n"
+    memW = memWrite 0x10E Types.Word 0x01020304 memU
diff --git a/test/CacheProofSpec.hs b/test/CacheProofSpec.hs
new file mode 100644
index 0000000..ee0dcd4
--- /dev/null
+++ b/test/CacheProofSpec.hs
@@ -0,0 +1,683 @@
+{-# LANGUAGE PackageImports #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+-- | The cache's proof and link 2 on random states, and the core behind the
+-- cache end to end: the cache's counterpart of "ProofSpec".
+--
+-- The statements are the ones "Proof.Memory.Cache4K.Server.Functional.Solver",
+-- "Proof.Memory.Cache4K.Server.Leakage.Solver",
+-- "Proof.Memory.Cache4K.CachedCore.Functional.Solver" and
+-- "Proof.Memory.Cache4K.CachedCore.Leakage.Solver" prove. Here they run on concrete
+-- states, without the trusted array embeddings the solver relies on.
+--
+-- The end-to-end runs check what no single proof states: that link 1 (the
+-- core behind ideal memory refines the ISA) and link 2 (the core behind the
+-- cache refines the core behind ideal memory) compose, on real programs.
+module CacheProofSpec
+  ( cacheProofTests,
+  )
+where
+
+import Cache4KSpec (TestMem (..), genAddr, genMem, genTag, genWord)
+import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
+import Clash.Sized.Vector (unsafeFromList)
+import Core.Pipeline as Core
+import Core.ISA (IsaState, IsaStateG (..), StepG (..), isaStep)
+import Core.Instruction
+import Core.RegFile (RegFile, RegFileOps (..), RegFn (..))
+import Data.Maybe (isJust, isNothing)
+import Memory.Cache4K
+import Memory.Cache4KServer
+import Memory.Types
+import Proof.Memory.Cache4K.CachedCore.Functional.Driver (cachedDriver, cachedDriverMatchesSpec)
+import Proof.Memory.Cache4K.CachedCore.Functional.Machine
+import qualified Proof.Memory.Cache4K.CachedCore.Functional.Obligation as Cached
+import Proof.Memory.Cache4K.CachedCore.Leakage.Driver (simCachedDriverMatchesSpec)
+import Proof.Memory.Cache4K.CachedCore.Leakage.Invariant (simCachedOf)
+import qualified Proof.Memory.Cache4K.CachedCore.Leakage.Obligation as CachedLeak
+import Proof.Memory.Cache4K.CachedCore.Leakage.Simulator (SimCachedSys (..), simInitCachedSys, simStepCached)
+import Proof.Memory.Cache4K.SMT.Raw (RawData (..))
+import Proof.Memory.Cache4K.Server.Functional.Contract
+  ( corePatient,
+    srvDriverMatchesSpec,
+    srvReadyIffAnswered,
+    srvReadyUnderInv,
+  )
+import Proof.Memory.Cache4K.Server.Functional.Driver (srvDriver)
+import Proof.Memory.Cache4K.Server.Functional.Invariant (coherentAt)
+import Proof.Memory.Cache4K.Server.Functional.Obligation (CoherentOps (..))
+import qualified Proof.Memory.Cache4K.Server.Functional.Obligation as Srv
+import Proof.Memory.Cache4K.Server.Leakage.Driver (simSrvDriverMatchesSpec)
+import Proof.Memory.Cache4K.Server.Leakage.Invariant (simOf)
+import Proof.Memory.Cache4K.Server.Leakage.Model (obsReq)
+import qualified Proof.Memory.Cache4K.Server.Leakage.Obligation as SrvLeak
+import Proof.Core.Functional.Machine
+import Proof.Core.Leakage.Driver (simDriver)
+import Proof.Core.Leakage.Model (Leak, Obs (..), leakOf, obsOf)
+import Proof.Core.Leakage.Simulator (SimInput, SimState, simCircuit, simInit)
+import ProofSpec (genArbSys, genArbSys1, initSysProg)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.QuickCheck
+import "aimcore" Types
+import Prelude hiding (Ordering (..), Word, init, log, map, not, undefined, (!!), (&&), (++), (||))
+import qualified Prelude as P
+
+cacheProofTests :: TestTree
+cacheProofTests =
+  testGroup
+    "Cache proof and the core behind the cache"
+    [ serverTests,
+      cachedCoreTests,
+      endToEndTests
+    ]
+
+-- The coherent cache ---------------------------------------------------------------
+
+-- | A coherent cache in front of the tests' memories, as
+-- 'Proof.Memory.Cache4K.Server.Functional.Obligation.mkDataMem' builds one in front of
+-- the solver's: a valid line holds memory's words, an invalid line raw ones.
+coherentData :: (MemOps m) => m -> TagArr -> RawData -> DataArr
+coherentData mem tags (RawData raw) = DataArr (imap word raw)
+  where
+    word :: Index 1024 -> Word -> Word
+    word i w
+      | entryValid e = memReadWord (wordAddr (entryTag e) si wi 0) mem
+      | otherwise = w
+      where
+        idx = fromIntegral i :: BitVector 10
+        si = slice d9 d2 idx
+        wi = slice d1 d0 idx
+        e = tagRead si tags
+
+instance CoherentOps TestMem where
+  mkData = coherentData
+
+instance CoherentOps MemFn where
+  mkData = coherentData
+
+-- Generators -----------------------------------------------------------------------
+
+-- | Tag entries: mostly valid, with the tags of the first three 4 KiB blocks.
+genTags :: Gen TagArr
+genTags =
+  TagArr . unsafeFromList
+    <$> vectorOf 256 (frequency [(2, pure 0), (8, ((1 :: BitVector 1) ++#) <$> genTag)])
+
+-- | The words of the invalid lines, or of any line for a cache that need not be
+-- coherent.
+genRaw :: Gen RawData
+genRaw = RawData . unsafeFromList <$> vectorOf 1024 genWord
+
+-- | Ready, or waiting for memory with up to 2 * 'penalty' cycles left.
+genSrvState :: Gen CacheSrvState
+genSrvState =
+  frequency
+    [ (4, pure CacheSrvReady),
+      (1, CacheSrvStall <$> (fromIntegral <$> choose (0 :: Int, 7)) <*> genWord)
+    ]
+
+-- | Requests: none, fetches, and reads and writes of every width and alignment.
+genReq :: Gen Request
+genReq =
+  frequency
+    [ (1, pure Nothing),
+      (2, Just . MemFetch <$> genAddr),
+      (8, (\a size -> Just (MemRead a size)) <$> genAddr <*> genSize),
+      (4, (\a size v -> Just (MemWrite a size v)) <$> genAddr <*> genSize <*> genWord)
+    ]
+  where
+    genSize = elements [Byte, Half, Types.Word]
+
+-- | The address a request accesses, 0 for none.
+reqAddr :: Request -> Address
+reqAddr req = case req of
+  Just (MemFetch a) -> a
+  Just (MemRead a _) -> a
+  Just (MemWrite a _ _) -> a
+  Nothing -> 0
+
+-- | Witnesses, half of the time at the request's own bytes, set and word.
+genWitness :: Address -> Gen (Address, SetIdx, WordIdx)
+genWitness a = do
+  wa <- frequency [(1, (\o -> a + fromIntegral o) <$> choose (0 :: Int, 4)), (1, genAddr)]
+  wsi <- frequency [(1, pure (setOf a)), (1, fromIntegral <$> choose (0 :: Int, 255))]
+  wwi <- frequency [(1, pure (wordOf a)), (1, fromIntegral <$> choose (0 :: Int, 3))]
+  pure (wa, wsi, wwi)
+
+-- | The register file of a generated state, as a 'Vec', so that cores can be
+-- compared.
+toRegFile :: RegFn -> RegFile
+toRegFile (RegFn g) = P.foldr (\i -> modifyRFg i (g i)) initRFg [1 .. 31]
+
+-- | An arbitrary system from "ProofSpec"'s generators, sometimes with a load in
+-- the memory stage, so that the cycle makes a data read.
+genSys :: Gen (SysG RegFile MemFn, Address)
+genSys = do
+  (Sys core inp mem, _, wa) <- oneof [genArbSys, genArbSys1]
+  me <- frequency [(1, pure Nothing), (1, Just <$> genLoad)]
+  let core' = maybe core (\ir -> core {stateMeInstr = ir}) me
+  pure (Sys core' {stateRegFile = toRegFile (stateRegFile core)} inp mem, wa)
+  where
+    genLoad =
+      (\size sign rd rs1 imm -> IType (Load size sign) rd rs1 imm)
+        <$> elements [Byte, Half, Types.Word]
+        <*> elements [Signed, Unsigned]
+        <*> (fromIntegral <$> choose (0 :: Int, 31))
+        <*> (fromIntegral <$> choose (0 :: Int, 31))
+        <*> (fromIntegral <$> choose (0 :: Int, 63))
+
+p :: Int
+p = fromIntegral penalty
+
+-- | Cover each hop length of the cache.
+coverHops :: Int -> Property -> Property
+coverHops k =
+  cover 20 (k == 0) "hop of 1 cycle"
+    . cover 10 (k == p) "hop of penalty + 1 cycles"
+    . cover 1 (k == 2 * p) "hop of 2 * penalty + 1 cycles"
+
+-- The cache's proof ----------------------------------------------------------------
+
+serverTests :: TestTree
+serverTests =
+  testGroup
+    "the cache's proof"
+    [ testProperty "functional: base case" $
+        forAll genMem $ \mem -> forAll (genWitness 0) $ \(wa, wsi, wwi) ->
+          Srv.baseCase wa wsi wwi mem,
+      -- The step for the hop length the driver gives, from a ready server whose
+      -- cache is coherent by construction, as in the solver.
+      testProperty "functional: the step for the driver's hop length" $
+        withMaxSuccess 4000 $ checkCoverage $
+          forAll genMem $ \mem -> forAll genTags $ \tags -> forAllShow genRaw (const "<raw words>") $ \raw ->
+            forAll genReq $ \req -> forAll (genWitness (reqAddr req)) $ \(wa, wsi, wwi) ->
+              let srv = CacheSrv (Cache4K tags (mkData mem tags raw)) mem CacheSrvReady
+                  k = srvDriver srv req
+                  step
+                    | k == 0 = Srv.indStep0 wa wsi wwi mem tags raw req
+                    | k == p =
+                        Srv.indStep4 wa wsi wwi mem tags raw req
+                          P.&& Srv.indStepWaits4 wa wsi wwi mem tags raw req
+                    | k == 2 * p =
+                        Srv.indStep8 wa wsi wwi mem tags raw req
+                          P.&& Srv.indStepWaits8 wa wsi wwi mem tags raw req
+                    | otherwise = False
+               in coverHops k (counterexample ("driver=" P.++ show k) step),
+      testProperty "the driver agrees with its operational reading" $
+        withMaxSuccess 4000 $
+          forAll genMem $ \mem -> forAll genTags $ \tags -> forAllShow genRaw (const "<raw words>") $ \raw ->
+            forAll genSrvState $ \st -> forAll genReq $ \req ->
+              srvDriverMatchesSpec (CacheSrv (Cache4K tags (DataArr (rawVec raw))) mem st) req,
+      testProperty "contract: after a step, the server is ready exactly when it has answered" $
+        withMaxSuccess 4000 $
+          forAll genMem $ \mem -> forAll genTags $ \tags -> forAllShow genRaw (const "<raw words>") $ \raw ->
+            forAll genSrvState $ \st -> forAll genReq $ \req ->
+              srvReadyIffAnswered (CacheSrv (Cache4K tags (DataArr (rawVec raw))) mem st) req,
+      testProperty "contract: a server related to ideal memory is ready" $
+        forAll genMem $ \mem -> forAll genTags $ \tags -> forAllShow genRaw (const "<raw words>") $ \raw ->
+          forAll (genWitness 0) $ \(wa, wsi, wwi) ->
+            srvReadyUnderInv wa wsi wwi mem (CacheSrv (Cache4K tags (mkData mem tags raw)) mem CacheSrvReady),
+      testProperty "contract: the core waits for what it asked for" $
+        withMaxSuccess 4000 $ checkCoverage $
+          forAllShow genSys (const "<state>") $ \(Sys core inp _, _) ->
+            cover 30 (isJust (outputMem (snd (circuit core inp)))) "the cycle makes a request" $
+              corePatient core inp,
+      testProperty "leakage: base case" $
+        forAll genMem $ \mem -> forAll (fromIntegral <$> choose (0 :: Int, 255)) $ \wsi ->
+          SrvLeak.baseCaseLeak wsi mem,
+      testProperty "leakage: the step, on any server" $
+        withMaxSuccess 4000 $
+          forAll genMem $ \mem -> forAll genTags $ \tags -> forAllShow genRaw (const "<raw words>") $ \raw ->
+            forAll genSrvState $ \st -> forAll genReq $ \req -> forAll (genWitness (reqAddr req)) $ \(_, wsi, _) ->
+              SrvLeak.indStepLeak wsi (CacheSrv (Cache4K tags (DataArr (rawVec raw))) mem st) req,
+      testProperty "leakage: the simulator's driver agrees with its operational reading" $
+        withMaxSuccess 4000 $
+          forAll genMem $ \mem -> forAll genTags $ \tags -> forAllShow genRaw (const "<raw words>") $ \raw ->
+            forAll genSrvState $ \st -> forAll genReq $ \req ->
+              simSrvDriverMatchesSpec (simOf (CacheSrv (Cache4K tags (DataArr (rawVec raw))) mem st)) (obsReq req)
+    ]
+  where
+    rawVec (RawData v) = v
+
+-- Link 2 ---------------------------------------------------------------------------
+
+cachedCoreTests :: TestTree
+cachedCoreTests =
+  testGroup
+    "link 2: the core behind the cache"
+    [ -- The step for the hop length the driver gives, functional and leakage
+      -- halves together, from the cached system built from an arbitrary one.
+      testProperty "the step for the driver's hop length" $
+        withMaxSuccess 4000 $ checkCoverage $
+          forAllShow genSys (const "<state>") $ \(sys, wa) ->
+            forAll genTags $ \tags -> forAllShow genRaw (const "<raw words>") $ \raw ->
+              forAll (genWitness wa) $ \(_, wsi, wwi) ->
+                let k = cachedDriver (Cached.cachedOf sys tags raw)
+                    step
+                      | k == 0 =
+                          Cached.indStep0 wa wsi wwi sys tags raw
+                            P.&& CachedLeak.indStepLeak0 wa wsi wwi sys tags raw
+                      | k == p =
+                          Cached.indStep4 wa wsi wwi sys tags raw
+                            P.&& CachedLeak.indStepLeak4 wa wsi wwi sys tags raw
+                      | k == 2 * p =
+                          Cached.indStep8 wa wsi wwi sys tags raw
+                            P.&& CachedLeak.indStepLeak8 wa wsi wwi sys tags raw
+                      | otherwise = False
+                 in coverHops k (counterexample ("driver=" P.++ show k) step),
+      testProperty "the driver agrees with its operational reading" $
+        withMaxSuccess 4000 $
+          forAllShow genSys (const "<state>") $ \(sys, wa) ->
+            forAll genTags $ \tags -> forAllShow genRaw (const "<raw words>") $ \raw ->
+              forAll (genWitness wa) $ \(_, wsi, wwi) ->
+                cachedDriverMatchesSpec wa wsi wwi sys (Cached.cachedOf sys tags raw),
+      testProperty "the simulator's driver agrees with its operational reading" $
+        withMaxSuccess 4000 $
+          forAllShow genSys (const "<state>") $ \(sys, _) ->
+            forAll genTags $ \tags -> forAllShow genRaw (const "<raw words>") $ \raw ->
+              simCachedDriverMatchesSpec
+                (simCachedOf (Cached.cachedOf sys tags raw))
+                (obsOf (snd (stepSysOut sys)))
+    ]
+
+-- End to end -----------------------------------------------------------------------
+
+endToEndTests :: TestTree
+endToEndTests =
+  testGroup
+    "end to end"
+    [ testProperty "the cached run is the ideal run with stall cycles inserted" $
+        withMaxSuccess 300 $ checkCoverage $
+          forAll genCTProg $ \prog ->
+            let sys = initSysProg prog
+                r = stutterReport 300 sys
+             in cover 30 (stallCycles sys > 0) "the core waits for the cache" (counterexample r (P.null r)),
+      testProperty "... also with reads and writes of every width and alignment" $
+        withMaxSuccess 300 $ checkCoverage $
+          forAll genByteProg $ \prog -> forAll genData $ \ds ->
+            let sys = withData ds (initSysProg prog)
+                r = stutterReport 300 sys
+             in cover 30 (stallCycles sys > 0) "the core waits for the cache" (counterexample r (P.null r)),
+      testProperty "the cached core's bus trace follows from the leakage alone" $
+        withMaxSuccess 300 $
+          forAll genCTProg $ \prog ->
+            let r = compositeReport (initSysProg prog)
+             in counterexample r (P.null r),
+      testProperty "... also with reads and writes of every width and alignment" $
+        withMaxSuccess 300 $
+          forAll genByteProg $ \prog -> forAll genData $ \ds ->
+            let r = compositeReport (withData ds (initSysProg prog))
+             in counterexample r (P.null r),
+      testProperty "a secret-free program leaks nothing about its data, behind the cache" $
+        withMaxSuccess 300 $
+          forAll genSecretFreeProg $ \prog ->
+            forAll genData $ \da ->
+              forAll genData $ \db ->
+                let s1 = withData da (initSysProg prog)
+                    s2 = withData db (initSysProg prog)
+                 in ctTrace 100 (isaStart s1) == ctTrace 100 (isaStart s2)
+                      P.&& cachedObs 300 s1 == cachedObs 300 s2,
+      testProperty "a load through a loaded pointer leaks it, even to a timing attacker" $
+        -- The control: @lw x5, 0(x0); lw x1, 0(x5); lw x2, 0(x0); ebreak@. The
+        -- second load's address is data. With the pointer at 0 the second load
+        -- hits the line the first one filled; with the pointer at 16, in the next
+        -- set, it misses. So even an attacker who sees only in which cycles a
+        -- request is made tells the two apart.
+        let prog =
+              map encode $
+                unsafeFromList $
+                  [ IType (Load Types.Word Signed) 5 0 0,
+                    IType (Load Types.Word Signed) 1 5 0,
+                    IType (Load Types.Word Signed) 2 0 0
+                  ]
+                    P.++ P.replicate 47 Core.Instruction.break
+            timing ptr = P.map (/= NoAccess) (cachedObs 100 (withData [(0, ptr)] (initSysProg prog)))
+         in once (timing 0 /= timing 16)
+    ]
+
+-- | The core behind the cache at start, for an ideal system at start: the same
+-- core and input, and the cache at start in front of its memory.
+cachedStart :: SysG r m -> CachedSysG r m
+cachedStart (Sys core inp mem) = CachedSys core inp (initCacheSrv mem)
+
+-- | The cached system as an ideal one: its core and input, and the memory
+-- behind the cache.
+idealView :: CachedSysG r m -> SysG r m
+idealView (CachedSys core inp srv) = Sys core inp (srvMem srv)
+
+-- | Has the core not halted yet?
+running :: StateG r -> Bool
+running = isNothing . stateHalt
+
+-- | The ISA state a program at start corresponds to: execution begins at
+-- 'initPc', with the system's register file and memory.
+isaStart :: Sys -> IsaState
+isaStart (Sys core _ mem) = IsaState initPc (stateRegFile core) mem
+
+-- | The bus observations of the core behind the cache, cycle by cycle, until it
+-- halts.
+cachedObs :: Int -> Sys -> [Obs]
+cachedObs n sys = go n (cachedStart sys)
+  where
+    go :: Int -> CachedSys -> [Obs]
+    go 0 _ = []
+    go j csys
+      | P.not (running (cachedCore csys)) = []
+      | otherwise = let (csys', o) = stepCachedOut csys in obsOf o : go (j - 1) csys'
+
+-- | The cycles in which the core behind the cache waits, until it halts.
+stallCycles :: Sys -> Int
+stallCycles sys = go (600 :: Int) (cachedStart sys)
+  where
+    go 0 _ = 0
+    go j csys
+      | P.not (running (cachedCore csys)) = 0
+      | otherwise =
+          (if isNothing (inputMem (cachedInput csys)) then 1 else 0)
+            + go (j - 1) (stepCached csys)
+
+-- | The core's bus observations computed from the leakage alone, hop by hop,
+-- as behind ideal memory: the core's simulator
+-- ('Proof.Core.Leakage.Simulator.simCircuit') run on the ISA's leakage trace.
+--
+-- The hops are those of 'ProofSpec.leakReport': the first gets no leakage,
+-- and every later one gets @'leakOf' isa@ on its first cycle, after which the
+-- ISA steps. A halted ISA stands still.
+simHops :: Sys -> [[Obs]]
+simHops sys0 = go Nothing (isaStart sys0) simInit
+  where
+    go :: SimInput -> IsaState -> SimState -> [[Obs]]
+    go inp isa sim =
+      let (sim', os) = runSim (simDriver inp sim + 1) inp sim
+          isa' = case inp of
+            Nothing -> isa
+            Just _ -> isaNext isa
+       in os : go (Just (leakOf isa')) isa' sim'
+    -- The simulator for @n@ cycles; it gets @inp@ on the first only.
+    runSim :: Int -> SimInput -> SimState -> (SimState, [Obs])
+    runSim 0 _ sim = (sim, [])
+    runSim n inp sim =
+      let (sim1, o) = simCircuit sim inp
+          (sim2, os) = runSim (n - 1) Nothing sim1
+       in (sim2, o : os)
+    isaNext isa = case isaStep isa of
+      Next isa' -> isa'
+      IsaHalted -> isa
+
+-- | The bus trace of the core behind the cache, from the leakage alone: the
+-- core's simulator gives each cycle of the core behind ideal memory
+-- ('simHops'), and link 2's simulator
+-- ("Proof.Memory.Cache4K.CachedCore.Leakage.Simulator") adds the cycles in which the
+-- core waits for the cache.
+compositeTrace :: Int -> Sys -> [Obs]
+compositeTrace n sys0 = go (P.concat (P.take n (simHops sys0))) simInitCachedSys
+  where
+    go :: [Obs] -> SimCachedSys -> [Obs]
+    go [] _ = []
+    go (obs : rest) sim =
+      let (sim', bus) = simStepCached sim (Just obs)
+       in bus : waiting rest sim'
+    waiting rest sim
+      | simCachedAnswered sim = go rest sim
+      | otherwise =
+          let (sim', bus) = simStepCached sim Nothing
+           in bus : waiting rest sim'
+
+compositeReport :: Sys -> String
+compositeReport sys0
+  | cached == P.take (P.length cached) composite = ""
+  | otherwise =
+      "first difference at cycle " P.++ show i P.++ ": "
+        P.++ show (P.take 6 (P.drop i cached)) P.++ " vs "
+        P.++ show (P.take 6 (P.drop i composite))
+  where
+    cached = cachedObs 600 sys0
+    composite = compositeTrace 600 sys0
+    i = P.length (P.takeWhile id (P.zipWith (==) cached composite))
+
+-- | Is the cache coherent with memory at every set the harness's memory can
+-- fill? Memory is 'MEM_SIZE' words, 400 bytes, so only sets 0 to 24.
+coherentLow :: MemBytes -> Cache4K -> Bool
+coherentLow mem c = P.and [coherentAt s w mem c | s <- [0 .. 24], w <- [0 .. 3]]
+
+-- | Walk the cached system and the ideal one together for @n@ cycles of the
+-- cached one, skipping the cached run's stall cycles -- those whose input is
+-- 'Nothing' -- in the ideal one. Returns @\"\"@ if every stall cycle makes no
+-- request and leaves the core alone, the cache stays coherent with memory, and
+-- every other cycle makes the ideal run's request from the ideal run's state,
+-- up to 'sameModuloCtrl'.
+stutterReport :: Int -> Sys -> String
+stutterReport n sys0 = go n (0 :: Int) (cachedStart sys0) sys0
+  where
+    go :: Int -> Int -> CachedSys -> Sys -> String
+    go 0 _ _ _ = ""
+    go j c csys ideal
+      | P.not (running (cachedCore csys)) = ""
+      | P.not (coherentLow (srvMem srv) (srvCache srv)) =
+          failAt "the cache is not coherent with memory" ""
+      | isNothing (inputMem (cachedInput csys)) =
+          if obsOf oC /= NoAccess
+            then failAt "a stall cycle made a request: " (show (obsOf oC))
+            else
+              if P.not (sameModuloCtrl (idealView csys) (withInput (idealView csys')))
+                then
+                  failAt "a stall cycle changed the core: "
+                    (P.unwords (coreDiff (idealView csys) (withInput (idealView csys'))))
+                else go (j - 1) (c + 1) csys' ideal
+      | P.not (sameModuloCtrl (idealView csys) ideal) =
+          failAt "the cached core left the ideal run: "
+            (P.unwords (coreDiff ideal (idealView csys)))
+      | obsOf oC /= obsOf oI = failAt "different requests: " (show (obsOf oC, obsOf oI))
+      | otherwise = go (j - 1) (c + 1) csys' ideal'
+      where
+        srv = cachedSrv csys
+        -- The answer may arrive in a stall cycle; only the core must stay.
+        withInput (Sys core _ mem) = Sys core (cachedInput csys) mem
+        (csys', oC) = stepCachedOut csys
+        (ideal', oI) = stepSysOut ideal
+        failAt what detail = "\ncycle " P.++ show c P.++ ": " P.++ what P.++ detail P.++ "\n"
+
+-- Comparing systems ----------------------------------------------------------------
+
+-- | Two systems equal in everything but the control lines, which the core
+-- resets in every cycle before any stage reads them.
+sameModuloCtrl :: Sys -> Sys -> Bool
+sameModuloCtrl (Sys a ia ma) (Sys b ib mb) =
+  a {stateCtrl = initCtrl} == b {stateCtrl = initCtrl}
+    P.&& ia == ib
+    P.&& ma == mb
+
+-- | The fields, other than the control lines, on which two systems differ, as
+-- @field(first | second)@.
+coreDiff :: Sys -> Sys -> [String]
+coreDiff (Sys a ia ma) (Sys b ib mb) =
+  P.concat
+    [ f "fePc" stateFePc,
+      f "dePc" stateDePc,
+      f "deExpInstr" stateDeExpInstr,
+      f "exPc" stateExPc,
+      f "ex" stateExInstr,
+      f "me" stateMeInstr,
+      f "meAddr" stateMeAddr,
+      f "meRes" stateMeRes,
+      f "wb" stateWbInstr,
+      f "wbRes" stateWbRes,
+      f "halt" stateHalt,
+      ["input(" P.++ show (inputMem ia) P.++ " | " P.++ show (inputMem ib) P.++ ")" | ia /= ib],
+      ["registers" | stateRegFile a /= stateRegFile b],
+      ["memory" | ma /= mb]
+    ]
+  where
+    f :: (Eq v, Show v) => String -> (State -> v) -> [String]
+    f name sel
+      | sel a == sel b = []
+      | otherwise = [name P.++ "(" P.++ show (sel a) P.++ " | " P.++ show (sel b) P.++ ")"]
+
+-- Programs -------------------------------------------------------------------------
+
+-- | The ISA-level constant-time leakage trace of the first @n@ instructions.
+ctTrace :: Int -> IsaState -> [Leak]
+ctTrace 0 _ = []
+ctTrace n isa = leakOf isa : case isaStep isa of
+  Next isa' -> ctTrace (n - 1) isa'
+  IsaHalted -> []
+
+-- | Load a data image (word-aligned addresses below the program) into a system.
+withData :: [(Address, Word)] -> Sys -> Sys
+withData ws (Sys s i m) = Sys s i (P.foldr (\(a, w) -> memWrite a Types.Word w) m ws)
+
+genData :: Gen [(Address, Word)]
+genData =
+  P.mapM (\k -> (\w -> (4 * k, w)) <$> elements [0, 1, 4, 0x10, 0x40, 0xDEADBEEF]) [0 .. 49]
+
+-- | Random programs whose loads, stores and @jalr@s go through base registers.
+--
+-- @x5@ and @x6@ are reserved as base registers: they are written only by
+-- @addi@ from @x0@, with a word-aligned data address (below 'initPc') or the
+-- address of an instruction of the program. Stores through them therefore also
+-- hit the code, which raises store hazards; they store @x0@, so an overwritten
+-- instruction decodes to @Nop DecodeFail@. Every access stays inside the
+-- harness's memory. A @jalr@ off @x0@, whose target fits the immediate, is
+-- generated as well.
+genCTProg :: Gen (Vec PROG_SIZE Word)
+genCTProg = do
+  n <- choose (2, 12)
+  body <- P.mapM (genCTInstr n) [0 .. n - 1]
+  let instrs = P.map roundTrips body P.++ P.replicate (50 - n) Core.Instruction.break
+  pure (map encode (unsafeFromList instrs))
+
+genCTInstr :: Int -> Int -> Gen Instruction
+genCTInstr n i =
+  frequency
+    [ (2, RType <$> genArith <*> genDst <*> genSrc <*> genSrc),
+      (1, IType <$> (Arith <$> genArith) <*> genDst <*> genSrc <*> genSmallImm),
+      (3, (\b a -> IType (Arith ADD) b 0 (fromIntegral a)) <$> genBase <*> genAddrImm),
+      ( 3,
+        (\size sign rd b off -> IType (Load size sign) rd b off)
+          <$> genSize
+          <*> elements [Signed, Unsigned]
+          <*> genDst
+          <*> genBase
+          <*> genOff
+      ),
+      (3, (\size off b -> SType size off b 0) <$> genSize <*> genOff <*> genBase),
+      (1, (\t -> SType Types.Word (fromIntegral (codeAddr t)) 0 0) <$> choose (0, n)),
+      ( 2,
+        (\cmp t rs1 rs2 -> BType cmp (fromIntegral ((t - i) * 4)) rs1 rs2)
+          <$> elements [EQ, NE, LT, GE, LTU, GEU]
+          <*> choose (0, n)
+          <*> genSrc
+          <*> genSrc
+      ),
+      (1, (\rd t -> JType rd (fromIntegral ((t - i) * 4))) <$> genDst <*> choose (0, n)),
+      (1, (\b -> IType Jump 0 b 0) <$> genBase),
+      (1, (\t -> IType Jump 0 0 (fromIntegral (codeAddr t))) <$> choose (0, n))
+    ]
+  where
+    genArith = elements [ADD, SUB, XOR, OR, AND, SLT, SLTU]
+    genSize = elements [Byte, Half, Types.Word]
+    genSmallImm = fromIntegral <$> choose (0 :: Int, 15)
+    -- Base registers, and everything else.
+    genBase = elements [5, 6]
+    genDst = elements [1, 2, 3, 4, 7]
+    genSrc = elements [0, 1, 2, 3, 4, 5, 6, 7]
+    genOff = (\k -> fromIntegral (k * 4)) <$> choose (0 :: Int, 2)
+    codeAddr t = fromIntegral initPc + 4 * t :: Int
+    genAddrImm =
+      oneof
+        [ (\k -> 4 * k) <$> choose (0 :: Int, 40),
+          codeAddr <$> choose (0, n)
+        ]
+
+-- | Programs whose control flow and addresses never depend on loaded data.
+--
+-- As 'genCTProg', with @x5@ and @x6@ the base registers, set only from
+-- constants; loads write @x1@ to @x4@ and @x7@, and branches compare only
+-- @x0@, @x5@ and @x6@, so no loaded value reaches a branch or an address.
+-- Stores store @x0@, so no loaded value reaches memory either.
+genSecretFreeProg :: Gen (Vec PROG_SIZE Word)
+genSecretFreeProg = do
+  n <- choose (2, 12)
+  body <- P.mapM (genOne n) [0 .. n - 1]
+  let instrs = P.map roundTrips body P.++ P.replicate (50 - n) Core.Instruction.break
+  pure (map encode (unsafeFromList instrs))
+  where
+    genOne n i =
+      frequency
+        [ (2, RType <$> elements [ADD, SUB, XOR, OR, AND] <*> genDst <*> genAny <*> genAny),
+          (3, (\b a -> IType (Arith ADD) b 0 (fromIntegral a)) <$> genBase <*> genAddrImm n),
+          ( 3,
+            (\size sign rd b off -> IType (Load size sign) rd b off)
+              <$> elements [Byte, Half, Types.Word]
+              <*> elements [Signed, Unsigned]
+              <*> genDst
+              <*> genBase
+              <*> genOff
+          ),
+          (2, (\size off b -> SType size off b 0) <$> elements [Byte, Half, Types.Word] <*> genOff <*> genBase),
+          ( 2,
+            (\cmp t rs1 rs2 -> BType cmp (fromIntegral ((t - i) * 4)) rs1 rs2)
+              <$> elements [EQ, NE, LT, GE, LTU, GEU]
+              <*> choose (0, n)
+              <*> genCtl
+              <*> genCtl
+          ),
+          (1, (\rd t -> JType rd (fromIntegral ((t - i) * 4))) <$> genDst <*> choose (0, n))
+        ]
+
+    genBase = elements [5, 6]
+    genCtl = elements [0, 5, 6]
+    genDst = elements [1, 2, 3, 4, 7]
+    genAny = elements [0, 1, 2, 3, 4, 5, 6, 7]
+    genOff = (\k -> fromIntegral (k * 4)) <$> choose (0 :: Int, 2)
+    genAddrImm n =
+      oneof
+        [ (\k -> 4 * k) <$> choose (0 :: Int, 40),
+          (\t -> fromIntegral initPc + 4 * t) <$> choose (0, n)
+        ]
+
+-- | Programs whose loads and stores have every width and alignment, including
+-- reads and writes that straddle two lines.
+--
+-- Base registers @x5@ and @x6@ are set only from constants, to data addresses,
+-- so no access reaches the program; offsets are any byte offset up to 11.
+-- Stores store data registers, loads write them, and branches compare them, so
+-- loaded values flow back into memory and into control flow.
+genByteProg :: Gen (Vec PROG_SIZE Word)
+genByteProg = do
+  n <- choose (2, 14)
+  body <- P.mapM (genOne n) [0 .. n - 1]
+  let instrs = P.map roundTrips body P.++ P.replicate (50 - n) Core.Instruction.break
+  pure (map encode (unsafeFromList instrs))
+  where
+    genOne n i =
+      frequency
+        [ (2, RType <$> elements [ADD, SUB, XOR, OR, AND] <*> genDst <*> genDst <*> genDst),
+          (3, (\b k -> IType (Arith ADD) b 0 (fromIntegral (4 * k :: Int))) <$> genBase <*> choose (0, 40)),
+          ( 4,
+            (\size sign rd b off -> IType (Load size sign) rd b off)
+              <$> elements [Byte, Half, Types.Word]
+              <*> elements [Signed, Unsigned]
+              <*> genDst
+              <*> genBase
+              <*> genOff
+          ),
+          (3, (\size off b rs2 -> SType size off b rs2) <$> elements [Byte, Half, Types.Word] <*> genOff <*> genBase <*> genDst),
+          ( 1,
+            (\cmp t rs1 rs2 -> BType cmp (fromIntegral ((t - i) * 4)) rs1 rs2)
+              <$> elements [EQ, NE, LT, GE, LTU, GEU]
+              <*> choose (i + 1, n)
+              <*> genDst
+              <*> genDst
+          )
+        ]
+
+    genBase = elements [5, 6]
+    genDst = elements [1, 2, 3, 4]
+    genOff = fromIntegral <$> choose (0 :: Int, 11)
+
+-- | An instruction that survives encoding, or @addi x0, x0, 0@.
+roundTrips :: Instruction -> Instruction
+roundTrips ir = case encode' ir of
+  Just w | decode' w == ir -> ir
+  _ -> IType (Arith ADD) 0 0 0
diff --git a/test/CompositionSpec.hs b/test/CompositionSpec.hs
deleted file mode 100644
index 3ad5cb1..0000000
--- a/test/CompositionSpec.hs
+++ /dev/null
@@ -1,332 +0,0 @@
-{-# LANGUAGE PackageImports #-}
-
--- | The core behind a cache: what holds for any cache, and the programs and
--- traces the cache tests ("Cache4KSpec") are built from.
---
--- The constant-time leakage proof ("Proof.Core.Leakage.Solver") is about the core
--- attached to memory that answers every request in the next cycle. Behind a
--- cache a load that misses is answered only after the miss penalty, and in the
--- meantime the core stalls. The core's side of what lets the ideal-memory result
--- carry over is checked here: after a data read the core waits
--- ('Proof.CachedCore.Obligation.waitObligation'), and a stall cycle is a stutter step
--- ('Proof.CachedCore.Obligation.stallObligation').
-module CompositionSpec
-  ( compositionTests,
-    sameModuloCtrl,
-    coreDiff,
-    ctTrace,
-    genByteProg,
-    genCTProg,
-    genData,
-    genSecretFreeProg,
-    genWord,
-    simHops,
-    withData,
-  )
-where
-
-import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
-import Clash.Sized.Vector (unsafeFromList)
-import Core
-import Data.Functor.Identity (Identity (..))
-import Core.ISA (IsaState, StepG (..), isaStep)
-import Core.Instruction
-import Memory.Types
-import Proof.CachedCore.Obligation (stallObligation, waitObligation)
-import Proof.Core.Leakage.Model
-import Proof.Core.Functional.Obligation (isaAt)
-import Proof.Core.Leakage.Driver (simDriver)
-import Proof.Core.Leakage.Simulator (SimInput, SimState, simCircuit, simInit)
-import Proof.Core.Functional.Machine
-import ProofSpec (genArbSys1)
-import Core.RegFile (RegFileOps)
-import Test.Tasty (TestTree, testGroup)
-import Test.Tasty.QuickCheck
-import "aimcore" Types
-import Prelude hiding (Ordering (..), Word, init, log, map, not, undefined, (!!), (&&), (++), (||))
-import qualified Prelude as P
-
--- | Two systems equal in everything but the control lines, which
--- 'Core.withCtrlReset' overwrites before any stage reads them.
-sameModuloCtrl :: Sys -> Sys -> Bool
-sameModuloCtrl (Sys a ia ma) (Sys b ib mb) =
-  a {stateCtrl = initCtrl} == b {stateCtrl = initCtrl}
-    P.&& runIdentity (inputMem ia) == runIdentity (inputMem ib)
-    P.&& inputMemReady ia == inputMemReady ib
-    P.&& ma == mb
-
--- | The fields, other than the control lines, on which two systems differ, as
--- @field(first | second)@.
-coreDiff :: Sys -> Sys -> [String]
-coreDiff (Sys a ia ma) (Sys b ib mb) =
-  P.concat
-    [ f "fePc" stateFePc,
-      f "dePc" stateDePc,
-      f "deExpInstr" stateDeExpInstr,
-      f "exPc" stateExPc,
-      f "ex" stateExInstr,
-      f "me" stateMeInstr,
-      f "meAddr" stateMeAddr,
-      f "meRes" (runIdentity . stateMeRes),
-      f "wb" stateWbInstr,
-      f "wbRes" (runIdentity . stateWbRes),
-      f "halt" stateHalt,
-      f "loadInFlight" stateLoadInFlight,
-      g "bus" (runIdentity . inputMem),
-      g "ready" inputMemReady,
-      ["registers" | stateRegFile a /= stateRegFile b],
-      ["memory" | ma /= mb]
-    ]
-  where
-    f :: (Eq v, Show v) => String -> (State Identity -> v) -> [String]
-    f name sel
-      | sel a == sel b = []
-      | otherwise = [name P.++ "(" P.++ show (sel a) P.++ " | " P.++ show (sel b) P.++ ")"]
-    g :: (Eq v, Show v) => String -> (Input Identity -> v) -> [String]
-    g name sel
-      | sel ia == sel ib = []
-      | otherwise = [name P.++ "(" P.++ show (sel ia) P.++ " | " P.++ show (sel ib) P.++ ")"]
-
--- | The ISA-level constant-time leakage trace of the first @n@ instructions.
-ctTrace :: Int -> IsaState -> [Leak]
-ctTrace 0 _ = []
-ctTrace n a = leakOf a : case isaStep a of
-  Next a' -> ctTrace (n - 1) a'
-  IsaHalted -> []
-
--- | Load a data image (word-aligned addresses below the program) into a system.
-withData :: [(Address, Word)] -> Sys -> Sys
-withData ws (Sys s i m) = Sys s i (P.foldr (\(a, w) -> memWrite a Types.Word w) m ws)
-
-genData :: Gen [(Address, Word)]
-genData =
-  P.mapM (\k -> (\w -> (4 * k, w)) <$> elements [0, 1, 4, 0x10, 0x40, 0xDEADBEEF]) [0 .. 49]
-
--- | Random programs whose loads, stores and @jalr@s go through base registers.
---
--- @x5@ and @x6@ are reserved as base registers: they are written only by
--- @addi@ from @x0@, with a word-aligned data address (below 'initPc') or the
--- address of an instruction of the program. Stores through them therefore also
--- hit the code, which raises store hazards; they store @x0@, so an overwritten
--- instruction decodes to @Nop DecodeFail@. Every access stays inside the
--- harness's memory. A @jalr@ off @x0@, whose target fits the immediate, is
--- generated as well.
-genCTProg :: Gen (Vec PROG_SIZE Word)
-genCTProg = do
-  n <- choose (2, 12)
-  body <- P.mapM (genCTInstr n) [0 .. n - 1]
-  let instrs = P.map roundTrips body P.++ P.replicate (50 - n) Core.Instruction.break
-  pure (map encode (unsafeFromList instrs))
-  where
-    roundTrips i = case encode' i of
-      Just w | decode' w == i -> i
-      _ -> IType (Arith ADD) 0 0 0
-
-genCTInstr :: Int -> Int -> Gen Instruction
-genCTInstr n i =
-  frequency
-    [ (2, RType <$> genArith <*> genDst <*> genSrc <*> genSrc),
-      (1, IType <$> (Arith <$> genArith) <*> genDst <*> genSrc <*> genSmallImm),
-      (3, (\b a -> IType (Arith ADD) b 0 (fromIntegral a)) <$> genBase <*> genAddr),
-      ( 3,
-        (\size sign rd b off -> IType (Load size sign) rd b off)
-          <$> genSize
-          <*> elements [Signed, Unsigned]
-          <*> genDst
-          <*> genBase
-          <*> genOff
-      ),
-      (3, (\size off b -> SType size off b 0) <$> genSize <*> genOff <*> genBase),
-      (1, (\t -> SType Word (fromIntegral (codeAddr t)) 0 0) <$> choose (0, n)),
-      ( 2,
-        (\cmp t rs1 rs2 -> BType cmp (fromIntegral ((t - i) * 4)) rs1 rs2)
-          <$> elements [EQ, NE, LT, GE, LTU, GEU]
-          <*> choose (0, n)
-          <*> genSrc
-          <*> genSrc
-      ),
-      (1, (\rd t -> JType rd (fromIntegral ((t - i) * 4))) <$> genDst <*> choose (0, n)),
-      (1, (\b -> IType Jump 0 b 0) <$> genBase),
-      (1, (\t -> IType Jump 0 0 (fromIntegral (codeAddr t))) <$> choose (0, n))
-    ]
-  where
-    genArith = elements [ADD, SUB, XOR, OR, AND, SLT, SLTU]
-    genSize = elements [Byte, Half, Word]
-    genSmallImm = fromIntegral <$> choose (0 :: Int, 15)
-    -- Base registers, and everything else.
-    genBase = elements [5, 6]
-    genDst = elements [1, 2, 3, 4, 7]
-    genSrc = elements [0, 1, 2, 3, 4, 5, 6, 7]
-    genOff = (\k -> fromIntegral (k * 4)) <$> choose (0 :: Int, 2)
-    codeAddr t = fromIntegral initPc + 4 * t :: Int
-    genAddr =
-      oneof
-        [ (\k -> 4 * k) <$> choose (0 :: Int, 40),
-          codeAddr <$> choose (0, n)
-        ]
-
--- | Programs whose control flow and addresses never depend on loaded data.
---
--- As 'genCTProg', with @x5@ and @x6@ the base registers, set only
--- from constants; loads write @x1@ to @x4@ and @x7@, and branches compare only
--- @x0@, @x5@ and @x6@, so no loaded value reaches a branch or an address. Stores
--- store @x0@, so no loaded value reaches memory either.
-genSecretFreeProg :: Gen (Vec PROG_SIZE Word)
-genSecretFreeProg = do
-  n <- choose (2, 12)
-  body <- P.mapM (genOne n) [0 .. n - 1]
-  let instrs = P.map roundTrips body P.++ P.replicate (50 - n) Core.Instruction.break
-  pure (map encode (unsafeFromList instrs))
-  where
-    roundTrips i = case encode' i of
-      Just w | decode' w == i -> i
-      _ -> IType (Arith ADD) 0 0 0
-
-    genOne n i =
-      frequency
-        [ (2, RType <$> elements [ADD, SUB, XOR, OR, AND] <*> genDst <*> genAny <*> genAny),
-          (3, (\b a -> IType (Arith ADD) b 0 (fromIntegral a)) <$> genBase <*> genAddr n),
-          ( 3,
-            (\size sign rd b off -> IType (Load size sign) rd b off)
-              <$> elements [Byte, Half, Types.Word]
-              <*> elements [Signed, Unsigned]
-              <*> genDst
-              <*> genBase
-              <*> genOff
-          ),
-          (2, (\size off b -> SType size off b 0) <$> elements [Byte, Half, Types.Word] <*> genOff <*> genBase),
-          ( 2,
-            (\cmp t rs1 rs2 -> BType cmp (fromIntegral ((t - i) * 4)) rs1 rs2)
-              <$> elements [EQ, NE, LT, GE, LTU, GEU]
-              <*> choose (0, n)
-              <*> genCtl
-              <*> genCtl
-          ),
-          (1, (\rd t -> JType rd (fromIntegral ((t - i) * 4))) <$> genDst <*> choose (0, n))
-        ]
-
-    genBase = elements [5, 6]
-    genCtl = elements [0, 5, 6]
-    genDst = elements [1, 2, 3, 4, 7]
-    genAny = elements [0, 1, 2, 3, 4, 5, 6, 7]
-    genOff = (\k -> fromIntegral (k * 4)) <$> choose (0 :: Int, 2)
-    genAddr n =
-      oneof
-        [ (\k -> 4 * k) <$> choose (0 :: Int, 40),
-          (\t -> fromIntegral initPc + 4 * t) <$> choose (0, n)
-        ]
-
--- | Programs whose loads and stores have every width and alignment, including
--- reads and writes that straddle two blocks.
---
--- Base registers @x5@ and @x6@ are set only from constants, to data addresses,
--- so no access reaches the program; offsets are any byte offset up to 11.
--- Stores store data registers, loads write them, and branches compare them, so
--- loaded values flow back into memory and into control flow.
-genByteProg :: Gen (Vec PROG_SIZE Word)
-genByteProg = do
-  n <- choose (2, 14)
-  body <- P.mapM (genOne n) [0 .. n - 1]
-  let instrs = P.map roundTrips body P.++ P.replicate (50 - n) Core.Instruction.break
-  pure (map encode (unsafeFromList instrs))
-  where
-    roundTrips i = case encode' i of
-      Just w | decode' w == i -> i
-      _ -> IType (Arith ADD) 0 0 0
-
-    genOne n i =
-      frequency
-        [ (2, RType <$> elements [ADD, SUB, XOR, OR, AND] <*> genDst <*> genDst <*> genDst),
-          (3, (\b k -> IType (Arith ADD) b 0 (fromIntegral (4 * k :: Int))) <$> genBase <*> choose (0, 40)),
-          ( 4,
-            (\size sign rd b off -> IType (Load size sign) rd b off)
-              <$> elements [Byte, Half, Types.Word]
-              <*> elements [Signed, Unsigned]
-              <*> genDst
-              <*> genBase
-              <*> genOff
-          ),
-          (3, (\size off b rs2 -> SType size off b rs2) <$> elements [Byte, Half, Types.Word] <*> genOff <*> genBase <*> genDst),
-          ( 1,
-            (\cmp t rs1 rs2 -> BType cmp (fromIntegral ((t - i) * 4)) rs1 rs2)
-              <$> elements [EQ, NE, LT, GE, LTU, GEU]
-              <*> choose (i + 1, n)
-              <*> genDst
-              <*> genDst
-          )
-        ]
-
-    genBase = elements [5, 6]
-    genDst = elements [1, 2, 3, 4]
-    genOff = fromIntegral <$> choose (0 :: Int, 11)
-
-genWord :: Gen Word
-genWord = oneof [elements [0, 1, 0xFF, 0x1234, 0x80000000, 0xDEADBEEF], fromIntegral <$> (arbitrary :: Gen Int)]
-
--- | The core's bus observations computed from the leakage alone, hop by hop, as
--- behind ideal memory: the leakage simulator ('Proof.Core.Leakage.Simulator.simCircuit')
--- run on the ISA's leakage trace.
---
--- The hops are those of 'ProofSpec.leakReport': the first gets no leakage, and
--- every later one gets @'leakOf' isa@ on its first cycle, after which the ISA
--- steps. A halted ISA stands still.
-simHops :: Sys -> [[Obs]]
-simHops sys0 = go Nothing (isaAt (stateFePc (sysCore sys0)) sys0) simInit
-  where
-    go :: SimInput -> IsaState -> SimState -> [[Obs]]
-    go inp a sim =
-      let (sim', os) = runSim (simDriver inp sim + 1) inp sim
-          a' = case inp of
-            Nothing -> a
-            Just _ -> isaNext a
-       in os : go (Just (leakOf a')) a' sim'
-    -- The simulator for @n@ cycles; it gets @inp@ on the first only.
-    runSim :: Int -> SimInput -> SimState -> (SimState, [Obs])
-    runSim 0 _ sim = (sim, [])
-    runSim n inp sim =
-      let (sim1, o) = simCircuit sim inp
-          (sim2, os) = runSim (n - 1) Nothing sim1
-       in (sim2, o : os)
-    isaNext a = case isaStep a of
-      Next a' -> a'
-      IsaHalted -> a
-
--- | A load to put into the memory stage, or none.
-genMeLoad :: Gen (Maybe Instruction)
-genMeLoad =
-  frequency
-    [ (1, pure Nothing),
-      ( 4,
-        (\size sign rd rs1 imm -> Just (IType (Load size sign) rd rs1 imm))
-          <$> elements [Byte, Half, Types.Word]
-          <*> elements [Signed, Unsigned]
-          <*> (fromIntegral <$> choose (0 :: Int, 31))
-          <*> (fromIntegral <$> choose (0 :: Int, 31))
-          <*> (fromIntegral <$> choose (0 :: Int, 63))
-      )
-    ]
-
--- | Does a cycle of the core from this state issue a data read?
-issuesDataRead :: (RegFileOps r) => StateG r Identity -> Input Identity -> Bool
-issuesDataRead s inp = case outMem (snd (circuit s inp)) of
-  Just (MemAccess False _ _ Nothing) -> True
-  _ -> False
-
-compositionTests :: TestTree
-compositionTests =
-  testGroup
-    "Core behind a cache"
-    [ testProperty "patience: after a data read the core waits" $
-        -- Arbitrary states, mostly with a load in the memory stage and none in
-        -- flight, so that the cycle issues a data read.
-        withMaxSuccess 5000 $ checkCoverage $
-          forAllShow genArbSys1 (const "<state>") $ \(Sys s0 inp _, _, _) ->
-            forAll genMeLoad $ \me ->
-              let s = maybe s0 (\ir -> s0 {stateMeInstr = ir, stateLoadInFlight = False}) me
-               in cover 50 (issuesDataRead s inp) "the cycle issues a data read" (waitObligation s inp),
-      testProperty "a stall cycle is a stutter step, on arbitrary stalled states" $
-        withMaxSuccess 5000 $
-          forAllShow genArbSys1 (const "<state>") $ \(Sys st inp _, wr, _) ->
-            isLoad (stateWbInstr st) ==>
-              stallObligation wr st {stateLoadInFlight = True} inp {inputMemReady = False}
-    ]
diff --git a/test/ProofSpec.hs b/test/ProofSpec.hs
index 475d990..cdf6df7 100644
--- a/test/ProofSpec.hs
+++ b/test/ProofSpec.hs
@@ -1,16 +1,16 @@
 {-# LANGUAGE PackageImports #-}
 
-module ProofSpec (proofTests, progs, initSys, alignedWalk, invTrace, invReport, genProg, genArbSys, genArbSys1, genArbSys2, genArbSys3, genTakenTransfer) where
+module ProofSpec (proofTests, progs, initSysProg, alignedWalk, invTrace, invReport, genProg, genArbSys, genArbSys1, genArbSys2, genArbSys3, genTakenTransfer) where
 
 import Clash.Prelude hiding (Ordering (..), Word, def, init, lift, log)
 import Clash.Sized.Vector (unsafeFromList)
-import Core
+import Core.Pipeline as Core
 import Proof.Core.Functional.Driver hiding (loadHazard, storeHazard)
 import Core.ISA (IsaStateG (..), IsaState, StepG (..), isaStep, isaInstrAt)
 import Core.Instruction
 import Proof.Core.Functional.Invariant
 import Proof.Core.Functional.Machine
-import Proof.Core.Functional.Obligation (indStep0, indStep1, indStep2, isaAt)
+import Proof.Core.Functional.Obligation (indStep0, indStep1, indStep2)
 import Proof.Core.Leakage.Driver (simDriver)
 import Proof.Core.Leakage.Invariant (simInv)
 import Proof.Core.Leakage.Model (Obs, leakOf, obsOf)
@@ -35,14 +35,14 @@ stepSysN n s
 -- | A state the driver is meant to be evaluated in: the execute stage holds a
 -- real instruction. The startup state (@Nop FirstCycle@) is the one bubble the
 -- driver has an explicit case for. Note @Nop DecodeFail@ is /not/ a bubble --
--- see 'Proof.Machine.isBubble'.
+-- see 'Proof.Core.Functional.Driver.isBubble'.
 aligned :: Sys -> Bool
-aligned s = not (isBubble (stateExInstr (sysCore s))) || stateExInstr (sysCore s) == Nop FirstCycle
+aligned s = not (isBubble s) || stateExInstr (sysCore s) == Nop FirstCycle
 
 -- | Walk the machine from aligned state to aligned state, taking
 -- @driver s + 1@ cycles each hop.
 alignedWalk :: Int -> Vec PROG_SIZE Word -> [(Int, Int, Sys)]
-alignedWalk k prog = go k 0 (initSys prog)
+alignedWalk k prog = go k 0 (initSysProg prog)
   where
     go 0 _ _ = []
     go j i s =
@@ -69,18 +69,14 @@ walkReport k prog =
         stateHalt (sysCore s') == Nothing
     ]
 
--- | The system as it starts up, with @prog@ loaded at 'initPc'.
-initSys :: Vec PROG_SIZE Word -> Sys
-initSys prog =
-  Sys
-    { sysCore = Core.init,
-      sysInput = initInput,
-      sysMem = mkRAM @PROG_SIZE @RAM_SIZE_BYTES prog
-    }
+-- | The system as it starts up, with @prog@ loaded at 'initPc' and the
+-- register file zeroed ('Proof.Core.Functional.Machine.initSys').
+initSysProg :: Vec PROG_SIZE Word -> Sys
+initSysProg prog = initSys initPc initRFg (mkRAM @PROG_SIZE @RAM_SIZE_BYTES prog)
 
 -- | The architectural state @prog@ starts in: execution begins at 'initPc', the
 -- register file is zeroed, and memory holds the program. The counterpart of
--- 'initSys' on the ISA side.
+-- 'initSysProg' on the ISA side.
 initIsa :: Vec PROG_SIZE Word -> IsaState
 initIsa prog = IsaState initPc initRF (mkRAM @PROG_SIZE @RAM_SIZE_BYTES prog)
 
@@ -90,18 +86,18 @@ initIsa prog = IsaState initPc initRF (mkRAM @PROG_SIZE @RAM_SIZE_BYTES prog)
 baseHolds :: Vec PROG_SIZE Word -> Bool
 baseHolds prog =
   driver sys0 P.== 1
-    P.&& driverRef 12 sys0 P.== Just 2
+    P.&& driverSpec 12 sys0 P.== Just 1
     P.&& inv (initIsa prog) (stepSysN 2 sys0)
   where
-    sys0 = initSys prog
+    sys0 = initSysProg prog
 
 baseReport :: Vec PROG_SIZE Word -> String
 baseReport prog =
   "driver=" P.++ show (driver sys0)
-    P.++ " driverRef=" P.++ show (driverRef 12 sys0)
+    P.++ " driverSpec=" P.++ show (driverSpec 12 sys0)
     P.++ "\n" P.++ explain (initIsa prog) (stepSysN 2 sys0)
   where
-    sys0 = initSys prog
+    sys0 = initSysProg prog
 
 -- | The driver and the ISA walked in lockstep, at every state the invariant is
 -- meant to hold.
@@ -115,7 +111,7 @@ invTrace :: Int -> Vec PROG_SIZE Word -> [(Int, IsaState, Sys)]
 invTrace k prog = go k 0 isa0 sys0 True
   where
     isa0 = initIsa prog
-    sys0 = initSys prog
+    sys0 = initSysProg prog
 
     go 0 _ _ _ _ = []
     go j c isa sys firstHop =
@@ -177,7 +173,7 @@ leakReport k prog =
     Just problem -> "first hop: " P.++ problem
     Nothing -> go k (driver sys0 + 1) (initIsa prog) sysAfter simAfter
   where
-    sys0 = initSys prog
+    sys0 = initSysProg prog
     firstHop@(sysAfter, simAfter, _, _) = runHop (driver sys0 + 1) sys0 simInit Nothing
 
     go :: Int -> Int -> IsaState -> Sys -> SimState -> String
@@ -350,21 +346,16 @@ proofTests =
         ],
       -- The driver's stated invariant, checked directly: from an aligned state,
       -- stepping @driver + 1@ cycles is exactly stepping until the execute
-      -- stage stops being a bubble.
-      --
-      -- @ecall@ / @ebreak@ are excluded because they are terminal: the core
-      -- halts and the execute stage then holds @Nop Halted@ forever, so there
-      -- is no next non-bubble for the operational reading to find.
+      -- stage stops being a bubble. Halted states and @ecall@ / @ebreak@ are
+      -- included: @Nop Halted@ is not a bubble ('isBubble').
       testCase "driver agrees with its operational reading" $
         let bad =
               [ (driver sys, ref, stateExInstr (sysCore sys))
                 | prog <- allProgs 500,
                   (_, _, sys) <- invTrace 40 prog,
-                  stateHalt (sysCore sys) == Nothing,
                   aligned sys,
-                  P.not (isEnvInstr (stateExInstr (sysCore sys))),
-                  let ref = driverRef 12 sys,
-                  ref /= Just (driver sys + 1)
+                  let ref = driverSpec 12 sys,
+                  ref /= Just (driver sys)
               ]
          in if P.null bad then pure () else assertFailure (show (P.take 10 bad)),
       -- The leakage simulator alongside the core: matching hop lengths and bus
@@ -405,7 +396,7 @@ proofTests =
       -- jump costs three cycles, so it has retired past writeback by the next
       -- aligned state -- and nothing else in the invariant rules it out, so this
       -- is the only thing constraining the @JType@ / @IType Jump@ clauses of
-      -- 'Proof.Core.Functional.Invariant.flushMeStage'. It fails if those clauses
+      -- 'Proof.Core.Functional.Invariant.applyMeStage'. It fails if those clauses
       -- stop writing @rd@.
       testCase "inductive with a jump in the memory stage" $
         let bad = [e | sys <- sampleStates 200, Just e <- [inductiveStep (withJumpInMe sys)]]
@@ -478,7 +469,7 @@ proofTests =
                       P.++ " wr=" P.++ show wr P.++ " wa=" P.++ show wa
                       P.++ "\nfailing=" P.++ show (P.map P.fst (P.filter (P.not . P.snd) (P.concatMap caseConjuncts (invCasesAt wr wa isa' sys'))))
                   )
-                  (indStep0 wr wa (stateExPc (sysCore sys)) sys),
+                  (indStep0 wr wa sys),
       -- k = 1: the two-cycle hop, a memory instruction in writeback. The test
       -- below asserts generated states actually satisfy the premise, since one
       -- this specific is easy to miss entirely and still see a green property.
@@ -498,14 +489,14 @@ proofTests =
                       P.++ " wr=" P.++ show wr P.++ " wa=" P.++ show wa
                       P.++ "\nfailing=" P.++ show (P.map P.fst (P.filter (P.not . P.snd) (P.concatMap caseConjuncts (invCasesAt wr wa isa' s2))))
                   )
-                  (indStep1 wr wa (stateExPc (sysCore sys)) sys),
+                  (indStep1 wr wa sys),
       testCase "k=1 generator satisfies the premise" $
         let sample = [s | (s, _, _) <- unGen (vectorOf 4000 genArbSys1) (mkQCGen 7) 30]
             admitted =
               [ ()
                 | s <- sample,
                   driver s P.== 1,
-                  invAt 1 0 (isaAt (stateExPc (sysCore s)) s) s
+                  invAt 1 0 (isaOf s) s
               ]
          in assertBool "no generated state satisfied the k=1 premise" (P.not (P.null admitted)),
       -- k = 2: jumps and the all-memory steady shape return to a running
@@ -523,14 +514,14 @@ proofTests =
                   P.++ "\nexPc=" P.++ show (stateExPc (sysCore sys))
                   P.++ " wr=" P.++ show wr P.++ " wa=" P.++ show wa
               )
-              (indStep2 wr wa (stateExPc (sysCore sys)) sys),
+              (indStep2 wr wa sys),
       testCase "k=2 generator reaches env, jump, and steady cases" $
         let sample =
               [ (label, driverCaseName s)
                 | (label, s, wr, wa) <-
                     unGen (vectorOf 4000 genArbSys2) (mkQCGen 29) 30,
                   driver s P.== 2,
-                  invAt wr wa (isaAt (stateExPc (sysCore s)) s) s
+                  invAt wr wa (isaOf s) s
               ]
             has label = P.any ((P.== label) . P.fst) sample
          in do
@@ -555,12 +546,12 @@ proofTests =
 -- cannot actually occur still has to be handled -- and that is where the
 -- invariant as written comes apart.
 
--- | The architectural state that makes the flush conjunct hold at @sys@ by
--- construction. If @sys@ is an aligned running state, this is the ISA state the
+-- | The architectural state that makes the pending-writes conjunct hold at
+-- @sys@ by construction. If @sys@ is an aligned running state, this is the ISA state the
 -- invariant claims it corresponds to.
 -- Shared with 'Proof.Core.Functional.Solver.indStep0' via "Proof.Core.Functional.Obligation", so the two cannot drift.
 isaFromSys :: (RegFileOps r, MemOps m) => SysG r m -> IsaStateG r m
-isaFromSys sys = isaAt (stateExPc (sysCore sys)) sys
+isaFromSys sys = isaOf sys
 
 -- | Take one driven step and report whether the invariant survived. Returns
 -- 'Nothing' when @sys@ does not satisfy the invariant to begin with (such a
@@ -641,7 +632,7 @@ wrapMem = MemFn bytes
 wrapCESys :: SysG RegFn MemFn
 wrapCESys =
   Sys
-    ( (sysCore (initSys (mkProg prog1)))
+    ( (sysCore (initSysProg (mkProg prog1)))
         { stateFePc = 0x00000000,
           stateDePc = 0xFFFFFFFC,
           stateDeExpInstr = True,
@@ -842,7 +833,7 @@ genArbSys = do
   wa <- unpack <$> genW
   let sys =
         Sys
-          ((sysCore (initSys (mkProg prog1)))
+          ((sysCore (initSysProg (mkProg prog1)))
              { stateFePc = base + 8,
                stateDePc = base + 4,
                stateDeExpInstr = True,
@@ -925,7 +916,7 @@ genRunning2 label genEx = do
   wa <- unpack <$> genW
   let sys =
         Sys
-          ( (sysCore (initSys (mkProg prog1)))
+          ( (sysCore (initSysProg (mkProg prog1)))
               { stateFePc = fePc,
                 stateDePc = base + 4,
                 stateDeExpInstr = P.not wbMem,
@@ -985,7 +976,7 @@ genSteady2 = do
   wa <- unpack <$> genW
   let sys =
         Sys
-          ( (sysCore (initSys (mkProg prog1)))
+          ( (sysCore (initSysProg (mkProg prog1)))
               { stateFePc = base + 4,
                 stateDePc = base + 4,
                 stateDeExpInstr = False,
@@ -1029,7 +1020,7 @@ genSteady1 = do
   wa <- unpack <$> genW
   let sys =
         Sys
-          ( (sysCore (initSys (mkProg prog1)))
+          ( (sysCore (initSysProg (mkProg prog1)))
               { stateFePc = base + 4,
                 stateDePc = base + 4,
                 stateDeExpInstr = False,
@@ -1248,7 +1239,7 @@ genTakenTransfer useJalr = do
 
       mkSys w0 rfun =
         Sys
-          ( (sysCore (initSys (mkProg prog1)))
+          ( (sysCore (initSysProg (mkProg prog1)))
               { stateFePc = fePc,
                 stateDePc = base + 4,
                 stateDeExpInstr = P.not wbMem,
@@ -1362,7 +1353,7 @@ mk3 base exI meI wbI nextI wbMem = do
         | P.otherwise = 0
   P.pure
     ( Sys
-        ( (sysCore (initSys (mkProg prog1)))
+        ( (sysCore (initSysProg (mkProg prog1)))
             { stateFePc = if wbMem then base + 4 else base + 8,
               stateDePc = base + 4,
               stateDeExpInstr = P.not wbMem,
diff --git a/test/Spec.hs b/test/Spec.hs
index 6b9bd58..f7876c9 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -7,10 +7,12 @@
 module Main (main) where
 
 import BenchmarkSpec (benchmarkTests)
+import Cache4KSpec (cache4KTests)
+import CacheProofSpec (cacheProofTests)
 import Clash.Prelude hiding (Log, Ordering (..), Word, break, def, init, lift, log, resize)
 import Clash.Sized.Vector (unsafeFromList)
 import Control.Monad
-import Core
+import Core.Pipeline as Core
 import Data.Maybe (fromJust, isJust)
 import Core.Instruction
 import InstructionSpec (instructionTests)
@@ -23,7 +25,10 @@ import qualified Proof.SMT.Sanity as Sanity
 #endif
 import qualified Prelude
 #ifdef SMT_PROOF
-import qualified Proof.Cache.Functional.Solver
+import qualified Proof.Memory.Cache4K.Server.Functional.Solver
+import qualified Proof.Memory.Cache4K.Server.Leakage.Solver
+import qualified Proof.Memory.Cache4K.CachedCore.Functional.Solver
+import qualified Proof.Memory.Cache4K.CachedCore.Leakage.Solver
 import qualified Proof.Core.Functional.Solver
 import qualified Proof.Core.Leakage.Solver
 #endif
@@ -74,6 +79,12 @@ sanityTests =
         lookup "arrRoundTripP" Proof.Core.Functional.Solver.results @?= Just Nothing,
       testCase "shift embeddings are sane" $
         lookup "shiftsSaneP" Proof.Core.Functional.Solver.results @?= Just Nothing,
+      testCase "on states in the invariant, the driver agrees with its reading" $
+        lookup "driverMatchesSpecP" Proof.Core.Functional.Solver.results @?= Just Nothing,
+      testCase "on the initial system, the driver agrees with its reading" $
+        lookup "driverMatchesSpecInitP" Proof.Core.Functional.Solver.results @?= Just Nothing,
+      testCase "the driver gives only the steps' hop lengths" $
+        lookup "driverValuesP" Proof.Core.Functional.Solver.results @?= Just Nothing,
       testCase "base case: invariant holds after the reset hop" $
         lookup "baseCaseP" Proof.Core.Functional.Solver.results @?= Just Nothing,
       testCase "k = 0 inductive step is valid" $
@@ -84,10 +95,18 @@ sanityTests =
         lookup "indStep2P" Proof.Core.Functional.Solver.results @?= Just Nothing,
       testCase "k = 3 inductive step is valid" $
         lookup "indStep3P" Proof.Core.Functional.Solver.results @?= Just Nothing,
-      testCase "the invariant implies the ISA's register file is the core's, flushed" $
+      testCase "the invariant implies the ISA's PC is the core's architectural one" $
+        lookup "pcUnderInvP" Proof.Core.Functional.Solver.results @?= Just Nothing,
+      testCase "the invariant implies the ISA's register file is the core's architectural one" $
         lookup "regFileUnderInvP" Proof.Core.Functional.Solver.results @?= Just Nothing,
-      testCase "the invariant implies the ISA's memory is the core's, flushed" $
+      testCase "the invariant implies the ISA's memory is the core's architectural one" $
         lookup "memUnderInvP" Proof.Core.Functional.Solver.results @?= Just Nothing,
+      testCase "the invariant is functional: it relates one ISA state to a system" $
+        lookup "invFunctionalP" Proof.Core.Functional.Solver.results @?= Just Nothing,
+      testCase "the simulator's driver agrees with its operational reading" $
+        lookup "simDriverMatchesSpecP" Proof.Core.Leakage.Solver.results @?= Just Nothing,
+      testCase "on the initial simulator, its driver agrees with its reading" $
+        lookup "simDriverMatchesSpecInitP" Proof.Core.Leakage.Solver.results @?= Just Nothing,
       testCase "leakage base case: simulator matches the first hop" $
         lookup "baseCaseLeakP" Proof.Core.Leakage.Solver.results @?= Just Nothing,
       testCase "k = 0 leakage step is valid" $
@@ -100,19 +119,66 @@ sanityTests =
         lookup "indStepLeak3P" Proof.Core.Leakage.Solver.results @?= Just Nothing,
       testGroup
         "the 4 KiB cache answers as ideal memory, with delay"
-        [ testCase name $ lookup name Proof.Cache.Functional.Solver.results @?= Just Nothing
+        [ testCase name $
+            lookup name Proof.Memory.Cache4K.Server.Functional.Solver.results
+              @?= Just Nothing
           | name <-
               [ "cacheArraysP",
                 "coherentDataP",
                 "coherentWriteP",
                 "coherentLayoutP",
+                "srvDriverMatchesSpecP",
+                "srvDriverValuesP",
+                "srvInvFunctionalP",
                 "baseCaseP",
                 "indStep0P",
                 "indStep4P",
+                "indStepWaits4P",
                 "indStep8P",
-                "readyUnderInvP",
-                "readyIdleNoWaitP",
-                "waitsAfterRequestP"
+                "indStepWaits8P",
+                "srvReadyIffAnsweredP",
+                "srvReadyUnderInvP",
+                "corePatientP"
+              ]
+        ],
+      testGroup
+        "the 4 KiB cache leaks only its requests' observations"
+        [ testCase name $
+            lookup name Proof.Memory.Cache4K.Server.Leakage.Solver.results
+              @?= Just Nothing
+          | name <-
+              [ "simSrvReadyIffAnsweredP",
+                "simSrvDriverMatchesSpecP",
+                "baseCaseLeakP",
+                "indStepLeakP"
+              ]
+        ],
+      testGroup
+        "the core behind the cache refines the core behind ideal memory"
+        [ testCase name $
+            lookup name Proof.Memory.Cache4K.CachedCore.Functional.Solver.results
+              @?= Just Nothing
+          | name <-
+              [ "cachedDriverMatchesSpecP",
+                "cachedDriverValuesP",
+                "cachedInvFunctionalP",
+                "baseCaseP",
+                "indStep0P",
+                "indStep4P",
+                "indStep8P"
+              ]
+        ],
+      testGroup
+        "the core behind the cache leaks only what it leaks behind ideal memory"
+        [ testCase name $
+            lookup name Proof.Memory.Cache4K.CachedCore.Leakage.Solver.results
+              @?= Just Nothing
+          | name <-
+              [ "simCachedDriverMatchesSpecP",
+                "baseCaseLeakP",
+                "indStepLeak0P",
+                "indStepLeak4P",
+                "indStepLeak8P"
               ]
         ]
     ]
@@ -132,6 +198,8 @@ tests =
       sanityTests,
 #endif
       proofTests,
+      cache4KTests,
+      cacheProofTests,
       isaConformanceTests,
       instructionTests,
       testGroup