diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,17 @@
 # Changelog for polysemy-plugin
 
+## 0.2.0.0 (2019-05-23)
+
+- Fixed a serious bug where the changes from 0.1.0.1 broke most real-world
+    usages of polysemy
+- The plugin will now automatically perform the transformation in
+    `polysemy`'s `inlineRecursiveCalls` when run with `-O`
+
+## 0.1.0.1 (2019-05-18)
+
+- Added some explicit bounds for cabal
+- Fixed a bug where effects that were too polymorphic would silently be accepted
+
 ## 0.1.0.0 (2019-04-27)
 
 - Initial release
diff --git a/polysemy-plugin.cabal b/polysemy-plugin.cabal
--- a/polysemy-plugin.cabal
+++ b/polysemy-plugin.cabal
@@ -4,10 +4,10 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: b2f1b5ca3df4cb55d14d21f847975a2eb82809c4b569f214f7ff29a88bd9d65d
+-- hash: 85478fdf6818cbb2b849d4dd68a9f8dbee303d4a7ac2005945ac34ac5eb9dd33
 
 name:           polysemy-plugin
-version:        0.1.0.1
+version:        0.2.0.0
 synopsis:       Disambiguate obvious uses of effects.
 description:    Please see the README on GitHub at <https://github.com/isovector/polysemy/tree/master/polysemy-plugin#readme>
 category:       Polysemy
@@ -30,6 +30,9 @@
 library
   exposed-modules:
       Polysemy.Plugin
+      Polysemy.Plugin.Fundep
+      Polysemy.Plugin.InlineRecursiveCalls
+      Polysemy.Plugin.Phases
   other-modules:
       Paths_polysemy_plugin
   hs-source-dirs:
@@ -40,6 +43,8 @@
     , ghc >=8.6.3 && <8.7
     , ghc-tcplugins-extra >=0.3 && <0.4
     , polysemy >=0.1
+    , syb >=0.7 && <0.8
+    , transformers >=0.5.5.0 && <0.6
   default-language: Haskell2010
 
 test-suite polysemy-plugin-test
@@ -47,18 +52,23 @@
   main-is: Main.hs
   other-modules:
       BadSpec
+      ExampleSpec
+      InlineRecursiveCallsSpec
       PluginSpec
       Paths_polysemy_plugin
   hs-source-dirs:
       test
   default-extensions: DataKinds DeriveFunctor FlexibleContexts GADTs LambdaCase PolyKinds RankNTypes ScopedTypeVariables StandaloneDeriving TypeApplications TypeOperators TypeFamilies UnicodeSyntax
-  ghc-options: -threaded -rtsopts -with-rtsopts=-N -fplugin=Polysemy.Plugin
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -fplugin=Polysemy.Plugin -O2
   build-depends:
       base >=4.7 && <5
     , ghc >=8.6.3 && <8.7
     , ghc-tcplugins-extra >=0.3 && <0.4
     , hspec >=2.6.0 && <3
+    , inspection-testing >=0.4.1.1 && <0.5
     , polysemy >=0.1
     , polysemy-plugin
     , should-not-typecheck >=2.1.0 && <3
+    , syb >=0.7 && <0.8
+    , transformers >=0.5.5.0 && <0.6
   default-language: Haskell2010
