diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,7 +1,16 @@
-### 0.2.0.2 -- 2024-03-15
+### 0.3.0.0 -- 2025-04-19
 
+* Breaking changes—`Internal` modules only
+  * Changes to internal representations
+* Performance improvements
+  * Fix a pessimization due to boxity analysis on GHC >= 9.4. Improves parsing
+    time by up to 23%.
+
+### 0.2.0.2 -- 2025-03-15
+
 * Compatibility with [MicroHs](https://github.com/augustss/MicroHs)
 * Performance improvements
+  * Avoid some closure allocations, improving parsing time by up to 10%.
 * Fix `compileBounded`'s behavior on negative bounds
 
 ### 0.2.0.1 -- 2024-12-25
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -66,7 +66,7 @@
           , fragment = Just "parser-regex" })
 ```
 
-### More parsing
+### Parsing
 
 Parsing is straightforward, even for tasks which may be impractical with
 submatch extraction typically offered by regex libraries.
@@ -121,27 +121,44 @@
 
 ### Parse any sequence
 
-Regexes are not restricted to parsing text. For example, one may parse vectors
-from the [vector](https://hackage.haskell.org/package/vector) library, because
-why not.
+Parsing is not restricted to text. One can parse a
+[`vector`](https://hackage.haskell.org/package/vector), a
+[`conduit`](https://hackage.haskell.org/package/conduit), or any other sequence
+one might have.
 
 ```hs
-import Regex.Base (Parser)
 import qualified Regex.Base as R
-import qualified Data.Vector.Generic as VG
+import qualified Data.Vector.Generic as VG -- from vector
+import qualified Conduit as C -- from conduit
 
-parseVector :: VG.Vector v c => Parser c a -> v c -> Maybe a
+parseVector :: VG.Vector v c => R.Parser c a -> v c -> Maybe a
 parseVector = R.parseFoldr VG.foldr
+
+parseConduit :: Monad m => R.Parser c a -> C.ConduitT c x m (Maybe a)
+parseConduit p = R.parseNext p C.await <* C.sinkNull
 ```
 ```hs
 >>> import Control.Applicative (many)
->>> import qualified Data.Vector as V
 >>> import qualified Regex.Base as R
+>>> :{
+let evenOddP :: R.Parser Int [(Int, Int)]
+    evenOddP = R.compile $ many ((,) <$> R.satisfy even <*> R.satisfy odd)
+:}
 >>>
