diff --git a/minipat/src/Minipat/Ast.hs b/minipat/src/Minipat/Ast.hs
index 5681913..ecc2715 100644
--- a/minipat/src/Minipat/Ast.hs
+++ b/minipat/src/Minipat/Ast.hs
@@ -29,7 +29,6 @@ module Minipat.Ast
   , Poly (..)
   , PatF (..)
   , Pat (..)
-  , PatX
   , UnPat
   , Pattern (..)
   )
@@ -204,13 +203,16 @@ instance Pretty SpeedDir where
     SpeedDirSlow -> "/"
 
 -- | Speed control
-data Speed s = Speed
+data Speed b = Speed
   { speedDir :: !SpeedDir
-  , speedFactor :: !s
+  , speedFactor :: !(Pat b Factor)
   }
-  deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable)
+  deriving stock (Eq, Ord, Show)
+
+-- instance Foldable Speed where
+--   foldr f z (Speed x y) = Speed x (bifoldr f y)
 
-instance (Pretty s) => Pretty (Speed s) where
+instance Pretty (Speed b) where
   pretty (Speed dir facs) = P.hcat [pretty dir, pretty facs]
 
 -- | Euclidean sequences
@@ -253,15 +255,15 @@ instance Pretty Replicate where
 -- TODO add elongate/replicate constructors here
 
 -- | Controls that can be applied to a given pattern
-data ModType s
+data ModType b
   = ModTypeDegrade !Degrade
   | ModTypeEuclid !Euclid
-  | ModTypeSpeed !(Speed s)
+  | ModTypeSpeed !(Speed b)
   | ModTypeElongate !Elongate
   | ModTypeReplicate !Replicate
-  deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable)
+  deriving stock (Eq, Ord, Show)
 
-instance (Pretty s) => Pretty (ModType s) where
+instance Pretty (ModType b) where
   pretty = \case
     ModTypeDegrade x -> pretty x
     ModTypeEuclid x -> pretty x
@@ -270,24 +272,15 @@ instance (Pretty s) => Pretty (ModType s) where
     ModTypeReplicate x -> pretty x
 
 -- | An expression modified by some control
-data Mod s r = Mod
+data Mod b r = Mod
   { modTarget :: !r
-  , modType :: !(ModType s)
+  , modType :: !(ModType b)
   }
   deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable)
 
-instance (Pretty c, Pretty r) => Pretty (Mod c r) where
+instance (Pretty r) => Pretty (Mod b r) where
   pretty (Mod tar ty) = P.hcat [pretty tar, pretty ty]
 
-instance Bifunctor Mod where
-  bimap f g (Mod r mt) = Mod (g r) (fmap f mt)
-
-instance Bifoldable Mod where
-  bifoldr f g z (Mod r mt) = g r (foldr f z mt)
-
-instance Bitraversable Mod where
-  bitraverse f g (Mod r mt) = Mod <$> g r <*> traverse f mt
-
 -- * Groups
 
 -- | Presentation of a sequence - dot- or space-separated
@@ -363,16 +356,16 @@ instance (Pretty r) => Pretty (Poly r) where
 
 -- * Functor
 
-data PatF s a r
+data PatF b a r
   = PatPure !a
   | PatSilence
   | PatShort !Short
   | PatGroup !(Group r)
-  | PatMod !(Mod s r)
+  | PatMod !(Mod b r)
   | PatPoly !(Poly r)
   deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable)
 
-instance Bifunctor (PatF s) where
+instance Bifunctor (PatF b) where
   bimap f g = \case
     PatPure a -> PatPure (f a)
     PatSilence -> PatSilence
@@ -381,7 +374,7 @@ instance Bifunctor (PatF s) where
     PatMod m -> PatMod (fmap g m)
     PatPoly p -> PatPoly (fmap g p)
 
-instance Bifoldable (PatF s) where
+instance Bifoldable (PatF b) where
   bifoldr f g = go
    where
     go z = \case
@@ -392,7 +385,7 @@ instance Bifoldable (PatF s) where
       PatMod m -> foldr g z m
       PatPoly p -> foldr g z p
 
-instance Bitraversable (PatF s) where
+instance Bitraversable (PatF b) where
   bitraverse f g = \case
     PatPure a -> fmap PatPure (f a)
     PatSilence -> pure PatSilence