diff --git a/src/Polysemy/Plugin.hs b/src/Polysemy/Plugin.hs
--- a/src/Polysemy/Plugin.hs
+++ b/src/Polysemy/Plugin.hs
@@ -2,37 +2,6 @@
 {-# LANGUAGE NoMonomorphismRestriction #-}
 
 ------------------------------------------------------------------------------
--- The MIT License (MIT)
---
--- Copyright (c) 2017 Luka Horvat
---
--- Permission is hereby granted, free of charge, to any person obtaining a copy
--- of this software and associated documentation files (the "Software"), to
--- deal in the Software without restriction, including without limitation the
--- rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
--- sell copies of the Software, and to permit persons to whom the Software is
--- furnished to do so, subject to the following conditions:
---
--- The above copyright notice and this permission notice shall be included in
--- all copies or substantial portions of the Software.
---
--- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
--- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
--- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
--- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
--- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
--- FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
--- IN THE SOFTWARE.
---
-------------------------------------------------------------------------------
---
--- This module is heavily based on 'Control.Effects.Plugin' from the
--- 'simple-effects' package, originally by Luka Horvat.
---
--- https://gitlab.com/LukaHorvat/simple-effects/commit/966ce80b8b5777a4bd8f87ffd443f5fa80cc8845#f51c1641c95dfaa4827f641013f8017e8cd02aab
-
-
-------------------------------------------------------------------------------
 -- | A typechecker plugin that can disambiguate "obvious" uses of effects in
 -- Polysemy.
 --
@@ -92,127 +61,51 @@
   ( plugin
   ) where
 
-import Class
-import CoAxiom
-import Control.Monad
 import CoreMonad
-import Data.Maybe
 import DynFlags
-import FastString (fsLit)
 import GHC (ModuleName, moduleName)
-import GHC.TcPluginM.Extra (lookupModule, lookupName)
-import Module     (mkModuleName, moduleSetElts)
-import OccName    (mkTcOcc)
-import Outputable
-import TcPluginM  (TcPluginM, tcLookupClass)
-import TcRnTypes
-import TcSMonad hiding (tcLookupClass)
-import TyCoRep    (Type (..))
-import Type
+import Module (mkModuleName, moduleSetElts)
+import Polysemy.Plugin.Fundep
+import Polysemy.Plugin.InlineRecursiveCalls
 
-import Plugins    (Plugin (..), defaultPlugin
+#if __GLASGOW_HASKELL__ >= 810
+import Polysemy.Plugin.Phases
+#endif
+
+import Plugins (Plugin (..), defaultPlugin)
 #if __GLASGOW_HASKELL__ >= 806
-    , PluginRecompile(..)
+import Plugins (PluginRecompile(..))
 #endif
-    )
 
 
 plugin :: Plugin
 plugin = defaultPlugin
     { tcPlugin = const $ Just fundepPlugin
-#if __GLASGOW_HASKELL__ >= 810
     , installCoreToDos = const installTodos
-#endif
 #if __GLASGOW_HASKELL__ >= 806
     , pluginRecompile = const $ pure NoForceRecompile
 #endif
     }
 
+
 polysemyInternal :: ModuleName
 polysemyInternal = mkModuleName "Polysemy.Internal"
 
-polysemyInternalUnion :: ModuleName
-polysemyInternalUnion = mkModuleName "Polysemy.Internal.Union"
 
 installTodos :: [CoreToDo] -> CoreM [CoreToDo]
 installTodos todos = do
-  dynFlags <- getDynFlags
-  case optLevel dynFlags of
-    2 -> do
-      mods <- moduleSetElts <$> getVisibleOrphanMods
-      case any ((== polysemyInternal) . moduleName) mods of
-        -- TODO(sandy): install extra passes
-        True  -> pure todos
-        False -> pure todos
-    _ -> pure todos
-
-fundepPlugin :: TcPlugin
-fundepPlugin = TcPlugin
-    { tcPluginInit = do
-        md <- lookupModule polysemyInternalUnion (fsLit "polysemy")
-        monadEffectTcNm <- lookupName md (mkTcOcc "Find")
-        tcLookupClass monadEffectTcNm
-    , tcPluginSolve = solveFundep
-    , tcPluginStop = const (return ()) }
-
-allMonadEffectConstraints :: Class -> [Ct] -> [(CtLoc, (Type, Type, Type))]
-allMonadEffectConstraints cls cts =
-    [ (ctLoc cd, (effName, eff, r))
-        | cd@CDictCan{cc_class = cls', cc_tyargs = [_, r, eff]} <- cts
-        , cls == cls'
-        , let effName = getEffName eff
-              ]
-
-singleListToJust :: [a] -> Maybe a
-singleListToJust [a] = Just a
-singleListToJust _ = Nothing
-
-findMatchingEffectIfSingular :: (Type, Type, Type) -> [(Type, Type, Type)] -> Maybe Type
-findMatchingEffectIfSingular (effName, _, mon) ts = singleListToJust
-    [ eff'
-        | (effName', eff', mon') <- ts
-        , eqType effName effName'
-        , eqType mon mon' ]
-
-getEffName :: Type -> Type
-getEffName t = fst $ splitAppTys t
-
-
--- isTyVar :: Type -> Bool
--- isTyVar = isJust . getTyVar_maybe
-
-
-canUnify :: Type -> Type -> Bool
-canUnify wanted given =
-  let (w, ws) = splitAppTys wanted
-      (g, gs) = splitAppTys given
-   in (&& eqType w g) . flip all (zip ws gs) $ \(wt, gt) ->
-        if isTyVarTy gt
-           then isTyVarTy wt
-           else True
-
-
-mkWanted :: Bool -> CtLoc -> Type -> Type -> TcPluginM (Maybe Ct)
-mkWanted mustUnify loc wanted given = do
-  if (not mustUnify || canUnify wanted given)
-     then do
-       (ev, _) <- unsafeTcPluginTcM $ runTcSDeriveds $ newWantedEq loc Nominal wanted given
-       pure $ Just (CNonCanonical ev)
-     else
-       pure Nothing
-
+  dflags <- getDynFlags
 
-solveFundep :: Class -> [Ct] -> [Ct] -> [Ct] -> TcPluginM TcPluginResult
-solveFundep effCls giv _ want = do
-    let wantedEffs = allMonadEffectConstraints effCls want
-    let givenEffs = snd <$> allMonadEffectConstraints effCls giv
-    eqs <- forM wantedEffs $ \(loc, e@(_, eff, r)) ->
-      case findMatchingEffectIfSingular e givenEffs of
-        Nothing -> do
-          case splitAppTys r of
-            (_, [_, eff', _]) -> mkWanted False loc eff eff'
-            _                 -> pure Nothing
-        Just eff' -> mkWanted True loc eff eff'
+  case optLevel dflags of
+    0 -> pure todos
+    _ -> do
+      mods <- moduleSetElts <$> getVisibleOrphanMods
+      pure $ case any ((== polysemyInternal) . moduleName) mods of
+        True  -> CoreDoPluginPass "Inline Recursive Calls" inlineRecursiveCalls
+               : todos
+#if __GLASGOW_HASKELL__ >= 810
+              ++ extraPhases dflags
+#endif
+        False -> todos
 
-    return (TcPluginOk [] (catMaybes eqs))
 
diff --git a/src/Polysemy/Plugin/Fundep.hs b/src/Polysemy/Plugin/Fundep.hs
new file mode 100644
--- /dev/null
+++ b/src/Polysemy/Plugin/Fundep.hs
@@ -0,0 +1,132 @@
+------------------------------------------------------------------------------
+-- The MIT License (MIT)
+--
+-- Copyright (c) 2017 Luka Horvat
+--
+-- Permission is hereby granted, free of charge, to any person obtaining a copy
+-- of this software and associated documentation files (the "Software"), to
+-- deal in the Software without restriction, including without limitation the
+-- rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+-- sell copies of the Software, and to permit persons to whom the Software is
+-- furnished to do so, subject to the following conditions:
+--
+-- The above copyright notice and this permission notice shall be included in
+-- all copies or substantial portions of the Software.
+--
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+-- FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+-- IN THE SOFTWARE.
+--
+------------------------------------------------------------------------------
+--
+-- This module is heavily based on 'Control.Effects.Plugin' from the
+-- 'simple-effects' package, originally by Luka Horvat.
+--
+-- https://gitlab.com/LukaHorvat/simple-effects/commit/966ce80b8b5777a4bd8f87ffd443f5fa80cc8845#f51c1641c95dfaa4827f641013f8017e8cd02aab
+
+module Polysemy.Plugin.Fundep (fundepPlugin) where
+
+import Class
+import CoAxiom
+import Control.Monad
+import Data.Bifunctor
+import Data.List
+import Data.Maybe
+import FastString (fsLit)
+import GHC (ModuleName)
+import GHC.TcPluginM.Extra (lookupModule, lookupName)
+import Module (mkModuleName)
+import OccName (mkTcOcc)
+import TcPluginM (TcPluginM, tcLookupClass)
+import TcRnTypes
+import TcSMonad hiding (tcLookupClass)
+import TyCoRep (Type (..))
+import Type
+
+
+polysemyInternalUnion :: ModuleName
+polysemyInternalUnion = mkModuleName "Polysemy.Internal.Union"
+
+fundepPlugin :: TcPlugin
+fundepPlugin = TcPlugin
+    { tcPluginInit = do
+        md <- lookupModule polysemyInternalUnion (fsLit "polysemy")
+        monadEffectTcNm <- lookupName md (mkTcOcc "Find")
+        tcLookupClass monadEffectTcNm
+    , tcPluginSolve = solveFundep
+    , tcPluginStop = const (return ()) }
+
+allMonadEffectConstraints :: Class -> [Ct] -> [(CtLoc, (Type, Type, Type))]
+allMonadEffectConstraints cls cts =
+    [ (ctLoc cd, (effName, eff, r))
+    | cd@CDictCan{cc_class = cls', cc_tyargs = [_, r, eff]} <- cts
+    , cls == cls'
+    , let effName = getEffName eff
+    ]
+
+singleListToJust :: [a] -> Maybe a
+singleListToJust [a] = Just a
+singleListToJust _ = Nothing
+
+findMatchingEffectIfSingular :: (Type, Type, Type) -> [(Type, Type, Type)] -> Maybe Type
+findMatchingEffectIfSingular (effName, _, mon) ts = singleListToJust
+    [ eff'
+        | (effName', eff', mon') <- ts
+        , eqType effName effName'
+        , eqType mon mon' ]
+
+getEffName :: Type -> Type
+getEffName t = fst $ splitAppTys t
+
+
+canUnify :: Type -> Type -> Bool
+canUnify wanted given =
+  let (w, ws) = splitAppTys wanted
+      (g, gs) = splitAppTys given
+   in (&& eqType w g) . flip all (zip ws gs) $ \(wt, gt) ->
+        if isTyVarTy gt
+           then isTyVarTy wt
+           else True
+
+
+mkWanted :: Bool -> CtLoc -> Type -> Type -> TcPluginM (Maybe Ct)
+mkWanted mustUnify loc wanted given =
+  if (not mustUnify || canUnify wanted given)
+     then do
+       (ev, _) <- unsafeTcPluginTcM $ runTcSDeriveds $ newWantedEq loc Nominal wanted given
+       pure $ Just $ CNonCanonical ev
+     else
+       pure Nothing
+
+thd :: (a, b, c) -> c
+thd (_, _, c) = c
+
+countLength :: (a -> a -> Bool) -> [a] -> [(a, Int)]
+countLength eq as =
+  let grouped = groupBy eq as
+   in zipWith (curry $ bimap head length) grouped grouped
+
+solveFundep :: Class -> [Ct] -> [Ct] -> [Ct] -> TcPluginM TcPluginResult
+solveFundep _ _ _ [] = pure $ TcPluginOk [] []
+solveFundep effCls giv _ want = do
+    let wantedEffs = allMonadEffectConstraints effCls want
+        givenEffs = snd <$> allMonadEffectConstraints effCls giv
+        num_wanteds_by_r = countLength eqType $ fmap (thd . snd) wantedEffs
+        must_unify r =
+          let Just num_wanted = find (eqType r . fst) num_wanteds_by_r
+           in snd num_wanted /= 1
+
+    eqs <- forM wantedEffs $ \(loc, e@(_, eff, r)) -> do
+      case findMatchingEffectIfSingular e givenEffs of
+        Nothing -> do
+          case splitAppTys r of
+            (_, [_, eff', _]) -> mkWanted (must_unify r) loc eff eff'
+            _                 -> pure Nothing
+        Just eff' -> mkWanted True loc eff eff'
+
+    pure $ TcPluginOk [] $ catMaybes eqs
+
diff --git a/src/Polysemy/Plugin/InlineRecursiveCalls.hs b/src/Polysemy/Plugin/InlineRecursiveCalls.hs
new file mode 100644
--- /dev/null
+++ b/src/Polysemy/Plugin/InlineRecursiveCalls.hs
@@ -0,0 +1,92 @@
+module Polysemy.Plugin.InlineRecursiveCalls
+  ( inlineRecursiveCalls
+  ) where
+
+import BasicTypes
+import Control.Monad
+import Control.Monad.Trans.State
+import CoreMonad
+import CoreSyn
+import Data.Monoid
+import Data.Traversable
+import GHC
+import Generics.SYB
+import HscTypes
+import IdInfo
+import Name
+import SrcLoc
+import UniqSupply
+import Unique
+import Var
+
+
+inlineRecursiveCalls :: ModGuts -> CoreM ModGuts
+inlineRecursiveCalls mg = do
+  uniqSupply <- liftIO $ mkSplitUniqSupply '\x264a'
+  flip evalStateT uniqSupply $ do
+    bs <- traverse loopbreakBinds $ mg_binds mg
+    pure $ mg { mg_binds = bs }
+
+
+type CoreSupplyM = StateT UniqSupply CoreM
+
+
+getUniq :: CoreSupplyM Unique
+getUniq = do
+  (u, s) <- gets takeUniqFromSupply
+  put s
+  pure u
+
+
+containsName :: CoreBndr -> CoreExpr -> Bool
+containsName n e =
+  getAny $
+    everything
+      (<>)
+      (mkQ (Any False) $ matches n)
+      e
+
+
+matches :: CoreBndr -> CoreExpr -> Any
+matches n (Var n') | n == n' = Any True
+matches _ _ = Any False
+
+
+replace :: Id -> Id -> Expr CoreBndr -> Expr CoreBndr
+replace n n' = everywhere $ mkT go
+  where
+    go :: Expr CoreBndr -> Expr CoreBndr
+    go v@(Var nn)
+      | nn == n   = Var n'
+      | otherwise = v
+    go x = x
+
+
+loopbreaker :: CoreBndr -> CoreExpr -> CoreSupplyM [(Var, CoreExpr)]
+loopbreaker n b = do
+  u <- getUniq
+  let Just info = zapUsageInfo $ idInfo n
+      info' = setInlinePragInfo info alwaysInlinePragma
+      n' = mkLocalVar
+             (idDetails n)
+             (mkInternalName u (occName n) noSrcSpan)
+             (idType n)
+         $ setInlinePragInfo vanillaIdInfo neverInlinePragma
+  pure [ (lazySetIdInfo n info', replace n n' b)
+       , (n', Var n)
+       ]
+
+
+-- TODO(sandy): Make this only break loops in functions whose type ends in `Sem
+-- * * -> Sem * *` for wildcards `*`
+loopbreakBinds
+    :: Bind CoreBndr
+    -> CoreSupplyM (Bind CoreBndr)
+loopbreakBinds nr@(NonRec n b)
+  | containsName n b = Rec <$> loopbreaker n b
+  | otherwise        = pure nr
+loopbreakBinds (Rec bs) = fmap (Rec . join) . for bs $ \(n, b) ->
+  case containsName n b of
+    False -> pure [(n, b)]
+    True  -> loopbreaker n b
+
diff --git a/src/Polysemy/Plugin/Phases.hs b/src/Polysemy/Plugin/Phases.hs
new file mode 100644
--- /dev/null
+++ b/src/Polysemy/Plugin/Phases.hs
@@ -0,0 +1,59 @@
+module Polysemy.Plugin.Phases
+  ( extraPhases
+  ) where
+
+import BasicTypes
+import CoreMonad
+import DynFlags
+
+extraPhases :: DynFlags -> [CoreToDo]
+extraPhases dflags =
+    [ CoreDoSpecialising
+    , simpl_phase 0 ["post-late-spec"] max_iter
+    , simpl_gently
+    , CoreDoStaticArgs
+    , CoreDoSpecialising
+    -- TODO(sandy): probably don't need this one
+    , simpl_phase 0 ["post-late-spec"] max_iter
+    , simpl_phases
+    , simpl_gently
+    ]
+
+  where
+    option   = flip gopt dflags
+    max_iter = maxSimplIterations dflags
+    rules_on = option Opt_DoLambdaEtaExpansion
+    phases   = simplPhases dflags
+
+    base_mode = SimplMode
+      { sm_phase      = error "base_mode"
+      , sm_names      = []
+      , sm_dflags     = dflags
+      , sm_rules      = option Opt_EnableRewriteRules
+      , sm_eta_expand = rules_on
+      , sm_inline     = True
+      , sm_case_case  = True
+      }
+
+    simpl_phase phase names iter = CoreDoPasses
+      [ runWhen (phase `elem` strictnessBefore dflags) CoreDoStrictness
+      , CoreDoSimplify iter $
+          base_mode { sm_phase = Phase phase
+                    , sm_names = names
+                    }
+      , runMaybe (ruleCheck dflags) $ CoreDoRuleCheck $ Phase phase
+      ]
+
+    simpl_gently = CoreDoSimplify max_iter $ base_mode
+      { sm_phase = InitialPhase
+      , sm_names = ["Gentle"]
+      , sm_rules = rules_on
+      , sm_inline = True
+      , sm_case_case = False
+      }
+
+    simpl_phases = CoreDoPasses
+      [ simpl_phase phase ["main"] max_iter
+      | phase <- [phases, phases-1 .. 1]
+      ]
+
diff --git a/test/ExampleSpec.hs b/test/ExampleSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/ExampleSpec.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE BlockArguments #-}
+{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}
+
+module ExampleSpec where
+
+import Polysemy
+import Polysemy.Error
+import Polysemy.Input
+import Polysemy.Output
+import Polysemy.Resource
+import Test.Hspec
+
+data Teletype m a where
+  ReadTTY  :: Teletype m String
+  WriteTTY :: String -> Teletype m ()
+
+makeSem ''Teletype
+
+runTeletypeIO :: Member (Lift IO) r => Sem (Teletype ': r) a -> Sem r a
+runTeletypeIO = interpret $ \case
+  ReadTTY      -> sendM getLine
+  WriteTTY msg -> sendM $ putStrLn msg
+
+data CustomException = ThisException | ThatException deriving Show
+
+program :: Members '[Teletype, Resource, Error CustomException] r => Sem r ()
+program = catch @CustomException work $ \e -> writeTTY ("Caught " ++ show e)
+  where work = bracket (readTTY) (const $ writeTTY "exiting bracket") $ \i -> do
+          writeTTY "entering bracket"
+          case i of
+            "explode"     -> throw ThisException
+            "weird stuff" -> writeTTY i >> throw ThatException
+            _             -> writeTTY i >> writeTTY "no exceptions"
+
+foo :: IO (Either CustomException ())
+foo = (runM .@ runResource .@@ runErrorInIO @CustomException) $ runTeletypeIO program
+
+spec :: Spec
+spec = describe "example" $ do
+  it "should compile!" $ do
+    True `shouldBe` True
+
diff --git a/test/InlineRecursiveCallsSpec.hs b/test/InlineRecursiveCallsSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/InlineRecursiveCallsSpec.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -ddump-simpl -dsuppress-coercions -dsuppress-uniques -dsuppress-idinfo #-}
+
+
+module InlineRecursiveCallsSpec
+  ( spec
+  ) where
+
+import qualified Control.Monad.Trans.State as S
+import           Data.Tuple
+import           Polysemy.Internal
+import           Polysemy.Internal.Effect
+import           Polysemy.Internal.Union
+import           Test.Hspec
+import           Test.Inspection
+
+
+spec :: Spec
+spec = describe "inlining recursive calls" $ do
+  it "should explicitly break recursion" $ do
+    -- TODO(sandy): This should use (===) instead of (==-), but can't due to
+    -- a bug in inspection-testing. See:
+    -- https://github.com/nomeata/inspection-testing/pull/19
+    shouldSucceed $(inspectTest $ 'recursive ==- 'mutual)
+
+
+isSuccess :: Result -> Bool
+isSuccess (Success _) = True
+isSuccess (Failure e) = error e
+
+
+shouldSucceed :: Result -> Expectation
+shouldSucceed r = r `shouldSatisfy` isSuccess
+
+
+------------------------------------------------------------------------------
+recursive
+    :: (∀ x m. e m x -> S.StateT s (Sem r) x)
+    -> s
+    -> Sem (e ': r) a
+    -> Sem r (s, a)
+recursive f s (Sem m) = Sem $ \k ->
+  fmap swap $ flip S.runStateT s $ m $ \u ->
+    case decomp u of
+        Left x -> S.StateT $ \s' ->
+          k . fmap swap
+            . weave (s', ()) (uncurry $ recursive f)
+            $ x
+        Right (Yo e z _ y) ->
+          fmap (y . (<$ z)) $ S.mapStateT (usingSem k) $ f e
+
+
+------------------------------------------------------------------------------
+mutual
+    :: (∀ x m. e m x -> S.StateT s (Sem r) x)
+    -> s
+    -> Sem (e ': r) a
+    -> Sem r (s, a)
+mutual f s (Sem m) = Sem $ \k ->
+  fmap swap $ flip S.runStateT s $ m $ \u ->
+    case decomp u of
+        Left x -> S.StateT $ \s' ->
+          k . fmap swap
+            . weave (s', ()) (uncurry $ mutual2 f)
+            $ x
+        Right (Yo e z _ y) ->
+          fmap (y . (<$ z)) $ S.mapStateT (usingSem k) $ f e
+{-# INLINE mutual #-}
+
+mutual2
+    :: (∀ x m. e m x -> S.StateT s (Sem r) x)
+    -> s
+    -> Sem (e ': r) a
+    -> Sem r (s, a)
+mutual2 = mutual
+{-# NOINLINE mutual2 #-}
+