->>> let p = R.compile $ many ((,) <$> R.satisfy even <*> R.satisfy odd)
->>> let v = V.fromList [0..5] :: V.Vector Int
->>> parseVector p v
-Just [(0,1),(2,3),(4,5)]
+>>> import qualified Data.Vector as V
+>>> parseVector evenOddP (V.fromList [6,1,2,5,4,3])
+Just [(6,1),(2,5),(4,3)]
+>>> parseVector evenOddP (V.fromList [4,3,1,2])
+Nothing
+>>>
+>>> import Conduit ((.|))
+>>> import qualified Conduit as C
+>>> C.runConduit $ C.yieldMany [0..3] .| C.iterMC print .| parseConduit evenOddP
+0
+1
+2
+3
+Just [(0,1),(2,3)]
 ```
 
 ## Documentation
diff --git a/parser-regex.cabal b/parser-regex.cabal
--- a/parser-regex.cabal
+++ b/parser-regex.cabal
@@ -1,6 +1,6 @@
 cabal-version:      2.4
 name:               parser-regex
-version:            0.2.0.2
+version:            0.3.0.0
 synopsis:           Regex based parsers
 homepage:           https://github.com/meooow25/parser-regex
 bug-reports:        https://github.com/meooow25/parser-regex/issues
@@ -52,6 +52,7 @@
         Regex.Internal.Debug
         Regex.Internal.Parser
         Regex.Internal.Regex
+        Regex.Internal.Solo
         Regex.Internal.Text
         Regex.Internal.Unique
 
diff --git a/src/Regex/Internal/Debug.hs b/src/Regex/Internal/Debug.hs
--- a/src/Regex/Internal/Debug.hs
+++ b/src/Regex/Internal/Debug.hs
@@ -22,7 +22,7 @@
 import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IM
 
-import Regex.Internal.Regex (RE(..), Strictness(..), Greediness(..))
+import Regex.Internal.Regex (RE(..))
 import Regex.Internal.Parser (Node(..), Parser(..))
 import Regex.Internal.Unique (Unique(..))
 import qualified Regex.Internal.CharSet as CS
@@ -44,15 +44,15 @@
     go :: forall b. RE c b -> M Id
     go re = case re of
       RToken t -> new $ labelToken "RToken" t ma
-      RFmap st _ re1 ->
-        withNew (str "RFmap" <+> dispsSt st) $ \i ->
+      RFmap _ re1 ->
+        withNew (str "RFmap") $ \i ->
           go re1 >>= writeEdge i
       RFmap_ _ re1 ->
         withNew (str "RFmap_") $ \i ->
           go re1 >>= writeEdge i
       RPure _ -> new (str "RPure")
-      RLiftA2 st _ re1 re2 ->
-        withNew (str "RLiftA2" <+> dispsSt st) $ \i -> do
+      RLiftA2 _ re1 re2 ->
+        withNew (str "RLiftA2") $ \i -> do
           go re1 >>= writeEdge i
           go re2 >>= writeEdge i
       REmpty -> new (str "REmpty")
@@ -60,9 +60,12 @@
         withNew (str "RAlt") $ \i -> do
           go re1 >>= writeEdge i
           go re2 >>= writeEdge i
-      RFold st gr _ _ re1 ->
-        withNew (str "RFold" <+> dispsSt st <+> dispsGr gr) $ \i ->
+      RFoldGr _ _ re1 ->
+        withNew (str "RFoldGr") $ \i ->
           go re1 >>= writeEdge i
+      RFoldMn _ _ re1 ->
+        withNew (str "RFoldMn") $ \i ->
+          go re1 >>= writeEdge i
       RMany _ _ _ _ re1 ->
         withNew (str "RMany") $ \i ->
           go re1 >>= writeEdge i
@@ -84,8 +87,8 @@
     go :: forall b. Parser c b -> M Id
     go p = case p of
       PToken t -> new $ labelToken "PToken" t ma
-      PFmap st _ re1 ->
-        withNew (str "PFmap" <+> dispsSt st) $ \i ->
+      PFmap _ re1 ->
+        withNew (str "PFmap") $ \i ->
           go re1 >>= writeEdge i
       PFmap_ node ->
         withNew (str "PFmap_") $ \i -> do
@@ -94,8 +97,8 @@
           writeLn (str "}")
           writeEdge i j
       PPure _ -> new (str "PPure")
-      PLiftA2 st _ re1 re2 ->
-        withNew (str "PLiftA2" <+> dispsSt st) $ \i -> do
+      PLiftA2 _ re1 re2 ->
+        withNew (str "PLiftA2") $ \i -> do
           go re1 >>= writeEdge i
           go re2 >>= writeEdge i
       PEmpty -> new (str "PEmpty")
@@ -107,11 +110,11 @@
       PMany _ _ _ _ _ re1 ->
         withNew (str "PMany") $ \i ->
           go re1 >>= writeEdge i
-      PFoldGr _ st _ _ re1 ->
-        withNew (str "PFoldGr" <+> dispsSt st) $ \i ->
+      PFoldGr _ _ _ re1 ->
+        withNew (str "PFoldGr") $ \i ->
           go re1 >>= writeEdge i
-      PFoldMn _ st _ _ re1 ->
-        withNew (str "PFoldMn" <+> dispsSt st) $ \i ->
+      PFoldMn _ _ _ re1 ->
+        withNew (str "PFoldMn") $ \i ->
           go re1 >>= writeEdge i
 
     goNode :: forall b. Node c b -> StateT (IntMap Id) M Id
@@ -157,16 +160,6 @@
 
 instance Monoid Str where
   mempty = Str id
-
-dispsSt :: Strictness -> Str
-dispsSt st = case st of
-  Strict -> str "S"
-  NonStrict -> str "NS"
-
-dispsGr :: Greediness -> Str
-dispsGr gr = case gr of
-  Greedy -> str "G"
-  Minimal -> str "M"
 
 labelToken :: String -> (c -> Maybe a) -> Maybe ([c], [c] -> String) -> Str
 labelToken node t = maybe
diff --git a/src/Regex/Internal/List.hs b/src/Regex/Internal/List.hs
--- a/src/Regex/Internal/List.hs
+++ b/src/Regex/Internal/List.hs
@@ -50,10 +50,11 @@
 import qualified Data.CharSet as CS
 import Regex.Internal.Parser (Parser)
 import qualified Regex.Internal.Parser as P
-import Regex.Internal.Regex (RE(..), Greediness(..), Strictness(..))
+import Regex.Internal.Regex (RE(..))
 import qualified Regex.Internal.Regex as R
 import qualified Regex.Internal.Num as RNum
 import qualified Regex.Internal.Generated.CaseFold as CF
+import Regex.Internal.Solo (Solo, mkSolo, matchSolo)
 
 ------------------------
 -- REs and combinators
@@ -231,30 +232,28 @@
 
 toMatch_ :: RE c b -> RE c (DList c)
 toMatch_ re = case re of
-  RToken t -> RToken (\c -> singletonD c <$ t c)
-  RFmap _ _ re1 -> toMatch_ re1
+  RToken t -> R.token (\c -> singletonD c <$ t c)
+  RFmap _ re1 -> toMatch_ re1
   RFmap_ _ re1 -> toMatch_ re1
-  RPure _ -> RPure mempty
-  RLiftA2 _ _ re1 re2 -> RLiftA2 Strict (<>) (toMatch_ re1) (toMatch_ re2)
-  REmpty -> REmpty
-  RAlt re1 re2 -> RAlt (toMatch_ re1) (toMatch_ re2)
-  RMany _ _ _ _ re1 -> RFold Strict Greedy (<>) mempty (toMatch_ re1)
-  RFold _ gr _ _ re1 -> RFold Strict gr (<>) mempty (toMatch_ re1)
+  RPure _ -> pure mempty
+  RLiftA2 _ re1 re2 -> R.liftA2' (<>) (toMatch_ re1) (toMatch_ re2)
+  REmpty -> Ap.empty
+  RAlt re1 re2 -> toMatch_ re1 <|> toMatch_ re2
+  RFoldGr _ _ re1 -> R.foldlMany' (<>) mempty (toMatch_ re1)
+  RFoldMn _ _ re1 -> R.foldlManyMin' (<>) mempty (toMatch_ re1)
+  RMany _ _ _ _ re1 -> R.foldlMany' (<>) mempty (toMatch_ re1)
 
 data WithMatch c a = WM !(DList c) a
 
-instance Functor (WithMatch c) where
-  fmap f (WM t x) = WM t (f x)
-
-fmapWM' :: (a -> b) -> WithMatch c a -> WithMatch c b
-fmapWM' f (WM t x) = WM t $! f x
+fmapWM :: (a -> Solo b) -> WithMatch c a -> WithMatch c b
+fmapWM f (WM t x) = matchSolo (f x) (WM t)
 
-instance Applicative (WithMatch c) where
-  pure = WM mempty
-  liftA2 f (WM t1 x) (WM t2 y) = WM (t1 <> t2) (f x y)
+pureWM :: a -> WithMatch c a
+pureWM = WM mempty
 
-liftA2WM' :: (a1 -> a2 -> b) -> WithMatch c a1 -> WithMatch c a2 -> WithMatch c b
-liftA2WM' f (WM t1 x) (WM t2 y) = WM (t1 <> t2) $! f x y
+liftA2WM
+  :: (a1 -> a2 -> Solo b) -> WithMatch c a1 -> WithMatch c a2 -> WithMatch c b
+liftA2WM f (WM t1 x) (WM t2 y) = matchSolo (f x y) (WM (t1 <> t2))
 
 -- | Rebuild the @RE@ to include the matched section of the list alongside the
 -- result.
@@ -263,28 +262,22 @@
   where
     go :: RE c b -> RE c (WithMatch c b)
     go re = case re of
-      RToken t -> RToken (\c -> WM (singletonD c) <$> t c)
-      RFmap st f re1 ->
-        let g = case st of
-              Strict -> fmapWM' f
-              NonStrict -> fmap f
-        in RFmap Strict g (go re1)
-      RFmap_ b re1 -> RFmap Strict (flip WM b) (toMatch_ re1)
-      RPure b -> RPure (pure b)
-      RLiftA2 st f re1 re2 ->
-        let g = case st of
-              Strict -> liftA2WM' f
-              NonStrict -> Ap.liftA2 f
-        in RLiftA2 Strict g (go re1) (go re2)
-      REmpty -> REmpty
-      RAlt re1 re2 -> RAlt (go re1) (go re2)
+      RToken t -> R.token (\c -> WM (singletonD c) <$> t c)
+      RFmap f re1 -> R.fmap' (fmapWM f) (go re1)
+      RFmap_ b re1 -> R.fmap' (flip WM b) (toMatch_ re1)
+      RPure b -> pure (pureWM b)
+      RLiftA2 f re1 re2 -> R.liftA2' (liftA2WM f) (go re1) (go re2)
+      REmpty -> Ap.empty
+      RAlt re1 re2 -> go re1 <|> go re2
+      RFoldGr f z re1 -> R.foldlMany' (liftA2WM f) (pureWM z) (go re1)
+      RFoldMn f z re1 -> R.foldlManyMin' (liftA2WM f) (pureWM z) (go re1)
       RMany f1 f2 f z re1 ->
-        RMany (fmapWM' f1) (fmapWM' f2) (liftA2WM' f) (pure z) (go re1)
-      RFold st gr f z re1 ->
-        let g = case st of
-              Strict -> liftA2WM' f
-              NonStrict -> Ap.liftA2 f
-        in RFold Strict gr g (pure z) (go re1)
+        RMany
+          (\x -> mkSolo $! fmapWM f1 x)
+          (\x -> mkSolo $! fmapWM f2 x)
+          (\x y -> mkSolo $! liftA2WM f x y)
+          (pureWM z)
+          (go re1)
 
 ----------
 -- Parse
diff --git a/src/Regex/Internal/Parser.hs b/src/Regex/Internal/Parser.hs
--- a/src/Regex/Internal/Parser.hs
+++ b/src/Regex/Internal/Parser.hs
@@ -4,6 +4,10 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_HADDOCK not-home #-}
+#if __GLASGOW_HASKELL__ >= 904
+-- See Note [-fdmd-unbox-width]
+{-# OPTIONS_GHC -fdmd-unbox-width=4 #-}
+#endif
 
 -- | This is an internal module. You probably don't need to import this.
 --
@@ -30,7 +34,7 @@
 import Control.Applicative ((<|>), empty)
 import qualified Control.Applicative as Ap
 import Control.Monad.Trans.State.Strict
-  ( State, StateT, evalState, evalStateT, execState, gets, modify', state)
+  ( State, StateT, evalState, evalStateT, gets, modify', state)
 import Control.Monad.Fix (mfix)
 import Data.Maybe (isJust)
 import qualified Data.Foldable as F
@@ -41,7 +45,8 @@
 import qualified GHC.Exts as X
 #endif
 
-import Regex.Internal.Regex (RE(..), Strictness(..), Greediness(..))
+import Regex.Internal.Regex (RE(..))
+import Regex.Internal.Solo (Solo, matchSolo)
 import Regex.Internal.Unique (Unique(..), UniqueSet)
 import qualified Regex.Internal.Unique as U
 
@@ -52,15 +57,15 @@
 -- | A parser compiled from a @'RE' c a@.
 data Parser c a where
   PToken  :: !(c -> Maybe a) -> Parser c a
-  PFmap   :: !Strictness -> !(a1 -> a) -> !(Parser c a1) -> Parser c a
+  PFmap   :: !(a1 -> Solo a) -> !(Parser c a1) -> Parser c a
   PFmap_  :: !(Node c a) -> Parser c a
   PPure   :: a -> Parser c a
-  PLiftA2 :: !Strictness -> !(a1 -> a2 -> a) -> !(Parser c a1) -> !(Parser c a2) -> Parser c a
+  PLiftA2 :: !(a1 -> a2 -> Solo a) -> !(Parser c a1) -> !(Parser c a2) -> Parser c a
   PEmpty  :: Parser c a
   PAlt    :: {-# UNPACK #-} !Unique -> !(Parser c a) -> !(Parser c a) -> {-# UNPACK #-} !(SmallArray (Parser c a)) -> Parser c a
-  PFoldGr :: {-# UNPACK #-} !Unique -> !Strictness -> !(a -> a1 -> a) -> a -> !(Parser c a1) -> Parser c a
-  PFoldMn :: {-# UNPACK #-} !Unique -> !Strictness -> !(a -> a1 -> a) -> a -> !(Parser c a1) -> Parser c a
-  PMany   :: {-# UNPACK #-} !Unique -> !(a1 -> a) -> !(a2 -> a) -> !(a2 -> a1 -> a2) -> !a2 -> !(Parser c a1) -> Parser c a
+  PFoldGr :: {-# UNPACK #-} !Unique -> !(a -> a1 -> Solo a) -> a -> !(Parser c a1) -> Parser c a
+  PFoldMn :: {-# UNPACK #-} !Unique -> !(a -> a1 -> Solo a) -> a -> !(Parser c a1) -> Parser c a
+  PMany   :: {-# UNPACK #-} !Unique -> !(a1 -> Solo a) -> !(a2 -> Solo a) -> !(a2 -> a1 -> Solo a2) -> !a2 -> !(Parser c a1) -> Parser c a
 
 -- | A node in the NFA. Used for recognition.
 data Node c a where
@@ -91,11 +96,11 @@
 compileToParser :: RE c a -> State Unique (Parser c a)
 compileToParser re = case re of
   RToken t -> pure $ PToken t
-  RFmap st f re1 -> PFmap st f <$> compileToParser re1
+  RFmap f re1 -> PFmap f <$> compileToParser re1
   RFmap_ a re1 -> PFmap_ <$> compileToNode a re1
   RPure a -> pure $ PPure a
-  RLiftA2 st f re1 re2 ->
-    Ap.liftA2 (PLiftA2 st f) (compileToParser re1) (compileToParser re2)
+  RLiftA2 f re1 re2 ->
+    Ap.liftA2 (PLiftA2 f) (compileToParser re1) (compileToParser re2)
   REmpty -> pure PEmpty
   RAlt re01 re02 -> do
     u <- nxtU
@@ -104,12 +109,14 @@
     p2 <- compileToParser re2
     ps <- T.traverse compileToParser res
     pure $ PAlt u p1 p2 (smallArrayFromList ps)
-  RFold st gr f z re1 -> do
+  RFoldGr f z re1 -> do
     u <- nxtU
     _localU <- nxtU
-    case gr of
-      Greedy -> PFoldGr u st f z <$> compileToParser re1
-      Minimal -> PFoldMn u st f z <$> compileToParser re1
+    PFoldGr u f z <$> compileToParser re1
+  RFoldMn f z re1 -> do
+    u <- nxtU
+    _localU <- nxtU
+    PFoldMn u f z <$> compileToParser re1
   RMany f1 f2 f z re1 -> do
     u <- nxtU
     _localU <- nxtU
@@ -121,10 +128,10 @@
     go :: forall a2. RE c a2 -> Node c a -> State Unique (Node c a)
     go re nxt = case re of
       RToken t -> pure $ NToken t nxt
-      RFmap _ _ re1 -> go re1 nxt
+      RFmap _ re1 -> go re1 nxt
       RFmap_ _ re1 -> go re1 nxt
       RPure _ -> pure nxt
-      RLiftA2 _ _ re1 re2 -> go re2 nxt >>= go re1
+      RLiftA2 _ re1 re2 -> go re2 nxt >>= go re1
       REmpty -> pure NEmpty
       RAlt re01 re02 -> do
         u <- nxtU
@@ -134,17 +141,17 @@
         n2 <- go re2 nxt1
         ns <- T.traverse (flip go nxt1) res
         pure $ NAlt n1 n2 (smallArrayFromList ns)
-      RFold _ gr _ _ re1 -> goMany gr re1 nxt
-      RMany _ _ _ _ re1 -> goMany Greedy re1 nxt
-    goMany :: forall a2.
-              Greediness -> RE c a2 -> Node c a -> State Unique (Node c a)
-    goMany gr re1 nxt = do
+      RFoldGr _ _ re1 -> goMany True re1 nxt
+      RFoldMn _ _ re1 -> goMany False re1 nxt
+      RMany _ _ _ _ re1 -> goMany True re1 nxt
+    goMany :: forall a2. Bool -> RE c a2 -> Node c a -> State Unique (Node c a)
+    goMany greedy re1 nxt = do
       u <- nxtU
       mfix $ \n -> do
         ndown <- go re1 n
-        case gr of
-           Greedy -> pure $ NGuard u (NAlt ndown nxt emptySmallArray)
-           Minimal -> pure $ NGuard u (NAlt nxt ndown emptySmallArray)
+        if greedy
+        then pure $ NGuard u (NAlt ndown nxt emptySmallArray)
+        else pure $ NGuard u (NAlt nxt ndown emptySmallArray)
 
 gatherAlts :: RE c a -> RE c a -> (RE c a, RE c a, [RE c a])
 gatherAlts re01 re02 = case go re01 (go re02 []) of
@@ -180,14 +187,15 @@
     go :: RE c a1 -> StateT Int Maybe ()
     go re = case re of
         RToken _ -> inc
-        RFmap _ _ re1 -> inc *> go re1
+        RFmap _ re1 -> inc *> go re1
         RFmap_ _ re1 -> inc *> go re1
         RPure _ -> inc
-        RLiftA2 _ _ re1 re2 -> inc *> go re1 *> go re2
+        RLiftA2 _ re1 re2 -> inc *> go re1 *> go re2
         REmpty -> inc
         RAlt re1 re2 -> inc *> go re1 *> go re2
+        RFoldGr _ _ re1 -> inc *> go re1
+        RFoldMn _ _ re1 -> inc *> go re1
         RMany _ _ _ _ re1 -> inc *> go re1
-        RFold _ _ _ _ re1 -> inc *> go re1
     inc = do
       ok <- gets (< lim)
       if ok
@@ -200,14 +208,14 @@
 
 data Cont c b a where
   CTop     :: Cont c a a
-  CFmap    :: !Strictness -> !(b -> a1) -> !(Cont c a1 a) -> Cont c b a
+  CFmap    :: !(b -> Solo a1) -> !(Cont c a1 a) -> Cont c b a
   CFmap_   :: !(Node c a1) -> !(Cont c a1 a) -> Cont c b a
-  CLiftA2A :: !Strictness -> !(b -> a2 -> a3) -> !(Parser c a2) -> !(Cont c a3 a) -> Cont c b a
-  CLiftA2B :: !Strictness -> !(a1 -> b -> a3) -> a1 -> !(Cont c a3 a) -> Cont c b a
+  CLiftA2A :: !(b -> a2 -> Solo a3) -> !(Parser c a2) -> !(Cont c a3 a) -> Cont c b a
+  CLiftA2B :: !(a1 -> b -> Solo a3) -> a1 -> !(Cont c a3 a) -> Cont c b a
   CAlt     :: {-# UNPACK #-} !Unique -> !(Cont c b a) -> Cont c b a
-  CFoldGr  :: {-# UNPACK #-} !Unique -> !Strictness -> !(Parser c b) -> !(a1 -> b -> a1) -> a1 -> !(Cont c a1 a) -> Cont c b a
-  CFoldMn  :: {-# UNPACK #-} !Unique -> !Strictness -> !(Parser c b) -> !(a1 -> b -> a1) -> a1 -> !(Cont c a1 a) -> Cont c b a
-  CMany    :: {-# UNPACK #-} !Unique -> !(Parser c b) -> !(b -> a2) -> !(a1 -> a2) -> !(a1 -> b -> a1) -> !a1 -> !(Cont c a2 a) -> Cont c b a
+  CFoldGr  :: {-# UNPACK #-} !Unique -> !(Parser c b) -> !(a1 -> b -> Solo a1) -> a1 -> !(Cont c a1 a) -> Cont c b a
+  CFoldMn  :: {-# UNPACK #-} !Unique -> !(Parser c b) -> !(a1 -> b -> Solo a1) -> a1 -> !(Cont c a1 a) -> Cont c b a
+  CMany    :: {-# UNPACK #-} !Unique -> !(Parser c b) -> !(b -> Solo a2) -> !(a1 -> Solo a2) -> !(a1 -> b -> Solo a1) -> !a1 -> !(Cont c a2 a) -> Cont c b a
 
 data NeedCList c a where
   NeedCCons :: !(c -> Maybe b) -> !(Cont c b a) -> !(NeedCList c a) -> NeedCList c a
@@ -222,59 +230,72 @@
 stepStateZero :: StepState c a
 stepStateZero = StepState U.empty NeedCNil Nothing
 
--- Note: Ideally we would have
--- down :: Parser c b -> Cont c b a -> State (StepState c a) ()
--- and similar downNode and up, but GHC is unable to optimize it to be
--- equivalent to the current code.
---
--- Using State is pretty convenient though, so it is used in branches. This
--- seems to get optimized well enough.
+sMember :: Unique -> StepState c a -> Bool
+sMember u pt = U.member u (sSet pt)
 
-sMember :: Unique -> State (StepState c a) Bool
-sMember u = gets $ \pt -> U.member u (sSet pt)
+sInsert :: Unique -> StepState c a -> StepState c a
+sInsert u pt = pt { sSet = U.insert u (sSet pt) }
 
-sInsert :: Unique -> State (StepState c a) ()
-sInsert u = modify' $ \pt -> pt { sSet = U.insert u (sSet pt) }
+-- Note [-fdmd-unbox-width]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~
+-- GHC's worker/wrapper transformation is able to eliminate the StepState and
+-- generate a worker for `down` with signature
+--
+-- $wdown
+--   :: Parser c b -> Cont c b a
+--   -> Int# -> IntSet -> NeedCList c a -> Maybe a
+--   -> (# Int#, IntSet, NeedCList c a, Maybe a #)
+--
+-- and likewise for `downNode` and `up`.
+--
+-- This is great, but unfortunately boxity analysis gets in the way. Boxity
+-- analysis prevents unboxing of types with more than -fdmd-unbox-width fields,
+-- default 3 as of today. So we set it to the number of fields in StepState,
+-- i.e. 4, with an OPTIONS_GHC pragma.
 
 down :: Parser c b -> Cont c b a -> StepState c a -> StepState c a
 down p !ct !pt = case p of
   PToken t -> pt { sNeed = NeedCCons t ct (sNeed pt) }
-  PFmap st f p1 -> down p1 (CFmap st f ct) pt
+  PFmap f p1 -> down p1 (CFmap f ct) pt
   PFmap_ n -> downNode n ct pt
   PPure b -> up b ct pt
-  PLiftA2 st f p1 p2 -> down p1 (CLiftA2A st f p2 ct) pt
+  PLiftA2 f p1 p2 -> down p1 (CLiftA2A f p2 ct) pt
   PEmpty -> pt
   PAlt u p1 p2 ps ->
     let ct1 = CAlt u ct
     in F.foldl' (\pt' p' -> down p' ct1 pt') (down p2 ct1 (down p1 ct1 pt)) ps
-  PFoldGr u st f z p1 -> flip execState pt $
-    unlessM (sMember u) $ do
-      sInsert (localU u)
-      modify' $ down p1 (CFoldGr u st p1 f z ct)
-      unlessM (sMember u) $ do
-        sInsert u
-        modify' $ up z ct
-  PFoldMn u st f z p1 -> flip execState pt $
-    unlessM (sMember u) $ do
-      unlessM (sMember (localU u)) $ do
-        modify' $ up z ct
-      sInsert u
-      modify' $ down p1 (CFoldMn u st p1 f z ct)
-  PMany u f1 f2 f z p1 -> flip execState pt $
-    unlessM (sMember u) $ do
-      sInsert (localU u)
-      modify' $ down p1 (CMany u p1 f1 f2 f z ct)
-      unlessM (sMember u) $ do
-        sInsert u
-        let !x = f2 z
-        modify' $ up x ct
+  PFoldGr u f z p1 ->
+    if sMember u pt
+    then pt
+    else
+      let pt1 = down p1 (CFoldGr u p1 f z ct) (sInsert (localU u) pt)
+      in if sMember u pt1
+         then pt1
+         else up z ct (sInsert u pt1)
+  PFoldMn u f z p1 ->
+    if sMember u pt
+    then pt
+    else
+      let pt1 = if sMember (localU u) pt
+                then pt
+                else up z ct pt
+      in down p1 (CFoldMn u p1 f z ct) (sInsert u pt1)
+  PMany u f1 f2 f z p1 ->
+    if sMember u pt
+    then pt
+    else
+      let pt1 = down p1 (CMany u p1 f1 f2 f z ct) (sInsert (localU u) pt)
+      in if sMember u pt1
+         then pt1
+         else matchSolo (f2 z) $ \x -> up x ct (sInsert u pt1)
 
 downNode :: Node c b -> Cont c b a -> StepState c a -> StepState c a
 downNode n !ct !pt = case n of
   NAccept b -> up b ct pt
-  NGuard u n1
-    | U.member u (sSet pt) -> pt
-    | otherwise -> downNode n1 ct (pt { sSet = U.insert u (sSet pt) })
+  NGuard u n1 ->
+    if sMember u pt
+    then pt
+    else downNode n1 ct (sInsert u pt)
   NToken t nxt ->
     pt { sNeed = NeedCCons t (CFmap_ nxt ct) (sNeed pt) }
   NEmpty -> pt
@@ -287,58 +308,42 @@
 up :: b -> Cont c b a -> StepState c a -> StepState c a
 up b ct !pt = case ct of
   CTop -> pt { sResult = sResult pt <|> Just b }
-  CFmap st f ct1 -> case st of
-    Strict -> let !x = f b in up x ct1 pt
-    NonStrict -> up (f b) ct1 pt
+  CFmap f ct1 -> matchSolo (f b) $ \x -> up x ct1 pt
   CFmap_ n ct1 -> downNode n ct1 pt
-  CLiftA2A st f p1 ct1 -> down p1 (CLiftA2B st f b ct1) pt
-  CLiftA2B st f a ct1 -> case st of
-    Strict -> let !x = f a b in up x ct1 pt
-    NonStrict -> up (f a b) ct1 pt
-  CAlt u ct1 -> flip execState pt $
-    unlessM (sMember u) $ do
-      sInsert u
-      modify' $ up b ct1
-  CFoldGr u st p1 f z ct1 -> flip execState pt $
-    unlessM (sMember u) $ do
-      lc <- sMember (localU u)
-      if lc then do
-        sInsert u
-        modify' $ up z ct1
-      else do
-        let go z1 = do
-              modify' $ down p1 (CFoldGr u st p1 f z1 ct1)
-              sInsert u
-              modify' $ up z1 ct1
-            {-# INLINE go #-}
-        case st of
-          Strict -> let !z1 = f z b in go z1
-          NonStrict -> go (f z b)
-  CFoldMn u st p1 f z ct1 -> flip execState pt $
-    unlessM (sMember u) $ do
-      let go z1 = do
-            sInsert (localU u)
-            modify' $ up z1 ct1
-            unlessM (sMember u) $ do
-              sInsert u
-              modify' $ down p1 (CFoldMn u st p1 f z1 ct1)
-          {-# INLINE go #-}
-      case st of
-        Strict -> let !z1 = f z b in go z1
-        NonStrict -> go (f z b)
-  CMany u p1 f1 f2 f z ct1 -> flip execState pt $
-    unlessM (sMember u) $ do
-      lc <- sMember (localU u)
-      if lc then do
-        sInsert u
-        let !x = f1 b
-        modify' $ up x ct1
-      else do
-        let !z1 = f z b
-        modify' $ down p1 (CMany u p1 f1 f2 f z1 ct1)
-        sInsert u
-        let !x = f2 z1
-        modify' $ up x ct1
+  CLiftA2A f p1 ct1 -> down p1 (CLiftA2B f b ct1) pt
+  CLiftA2B f a ct1 -> matchSolo (f a b) $ \x -> up x ct1 pt
+  CAlt u ct1 ->
+    if sMember u pt
+    then pt
+    else up b ct1 (sInsert u pt)
+  CFoldGr u p1 f z ct1 ->
+    if sMember u pt
+    then pt
+    else
+      if sMember (localU u) pt
+      then up z ct1 (sInsert u pt)
+      else matchSolo (f z b) $ \z1 ->
+        let pt1 = down p1 (CFoldGr u p1 f z1 ct1) pt
+        in up z1 ct1 (sInsert u pt1)
+  CFoldMn u p1 f z ct1 ->
+    if sMember u pt
+    then pt
+    else matchSolo (f z b) $ \z1 ->
+      let pt1 = up z1 ct1 (sInsert (localU u) pt)
+      in if sMember u pt1
+         then pt1
+         else down p1 (CFoldMn u p1 f z1 ct1) (sInsert u pt1)
+  CMany u p1 f1 f2 f z ct1 ->
+    if sMember u pt
+    then pt
+    else
+      if sMember (localU u) pt
+      then matchSolo (f1 b) $ \x -> up x ct1 (sInsert u pt)
+      else
+        matchSolo (f z b) $ \z1 ->
+        matchSolo (f2 z1) $ \x ->
+          let pt1 = down p1 (CMany u p1 f1 f2 f z1 ct1) pt
+          in up x ct1 (sInsert u pt1)
 
 localU :: Unique -> Unique
 localU = Unique . (+1) . unUnique
@@ -395,24 +400,21 @@
 -- ==== __Examples__
 --
 -- @
--- import qualified Data.Vector.Generic as VG -- from vector
---
--- import Regex.Base (Parser)
 -- import qualified Regex.Base as R
+-- import qualified Data.Vector.Generic as VG -- from vector
 --
--- parseVector :: VG.Vector v c => Parser c a -> v c -> Maybe a
+-- parseVector :: VG.Vector v c => R.Parser c a -> v c -> Maybe a
 -- parseVector p v = R.'parseFoldr' VG.foldr p v
 -- @
 --
 -- >>> import Control.Applicative (many)
--- >>> import qualified Data.Vector as V
--- >>> import Regex.Base (Parser)
 -- >>> import qualified Regex.Base as R
+-- >>> import qualified Data.Vector as V
 -- >>>
 -- >>> let p = R.compile $ many ((,) <$> R.satisfy even <*> R.satisfy odd) :: Parser Int [(Int, Int)]
--- >>> parseVector p (V.fromList [0..5])
--- Just [(0,1),(2,3),(4,5)]
--- >>> parseVector p (V.fromList [0,2..6])
+-- >>> parseVector p (V.fromList [6,1,2,5,4,3])
+-- Just [(6,1),(2,5),(4,3)]
+-- >>> parseVector p (V.fromList [4,3,1,2])
 -- Nothing
 --
 parseFoldr :: Foldr f c -> Parser c a -> f -> Maybe a
@@ -436,35 +438,30 @@
 -- ==== __Examples__
 --
 -- @
--- import Conduit (ConduitT, await, sinkNull) -- from conduit
---
--- import Regex.Base (Parser)
 -- import qualified Regex.Base as R
+-- import qualified Conduit as C -- from conduit
 --
--- parseConduit :: Monad m => Parser c a -> ConduitT c x m (Maybe a)
--- parseConduit p = R.'parseNext' p await <* sinkNull
+-- parseConduit :: Monad m => R.Parser c a -> C.ConduitT c x m (Maybe a)
+-- parseConduit p = R.'parseNext' p C.await <* C.sinkNull
 -- @
 --
 -- >>> import Control.Applicative (many)
--- >>> import Conduit ((.|), iterMC, runConduit, yieldMany)
--- >>> import Regex.Base (Parser)
 -- >>> import qualified Regex.Base as R
+-- >>> import Conduit ((.|))
+-- >>> import qualified Conduit as C
 -- >>>
 -- >>> let p = R.compile $ many ((,) <$> R.satisfy even <*> R.satisfy odd) :: Parser Int [(Int, Int)]
--- >>> let printYieldMany xs = yieldMany xs .| iterMC print
--- >>> runConduit $ printYieldMany [0..5] .| parseConduit p
+-- >>> runConduit $ C.yieldMany [0..3] .| C.iterMC print .| parseConduit p
 -- 0
 -- 1
 -- 2
 -- 3
+-- Just [(0,1),(2,3)]
+-- >>> runConduit $ C.yieldMany [4,3,1,2] .| C.iterMC print .| parseConduit p
 -- 4
--- 5
--- Just [(0,1),(2,3),(4,5)]
--- >>> runConduit $ printYieldMany [0,2..6] .| parseConduit p
--- 0
+-- 3
+-- 1
 -- 2
--- 4
--- 6
 -- Nothing
 --
 -- @since 0.2.0.0
@@ -479,15 +476,6 @@
         Nothing -> pure Nothing
         Just ps' -> loop ps'
 {-# INLINE parseNext #-}
-
----------
--- Util
----------
-
-unlessM :: Monad m => m Bool -> m () -> m ()
-unlessM mb mx = do
-  b <- mb
-  if b then pure () else mx
 
 -----------------
 -- Array compat
diff --git a/src/Regex/Internal/Regex.hs b/src/Regex/Internal/Regex.hs
--- a/src/Regex/Internal/Regex.hs
+++ b/src/Regex/Internal/Regex.hs
@@ -6,8 +6,6 @@
 --
 module Regex.Internal.Regex
   ( RE(..)
-  , Strictness(..)
-  , Greediness(..)
   , Many(..)
 
   , token
@@ -53,6 +51,8 @@
 import qualified Data.Foldable as F
 import qualified Data.Traversable as T
 
+import Regex.Internal.Solo (Solo, mkSolo)
+
 ---------------------------------
 -- RE and constructor functions
 ---------------------------------
@@ -90,35 +90,43 @@
 -- /Performance tip/: Prefer the smaller of equivalent regexes, i.e. prefer
 -- @(a \<|> b) \<*> c@ over @(a \<*> c) \<|> (b \<*> c)@.
 --
+
+-- See Note [Functions returning Solo]
 data RE c a where
   RToken  :: !(c -> Maybe a) -> RE c a
-  RFmap   :: !Strictness -> !(a1 -> a) -> !(RE c a1) -> RE c a
+  RFmap   :: !(a1 -> Solo a) -> !(RE c a1) -> RE c a
   RFmap_  :: a -> !(RE c a1) -> RE c a
   RPure   :: a -> RE c a
-  RLiftA2 :: !Strictness -> !(a1 -> a2 -> a) -> !(RE c a1) -> !(RE c a2) -> RE c a
+  RLiftA2 :: !(a1 -> a2 -> Solo a) -> !(RE c a1) -> !(RE c a2) -> RE c a
   REmpty  :: RE c a
   RAlt    :: !(RE c a) -> !(RE c a) -> RE c a
-  RFold   :: !Strictness -> !Greediness -> !(a -> a1 -> a) -> a -> !(RE c a1) -> RE c a
-  RMany   :: !(a1 -> a) -> !(a2 -> a) -> !(a2 -> a1 -> a2) -> !a2 -> !(RE c a1) -> RE c a -- Strict and greedy implicitly
-
-data Strictness = Strict | NonStrict
-data Greediness = Greedy | Minimal
+  RFoldGr :: !(a -> a1 -> Solo a) -> a -> !(RE c a1) -> RE c a
+  RFoldMn :: !(a -> a1 -> Solo a) -> a -> !(RE c a1) -> RE c a
+  RMany   :: !(a1 -> Solo a) -> !(a2 -> Solo a) -> !(a2 -> a1 -> Solo a2) -> !a2 -> !(RE c a1) -> RE c a -- Greedy
 
 instance Functor (RE c) where
-  fmap = RFmap NonStrict
+  fmap f = RFmap (\x -> mkSolo (f x))
+  {-# INLINE fmap #-}
+
   (<$) = RFmap_
 
 fmap' :: (a -> b) -> RE c a -> RE c b
-fmap' = RFmap Strict
+fmap' f = RFmap (\x -> mkSolo $! f x)
+{-# INLINE fmap' #-}
 
 instance Applicative (RE c) where
   pure = RPure
-  liftA2 = RLiftA2 NonStrict
-  re1 *> re2 = Ap.liftA2 (const id) (void re1) re2
-  re1 <* re2 = Ap.liftA2 const re1 (void re2)
 
+  liftA2 f = RLiftA2 (\x y -> mkSolo (f x y))
+  {-# INLINE liftA2 #-}
+
+  re1 *> re2 = RLiftA2 (\_ y -> mkSolo y) (void re1) re2
+
+  re1 <* re2 = RLiftA2 (\x _ -> mkSolo x) re1 (void re2)
+
 liftA2' :: (a1 -> a2 -> b) -> RE c a1 -> RE c a2 -> RE c b
-liftA2' = RLiftA2 Strict
+liftA2' f = RLiftA2 (\x y -> mkSolo $! f x y)
+{-# INLINE liftA2' #-}
 
 instance Alternative (RE c) where
   empty = REmpty
@@ -150,24 +158,33 @@
 --
 -- Also see the section "Looping parsers".
 manyr :: RE c a -> RE c (Many a)
-manyr = RMany Repeat (Finite . reverse) (flip (:)) []
+manyr =
+  RMany
+    (\xs -> mkSolo (Repeat xs))
+    (\xs -> mkSolo (Finite (reverse xs)))
+    (\xs x -> mkSolo (x:xs))
+    []
 
 -- | Parse many occurences of the given @RE@. Biased towards matching more.
 --
 -- Also see the section "Looping parsers".
 foldlMany :: (b -> a -> b) -> b -> RE c a -> RE c b
-foldlMany = RFold NonStrict Greedy
+foldlMany f = RFoldGr (\z x -> mkSolo (f z x))
+{-# INLINE foldlMany #-}
 
 foldlMany' :: (b -> a -> b) -> b -> RE c a -> RE c b
-foldlMany' f !z = RFold Strict Greedy f z
+foldlMany' f !z = RFoldGr (\z' x -> mkSolo $! f z' x) z
+{-# INLINE foldlMany' #-}
 
 -- | Parse many occurences of the given @RE@. Minimal, i.e. biased towards
 -- matching less.
 foldlManyMin :: (b -> a -> b) -> b -> RE c a -> RE c b
-foldlManyMin = RFold NonStrict Minimal
+foldlManyMin f = RFoldMn (\z x -> mkSolo (f z x))
+{-# INLINE foldlManyMin #-}
 
 foldlManyMin' :: (b -> a -> b) -> b -> RE c a -> RE c b
-foldlManyMin' f !z = RFold Strict Minimal f z
+foldlManyMin' f !z = RFoldMn (\z' x -> mkSolo $! f z' x) z
+{-# INLINE foldlManyMin' #-}
 
 -- | Parse a @c@ if it satisfies the given predicate.
 satisfy :: (c -> Bool) -> RE c c
@@ -362,3 +379,33 @@
 toFindMany re =
   reverse <$>
   foldlMany' (flip ($)) [] ((:) <$> re <|> id <$ anySingle)
+
+----------
+-- Notes
+----------
+
+-- Note [Functions returning Solo]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- We use `-> Solo a` functions in RFmap, RLiftA2, RFold, RMany to get better
+-- control of the evaluation and avoid wastefully creating thunks.
+--
+-- Under normal circumstances, GHC does a good job of avoiding such thunks using
+-- demand analysis. However, for a function stored in a RE, there is no way to
+-- know its demand characteristics, making such optimizations impossible.
+--
+-- So, Solo is a way to get some /manual/ control over evaluation. For functions
+-- where we want to avoid thunks we use strict combinators, e.g. `liftA2' (:)`,
+-- so that forcing the Solo forces the result. Where we don't want to force the
+-- result, we use lazy combinators which simply put the thunk in the Solo, e.g.
+-- `fmap reverse`.
+--
+-- On GHC, Solo is implemented as an unboxed 1-tuple at no extra cost. It does
+-- have a cost on non-GHC however.
+--
+-- An alternative is to store the strictness of the function alongside it, as a
+-- Bool for instance, and force the result when applying the function if it is
+-- strict. In fact, this is how it was originally implemented here. This method
+-- adds memory costs to the RE and makes the code a little more complicated. The
+-- current setup also might incur a memory cost if an unknown function has to
+-- be wrapped in a function which returns Solo. But in practice the function is
+-- usually statically known and wrapping function gets simplified.
diff --git a/src/Regex/Internal/Solo.hs b/src/Regex/Internal/Solo.hs
new file mode 100644
--- /dev/null
+++ b/src/Regex/Internal/Solo.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedNewtypes #-}
+#endif
+
+-- | This is an internal module. You probably don't need to import this.
+--
+module Regex.Internal.Solo
+  ( Solo
+  , mkSolo
+  , matchSolo
+  ) where
+
+mkSolo :: a -> Solo a
+matchSolo :: Solo a -> (a -> b) -> b
+
+#ifdef __GLASGOW_HASKELL__
+newtype Solo a = Solo (# a #)
+mkSolo x = Solo (# x #)
+matchSolo (Solo (# x #)) f = f x
+#else
+data Solo a = Solo a
+mkSolo = Solo
+matchSolo (Solo x) f = f x
+#endif
diff --git a/src/Regex/Internal/Text.hs b/src/Regex/Internal/Text.hs
--- a/src/Regex/Internal/Text.hs
+++ b/src/Regex/Internal/Text.hs
@@ -81,10 +81,11 @@
 import qualified Data.CharSet as CS
 import Regex.Internal.Parser (Parser)
 import qualified Regex.Internal.Parser as P
-import Regex.Internal.Regex (RE(..), Greediness(..), Strictness(..))
+import Regex.Internal.Regex (RE(..))
 import qualified Regex.Internal.Regex as R
 import qualified Regex.Internal.Num as RNum
 import qualified Regex.Internal.Generated.CaseFold as CF
+import Regex.Internal.Solo (Solo, mkSolo, matchSolo)
 
 ----------------------
 -- Token and Text REs
@@ -400,17 +401,16 @@
     go :: REText b -> REText Text
     go re = case re of
       RToken t -> tokenMatch t
-      RFmap _ _ re1 -> go re1
+      RFmap _ re1 -> go re1
       RFmap_ _ re1 -> go re1
-      RPure _ -> RPure T.empty
-      RLiftA2 _ _ re1 re2 ->
-        RLiftA2 Strict unsafeAdjacentAppend (go re1) (go re2)
-      REmpty -> REmpty
-      RAlt re1 re2 -> RAlt (go re1) (go re2)
+      RPure _ -> pure T.empty
+      RLiftA2 _ re1 re2 -> R.liftA2' unsafeAdjacentAppend (go re1) (go re2)
+      REmpty -> Ap.empty
+      RAlt re1 re2 -> go re1 <|> go re2
+      RFoldGr _ _ re1 -> R.foldlMany' unsafeAdjacentAppend T.empty (go re1)
+      RFoldMn _ _ re1 -> R.foldlManyMin' unsafeAdjacentAppend T.empty (go re1)
       RMany _ _ _ _ re1 ->
-        RFold Strict Greedy unsafeAdjacentAppend T.empty (go re1)
-      RFold _ gr _ _ re1 ->
-        RFold Strict gr unsafeAdjacentAppend T.empty (go re1)
+        R.foldlMany' unsafeAdjacentAppend T.empty (go re1)
 #else
 toMatch = fmap (T.pack . map tChar) . RL.toMatch
 #endif
@@ -420,45 +420,36 @@
 #ifdef __GLASGOW_HASKELL__
 data WithMatch a = WM {-# UNPACK #-} !Text a
 
-instance Functor WithMatch where
-  fmap f (WM t x) = WM t (f x)
-
-fmapWM' :: (a -> b) -> WithMatch a -> WithMatch b
-fmapWM' f (WM t x) = WM t $! f x
+pureWM :: a -> WithMatch a
+pureWM x = WM T.empty x
 
-instance Applicative WithMatch where
-  pure = WM T.empty
-  liftA2 f (WM t1 x) (WM t2 y) = WM (unsafeAdjacentAppend t1 t2) (f x y)
+fmapWM :: (a -> Solo b) -> WithMatch a -> WithMatch b
+fmapWM f (WM t x) = matchSolo (f x) (WM t)
 
-liftA2WM' :: (a1 -> a2 -> b) -> WithMatch a1 -> WithMatch a2 -> WithMatch b
-liftA2WM' f (WM t1 x) (WM t2 y) = WM (unsafeAdjacentAppend t1 t2) $! f x y
+liftA2WM :: (a1 -> a2 -> Solo b) -> WithMatch a1 -> WithMatch a2 -> WithMatch b
+liftA2WM f (WM t1 x) (WM t2 y) =
+  matchSolo (f x y) (WM (unsafeAdjacentAppend t1 t2))
 
 withMatch = R.fmap' (\(WM t x) -> (t,x)) . go
   where
     go :: REText b -> REText (WithMatch b)
     go re = case re of
       RToken t -> tokenWithMatch t
-      RFmap st f re1 ->
-        let g = case st of
-              Strict -> fmapWM' f
-              NonStrict -> fmap f
-        in RFmap Strict g (go re1)
-      RFmap_ b re1 -> RFmap Strict (flip WM b) (toMatch re1)
-      RPure b -> RPure (pure b)
-      RLiftA2 st f re1 re2 ->
-        let g = case st of
-              Strict -> liftA2WM' f
-              NonStrict -> Ap.liftA2 f
-        in RLiftA2 Strict g (go re1) (go re2)
-      REmpty -> REmpty
-      RAlt re1 re2 -> RAlt (go re1) (go re2)
+      RFmap f re1 -> R.fmap' (fmapWM f) (go re1)
+      RFmap_ b re1 -> R.fmap' (flip WM b) (toMatch re1)
+      RPure b -> pure (pureWM b)
+      RLiftA2 f re1 re2 -> R.liftA2' (liftA2WM f) (go re1) (go re2)
+      REmpty -> Ap.empty
+      RAlt re1 re2 ->  go re1 <|> go re2
+      RFoldGr f z re1 -> R.foldlMany' (liftA2WM f) (pureWM z) (go re1)
+      RFoldMn f z re1 -> R.foldlManyMin' (liftA2WM f) (pureWM z) (go re1)
       RMany f1 f2 f z re1 ->
-        RMany (fmapWM' f1) (fmapWM' f2) (liftA2WM' f) (pure z) (go re1)
-      RFold st gr f z re1 ->
-        let g = case st of
-              Strict -> liftA2WM' f
-              NonStrict -> Ap.liftA2 f
-        in RFold Strict gr g (pure z) (go re1)
+        RMany
+          (\x -> mkSolo $! fmapWM f1 x)
+          (\x -> mkSolo $! fmapWM f2 x)
+          (\x y -> mkSolo $! liftA2WM f x y)
+          (pureWM z)
+          (go re1)
 #else
 withMatch = fmap (\(toks, x) -> (T.pack (map tChar toks), x)) . RL.withMatch
 #endif
diff --git a/src/Regex/Internal/Unique.hs b/src/Regex/Internal/Unique.hs
--- a/src/Regex/Internal/Unique.hs
+++ b/src/Regex/Internal/Unique.hs
@@ -1,5 +1,3 @@
-{-# OPTIONS_HADDOCK not-home #-}
-
 -- | This is an internal module. You probably don't need to import this.
 --
 -- = WARNING
