diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -9,3 +9,7 @@
 
 * Introduced `Lam` to the API and conversion functions for `Core.Defunc`
 * Extra type ascriptions added to generated code
+
+## 1.0.1.1 -- 2021-06-27
+
+* Added input factoring to `try p <|> q` and also forms with `f <$> try p <|> q` and `try p $> x <|> q`
diff --git a/parsley-core.cabal b/parsley-core.cabal
--- a/parsley-core.cabal
+++ b/parsley-core.cabal
@@ -5,7 +5,7 @@
 --                   | +------- breaking internal API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             1.0.1.0
+version:             1.0.1.1
 synopsis:            A fast parser combinator library backed by Typed Template Haskell
 description:         This package contains the internals of the @parsley@ package.
                      .
diff --git a/src/ghc/Parsley/Internal/Backend/CodeGenerator.hs b/src/ghc/Parsley/Internal/Backend/CodeGenerator.hs
--- a/src/ghc/Parsley/Internal/Backend/CodeGenerator.hs
+++ b/src/ghc/Parsley/Internal/Backend/CodeGenerator.hs
@@ -35,19 +35,17 @@
     name = maybe "TOP LEVEL" show letBound
     m = finalise (histo alg p)
     alg :: PositionOps o => Combinator (Cofree Combinator (CodeGen o a)) x -> CodeGen o a x
-    alg = peephole |> (\x -> CodeGen (direct (imap extract x)))
+    alg = deep |> (\x -> CodeGen (shallow (imap extract x)))
     finalise cg =
       let m = runCodeGenStack (runCodeGen cg (In4 Ret)) μ0 0 σ0
       in if isJust letBound then m else addCoins (coinsNeeded m) m
 
-pattern (:<$>:) :: Core.Defunc (a -> b) -> k a -> Combinator (Cofree Combinator k) b
-pattern f :<$>: p <- (_ :< Pure f) :<*>: (p :< _)
+pattern (:<$>:) :: Core.Defunc (a -> b) -> Cofree Combinator k a -> Combinator (Cofree Combinator k) b
+pattern f :<$>: p <- (_ :< Pure f) :<*>: p
 pattern (:$>:) :: Combinator (Cofree Combinator k) a -> Core.Defunc b -> Combinator (Cofree Combinator k) b
 pattern p :$>: x <- (_ :< p) :*>: (_ :< Pure x)
-pattern LiftA2 :: Core.Defunc (a -> b -> c) -> k a -> k b -> Combinator (Cofree Combinator k) c
-pattern LiftA2 f p q <- (_ :< ((_ :< Pure f) :<*>: (p :< _))) :<*>: (q :< _)
---pattern TryOrElse ::  k a -> k a -> Combinator (Cofree Combinator k) a
---pattern TryOrElse p q <- (_ :< Try (p :< _)) :<|>: (q :< _)
+pattern TryOrElse ::  k a -> k a -> Combinator (Cofree Combinator k) a
+pattern TryOrElse p q <- (_ :< Try (p :< _)) :<|>: (q :< _)
 
 rollbackHandler :: Fix4 (Instr o) (o : xs) (Succ n) r a
 rollbackHandler = In4 (Seek (In4 Empt))
@@ -55,72 +53,77 @@
 parsecHandler :: PositionOps o => Fix4 (Instr o) xs (Succ n) r a -> Fix4 (Instr o) (o : xs) (Succ n) r a
 parsecHandler k = In4 (Tell (In4 (Lift2 SAME (In4 (If k (In4 Empt))))))
 