@@ -401,10 +394,10 @@ instance Bitraversable (PatF s) where
     PatMod m -> fmap PatMod (traverse g m)
     PatPoly p -> fmap PatPoly (traverse g p)
 
-instance (IsString a) => IsString (PatF s a r) where
+instance (IsString a) => IsString (PatF b a r) where
   fromString = PatPure . fromString
 
-instance (Pretty s, Pretty a, Pretty r) => Pretty (PatF s a r) where
+instance (Pretty a, Pretty r) => Pretty (PatF b a r) where
   pretty a = case a of
     PatPure x -> pretty x
     PatSilence -> "~"
@@ -420,51 +413,11 @@ newtype Pat b a = Pat {unPat :: UnPat b a}
   deriving stock (Show)
   deriving newtype (Eq, Ord, Functor, Foldable, Pretty)
 
-type PatX b = PatF (Pat b Factor)
-
-type UnPat b = Jot (PatX b) b
+type UnPat b = Jot (PatF b) b
 
 instance Traversable (Pat a) where traverse f = fmap Pat . traverse f . unPat
 
-instance Bifunctor Pat where
-  bimap f g = Pat . go . unPat
-   where
-    go (JotP b pf) = JotP (f b) $
-      case pf of
-        PatPure a -> PatPure (g a)
-        PatSilence -> PatSilence
-        PatShort s -> PatShort s
-        PatGroup gs -> PatGroup (fmap go gs)
-        PatMod (Mod r m) -> PatMod (Mod (go r) (fmap (first f) m))
-        PatPoly (Poly rs mc) -> PatPoly (Poly (fmap go rs) mc)
-
-instance Bifoldable Pat where
-  bifoldr f g = flip (go . unPat)
-   where
-    go (JotP b pf) z = f b $
-      case pf of
-        PatPure a -> g a z
-        PatSilence -> z
-        PatShort _ -> z
-        PatGroup gs -> foldr go z gs
-        PatMod (Mod r m) -> go r (foldr (flip (bifoldr f (const id))) z m)
-        PatPoly (Poly rs _) -> foldr go z rs
-
-instance Bitraversable Pat where
-  bitraverse f g = fmap Pat . go . unPat
-   where
-    go (JotP b pf) =
-      JotP
-        <$> f b
-        <*> case pf of
-          PatPure a -> fmap PatPure (g a)
-          PatSilence -> pure PatSilence
-          PatShort s -> pure (PatShort s)
-          PatGroup gs -> fmap PatGroup (traverse go gs)
-          PatMod (Mod r m) -> fmap PatMod $ Mod <$> go r <*> traverse (bitraverse f pure) m
-          PatPoly (Poly rs mc) -> fmap (\rs' -> PatPoly (Poly rs' mc)) (traverse go rs)
-
-mkPat :: (Monoid b) => PatX b a (UnPat b a) -> Pat b a
+mkPat :: (Monoid b) => PatF b a (UnPat b a) -> Pat b a
 mkPat = Pat . JotP mempty
 
 mkPatGroup :: (Monoid b) => GroupType -> Seq (Pat b a) -> Pat b a
diff --git a/minipat/src/Minipat/Interp.hs b/minipat/src/Minipat/Interp.hs
index d390cf7..03b2018 100644
--- a/minipat/src/Minipat/Interp.hs
+++ b/minipat/src/Minipat/Interp.hs
@@ -8,8 +8,6 @@ module Minipat.Interp
 where
 
 import Control.Exception (Exception)
-import Control.Monad.Except (Except, runExcept)
-import Control.Monad.Trans (lift)
 import Data.Ratio ((%))
 import Minipat.Ast
   ( Degrade (..)
@@ -21,7 +19,6 @@ import Minipat.Ast
   , ModType (..)
   , Pat (..)
   , PatF (..)
-  , PatX
   , Pattern (..)
   , Poly (..)
   , Replicate (..)
@@ -29,7 +26,7 @@ import Minipat.Ast
   , SpeedDir (..)
   , factorValue
   )
-import Minipat.Rewrite (RwErr, RwT, rewriteM, throwRw)
+import Minipat.Rewrite (AnnoErr, Rw, patCataRw, runPatRw, throwRw)
 
 -- | An error interpreting a 'Pat' as a 'Stream'
 data InterpErr
