diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,9 @@
 # dickinson
 
+## 1.4.1.2
+
+  * Performance improvements in the pattern match exhaustiveness checker
+
 ## 1.4.1.1
 
   * Bundle `user-guide.pdf` in tarball
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -21,7 +21,6 @@
 computer:
 
 ```bash
-
 curl -sSl https://raw.githubusercontent.com/vmchale/dickinson/master/bash/install.sh | sh -s
 ```
 
diff --git a/language-dickinson.cabal b/language-dickinson.cabal
--- a/language-dickinson.cabal
+++ b/language-dickinson.cabal
@@ -1,6 +1,6 @@
 cabal-version:      2.0
 name:               language-dickinson
-version:            1.4.1.1
+version:            1.4.1.2
 license:            BSD3
 license-file:       LICENSE
 copyright:          Copyright: (c) 2020 Vanessa McHale
diff --git a/lib/noun.dck b/lib/noun.dck
--- a/lib/noun.dck
+++ b/lib/noun.dck
@@ -61,7 +61,9 @@
       (| "autonomous")
       (| "pseudonym")
       (| "perfidy")
+      (| "potboiler")
       (| "heliophagy")
+      (| "poultice")
       (| "aril")
       (| "valedictorian")
       (| "cathexis")
diff --git a/src/Language/Dickinson/Check/Exhaustive.hs b/src/Language/Dickinson/Check/Exhaustive.hs
--- a/src/Language/Dickinson/Check/Exhaustive.hs
+++ b/src/Language/Dickinson/Check/Exhaustive.hs
@@ -3,9 +3,9 @@
 
 import           Control.Applicative                ((<|>))
 import           Data.Foldable                      (toList)
+import           Data.Foldable.Ext
 import           Data.List                          (inits)
 import           Data.Maybe                         (mapMaybe)
-import           Language.Dickinson.Check.Common
 import           Language.Dickinson.Error
 import           Language.Dickinson.Pattern.Useless
 import           Language.Dickinson.Type
@@ -13,28 +13,26 @@
 -- | Check that there are no useless pattern clauses and check that the pattern
 -- matches are exhaustive
 checkExhaustive :: [Declaration a] -> Maybe (DickinsonWarning a)
-checkExhaustive ds = runPatternM (checkDeclsM ds)
+checkExhaustive = checkDeclsM
 
-checkDeclsM :: [Declaration a] -> PatternM (Maybe (DickinsonWarning a))
+checkDeclsM :: [Declaration a] -> Maybe (DickinsonWarning a)
 checkDeclsM ds =
-    patternEnvDecls ds *>
-    mapSumM checkDeclM ds
+    let pEnv = runPatternM $ patternEnvDecls ds in
+        foldMapAlternative (checkDecl pEnv) ds
 
-checkDeclM :: Declaration a -> PatternM (Maybe (DickinsonWarning a))
-checkDeclM TyDecl{}       = pure Nothing
-checkDeclM (Define _ _ e) = checkExprM e
+checkDecl :: PatternEnv -> Declaration a -> Maybe (DickinsonWarning a)
+checkDecl _ TyDecl{}         = Nothing
+checkDecl env (Define _ _ e) = checkExpr env e
 
-isExhaustiveM :: [Pattern a] -> a -> PatternM (Maybe (DickinsonWarning a))
-isExhaustiveM ps loc = do
-    e <- isExhaustive ps
-    pure $ if e
+isExhaustiveErr :: PatternEnv -> [Pattern a] -> a -> Maybe (DickinsonWarning a)
+isExhaustiveErr env ps loc =
+    if isExhaustive env ps
         then Nothing
         else Just $ InexhaustiveMatch loc
 