-peephole :: PositionOps o => Combinator (Cofree Combinator (CodeGen o a)) x -> Maybe (CodeGen o a x)
-peephole (f :<$>: p) = Just $ CodeGen $ \m -> runCodeGen p (In4 (Fmap (USER f) m))
-peephole (LiftA2 f p q) = Just $ CodeGen $ \m ->
-  do qc <- runCodeGen q (In4 (Lift2 (USER f) m))
-     runCodeGen p qc
-{-peephole (TryOrElse p q) = Just $ CodeGen $ \m -> -- FIXME!
-  do (binder, φ) <- makeΦ m
-     pc <- freshΦ (runCodeGen p (deadCommitOptimisation φ))
-     fmap (binder . In4 . Catch pc . In4 . Seek) (freshΦ (runCodeGen q φ))-}
-peephole ((_ :< (Try (p :< _) :$>: x)) :<|>: (q :< _)) = Just $ CodeGen $ \m ->
-  do (binder, φ) <- makeΦ m
-     pc <- freshΦ (runCodeGen p (deadCommitOptimisation (In4 (Pop (In4 (Push (USER x) φ))))))
-     fmap (binder . In4 . Catch pc . In4 . Seek) (freshΦ (runCodeGen q φ))
-peephole (MetaCombinator RequiresCut (_ :< ((p :< _) :<|>: (q :< _)))) = Just $ CodeGen $ \m ->
+altNoCutCompile :: CodeGen o a y -> CodeGen o a x
+                -> (forall n xs r. Fix4 (Instr o) xs (Succ n) r a -> Fix4 (Instr o) (o : xs) (Succ n) r a)
+                -> (forall n xs r. Fix4 (Instr o) (x : xs) n r a  -> Fix4 (Instr o) (y : xs) n r a)
+                -> Fix4 (Instr o) (x : xs) (Succ n) r a -> CodeGenStack (Fix4 (Instr o) xs (Succ n) r a)
+altNoCutCompile p q handler post m =
   do (binder, φ) <- makeΦ m
-     pc <- freshΦ (runCodeGen p (deadCommitOptimisation φ))
+     pc <- freshΦ (runCodeGen p (deadCommitOptimisation (post φ)))
      qc <- freshΦ (runCodeGen q φ)
-     return $! binder (In4 (Catch pc (parsecHandler qc)))
-peephole (MetaCombinator RequiresCut (_ :< ChainPre (op :< _) (p :< _))) = Just $ CodeGen $ \m ->
+     let np = coinsNeeded pc
+     let nq = coinsNeeded qc
+     let dp = np - min np nq
+     let dq = nq - min np nq
+     return $! binder (In4 (Catch (addCoins dp pc) (handler (addCoins dq qc))))
+
+chainPreCompile :: PositionOps o => CodeGen o a (x -> x) -> CodeGen o a x
+                -> (forall n xs r. Fix4 (Instr o) xs (Succ n) r a -> Fix4 (Instr o) xs (Succ n) r a)
+                -> (forall n xs r. Fix4 (Instr o) xs (Succ n) r a -> Fix4 (Instr o) xs (Succ n) r a)
+                -> Fix4 (Instr o) (x : xs) (Succ n) r a -> CodeGenStack (Fix4 (Instr o) xs (Succ n) r a)
+chainPreCompile op p preOp preP m =
   do μ <- askM
      σ <- freshΣ
      opc <- freshM (runCodeGen op (In4 (Fmap (USER (FLIP_H COMPOSE)) (In4 (_Modify σ (In4 (Jump μ)))))))
      pc <- freshM (runCodeGen p (In4 (App m)))
-     return $! In4 (Push (USER ID) (In4 (_Make σ (In4 (Iter μ opc (parsecHandler (In4 (_Get σ (addCoins (coinsNeeded pc) pc)))))))))
-peephole (MetaCombinator RequiresCut (_ :< ChainPost (p :< _) (op :< _))) = Just $ CodeGen $ \m ->
+     return $! In4 (Push (USER ID) (In4 (_Make σ (In4 (Iter μ (preOp opc) (parsecHandler (In4 (_Get σ (preP pc)))))))))
+
+chainPostCompile :: PositionOps o => CodeGen o a x -> CodeGen o a (x -> x)
+                 -> (forall n xs r. Fix4 (Instr o) xs (Succ n) r a -> Fix4 (Instr o) xs (Succ n) r a)
+                 -> (forall n xs r. Fix4 (Instr o) xs (Succ n) r a -> Fix4 (Instr o) xs (Succ n) r a)
+                 -> Fix4 (Instr o) (x : xs) (Succ n) r a -> CodeGenStack (Fix4 (Instr o) xs (Succ n) r a)
+chainPostCompile p op preOp preM m =
   do μ <- askM
      σ <- freshΣ
-     let nm = coinsNeeded m
      opc <- freshM (runCodeGen op (In4 (_Modify σ (In4 (Jump μ)))))