@@ -39,37 +36,30 @@ data InterpErr
 
 instance Exception InterpErr
 
-type M b = Except (RwErr InterpErr b)
-
-runM :: M b a -> Either (RwErr InterpErr b) a
-runM = runExcept
-
 lookInterp
   :: (Pattern f)
-  => PatX b a (M b (f a, Rational))
-  -> RwT b (M b) (f a, Rational)
+  => PatF b a (f a, Rational)
+  -> Rw b InterpErr (f a, Rational)
 lookInterp = \case
   PatPure a -> pure (patPure a, 1)
   PatSilence -> pure (patEmpty, 1)
   PatShort _ -> throwRw InterpErrShort
   PatGroup (Group _ ty els) -> do
-    els' <- lift (sequenceA els)
     case ty of
-      GroupTypeSeq _ -> pure (patSeq els', 1)
-      GroupTypePar -> pure (patPar (fmap fst els'), 1)
+      GroupTypeSeq _ -> pure (patSeq els, 1)
+      GroupTypePar -> pure (patPar (fmap fst els), 1)
       GroupTypeRand ->
-        let els'' = fmap (\(el, w) -> patFastBy w el) els'
+        let els'' = fmap (\(el, w) -> patFastBy w el) els
             s = patRand els''
         in  pure (s, 1)
       GroupTypeAlt ->
-        let els'' = fmap (\(el, w) -> patFastBy w el) els'
+        let els'' = fmap (\(el, w) -> patFastBy w el) els
             s = patAlt els''
         in  pure (s, 1)
-  PatMod (Mod melw md) -> do
-    (el, w) <- lift melw
+  PatMod (Mod (el, w) md) -> do
     case md of
       ModTypeSpeed (Speed dir spat) -> do
-        spat' <- lift (subInterp spat)
+        spat' <- subInterp spat
         let f = case dir of
               SpeedDirFast -> patFast
               SpeedDirSlow -> patSlow
@@ -94,9 +84,8 @@ lookInterp = \case
         pure (el', w')
   PatPoly (Poly _ _) -> error "TODO"
 
-subInterp :: (Pattern f) => Pat b a -> M b (f a)
-subInterp = fmap fst . rewriteM lookInterp . unPat
+subInterp :: (Pattern f) => Pat b a -> Rw b InterpErr (f a)
+subInterp = fmap fst . patCataRw lookInterp
 
--- | Interpret the given 'Pat' as any 'Pattern'
-interpPat :: (Pattern f) => Pat b a -> Either (RwErr InterpErr b) (f a)
-interpPat = runM . subInterp
+interpPat :: (Pattern f) => Pat b a -> Either (AnnoErr b InterpErr) (f a)
+interpPat = runPatRw subInterp
diff --git a/minipat/src/Minipat/Norm.hs b/minipat/src/Minipat/Norm.hs
index 5d386af..7fc2453 100644
--- a/minipat/src/Minipat/Norm.hs
+++ b/minipat/src/Minipat/Norm.hs
@@ -8,6 +8,7 @@ import Bowtie (pattern JotP)
 import Data.Sequence (Seq (..))
 import Data.Sequence.NonEmpty (NESeq (..))
 import Data.Sequence.NonEmpty qualified as NESeq
+import Data.Void (Void)
 import Minipat.Ast
   ( Elongate (..)
   , Group (..)
@@ -16,12 +17,11 @@ import Minipat.Ast
   , ModType (..)
   , Pat (..)
   , PatF (..)
-  , PatX
   , Replicate (..)
   , Short (..)
   , UnPat
   )
-import Minipat.Rewrite (Rw, asksRw, overhaul, wrapRw)
+import Minipat.Rewrite (Rw, patNatRw, peeksRw, runPatRw, unwrapAnnoErr, wrapRw)
 
 foldNorm :: (b -> b -> b) -> Seq (UnPat b a) -> Seq (UnPat b a)
 foldNorm f = goFirst
@@ -49,7 +49,7 @@ foldNorm f = goFirst
             _ -> ws NESeq.|> y
       in  goRest ws' ys
 
-subNorm :: (b -> b -> b) -> PatX b a (UnPat b a) -> Rw b (UnPat b a)
+subNorm :: (b -> b -> b) -> PatF b a (UnPat b a) -> Rw b Void (UnPat b a)
 subNorm f x = case x of
   PatGroup (Group lvl ty ss) -> do
     -- Fold over sequences, eliminating time shorthands
@@ -58,7 +58,7 @@ subNorm f x = case x of
           _ -> ss
     -- Unwrap any empty groups or singletons we find
     case ss' of
-      Empty -> asksRw (`JotP` PatSilence)
+      Empty -> peeksRw (`JotP` PatSilence)
       q :<| Empty -> pure q
       _ -> wrapRw (PatGroup (Group lvl ty ss'))
   _ -> wrapRw x
@@ -66,7 +66,7 @@ subNorm f x = case x of
 -- Someday we might want to expose this variant, which supports
 -- combining annotations any way we choose
 normPat' :: (b -> b -> b) -> Pat b a -> Pat b a
-normPat' f = Pat . overhaul (subNorm f) . unPat
+normPat' f = unwrapAnnoErr . runPatRw (patNatRw (subNorm f))
 
 -- | Normalize the given pattern
 normPat :: (Semigroup b) => Pat b a -> Pat b a
diff --git a/minipat/src/Minipat/Parser.hs b/minipat/src/Minipat/Parser.hs
index 3072e0e..447f769 100644
--- a/minipat/src/Minipat/Parser.hs
+++ b/minipat/src/Minipat/Parser.hs
@@ -156,12 +156,12 @@ factorP = do
 bracedP :: Brace -> P a -> P a
 bracedP b = L.betweenP (stripTokP (braceOpenChar b)) (tokP (braceCloseChar b))
 
-speedFastP :: P s -> P (Speed s)
+speedFastP :: P (PPat Factor) -> P (Speed Loc)
 speedFastP ps = do
   tokP '*'
   Speed SpeedDirFast <$> ps
 
-speedSlowP :: P s -> P (Speed s)
+speedSlowP :: P (PPat Factor) -> P (Speed Loc)
 speedSlowP ps = do
   tokP '/'
   Speed SpeedDirSlow <$> ps
diff --git a/minipat/src/Minipat/Rewrite.hs b/minipat/src/Minipat/Rewrite.hs
index cd32232..8387125 100644
--- a/minipat/src/Minipat/Rewrite.hs
+++ b/minipat/src/Minipat/Rewrite.hs
@@ -1,130 +1,153 @@
+{-# LANGUAGE UndecidableInstances #-}
+
 -- | Utilities for rewriting patterns
-module Minipat.Rewrite
-  ( RwErr (..)
-  , RwT
-  , Rw
-  , askRw
-  , asksRw
-  , throwRw
-  , wrapRw
-  , PatRw
-  , rewrite
-  , PatRwM
-  , rewriteM
-  , PatOvh
-  , overhaul
-  , PatOvhM
-  , overhaulM
-  )
-where
-
-import Bowtie (pattern JotP)
+module Minipat.Rewrite where
+
+import Bowtie (Jot, pattern JotP)
 import Control.Exception (Exception)
-import Control.Monad.Except (MonadError (..))
+import Control.Monad ((>=>))
+import Control.Monad.Except (ExceptT, MonadError (..), runExceptT)
+import Control.Monad.IO.Class (MonadIO (..))
 import Control.Monad.Identity (Identity (..))
-import Control.Monad.Reader (Reader, ReaderT (..), asks)
-import Data.Bifoldable (Bifoldable (..))
-import Data.Bifunctor (Bifunctor (..))
+import Control.Monad.Reader (MonadReader (..), ReaderT (..), asks)
+import Control.Monad.State (MonadState (..))
+import Control.Monad.Trans (MonadTrans (..))
 import Data.Bitraversable (Bitraversable (..))
 import Data.Sequence.NonEmpty (NESeq)
 import Data.Sequence.NonEmpty qualified as NESeq
 import Data.Typeable (Typeable)
-import Minipat.Ast qualified as A
+import Data.Void (Void, absurd)
+import Minipat.Ast (Mod (..), ModType (..), Pat (..), PatF (..), Poly (..), Speed (..), UnPat)
+
+-- * General rewriting (can go in Bowtie)
 
-data RwErr e b = RwErr
-  { rwErrLoc :: !b
-  , rwErrReason :: !e
+data AnnoErr k e = AnnoErr
+  { annoErrKey :: !k
+  , annoErrVal :: !e
   }
   deriving stock (Eq, Ord, Show)
 
 instance
-  (Show b, Typeable b, Show e, Typeable e)
-  => Exception (RwErr b e)
+  (Show k, Typeable k, Show e, Typeable e)
+  => Exception (AnnoErr k e)
+
+unwrapAnnoErr :: Either (AnnoErr k Void) a -> a
+unwrapAnnoErr = either (absurd . annoErrVal) id
+
+newtype RwT k e m a = RwT {unRwT :: ReaderT (NESeq k) (ExceptT (AnnoErr k e) m) a}
+  deriving newtype (Functor, Applicative, Monad)
+
+type Rw k e = RwT k e Identity
+
+instance MonadTrans (RwT k e) where
+  lift = RwT . lift . lift
+
+runRwT :: RwT k e m a -> k -> m (Either (AnnoErr k e) a)
+runRwT m = runExceptT . runReaderT (unRwT m) . NESeq.singleton
+
+runRw :: Rw k e a -> k -> Either (AnnoErr k e) a
+runRw m = runIdentity . runRwT m
 
--- | As we rewrite, we keep track of all locations from the root (snocing)
-type RwT b = ReaderT (NESeq b)
+pushRw :: (Monad m) => k -> RwT k e m a -> RwT k e m a
+pushRw b m = RwT (local (NESeq.|> b) (unRwT m))
 
-type Rw b = Reader (NESeq b)
+peekRw :: (Monad m) => RwT k e m k
+peekRw = RwT (asks NESeq.last)
 
-askRw :: (Monad m) => RwT b m b
-askRw = asks NESeq.last
+peeksRw :: (Monad m) => (k -> a) -> RwT k e m a
+peeksRw f = RwT (asks (f . NESeq.last))
 
-asksRw :: (Monad m) => (b -> c) -> RwT b m c
-asksRw f = asks (f . NESeq.last)
+askRw :: (Monad m) => RwT k e m (NESeq k)
+askRw = RwT ask
 
-throwRw :: (MonadError (RwErr e b) m) => e -> RwT b m a
-throwRw e = askRw >>= \b -> throwError (RwErr b e)
+asksRw :: (Monad m) => (NESeq k -> a) -> RwT k e m a
+asksRw f = RwT (asks f)
 
-wrapRw :: (Monad m) => A.PatX b a (A.UnPat b a) -> RwT b m (A.UnPat b a)
-wrapRw = asksRw . flip JotP
+throwRw :: (Monad m) => e -> RwT k e m a
+throwRw e = RwT (asks NESeq.last >>= \b -> throwError (AnnoErr b e))
 
-type PatRw b a x = A.PatX b a x -> Rw b x
+instance (MonadReader r m) => MonadReader r (RwT k e m) where
+  ask = lift ask
+  reader f = lift (reader f)
+  local f m = RwT $ do
+    bs <- ask
+    ea <- lift (lift (local f (runExceptT (runReaderT (unRwT m) bs))))
+    either throwError pure ea
 
-rewrite :: PatRw b a x -> A.UnPat b a -> x
-rewrite f = runIdentity . rewriteM (f . fmap runIdentity)
+instance (MonadState s m) => MonadState s (RwT k e m) where
+  get = lift get
+  put = lift . put
+  state f = lift (state f)
 
-type PatRwM b a m x = A.PatX b a (m x) -> RwT b m x
+instance (MonadIO m) => MonadIO (RwT k e m) where
+  liftIO = lift . liftIO
 
--- | Rewrite just the current pattern constructors (ignoring embedded patterns)
-rewriteM :: PatRwM b a m x -> A.UnPat b a -> m x
-rewriteM f (JotP b0 pf0) = go (NESeq.singleton b0) pf0
+wrapRw :: g a (Jot g k a) -> Rw k e (Jot g k a)
+wrapRw = peeksRw . flip JotP
+
+jotCataRw :: (Bitraversable g) => (g a z -> Rw k e z) -> Jot g k a -> Rw k e z
+jotCataRw f = jotCataRwT (bitraverse pure id >=> f)
+
+jotCataRwT :: (Monad m, Bitraversable g) => (g a (RwT k e m z) -> RwT k e m z) -> Jot g k a -> RwT k e m z
+jotCataRwT f = goJ
+ where
+  goJ (JotP b g) = pushRw b (goG g)
+  goG g = f (fmap goJ g)
+
+-- * Pattern rewriting
+
+patCataRw :: (PatF b a z -> Rw b e z) -> Pat b a -> Rw b e z
+patCataRw f = jotCataRw f . unPat
+
+patCataRwT :: (Monad m) => (PatF b a (RwT b e m z) -> RwT b e m z) -> Pat b a -> RwT b e m z
+patCataRwT f = jotCataRwT f . unPat
+
+patNatRw :: (forall x. PatF b x (UnPat b x) -> Rw b e (UnPat b x)) -> Pat b a -> Rw b e (Pat b a)
+patNatRw f = patNatRwT (bitraverse pure id >=> f)
+
+patNatRwT
+  :: (Monad m) => (forall x. PatF b x (RwT b e m (UnPat b x)) -> RwT b e m (UnPat b x)) -> Pat b a -> RwT b e m (Pat b a)
+patNatRwT f = goP
+ where
+  goP = fmap Pat . goJ . unPat
+  goJ (JotP b pf) = pushRw b (goG pf >>= f)
+  goG = \case
+    PatPure a -> pure (PatPure a)
+    PatSilence -> pure PatSilence
+    PatShort s -> pure (PatShort s)
+    PatGroup gs -> pure (PatGroup (fmap goJ gs))
+    PatMod (Mod r m) -> fmap (PatMod . Mod (goJ r)) (goM m)
+    PatPoly (Poly rs mi) -> pure (PatPoly (Poly (fmap goJ rs) mi))
+  goM = \case
+    ModTypeDegrade d -> pure (ModTypeDegrade d)
+    ModTypeEuclid e -> pure (ModTypeEuclid e)
+    ModTypeSpeed s -> fmap ModTypeSpeed (goS s)
+    ModTypeElongate e -> pure (ModTypeElongate e)
+    ModTypeReplicate r -> pure (ModTypeReplicate r)
+  goS (Speed d p) = fmap (Speed d) (patNatRwT f p)
+
+runPatRw :: (Pat b a -> Rw b e z) -> Pat b a -> Either (AnnoErr b e) z
+runPatRw g p@(Pat (JotP b _)) = runRw (g p) b
+
+runPatRwT :: (Pat b a -> RwT b e m z) -> Pat b a -> m (Either (AnnoErr b e) z)
+runPatRwT g p@(Pat (JotP b _)) = runRwT (g p) b
+
+patMapInfo :: (b -> c) -> Pat b a -> Pat c a
+patMapInfo f = goP
  where
-  go bs pf = runReaderT (f (fmap (push bs) pf)) bs
-  push bs (JotP b pf) = go (bs NESeq.|> b) pf
-
--- Targets both positions filled by patterns
-newtype TapF a s r = TapF {unTapF :: A.PatF s a r}
-  deriving stock (Show)
-  deriving newtype (Eq, Ord, Functor, Foldable)
-
-instance Bifunctor (TapF a) where
-  bimap f g = TapF . go . unTapF
-   where
-    go = \case
-      A.PatPure a -> A.PatPure a
-      A.PatSilence -> A.PatSilence
-      A.PatShort s -> A.PatShort s
-      A.PatGroup gs -> A.PatGroup (fmap g gs)
-      A.PatMod m -> A.PatMod (bimap f g m)
-      A.PatPoly p -> A.PatPoly (fmap g p)
-
-instance Bifoldable (TapF a) where
-  bifoldr f g z0 (TapF p0) = go z0 p0
-   where
-    go z = \case
-      A.PatPure _ -> z
-      A.PatSilence -> z
-      A.PatShort _ -> z
-      A.PatGroup gs -> foldr g z gs
-      A.PatMod m -> bifoldr f g z m
-      A.PatPoly p -> foldr g z p
-
-instance Bitraversable (TapF a) where
-  bitraverse f g = fmap TapF . go . unTapF
-   where
-    go = \case
-      A.PatPure a -> pure (A.PatPure a)
-      A.PatSilence -> pure A.PatSilence
-      A.PatShort s -> pure (A.PatShort s)
-      A.PatGroup gs -> fmap A.PatGroup (traverse g gs)
-      A.PatMod m -> fmap A.PatMod (bitraverse f g m)
-      A.PatPoly p -> fmap A.PatPoly (traverse g p)
-
-type PatOvh b = forall a. PatRw b a (A.UnPat b a)
-
-overhaul :: PatOvh b -> A.UnPat b a -> A.UnPat b a
-overhaul f = runIdentity . overhaulM (f . fmap runIdentity)
-
-type PatOvhM b m = forall a. PatRwM b a m (A.UnPat b a)
-
--- Rewrite all pattern constructors *polymorphically* (includes embedded patterns)
-overhaulM :: (Monad m) => PatOvhM b m -> A.UnPat b a -> m (A.UnPat b a)
-overhaulM f (JotP b0 pf0) = goOvhM f (NESeq.singleton b0) pf0
-
-goOvhM :: (Monad m) => PatOvhM b m -> NESeq b -> A.PatX b a (A.UnPat b a) -> m (A.UnPat b a)
-goOvhM f bs pf = do
-  pf' <- fmap unTapF (bitraverse (fmap A.Pat . pushOvhM f bs . A.unPat) (pure . pushOvhM f bs) (TapF pf))
-  runReaderT (f pf') bs
-
-pushOvhM :: (Monad m) => PatOvhM b m -> NESeq b -> A.UnPat b a -> m (A.UnPat b a)
-pushOvhM f bs (JotP b pf) = goOvhM f (bs NESeq.|> b) pf
+  goP = Pat . goJ . unPat
+  goJ (JotP b pf) = JotP (f b) (goG (fmap goJ pf))
+  goG = \case
+    PatPure a -> PatPure a
+    PatSilence -> PatSilence
+    PatShort s -> PatShort s
+    PatGroup gs -> PatGroup gs
+    PatMod (Mod r m) -> PatMod (Mod r (goM m))
+    PatPoly (Poly rs mi) -> PatPoly (Poly rs mi)
+  goM = \case
+    ModTypeDegrade d -> ModTypeDegrade d
+    ModTypeEuclid e -> ModTypeEuclid e
+    ModTypeSpeed s -> ModTypeSpeed (goS s)
+    ModTypeElongate e -> ModTypeElongate e
+    ModTypeReplicate r -> ModTypeReplicate r
+  goS (Speed d p) = Speed d (patMapInfo f p)
diff --git a/minipat/test/Main.hs b/minipat/test/Main.hs
index 719ddf1..767581e 100644
--- a/minipat/test/Main.hs
+++ b/minipat/test/Main.hs
@@ -9,7 +9,6 @@ where
 import Bowtie (pattern JotP)
 import Control.Exception (throwIO)
 import Control.Monad (void)
-import Data.Bifunctor (first)
 import Data.Either (isLeft, isRight)
 import Data.Maybe (fromMaybe)
 import Data.Ratio ((%))
@@ -21,6 +20,7 @@ import Minipat.Interp (interpPat)
 import Minipat.Norm (normPat)
 import Minipat.Parser (P, ParseErr, factorP, identP, identPatP, selectIdentPatP)
 import Minipat.Print (prettyShow)
+import Minipat.Rewrite (patMapInfo)
 import Minipat.Stream (Ev (..), streamRun)
 import Minipat.Time (Arc (..), CycleTime (..), Span (..))
 import Prettyprinter qualified as P
@@ -70,17 +70,17 @@ type TPat = Pat ()
 
 type UnTPat = UnPat ()
 
-mkTPat :: PatF (TPat Factor) a (UnPat () a) -> TPat a
+mkTPat :: PatF () a (UnPat () a) -> TPat a
 mkTPat = Pat . JotP ()
 
-mkUnTPat :: PatF (TPat Factor) a (UnPat () a) -> UnTPat a
+mkUnTPat :: PatF () a (UnPat () a) -> UnTPat a
 mkUnTPat = unPat . mkTPat
 
 tpatP :: P (TPat Ident)
-tpatP = fmap (first (const ())) identPatP
+tpatP = fmap (patMapInfo (const ())) identPatP
 
 tspatP :: P (TPat (Select Integer Ident))
-tspatP = fmap (first (const ())) (selectIdentPatP intP)
+tspatP = fmap (patMapInfo (const ())) (selectIdentPatP intP)
 
 xPatIdent, yPatIdent :: UnTPat Ident
 xPatIdent = mkUnTPat (PatPure (Ident "x"))