-uselessErr :: [Pattern a] -> Pattern a -> PatternM (Maybe (DickinsonWarning a))
-uselessErr ps p = {-# SCC "uselessErr" #-} do
-    e <- useful ps p
-    pure $ if e
+uselessErr :: PatternEnv -> [Pattern a] -> Pattern a -> Maybe (DickinsonWarning a)
+uselessErr env ps p = {-# SCC "uselessErr" #-}
+    if useful env ps p
         then Nothing
         else Just $ UselessPattern (patAnn p) p
 
@@ -44,31 +42,29 @@
           split [_] = Nothing
           split xs  = Just (init xs, last xs)
 
-checkMatch :: [Pattern a] -> a -> PatternM (Maybe (DickinsonWarning a))
-checkMatch ps loc = {-# SCC "checkMatch" #-}
-    (<|>)
-        <$> mapSumM (uncurry uselessErr) ({-# SCC "foliate" #-} foliate ps)
-        <*> isExhaustiveM ps loc
+checkMatch :: PatternEnv -> [Pattern a] -> a -> Maybe (DickinsonWarning a)
+checkMatch env ps loc = {-# SCC "checkMatch" #-}
+    foldMapAlternative (uncurry (uselessErr env)) ({-# SCC "foliate" #-} foliate ps)
+    <|> isExhaustiveErr env ps loc
 
-checkExprM :: Expression a -> PatternM (Maybe (DickinsonWarning a))
-checkExprM Var{}              = pure Nothing
-checkExprM Literal{}          = pure Nothing
-checkExprM StrChunk{}         = pure Nothing
-checkExprM Constructor{}      = pure Nothing
-checkExprM BuiltinFn{}        = pure Nothing
-checkExprM Random{}           = pure Nothing
-checkExprM (Flatten _ e)      = checkExprM e
-checkExprM (Annot _ e _)      = checkExprM e
-checkExprM (Lambda _ _ _ e)   = checkExprM e
-checkExprM (Choice _ brs)     = mapSumM checkExprM (snd <$> brs)
-checkExprM (Let _ brs e)      = (<|>) <$> mapSumM checkExprM (snd <$> brs) <*> checkExprM e
-checkExprM (Bind _ brs e)     = (<|>) <$> mapSumM checkExprM (snd <$> brs) <*> checkExprM e
-checkExprM (Interp _ es)      = mapSumM checkExprM es
-checkExprM (MultiInterp _ es) = mapSumM checkExprM es
-checkExprM (Apply _ e e')     = (<|>) <$> checkExprM e <*> checkExprM e'
-checkExprM (Concat _ es)      = mapSumM checkExprM es
-checkExprM (Tuple _ es)       = mapSumM checkExprM es
-checkExprM (Match l e brs)    =
-    (<|>)
-        <$> checkExprM e
-        <*> ((<|>) <$> checkMatch (toList (fst <$> brs)) l <*> mapSumM checkExprM (snd <$> brs))
+checkExpr :: PatternEnv -> Expression a -> Maybe (DickinsonWarning a)
+checkExpr _ Var{}                = Nothing
+checkExpr _ Literal{}            = Nothing
+checkExpr _ StrChunk{}           = Nothing
+checkExpr _ Constructor{}        = Nothing
+checkExpr _ BuiltinFn{}          = Nothing
+checkExpr _ Random{}             = Nothing
+checkExpr env (Flatten _ e)      = checkExpr env e
+checkExpr env (Annot _ e _)      = checkExpr env e
+checkExpr env (Lambda _ _ _ e)   = checkExpr env e
+checkExpr env (Choice _ brs)     = foldMapAlternative (checkExpr env) (snd <$> brs)
+checkExpr env (Let _ brs e)      = foldMapAlternative (checkExpr env) (snd <$> brs) <|> checkExpr env e
+checkExpr env (Bind _ brs e)     = foldMapAlternative (checkExpr env) (snd <$> brs) <|> checkExpr env e
+checkExpr env (Interp _ es)      = foldMapAlternative (checkExpr env) es
+checkExpr env (MultiInterp _ es) = foldMapAlternative (checkExpr env) es
+checkExpr env (Apply _ e e')     = checkExpr env e <|> checkExpr env e'
+checkExpr env (Concat _ es)      = foldMapAlternative (checkExpr env) es
+checkExpr env (Tuple _ es)       = foldMapAlternative (checkExpr env) es
+checkExpr env (Match l e brs)    =
+    checkExpr env e
+        <|> checkMatch env (toList (fst <$> brs)) l <|> foldMapAlternative (checkExpr env) (snd <$> brs)
diff --git a/src/Language/Dickinson/Pattern/Useless.hs b/src/Language/Dickinson/Pattern/Useless.hs
--- a/src/Language/Dickinson/Pattern/Useless.hs
+++ b/src/Language/Dickinson/Pattern/Useless.hs
@@ -3,6 +3,7 @@
 -- | This module is loosely based off /Warnings for pattern matching/ by Luc
 -- Maranget
 module Language.Dickinson.Pattern.Useless ( PatternM
+                                          , PatternEnv
                                           , runPatternM
                                           , isExhaustive
                                           , patternEnvDecls
@@ -12,15 +13,14 @@
                                           , specializeTag
                                           ) where
 
-import           Control.Monad              (forM, forM_)
-import           Control.Monad.State.Strict (State, evalState, get)
+import           Control.Monad              (forM_)
+import           Control.Monad.State.Strict (State, execState)
 import           Data.Coerce                (coerce)
 import           Data.Foldable              (toList, traverse_)
 import           Data.Functor               (void)
 import           Data.IntMap.Strict         (findWithDefault)
 import qualified Data.IntMap.Strict         as IM
 import qualified Data.IntSet                as IS
-import           Data.List.Ext
 import           Language.Dickinson.Name
 import           Language.Dickinson.Type
 import           Language.Dickinson.Unique
@@ -52,34 +52,32 @@
 -- TODO: just reader monad... writer at beginning?
 type PatternM = State PatternEnv
 
-runPatternM :: PatternM a -> a
-runPatternM = flip evalState (PatternEnv mempty mempty)
+runPatternM :: PatternM a -> PatternEnv
+runPatternM = flip execState (PatternEnv mempty mempty)
 
 -- given a constructor name, get the IntSet of all constructors of that type
-assocUniques :: Name a -> PatternM IS.IntSet
-assocUniques (Name _ (Unique i) _) = {-# SCC "assocUniques" #-} do
-    st <- get
-    let ty = findWithDefault internalError i (types st)
-    pure $ findWithDefault internalError ty (allCons st)
+assocUniques :: PatternEnv -> Name a -> IS.IntSet
+assocUniques env (Name _ (Unique i) _) = {-# SCC "assocUniques" #-}
+    let ty = findWithDefault internalError i (types env)
+        in findWithDefault internalError ty (allCons env)
 
 internalError :: a
 internalError = error "Internal error: lookup in a PatternEnv failed"
 
-isExhaustive :: [Pattern a] -> PatternM Bool
-isExhaustive ps = {-# SCC "isExhaustive" #-} not <$> useful ps (Wildcard undefined)
+isExhaustive :: PatternEnv -> [Pattern a] -> Bool
+isExhaustive env ps = {-# SCC "isExhaustive" #-} not $ useful env ps (Wildcard undefined)
 
-isCompleteSet :: [Name a] -> PatternM (Maybe [Name ()])
-isCompleteSet []       = pure Nothing
-isCompleteSet ns@(n:_) = do
-    allU <- assocUniques n
-    let ty = coerce (unique <$> ns)
-    pure $
-        if IS.null (allU IS.\\ IS.fromList ty)
+isCompleteSet :: PatternEnv -> [Name a] -> Maybe [Name ()]
+isCompleteSet _ []       = Nothing
+isCompleteSet env ns@(n:_) =
+    let allU = assocUniques env n
+        ty = coerce (unique <$> ns)
+        in if IS.null (allU IS.\\ IS.fromList ty)
             then Just ((\u -> Name undefined (Unique u) ()) <$> IS.toList allU)
             else Nothing
 
-useful :: [Pattern a] -> Pattern a -> PatternM Bool
-useful ps p = usefulMaranget [[p'] | p' <- ps] [p]
+useful :: PatternEnv -> [Pattern a] -> Pattern a -> Bool
+useful env ps p = usefulMaranget env [[p'] | p' <- ps] [p]
 
 sanityFailed :: a
 sanityFailed = error "Sanity check failed! Perhaps you ran the pattern match exhaustiveness checker on an ill-typed program?"
@@ -126,12 +124,12 @@
 extrCons _                 = []
 
 -- Is the first column of the pattern matrix complete?
-fstComplete :: [[Pattern a]] -> PatternM (Complete ())
-fstComplete ps = {-# SCC "fstComplete" #-}
+fstComplete :: PatternEnv -> [[Pattern a]] -> Complete ()
+fstComplete env ps = {-# SCC "fstComplete" #-}
     if maxTupleLength > 0
-        then pure $ CompleteTuple maxTupleLength
+        then CompleteTuple maxTupleLength
         else maybe NotComplete CompleteTags
-                <$> isCompleteSet (concatMap extrCons fstColumn)
+                $ isCompleteSet env (concatMap extrCons fstColumn)
     where fstColumn = fmap head ps
           tuple (PatternTuple _ ps') = length ps'
           tuple (OrPattern _ ps')    = maximum (tuple <$> ps')
@@ -139,18 +137,18 @@
           maxTupleLength = maximum (tuple <$> fstColumn)
 
 -- follows maranget paper
-usefulMaranget :: [[Pattern a]] -> [Pattern a] -> PatternM Bool
-usefulMaranget [] _                       = pure True
-usefulMaranget _ []                       = pure False
-usefulMaranget ps (PatternCons _ c:qs)    = usefulMaranget (specializeTag c ps) qs
-usefulMaranget ps (PatternTuple _ ps':qs) = usefulMaranget (specializeTuple (length ps') ps) (toList ps' ++ qs)
-usefulMaranget ps (OrPattern _ ps':qs)    = forAnyA ps' $ \p -> usefulMaranget ps (p:qs)
-usefulMaranget ps (q:qs)                  = do -- var or wildcard
-    cont <- fstComplete ps
+usefulMaranget :: PatternEnv -> [[Pattern a]] -> [Pattern a] -> Bool
+usefulMaranget _ [] _                       = True
+usefulMaranget _ _ []                       = False
+usefulMaranget env ps (PatternCons _ c:qs)    = usefulMaranget env (specializeTag c ps) qs
+usefulMaranget env ps (PatternTuple _ ps':qs) = usefulMaranget env (specializeTuple (length ps') ps) (toList ps' ++ qs)
+usefulMaranget env ps (OrPattern _ ps':qs)    = any (\p -> usefulMaranget env ps (p:qs)) ps'
+usefulMaranget env ps (q:qs)                  = -- var or wildcard
+    let cont = fstComplete env ps in
     case cont of
-        NotComplete     -> usefulMaranget (defaultMatrix ps) qs
-        CompleteTuple n -> usefulMaranget (specializeTuple n ps) (specializeTupleVector n q qs)
-        CompleteTags ns -> or <$> forM ns (\n -> usefulMaranget (specializeTag n (forget ps)) (fmap void qs))
+        NotComplete     -> usefulMaranget env (defaultMatrix ps) qs
+        CompleteTuple n -> usefulMaranget env (specializeTuple n ps) (specializeTupleVector n q qs)
+        CompleteTags ns -> or $ fmap (\n -> usefulMaranget env (specializeTag n (forget ps)) (fmap void qs)) ns
 
 specializeTupleVector :: Int -> Pattern a -> [Pattern a] -> [Pattern a]
 specializeTupleVector n p ps = {-# SCC "specializeTupleVector" #-} replicate n p ++ ps