-     freshM (runCodeGen p (In4 (_Make σ (In4 (Iter μ opc (parsecHandler (In4 (_Get σ (addCoins nm m)))))))))
-peephole (MetaCombinator Cut (_ :< ChainPre (op :< _) (p :< _))) = Just $ CodeGen $ \m ->
-  do μ <- askM
-     σ <- freshΣ
-     opc <- freshM (runCodeGen op (In4 (Fmap (USER (FLIP_H COMPOSE)) (In4 (_Modify σ (In4 (Jump μ)))))))
-     let nop = coinsNeeded opc
-     pc <- freshM (runCodeGen p (In4 (App m)))
-     return $! In4 (Push (USER ID) (In4 (_Make σ (In4 (Iter μ (addCoins nop opc) (parsecHandler (In4 (_Get σ (addCoins (coinsNeeded pc) pc)))))))))
--- TODO: One more for fmap try
-peephole _ = Nothing
+     freshM (runCodeGen p (In4 (_Make σ (In4 (Iter μ (preOp opc) (parsecHandler (In4 (_Get σ (preM m)))))))))
 
-direct :: PositionOps o => Combinator (CodeGen o a) x -> Fix4 (Instr o) (x : xs) (Succ n) r a -> CodeGenStack (Fix4 (Instr o) xs (Succ n) r a)
-direct (Pure x)      m = do return $! In4 (Push (USER x) m)
-direct (Satisfy p)   m = do return $! In4 (Sat (USER p) m)
-direct (pf :<*>: px) m = do pxc <- runCodeGen px (In4 (App m)); runCodeGen pf pxc
-direct (p :*>: q)    m = do qc <- runCodeGen q m; runCodeGen p (In4 (Pop qc))
-direct (p :<*: q)    m = do qc <- runCodeGen q (In4 (Pop m)); runCodeGen p qc
-direct Empty         _ = do return $! In4 Empt
-direct (p :<|>: q) m =
+deep :: PositionOps o => Combinator (Cofree Combinator (CodeGen o a)) x -> Maybe (CodeGen o a x)
+deep (f :<$>: (p :< _)) = Just $ CodeGen $ \m -> runCodeGen p (In4 (Fmap (USER f) m))
+deep (TryOrElse p q) = Just $ CodeGen $ altNoCutCompile p q (In4 . Seek) id
+deep ((_ :< (Try (p :< _) :$>: x)) :<|>: (q :< _)) = Just $ CodeGen $ altNoCutCompile p q (In4 . Seek) (In4 . Pop . In4 . Push (USER x))
+deep ((_ :< (f :<$>: (_ :< Try (p :< _)))) :<|>: (q :< _)) = Just $ CodeGen $ altNoCutCompile p q (In4 . Seek) (In4 . Fmap (USER f))
+deep (MetaCombinator RequiresCut (_ :< ((p :< _) :<|>: (q :< _)))) = Just $ CodeGen $ \m ->
   do (binder, φ) <- makeΦ m
      pc <- freshΦ (runCodeGen p (deadCommitOptimisation φ))
      qc <- freshΦ (runCodeGen q φ)
-     let np = coinsNeeded pc
-     let nq = coinsNeeded qc
-     let dp = np - min np nq
-     let dq = nq - min np nq
-     return $! binder (In4 (Catch (addCoins dp pc) (parsecHandler (addCoins dq qc))))
-direct (Try p)       m = do fmap (In4 . flip Catch rollbackHandler) (runCodeGen p (deadCommitOptimisation m))
-direct (LookAhead p) m =
+     return $! binder (In4 (Catch pc (parsecHandler qc)))
+deep (MetaCombinator RequiresCut (_ :< ChainPre (op :< _) (p :< _))) = Just $ CodeGen $ chainPreCompile op p id addCoinsNeeded
+deep (MetaCombinator RequiresCut (_ :< ChainPost (p :< _) (op :< _))) = Just $ CodeGen $ chainPostCompile p op id addCoinsNeeded
+deep (MetaCombinator Cut (_ :< ChainPre (op :< _) (p :< _))) = Just $ CodeGen $ chainPreCompile op p addCoinsNeeded addCoinsNeeded
+deep _ = Nothing
+
+addCoinsNeeded :: Fix4 (Instr o) xs (Succ n) r a -> Fix4 (Instr o) xs (Succ n) r a
+addCoinsNeeded = coinsNeeded >>= addCoins
+
+shallow :: PositionOps o => Combinator (CodeGen o a) x -> Fix4 (Instr o) (x : xs) (Succ n) r a -> CodeGenStack (Fix4 (Instr o) xs (Succ n) r a)
+shallow (Pure x)      m = do return $! In4 (Push (USER x) m)
+shallow (Satisfy p)   m = do return $! In4 (Sat (USER p) m)
+shallow (pf :<*>: px) m = do pxc <- runCodeGen px (In4 (App m)); runCodeGen pf pxc
+shallow (p :*>: q)    m = do qc <- runCodeGen q m; runCodeGen p (In4 (Pop qc))
+shallow (p :<*: q)    m = do qc <- runCodeGen q (In4 (Pop m)); runCodeGen p qc
+shallow Empty         _ = do return $! In4 Empt
+shallow (p :<|>: q)   m = do altNoCutCompile p q parsecHandler id m
+shallow (Try p)       m = do fmap (In4 . flip Catch rollbackHandler) (runCodeGen p (deadCommitOptimisation m))
+shallow (LookAhead p) m =
   do n <- fmap coinsNeeded (runCodeGen p (In4 Empt)) -- Dodgy hack, but oh well
      fmap (In4 . Tell) (runCodeGen p (In4 (Swap (In4 (Seek (refundCoins n m))))))
-direct (NotFollowedBy p) m =
+shallow (NotFollowedBy p) m =
   do pc <- runCodeGen p (In4 (Pop (In4 (Seek (In4 (Commit (In4 Empt)))))))
      let np = coinsNeeded pc
      let nm = coinsNeeded m
      return $! In4 (Catch (addCoins (max (np - nm) 0) (In4 (Tell pc))) (In4 (Seek (In4 (Push (USER UNIT) m)))))
-direct (Branch b p q) m =
+shallow (Branch b p q) m =
   do (binder, φ) <- makeΦ m
      pc <- freshΦ (runCodeGen p (In4 (Swap (In4 (App φ)))))
      qc <- freshΦ (runCodeGen q (In4 (Swap (In4 (App φ)))))
@@ -128,32 +131,21 @@
      let dp = max 0 (coinsNeeded pc - minc)
      let dq = max 0 (coinsNeeded qc - minc)
      fmap binder (runCodeGen b (In4 (Case (addCoins dp pc) (addCoins dq qc))))
-direct (Match p fs qs def) m =
+shallow (Match p fs qs def) m =
   do (binder, φ) <- makeΦ m
      qcs <- traverse (\q -> freshΦ (runCodeGen q φ)) qs
      defc <- freshΦ (runCodeGen def φ)
      let minc = coinsNeeded (In4 (Choices (map USER fs) qcs defc))
      let defc':qcs' = map (max 0 . subtract minc . coinsNeeded >>= addCoins) (defc:qcs)
      fmap binder (runCodeGen p (In4 (Choices (map USER fs) qcs' defc')))
-direct (Let _ μ _) m = return $! tailCallOptimise μ m
-direct (ChainPre op p) m =
-  do μ <- askM
-     σ <- freshΣ
-     opc <- freshM (runCodeGen op (In4 (Fmap (USER (FLIP_H COMPOSE)) (In4 (_Modify σ (In4 (Jump μ)))))))
-     let nop = coinsNeeded opc
-     pc <- freshM (runCodeGen p (In4 (App m)))
-     return $! In4 (Push (USER ID) (In4 (_Make σ (In4 (Iter μ (addCoins nop opc) (parsecHandler (In4 (_Get σ pc))))))))
-direct (ChainPost p op) m =
-  do μ <- askM
-     σ <- freshΣ
-     opc <- freshM (runCodeGen op (In4 (_Modify σ (In4 (Jump μ)))))
-     let nop = coinsNeeded opc
-     freshM (runCodeGen p (In4 (_Make σ (In4 (Iter μ (addCoins nop opc) (parsecHandler (In4 (_Get σ m))))))))
-direct (MakeRegister σ p q)   m = do qc <- runCodeGen q m; runCodeGen p (In4 (_Make σ qc))
-direct (GetRegister σ)        m = do return $! In4 (_Get σ m)
-direct (PutRegister σ p)      m = do runCodeGen p (In4 (_Put σ (In4 (Push (USER UNIT) m))))
-direct (Debug name p)         m = do fmap (In4 . LogEnter name) (runCodeGen p (In4 (Commit (In4 (LogExit name m)))))
-direct (MetaCombinator Cut p) m = do runCodeGen p (addCoins (coinsNeeded m) m)
+shallow (Let _ μ _)            m = do return $! tailCallOptimise μ m
+shallow (ChainPre op p)        m = do chainPreCompile op p addCoinsNeeded id m
+shallow (ChainPost p op)       m = do chainPostCompile p op addCoinsNeeded id m
+shallow (MakeRegister σ p q)   m = do qc <- runCodeGen q m; runCodeGen p (In4 (_Make σ qc))
+shallow (GetRegister σ)        m = do return $! In4 (_Get σ m)
+shallow (PutRegister σ p)      m = do runCodeGen p (In4 (_Put σ (In4 (Push (USER UNIT) m))))
+shallow (Debug name p)         m = do fmap (In4 . LogEnter name) (runCodeGen p (In4 (Commit (In4 (LogExit name m)))))
+shallow (MetaCombinator Cut p) m = do runCodeGen p (addCoins (coinsNeeded m) m)
 
 tailCallOptimise :: MVar x -> Fix4 (Instr o) (x : xs) (Succ n) r a -> Fix4 (Instr o) xs (Succ n) r a
 tailCallOptimise μ (In4 Ret) = In4 (Jump μ)
@@ -181,9 +173,9 @@
 makeΦ :: Fix4 (Instr o) (x ': xs) (Succ n) r a -> CodeGenStack (Fix4 (Instr o) xs (Succ n) r a -> Fix4 (Instr o) xs (Succ n) r a, Fix4 (Instr o) (x : xs) (Succ n) r a)
 makeΦ m | elidable m = return $! (id, m)
   where
-    -- This is double-φ optimisation:   If a φ-node points directly to another φ-node, then it can be elided
+    -- This is double-φ optimisation:   If a φ-node points shallowly to another φ-node, then it can be elided
     elidable (In4 (Join _)) = True
-    -- This is terminal-φ optimisation: If a φ-node points directly to a terminal operation, then it can be elided
+    -- This is terminal-φ optimisation: If a φ-node points shallowly to a terminal operation, then it can be elided
     elidable (In4 Ret)      = True
     elidable _              = False
 makeΦ m = let n = coinsNeeded m in fmap (\φ -> (In4 . MkJoin φ (addCoins n m), drainCoins n (In4 (Join φ)))) askΦ
diff --git a/src/ghc/Parsley/Internal/Backend/InstructionAnalyser.hs b/src/ghc/Parsley/Internal/Backend/InstructionAnalyser.hs
--- a/src/ghc/Parsley/Internal/Backend/InstructionAnalyser.hs
+++ b/src/ghc/Parsley/Internal/Backend/InstructionAnalyser.hs
@@ -16,9 +16,12 @@
     algCatch (_, True) k = k
     algCatch (k1, _) (k2, _) = (min k1 k2, False)
 
+    -- Bool represents if an empty is found in a branch (of a Catch)
+    -- This helps to get rid of `min` being used for `Try` where min is always 0
+    -- (The input is needed to _succeed_, so if one branch is doomed to fail it doesn't care about coins)
     alg :: Instr o (Const4 (Int, Bool)) xs n r a -> (Int, Bool)
     alg Ret                                    = (0, False)
-    alg (Push _ (Const4 k))                    = (fst k, False)
+    alg (Push _ k)                             = getConst4 k -- was const False on the second parameter, I think that's probably right but a bit presumptive
     alg (Pop k)                                = getConst4 k
     alg (Lift2 _ k)                            = getConst4 k
     alg (Sat _ (Const4 k))                     = (fst k + 1, snd k)
diff --git a/src/ghc/Parsley/Internal/Backend/Machine/Instructions.hs b/src/ghc/Parsley/Internal/Backend/Machine/Instructions.hs
--- a/src/ghc/Parsley/Internal/Backend/Machine/Instructions.hs
+++ b/src/ghc/Parsley/Internal/Backend/Machine/Instructions.hs
@@ -11,7 +11,7 @@
 import Parsley.Internal.Backend.Machine.Defunc as Machine (Defunc(USER))
 import Parsley.Internal.Core.Defunc            as Core    (Defunc(ID), pattern FLIP_H)
 
-data Instr (o :: rep) (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type]) (n :: Nat) (r :: Type) (a :: Type) where
+data Instr (o :: Type) (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type]) (n :: Nat) (r :: Type) (a :: Type) where
   Ret       :: Instr o k '[x] n x a
   Push      :: Machine.Defunc x -> k (x : xs) n r a -> Instr o k xs n r a
   Pop       :: k xs n r a -> Instr o k (x : xs) n r a