diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,11 @@
+# Revision history for `parsley`
+
+## 0.1.0.0  -- 2021-05-22
+
+* First version. Released on an unsuspecting world.
+
+## 0.1.0.1  -- 2021-05-22
+
+* Moved tests and benchmarks into a subproject, which will be easier later down the line.
+* Removed useless `dump-core` flag (only used by test and bench, not by the library).
+* Fleshed out README properly!
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2019, Jamie Willis
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Jamie Willis nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,72 @@
+# Parsley ![GitHub Workflow Status](https://img.shields.io/github/workflow/status/j-mie6/ParsleyHaskell/CI) ![GitHub release](https://img.shields.io/github/v/release/j-mie6/ParsleyHaskell?include_prereleases&sort=semver) [![GitHub license](https://img.shields.io/github/license/j-mie6/ParsleyHaskell.svg)](https://github.com/j-mie6/ParsleyHakell/blob/master/LICENSE)
+
+## What is Parsley?
+Parsley is a very fast parser combinator library that outperforms the other libraries in both the
+parsec family, as well as Happy. To make this possible, it makes use of Typed Template Haskell
+to generate the code for the parsers.
+
+## How do I use it? ![Hackage Version](https://img.shields.io/hackage/v/parsley)
+Parsley is distributed on Hackage, and can be added by depending on the package `parsley`.
+
+The version policy adheres to the regular Haskell PVP, but the two major versions are distinguished
+in Parsley: the first is the _User API_ major version, which represents backwards incompatible changes
+in the regular PVP sense that could affect any users of the library; the second version is the
+_Internal API_ major version, which would only effect users who use part of the internal parsley
+modules. As such, for people that are **not** explicitly importing anything from `Parsley.Internal`, or
+its submodules, the second major version does not matter: `0.2.0.0` and `0.3.0.0` would be compatible,
+for instance.
+
+To use it, you'll need to write you parsers in another file from where they will be used: this is
+due to Template Haskell.
+
+### How does Parsley being a _Staged Selective_ library change its use?
+By being a _Selective_ Parser Combinator library, Parsley does not support monadic operations such
+as `(>>=)` or `return`. Instead, the most powerful operations are `select` or `branch`. Most monadic
+power can be recovered using the functionality provided by `Parsley.Register`, as well as the
+selectives.
+
+The reason monads are not supported is because of the _Staging_: Parsley parsers are compiled ahead
+of time to produce fast code, but this means the entirety of the parser must be known before any
+input is provided, ruling out dynamic monadic operations. The use of staging (in this instance provided
+by Typed Template Haskell) means that the signatures of the combinators do not correspond to their
+counterparts in other libraries: they don't use raw values, they use code of values. A consequence
+of this is that Parsley does not implement instances of `Functor`, `Applicative`, `Alternative`,
+or indeed `Selective`; `do`-notation also cannot be used even with `ApplicativeDo`, except perhaps
+if `RebindableSyntax` is used.
+
+Code is provided to the combinators by way of the datatype `WQ` (or `Defunc` if you're feeling fancy),
+which pairs a normal value with its Haskell code representation:
+
+```hs
+data WQ a = WQ a (Code a)
+```
+
+This gives us combinators like:
+
+```hs
+pure :: WQ a -> Parser a
+satisfy :: WQ a -> Parser a
+
+char :: Char -> Parser a
+char c = satisfy (WQ (== c) [||(== c)||])
+```
+
+Using `WQ` explicitly like this can get annoying, which is what the `lift-plugin` and the
+`idioms-plugin` are both for: versions compatible with Parsley can be found on my GitHub, and the
+`cabal.project` in this repo shows how these should be installed until they are properly released.
+
+## How does it work?
+In short, Parsley represents all parsers as Abstract Syntax Trees (ASTs). The representation of the
+parsers the users write is called the Combinator Tree, which is analysed and optimised by Parsley.
+This representation is then transformed into an Abstract Machine in CPS form, this is analysed further
+before being partially evaluated at compile-time to generate high quality Haskell code. For the long
+version, I'd recommend checking out the paper!
+
+## Bug Reports
+If you encounter a bug when using Parsley, try and minimise the example of the parser (and the input)
+that triggers the bug. If possible, make a self contained example: this will help me to identify the
+issue without too much issue. It might be helpful to import `Parsley.Internal.Verbose` to provide a
+debug dump that I can check out.
+
+## References
+* This work spawned a paper at ICFP 2020: [**Staged Selective Parser Combinators**](https://dl.acm.org/doi/10.1145/3409002)
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/parsley.cabal b/parsley.cabal
new file mode 100644
--- /dev/null
+++ b/parsley.cabal
@@ -0,0 +1,153 @@
+cabal-version:       2.2
+name:                parsley
+-- https://wiki.haskell.org/Package_versioning_policy
+-- PVP summary:      +--------- breaking API changes
+--                   | +------- breaking internal API changes
+--                   | | +----- non-breaking API additions
+--                   | | | +--- code changes with no API change
+version:             0.1.0.1
+synopsis:            A fast parser combinator library backed by Typed Template Haskell
+description:         Parsley is a staged selective parser combinator library, which means
+                     it does not support monadic operations, and relies on Typed Template
+                     Haskell to generate very fast code. Currently there are no error messages
+                     but there are plans for this in the works.
+                     .
+                     Based on the work found in [/Staged Selective Parser Combinators/
+                     (Willis et al. 2020)](https://dl.acm.org/doi/10.1145/3409002)
+                     .
+                     While this library adheres to the Haskell PVP, it additionally
+                     enforces an additional constraint: the version @M.I.m.p@ represents
+                     a breaking change to the /user/ API @M@, a breaking change
+                     to the /internal/ API @I@ (which will not affect most users), an addition
+                     to either API @m@, and patches or performance improvements @p@.
+                     As such, users should feel free to bound themselves on the next @M@
+                     version of the library as opposed to the second @I@ version if they
+                     do not make use of the "Parsley.Internal" package or any of its children.
+
+
+homepage:            https://github.com/j-mie6/ParsleyHaskell
+bug-reports:         https://github.com/j-mie6/ParsleyHaskell/issues
+license:             BSD-3-Clause
+license-file:        LICENSE
+author:              Jamie Willis
+maintainer:          Jamie Willis <j.willis19@imperial.ac.uk>
+category:            Parsing
+build-type:          Simple
+extra-doc-files:     ChangeLog.md
+                     README.md
+tested-with:         GHC == 8.6.1, GHC == 8.6.2, GHC == 8.6.3, GHC == 8.6.4, GHC == 8.6.5,
+                     GHC == 8.8.1, GHC == 8.8.2, GHC == 8.8.3, GHC == 8.8.4,
+                     GHC == 8.10.4
+
+library
+  exposed-modules:     Parsley,
+                       Parsley.Applicative,
+                       Parsley.Alternative,
+                       Parsley.Defunctionalized,
+                       Parsley.Selective,
+                       Parsley.Register,
+                       Parsley.Combinator,
+                       Parsley.Fold,
+                       Parsley.InputExtras,
+                       Parsley.Precedence
+
+                       Parsley.Internal,
+                       Parsley.Internal.Trace,
+                       Parsley.Internal.Verbose,
+
+                       Parsley.Internal.Common,
+                       Parsley.Internal.Common.Fresh,
+                       Parsley.Internal.Common.Indexed,
+                       Parsley.Internal.Common.Queue,
+                       Parsley.Internal.Common.State,
+                       Parsley.Internal.Common.Utils,
+                       Parsley.Internal.Common.Vec,
+
+                       Parsley.Internal.Core,
+                       Parsley.Internal.Core.CombinatorAST,
+                       Parsley.Internal.Core.Defunc,
+                       Parsley.Internal.Core.Identifiers,
+                       Parsley.Internal.Core.InputTypes,
+                       Parsley.Internal.Core.Primitives,
+
+                       Parsley.Internal.Frontend,
+                       Parsley.Internal.Frontend.CombinatorAnalyser,
+                       Parsley.Internal.Frontend.Compiler,
+                       Parsley.Internal.Frontend.Dependencies,
+                       Parsley.Internal.Frontend.Optimiser,
+
+                       Parsley.Internal.Backend,
+                       Parsley.Internal.Backend.CodeGenerator,
+                       Parsley.Internal.Backend.InstructionAnalyser,
+                       Parsley.Internal.Backend.Optimiser,
+
+                       Parsley.Internal.Backend.Machine,
+                       Parsley.Internal.Backend.Machine.Defunc,
+                       Parsley.Internal.Backend.Machine.Eval,
+                       Parsley.Internal.Backend.Machine.LetBindings,
+                       Parsley.Internal.Backend.Machine.LetRecBuilder,
+                       Parsley.Internal.Backend.Machine.Identifiers,
+                       Parsley.Internal.Backend.Machine.InputOps,
+                       Parsley.Internal.Backend.Machine.InputRep,
+                       Parsley.Internal.Backend.Machine.Instructions,
+                       Parsley.Internal.Backend.Machine.Ops,
+                       Parsley.Internal.Backend.Machine.State
+
+  default-extensions:  BangPatterns,
+                       DataKinds,
+                       GADTs,
+                       FlexibleContexts,
+                       FlexibleInstances,
+                       KindSignatures,
+                       PolyKinds,
+                       RankNTypes,
+                       ScopedTypeVariables,
+                       TemplateHaskell,
+                       TypeOperators,
+
+                       NoStarIsType
+
+--                     ghc                  >= 8.6     && < 9.2,
+  build-depends:       base                 >= 4.10    && < 4.16,
+                       mtl                  >= 2.2.1   && < 2.3,
+                       hashable             >= 1.2.7.0 && < 1.4,
+                       unordered-containers >= 0.2.13  && < 0.3,
+                       array                >= 0.5.2   && < 0.6,
+                       ghc-prim             >= 0.5.3   && < 1,
+                       template-haskell     >= 2.14    && < 3,
+                       containers           >= 0.6     && < 0.7,
+                       dependent-map        >= 0.4.0   && < 0.5,
+                       dependent-sum        >= 0.7.1   && < 0.8,
+                       pretty-terminal      >= 0.1.0   && < 0.2,
+                       text                 >= 1.2.3   && < 1.3,
+                       -- Not sure about this one, 0.11.0.0 introduced a type synonym for PS, so it _should_ work
+                       bytestring           >= 0.10.8  && < 0.12
+  build-tool-depends:  cpphs:cpphs          >= 1.19
+  hs-source-dirs:      src/ghc
+  if impl(ghc >= 8.10)
+    hs-source-dirs:    src/ghc-8.10+
+  else
+    hs-source-dirs:    src/ghc-8.6+
+  default-language:    Haskell2010
+  ghc-options:         -Wall -Weverything -Wcompat
+                       -Wno-unticked-promoted-constructors
+                       -Wno-name-shadowing
+                       -Wno-unused-do-bind
+                       -Wno-implicit-prelude
+                       -Wno-missing-import-lists
+                       -Wno-missing-local-signatures
+                       -Wno-safe
+                       -Wno-unsafe
+                       -Wno-missed-specialisations
+                       -Wno-all-missed-specialisations
+                       -Wno-incomplete-uni-patterns
+                       -pgmP cpphs -optP --cpp
+                       -freverse-errors
+  if impl(ghc >= 8.10)
+    ghc-options:       -Wno-missing-safe-haskell-mode
+                       -Wno-prepositive-qualified-module
+                       -Wno-unused-packages
+
+source-repository head
+  type:                git
+  location:            https://github.com/j-mie6/HaskellParsley
diff --git a/src/ghc-8.10+/Parsley/Internal/Backend/Machine.hs b/src/ghc-8.10+/Parsley/Internal/Backend/Machine.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc-8.10+/Parsley/Internal/Backend/Machine.hs
@@ -0,0 +1,49 @@
+{-|
+Module      : Parsley.Internal.Backend.Machine
+Description : The implementation of the low level parsing machinery is found here
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : unstable
+
+@since 0.1.0.0
+-}
+module Parsley.Internal.Backend.Machine (
+    Input, eval,
+    PositionOps,
+    module Parsley.Internal.Backend.Machine.Instructions,
+    module Parsley.Internal.Backend.Machine.Defunc,
+    module Parsley.Internal.Backend.Machine.Identifiers,
+    module Parsley.Internal.Backend.Machine.LetBindings
+  ) where
+
+import Data.Array.Unboxed                            (UArray)
+import Data.ByteString                               (ByteString)
+import Data.Dependent.Map                            (DMap)
+import Data.Text                                     (Text)
+import Parsley.Internal.Backend.Machine.Defunc       (Defunc(..))
+import Parsley.Internal.Backend.Machine.Identifiers
+import Parsley.Internal.Backend.Machine.InputOps     (InputPrep(..), PositionOps)
+import Parsley.Internal.Backend.Machine.Instructions
+import Parsley.Internal.Backend.Machine.LetBindings  (LetBinding, makeLetBinding)
+import Parsley.Internal.Backend.Machine.Ops          (Ops)
+import Parsley.Internal.Common.Utils                 (Code)
+import Parsley.Internal.Core.InputTypes
+import Parsley.Internal.Trace                        (Trace)
+
+import qualified Data.ByteString.Lazy as Lazy (ByteString)
+import qualified Parsley.Internal.Backend.Machine.Eval as Eval (eval)
+
+eval :: forall input a. (Input input, Trace) => Code input -> (LetBinding input a a, DMap MVar (LetBinding input a)) -> Code (Maybe a)
+eval input (toplevel, bindings) = Eval.eval (prepare input) toplevel bindings
+
+class (InputPrep input, Ops input) => Input input
+instance Input [Char]
+instance Input (UArray Int Char)
+instance Input Text16
+instance Input ByteString
+instance Input CharList
+instance Input Text
+--instance Input CacheText
+instance Input Lazy.ByteString
+--instance Input Lazy.ByteString
+instance Input Stream
diff --git a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Defunc.hs b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Defunc.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Defunc.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE StandaloneKindSignatures, TypeApplications #-}
+module Parsley.Internal.Backend.Machine.Defunc (module Parsley.Internal.Backend.Machine.Defunc) where
+
+import Data.Proxy                                (Proxy(Proxy))
+import Parsley.Internal.Backend.Machine.InputOps (PositionOps(same))
+import Parsley.Internal.Backend.Machine.InputRep (Rep)
+import Parsley.Internal.Common.Utils             (Code, WQ(WQ))
+
+import qualified Parsley.Internal.Core.Defunc as Core (Defunc(BLACK), ap, genDefunc, genDefunc1, genDefunc2)
+
+data Defunc a where
+  USER    :: Core.Defunc a -> Defunc a
+  BOTTOM  :: Defunc a
+  SAME    :: PositionOps o => Defunc (o -> o -> Bool)
+  FREEVAR :: Code a -> Defunc a
+  OFFSET  :: Code (Rep o) -> Defunc o
+
+ap2 :: Defunc (a -> b -> c) -> Defunc a -> Defunc b -> Defunc c
+ap2 f@SAME (OFFSET o1) (OFFSET o2) = USER (black (apSame f o1 o2))
+  where
+    apSame :: forall o. Defunc (o -> o -> Bool) -> Code (Rep o) -> Code (Rep o) -> Code Bool
+    apSame SAME = same (Proxy @o)
+    apSame _    = undefined
+ap2 f x y = USER (Core.ap (Core.ap (seal f) (seal x)) (seal y))
+  where
+    seal :: Defunc a -> Core.Defunc a
+    seal (USER x) = x
+    seal x        = black (genDefunc x)
+
+black :: Code a -> Core.Defunc a
+black = Core.BLACK . WQ undefined
+
+genDefunc :: Defunc a -> Code a
+genDefunc (USER x)    = Core.genDefunc x
+genDefunc BOTTOM      = [||undefined||]
+genDefunc (FREEVAR x) = x
+genDefunc SAME        = error "Cannot materialise the same function in the regular way"
+genDefunc (OFFSET _)  = error "Cannot materialise an unboxed offset in the regular way"
+
+genDefunc1 :: Defunc (a -> b) -> Code a -> Code b
+genDefunc1 (USER f) qx = Core.genDefunc1 f qx
+genDefunc1 f qx        = [|| $$(genDefunc f) $$qx ||]
+
+genDefunc2 :: Defunc (a -> b -> c) -> Code a -> Code b -> Code c
+genDefunc2 (USER f) qx qy = Core.genDefunc2 f qx qy
+genDefunc2 f qx qy        = [|| $$(genDefunc f) $$qx $$qy ||]
+
+instance Show (Defunc a) where
+  show (USER x) = show x
+  show SAME = "same"
+  show BOTTOM = "[[irrelevant]]"
+  show (FREEVAR _) = "x"
+  show (OFFSET _)  = "an offset"
diff --git a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Eval.hs b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Eval.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Eval.hs
@@ -0,0 +1,185 @@
+{-# LANGUAGE ImplicitParams,
+             MultiWayIf,
+             RecordWildCards,
+             TypeApplications,
+             UnboxedTuples #-}
+module Parsley.Internal.Backend.Machine.Eval (eval) where
+
+import Data.Dependent.Map                             (DMap)
+import Data.Functor                                   ((<&>))
+import Data.Void                                      (Void)
+import Control.Monad                                  (forM, liftM2)
+import Control.Monad.Reader                           (ask, asks, local)
+import Control.Monad.ST                               (runST)
+import Parsley.Internal.Backend.Machine.Defunc        (Defunc(FREEVAR, OFFSET), genDefunc, genDefunc1, ap2)
+import Parsley.Internal.Backend.Machine.Identifiers   (MVar(..), ΦVar, ΣVar)
+import Parsley.Internal.Backend.Machine.InputOps      (InputDependant, PositionOps, LogOps, InputOps(InputOps))
+import Parsley.Internal.Backend.Machine.InputRep      (Rep)
+import Parsley.Internal.Backend.Machine.Instructions  (Instr(..), MetaInstr(..), Access(..))
+import Parsley.Internal.Backend.Machine.LetBindings   (LetBinding(..))
+import Parsley.Internal.Backend.Machine.LetRecBuilder
+import Parsley.Internal.Backend.Machine.Ops
+import Parsley.Internal.Backend.Machine.State
+import Parsley.Internal.Common                        (Fix4, cata4, One, Code, Vec(..), Nat(..))
+import Parsley.Internal.Trace                         (Trace(trace))
+import System.Console.Pretty                          (color, Color(Green))
+
+import qualified Debug.Trace (trace)
+
+eval :: forall o a. (Trace, Ops o) => Code (InputDependant (Rep o)) -> LetBinding o a a -> DMap MVar (LetBinding o a) -> Code (Maybe a)
+eval input (LetBinding !p _) fs = trace ("EVALUATING TOP LEVEL") [|| runST $
+  do let (# next, more, offset #) = $$input
+     $$(let ?ops = InputOps [||more||] [||next||]
+        in letRec fs
+             nameLet
+             (\exp rs names -> buildRec rs (emptyCtx names) (readyMachine exp))
+             (\names -> run (readyMachine p) (Γ Empty (halt @o) [||offset||] (VCons (fatal @o) VNil)) (emptyCtx names)))
+  ||]
+  where
+    nameLet :: MVar x -> String
+    nameLet (MVar i) = "sub" ++ show i
+
+readyMachine :: (?ops :: InputOps (Rep o), Ops o, Trace) => Fix4 (Instr o) xs n r a -> Machine s o xs n r a
+readyMachine = cata4 (Machine . alg)
+  where
+    alg :: (?ops :: InputOps (Rep o), Ops o) => Instr o (Machine s o) xs n r a -> MachineMonad s o xs n r a
+    alg Ret                 = evalRet
+    alg (Call μ k)          = evalCall μ k
+    alg (Jump μ)            = evalJump μ
+    alg (Push x k)          = evalPush x k
+    alg (Pop k)             = evalPop k
+    alg (Lift2 f k)         = evalLift2 f k
+    alg (Sat p k)           = evalSat p k
+    alg Empt                = evalEmpt
+    alg (Commit k)          = evalCommit k
+    alg (Catch k h)         = evalCatch k h
+    alg (Tell k)            = evalTell k
+    alg (Seek k)            = evalSeek k
+    alg (Case p q)          = evalCase p q
+    alg (Choices fs ks def) = evalChoices fs ks def
+    alg (Iter μ l k)        = evalIter μ l k
+    alg (Join φ)            = evalJoin φ
+    alg (MkJoin φ p k)      = evalMkJoin φ p k
+    alg (Swap k)            = evalSwap k
+    alg (Dup k)             = evalDup k
+    alg (Make σ c k)        = evalMake σ c k
+    alg (Get σ c k)         = evalGet σ c k
+    alg (Put σ c k)         = evalPut σ c k
+    alg (LogEnter name k)   = evalLogEnter name k
+    alg (LogExit name k)    = evalLogExit name k
+    alg (MetaInstr m k)     = evalMeta m k
+
+evalRet :: MachineMonad s o (x : xs) n x a
+evalRet = return $! retCont >>= resume
+
+evalCall :: forall s o a x xs n r. ContOps o => MVar x -> Machine s o (x : xs) (Succ n) r a -> MachineMonad s o xs (Succ n) r a
+evalCall μ (Machine k) = liftM2 (\mk sub γ@Γ{..} -> callWithContinuation @o sub (suspend mk γ) input handlers) k (askSub μ)
+
+evalJump :: forall s o a x n. MVar x -> MachineMonad s o '[] (Succ n) x a
+evalJump μ = askSub μ <&> \sub Γ{..} -> callWithContinuation @o sub retCont input handlers
+
+evalPush :: Defunc x -> Machine s o (x : xs) n r a -> MachineMonad s o xs n r a
+evalPush x (Machine k) = k <&> \m γ -> m (γ {operands = Op x (operands γ)})
+
+evalPop :: Machine s o xs n r a -> MachineMonad s o (x : xs) n r a
+evalPop (Machine k) = k <&> \m γ -> m (γ {operands = let Op _ xs = operands γ in xs})
+
+evalLift2 :: Defunc (x -> y -> z) -> Machine s o (z : xs) n r a -> MachineMonad s o (y : x : xs) n r a
+evalLift2 f (Machine k) = k <&> \m γ -> m (γ {operands = let Op y (Op x xs) = operands γ in Op (ap2 f x y) xs})
+
+evalSat :: (?ops :: InputOps (Rep o), PositionOps o, Trace) => Defunc (Char -> Bool) -> Machine s o (Char : xs) (Succ n) r a -> MachineMonad s o xs (Succ n) r a
+evalSat p (Machine k) = do
+  bankrupt <- asks isBankrupt
+  hasChange <- asks hasCoin
+  if | bankrupt -> maybeEmitCheck (Just 1) <$> k
+     | hasChange -> maybeEmitCheck Nothing <$> local spendCoin k
+     | otherwise -> trace "I have a piggy :)" $ local breakPiggy (maybeEmitCheck . Just <$> asks coins <*> local spendCoin k)
+  where
+    maybeEmitCheck Nothing mk γ = sat (genDefunc1 p) mk (raise γ) γ
+    maybeEmitCheck (Just n) mk γ =
+      [|| let bad = $$(raise γ) in $$(emitLengthCheck n (sat (genDefunc1 p) mk [||bad||]) [||bad||] γ)||]
+
+evalEmpt :: MachineMonad s o xs (Succ n) r a
+evalEmpt = return $! raise
+
+evalCommit :: Machine s o xs n r a -> MachineMonad s o xs (Succ n) r a
+evalCommit (Machine k) = k <&> \mk γ -> let VCons _ hs = handlers γ in mk (γ {handlers = hs})
+
+evalCatch :: HandlerOps o => Machine s o xs (Succ n) r a -> Machine s o (o : xs) n r a -> MachineMonad s o xs n r a
+evalCatch (Machine k) (Machine h) = liftM2 (\mk mh γ -> setupHandler γ (buildHandler γ mh) mk) k h
+
+evalTell :: Machine s o (o : xs) n r a -> MachineMonad s o xs n r a
+evalTell (Machine k) = k <&> \mk γ -> mk (γ {operands = Op (OFFSET (input γ)) (operands γ)})
+
+evalSeek :: Machine s o xs n r a -> MachineMonad s o (o : xs) n r a
+evalSeek (Machine k) = k <&> \mk γ -> let Op (OFFSET input) xs = operands γ in mk (γ {operands = xs, input = input})
+
+evalCase :: Machine s o (x : xs) n r a -> Machine s o (y : xs) n r a -> MachineMonad s o (Either x y : xs) n r a
+evalCase (Machine p) (Machine q) = liftM2 (\mp mq γ ->
+  let Op e xs = operands γ
+  in [||case $$(genDefunc e) of
+    Left x -> $$(mp (γ {operands = Op (FREEVAR [||x||]) xs}))
+    Right y  -> $$(mq (γ {operands = Op (FREEVAR [||y||]) xs}))||]) p q
+
+evalChoices :: [Defunc (x -> Bool)] -> [Machine s o xs n r a] -> Machine s o xs n r a -> MachineMonad s o (x : xs) n r a
+evalChoices fs ks (Machine def) = liftM2 (\mdef mks γ -> let Op x xs = operands γ in go x fs mks mdef (γ {operands = xs}))
+  def
+  (forM ks getMachine)
+  where
+    go x (f:fs) (mk:mks) def γ = [||
+        if $$(genDefunc1 f (genDefunc x)) then $$(mk γ)
+        else $$(go x fs mks def γ)
+      ||]
+    go _ _ _ def γ = def γ
+
+evalIter :: (RecBuilder o, ReturnOps o, HandlerOps o)
+         => MVar Void -> Machine s o '[] One Void a -> Machine s o (o : xs) n r a
+         -> MachineMonad s o xs n r a
+evalIter μ l (Machine h) = liftM2 (\mh ctx γ -> buildIter ctx μ l (buildHandler γ mh) (input γ)) h ask
+
+evalJoin :: ΦVar x -> MachineMonad s o (x : xs) n r a
+evalJoin φ = askΦ φ <&> resume
+
+evalMkJoin :: JoinBuilder o => ΦVar x -> Machine s o (x : xs) n r a -> Machine s o xs n r a -> MachineMonad s o xs n r a
+evalMkJoin = setupJoinPoint
+
+evalSwap :: Machine s o (x : y : xs) n r a -> MachineMonad s o (y : x : xs) n r a
+evalSwap (Machine k) = k <&> \mk γ -> mk (γ {operands = let Op y (Op x xs) = operands γ in Op x (Op y xs)})
+
+evalDup :: Machine s o (x : x : xs) n r a -> MachineMonad s o (x : xs) n r a
+evalDup (Machine k) = k <&> \mk γ ->
+  let Op x xs = operands γ
+  in dup x $ \dupx -> mk (γ {operands = Op dupx (Op dupx xs)})
+
+evalMake :: ΣVar x -> Access -> Machine s o xs n r a -> MachineMonad s o (x : xs) n r a
+evalMake σ a k = asks $! \ctx γ ->
+  let Op x xs = operands γ
+  in newΣ σ a x (run k (γ {operands = xs})) ctx
+
+evalGet :: ΣVar x -> Access -> Machine s o (x : xs) n r a -> MachineMonad s o xs n r a
+evalGet σ a k = asks $! \ctx γ -> readΣ σ a (\x -> run k (γ {operands = Op x (operands γ)})) ctx
+
+evalPut :: ΣVar x -> Access -> Machine s o xs n r a -> MachineMonad s o (x : xs) n r a
+evalPut σ a k = asks $! \ctx γ ->
+  let Op x xs = operands γ
+  in writeΣ σ a x (run k (γ {operands = xs})) ctx
+
+evalLogEnter :: (?ops :: InputOps (Rep o), LogHandler o) => String -> Machine s o xs (Succ (Succ n)) r a -> MachineMonad s o xs (Succ n) r a
+evalLogEnter name (Machine mk) =
+  liftM2 (\k ctx γ -> [|| Debug.Trace.trace $$(preludeString name '>' γ ctx "") $$(setupHandler γ (logHandler name ctx γ) k)||])
+    (local debugUp mk)
+    ask
+
+evalLogExit :: (?ops :: InputOps (Rep o), PositionOps o, LogOps (Rep o)) => String -> Machine s o xs n r a -> MachineMonad s o xs n r a
+evalLogExit name (Machine mk) =
+  liftM2 (\k ctx γ -> [|| Debug.Trace.trace $$(preludeString name '<' γ (debugDown ctx) (color Green " Good")) $$(k γ) ||])
+    (local debugDown mk)
+    ask
+
+evalMeta :: (?ops :: InputOps (Rep o), PositionOps o) => MetaInstr n -> Machine s o xs n r a -> MachineMonad s o xs n r a
+evalMeta (AddCoins coins) (Machine k) =
+  do requiresPiggy <- asks hasCoin
+     if requiresPiggy then local (storePiggy coins) k
+     else local (giveCoins coins) k <&> \mk γ -> emitLengthCheck coins mk (raise γ) γ
+evalMeta (RefundCoins coins) (Machine k) = local (giveCoins coins) k
+evalMeta (DrainCoins coins) (Machine k) = liftM2 (\n mk γ -> emitLengthCheck n mk (raise γ) γ) (asks ((coins -) . liquidate)) k
diff --git a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/InputOps.hs b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/InputOps.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/InputOps.hs
@@ -0,0 +1,231 @@
+{-# LANGUAGE ImplicitParams,
+             MagicHash,
+             TypeApplications,
+             UnboxedTuples #-}
+module Parsley.Internal.Backend.Machine.InputOps (
+    InputPrep(..), PositionOps(..), LogOps(..),
+    InputOps(..), more, next,
+    InputDependant,
+  ) where
+
+import Data.Array.Base                           (UArray(..), listArray)
+import Data.ByteString.Internal                  (ByteString(..))
+import Data.Text.Array                           (aBA{-, empty-})
+import Data.Text.Internal                        (Text(..))
+import Data.Text.Unsafe                          (iter, Iter(..){-, iter_, reverseIter_-})
+import Data.Proxy                                (Proxy)
+import GHC.Exts                                  (Int(..), Char(..), TYPE, Int#)
+import GHC.ForeignPtr                            (ForeignPtr(..))
+import GHC.Prim                                  (indexWideCharArray#, indexWord16Array#, readWord8OffAddr#, word2Int#, chr#, touch#, realWorld#, plusAddr#, (+#), (-#))
+import Parsley.Internal.Backend.Machine.InputRep
+import Parsley.Internal.Common.Utils             (Code)
+import Parsley.Internal.Core.InputTypes
+
+import qualified Data.ByteString.Lazy.Internal as Lazy (ByteString(..))
+--import qualified Data.Text                     as Text (length, index)
+
+{- Auxillary Representation -}
+type InputDependant (rep :: TYPE r) = (# {-next-} rep -> (# Char, rep #)
+                                       , {-more-} rep -> Bool
+                                       , {-init-} rep
+                                       #)
+
+{- Typeclasses -}
+class InputPrep input where
+  prepare :: rep ~ Rep input => Code input -> Code (InputDependant rep)
+
+class PositionOps input where
+  same :: rep ~ Rep input => Proxy input -> Code rep -> Code rep -> Code Bool
+  shiftRight :: rep ~ Rep input => Proxy input -> Code rep -> Code Int# -> Code rep
+
+class LogOps (rep :: TYPE r) where
+  shiftLeft :: Code rep -> Code Int# -> Code rep
+  offToInt  :: Code rep -> Code Int
+
+data InputOps (rep :: TYPE r) = InputOps { _more       :: Code (rep -> Bool)
+                                         , _next       :: Code (rep -> (# Char, rep #))
+                                         }
+more :: forall r (rep :: TYPE r). (?ops :: InputOps rep) => Code (rep -> Bool)
+more = _more ?ops
+next :: forall r (rep :: TYPE r) a. (?ops :: InputOps rep) => Code rep -> (Code Char -> Code rep -> Code a) -> Code a
+next ts k = [|| let !(# t, ts' #) = $$(_next ?ops) $$ts in $$(k [||t||] [||ts'||]) ||]
+
+{- INSTANCES -}
+-- InputPrep Instances
+instance InputPrep [Char] where
+  prepare input = prepare @(UArray Int Char) [||listArray (0, length $$input-1) $$input||]
+
+instance InputPrep (UArray Int Char) where
+  prepare qinput = [||
+      let UArray _ _ (I# size#) input# = $$qinput
+          next i# = (# C# (indexWideCharArray# input# i#), i# +# 1# #)
+      in (# next, \qi -> $$(intLess [||qi||] [||size#||]), 0# #)
+    ||]
+
+instance InputPrep Text16 where
+  prepare qinput = [||
+      let Text16 (Text arr (I# off#) (I# size#)) = $$qinput
+          arr# = aBA arr
+          next i# = (# C# (chr# (word2Int# (indexWord16Array# arr# i#))), i# +# 1# #)
+      in (# next, \qi -> $$(intLess [||qi||] [||size#||]), off# #)
+    ||]
+
+instance InputPrep ByteString where
+  prepare qinput = [||
+      let PS (ForeignPtr addr# final) (I# off#) (I# size#) = $$qinput
+          next i# =
+            case readWord8OffAddr# (addr# `plusAddr#` i#) 0# realWorld# of
+              (# s', x #) -> case touch# final s' of
+                _ -> (# C# (chr# (word2Int# x)), i# +# 1# #)
+      in  (# next, \qi -> $$(intLess [||qi||] [||size#||]), off# #)
+    ||]
+
+instance InputPrep CharList where
+  prepare qinput = [||
+      let CharList input = $$qinput
+          next (# i#, c:cs #) = (# c, (# i# +# 1#, cs #) #)
+          I# size# = length input
+          more (# i#, _ #) = $$(intLess [||i#||] [||size#||])
+          --more (OffWith _ []) = False
+          --more _              = True
+      in (# next, more, $$(offWith [||input||]) #)
+    ||]
+
+instance InputPrep Text where
+  prepare qinput = [||
+      let next t@(Text arr off unconsumed) = let !(Iter c d) = iter t 0 in (# c, Text arr (off+d) (unconsumed-d) #)
+          more (Text _ _ unconsumed) = unconsumed > 0
+      in (# next, more, $$qinput #)
+    ||]
+
+instance InputPrep Lazy.ByteString where
+  prepare qinput = [||
+      let next (# i#, addr#, final, off#, size#, cs #) =
+            case readWord8OffAddr# addr# off# realWorld# of
+              (# s', x #) -> case touch# final s' of
+                _ -> (# C# (chr# (word2Int# x)),
+                    if I# size# /= 1 then (# i# +# 1#, addr#, final, off# +# 1#, size# -# 1#, cs #)
+                    else case cs of
+                      Lazy.Chunk (PS (ForeignPtr addr'# final') (I# off'#) (I# size'#)) cs' ->
+                        (# i# +# 1#, addr'#, final', off'#, size'#, cs' #)
+                      Lazy.Empty -> $$(emptyUnpackedLazyByteString [||i# +# 1#||])
+                  #)
+          more :: UnpackedLazyByteString -> Bool
+          more (# _, _, _, _, 0#, _ #) = False
+          more (# _, _, _, _, _, _ #) = True
+
+          initial :: UnpackedLazyByteString
+          initial = case $$qinput of
+            Lazy.Chunk (PS (ForeignPtr addr# final) (I# off#) (I# size#)) cs -> (# 0#, addr#, final, off#, size#, cs #)
+            Lazy.Empty -> $$(emptyUnpackedLazyByteString [||0#||])
+      in (# next, more, initial #)
+    ||]
+
+instance InputPrep Stream where
+  prepare qinput = [||
+      let next (# o#, c :> cs #) = (# c, (# o# +# 1#, cs #) #)
+      in (# next, \_ -> True, $$(offWith qinput) #)
+    ||]
+
+shiftRightInt :: Code Int# -> Code Int# -> Code Int#
+shiftRightInt qo# qi# = [||$$(qo#) +# $$(qi#)||]
+
+-- PositionOps Instances
+instance PositionOps [Char] where
+  same _ = intSame
+  shiftRight _ = shiftRightInt
+instance PositionOps (UArray Int Char) where
+  same _ = intSame
+  shiftRight _ = shiftRightInt
+instance PositionOps Text16 where
+  same _ = intSame
+  shiftRight _ = shiftRightInt
+instance PositionOps ByteString where
+  same _ = intSame
+  shiftRight _ = shiftRightInt
+
+instance PositionOps CharList where
+  same _ = offWithSame
+  shiftRight _ qo# qi# = offWithShiftRight [||drop||] qo# qi#
+
+instance PositionOps Stream where
+  same _ = offWithSame
+  shiftRight _ qo# qi# = offWithShiftRight [||dropStream||] qo# qi#
+
+instance PositionOps Text where
+  same _ qt1 qt2 = [||$$(offsetText qt1) == $$(offsetText qt2)||]
+  shiftRight _ qo# qi# = [||textShiftRight $$(qo#) (I# $$(qi#))||]
+
+instance PositionOps Lazy.ByteString where
+  same _ qx# qy# = [||
+      case $$(qx#) of
+        (# i#, _, _, _, _, _ #) -> case $$(qy#) of
+          (# j#, _, _, _, _, _ #) -> $$(intSame [||i#||] [||j#||])
+    ||]
+  shiftRight _ qo# qi# = [||byteStringShiftRight $$(qo#) $$(qi#)||]
+
+-- LogOps Instances
+instance LogOps Int# where
+  shiftLeft qo# qi# = [||max# ($$(qo#) -# $$(qi#)) 0#||]
+  offToInt qi# = [||I# $$(qi#)||]
+
+instance LogOps (# Int#, ts #) where
+  shiftLeft qo# _ = qo#
+  offToInt qo# = [||case $$(qo#) of (# i#, _ #) -> I# i#||]
+
+instance LogOps Text where
+  shiftLeft qo qi# = [||textShiftLeft $$qo (I# $$(qi#))||]
+  offToInt qo = [||case $$qo of Text _ off _ -> div off 2||]
+
+instance LogOps UnpackedLazyByteString where
+  shiftLeft qo# qi# = [||byteStringShiftLeft $$(qo#) $$(qi#)||]
+  offToInt qo# = [||case $$(qo#) of (# i#, _, _, _, _, _ #) -> I# i# ||]
+
+{- Old Instances -}
+{-instance Input CacheText (Text, Stream) where
+  prepare qinput = [||
+      let (CacheText input) = $$qinput
+          next (t@(Text arr off unconsumed), _) = let !(Iter c d) = iter t 0 in (# c, (Text arr (off+d) (unconsumed-d), nomore) #)
+          more (Text _ _ unconsumed, _) = unconsumed > 0
+          same (Text _ i _, _) (Text _ j _, _) = i == j
+          (Text arr off unconsumed, _) << i = go i off unconsumed
+            where
+              go 0 off' unconsumed' = (Text arr off' unconsumed', nomore)
+              go n off' unconsumed'
+                | off' > 0 = let !d = reverseIter_ (Text arr off' unconsumed') 0 in go (n-1) (off'+d) (unconsumed'-d)
+                | otherwise = (Text arr off' unconsumed', nomore)
+          (Text arr off unconsumed, _) >> i = go i off unconsumed
+            where
+              go 0 off' unconsumed' = (Text arr off' unconsumed', nomore)
+              go n off' unconsumed'
+                | unconsumed' > 0 = let !d = iter_ (Text arr off' unconsumed') 0 in go (n-1) (off'+d) (unconsumed'-d)
+                | otherwise = (Text arr off' unconsumed', nomore)
+          toInt (Text arr off unconsumed, _) = div off 2
+          box (# text, cache #) = (text, cache)
+          unbox (text, cache) = (# text, cache #)
+          newCRef (Text _ i _, _) = newSTRefU i
+          readCRef ref = fmap (\i -> (Text empty i 0, nomore)) (readSTRefU ref)
+          writeCRef ref (Text _ i _, _) = writeSTRefU ref i
+      in PreparedInput next more same (input, nomore) box unbox newCRef readCRef writeCRef s(<<) (>>) toInt
+    ||]
+
+instance Input Lazy.ByteString (OffWith Lazy.ByteString) where
+  prepare qinput = [||
+      let next (OffWith i (Lazy.Chunk (PS ptr@(ForeignPtr addr# final) off@(I# off#) size) cs)) =
+            case readWord8OffAddr# addr# off# realWorld# of
+              (# s', x #) -> case touch# final s' of
+                _ -> (# C# (chr# (word2Int# x)), OffWith (i+1) (if size == 1 then cs
+                                                                else Lazy.Chunk (PS ptr (off+1) (size-1)) cs) #)
+          more (OffWith _ Lazy.Empty) = False
+          more _ = True
+          ow@(OffWith _ (Lazy.Empty)) << _ = ow
+          OffWith o (Lazy.Chunk (PS ptr off size) cs) << i =
+            let d = min off i
+            in OffWith (o - d) (Lazy.Chunk (PS ptr (off - d) (size + d)) cs)
+          ow@(OffWith _ Lazy.Empty) >> _ = ow
+          OffWith o (Lazy.Chunk (PS ptr off size) cs) >> i
+            | i < size  = OffWith (o + i) (Lazy.Chunk (PS ptr (off + i) (size - i)) cs)
+            | otherwise = OffWith (o + size) cs >> (i - size)
+          readCRef ref = fmap (\i -> OffWith i Lazy.Empty) (readSTRefU ref)
+      in PreparedInput next more offWithSame (offWith $$qinput) offWithBox offWithUnbox offWithNewORef readCRef offWithWriteORef (<<) (>>) offWithToInt
+    ||]-}
diff --git a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/InputRep.hs b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/InputRep.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/InputRep.hs
@@ -0,0 +1,155 @@
+{-# LANGUAGE MagicHash,
+             TypeFamilies,
+             UnboxedTuples,
+             StandaloneKindSignatures #-}
+module Parsley.Internal.Backend.Machine.InputRep (
+    Rep,
+    intSame, intLess, min#, max#,
+    offWith, offWithSame, offWithShiftRight,
+    --OffWithStreamAnd(..),
+    UnpackedLazyByteString, emptyUnpackedLazyByteString,
+    Stream, dropStream,
+    offsetText,
+    representationTypes,
+    -- These must be exposed
+    textShiftRight, textShiftLeft,
+    byteStringShiftRight, byteStringShiftLeft
+  ) where
+
+import Data.Array.Unboxed                (UArray)
+import Data.ByteString.Internal          (ByteString(..))
+import Data.Kind                         (Type)
+import Data.Text.Internal                (Text(..))
+import Data.Text.Unsafe                  (iter_, reverseIter_)
+import GHC.Exts                          (Int(..), TYPE, RuntimeRep(..), (==#), (<#), (+#), (-#), isTrue#)
+import GHC.ForeignPtr                    (ForeignPtr(..), ForeignPtrContents)
+import GHC.Prim                          (Int#, Addr#, nullAddr#)
+import Parsley.Internal.Common.Utils     (Code)
+import Parsley.Internal.Core.InputTypes  (Text16, CharList, Stream(..))
+
+import qualified Data.ByteString.Lazy.Internal as Lazy (ByteString(..))
+import qualified Language.Haskell.TH           as TH   (Q, Type)
+
+{- Representation Types -}
+type OffWith ts = (# Int#, ts #)
+--data OffWithStreamAnd ts = OffWithStreamAnd {-# UNPACK #-} !Int !Stream ts
+type UnpackedLazyByteString = (#
+    Int#,
+    Addr#,
+    ForeignPtrContents,
+    Int#,
+    Int#,
+    Lazy.ByteString
+  #)
+
+representationTypes :: [TH.Q TH.Type]
+representationTypes = [[t|[Char]|], [t|UArray Int Char|], [t|Text16|], [t|ByteString|], [t|CharList|], [t|Stream|], [t|Lazy.ByteString|], [t|Text|]]
+
+offWith :: Code ts -> Code (OffWith ts)
+offWith qts = [||(# 0#, $$qts #)||]
+
+emptyUnpackedLazyByteString :: Code Int# -> Code UnpackedLazyByteString
+emptyUnpackedLazyByteString qi# = [|| (# $$(qi#), nullAddr#, error "nullForeignPtr", 0#, 0#, Lazy.Empty #) ||]
+
+{- Representation Mappings -}
+-- When a new input type is added here, it needs an Input instance in Parsley.Backend.Machine
+type RepKind :: Type -> RuntimeRep
+type family RepKind input where
+  RepKind [Char] = IntRep
+  RepKind (UArray Int Char) = IntRep
+  RepKind Text16 = IntRep
+  RepKind ByteString = IntRep
+  RepKind Text = LiftedRep
+  RepKind Lazy.ByteString = 'TupleRep '[IntRep, AddrRep, LiftedRep, IntRep, IntRep, LiftedRep]
+  RepKind CharList = 'TupleRep '[IntRep, LiftedRep]
+  RepKind Stream = 'TupleRep '[IntRep, LiftedRep]
+  --RepKind (OffWithStreamAnd _) = 'TupleRep '[IntRep, LiftedRep, LiftedRep] --REMOVE
+  --RepKind (Text, Stream) = 'TupleRep '[LiftedRep, LiftedRep] --REMOVE
+
+type Rep :: forall (rep :: Type) -> TYPE (RepKind rep)
+type family Rep input where
+  Rep [Char] = Int#
+  Rep (UArray Int Char) = Int#
+  Rep Text16 = Int#
+  Rep ByteString = Int#
+  Rep Text = Text
+  Rep Lazy.ByteString = UnpackedLazyByteString
+  Rep CharList = (# Int#, String #)
+  Rep Stream = (# Int#, Stream #)
+  --Rep (OffWithStreamAnd ts) = (# Int#, Stream, ts #)
+  --Rep (Text, Stream) = (# Text, Stream #)
+
+{- Generic Representation Operations -}
+intSame :: Code Int# -> Code Int# -> Code Bool
+intSame qi# qj# = [||isTrue# ($$(qi#) ==# $$(qj#))||]
+
+intLess :: Code Int# -> Code Int# -> Code Bool
+intLess qi# qj# = [||isTrue# ($$(qi#) <# $$(qj#))||]
+
+offsetText :: Code Text -> Code Int
+offsetText qt = [||case $$qt of Text _ off _ -> off||]
+
+offWithSame :: Code (# Int#, ts #) -> Code (# Int#, ts #) -> Code Bool
+offWithSame qi# qj# = [||
+    case $$(qi#) of
+      (# i#, _ #) -> case $$(qj#) of
+        (# j#, _ #) -> $$(intSame [||i#||] [||j#||])
+  ||]
+
+offWithShiftRight :: Code (Int -> ts -> ts) -> Code (# Int#, ts #) -> Code Int# -> Code (# Int#, ts #)
+offWithShiftRight drop qo# qi# = [||
+    case $$(qo#) of (# o#, ts #) -> (# (o# +# $$(qi#)), ($$drop (I# $$(qi#)) ts) #)
+  ||]
+
+{-offWithStreamAnd :: ts -> OffWithStreamAnd ts
+offWithStreamAnd ts = OffWithStreamAnd 0 nomore ts
+
+offWithStreamAndToInt :: OffWithStreamAnd ts -> Int
+offWithStreamAndToInt (OffWithStreamAnd i _ _) = i-}
+
+dropStream :: Int -> Stream -> Stream
+dropStream 0 cs = cs
+dropStream n (_ :> cs) = dropStream (n-1) cs
+
+textShiftRight :: Text -> Int -> Text
+textShiftRight (Text arr off unconsumed) i = go i off unconsumed
+  where
+    go 0 off' unconsumed' = Text arr off' unconsumed'
+    go n off' unconsumed'
+      | unconsumed' > 0 = let !d = iter_ (Text arr off' unconsumed') 0
+                          in go (n-1) (off'+d) (unconsumed'-d)
+      | otherwise = Text arr off' unconsumed'
+
+textShiftLeft :: Text -> Int -> Text
+textShiftLeft (Text arr off unconsumed) i = go i off unconsumed
+  where
+    go 0 off' unconsumed' = Text arr off' unconsumed'
+    go n off' unconsumed'
+      | off' > 0 = let !d = reverseIter_ (Text arr off' unconsumed') 0 in go (n-1) (off'+d) (unconsumed'-d)
+      | otherwise = Text arr off' unconsumed'
+
+{-# INLINE emptyUnpackedLazyByteString' #-}
+emptyUnpackedLazyByteString' :: Int# -> UnpackedLazyByteString
+emptyUnpackedLazyByteString' i# = (# i#, nullAddr#, error "nullForeignPtr", 0#, 0#, Lazy.Empty #)
+
+byteStringShiftRight :: UnpackedLazyByteString -> Int# -> UnpackedLazyByteString
+byteStringShiftRight (# i#, addr#, final, off#, size#, cs #) j#
+  | isTrue# (j# <# size#)  = (# i# +# j#, addr#, final, off# +# j#, size# -# j#, cs #)
+  | otherwise = case cs of
+    Lazy.Chunk (PS (ForeignPtr addr'# final') (I# off'#) (I# size'#)) cs' -> byteStringShiftRight (# i# +# size#, addr'#, final', off'#, size'#, cs' #) (j# -# size#)
+    Lazy.Empty -> emptyUnpackedLazyByteString' (i# +# size#)
+
+byteStringShiftLeft :: UnpackedLazyByteString -> Int# -> UnpackedLazyByteString
+byteStringShiftLeft (# i#, addr#, final, off#, size#, cs #) j# =
+  let d# = min# off# j#
+  in (# i# -# d#, addr#, final, off# -# d#, size# +# d#, cs #)
+
+min# :: Int# -> Int# -> Int#
+min# i# j# = case i# <# j# of
+  0# -> j#
+  _  -> i#
+
+max# :: Int# -> Int# -> Int#
+max# i# j# = case i# <# j# of
+  0# -> i#
+  _  -> j#
diff --git a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Ops.hs b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Ops.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Ops.hs
@@ -0,0 +1,233 @@
+{-# OPTIONS_GHC -Wno-monomorphism-restriction #-}
+{-# LANGUAGE AllowAmbiguousTypes,
+             ConstrainedClassMethods,
+             ConstraintKinds,
+             CPP,
+             ImplicitParams,
+             MagicHash,
+             RecordWildCards,
+             TypeApplications #-}
+module Parsley.Internal.Backend.Machine.Ops (module Parsley.Internal.Backend.Machine.Ops) where
+
+import Control.Monad                                 (liftM2)
+import Control.Monad.Reader                          (ask, local)
+import Control.Monad.ST                              (ST)
+import Data.Array.Unboxed                            (UArray)
+import Data.ByteString.Internal                      (ByteString)
+import Data.STRef                                    (writeSTRef, readSTRef, newSTRef)
+import Data.Proxy                                    (Proxy(Proxy))
+import Data.Text                                     (Text)
+import Data.Void                                     (Void)
+import Debug.Trace                                   (trace)
+import GHC.Exts                                      (Int(..), (-#))
+import Parsley.Internal.Backend.Machine.Defunc       (Defunc(FREEVAR, OFFSET), genDefunc)
+import Parsley.Internal.Backend.Machine.Identifiers  (MVar, ΦVar, ΣVar)
+import Parsley.Internal.Backend.Machine.InputOps     (PositionOps(..), LogOps(..), InputOps, next, more)
+import Parsley.Internal.Backend.Machine.InputRep     (Rep{-, representationTypes-})
+import Parsley.Internal.Backend.Machine.Instructions (Access(..))
+import Parsley.Internal.Backend.Machine.LetBindings  (Regs(..))
+import Parsley.Internal.Backend.Machine.State        (Γ(..), Ctx, Handler, Machine(..), MachineMonad, Cont, SubRoutine, OpStack(..), Func,
+                                                      run, voidCoins, insertSub, insertΦ, insertNewΣ, insertScopedΣ, cacheΣ, cachedΣ, concreteΣ, debugLevel)
+import Parsley.Internal.Common                       (One, Code, Vec(..), Nat(..))
+import Parsley.Internal.Core.InputTypes              (Text16, CharList, Stream)
+import System.Console.Pretty                         (color, Color(Green, White, Red, Blue))
+
+import qualified Data.ByteString.Lazy.Internal as Lazy (ByteString)
+
+#define inputInstances(derivation) \
+derivation([Char])                 \
+derivation((UArray Int Char))      \
+derivation(Text16)                 \
+derivation(ByteString)             \
+derivation(CharList)               \
+derivation(Stream)                 \
+derivation(Lazy.ByteString)        \
+derivation(Text)
+
+type Ops o = (LogHandler o, ContOps o, HandlerOps o, JoinBuilder o, RecBuilder o, ReturnOps o, PositionOps o, LogOps (Rep o))
+
+{- Input Operations -}
+sat :: (?ops :: InputOps (Rep o)) => (Code Char -> Code Bool) -> (Γ s o (Char : xs) n r a -> Code (ST s (Maybe a))) -> Code (ST s (Maybe a)) -> Γ s o xs n r a -> Code (ST s (Maybe a))
+sat p k bad γ@Γ{..} = next input $ \c input' -> [||
+    if $$(p c) then $$(k (γ {operands = Op (FREEVAR c) operands, input = input'}))
+    else $$bad
+  ||]
+
+emitLengthCheck :: forall s o xs n r a. (?ops :: InputOps (Rep o), PositionOps o) => Int -> (Γ s o xs n r a -> Code (ST s (Maybe a))) -> Code (ST s (Maybe a)) -> Γ s o xs n r a -> Code (ST s (Maybe a))
+emitLengthCheck 0 good _ γ   = good γ
+emitLengthCheck 1 good bad γ = [|| if $$more $$(input γ) then $$(good γ) else $$bad ||]
+emitLengthCheck (I# n) good bad γ = [||
+  if $$more $$(shiftRight (Proxy @o) (input γ) [||n -# 1#||]) then $$(good γ)
+  else $$bad ||]
+
+{- General Operations -}
+dup :: Defunc x -> (Defunc x -> Code r) -> Code r
+dup x k = [|| let !dupx = $$(genDefunc x) in $$(k (FREEVAR [||dupx||])) ||]
+
+{-# INLINE returnST #-}
+returnST :: forall s a. a -> ST s a
+returnST = return @(ST s)
+
+{- Register Operations -}
+newΣ :: ΣVar x -> Access -> Defunc x -> (Ctx s o a -> Code (ST s (Maybe a))) -> Ctx s o a -> Code (ST s (Maybe a))
+newΣ σ Soft x k ctx = dup x $ \dupx -> k $! insertNewΣ σ Nothing dupx ctx
+newΣ σ Hard x k ctx = dup x $ \dupx -> [||
+    do ref <- newSTRef $$(genDefunc dupx)
+       $$(k $! insertNewΣ σ (Just [||ref||]) dupx ctx)
+  ||]
+
+writeΣ :: ΣVar x -> Access -> Defunc x -> (Ctx s o a -> Code (ST s (Maybe a))) -> Ctx s o a -> Code (ST s (Maybe a))
+writeΣ σ Soft x k ctx = dup x $ \dupx -> k $! cacheΣ σ dupx ctx
+writeΣ σ Hard x k ctx = let ref = concreteΣ σ ctx in dup x $ \dupx -> [||
+    do writeSTRef $$ref $$(genDefunc dupx)
+       $$(k $! cacheΣ σ dupx ctx)
+  ||]
+
+readΣ :: ΣVar x -> Access -> (Defunc x -> Ctx s o a -> Code (ST s (Maybe a))) -> Ctx s o a -> Code (ST s (Maybe a))
+readΣ σ Soft k ctx = (k $! cachedΣ σ ctx) $! ctx
+readΣ σ Hard k ctx = let ref = concreteΣ σ ctx in [||
+    do x <- readSTRef $$ref
+       $$(let fv = FREEVAR [||x||] in k fv $! cacheΣ σ fv ctx)
+  ||]
+
+{- Handler Operations -}
+class HandlerOps o where
+  buildHandler :: Γ s o xs n r a
+               -> (Γ s o (o : xs) n r a -> Code (ST s (Maybe a)))
+               -> Code (Rep o) -> Code (Handler s o a)
+  fatal :: Code (Handler s o a)
+
+setupHandler :: Γ s o xs n r a
+             -> (Code (Rep o) -> Code (Handler s o a))
+             -> (Γ s o xs (Succ n) r a -> Code (ST s (Maybe a))) -> Code (ST s (Maybe a))
+setupHandler γ h k = [||
+    let handler = $$(h (input γ))
+    in $$(k (γ {handlers = VCons [||handler||] (handlers γ)}))
+  ||]
+
+raise :: Γ s o xs (Succ n) r a -> Code (ST s (Maybe a))
+raise γ = let VCons h _ = handlers γ in [|| $$h $$(input γ) ||]
+
+#define deriveHandlerOps(_o)                        \
+instance HandlerOps _o where                        \
+{                                                   \
+  buildHandler γ h c = [||\(o# :: Rep _o) ->        \
+    $$(h (γ {operands = Op (OFFSET c) (operands γ), \
+             input = [||o#||]}))||];                \
+  fatal = [||\(!_) -> returnST Nothing ||];         \
+};
+inputInstances(deriveHandlerOps)
+
+{- Control Flow Operations -}
+class ContOps o where
+  suspend :: (Γ s o (x : xs) n r a -> Code (ST s (Maybe a))) -> Γ s o xs n r a -> Code (Cont s o a x)
+
+class ReturnOps o where
+  halt :: Code (Cont s o a a)
+  noreturn :: Code (Cont s o a Void)
+
+callWithContinuation :: forall o s a x n. Code (SubRoutine s o a x) -> Code (Cont s o a x) -> Code (Rep o) -> Vec (Succ n) (Code (Handler s o a)) -> Code (ST s (Maybe a))
+callWithContinuation sub ret input (VCons h _) = [||$$sub $$ret $$input $! $$h||]
+
+resume :: Code (Cont s o a x) -> Γ s o (x : xs) n r a -> Code (ST s (Maybe a))
+resume k γ = let Op x _ = operands γ in [|| $$k $$(genDefunc x) $$(input γ) ||]
+
+#define deriveContOps(_o)                                                              \
+instance ContOps _o where                                                              \
+{                                                                                      \
+  suspend m γ = [|| \x (!o#) -> $$(m (γ {operands = Op (FREEVAR [||x||]) (operands γ), \
+                                         input = [||o#||]})) ||];                      \
+};
+inputInstances(deriveContOps)
+
+#define deriveReturnOps(_o)                                      \
+instance ReturnOps _o where                                      \
+{                                                                \
+  halt = [||\x _ -> returnST $! Just x||];                       \
+  noreturn = [||\_ _ -> error "Return is not permitted here"||]; \
+};
+inputInstances(deriveReturnOps)
+
+{- Builder Operations -}
+class JoinBuilder o where
+  setupJoinPoint :: ΦVar x -> Machine s o (x : xs) n r a -> Machine s o xs n r a -> MachineMonad s o xs n r a
+
+class RecBuilder o where
+  buildIter :: ReturnOps o
+            => Ctx s o a -> MVar Void -> Machine s o '[] One Void a
+            -> (Code (Rep o) -> Code (Handler s o a)) -> Code (Rep o) -> Code (ST s (Maybe a))
+  buildRec  :: Regs rs
+            -> Ctx s o a
+            -> Machine s o '[] One r a
+            -> Code (Func rs s o a r)
+
+#define deriveJoinBuilder(_o)                                                       \
+instance JoinBuilder _o where                                                       \
+{                                                                                   \
+  setupJoinPoint φ (Machine k) mx =                                                 \
+    liftM2 (\mk ctx γ -> [||                                                        \
+      let join x !(o# :: Rep _o) =                                                  \
+        $$(mk (γ {operands = Op (FREEVAR [||x||]) (operands γ), input = [||o#||]})) \
+      in $$(run mx γ (insertΦ φ [||join||] ctx))                                    \
+    ||]) (local voidCoins k) ask;                                                   \
+};
+inputInstances(deriveJoinBuilder)
+
+#define deriveRecBuilder(_o)                                                \
+instance RecBuilder _o where                                                \
+{                                                                           \
+  buildIter ctx μ l h o = [||                                               \
+      let handler !o# = $$(h [||o#||]);                                     \
+          loop !o# =                                                        \
+        $$(run l                                                            \
+            (Γ Empty (noreturn @_o) [||o#||] (VCons [||handler o#||] VNil)) \
+            (voidCoins (insertSub μ [||\_ (!o#) _ -> loop o#||] ctx)))      \
+      in loop $$o                                                           \
+    ||];                                                                    \
+  buildRec rs ctx k = takeFreeRegisters rs ctx (\ctx ->                     \
+    [|| \(!ret) (!o#) h ->                                                  \
+      $$(run k (Γ Empty [||ret||] [||o#||] (VCons [||h||] VNil)) ctx) ||]); \
+};
+inputInstances(deriveRecBuilder)
+
+takeFreeRegisters :: Regs rs -> Ctx s o a -> (Ctx s o a -> Code (SubRoutine s o a x)) -> Code (Func rs s o a x)
+takeFreeRegisters NoRegs ctx body = body ctx
+takeFreeRegisters (FreeReg σ σs) ctx body = [||\(!reg) -> $$(takeFreeRegisters σs (insertScopedΣ σ [||reg||] ctx) body)||]
+
+{- Debugger Operations -}
+class (PositionOps o, LogOps (Rep o)) => LogHandler o where
+  logHandler :: (?ops :: InputOps (Rep o)) => String -> Ctx s o a -> Γ s o xs (Succ n) ks a -> Code (Rep o) -> Code (Handler s o a)
+
+preludeString :: forall s o xs n r a. (?ops :: InputOps (Rep o), PositionOps o, LogOps (Rep o)) => String -> Char -> Γ s o xs n r a -> Ctx s o a -> String -> Code String
+preludeString name dir γ ctx ends = [|| concat [$$prelude, $$eof, ends, '\n' : $$caretSpace, color Blue "^"] ||]
+  where
+    offset     = input γ
+    proxy      = Proxy @o
+    indent     = replicate (debugLevel ctx * 2) ' '
+    start      = shiftLeft offset [||5#||]
+    end        = shiftRight proxy offset [||5#||]
+    inputTrace = [|| let replace '\n' = color Green "↙"
+                         replace ' '  = color White "·"
+                         replace c    = return c
+                         go i#
+                           | $$(same proxy [||i#||] end) || not ($$more i#) = []
+                           | otherwise = $$(next [||i#||] (\qc qi' -> [||replace $$qc ++ go $$qi'||]))
+                     in go $$start ||]
+    eof        = [|| if $$more $$end then $$inputTrace else $$inputTrace ++ color Red "•" ||]
+    prelude    = [|| concat [indent, dir : name, dir : " (", show ($$(offToInt offset)), "): "] ||]
+    caretSpace = [|| replicate (length $$prelude + $$(offToInt offset) - $$(offToInt start)) ' ' ||]
+
+#define deriveLogHandler(_o)                                                                   \
+instance LogHandler _o where                                                                   \
+{                                                                                              \
+  logHandler name ctx γ _ = let VCons h _ = handlers γ in [||\(!o#) ->                         \
+      trace $$(preludeString name '<' (γ {input = [||o#||]}) ctx (color Red " Fail")) ($$h o#) \
+    ||];                                                                                       \
+};
+inputInstances(deriveLogHandler)
+
+-- RIP Dream :(
+{-$(let derive _o = [d|
+        instance HandlerOps _o where
+          fatal = [||\(!o#) -> return Nothing :: ST s (Maybe a)||]
+        |] in traverse derive representationTypes)-}
diff --git a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/State.hs b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/State.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/State.hs
@@ -0,0 +1,160 @@
+{-# LANGUAGE DeriveAnyClass,
+             ExistentialQuantification,
+             TypeFamilies,
+             DerivingStrategies #-}
+module Parsley.Internal.Backend.Machine.State (
+    HandlerStack, Handler, Cont, SubRoutine, MachineMonad, Func,
+    Γ(..), Ctx, OpStack(..),
+    QSubRoutine(..), QJoin(..), Machine(..),
+    run,
+    emptyCtx,
+    insertSub, insertΦ, insertNewΣ, insertScopedΣ, cacheΣ, concreteΣ, cachedΣ,
+    askSub, askΦ,
+    debugUp, debugDown, debugLevel,
+    storePiggy, breakPiggy, spendCoin, giveCoins, voidCoins, coins,
+    hasCoin, isBankrupt, liquidate
+  ) where
+
+import Control.Exception                            (Exception, throw)
+import Control.Monad                                (liftM2)
+import Control.Monad.Reader                         (asks, MonadReader, Reader, runReader)
+import Control.Monad.ST                             (ST)
+import Data.STRef                                   (STRef)
+import Data.Dependent.Map                           (DMap)
+import Data.Kind                                    (Type)
+import Data.Maybe                                   (fromMaybe)
+import Parsley.Internal.Backend.Machine.Defunc      (Defunc)
+import Parsley.Internal.Backend.Machine.Identifiers (MVar(..), ΣVar(..), ΦVar, IMVar, IΣVar)
+import Parsley.Internal.Backend.Machine.InputRep    (Rep)
+import Parsley.Internal.Backend.Machine.LetBindings (Regs(..))
+import Parsley.Internal.Common                      (Queue, enqueue, dequeue, Code, Vec)
+
+import qualified Data.Dependent.Map as DMap             ((!), insert, empty, lookup)
+import qualified Parsley.Internal.Common.Queue as Queue (empty, null, foldr)
+
+type HandlerStack n s o a = Vec n (Code (Handler s o a))
+type Handler s o a = Rep o -> ST s (Maybe a)
+type Cont s o a x = x -> Rep o -> ST s (Maybe a)
+type SubRoutine s o a x = Cont s o a x -> Rep o -> Handler s o a -> ST s (Maybe a)
+type MachineMonad s o xs n r a = Reader (Ctx s o a) (Γ s o xs n r a -> Code (ST s (Maybe a)))
+
+type family Func (rs :: [Type]) s o a x where
+  Func '[] s o a x      = SubRoutine s o a x
+  Func (r : rs) s o a x = STRef s r -> Func rs s o a x
+
+data QSubRoutine s o a x = forall rs. QSubRoutine  (Code (Func rs s o a x)) (Regs rs)
+newtype QJoin s o a x = QJoin { unwrapJoin :: Code (Cont s o a x) }
+newtype Machine s o xs n r a = Machine { getMachine :: MachineMonad s o xs n r a }
+
+run :: Machine s o xs n r a -> Γ s o xs n r a -> Ctx s o a -> Code (ST s (Maybe a))
+run = flip . runReader . getMachine
+
+data OpStack xs where
+  Empty :: OpStack '[]
+  Op :: Defunc x -> OpStack xs -> OpStack (x ': xs)
+
+data Reg s x = Reg { getReg    :: Maybe (Code (STRef s x))
+                   , getCached :: Maybe (Defunc x) }
+
+data Γ s o xs n r a = Γ { operands :: OpStack xs
+                        , retCont  :: Code (Cont s o a r)
+                        , input    :: Code (Rep o)
+                        , handlers :: HandlerStack n s o a }
+
+data Ctx s o a = Ctx { μs         :: DMap MVar (QSubRoutine s o a)
+                     , φs         :: DMap ΦVar (QJoin s o a)
+                     , σs         :: DMap ΣVar (Reg s)
+                     , debugLevel :: Int
+                     , coins      :: Int
+                     , piggies    :: Queue Int }
+
+emptyCtx :: DMap MVar (QSubRoutine s o a) -> Ctx s o a
+emptyCtx μs = Ctx μs DMap.empty DMap.empty 0 0 Queue.empty
+
+insertSub :: MVar x -> Code (SubRoutine s o a x) -> Ctx s o a -> Ctx s o a
+insertSub μ q ctx = ctx {μs = DMap.insert μ (QSubRoutine q NoRegs) (μs ctx)}
+
+insertΦ :: ΦVar x -> Code (Cont s o a x) -> Ctx s o a -> Ctx s o a
+insertΦ φ qjoin ctx = ctx {φs = DMap.insert φ (QJoin qjoin) (φs ctx)}
+
+insertNewΣ :: ΣVar x -> Maybe (Code (STRef s x)) -> Defunc x -> Ctx s o a -> Ctx s o a
+insertNewΣ σ qref x ctx = ctx {σs = DMap.insert σ (Reg qref (Just x)) (σs ctx)}
+
+insertScopedΣ :: ΣVar x -> Code (STRef s x) -> Ctx s o a -> Ctx s o a
+insertScopedΣ σ qref ctx = ctx {σs = DMap.insert σ (Reg (Just qref) Nothing) (σs ctx)}
+
+cacheΣ :: ΣVar x -> Defunc x -> Ctx s o a -> Ctx s o a
+cacheΣ σ x ctx = case DMap.lookup σ (σs ctx) of
+  Just (Reg ref _) -> ctx {σs = DMap.insert σ (Reg ref (Just x)) (σs ctx)}
+  Nothing          -> throw (outOfScopeRegister σ)
+
+concreteΣ :: ΣVar x -> Ctx s o a -> Code (STRef s x)
+concreteΣ σ = fromMaybe (throw (intangibleRegister σ)) . (>>= getReg) . DMap.lookup σ . σs
+
+cachedΣ :: ΣVar x -> Ctx s o a -> Defunc x
+cachedΣ σ = fromMaybe (throw (registerFault σ)) . (>>= getCached) . DMap.lookup σ . σs
+
+askSub :: MonadReader (Ctx s o a) m => MVar x -> m (Code (SubRoutine s o a x))
+askSub μ =
+  do QSubRoutine sub rs <- askSubUnbound μ
+     asks (provideFreeRegisters sub rs)
+
+askSubUnbound :: MonadReader (Ctx s o a) m => MVar x -> m (QSubRoutine s o a x)
+askSubUnbound μ = asks (fromMaybe (throw (missingDependency μ)) . DMap.lookup μ . μs)
+
+provideFreeRegisters :: Code (Func rs s o a x) -> Regs rs -> Ctx s o a -> Code (SubRoutine s o a x)
+provideFreeRegisters sub NoRegs _ = sub
+provideFreeRegisters f (FreeReg σ σs) ctx = provideFreeRegisters [||$$f $$(concreteΣ σ ctx)||] σs ctx
+
+askΦ :: MonadReader (Ctx s o a) m => ΦVar x -> m (Code (Cont s o a x))
+askΦ φ = asks (unwrapJoin . (DMap.! φ) . φs)
+
+debugUp :: Ctx s o a -> Ctx s o a
+debugUp ctx = ctx {debugLevel = debugLevel ctx + 1}
+
+debugDown :: Ctx s o a -> Ctx s o a
+debugDown ctx = ctx {debugLevel = debugLevel ctx - 1}
+
+-- Piggy bank functions
+storePiggy :: Int -> Ctx s o a -> Ctx s o a
+storePiggy coins ctx = ctx {piggies = enqueue coins (piggies ctx)}
+
+breakPiggy :: Ctx s o a -> Ctx s o a
+breakPiggy ctx = let (coins, piggies') = dequeue (piggies ctx) in ctx {coins = coins, piggies = piggies'}
+
+hasCoin :: Ctx s o a -> Bool
+hasCoin = (> 0) . coins
+
+isBankrupt :: Ctx s o a -> Bool
+isBankrupt = liftM2 (&&) (not . hasCoin) (Queue.null . piggies)
+
+spendCoin :: Ctx s o a -> Ctx s o a
+spendCoin ctx = ctx {coins = coins ctx - 1}
+
+giveCoins :: Int -> Ctx s o a -> Ctx s o a
+giveCoins c ctx = ctx {coins = coins ctx + c}
+
+voidCoins :: Ctx s o a -> Ctx s o a
+voidCoins ctx = ctx {coins = 0, piggies = Queue.empty}
+
+liquidate :: Ctx s o a -> Int
+liquidate ctx = Queue.foldr (+) (coins ctx) (piggies ctx)
+
+newtype MissingDependency = MissingDependency IMVar deriving anyclass Exception
+newtype OutOfScopeRegister = OutOfScopeRegister IΣVar deriving anyclass Exception
+newtype IntangibleRegister = IntangibleRegister IΣVar deriving anyclass Exception
+newtype RegisterFault = RegisterFault IΣVar deriving anyclass Exception
+
+missingDependency :: MVar x -> MissingDependency
+missingDependency (MVar v) = MissingDependency v
+outOfScopeRegister :: ΣVar x -> OutOfScopeRegister
+outOfScopeRegister (ΣVar σ) = OutOfScopeRegister σ
+intangibleRegister :: ΣVar x -> IntangibleRegister
+intangibleRegister (ΣVar σ) = IntangibleRegister σ
+registerFault :: ΣVar x -> RegisterFault
+registerFault (ΣVar σ) = RegisterFault σ
+
+instance Show MissingDependency where show (MissingDependency μ) = "Dependency μ" ++ show μ ++ " has not been compiled"
+instance Show OutOfScopeRegister where show (OutOfScopeRegister σ) = "Register r" ++ show σ ++ " is out of scope"
+instance Show IntangibleRegister where show (IntangibleRegister σ) = "Register r" ++ show σ ++ " is intangible in this scope"
+instance Show RegisterFault where show (RegisterFault σ) = "Attempting to access register r" ++ show σ ++ " from cache has failed"
diff --git a/src/ghc-8.6+/Parsley/Internal/Backend/Machine.hs b/src/ghc-8.6+/Parsley/Internal/Backend/Machine.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc-8.6+/Parsley/Internal/Backend/Machine.hs
@@ -0,0 +1,50 @@
+{-|
+Module      : Parsley.Internal.Backend.Machine
+Description : The implementation of the low level parsing machinery is found here
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : unstable
+
+@since 0.1.0.0
+-}
+module Parsley.Internal.Backend.Machine (
+    Input, eval,
+    PositionOps,
+    module Parsley.Internal.Backend.Machine.Instructions,
+    module Parsley.Internal.Backend.Machine.Defunc,
+    module Parsley.Internal.Backend.Machine.Identifiers,
+    module Parsley.Internal.Backend.Machine.LetBindings
+  ) where
+
+import Data.Array.Unboxed                            (UArray)
+import Data.ByteString                               (ByteString)
+import Data.Dependent.Map                            (DMap)
+import Data.Text                                     (Text)
+import Parsley.Internal.Backend.Machine.Defunc       (Defunc(..))
+import Parsley.Internal.Backend.Machine.Identifiers
+import Parsley.Internal.Backend.Machine.InputOps     (InputPrep(..), PositionOps)
+import Parsley.Internal.Backend.Machine.InputRep     (Rep)
+import Parsley.Internal.Backend.Machine.Instructions
+import Parsley.Internal.Backend.Machine.LetBindings  (LetBinding, makeLetBinding)
+import Parsley.Internal.Backend.Machine.Ops          (Ops)
+import Parsley.Internal.Common.Utils                 (Code)
+import Parsley.Internal.Core.InputTypes
+import Parsley.Internal.Trace                        (Trace)
+
+import qualified Data.ByteString.Lazy as Lazy (ByteString)
+import qualified Parsley.Internal.Backend.Machine.Eval as Eval (eval)
+
+eval :: forall input a. (Input input, Trace) => Code input -> (LetBinding (Rep input) a a, DMap MVar (LetBinding (Rep input) a)) -> Code (Maybe a)
+eval input (toplevel, bindings) = Eval.eval (prepare input) toplevel bindings
+
+class (InputPrep input, Ops (Rep input)) => Input input
+instance Input [Char]
+instance Input (UArray Int Char)
+instance Input Text16
+instance Input ByteString
+instance Input CharList
+instance Input Text
+--instance Input CacheText
+instance Input Lazy.ByteString
+--instance Input Lazy.ByteString
+instance Input Stream
diff --git a/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Defunc.hs b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Defunc.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Defunc.hs
@@ -0,0 +1,39 @@
+module Parsley.Internal.Backend.Machine.Defunc (module Parsley.Internal.Backend.Machine.Defunc) where
+
+import Parsley.Internal.Backend.Machine.InputOps (PositionOps(same))
+import Parsley.Internal.Common.Utils             (Code, WQ(WQ))
+
+import qualified Parsley.Internal.Core.Defunc as Core (Defunc(BLACK), ap, genDefunc, genDefunc1, genDefunc2)
+
+data Defunc a where
+  USER    :: Core.Defunc a -> Defunc a
+  BOTTOM  :: Defunc a
+  SAME    :: PositionOps o => Defunc (o -> o -> Bool)
+  FREEVAR :: Code a -> Defunc a
+
+ap2 :: Defunc (a -> b -> c) -> Defunc a -> Defunc b -> Defunc c
+ap2 f x y = USER (Core.ap (Core.ap (seal f) (seal x)) (seal y))
+  where
+    seal :: Defunc a -> Core.Defunc a
+    seal (USER x) = x
+    seal x        = Core.BLACK (WQ undefined (genDefunc x))
+
+genDefunc :: Defunc a -> Code a
+genDefunc (USER x)    = Core.genDefunc x
+genDefunc BOTTOM      = [||undefined||]
+genDefunc SAME        = same
+genDefunc (FREEVAR x) = x
+
+genDefunc1 :: Defunc (a -> b) -> Code a -> Code b
+genDefunc1 (USER f) qx = Core.genDefunc1 f qx
+genDefunc1 f qx        = [|| $$(genDefunc f) $$qx ||]
+
+genDefunc2 :: Defunc (a -> b -> c) -> Code a -> Code b -> Code c
+genDefunc2 (USER f) qx qy = Core.genDefunc2 f qx qy
+genDefunc2 f qx qy        = [|| $$(genDefunc f) $$qx $$qy ||]
+
+instance Show (Defunc a) where
+  show (USER x) = show x
+  show SAME = "same"
+  show BOTTOM = "[[irrelevant]]"
+  show (FREEVAR _) = "x"
diff --git a/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Eval.hs b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Eval.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Eval.hs
@@ -0,0 +1,183 @@
+{-# LANGUAGE ImplicitParams,
+             MultiWayIf,
+             RecordWildCards,
+             TypeApplications #-}
+module Parsley.Internal.Backend.Machine.Eval (eval) where
+
+import Data.Dependent.Map                             (DMap)
+import Data.Functor                                   ((<&>))
+import Data.Void                                      (Void)
+import Control.Monad                                  (forM, liftM2)
+import Control.Monad.Reader                           (ask, asks, local)
+import Control.Monad.ST                               (runST)
+import Parsley.Internal.Backend.Machine.Defunc        (Defunc(FREEVAR), genDefunc, genDefunc1, ap2)
+import Parsley.Internal.Backend.Machine.Identifiers   (MVar(..), ΦVar, ΣVar)
+import Parsley.Internal.Backend.Machine.InputOps      (InputDependant(..), PositionOps, BoxOps, LogOps, InputOps(InputOps))
+import Parsley.Internal.Backend.Machine.Instructions  (Instr(..), MetaInstr(..), Access(..))
+import Parsley.Internal.Backend.Machine.LetBindings   (LetBinding(..))
+import Parsley.Internal.Backend.Machine.LetRecBuilder
+import Parsley.Internal.Backend.Machine.Ops
+import Parsley.Internal.Backend.Machine.State
+import Parsley.Internal.Common                        (Fix4, cata4, One, Code, Vec(..), Nat(..))
+import Parsley.Internal.Trace                         (Trace(trace))
+import System.Console.Pretty                          (color, Color(Green))
+
+import qualified Debug.Trace (trace)
+
+eval :: forall o a. (Trace, Ops o) => Code (InputDependant o) -> LetBinding o a a -> DMap MVar (LetBinding o a) -> Code (Maybe a)
+eval input (LetBinding !p _) fs = trace ("EVALUATING TOP LEVEL") [|| runST $
+  do let !(InputDependant next more offset) = $$input
+     $$(let ?ops = InputOps [||more||] [||next||]
+        in letRec fs
+             nameLet
+             (\exp rs names -> buildRec rs (emptyCtx names) (readyMachine exp))
+             (\names -> run (readyMachine p) (Γ Empty (halt @o) [||offset||] (VCons (fatal @o) VNil)) (emptyCtx names)))
+  ||]
+  where
+    nameLet :: MVar x -> String
+    nameLet (MVar i) = "sub" ++ show i
+
+readyMachine :: (?ops :: InputOps o, Ops o, Trace) => Fix4 (Instr o) xs n r a -> Machine s o xs n r a
+readyMachine = cata4 (Machine . alg)
+  where
+    alg :: (?ops :: InputOps o, Ops o) => Instr o (Machine s o) xs n r a -> MachineMonad s o xs n r a
+    alg Ret                 = evalRet
+    alg (Call μ k)          = evalCall μ k
+    alg (Jump μ)            = evalJump μ
+    alg (Push x k)          = evalPush x k
+    alg (Pop k)             = evalPop k
+    alg (Lift2 f k)         = evalLift2 f k
+    alg (Sat p k)           = evalSat p k
+    alg Empt                = evalEmpt
+    alg (Commit k)          = evalCommit k
+    alg (Catch k h)         = evalCatch k h
+    alg (Tell k)            = evalTell k
+    alg (Seek k)            = evalSeek k
+    alg (Case p q)          = evalCase p q
+    alg (Choices fs ks def) = evalChoices fs ks def
+    alg (Iter μ l k)        = evalIter μ l k
+    alg (Join φ)            = evalJoin φ
+    alg (MkJoin φ p k)      = evalMkJoin φ p k
+    alg (Swap k)            = evalSwap k
+    alg (Dup k)             = evalDup k
+    alg (Make σ c k)        = evalMake σ c k
+    alg (Get σ c k)         = evalGet σ c k
+    alg (Put σ c k)         = evalPut σ c k
+    alg (LogEnter name k)   = evalLogEnter name k
+    alg (LogExit name k)    = evalLogExit name k
+    alg (MetaInstr m k)     = evalMeta m k
+
+evalRet :: ContOps o => MachineMonad s o (x : xs) n x a
+evalRet = return $! retCont >>= resume
+
+evalCall :: ContOps o => MVar x -> Machine s o (x : xs) (Succ n) r a -> MachineMonad s o xs (Succ n) r a
+evalCall μ (Machine k) = liftM2 (\mk sub γ@Γ{..} -> callWithContinuation sub (suspend mk γ) input handlers) k (askSub μ)
+
+evalJump :: ContOps o => MVar x -> MachineMonad s o '[] (Succ n) x a
+evalJump μ = askSub μ <&> \sub Γ{..} -> callWithContinuation sub retCont input handlers
+
+evalPush :: Defunc x -> Machine s o (x : xs) n r a -> MachineMonad s o xs n r a
+evalPush x (Machine k) = k <&> \m γ -> m (γ {operands = Op x (operands γ)})
+
+evalPop :: Machine s o xs n r a -> MachineMonad s o (x : xs) n r a
+evalPop (Machine k) = k <&> \m γ -> m (γ {operands = let Op _ xs = operands γ in xs})
+
+evalLift2 :: Defunc (x -> y -> z) -> Machine s o (z : xs) n r a -> MachineMonad s o (y : x : xs) n r a
+evalLift2 f (Machine k) = k <&> \m γ -> m (γ {operands = let Op y (Op x xs) = operands γ in Op (ap2 f x y) xs})
+
+evalSat :: (?ops :: InputOps o, PositionOps o, BoxOps o, HandlerOps o, Trace) => Defunc (Char -> Bool) -> Machine s o (Char : xs) (Succ n) r a -> MachineMonad s o xs (Succ n) r a
+evalSat p (Machine k) = do
+  bankrupt <- asks isBankrupt
+  hasChange <- asks hasCoin
+  if | bankrupt -> maybeEmitCheck (Just 1) <$> k
+     | hasChange -> maybeEmitCheck Nothing <$> local spendCoin k
+     | otherwise -> trace "I have a piggy :)" $ local breakPiggy (maybeEmitCheck . Just <$> asks coins <*> local spendCoin k)
+  where
+    maybeEmitCheck Nothing mk γ = sat (genDefunc1 p) mk (raise γ) γ
+    maybeEmitCheck (Just n) mk γ =
+      [|| let bad = $$(raise γ) in $$(emitLengthCheck n (sat (genDefunc1 p) mk [||bad||]) [||bad||] γ)||]
+
+evalEmpt :: (BoxOps o, HandlerOps o) => MachineMonad s o xs (Succ n) r a
+evalEmpt = return $! raise
+
+evalCommit :: Machine s o xs n r a -> MachineMonad s o xs (Succ n) r a
+evalCommit (Machine k) = k <&> \mk γ -> let VCons _ hs = handlers γ in mk (γ {handlers = hs})
+
+evalCatch :: (BoxOps o, HandlerOps o) => Machine s o xs (Succ n) r a -> Machine s o (o : xs) n r a -> MachineMonad s o xs n r a
+evalCatch (Machine k) (Machine h) = liftM2 (\mk mh γ -> setupHandler γ (buildHandler γ mh) mk) k h
+
+evalTell :: Machine s o (o : xs) n r a -> MachineMonad s o xs n r a
+evalTell (Machine k) = k <&> \mk γ -> mk (γ {operands = Op (FREEVAR (input γ)) (operands γ)})
+
+evalSeek :: Machine s o xs n r a -> MachineMonad s o (o : xs) n r a
+evalSeek (Machine k) = k <&> \mk γ -> let Op input xs = operands γ in mk (γ {operands = xs, input = genDefunc input})
+
+evalCase :: Machine s o (x : xs) n r a -> Machine s o (y : xs) n r a -> MachineMonad s o (Either x y : xs) n r a
+evalCase (Machine p) (Machine q) = liftM2 (\mp mq γ ->
+  let Op e xs = operands γ
+  in [||case $$(genDefunc e) of
+    Left x -> $$(mp (γ {operands = Op (FREEVAR [||x||]) xs}))
+    Right y  -> $$(mq (γ {operands = Op (FREEVAR [||y||]) xs}))||]) p q
+
+evalChoices :: [Defunc (x -> Bool)] -> [Machine s o xs n r a] -> Machine s o xs n r a -> MachineMonad s o (x : xs) n r a
+evalChoices fs ks (Machine def) = liftM2 (\mdef mks γ -> let Op x xs = operands γ in go x fs mks mdef (γ {operands = xs}))
+  def
+  (forM ks getMachine)
+  where
+    go x (f:fs) (mk:mks) def γ = [||
+        if $$(genDefunc1 f (genDefunc x)) then $$(mk γ)
+        else $$(go x fs mks def γ)
+      ||]
+    go _ _ _ def γ = def γ
+
+evalIter :: (RecBuilder o, ReturnOps o, HandlerOps o)
+         => MVar Void -> Machine s o '[] One Void a -> Machine s o (o : xs) n r a
+         -> MachineMonad s o xs n r a
+evalIter μ l (Machine h) = liftM2 (\mh ctx γ -> buildIter ctx μ l (buildHandler γ mh) (input γ)) h ask
+
+evalJoin :: ContOps o => ΦVar x -> MachineMonad s o (x : xs) n r a
+evalJoin φ = askΦ φ <&> resume
+
+evalMkJoin :: JoinBuilder o => ΦVar x -> Machine s o (x : xs) n r a -> Machine s o xs n r a -> MachineMonad s o xs n r a
+evalMkJoin = setupJoinPoint
+
+evalSwap :: Machine s o (x : y : xs) n r a -> MachineMonad s o (y : x : xs) n r a
+evalSwap (Machine k) = k <&> \mk γ -> mk (γ {operands = let Op y (Op x xs) = operands γ in Op x (Op y xs)})
+
+evalDup :: Machine s o (x : x : xs) n r a -> MachineMonad s o (x : xs) n r a
+evalDup (Machine k) = k <&> \mk γ ->
+  let Op x xs = operands γ
+  in dup x $ \dupx -> mk (γ {operands = Op dupx (Op dupx xs)})
+
+evalMake :: ΣVar x -> Access -> Machine s o xs n r a -> MachineMonad s o (x : xs) n r a
+evalMake σ a k = asks $! \ctx γ ->
+  let Op x xs = operands γ
+  in newΣ σ a x (run k (γ {operands = xs})) ctx
+
+evalGet :: ΣVar x -> Access -> Machine s o (x : xs) n r a -> MachineMonad s o xs n r a
+evalGet σ a k = asks $! \ctx γ -> readΣ σ a (\x -> run k (γ {operands = Op x (operands γ)})) ctx
+
+evalPut :: ΣVar x -> Access -> Machine s o xs n r a -> MachineMonad s o (x : xs) n r a
+evalPut σ a k = asks $! \ctx γ ->
+  let Op x xs = operands γ
+  in writeΣ σ a x (run k (γ {operands = xs})) ctx
+
+evalLogEnter :: (?ops :: InputOps o, LogHandler o) => String -> Machine s o xs (Succ (Succ n)) r a -> MachineMonad s o xs (Succ n) r a
+evalLogEnter name (Machine mk) =
+  liftM2 (\k ctx γ -> [|| Debug.Trace.trace $$(preludeString name '>' γ ctx "") $$(setupHandler γ (logHandler name ctx γ) k)||])
+    (local debugUp mk)
+    ask
+
+evalLogExit :: (?ops :: InputOps o, PositionOps o, LogOps o) => String -> Machine s o xs n r a -> MachineMonad s o xs n r a
+evalLogExit name (Machine mk) =
+  liftM2 (\k ctx γ -> [|| Debug.Trace.trace $$(preludeString name '<' γ (debugDown ctx) (color Green " Good")) $$(k γ) ||])
+    (local debugDown mk)
+    ask
+
+evalMeta :: (?ops :: InputOps o, PositionOps o, BoxOps o, HandlerOps o) => MetaInstr n -> Machine s o xs n r a -> MachineMonad s o xs n r a
+evalMeta (AddCoins coins) (Machine k) =
+  do requiresPiggy <- asks hasCoin
+     if requiresPiggy then local (storePiggy coins) k
+     else local (giveCoins coins) k <&> \mk γ -> emitLengthCheck coins mk (raise γ) γ
+evalMeta (RefundCoins coins) (Machine k) = local (giveCoins coins) k
+evalMeta (DrainCoins coins) (Machine k) = liftM2 (\n mk γ -> emitLengthCheck n mk (raise γ) γ) (asks ((coins -) . liquidate)) k
diff --git a/src/ghc-8.6+/Parsley/Internal/Backend/Machine/InputOps.hs b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/InputOps.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/InputOps.hs
@@ -0,0 +1,229 @@
+{-# LANGUAGE ImplicitParams,
+             MagicHash,
+             TypeApplications,
+             UnboxedTuples #-}
+module Parsley.Internal.Backend.Machine.InputOps (
+    InputPrep(..), PositionOps(..), BoxOps(..), LogOps(..),
+    InputOps(..), more, next,
+    InputDependant(..),
+  ) where
+
+import Data.Array.Base                           (UArray(..), listArray)
+import Data.ByteString.Internal                  (ByteString(..))
+import Data.Text.Array                           (aBA{-, empty-})
+import Data.Text.Internal                        (Text(..))
+import Data.Text.Unsafe                          (iter, Iter(..){-, iter_, reverseIter_-})
+import GHC.Exts                                  (Int(..), Char(..))
+import GHC.ForeignPtr                            (ForeignPtr(..))
+import GHC.Prim                                  (indexWideCharArray#, indexWord16Array#, readWord8OffAddr#, word2Int#, chr#, touch#, realWorld#, plusAddr#, (+#))
+import Parsley.Internal.Backend.Machine.InputRep
+import Parsley.Internal.Common.Utils             (Code)
+import Parsley.Internal.Core.InputTypes
+
+import qualified Data.ByteString.Lazy.Internal as Lazy (ByteString(..))
+--import qualified Data.Text                     as Text (length, index)
+
+data InputDependant rep = InputDependant {-next-} (rep -> (# Char, rep #))
+                                         {-more-} (rep -> Bool)
+                                         {-init-} rep
+
+{- Typeclasses -}
+class InputPrep input where
+  prepare :: Code input -> Code (InputDependant (Rep input))
+
+class PositionOps rep where
+  same :: Code (rep -> rep -> Bool)
+  shiftRight :: Code (rep -> Int -> rep)
+
+class BoxOps rep where
+  box   :: Code (Unboxed rep -> rep)
+  unbox :: Code (rep -> Unboxed rep)
+
+class LogOps rep where
+  shiftLeft :: Code (rep -> Int -> rep)
+  offToInt  :: Code (rep -> Int)
+
+data InputOps rep = InputOps { _more       :: Code (rep -> Bool)
+                             , _next       :: Code (rep -> (# Char, rep #))
+                             }
+more :: (?ops :: InputOps rep) => Code (rep -> Bool)
+more = _more ?ops
+next :: (?ops :: InputOps rep) => Code rep -> (Code Char -> Code rep -> Code r) -> Code r
+next ts k = [|| let !(# t, ts' #) = $$(_next ?ops) $$ts in $$(k [||t||] [||ts'||]) ||]
+
+{- INSTANCES -}
+-- InputPrep Instances
+instance InputPrep [Char] where
+  prepare input = prepare @(UArray Int Char) [||listArray (0, length $$input-1) $$input||]
+
+instance InputPrep (UArray Int Char) where
+  prepare qinput = [||
+      let UArray _ _ size input# = $$qinput
+          next (I# i#) = (# C# (indexWideCharArray# input# i#), I# (i# +# 1#) #)
+      in InputDependant next (< size) 0
+    ||]
+
+instance InputPrep Text16 where
+  prepare qinput = [||
+      let Text16 (Text arr off size) = $$qinput
+          arr# = aBA arr
+          next (I# i#) = (# C# (chr# (word2Int# (indexWord16Array# arr# i#))), I# (i# +# 1#) #)
+      in InputDependant next (< size) off
+    ||]
+
+instance InputPrep ByteString where
+  prepare qinput = [||
+      let PS (ForeignPtr addr# final) off size = $$qinput
+          next i@(I# i#) =
+            case readWord8OffAddr# (addr# `plusAddr#` i#) 0# realWorld# of
+              (# s', x #) -> case touch# final s' of
+                _ -> (# C# (chr# (word2Int# x)), i + 1 #)
+      in InputDependant next (< size) off
+    ||]
+
+instance InputPrep CharList where
+  prepare qinput = [||
+      let CharList input = $$qinput
+          next (OffWith i (c:cs)) = (# c, OffWith (i+1) cs #)
+          size = length input
+          more (OffWith i _) = i < size
+          --more (OffWith _ []) = False
+          --more _              = True
+      in InputDependant next more ($$offWith input)
+    ||]
+
+instance InputPrep Text where
+  prepare qinput = [||
+      let next t@(Text arr off unconsumed) = let !(Iter c d) = iter t 0 in (# c, Text arr (off+d) (unconsumed-d) #)
+          more (Text _ _ unconsumed) = unconsumed > 0
+      in InputDependant next more $$qinput
+    ||]
+
+instance InputPrep Lazy.ByteString where
+  prepare qinput = [||
+      let next (UnpackedLazyByteString i addr# final off@(I# off#) size cs) =
+            case readWord8OffAddr# addr# off# realWorld# of
+              (# s', x #) -> case touch# final s' of
+                _ -> (# C# (chr# (word2Int# x)),
+                    if size /= 1 then UnpackedLazyByteString (i+1) addr# final (off+1) (size-1) cs
+                    else case cs of
+                      Lazy.Chunk (PS (ForeignPtr addr'# final') off' size') cs' -> UnpackedLazyByteString (i+1) addr'# final' off' size' cs'
+                      Lazy.Empty -> emptyUnpackedLazyByteString (i+1)
+                  #)
+          more (UnpackedLazyByteString _ _ _ _ 0 _) = False
+          more _ = True
+          initial = case $$qinput of
+            Lazy.Chunk (PS (ForeignPtr addr# final) off size) cs -> UnpackedLazyByteString 0 addr# final off size cs
+            Lazy.Empty -> emptyUnpackedLazyByteString 0
+      in InputDependant next more initial
+    ||]
+
+instance InputPrep Stream where
+  prepare qinput = [||
+      let next (OffWith o (c :> cs)) = (# c, OffWith (o + 1) cs #)
+      in InputDependant next (const True) ($$offWith $$qinput)
+    ||]
+
+-- PositionOps Instances
+instance PositionOps Int where
+  same = [||(==) @Int||]
+  shiftRight = [||(+) @Int||]
+
+instance PositionOps (OffWith String) where
+  same = offWithSame
+  shiftRight = offWithShiftRight [||drop||]
+
+instance PositionOps (OffWith Stream) where
+  same = offWithSame
+  shiftRight = offWithShiftRight [||dropStream||]
+
+instance PositionOps Text where
+  same = [||\(Text _ i _) (Text _ j _) -> i == j||]
+  shiftRight = [||textShiftRight||]
+
+instance PositionOps UnpackedLazyByteString where
+  same = [||\(UnpackedLazyByteString i _ _ _ _ _) (UnpackedLazyByteString j _ _ _ _ _) -> i == j||]
+  shiftRight = [||byteStringShiftRight||]
+
+-- BoxOps Instances
+instance BoxOps Int where
+  box = [||\i# -> I# i#||]
+  unbox = [||\(I# i#) -> i#||]
+
+instance BoxOps (OffWith ts) where
+  box = [||\(# i#, ts #) -> OffWith (I# i#) ts||]
+  unbox = [||\(OffWith (I# i#) ts) -> (# i#, ts #)||]
+
+instance BoxOps Text where
+  box = [||id||]
+  unbox = [||id||]
+
+instance BoxOps UnpackedLazyByteString where
+  box = [||\(!(# i#, addr#, final, off#, size#, cs #)) -> UnpackedLazyByteString (I# i#) addr# final (I# off#) (I# size#) cs||]
+  unbox = [||\(UnpackedLazyByteString (I# i#) addr# final (I# off#) (I# size#) cs) -> (# i#, addr#, final, off#, size#, cs #)||]
+
+-- LogOps Instances
+instance LogOps Int where
+  shiftLeft = [||\o i -> max (o - i) 0||]
+  offToInt = [||id||]
+
+instance LogOps (OffWith ts) where
+  shiftLeft = [||const||]
+  offToInt = [||\(OffWith i _) -> i||]
+
+instance LogOps Text where
+  shiftLeft = [||textShiftLeft||]
+  offToInt = [||\(Text _ off _) -> div off 2||]
+
+instance LogOps UnpackedLazyByteString where
+  shiftLeft = [||byteStringShiftLeft||]
+  offToInt = [||\(UnpackedLazyByteString i _ _ _ _ _) -> i||]
+
+{- Old Instances -}
+{-instance Input CacheText (Text, Stream) where
+  prepare qinput = [||
+      let (CacheText input) = $$qinput
+          next (t@(Text arr off unconsumed), _) = let !(Iter c d) = iter t 0 in (# c, (Text arr (off+d) (unconsumed-d), nomore) #)
+          more (Text _ _ unconsumed, _) = unconsumed > 0
+          same (Text _ i _, _) (Text _ j _, _) = i == j
+          (Text arr off unconsumed, _) << i = go i off unconsumed
+            where
+              go 0 off' unconsumed' = (Text arr off' unconsumed', nomore)
+              go n off' unconsumed'
+                | off' > 0 = let !d = reverseIter_ (Text arr off' unconsumed') 0 in go (n-1) (off'+d) (unconsumed'-d)
+                | otherwise = (Text arr off' unconsumed', nomore)
+          (Text arr off unconsumed, _) >> i = go i off unconsumed
+            where
+              go 0 off' unconsumed' = (Text arr off' unconsumed', nomore)
+              go n off' unconsumed'
+                | unconsumed' > 0 = let !d = iter_ (Text arr off' unconsumed') 0 in go (n-1) (off'+d) (unconsumed'-d)
+                | otherwise = (Text arr off' unconsumed', nomore)
+          toInt (Text arr off unconsumed, _) = div off 2
+          box (# text, cache #) = (text, cache)
+          unbox (text, cache) = (# text, cache #)
+          newCRef (Text _ i _, _) = newSTRefU i
+          readCRef ref = fmap (\i -> (Text empty i 0, nomore)) (readSTRefU ref)
+          writeCRef ref (Text _ i _, _) = writeSTRefU ref i
+      in PreparedInput next more same (input, nomore) box unbox newCRef readCRef writeCRef s(<<) (>>) toInt
+    ||]
+
+instance Input Lazy.ByteString (OffWith Lazy.ByteString) where
+  prepare qinput = [||
+      let next (OffWith i (Lazy.Chunk (PS ptr@(ForeignPtr addr# final) off@(I# off#) size) cs)) =
+            case readWord8OffAddr# addr# off# realWorld# of
+              (# s', x #) -> case touch# final s' of
+                _ -> (# C# (chr# (word2Int# x)), OffWith (i+1) (if size == 1 then cs
+                                                                else Lazy.Chunk (PS ptr (off+1) (size-1)) cs) #)
+          more (OffWith _ Lazy.Empty) = False
+          more _ = True
+          ow@(OffWith _ (Lazy.Empty)) << _ = ow
+          OffWith o (Lazy.Chunk (PS ptr off size) cs) << i =
+            let d = min off i
+            in OffWith (o - d) (Lazy.Chunk (PS ptr (off - d) (size + d)) cs)
+          ow@(OffWith _ Lazy.Empty) >> _ = ow
+          OffWith o (Lazy.Chunk (PS ptr off size) cs) >> i
+            | i < size  = OffWith (o + i) (Lazy.Chunk (PS ptr (off + i) (size - i)) cs)
+            | otherwise = OffWith (o + size) cs >> (i - size)
+          readCRef ref = fmap (\i -> OffWith i Lazy.Empty) (readSTRefU ref)
+      in PreparedInput next more offWithSame (offWith $$qinput) offWithBox offWithUnbox offWithNewORef readCRef offWithWriteORef (<<) (>>) offWithToInt
+    ||]-}
diff --git a/src/ghc-8.6+/Parsley/Internal/Backend/Machine/InputRep.hs b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/InputRep.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/InputRep.hs
@@ -0,0 +1,131 @@
+{-# LANGUAGE MagicHash,
+             TypeFamilies,
+             TypeFamilyDependencies,
+             UnboxedTuples #-}
+module Parsley.Internal.Backend.Machine.InputRep (
+    Unboxed, Rep,
+    OffWith(..), offWith, offWithSame, offWithShiftRight,
+    OffWithStreamAnd(..),
+    UnpackedLazyByteString(..), emptyUnpackedLazyByteString,
+    Stream, dropStream,
+    representationTypes,
+    -- These must be exposed
+    textShiftRight, textShiftLeft,
+    byteStringShiftRight, byteStringShiftLeft
+  ) where
+
+import Data.Array.Unboxed                (UArray)
+import Data.ByteString.Internal          (ByteString(..))
+import Data.Text.Internal                (Text(..))
+import Data.Text.Unsafe                  (iter_, reverseIter_)
+import GHC.Exts                          (TYPE, RuntimeRep(..))
+import GHC.ForeignPtr                    (ForeignPtr(..), ForeignPtrContents)
+import GHC.Prim                          (Int#, Addr#, nullAddr#)
+import Parsley.Internal.Common.Utils     (Code)
+import Parsley.Internal.Core.InputTypes  (Text16, CharList, Stream(..))
+
+import qualified Data.ByteString.Lazy.Internal as Lazy (ByteString(..))
+import qualified Language.Haskell.TH           as TH   (Q, Type)
+
+{- Representation Types -}
+data OffWith ts = OffWith {-# UNPACK #-} !Int ts
+data OffWithStreamAnd ts = OffWithStreamAnd {-# UNPACK #-} !Int !Stream ts
+data UnpackedLazyByteString = UnpackedLazyByteString
+  {-# UNPACK #-} !Int
+  !Addr#
+  ForeignPtrContents
+  {-# UNPACK #-} !Int
+  {-# UNPACK #-} !Int
+  Lazy.ByteString
+
+representationTypes :: [TH.Q TH.Type]
+representationTypes = [[t|Int|], [t|OffWith [Char]|], [t|OffWith Stream|], [t|UnpackedLazyByteString|], [t|Text|]]
+
+offWith :: Code (ts -> OffWith ts)
+offWith = [||OffWith 0||]
+
+{-# INLINE emptyUnpackedLazyByteString #-}
+emptyUnpackedLazyByteString :: Int -> UnpackedLazyByteString
+emptyUnpackedLazyByteString i = UnpackedLazyByteString i nullAddr# (error "nullForeignPtr") 0 0 Lazy.Empty
+
+{- Representation Mappings -}
+-- When a new input type is added here, it needs an Input instance in Parsley.Backend.Machine
+type family Rep input where
+  Rep [Char] = Int
+  Rep (UArray Int Char) = Int
+  Rep Text16 = Int
+  Rep ByteString = Int
+  Rep CharList = OffWith String
+  Rep Text = Text
+  --Rep CacheText = (Text, Stream)
+  Rep Lazy.ByteString = UnpackedLazyByteString
+  --Rep Lazy.ByteString = OffWith Lazy.ByteString
+  Rep Stream = OffWith Stream
+
+type family RepKind rep where
+  RepKind Int = IntRep
+  RepKind Text = LiftedRep
+  RepKind UnpackedLazyByteString = 'TupleRep '[IntRep, AddrRep, LiftedRep, IntRep, IntRep, LiftedRep]
+  RepKind (OffWith _) = 'TupleRep '[IntRep, LiftedRep]
+  RepKind (OffWithStreamAnd _) = 'TupleRep '[IntRep, LiftedRep, LiftedRep]
+  RepKind (Text, Stream) = 'TupleRep '[LiftedRep, LiftedRep]
+
+type family Unboxed rep = (urep :: TYPE (RepKind rep)) | urep -> rep where
+  Unboxed Int = Int#
+  Unboxed Text = Text
+  Unboxed UnpackedLazyByteString = (# Int#, Addr#, ForeignPtrContents, Int#, Int#, Lazy.ByteString #)
+  Unboxed (OffWith ts) = (# Int#, ts #)
+  Unboxed (OffWithStreamAnd ts) = (# Int#, Stream, ts #)
+  Unboxed (Text, Stream) = (# Text, Stream #)
+
+{- Generic Representation Operations -}
+offWithSame :: Code (OffWith ts -> OffWith ts -> Bool)
+offWithSame = [||\(OffWith i _) (OffWith j _) -> i == j||]
+
+offWithShiftRight :: Code (Int -> ts -> ts) -> Code (OffWith ts -> Int -> OffWith ts)
+offWithShiftRight drop = [||\(OffWith o ts) i -> OffWith (o + i) ($$drop i ts)||]
+
+{-offWithStreamAnd :: ts -> OffWithStreamAnd ts
+offWithStreamAnd ts = OffWithStreamAnd 0 nomore ts
+
+offWithStreamAndBox :: (# Int#, Stream, ts #) -> OffWithStreamAnd ts
+offWithStreamAndBox (# i#, ss, ts #) = OffWithStreamAnd (I# i#) ss ts
+
+offWithStreamAndUnbox :: OffWithStreamAnd ts -> (# Int#, Stream, ts #)
+offWithStreamAndUnbox (OffWithStreamAnd (I# i#) ss ts) = (# i#, ss, ts #)
+
+offWithStreamAndToInt :: OffWithStreamAnd ts -> Int
+offWithStreamAndToInt (OffWithStreamAnd i _ _) = i-}
+
+dropStream :: Int -> Stream -> Stream
+dropStream 0 cs = cs
+dropStream n (_ :> cs) = dropStream (n-1) cs
+
+textShiftRight :: Text -> Int -> Text
+textShiftRight (Text arr off unconsumed) i = go i off unconsumed
+  where
+    go 0 off' unconsumed' = Text arr off' unconsumed'
+    go n off' unconsumed'
+      | unconsumed' > 0 = let !d = iter_ (Text arr off' unconsumed') 0
+                          in go (n-1) (off'+d) (unconsumed'-d)
+      | otherwise = Text arr off' unconsumed'
+
+textShiftLeft :: Text -> Int -> Text
+textShiftLeft (Text arr off unconsumed) i = go i off unconsumed
+  where
+    go 0 off' unconsumed' = Text arr off' unconsumed'
+    go n off' unconsumed'
+      | off' > 0 = let !d = reverseIter_ (Text arr off' unconsumed') 0 in go (n-1) (off'+d) (unconsumed'-d)
+      | otherwise = Text arr off' unconsumed'
+
+byteStringShiftRight :: UnpackedLazyByteString -> Int -> UnpackedLazyByteString
+byteStringShiftRight !(UnpackedLazyByteString i addr# final off size cs) j
+  | j < size  = UnpackedLazyByteString (i + j) addr# final (off + j) (size - j) cs
+  | otherwise = case cs of
+    Lazy.Chunk (PS (ForeignPtr addr'# final') off' size') cs' -> byteStringShiftRight (UnpackedLazyByteString (i + size) addr'# final' off' size' cs') (j - size)
+    Lazy.Empty -> emptyUnpackedLazyByteString (i + size)
+
+byteStringShiftLeft :: UnpackedLazyByteString -> Int -> UnpackedLazyByteString
+byteStringShiftLeft (UnpackedLazyByteString i addr# final off size cs) j =
+  let d = min off j
+  in UnpackedLazyByteString (i - d) addr# final (off - d) (size + d) cs
diff --git a/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Ops.hs b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Ops.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Ops.hs
@@ -0,0 +1,221 @@
+{-# OPTIONS_GHC -Wno-monomorphism-restriction #-}
+{-# LANGUAGE AllowAmbiguousTypes,
+             ConstrainedClassMethods,
+             ConstraintKinds,
+             CPP,
+             ImplicitParams,
+             MagicHash,
+             RecordWildCards,
+             TypeApplications #-}
+module Parsley.Internal.Backend.Machine.Ops (module Parsley.Internal.Backend.Machine.Ops) where
+
+import Control.Monad                                 (liftM2)
+import Control.Monad.Reader                          (ask, local)
+import Control.Monad.ST                              (ST)
+import Data.STRef                                    (writeSTRef, readSTRef, newSTRef)
+import Data.Text                                     (Text)
+import Data.Void                                     (Void)
+import Debug.Trace                                   (trace)
+import Parsley.Internal.Backend.Machine.Defunc       (Defunc(FREEVAR), genDefunc)
+import Parsley.Internal.Backend.Machine.Identifiers  (MVar, ΦVar, ΣVar)
+import Parsley.Internal.Backend.Machine.InputOps     (PositionOps(..), BoxOps(..), LogOps(..), InputOps, next, more)
+import Parsley.Internal.Backend.Machine.InputRep     (Unboxed, OffWith, UnpackedLazyByteString, Stream{-, representationTypes-})
+import Parsley.Internal.Backend.Machine.Instructions (Access(..))
+import Parsley.Internal.Backend.Machine.LetBindings  (Regs(..))
+import Parsley.Internal.Backend.Machine.State        (Γ(..), Ctx, Handler, Machine(..), MachineMonad, Cont, SubRoutine, OpStack(..), Func,
+                                                      run, voidCoins, insertSub, insertΦ, insertNewΣ, insertScopedΣ, cacheΣ, cachedΣ, concreteΣ, debugLevel)
+import Parsley.Internal.Common                       (One, Code, Vec(..), Nat(..))
+import System.Console.Pretty                         (color, Color(Green, White, Red, Blue))
+
+#define inputInstances(derivation) \
+derivation(Int)                    \
+derivation((OffWith [Char]))       \
+derivation((OffWith Stream))       \
+derivation(UnpackedLazyByteString) \
+derivation(Text)
+
+type Ops o = (LogHandler o, ContOps o, HandlerOps o, JoinBuilder o, RecBuilder o, ReturnOps o, PositionOps o, BoxOps o, LogOps o)
+
+{- Input Operations -}
+sat :: (?ops :: InputOps o) => (Code Char -> Code Bool) -> (Γ s o (Char : xs) n r a -> Code (ST s (Maybe a))) -> Code (ST s (Maybe a)) -> Γ s o xs n r a -> Code (ST s (Maybe a))
+sat p k bad γ@Γ{..} = next input $ \c input' -> [||
+    if $$(p c) then $$(k (γ {operands = Op (FREEVAR c) operands, input = input'}))
+    else $$bad
+  ||]
+
+emitLengthCheck :: (?ops :: InputOps o, PositionOps o) => Int -> (Γ s o xs n r a -> Code (ST s (Maybe a))) -> Code (ST s (Maybe a)) -> Γ s o xs n r a -> Code (ST s (Maybe a))
+emitLengthCheck 0 good _ γ   = good γ
+emitLengthCheck 1 good bad γ = [|| if $$more $$(input γ) then $$(good γ) else $$bad ||]
+emitLengthCheck n good bad γ = [||
+  if $$more ($$shiftRight $$(input γ) (n - 1)) then $$(good γ)
+  else $$bad ||]
+
+{- General Operations -}
+dup :: Defunc x -> (Defunc x -> Code r) -> Code r
+dup x k = [|| let !dupx = $$(genDefunc x) in $$(k (FREEVAR [||dupx||])) ||]
+
+{-# INLINE returnST #-}
+returnST :: forall s a. a -> ST s a
+returnST = return @(ST s)
+
+{- Register Operations -}
+newΣ :: ΣVar x -> Access -> Defunc x -> (Ctx s o a -> Code (ST s (Maybe a))) -> Ctx s o a -> Code (ST s (Maybe a))
+newΣ σ Soft x k ctx = dup x $ \dupx -> k $! insertNewΣ σ Nothing dupx ctx
+newΣ σ Hard x k ctx = dup x $ \dupx -> [||
+    do ref <- newSTRef $$(genDefunc dupx)
+       $$(k $! insertNewΣ σ (Just [||ref||]) dupx ctx)
+  ||]
+
+writeΣ :: ΣVar x -> Access -> Defunc x -> (Ctx s o a -> Code (ST s (Maybe a))) -> Ctx s o a -> Code (ST s (Maybe a))
+writeΣ σ Soft x k ctx = dup x $ \dupx -> k $! cacheΣ σ dupx ctx
+writeΣ σ Hard x k ctx = let ref = concreteΣ σ ctx in dup x $ \dupx -> [||
+    do writeSTRef $$ref $$(genDefunc dupx)
+       $$(k $! cacheΣ σ dupx ctx)
+  ||]
+
+readΣ :: ΣVar x -> Access -> (Defunc x -> Ctx s o a -> Code (ST s (Maybe a))) -> Ctx s o a -> Code (ST s (Maybe a))
+readΣ σ Soft k ctx = (k $! cachedΣ σ ctx) $! ctx
+readΣ σ Hard k ctx = let ref = concreteΣ σ ctx in [||
+    do x <- readSTRef $$ref
+       $$(let fv = FREEVAR [||x||] in k fv $! cacheΣ σ fv ctx)
+  ||]
+
+{- Handler Operations -}
+class HandlerOps o where
+  buildHandler :: BoxOps o
+               => Γ s o xs n r a
+               -> (Γ s o (o : xs) n r a -> Code (ST s (Maybe a)))
+               -> Code o -> Code (Handler s o a)
+  fatal :: Code (Handler s o a)
+  raise :: BoxOps o => Γ s o xs (Succ n) r a -> Code (ST s (Maybe a))
+
+setupHandler :: Γ s o xs n r a
+             -> (Code o -> Code (Handler s o a))
+             -> (Γ s o xs (Succ n) r a -> Code (ST s (Maybe a))) -> Code (ST s (Maybe a))
+setupHandler γ h k = [||
+    let handler = $$(h (input γ))
+    in $$(k (γ {handlers = VCons [||handler||] (handlers γ)}))
+  ||]
+
+#define deriveHandlerOps(_o)                         \
+instance HandlerOps _o where                         \
+{                                                    \
+  buildHandler γ h c = [||\(o# :: Unboxed _o) ->     \
+    $$(h (γ {operands = Op (FREEVAR c) (operands γ), \
+             input = [||$$box o#||]}))||];           \
+  fatal = [||\(!_) -> returnST Nothing ||];          \
+  raise γ = let VCons h _ = handlers γ               \
+            in [|| $$h ($$unbox $$(input γ)) ||];    \
+};
+inputInstances(deriveHandlerOps)
+
+{- Control Flow Operations -}
+class BoxOps o => ContOps o where
+  suspend :: (Γ s o (x : xs) n r a -> Code (ST s (Maybe a))) -> Γ s o xs n r a -> Code (Cont s o a x)
+  resume :: Code (Cont s o a x) -> Γ s o (x : xs) n r a -> Code (ST s (Maybe a))
+  callWithContinuation :: Code (SubRoutine s o a x) -> Code (Cont s o a x) -> Code o -> Vec (Succ n) (Code (Handler s o a)) -> Code (ST s (Maybe a))
+
+class ReturnOps o where
+  halt :: Code (Cont s o a a)
+  noreturn :: Code (Cont s o a Void)
+
+#define deriveContOps(_o)                                                                      \
+instance ContOps _o where                                                                      \
+{                                                                                              \
+  suspend m γ = [|| \x (!o#) -> $$(m (γ {operands = Op (FREEVAR [||x||]) (operands γ),         \
+                                         input = [||$$box o#||]})) ||];                        \
+  resume k γ = let Op x _ = operands γ in [|| $$k $$(genDefunc x) ($$unbox $$(input γ)) ||];   \
+  callWithContinuation sub ret input (VCons h _) = [||$$sub $$ret ($$unbox $$input) $! $$h||]; \
+};
+inputInstances(deriveContOps)
+
+#define deriveReturnOps(_o)                                      \
+instance ReturnOps _o where                                      \
+{                                                                \
+  halt = [||\x _ -> returnST $! Just x||];                       \
+  noreturn = [||\_ _ -> error "Return is not permitted here"||]; \
+};
+inputInstances(deriveReturnOps)
+
+{- Builder Operations -}
+class BoxOps o => JoinBuilder o where
+  setupJoinPoint :: ΦVar x -> Machine s o (x : xs) n r a -> Machine s o xs n r a -> MachineMonad s o xs n r a
+
+class BoxOps o => RecBuilder o where
+  buildIter :: ReturnOps o
+            => Ctx s o a -> MVar Void -> Machine s o '[] One Void a
+            -> (Code o -> Code (Handler s o a)) -> Code o -> Code (ST s (Maybe a))
+  buildRec  :: Regs rs
+            -> Ctx s o a
+            -> Machine s o '[] One r a
+            -> Code (Func rs s o a r)
+
+#define deriveJoinBuilder(_o)                                                             \
+instance JoinBuilder _o where                                                             \
+{                                                                                         \
+  setupJoinPoint φ (Machine k) mx =                                                       \
+    liftM2 (\mk ctx γ -> [||                                                              \
+      let join x !(o# :: Unboxed _o) =                                                    \
+        $$(mk (γ {operands = Op (FREEVAR [||x||]) (operands γ), input = [||$$box o#||]})) \
+      in $$(run mx γ (insertΦ φ [||join||] ctx))                                          \
+    ||]) (local voidCoins k) ask;                                                         \
+};
+inputInstances(deriveJoinBuilder)
+
+#define deriveRecBuilder(_o)                                                     \
+instance RecBuilder _o where                                                     \
+{                                                                                \
+  buildIter ctx μ l h o = let bx = box in [||                                    \
+      let handler !o# = $$(h [||$$bx o#||]);                                     \
+          loop !o# =                                                             \
+        $$(run l                                                                 \
+            (Γ Empty (noreturn @_o) [||$$bx o#||] (VCons [||handler o#||] VNil)) \
+            (voidCoins (insertSub μ [||\_ (!o#) _ -> loop o#||] ctx)))           \
+      in loop ($$unbox $$o)                                                      \
+    ||];                                                                         \
+  buildRec rs ctx k = let bx = box in takeFreeRegisters rs ctx (\ctx ->          \
+    [|| \(!ret) (!o#) h ->                                                       \
+      $$(run k (Γ Empty [||ret||] [||$$bx o#||] (VCons [||h||] VNil)) ctx) ||]); \
+};
+inputInstances(deriveRecBuilder)
+
+takeFreeRegisters :: Regs rs -> Ctx s o a -> (Ctx s o a -> Code (SubRoutine s o a x)) -> Code (Func rs s o a x)
+takeFreeRegisters NoRegs ctx body = body ctx
+takeFreeRegisters (FreeReg σ σs) ctx body = [||\(!reg) -> $$(takeFreeRegisters σs (insertScopedΣ σ [||reg||] ctx) body)||]
+
+{- Debugger Operations -}
+class (BoxOps o, PositionOps o, LogOps o) => LogHandler o where
+  logHandler :: (?ops :: InputOps o) => String -> Ctx s o a -> Γ s o xs (Succ n) ks a -> Code o -> Code (Handler s o a)
+
+preludeString :: (?ops :: InputOps o, PositionOps o, LogOps o) => String -> Char -> Γ s o xs n r a -> Ctx s o a -> String -> Code String
+preludeString name dir γ ctx ends = [|| concat [$$prelude, $$eof, ends, '\n' : $$caretSpace, color Blue "^"] ||]
+  where
+    offset     = input γ
+    indent     = replicate (debugLevel ctx * 2) ' '
+    start      = [|| $$shiftLeft $$offset 5 ||]
+    end        = [|| $$shiftRight $$offset 5 ||]
+    inputTrace = [|| let replace '\n' = color Green "↙"
+                         replace ' '  = color White "·"
+                         replace c    = return c
+                         go i
+                           | $$same i $$end || not ($$more i) = []
+                           | otherwise = $$(next [||i||] (\qc qi' -> [||replace $$qc ++ go $$qi'||]))
+                     in go $$start ||]
+    eof        = [|| if $$more $$end then $$inputTrace else $$inputTrace ++ color Red "•" ||]
+    prelude    = [|| concat [indent, dir : name, dir : " (", show ($$offToInt $$offset), "): "] ||]
+    caretSpace = [|| replicate (length $$prelude + $$offToInt $$offset - $$offToInt $$start) ' ' ||]
+
+#define deriveLogHandler(_o)                                                                         \
+instance LogHandler _o where                                                                         \
+{                                                                                                    \
+  logHandler name ctx γ _ = let VCons h _ = handlers γ in [||\(!o#) ->                               \
+      trace $$(preludeString name '<' (γ {input = [||$$box o#||]}) ctx (color Red " Fail")) ($$h o#) \
+    ||];                                                                                             \
+};
+inputInstances(deriveLogHandler)
+
+-- RIP Dream :(
+{-$(let derive _o = [d|
+        instance HandlerOps _o where
+          fatal = [||\(!o#) -> return Nothing :: ST s (Maybe a)||]
+        |] in traverse derive representationTypes)-}
diff --git a/src/ghc-8.6+/Parsley/Internal/Backend/Machine/State.hs b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/State.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/State.hs
@@ -0,0 +1,160 @@
+{-# LANGUAGE DeriveAnyClass,
+             ExistentialQuantification,
+             TypeFamilies,
+             DerivingStrategies #-}
+module Parsley.Internal.Backend.Machine.State (
+    HandlerStack, Handler, Cont, SubRoutine, MachineMonad, Func,
+    Γ(..), Ctx, OpStack(..),
+    QSubRoutine(..), QJoin(..), Machine(..),
+    run,
+    emptyCtx,
+    insertSub, insertΦ, insertNewΣ, insertScopedΣ, cacheΣ, concreteΣ, cachedΣ,
+    askSub, askΦ,
+    debugUp, debugDown, debugLevel,
+    storePiggy, breakPiggy, spendCoin, giveCoins, voidCoins, coins,
+    hasCoin, isBankrupt, liquidate
+  ) where
+
+import Control.Exception                            (Exception, throw)
+import Control.Monad                                (liftM2)
+import Control.Monad.Reader                         (asks, MonadReader, Reader, runReader)
+import Control.Monad.ST                             (ST)
+import Data.STRef                                   (STRef)
+import Data.Dependent.Map                           (DMap)
+import Data.Kind                                    (Type)
+import Data.Maybe                                   (fromMaybe)
+import Parsley.Internal.Backend.Machine.Defunc      (Defunc)
+import Parsley.Internal.Backend.Machine.Identifiers (MVar(..), ΣVar(..), ΦVar, IMVar, IΣVar)
+import Parsley.Internal.Backend.Machine.InputRep    (Unboxed)
+import Parsley.Internal.Backend.Machine.LetBindings (Regs(..))
+import Parsley.Internal.Common                      (Queue, enqueue, dequeue, Code, Vec)
+
+import qualified Data.Dependent.Map as DMap             ((!), insert, empty, lookup)
+import qualified Parsley.Internal.Common.Queue as Queue (empty, null, foldr)
+
+type HandlerStack n s o a = Vec n (Code (Handler s o a))
+type Handler s o a = Unboxed o -> ST s (Maybe a)
+type Cont s o a x = x -> Unboxed o -> ST s (Maybe a)
+type SubRoutine s o a x = Cont s o a x -> Unboxed o -> Handler s o a -> ST s (Maybe a)
+type MachineMonad s o xs n r a = Reader (Ctx s o a) (Γ s o xs n r a -> Code (ST s (Maybe a)))
+
+type family Func (rs :: [Type]) s o a x where
+  Func '[] s o a x      = SubRoutine s o a x
+  Func (r : rs) s o a x = STRef s r -> Func rs s o a x
+
+data QSubRoutine s o a x = forall rs. QSubRoutine  (Code (Func rs s o a x)) (Regs rs)
+newtype QJoin s o a x = QJoin { unwrapJoin :: Code (Cont s o a x) }
+newtype Machine s o xs n r a = Machine { getMachine :: MachineMonad s o xs n r a }
+
+run :: Machine s o xs n r a -> Γ s o xs n r a -> Ctx s o a -> Code (ST s (Maybe a))
+run = flip . runReader . getMachine
+
+data OpStack xs where
+  Empty :: OpStack '[]
+  Op :: Defunc x -> OpStack xs -> OpStack (x ': xs)
+
+data Reg s x = Reg { getReg    :: Maybe (Code (STRef s x))
+                   , getCached :: Maybe (Defunc x) }
+
+data Γ s o xs n r a = Γ { operands :: OpStack xs
+                        , retCont  :: Code (Cont s o a r)
+                        , input    :: Code o
+                        , handlers :: HandlerStack n s o a }
+
+data Ctx s o a = Ctx { μs         :: DMap MVar (QSubRoutine s o a)
+                     , φs         :: DMap ΦVar (QJoin s o a)
+                     , σs         :: DMap ΣVar (Reg s)
+                     , debugLevel :: Int
+                     , coins      :: Int
+                     , piggies    :: Queue Int }
+
+emptyCtx :: DMap MVar (QSubRoutine s o a) -> Ctx s o a
+emptyCtx μs = Ctx μs DMap.empty DMap.empty 0 0 Queue.empty
+
+insertSub :: MVar x -> Code (SubRoutine s o a x) -> Ctx s o a -> Ctx s o a
+insertSub μ q ctx = ctx {μs = DMap.insert μ (QSubRoutine q NoRegs) (μs ctx)}
+
+insertΦ :: ΦVar x -> Code (Cont s o a x) -> Ctx s o a -> Ctx s o a
+insertΦ φ qjoin ctx = ctx {φs = DMap.insert φ (QJoin qjoin) (φs ctx)}
+
+insertNewΣ :: ΣVar x -> Maybe (Code (STRef s x)) -> Defunc x -> Ctx s o a -> Ctx s o a
+insertNewΣ σ qref x ctx = ctx {σs = DMap.insert σ (Reg qref (Just x)) (σs ctx)}
+
+insertScopedΣ :: ΣVar x -> Code (STRef s x) -> Ctx s o a -> Ctx s o a
+insertScopedΣ σ qref ctx = ctx {σs = DMap.insert σ (Reg (Just qref) Nothing) (σs ctx)}
+
+cacheΣ :: ΣVar x -> Defunc x -> Ctx s o a -> Ctx s o a
+cacheΣ σ x ctx = case DMap.lookup σ (σs ctx) of
+  Just (Reg ref _) -> ctx {σs = DMap.insert σ (Reg ref (Just x)) (σs ctx)}
+  Nothing          -> throw (outOfScopeRegister σ)
+
+concreteΣ :: ΣVar x -> Ctx s o a -> Code (STRef s x)
+concreteΣ σ = fromMaybe (throw (intangibleRegister σ)) . (>>= getReg) . DMap.lookup σ . σs
+
+cachedΣ :: ΣVar x -> Ctx s o a -> Defunc x
+cachedΣ σ = fromMaybe (throw (registerFault σ)) . (>>= getCached) . DMap.lookup σ . σs
+
+askSub :: MonadReader (Ctx s o a) m => MVar x -> m (Code (SubRoutine s o a x))
+askSub μ =
+  do QSubRoutine sub rs <- askSubUnbound μ
+     asks (provideFreeRegisters sub rs)
+
+askSubUnbound :: MonadReader (Ctx s o a) m => MVar x -> m (QSubRoutine s o a x)
+askSubUnbound μ = asks (fromMaybe (throw (missingDependency μ)) . DMap.lookup μ . μs)
+
+provideFreeRegisters :: Code (Func rs s o a x) -> Regs rs -> Ctx s o a -> Code (SubRoutine s o a x)
+provideFreeRegisters sub NoRegs _ = sub
+provideFreeRegisters f (FreeReg σ σs) ctx = provideFreeRegisters [||$$f $$(concreteΣ σ ctx)||] σs ctx
+
+askΦ :: MonadReader (Ctx s o a) m => ΦVar x -> m (Code (Cont s o a x))
+askΦ φ = asks (unwrapJoin . (DMap.! φ) . φs)
+
+debugUp :: Ctx s o a -> Ctx s o a
+debugUp ctx = ctx {debugLevel = debugLevel ctx + 1}
+
+debugDown :: Ctx s o a -> Ctx s o a
+debugDown ctx = ctx {debugLevel = debugLevel ctx - 1}
+
+-- Piggy bank functions
+storePiggy :: Int -> Ctx s o a -> Ctx s o a
+storePiggy coins ctx = ctx {piggies = enqueue coins (piggies ctx)}
+
+breakPiggy :: Ctx s o a -> Ctx s o a
+breakPiggy ctx = let (coins, piggies') = dequeue (piggies ctx) in ctx {coins = coins, piggies = piggies'}
+
+hasCoin :: Ctx s o a -> Bool
+hasCoin = (> 0) . coins
+
+isBankrupt :: Ctx s o a -> Bool
+isBankrupt = liftM2 (&&) (not . hasCoin) (Queue.null . piggies)
+
+spendCoin :: Ctx s o a -> Ctx s o a
+spendCoin ctx = ctx {coins = coins ctx - 1}
+
+giveCoins :: Int -> Ctx s o a -> Ctx s o a
+giveCoins c ctx = ctx {coins = coins ctx + c}
+
+voidCoins :: Ctx s o a -> Ctx s o a
+voidCoins ctx = ctx {coins = 0, piggies = Queue.empty}
+
+liquidate :: Ctx s o a -> Int
+liquidate ctx = Queue.foldr (+) (coins ctx) (piggies ctx)
+
+newtype MissingDependency = MissingDependency IMVar deriving anyclass Exception
+newtype OutOfScopeRegister = OutOfScopeRegister IΣVar deriving anyclass Exception
+newtype IntangibleRegister = IntangibleRegister IΣVar deriving anyclass Exception
+newtype RegisterFault = RegisterFault IΣVar deriving anyclass Exception
+
+missingDependency :: MVar x -> MissingDependency
+missingDependency (MVar v) = MissingDependency v
+outOfScopeRegister :: ΣVar x -> OutOfScopeRegister
+outOfScopeRegister (ΣVar σ) = OutOfScopeRegister σ
+intangibleRegister :: ΣVar x -> IntangibleRegister
+intangibleRegister (ΣVar σ) = IntangibleRegister σ
+registerFault :: ΣVar x -> RegisterFault
+registerFault (ΣVar σ) = RegisterFault σ
+
+instance Show MissingDependency where show (MissingDependency μ) = "Dependency μ" ++ show μ ++ " has not been compiled"
+instance Show OutOfScopeRegister where show (OutOfScopeRegister σ) = "Register r" ++ show σ ++ " is out of scope"
+instance Show IntangibleRegister where show (IntangibleRegister σ) = "Register r" ++ show σ ++ " is intangible in this scope"
+instance Show RegisterFault where show (RegisterFault σ) = "Attempting to access register r" ++ show σ ++ " from cache has failed"
diff --git a/src/ghc/Parsley.hs b/src/ghc/Parsley.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley.hs
@@ -0,0 +1,95 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-|
+Module      : Parsley
+Description : Main functionality exports
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : stable
+
+This module contains the core execution functions `runParser` and `parseFromFile`.
+It exports the `Parser` type, as well as the `ParserOps` typeclass, which may be needed
+as a constraint to create more general combinators. It also exports several of the more
+important modules and functionality in particular the core set of combinators.
+
+@since 0.1.0.0
+-}
+module Parsley (
+    runParser, parseFromFile,
+    module Core,
+    module Primitives,
+    module Applicative,
+    module Alternative,
+    module Selective,
+    module Combinator,
+    module Fold,
+    module THUtils,
+  ) where
+
+import Prelude hiding            (readFile)
+import Data.Text.IO              (readFile)
+import Parsley.InputExtras       (Text16(..))
+import Parsley.Internal.Backend  (codeGen, Input, eval)
+import Parsley.Internal.Frontend (compile)
+import Parsley.Internal.Trace    (Trace(trace))
+
+import Parsley.Alternative              as Alternative
+import Parsley.Applicative              as Applicative
+import Parsley.Combinator               as Combinator  (item, char, string, satisfy, notFollowedBy, lookAhead, try)
+import Parsley.Fold                     as Fold        (many, some)
+import Parsley.Internal.Core            as Core        (Parser, ParserOps)
+import Parsley.Internal.Common.Utils    as THUtils     (Quapplicative(..), WQ, Code)
+import Parsley.Internal.Core.Primitives as Primitives  (debug)
+import Parsley.Selective                as Selective
+
+{-|
+The standard way to compile a parser, it returns `Code`, which means
+that it must be /spliced/ into a function definition to produce a
+function of type @input -> Maybe a@ for a chosen input type. As an example:
+
+/In @Parser.hs@/:
+
+> helloParsley :: Parser String
+> helloParsley = string "hello Parsley!"
+
+/In @Main.hs@/:
+
+> parseHelloParsley :: String -> Maybe String
+> parseHelloParsley = $$(runParser helloParsley)
+
+Note that the definition of the parser __must__ be in a separate module to
+the splice (@$$@).
+
+See `Input` for what the valid input types for Parsley are.
+
+The `Trace` instance is used to enable verbose debugging output for
+the compilation pipeline when "Parsley.Internal.Verbose" is imported.
+
+@since 0.1.0.0
+-}
+runParser :: (Trace, Input input)
+          => Parser a                -- ^ The parser to be compiled
+          -> Code (input -> Maybe a) -- ^ The generated parsing function
+runParser p = [||\input -> $$(eval [||input||] (compile p codeGen))||]
+
+{-|
+This function generates a function that reads input from a file
+and parses it. The input files contents are treated as `Text16`.
+
+See `runParser` for more information.
+
+@since 0.1.0.0
+-}
+parseFromFile :: Trace
+              => Parser a                        -- ^ The parser to be compiled
+              -> Code (FilePath -> IO (Maybe a)) -- ^ The generated parsing function
+parseFromFile p = [||\filename -> do input <- readFile filename; return ($$(runParser p) (Text16 input))||]
+
+{-|
+The default instance for `Trace`, which disables all debugging output about the parser compilation
+process. If "Parsley.Internal.Verbose" is imported, this instance will be supersceded.
+
+@since 0.1.0.0
+-}
+instance {-# INCOHERENT #-} Trace where
+  trace = flip const
diff --git a/src/ghc/Parsley/Alternative.hs b/src/ghc/Parsley/Alternative.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Alternative.hs
@@ -0,0 +1,86 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-|
+Module      : Parsley.Alterative
+Description : The @Alternative@ combinators
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : stable
+
+This modules contains the @Alternative@ combinators that would normally be found in
+@Control.Applicative@. However, since Parsley makes use of staging, the signatures
+of these combinators do not correctly match the signatures of those in base Haskell (due to a lack
+of @Applicative@ constraint).
+
+@since 0.1.0.0
+-}
+module Parsley.Alternative (
+    (<|>), empty,
+    (<+>), option, optionally, optional, choice, maybeP, manyTill
+  ) where
+
+import Prelude hiding      (pure, (<$>))
+import Parsley.Applicative (pure, (<$>), ($>), (<:>))
+import Parsley.Internal    (makeQ, Parser, Defunc(EMPTY), pattern UNIT, ParserOps, (<|>), empty)
+
+{-|
+This combinator is similar to @(`<|>`)@, except it allows both branches to differ in type by
+producing a co-product as a result.
+
+@since 0.1.0.0
+-}
+infixl 3 <+>
+(<+>) :: Parser a -> Parser b -> Parser (Either a b)
+p <+> q = makeQ Left [||Left||] <$> p <|> makeQ Right [||Right||] <$> q
+
+{-|
+@option x p@ first tries to parse @p@ and, if it fails without consuming input, will return
+@x@ as a result.
+
+@since 0.1.0.0
+-}
+option :: ParserOps rep => rep a -> Parser a -> Parser a
+option x p = p <|> pure x
+
+{-|
+@optionally p x@ will try to parse @p@ and will always return @x@. If @p@ fails having consumed
+input, then this combinator will fail.
+
+@since 0.1.0.0
+-}
+optionally :: ParserOps rep => Parser a -> rep b -> Parser b
+optionally p x = option x (p $> x)
+
+{-|
+Attempts to parse a given parser, and will always return @()@. (See `optionally`)
+
+@since 0.1.0.0
+-}
+optional :: Parser a -> Parser ()
+optional = flip optionally UNIT
+
+{-|
+Tries to parse each of the given parsers in turn until one of them succeeds using @(`<|>`)@. If
+given the empty list, it will fail unconditionally.
+
+@since 0.1.0.0
+-}
+choice :: [Parser a] -> Parser a
+choice = foldr (<|>) empty
+
+{-|
+Tries to parse a given parser, returning its result in @Just@ if it succeeds and @Nothing@ if it
+fails having not consumed input.
+
+@since 0.1.0.0
+-}
+maybeP :: Parser a -> Parser (Maybe a)
+maybeP p = option (makeQ Nothing [||Nothing||]) (makeQ Just [||Just||] <$> p)
+
+{-|
+The combinator @someTill p end@ will try and parse @p@ as many times as possible so long as @end@
+cannot be successfully parsed. It will return the results from the successful parses of @p@.
+
+@since 0.1.0.0
+-}
+manyTill :: Parser a -> Parser b -> Parser [a]
+manyTill p end = let go = end $> EMPTY <|> p <:> go in go
diff --git a/src/ghc/Parsley/Applicative.hs b/src/ghc/Parsley/Applicative.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Applicative.hs
@@ -0,0 +1,205 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-|
+Module      : Parsley.Applicative
+Description : The @Applicative@ combinators
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : stable
+
+This modules contains all of the @Applicative@ combinators that would normally be found in
+@Data.Functor@ or @Control.Applicative@. However, since Parsley makes use of staging, the signatures
+of these combinators do not correctly match the signatures of those in base Haskell.
+
+@since 0.1.0.0
+-}
+module Parsley.Applicative (
+    pure, (<*>), (*>), (<*),
+    fmap, (<$>), void, (<$), ($>), (<&>), constp,
+    unit, (<~>), (<~), (~>),
+    liftA2, liftA3,
+    (<:>), (<**>),
+    sequence, traverse, repeat,
+    between,
+    (>>)
+  ) where
+
+import Prelude hiding   (pure, (<*>), (*>), (<*), (>>), (<$>), fmap, (<$), traverse, sequence, repeat)
+import Parsley.Internal (makeQ, Parser, Defunc(CONS, CONST, ID, EMPTY), pattern FLIP_H, pattern UNIT, ParserOps, pure, (<*>), (*>), (<*))
+
+-- Functor Operations
+{-|
+Maps a function over the result of a parser.
+
+@since 0.1.0.0
+-}
+fmap :: ParserOps rep => rep (a -> b) -> Parser a -> Parser b
+fmap f = (pure f <*>)
+
+{-|
+Alias of `fmap`.
+
+@since 0.1.0.0
+-}
+infixl 4 <$>
+(<$>) :: ParserOps rep => rep (a -> b) -> Parser a -> Parser b
+(<$>) = fmap
+
+{-|
+This combinator \"forgets\" the result of a parser, and replaces it with @()@.
+
+@since 0.1.0.0
+-}
+void :: Parser a -> Parser ()
+void p = p $> UNIT
+
+{-|
+This combinator \"forgets\" the result of a parser, and replaces it the given value.
+
+@since 0.1.0.0
+-}
+infixl 4 <$
+(<$) :: ParserOps rep => rep b -> Parser a -> Parser b
+x <$ p = p *> pure x
+
+{-|
+This combinator \"forgets\" the result of a parser, and replaces it the given value.
+
+@since 0.1.0.0
+-}
+infixl 4 $>
+($>) :: ParserOps rep => Parser a -> rep b -> Parser b
+($>) = flip (<$)
+
+{-|
+Maps a function over the result of a parser.
+
+@since 0.1.0.0
+-}
+infixl 4 <&>
+(<&>) :: ParserOps rep => Parser a -> rep (a -> b) -> Parser b
+(<&>) = flip fmap
+
+-- | @since 0.1.0.0
+constp :: Parser a -> Parser (b -> a)
+constp = (CONST <$>)
+
+-- Alias Operations
+{-|
+Alias of @(`*>`)@
+
+@since 0.1.0.0
+-}
+infixl 1 >>
+(>>) :: Parser a -> Parser b -> Parser b
+(>>) = (*>)
+
+-- Monoidal Operations
+{-|
+This parser always returns @()@ without consuming input.
+
+@since 0.1.0.0
+-}
+unit :: Parser ()
+unit = pure UNIT
+
+{-|
+Sequential zipping of one parser's result with another's. The parsers must both succeed, one after
+the other to pair their results. If either parser fails then the combinator will fail.
+
+@since 0.1.0.0
+-}
+infixl 4 <~>
+(<~>) :: Parser a -> Parser b -> Parser (a, b)
+(<~>) = liftA2 (makeQ (,) [||(,)||])
+
+{-|
+Alias of @(`<*`)@
+
+@since 0.1.0.0
+-}
+infixl 4 <~
+(<~) :: Parser a -> Parser b -> Parser a
+(<~) = (<*)
+
+{-|
+Alias of @(`*>`)@
+
+@since 0.1.0.0
+-}
+infixl 4 ~>
+(~>) :: Parser a -> Parser b -> Parser b
+(~>) = (*>)
+
+-- Lift Operations
+{-|
+Sequential combination of two parsers results. The results are combined using the given function.
+
+@since 0.1.0.0
+-}
+liftA2 :: ParserOps rep => rep (a -> b -> c) -> Parser a -> Parser b -> Parser c
+liftA2 f p q = f <$> p <*> q
+
+{-|
+Sequential combination of three parsers results. The results are combined using the given function.
+
+@since 0.1.0.0
+-}
+liftA3 :: ParserOps rep => rep (a -> b -> c -> d) -> Parser a -> Parser b -> Parser c -> Parser d
+liftA3 f p q r = f <$> p <*> q <*> r
+
+{-|
+Sequential consing of one parser's result with another's. The parsers must both succeed, one after
+the other to combine their results. If either parser fails then the combinator will fail.
+
+@since 0.1.0.0
+-}
+infixl 4 <:>
+(<:>) :: Parser a -> Parser [a] -> Parser [a]
+(<:>) = liftA2 CONS
+
+{-|
+A variant of @(`<*>`)@ with the arguments reversed.
+
+@since 0.1.0.0
+-}
+infixl 4 <**>
+(<**>) :: Parser a -> Parser (a -> b) -> Parser b
+(<**>) = liftA2 (FLIP_H ID)
+
+-- Auxillary functions
+{-|
+Given a list of parsers, `sequence` will parse each in turn and collect all their results into a
+list. All the parsers in the list must succeed.
+
+@since 0.1.0.0
+-}
+sequence :: [Parser a] -> Parser [a]
+sequence = foldr (<:>) (pure EMPTY)
+
+{-|
+Like `sequence`, but the parsers to sequence are generated from seed values using a given generator
+function.
+
+@since 0.1.0.0
+-}
+traverse :: (a -> Parser b) -> [a] -> Parser [b]
+traverse f = sequence . map f
+
+{-|
+The combinator @repeat n p@ will attempt to parse @p@ exactly @n@ times. That is not to say that
+the parser must fail on the @n+1@th try, but there must be @n@ successes for the combinator to
+succeed. All the results generated from @p@ will be collected into a list.
+
+@since 0.1.0.0
+-}
+repeat :: Int -> Parser a -> Parser [a]
+repeat n = sequence . replicate n
+
+{-|
+The combinator @between open close p@ will first parse @open@ then @p@ and then @close@, yielding
+the result given by @p@.
+
+@since 0.1.0.0
+-}
+between :: Parser o -> Parser c -> Parser a -> Parser a
+between open close p = open *> p <* close
diff --git a/src/ghc/Parsley/Combinator.hs b/src/ghc/Parsley/Combinator.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Combinator.hs
@@ -0,0 +1,116 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-|
+Module      : Parsley.Combinator
+Description : The parsing combinators
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : stable
+
+This module contains the classic parser combinator operations specific to parsers themselves.
+This means any combinators that deal with input consumption at a primitive level.
+
+@since 0.1.0.0
+-}
+module Parsley.Combinator (
+    satisfy, char, item,
+    string, token,
+    oneOf, noneOf,
+    eof, more,
+    someTill,
+    try,
+    lookAhead, notFollowedBy
+  ) where
+
+import Prelude hiding      (traverse, (*>))
+import Parsley.Alternative (manyTill)
+import Parsley.Applicative (($>), void, traverse, (<:>), (*>))
+import Parsley.Internal    (Code, makeQ, Parser, Defunc(LIFTED, EQ_H, CONST), pattern APP_H, satisfy, lookAhead, try, notFollowedBy)
+
+{-|
+This combinator will attempt match a given string. If the parser fails midway through, this
+combinator will fail having consumed input. On success, the string itself is returned and input
+will be consumed.
+
+@since 0.1.0.0
+-}
+string :: String -> Parser String
+string = traverse char
+
+{-|
+This combinator will attempt to match any one of the provided list of characters. If one of those
+characters is found, it will be returned and the input consumed. If not, the combinator will fail
+having consumed no input.
+
+@since 0.1.0.0
+-}
+oneOf :: [Char] -> Parser Char
+oneOf cs = satisfy (makeQ (flip elem cs) [||\c -> $$(ofChars cs [||c||])||])
+
+{-|
+This combinator will attempt to not match any one of the provided list of characters. If one of those
+characters is found, the combinator will fail having consumed no input. If not, it will return
+the character that was not an element of the provided list.
+
+@since 0.1.0.0
+-}
+noneOf :: [Char] -> Parser Char
+noneOf cs = satisfy (makeQ (not . flip elem cs) [||\c -> not $$(ofChars cs [||c||])||])
+
+ofChars :: [Char] -> Code Char -> Code Bool
+ofChars = foldr (\c rest qc -> [|| c == $$qc || $$(rest qc) ||]) (const [||False||])
+
+{-|
+Like `string`, excepts parses the given string atomically using `try`. Never consumes input on
+failure.
+
+@since 0.1.0.0
+-}
+token :: String -> Parser String
+token = try . string
+
+{-|
+This parser succeeds only if there is no input left to consume, and fails without consuming input
+otherwise.
+
+@since 0.1.0.0
+-}
+eof :: Parser ()
+eof = notFollowedBy item
+
+{-|
+This parser succeeds if there is still input left to consume, and fails otherwise.
+
+@since 0.1.0.0
+-}
+more :: Parser ()
+more = lookAhead (void item)
+
+-- Parsing Primitives
+{-|
+This combinator will attempt to match a given character. If that character is the next input token,
+the parser succeeds and the character is returned. Otherwise, the combinator will fail having not
+consumed any input.
+
+@since 0.1.0.0
+-}
+char :: Char -> Parser Char
+char c = satisfy (EQ_H (LIFTED c)) $> LIFTED c
+
+{-|
+Reads any single character. This combinator will only fail if there is no more input remaining.
+The parsed character is returned.
+
+@since 0.1.0.0
+-}
+item :: Parser Char
+item = satisfy (APP_H CONST ((makeQ True [||True||])))
+
+-- Composite Combinators
+{-|
+The combinator @someTill p end@ will try and parse @p@ as many times as possible (but at least once)
+so long as @end@ cannot be successfully parsed. It will return the results from the successful parses of @p@.
+
+@since 0.1.0.0
+-}
+someTill :: Parser a -> Parser b -> Parser [a]
+someTill p end = notFollowedBy end *> (p <:> manyTill p end)
diff --git a/src/ghc/Parsley/Defunctionalized.hs b/src/ghc/Parsley/Defunctionalized.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Defunctionalized.hs
@@ -0,0 +1,19 @@
+{-|
+Module      : Parsley.Defunctionalized
+Description : Defunctionalised operators usable in place of plain Haskell equivalents
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : stable
+
+This module exports the `Defunc` type and associated patterns. These are by no means required
+to use Parsley, however they can serve as useful shortcuts to their regular Haskell equivalents.
+As they are in datatype form, they are inspectable by the internal Parsley machinery, which may
+improve optimisation opportunities or code generation.
+
+@since 0.1.0.0
+-}
+module Parsley.Defunctionalized (
+    module Parsley.Internal.Core.Defunc
+  ) where
+
+import Parsley.Internal.Core.Defunc hiding (genDefunc, genDefunc1, genDefunc2, ap)
diff --git a/src/ghc/Parsley/Fold.hs b/src/ghc/Parsley/Fold.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Fold.hs
@@ -0,0 +1,258 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-|
+Module      : Parsley.Fold
+Description : The "folding" combinators: chains and iterators
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : stable
+
+This module contains the combinator concerned with some form of iteration or input folding. Notably,
+this includes the traditional `many` and `some` combinators.
+
+@since 0.1.0.0
+-}
+module Parsley.Fold (
+    many, some, manyN,
+    skipMany, skipSome, skipManyN,
+    sepBy, sepBy1, endBy, endBy1, sepEndBy, sepEndBy1,
+    chainl1, chainr1, chainl, chainr,
+    chainl1', chainr1', chainPre, chainPost,
+    pfoldr, pfoldl,
+    pfoldr1, pfoldl1
+  ) where
+
+import Prelude hiding      (pure, (<*>), (<$>), (*>), (<*))
+import Parsley.Alternative ((<|>), option)
+import Parsley.Applicative (pure, (<*>), (<$>), (*>), (<*), (<:>), (<**>), void)
+import Parsley.Internal    (Parser, Defunc(FLIP, ID, COMPOSE, EMPTY, CONS, CONST), ParserOps, pattern FLIP_H, pattern COMPOSE_H, pattern UNIT, chainPre, chainPost)
+import Parsley.Register    (bind, get, modify, newRegister_)
+
+{-chainPre :: Parser (a -> a) -> Parser a -> Parser a
+chainPre op p = newRegister_ ID $ \acc ->
+  let go = modify acc (FLIP_H COMPOSE <$> op) *> go
+       <|> get acc
+  in go <*> p-}
+
+{-chainPost :: Parser a -> Parser (a -> a) -> Parser a
+chainPost p op = newRegister p $ \acc ->
+  let go = modify acc op *> go
+       <|> get acc
+  in go-}
+
+-- Parser Folds
+{-|
+@pfoldr f k p@ parses __zero__ or more @p@s and combines the results using the function @f@. When @p@
+fails without consuming input, the terminal result @k@ is returned.
+
+> many = pfoldr CONS EMPTY
+
+@since 0.1.0.0
+-}
+pfoldr :: (ParserOps repf, ParserOps repk) => repf (a -> b -> b) -> repk b -> Parser a -> Parser b
+pfoldr f k p = chainPre (f <$> p) (pure k)
+
+{-|
+@pfoldr1 f k p@ parses __one__ or more @p@s and combines the results using the function @f@. When @p@
+fails without consuming input, the terminal result @k@ is returned.
+
+> some = pfoldr1 CONS EMPTY
+
+@since 0.1.0.0
+-}
+pfoldr1 :: (ParserOps repf, ParserOps repk) => repf (a -> b -> b) -> repk b -> Parser a -> Parser b
+pfoldr1 f k p = f <$> p <*> pfoldr f k p
+
+{-|
+@pfoldl f k p@ parses __zero__ or more @p@s and combines the results using the function @f@. The
+accumulator is initialised with the value @k@.
+
+@since 0.1.0.0
+-}
+pfoldl :: (ParserOps repf, ParserOps repk) => repf (b -> a -> b) -> repk b -> Parser a -> Parser b
+pfoldl f k p = chainPost (pure k) ((FLIP <$> pure f) <*> p)
+
+{-|
+@pfoldl1 f k p@ parses __one__ or more @p@s and combines the results using the function @f@. The
+accumulator is initialised with the value @k@.
+
+@since 0.1.0.0
+-}
+pfoldl1 :: (ParserOps repf, ParserOps repk) => repf (b -> a -> b) -> repk b -> Parser a -> Parser b
+pfoldl1 f k p = chainPost (f <$> pure k <*> p) ((FLIP <$> pure f) <*> p)
+
+-- Chain Combinators
+{-|
+@chainl1' wrap p op @ parses one or more occurrences of @p@, separated by @op@. Returns a value obtained
+by a /left/ associative application of all functions returned by @op@ to the values returned by @p@.
+The function @wrap@ is used to transform the initial value from @p@ into the correct form.
+
+@since 0.1.0.0
+-}
+chainl1' :: ParserOps rep => rep (a -> b) -> Parser a -> Parser (b -> a -> b) -> Parser b
+chainl1' f p op = chainPost (f <$> p) (FLIP <$> op <*> p)
+
+{-|
+The classic version of the left-associative chain combinator. See `chainl1'`.
+
+> chainl1 p op = chainl1' ID p op
+
+@since 0.1.0.0
+-}
+chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
+chainl1 = chainl1' ID
+
+{-|
+@chainr1' wrap p op @ parses one or more occurrences of @p@, separated by @op@. Returns a value obtained
+by a /right/ associative application of all functions returned by @op@ to the values returned by @p@.
+The function @wrap@ is used to transform the final value from @p@ into the correct form.
+
+@since 0.1.0.0
+-}
+chainr1' :: ParserOps rep => rep (a -> b) -> Parser a -> Parser (a -> b -> b) -> Parser b
+chainr1' f p op = newRegister_ ID $ \acc ->
+  let go = bind p $ \x ->
+           modify acc (FLIP_H COMPOSE <$> (op <*> x)) *> go
+       <|> f <$> x
+  in go <**> get acc
+
+{-|
+The classic version of the right-associative chain combinator. See `chainr1'`.
+
+> chainr1 p op = chainr1' ID p op
+
+@since 0.1.0.0
+-}
+chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a
+chainr1 = chainr1' ID
+
+{-|
+Like `chainr1`, but may parse zero occurences of @p@ in which case the value is returned.
+
+@since 0.1.0.0
+-}
+chainr :: ParserOps rep => Parser a -> Parser (a -> a -> a) -> rep a -> Parser a
+chainr p op x = option x (chainr1 p op)
+
+{-|
+Like `chainl1`, but may parse zero occurences of @p@ in which case the value is returned.
+
+@since 0.1.0.0
+-}
+chainl :: ParserOps rep => Parser a -> Parser (a -> a -> a) -> rep a -> Parser a
+chainl p op x = option x (chainl1 p op)
+
+-- Derived Combinators
+{-|
+Attempts to parse the given parser __zero__ or more times, collecting all of the successful results
+into a list. Same as @manyN 0@
+
+@since 0.1.0.0
+-}
+many :: Parser a -> Parser [a]
+many = pfoldr CONS EMPTY
+
+{-|
+Attempts to parse the given parser __n__ or more times, collecting all of the successful results
+into a list.
+
+@since 0.1.0.0
+-}
+manyN :: Int -> Parser a -> Parser [a]
+manyN n p = foldr (const (p <:>)) (many p) [1..n]
+
+{-|
+Attempts to parse the given parser __one__ or more times, collecting all of the successful results
+into a list. Same as @manyN 1@
+
+@since 0.1.0.0
+-}
+some :: Parser a -> Parser [a]
+some = manyN 1
+
+{-|
+Like `many`, excepts discards its results.
+
+@since 0.1.0.0
+-}
+skipMany :: Parser a -> Parser ()
+--skipMany p = let skipManyp = p *> skipManyp <|> unit in skipManyp
+skipMany = void . pfoldl CONST UNIT -- the void here will encourage the optimiser to recognise that the register is unused
+
+{-|
+Like `manyN`, excepts discards its results.
+
+@since 0.1.0.0
+-}
+skipManyN :: Int -> Parser a -> Parser ()
+skipManyN n p = foldr (const (p *>)) (skipMany p) [1..n]
+
+{-|
+Like `some`, excepts discards its results.
+
+@since 0.1.0.0
+-}
+skipSome :: Parser a -> Parser ()
+skipSome = skipManyN 1
+
+{-|
+@sepBy p sep@ parses __zero__ or more occurrences of @p@, separated by @sep@.
+Returns a list of values returned by @p@.
+
+@since 0.1.0.0
+-}
+sepBy :: Parser a -> Parser b -> Parser [a]
+sepBy p sep = option EMPTY (sepBy1 p sep)
+
+{-|
+@sepBy1 p sep@ parses __one__ or more occurrences of @p@, separated by @sep@.
+Returns a list of values returned by @p@.
+
+@since 0.1.0.0
+-}
+sepBy1 :: Parser a -> Parser b -> Parser [a]
+sepBy1 p sep = p <:> many (sep *> p)
+
+{-|
+@endBy p sep@ parses __zero__ or more occurrences of @p@, separated and ended by @sep@.
+Returns a list of values returned by @p@.
+
+@since 0.1.0.0
+-}
+endBy :: Parser a -> Parser b -> Parser [a]
+endBy p sep = many (p <* sep)
+
+{-|
+@endBy1 p sep@ parses __one__ or more occurrences of @p@, separated and ended by @sep@.
+Returns a list of values returned by @p@.
+
+@since 0.1.0.0
+-}
+endBy1 :: Parser a -> Parser b -> Parser [a]
+endBy1 p sep = some (p <* sep)
+
+{-|
+@sepEndBy p sep@ parses __zero__ or more occurrences of @p@, separated and /optionally/ ended by @sep@.
+Returns a list of values returned by @p@.
+
+@since 0.1.0.0
+-}
+sepEndBy :: Parser a -> Parser b -> Parser [a]
+sepEndBy p sep = option EMPTY (sepEndBy1 p sep)
+
+{-|
+@sepEndBy1 p sep@ parses __one__ or more occurrences of @p@, separated and /optionally/ ended by @sep@.
+Returns a list of values returned by @p@.
+
+@since 0.1.0.0
+-}
+sepEndBy1 :: Parser a -> Parser b -> Parser [a]
+sepEndBy1 p sep = newRegister_ ID $ \acc ->
+  let go = modify acc (COMPOSE_H (FLIP_H COMPOSE) CONS <$> p)
+         *> (sep *> (go <|> get acc) <|> get acc)
+  in go <*> pure EMPTY
+
+{-sepEndBy1 :: Parser a -> Parser b -> Parser [a]
+sepEndBy1 p sep =
+  let seb1 = p <**> (sep *> (FLIP_H CONS <$> option EMPTY seb1)
+                 <|> pure (APP_H (FLIP_H CONS) EMPTY))
+  in seb1-}
diff --git a/src/ghc/Parsley/InputExtras.hs b/src/ghc/Parsley/InputExtras.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/InputExtras.hs
@@ -0,0 +1,22 @@
+{-|
+Module      : Parsley.InputExtras
+Description : Extra datatypes that can be used to wrap input
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : stable
+
+This module exports the `Stream` datatype, which can be used as an infinite input to a
+parser. It also exports `Text16` and `CharList`, which can be wrapped around
+@Text@ and @String@ respectively to force them to be parsed faithfully to their
+representation. By default, @String@s are converted to character arrays for performance,
+but `CharList` will be uncoverted. On the other hand, `Text16` enables a faster, but
+potentially less general processing of @Text@ data by assuming all characters
+are exactly 16-bits in width.
+
+@since 0.1.0.0
+-}
+module Parsley.InputExtras (
+    module Parsley.Internal
+  ) where
+
+import Parsley.Internal (Text16(..), CharList(..), Stream(..), nomore)
diff --git a/src/ghc/Parsley/Internal.hs b/src/ghc/Parsley/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-|
+Module      : Parsley.Internal
+Description : The gateway into the internals: here be monsters!
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : unstable
+
+This module exposes all of the /required/ functionality found in the internals of the library out
+to the user API.
+
+@since 0.1.0.0
+-}
+module Parsley.Internal (
+    module Core,
+    module Primitives,
+    module THUtils,
+    module Trace,
+    module Frontend,
+    module Backend
+  ) where
+
+import Parsley.Internal.Backend         as Backend    (codeGen, Input, eval)
+import Parsley.Internal.Core            as Core
+import Parsley.Internal.Core.Primitives as Primitives (
+    pure, (<*>), (*>), (<*),
+    (<|>), empty,
+    satisfy, lookAhead, try, notFollowedBy,
+    chainPre, chainPost,
+    Reg, newRegister, get, put,
+    conditional, branch,
+    debug
+  )
+import Parsley.Internal.Common.Utils    as THUtils    (Quapplicative(..), WQ, Code, makeQ)
+import Parsley.Internal.Frontend        as Frontend   (compile)
+import Parsley.Internal.Trace           as Trace      (Trace(trace))
diff --git a/src/ghc/Parsley/Internal/Backend.hs b/src/ghc/Parsley/Internal/Backend.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Backend.hs
@@ -0,0 +1,16 @@
+{-|
+Module      : Parsley.Internal.Backend
+Description : The backend is concerned with code generation and control flow analysis
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : stable
+
+@since 0.1.0.0
+-}
+module Parsley.Internal.Backend (
+    module Parsley.Internal.Backend.CodeGenerator,
+    module Parsley.Internal.Backend.Machine
+  ) where
+
+import Parsley.Internal.Backend.CodeGenerator (codeGen)
+import Parsley.Internal.Backend.Machine       (Input, eval)
diff --git a/src/ghc/Parsley/Internal/Backend/CodeGenerator.hs b/src/ghc/Parsley/Internal/Backend/CodeGenerator.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Backend/CodeGenerator.hs
@@ -0,0 +1,192 @@
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
+{-# LANGUAGE PatternSynonyms #-}
+module Parsley.Internal.Backend.CodeGenerator (codeGen) where
+
+import Data.Maybe                                    (isJust)
+import Data.Set                                      (Set, elems)
+import Control.Monad.Trans                           (lift)
+import Parsley.Internal.Backend.Machine              (Defunc(USER, SAME), LetBinding, makeLetBinding, Instr(..),
+                                                      pattern Fmap, pattern App, _Modify, _Get, _Put, _Make, pattern If,
+                                                      addCoins, refundCoins, drainCoins, PositionOps,
+                                                      IMVar, IΦVar, IΣVar, MVar(..), ΦVar(..), ΣVar(..))
+import Parsley.Internal.Backend.InstructionAnalyser  (coinsNeeded)
+import Parsley.Internal.Common.Fresh                 (VFreshT, HFresh, evalFreshT, evalFresh, construct, MonadFresh(..), mapVFreshT)
+import Parsley.Internal.Common.Indexed               (Fix, Fix4(In4), Cofree(..), Nat(..), imap, histo, extract, (|>))
+import Parsley.Internal.Core.CombinatorAST           (Combinator(..), MetaCombinator(..))
+import Parsley.Internal.Core.Defunc                  (Defunc(COMPOSE, ID), pattern FLIP_H, pattern UNIT)
+import Parsley.Internal.Trace                        (Trace(trace))
+
+import Parsley.Internal.Core.Defunc as Core          (Defunc)
+
+type CodeGenStack a = VFreshT IΦVar (VFreshT IMVar (HFresh IΣVar)) a
+runCodeGenStack :: CodeGenStack a -> IMVar -> IΦVar -> IΣVar -> a
+runCodeGenStack m μ0 φ0 σ0 =
+  (flip evalFresh σ0 .
+   flip evalFreshT μ0 .
+   flip evalFreshT φ0) m
+
+newtype CodeGen o a x =
+  CodeGen {runCodeGen :: forall xs n r. Fix4 (Instr o) (x : xs) (Succ n) r a -> CodeGenStack (Fix4 (Instr o) xs (Succ n) r a)}
+
+{-# INLINEABLE codeGen #-}
+codeGen :: (Trace, PositionOps o) => Maybe (MVar x) -> Fix Combinator x -> Set IΣVar -> IMVar -> IΣVar -> LetBinding o a x
+codeGen letBound p rs μ0 σ0 = trace ("GENERATING " ++ name ++ ": " ++ show p ++ "\nMACHINE: " ++ show (map ΣVar (elems rs)) ++ " => " ++ show m) $ makeLetBinding m rs
+  where
+    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)))
+    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 (:$>:) :: 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 :< _)
+
+rollbackHandler :: Fix4 (Instr o) (o : xs) (Succ n) r a
+rollbackHandler = In4 (Seek (In4 Empt))
+
+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 ->
+  do (binder, φ) <- makeΦ m
+     pc <- freshΦ (runCodeGen p (deadCommitOptimisation φ))
+     qc <- freshΦ (runCodeGen q φ)
+     return $! binder (In4 (Catch pc (parsecHandler qc)))
+peephole (MetaCombinator RequiresCut (_ :< ChainPre (op :< _) (p :< _))) = Just $ CodeGen $ \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 ->
+  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
+
+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 =
+  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 =
+  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 =
+  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 =
+  do (binder, φ) <- makeΦ m
+     pc <- freshΦ (runCodeGen p (In4 (Swap (In4 (App φ)))))
+     qc <- freshΦ (runCodeGen q (In4 (Swap (In4 (App φ)))))
+     let minc = coinsNeeded (In4 (Case pc qc))
+     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 =
+  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)
+
+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 μ)
+tailCallOptimise μ k         = In4 (Call μ k)
+
+-- Thanks to the optimisation applied to the K stack, commit is deadcode before Ret
+-- However, I'm not yet sure about the interactions with try yet...
+deadCommitOptimisation :: Fix4 (Instr o) xs n r a -> Fix4 (Instr o) xs (Succ n) r a
+deadCommitOptimisation (In4 Ret) = In4 Ret
+deadCommitOptimisation m         = In4 (Commit m)
+
+-- Refactor with asks
+askM :: CodeGenStack (MVar a)
+askM = lift (construct MVar)
+
+askΦ :: CodeGenStack (ΦVar a)
+askΦ = construct ΦVar
+
+freshM :: CodeGenStack a -> CodeGenStack a
+freshM = mapVFreshT newScope
+
+freshΦ :: CodeGenStack a -> CodeGenStack a
+freshΦ = newScope
+
+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
+    elidable (In4 (Join _)) = True
+    -- This is terminal-φ optimisation: If a φ-node points directly 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Φ
+
+freshΣ :: CodeGenStack (ΣVar a)
+freshΣ = lift (lift (construct ΣVar))
diff --git a/src/ghc/Parsley/Internal/Backend/InstructionAnalyser.hs b/src/ghc/Parsley/Internal/Backend/InstructionAnalyser.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Backend/InstructionAnalyser.hs
@@ -0,0 +1,123 @@
+{-# LANGUAGE MultiParamTypeClasses,
+             TypeFamilies,
+             UndecidableInstances #-}
+module Parsley.Internal.Backend.InstructionAnalyser (coinsNeeded, relevancy) where
+
+import Data.Kind                        (Type)
+import Parsley.Internal.Backend.Machine (Instr(..), MetaInstr(..))
+import Parsley.Internal.Common.Indexed  (cata4, Fix4, Const4(..))
+import Parsley.Internal.Common.Vec      (Vec(..), Nat(..), SNat(..), SingNat(..), zipWithVec, replicateVec)
+
+coinsNeeded :: Fix4 (Instr o) xs n r a -> Int
+coinsNeeded = fst . getConst4 . cata4 (Const4 . alg)
+  where
+    algCatch :: (Int, Bool) -> (Int, Bool) -> (Int, Bool)
+    algCatch k (_, True) = k
+    algCatch (_, True) k = k
+    algCatch (k1, _) (k2, _) = (min k1 k2, False)
+
+    alg :: Instr o (Const4 (Int, Bool)) xs n r a -> (Int, Bool)
+    alg Ret                                    = (0, False)
+    alg (Push _ (Const4 k))                    = (fst k, False)
+    alg (Pop k)                                = getConst4 k
+    alg (Lift2 _ k)                            = getConst4 k
+    alg (Sat _ (Const4 k))                     = (fst k + 1, snd k)
+    alg (Call _ (Const4 k))                    = (0, snd k)
+    alg (Jump _)                               = (0, False)
+    alg Empt                                   = (0, True)
+    alg (Commit k)                             = getConst4 k
+    alg (Catch k h)                            = algCatch (getConst4 k) (getConst4 h)
+    alg (Tell k)                               = getConst4 k
+    alg (Seek k)                               = getConst4 k
+    alg (Case p q)                             = algCatch (getConst4 p) (getConst4 q)
+    alg (Choices _ ks def)                     = foldr (algCatch . getConst4) (getConst4 def) ks
+    alg (Iter _ _ (Const4 k))                  = (0, snd k)
+    alg (Join _)                               = (0, False)
+    alg (MkJoin _ (Const4 b) (Const4 k))       = (fst k + fst b, snd k || snd b)
+    alg (Swap k)                               = getConst4 k
+    alg (Dup k)                                = getConst4 k
+    alg (Make _ _ k)                           = getConst4 k
+    alg (Get _ _ k)                            = getConst4 k
+    alg (Put _ _ k)                            = getConst4 k
+    alg (LogEnter _ k)                         = getConst4 k
+    alg (LogExit _ k)                          = getConst4 k
+    alg (MetaInstr (AddCoins _) (Const4 k))    = k
+    alg (MetaInstr (RefundCoins n) (Const4 k)) = (max (fst k - n) 0, snd k) -- These were refunded, so deduct
+    alg (MetaInstr (DrainCoins _) (Const4 k))  = (fst k, False)
+
+{- TODO
+  Live Value Analysis
+  -------------------
+
+  This analysis is designed to clean up dead registers:
+    * Instead of the state laws on the Combinator AST, this should catch these cases
+    * By performing it here we have ready access to the control flow information
+    * We'll perform global register analysis
+
+  State Laws:
+    * get *> get = get = get <* get
+    * put (pure x) *> get = put (pure x) *> pure x
+    * put get = pure ()
+    * put x *> put (pure y) = x *> put (pure y) = put x <* put (pure y)
+    -->
+    * Get . Pop . Get = Get = Get . Get . Pop -- Captured by relevancy analysis
+    * Get . Get = Get . Dup Subsumes the above (Dup . Pop = id, Dup . Swap = Dup)
+    * px . Put . Push () . Pop . Get = px . Dup . Put . Push () . Pop -- ??? (this law is better than above)
+    * Get . Put . Push () = Push () -- ??? Improved relevancy analysis?
+    * px . Put . Push () . Pop . py . Put . Push () = px . Pop . Push () . Pop . py . Put . Push () = px . Put . Push () . py . Put . Push () . Pop -- Captured by dead register analysis
+
+  Best case scenario is that we can capture all of the above optimisations
+  without a need to explicitly implement them.
+
+  Idea 1) recurse through the machine and mark branches with their liveIn set
+          if a register is not liveIn after a Put instruction it can be removed
+          Get r gens r
+          Put r kills r
+  Idea 2) recurse through the machine and collect relevancy data:
+          a value on the stack is relevant if it is consumed by `Lift2` or `Case`, etc
+          it is irrelevant if consumed by Pop
+          if Get produces an irrelevant operand, it can be replaced by Push BOTTOM
+          Dup disjoins the relevancy of the top two elements of the stack
+          Swap switches the relevancy of the top two elements of the stack
+  Idea 3) recurse through the machine and collect everUsed information
+          if a register is never used, then the Make instruction can be removed
+-}
+
+type family Length (xs :: [Type]) :: Nat where
+  Length '[] = Zero
+  Length (_ : xs) = Succ (Length xs)
+
+newtype RelevancyStack xs (n :: Nat) r a = RelevancyStack { getStack :: SNat (Length xs) -> Vec (Length xs) Bool }
+
+relevancy :: SingNat (Length xs) => Fix4 (Instr o) xs n r a -> Vec (Length xs) Bool
+relevancy = ($ sing) . getStack . cata4 (RelevancyStack . alg)
+  where
+    zipRelevancy = zipWithVec (||)
+
+    -- This algorithm is over-approximating: join and ret aren't _always_ relevant
+    alg :: Instr o RelevancyStack xs n r a -> SNat (Length xs) -> Vec (Length xs) Bool
+    alg Ret                _         = VCons True VNil
+    alg (Push _ k)         n         = let VCons _ xs = getStack k (SSucc n) in xs
+    alg (Pop k)            (SSucc n) = VCons False (getStack k n)
+    alg (Lift2 _ k)        (SSucc n) = let VCons rel xs = getStack k n in VCons rel (VCons rel xs)
+    alg (Sat _ k)          n         = let VCons _ xs = getStack k (SSucc n) in xs
+    alg (Call _ k)         n         = let VCons _ xs = getStack k (SSucc n) in xs
+    alg (Jump _)           _         = VNil
+    alg Empt               n         = replicateVec n False
+    alg (Commit k)         n         = getStack k n
+    alg (Catch k _)        n         = getStack k n
+    alg (Tell k)           n         = let VCons _ xs = getStack k (SSucc n) in xs
+    alg (Seek k)           (SSucc n) = VCons True (getStack k n)
+    alg (Case p q)         n         = VCons True (let VCons _ xs = zipRelevancy (getStack p n) (getStack q n) in xs)
+    alg (Choices _ ks def) (SSucc n) = VCons True (foldr (zipRelevancy . (`getStack` n)) (getStack def n) ks)
+    alg (Iter _ _ k)       n         = let VCons _ xs = getStack k (SSucc n) in xs
+    alg (Join _)           (SSucc n) = VCons True (replicateVec n False)
+    alg (MkJoin _ b _)     n         = let VCons _ xs = getStack b (SSucc n) in xs
+    alg (Swap k)           n         = let VCons rel1 (VCons rel2 xs) = getStack k n in VCons rel2 (VCons rel1 xs)
+    alg (Dup k)            n         = let VCons rel1 (VCons rel2 xs) = getStack k (SSucc n) in VCons (rel1 || rel2) xs
+    alg (Make _ _ k)       (SSucc n) = VCons False (getStack k n)
+    alg (Get _ _ k)        n         = let VCons _ xs = getStack k (SSucc n) in xs
+    alg (Put _ _ k)        (SSucc n) = VCons False (getStack k n)
+    alg (LogEnter _ k)     n         = getStack k n
+    alg (LogExit _ k)      n         = getStack k n
+    alg (MetaInstr _ k)    n         = getStack k n
diff --git a/src/ghc/Parsley/Internal/Backend/Machine/Identifiers.hs b/src/ghc/Parsley/Internal/Backend/Machine/Identifiers.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Backend/Machine/Identifiers.hs
@@ -0,0 +1,30 @@
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
+{-# LANGUAGE DerivingStrategies,
+             GeneralizedNewtypeDeriving #-}
+module Parsley.Internal.Backend.Machine.Identifiers (
+    ΦVar(..), IΦVar,
+    module Parsley.Internal.Core.Identifiers,
+  ) where
+
+import Data.GADT.Compare                 (GEq, GCompare, gcompare, geq, GOrdering(..))
+import Data.Kind                         (Type)
+import Data.Typeable                     ((:~:)(Refl))
+import Data.Word                         (Word64)
+import Parsley.Internal.Core.Identifiers -- for re-export
+import Unsafe.Coerce                     (unsafeCoerce)
+
+newtype ΦVar (a :: Type) = ΦVar IΦVar
+newtype IΦVar = IΦVar Word64 deriving newtype (Ord, Eq, Num, Enum, Show)
+
+instance Show (ΦVar a) where show (ΦVar φ) = "φ" ++ show φ
+
+instance GEq ΦVar where
+  geq (ΦVar u) (ΦVar v)
+    | u == v    = Just (unsafeCoerce Refl)
+    | otherwise = Nothing
+
+instance GCompare ΦVar where
+  gcompare φ1@(ΦVar u) φ2@(ΦVar v) = case compare u v of
+    LT -> GLT
+    EQ -> case geq φ1 φ2 of Just Refl -> GEQ
+    GT -> GGT
diff --git a/src/ghc/Parsley/Internal/Backend/Machine/Instructions.hs b/src/ghc/Parsley/Internal/Backend/Machine/Instructions.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Backend/Machine/Instructions.hs
@@ -0,0 +1,141 @@
+{-# LANGUAGE OverloadedStrings,
+             PatternSynonyms,
+             DerivingStrategies #-}
+module Parsley.Internal.Backend.Machine.Instructions (module Parsley.Internal.Backend.Machine.Instructions) where
+
+import Data.Kind                                    (Type)
+import Data.Void                                    (Void)
+import Parsley.Internal.Backend.Machine.Identifiers (MVar, ΦVar, ΣVar)
+import Parsley.Internal.Common                      (IFunctor4, Fix4(In4), Const4(..), imap4, cata4, Nat(..), One, intercalateDiff)
+
+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
+  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
+  Lift2     :: Machine.Defunc (x -> y -> z) -> k (z : xs) n r a -> Instr o k (y : x : xs) n r a
+  Sat       :: Machine.Defunc (Char -> Bool) -> k (Char : xs) (Succ n) r a -> Instr o k xs (Succ n) r a
+  Call      :: MVar x -> k (x : xs) (Succ n) r a -> Instr o k xs (Succ n) r a
+  Jump      :: MVar x -> Instr o k '[] (Succ n) x a
+  Empt      :: Instr o k xs (Succ n) r a
+  Commit    :: k xs n r a -> Instr o k xs (Succ n) r a
+  Catch     :: k xs (Succ n) r a -> k (o : xs) n r a -> Instr o k xs n r a
+  Tell      :: k (o : xs) n r a -> Instr o k xs n r a
+  Seek      :: k xs n r a -> Instr o k (o : xs) n r a
+  Case      :: k (x : xs) n r a -> k (y : xs) n r a -> Instr o k (Either x y : xs) n r a
+  Choices   :: [Machine.Defunc (x -> Bool)] -> [k xs n r a] -> k xs n r a -> Instr o k (x : xs) n r a
+  Iter      :: MVar Void -> k '[] One Void a -> k (o : xs) n r a -> Instr o k xs n r a
+  Join      :: ΦVar x -> Instr o k (x : xs) n r a
+  MkJoin    :: ΦVar x -> k (x : xs) n r a -> k xs n r a -> Instr o k xs n r a
+  Swap      :: k (x : y : xs) n r a -> Instr o k (y : x : xs) n r a
+  Dup       :: k (x : x : xs) n r a -> Instr o k (x : xs) n r a
+  Make      :: ΣVar x -> Access -> k xs n r a -> Instr o k (x : xs) n r a
+  Get       :: ΣVar x -> Access -> k (x : xs) n r a -> Instr o k xs n r a
+  Put       :: ΣVar x -> Access -> k xs n r a -> Instr o k (x : xs) n r a
+  LogEnter  :: String -> k xs (Succ (Succ n)) r a -> Instr o k xs (Succ n) r a
+  LogExit   :: String -> k xs n r a -> Instr o k xs n r a
+  MetaInstr :: MetaInstr n -> k xs n r a -> Instr o k xs n r a
+
+data Access = Hard | Soft deriving stock Show
+
+data MetaInstr (n :: Nat) where
+  AddCoins    :: Int -> MetaInstr (Succ n)
+  RefundCoins :: Int -> MetaInstr n
+  DrainCoins  :: Int -> MetaInstr (Succ n)
+
+mkCoin :: (Int -> MetaInstr n) -> Int -> Fix4 (Instr o) xs n r a -> Fix4 (Instr o) xs n r a
+mkCoin _    0 = id
+mkCoin meta n = In4 . MetaInstr (meta n)
+
+addCoins :: Int -> Fix4 (Instr o) xs (Succ n) r a -> Fix4 (Instr o) xs (Succ n) r a
+addCoins = mkCoin AddCoins
+refundCoins :: Int -> Fix4 (Instr o) xs n r a -> Fix4 (Instr o) xs n r a
+refundCoins = mkCoin RefundCoins
+drainCoins :: Int -> Fix4 (Instr o) xs (Succ n) r a -> Fix4 (Instr o) xs (Succ n) r a
+drainCoins = mkCoin DrainCoins
+
+pattern App :: Fix4 (Instr o) (y : xs) n r a -> Instr o (Fix4 (Instr o)) (x : (x -> y) : xs) n r a
+pattern App k = Lift2 (USER ID) k
+
+pattern Fmap :: Machine.Defunc (x -> y) -> Fix4 (Instr o) (y : xs) n r a -> Instr o (Fix4 (Instr o)) (x : xs) n r a
+pattern Fmap f k = Push f (In4 (Lift2 (USER (FLIP_H ID)) k))
+
+_Modify :: ΣVar x -> Fix4 (Instr o) xs n r a -> Instr o (Fix4 (Instr o)) ((x -> x) : xs) n r a
+_Modify σ  = _Get σ . In4 . App . In4 . _Put σ
+
+_Make :: ΣVar x -> k xs n r a -> Instr o k (x : xs) n r a
+_Make σ = Make σ Hard
+
+_Put :: ΣVar x -> k xs n r a -> Instr o k (x : xs) n r a
+_Put σ = Put σ Hard
+
+_Get :: ΣVar x -> k (x : xs) n r a -> Instr o k xs n r a
+_Get σ = Get σ Hard
+
+-- This this is a nice little trick to get this instruction to generate optimised code
+pattern If :: Fix4 (Instr o) xs n r a -> Fix4 (Instr o) xs n r a -> Instr o (Fix4 (Instr o)) (Bool : xs) n r a
+pattern If t e = Choices [USER ID] [t] e
+
+instance IFunctor4 (Instr o) where
+  imap4 _ Ret                 = Ret
+  imap4 f (Push x k)          = Push x (f k)
+  imap4 f (Pop k)             = Pop (f k)
+  imap4 f (Lift2 g k)         = Lift2 g (f k)
+  imap4 f (Sat g k)           = Sat g (f k)
+  imap4 f (Call μ k)          = Call μ (f k)
+  imap4 _ (Jump μ)            = Jump μ
+  imap4 _ Empt                = Empt
+  imap4 f (Commit k)          = Commit (f k)
+  imap4 f (Catch p h)         = Catch (f p) (f h)
+  imap4 f (Tell k)            = Tell (f k)
+  imap4 f (Seek k)            = Seek (f k)
+  imap4 f (Case p q)          = Case (f p) (f q)
+  imap4 f (Choices fs ks def) = Choices fs (map f ks) (f def)
+  imap4 f (Iter μ l h)        = Iter μ (f l) (f h)
+  imap4 _ (Join φ)            = Join φ
+  imap4 f (MkJoin φ p k)      = MkJoin φ (f p) (f k)
+  imap4 f (Swap k)            = Swap (f k)
+  imap4 f (Dup k)             = Dup (f k)
+  imap4 f (Make σ a k)        = Make σ a (f k)
+  imap4 f (Get σ a k)         = Get σ a (f k)
+  imap4 f (Put σ a k)         = Put σ a (f k)
+  imap4 f (LogEnter name k)   = LogEnter name (f k)
+  imap4 f (LogExit name k)    = LogExit name (f k)
+  imap4 f (MetaInstr m k)     = MetaInstr m (f k)
+
+instance Show (Fix4 (Instr o) xs n r a) where
+  show = ($ "") . getConst4 . cata4 (Const4 . alg)
+    where
+      alg :: forall xs n r a. Instr o (Const4 (String -> String)) xs n r a -> String -> String
+      alg Ret                 = "Ret"
+      alg (Call μ k)          = "(Call " . shows μ . " " . getConst4 k . ")"
+      alg (Jump μ)            = "(Jump " . shows μ . ")"
+      alg (Push x k)          = "(Push " . shows x . " " . getConst4 k . ")"
+      alg (Pop k)             = "(Pop " . getConst4 k . ")"
+      alg (Lift2 f k)         = "(Lift2 " . shows f . " " . getConst4 k . ")"
+      alg (Sat f k)           = "(Sat " . shows f . " " . getConst4 k . ")"
+      alg Empt                = "Empt"
+      alg (Commit k)          = "(Commit " . getConst4 k . ")"
+      alg (Catch p h)         = "(Catch " . getConst4 p . " " . getConst4 h . ")"
+      alg (Tell k)            = "(Tell " . getConst4 k . ")"
+      alg (Seek k)            = "(Seek " . getConst4 k . ")"
+      alg (Case p q)          = "(Case " . getConst4 p . " " . getConst4 q . ")"
+      alg (Choices fs ks def) = "(Choices " . shows fs . " [" . intercalateDiff ", " (map getConst4 ks) . "] " . getConst4 def . ")"
+      alg (Iter μ l h)        = "{Iter " . shows μ . " " . getConst4 l . " " . getConst4 h . "}"
+      alg (Join φ)            = shows φ
+      alg (MkJoin φ p k)      = "(let " . shows φ . " = " . getConst4 p . " in " . getConst4 k . ")"
+      alg (Swap k)            = "(Swap " . getConst4 k . ")"
+      alg (Dup k)             = "(Dup " . getConst4 k . ")"
+      alg (Make σ a k)        = "(Make " . shows σ . " " . shows a . " " . getConst4 k . ")"
+      alg (Get σ a k)         = "(Get " . shows σ . " " . shows a . " " . getConst4 k . ")"
+      alg (Put σ a k)         = "(Put " . shows σ . " " . shows a . " " . getConst4 k . ")"
+      alg (LogEnter _ k)      = getConst4 k
+      alg (LogExit _ k)       = getConst4 k
+      alg (MetaInstr m k)     = "[" . shows m . "] " . getConst4 k
+
+instance Show (MetaInstr n) where
+  show (AddCoins n)    = "Add " ++ show n ++ " coins"
+  show (RefundCoins n) = "Refund " ++ show n ++ " coins"
+  show (DrainCoins n)  = "Using " ++ show n ++ " coins"
diff --git a/src/ghc/Parsley/Internal/Backend/Machine/LetBindings.hs b/src/ghc/Parsley/Internal/Backend/Machine/LetBindings.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Backend/Machine/LetBindings.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE ExistentialQuantification,
+             StandaloneDeriving,
+             DerivingStrategies #-}
+module Parsley.Internal.Backend.Machine.LetBindings (
+    LetBinding(..),
+    Regs(..),
+    makeLetBinding,
+    Binding
+  ) where
+
+import Prelude hiding                                (foldr)
+import Data.Kind                                     (Type)
+import Data.Set                                      (Set, foldr)
+import Parsley.Internal.Backend.Machine.Identifiers  (IΣVar, ΣVar(..))
+import Parsley.Internal.Backend.Machine.Instructions (Instr)
+import Parsley.Internal.Common                       (Fix4, One)
+import Unsafe.Coerce                                 (unsafeCoerce)
+
+type Binding o a x = Fix4 (Instr o) '[] One x a
+data LetBinding o a x = forall rs. LetBinding (Binding o a x) (Regs rs)
+deriving stock instance Show (LetBinding o a x)
+
+makeLetBinding :: Binding o a x -> Set IΣVar -> LetBinding o a x
+makeLetBinding m rs = LetBinding m (unsafeMakeRegs rs)
+
+data Regs (rs :: [Type]) where
+  NoRegs :: Regs '[]
+  FreeReg :: ΣVar r -> Regs rs -> Regs (r : rs)
+deriving stock instance Show (Regs rs)
+
+unsafeMakeRegs :: Set IΣVar -> Regs rs
+unsafeMakeRegs =  foldr (\σ rs -> unsafeCoerce (FreeReg (ΣVar σ) rs)) (unsafeCoerce NoRegs)
diff --git a/src/ghc/Parsley/Internal/Backend/Machine/LetRecBuilder.hs b/src/ghc/Parsley/Internal/Backend/Machine/LetRecBuilder.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Backend/Machine/LetRecBuilder.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE TupleSections,
+             CPP #-}
+module Parsley.Internal.Backend.Machine.LetRecBuilder (letRec) where
+
+import Data.Dependent.Sum                           (DSum((:=>)))
+import Data.Functor.Const                           (Const(..))
+import Data.GADT.Compare                            (GCompare)
+import Data.Some                                    (Some(Some))
+import Language.Haskell.TH                          (newName, Name)
+#if __GLASGOW_HASKELL__ < 900
+import Language.Haskell.TH.Syntax                   (Q, unTypeQ, unsafeTExpCoerce, Exp(VarE, LetE), Dec(FunD), Clause(Clause), Body(NormalB))
+#else
+import Language.Haskell.TH.Syntax                   (unTypeCode, unsafeCodeCoerce, Exp(VarE, LetE), Dec(FunD), Clause(Clause), Body(NormalB))
+#endif
+import Parsley.Internal.Backend.Machine.LetBindings (LetBinding(..), Binding, Regs)
+import Parsley.Internal.Backend.Machine.State       (QSubRoutine(..), Func)
+import Parsley.Internal.Common.Utils                (Code)
+
+import Data.Dependent.Map as DMap (DMap, (!), map, toList, traverseWithKey)
+
+#if __GLASGOW_HASKELL__ < 900
+unsafeCodeCoerce :: Q Exp -> Code a
+unsafeCodeCoerce = unsafeTExpCoerce
+unTypeCode :: Code a -> Q Exp
+unTypeCode = unTypeQ
+#endif
+
+letRec :: GCompare key => {-bindings-}   DMap key (LetBinding o a)
+                       -> {-nameof-}     (forall x. key x -> String)
+                       -> {-genBinding-} (forall x rs. Binding o a x -> Regs rs -> DMap key (QSubRoutine s o a) -> Code (Func rs s o a x))
+                       -> {-expr-}       (DMap key (QSubRoutine s o a) -> Code b)
+                       -> Code b
+letRec bindings nameOf genBinding expr = unsafeCodeCoerce $
+  do -- Make a bunch of names
+     names <- traverseWithKey (\k (LetBinding _ rs) -> Const . (, Some rs) <$> newName (nameOf k)) bindings
+     -- Wrap them up so that they are valid typed template haskell names
+     let typedNames = DMap.map makeTypedName names
+     -- Generate each binding providing them with the names
+     let makeDecl (k :=> LetBinding body frees) =
+          do let Const (name, _) = names ! k
+             func <- unTypeCode (genBinding body frees typedNames)
+             return (FunD name [Clause [] (NormalB func) []])
+     decls <- traverse makeDecl (toList bindings)
+     -- Generate the main expression using the same names
+     exp <- unTypeCode (expr typedNames)
+     -- Construct the let expression
+     return (LetE decls exp)
+  where
+     makeTypedName :: Const (Name, Some Regs) x -> QSubRoutine s o a x
+     makeTypedName (Const (name, Some frees)) = QSubRoutine (unsafeCodeCoerce (return (VarE name))) frees
diff --git a/src/ghc/Parsley/Internal/Backend/Optimiser.hs b/src/ghc/Parsley/Internal/Backend/Optimiser.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Backend/Optimiser.hs
@@ -0,0 +1,17 @@
+module Parsley.Internal.Backend.Optimiser (optimise) where
+
+import Data.GADT.Compare                (geq)
+import Data.Typeable                    ((:~:)(Refl))
+import Parsley.Internal.Backend.Machine
+import Parsley.Internal.Common.Indexed
+
+-- We'll come back here later ;)
+optimise :: Instr o (Fix4 (Instr o)) xs n r a -> Fix4 (Instr o) xs n r a
+optimise (Push _ (In4 (Pop m))) = m
+optimise (Get _ _ (In4 (Pop m))) = m
+optimise (Dup (In4 (Pop m))) = m
+optimise (Dup (In4 (Swap m))) = In4 (Dup m)
+optimise (Get r1 a (In4 (Get r2 _ m))) | Just Refl <- r1 `geq` r2 = In4 (Get r1 a (In4 (Dup m)))
+optimise (Put r1 a (In4 (Get r2 _ m))) | Just Refl <- r1 `geq` r2 = In4 (Dup (In4 (Put r1 a m)))
+optimise (Get r1 _ (In4 (Put r2 _ m))) | Just Refl <- r1 `geq` r2 = m
+optimise m = In4 m
diff --git a/src/ghc/Parsley/Internal/Common.hs b/src/ghc/Parsley/Internal/Common.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Common.hs
@@ -0,0 +1,22 @@
+{-|
+Module      : Parsley.Internal.Core
+Description : Functionality that is not parser specific but used in various places.
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : unstable
+
+@since 0.1.0.0
+-}
+module Parsley.Internal.Common (
+    module Parsley.Internal.Common.Fresh,
+    module Parsley.Internal.Common.Indexed,
+    module Parsley.Internal.Common.Queue,
+    module Parsley.Internal.Common.Utils,
+    module Parsley.Internal.Common.Vec
+  ) where
+
+import Parsley.Internal.Common.Fresh
+import Parsley.Internal.Common.Indexed
+import Parsley.Internal.Common.Queue
+import Parsley.Internal.Common.Utils
+import Parsley.Internal.Common.Vec
diff --git a/src/ghc/Parsley/Internal/Common/Fresh.hs b/src/ghc/Parsley/Internal/Common/Fresh.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Common/Fresh.hs
@@ -0,0 +1,123 @@
+{-# LANGUAGE FunctionalDependencies,
+             GeneralisedNewtypeDeriving,
+             DerivingStrategies,
+             UndecidableInstances #-}
+module Parsley.Internal.Common.Fresh (
+    VFreshT, HFreshT, VFresh, HFresh,
+    runFreshT, runFresh,
+    evalFreshT, evalFresh,
+    execFreshT, execFresh,
+    MonadFresh(..), construct, mapVFreshT
+  ) where
+
+import Control.Applicative        (liftA2)
+import Control.Monad.Fix          (MonadFix(..))
+import Control.Monad.Identity     (Identity, runIdentity)
+import Control.Monad.Reader.Class (MonadReader(..))
+import Control.Monad.State.Class  (MonadState(..))
+import Control.Monad.Trans        (MonadTrans(..), MonadIO(..))
+
+-- Fresh operations
+class Monad m => MonadFresh x m | m -> x where
+  newVar :: m x
+  newScope :: m a -> m a
+
+construct :: MonadFresh x m => (x -> a) -> m a
+construct f = fmap f newVar
+
+mapVFreshT :: (m (a, x, x) -> n (b, x, x)) -> VFreshT x m a -> VFreshT x n b
+mapVFreshT f m = vFreshT (\cur max -> f (unVFreshT m cur max))
+
+class (Monad n, Monad m) => RunFreshT x n m | m -> x, m -> n where
+  runFreshT :: m a -> x -> n (a, x)
+
+evalFreshT :: RunFreshT x n m => m a -> x -> n a
+evalFreshT m init = fst <$> runFreshT m init
+
+execFreshT :: RunFreshT x n m => m a -> x -> n x
+execFreshT m init = snd <$> runFreshT m init
+
+-- Fresh type
+type HFresh x = HFreshT x Identity
+type VFresh x = VFreshT x Identity
+-- TODO Nominals
+newtype VFreshT x m a = VFreshT (FreshT x m a) deriving newtype (Functor, Applicative, Monad, MonadFix, MonadTrans, MonadIO, MonadReader r, MonadState s, RunFreshT x m)
+newtype HFreshT x m a = HFreshT (FreshT x m a) deriving newtype (Functor, Applicative, Monad, MonadFix, MonadTrans, MonadIO, MonadReader r, MonadState s, RunFreshT x m)
+newtype FreshT x m a = FreshT {unFreshT :: x -> x -> m (a, x, x)}
+
+instance Monad n => RunFreshT x n (FreshT x n) where
+  runFreshT k init =
+    do (x, _, max) <- unFreshT k init init
+       return $! (x, max)
+
+runFresh :: RunFreshT x Identity m => m a -> x -> (a, x)
+runFresh mx = runIdentity . runFreshT mx
+
+evalFresh :: RunFreshT x Identity m => m a -> x -> a
+evalFresh mx = runIdentity . evalFreshT mx
+
+execFresh :: RunFreshT x Identity m => m a -> x -> x
+execFresh mx = runIdentity . execFreshT mx
+
+vFreshT :: (x -> x -> m (a, x, x)) -> VFreshT x m a
+vFreshT = VFreshT . FreshT
+
+unVFreshT :: VFreshT x m a -> x -> x -> m (a, x, x)
+unVFreshT (VFreshT f) = unFreshT f
+
+hFreshT :: (x -> x -> m (a, x, x)) -> HFreshT x m a
+hFreshT = HFreshT . FreshT
+
+unHFreshT :: HFreshT x m a -> x -> x -> m (a, x, x)
+unHFreshT (HFreshT f) = unFreshT f
+
+instance Functor f => Functor (FreshT x f) where
+  {-# INLINE fmap #-}
+  fmap f (FreshT k) = FreshT (\cur max -> fmap (\(x, cur', max') -> (f x, cur', max')) (k cur max))
+
+instance Monad m => Applicative (FreshT x m) where
+  {-# INLINE pure #-}
+  pure x = FreshT (\cur max -> pure (x, cur, max))
+  {-# INLINE liftA2 #-}
+  liftA2 f (FreshT mx) (FreshT my) = FreshT (\cur max ->
+    do (x, cur', max') <- mx cur max
+       (y, cur'', max'') <- my cur' max'
+       return $! (f x y, cur'', max''))
+
+instance Monad m => Monad (FreshT x m) where
+  {-# INLINE return #-}
+  return = pure
+  {-# INLINE (>>=) #-}
+  (FreshT mx) >>= f = FreshT (\cur max ->
+    do (x, cur', max') <- mx cur max
+       unFreshT (f x) cur' max')
+
+instance MonadFix m => MonadFix (FreshT x m) where
+  {-# INLINE mfix #-}
+  mfix f = FreshT (\cur max -> mfix (\ ~(x, _, _) -> unFreshT (f x) cur max))
+
+instance MonadTrans (FreshT x) where
+  {-# INLINE lift #-}
+  lift m = FreshT (\cur max ->
+    do x <- m
+       return (x, cur, max))
+
+instance (Monad m, Ord x, Enum x) => MonadFresh x (VFreshT x m) where
+  newVar = vFreshT (\cur m -> return (cur, cur, max m cur))
+  newScope scoped = vFreshT (\cur max ->
+    do (x, _, max') <- unVFreshT scoped (succ cur) max
+       return $! (x, cur, max'))
+
+instance (Monad m, Ord x, Enum x) => MonadFresh x (HFreshT x m) where
+  newVar = hFreshT (\cur m -> return (cur, succ cur, max m cur))
+  newScope scoped = hFreshT (\cur max ->
+    do (x, _, max') <- unHFreshT scoped cur max
+       return $! (x, cur, max'))
+
+instance MonadIO m => MonadIO (FreshT x m) where liftIO = lift . liftIO
+instance MonadReader r m => MonadReader r (FreshT x m) where
+  ask = lift ask
+  local f m = FreshT (\cur next -> local f (unFreshT m cur next))
+instance MonadState s m => MonadState s (FreshT x m) where
+  get = lift get
+  put = lift . put
diff --git a/src/ghc/Parsley/Internal/Common/Indexed.hs b/src/ghc/Parsley/Internal/Common/Indexed.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Common/Indexed.hs
@@ -0,0 +1,98 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Parsley.Internal.Common.Indexed (module Parsley.Internal.Common.Indexed) where
+
+import Control.Applicative ((<|>), liftA2)
+import Data.Kind           (Type)
+import Data.Maybe          (fromMaybe)
+
+data Nat = Zero | Succ Nat
+type One = Succ Zero
+
+class IFunctor (f :: (Type -> Type) -> Type -> Type) where
+  imap :: (forall j. a j -> b j) -> f a i -> f b i
+
+class IFunctor4 (f :: ([Type] -> Nat -> Type -> Type -> Type) -> [Type] -> Nat -> Type -> Type -> Type) where
+  imap4 :: (forall i' j' k'. a i' j' k' x -> b i' j' k' x) -> f a i j k x -> f b i j k x
+
+newtype Fix f a = In (f (Fix f) a)
+newtype Fix4 f i j k l = In4 (f (Fix4 f) i j k l)
+
+inop :: Fix f a -> f (Fix f) a
+inop (In x) = x
+
+inop4 :: Fix4 f i j k l -> f (Fix4 f) i j k l
+inop4 (In4 x) = x
+
+cata :: forall f a i. IFunctor f => (forall j. f a j -> a j) -> Fix f i -> a i
+cata alg = go where
+  go :: Fix f j -> a j
+  go (In x) = alg (imap go x)
+
+cata' :: forall f a i. IFunctor f =>
+         (forall j. Fix f j -> f a j -> a j) ->
+         Fix f i -> a i
+cata' alg = go where
+  go :: Fix f j -> a j
+  go i@(In x) = alg i (imap go x)
+
+cata4 :: forall f a i j k x. IFunctor4 f =>
+         (forall i' j' k'. f a i' j' k' x -> a i' j' k' x) ->
+         Fix4 f i j k x -> a i j k x
+cata4 alg = go where
+  go :: Fix4 f i' j' k' x -> a i' j' k' x
+  go (In4 x) = alg (imap4 go x)
+
+data (f :+: g) k a where
+  L :: f k a -> (f :+: g) k a
+  R :: g k a -> (f :+: g) k a
+
+instance (IFunctor f, IFunctor g) => IFunctor (f :+: g) where
+  imap f (L x) = L (imap f x)
+  imap f (R y) = R (imap f y)
+
+(\/) :: (f a i -> b) -> (g a i -> b) -> (f :+: g) a i -> b
+(f \/ _) (L x) = f x
+(_ \/ g) (R y) = g y
+
+data Cofree f a i = a i :< f (Cofree f a) i
+{-# INLINE extract #-}
+extract :: Cofree f a i -> a i
+extract (x :< _) = x
+
+instance IFunctor f => IFunctor (Cofree f) where
+  imap f (x :< xs) = f x :< imap (imap f) xs
+
+histo :: IFunctor f => (forall j. f (Cofree f a) j -> a j) -> Fix f i -> a i
+histo alg = extract . cata (alg >>= (:<))
+
+data (f :*: g) i = f i :*: g i
+
+{-# INLINE (/\) #-}
+(/\) :: (a -> f i) -> (a -> g i) -> (a -> (f :*: g) i)
+(f /\ g) x = f x :*: g x
+
+{-# INLINE ifst #-}
+ifst :: (f :*: g) i -> f i
+ifst (x :*: _) = x
+{-# INLINE isnd #-}
+isnd :: (f :*: g) i -> g i
+isnd (_ :*: y) = y
+
+mutu :: IFunctor f => (forall j. f (a :*: b) j -> a j) -> (forall j. f (a :*: b) j -> b j) -> Fix f i -> (a :*: b) i
+mutu algl algr = cata (algl /\ algr)
+
+zygo :: IFunctor f => (forall j. f (a :*: b) j -> a j) -> (forall j. f b j -> b j) -> Fix f i -> a i
+zygo alg aux = ifst . mutu alg (aux . imap isnd)
+
+zipper :: IFunctor f => (forall j. f a j -> a j) -> (forall j. f b j -> b j) -> Fix f i -> (a :*: b) i
+zipper algl algr = mutu (algl . imap ifst) (algr . imap isnd)
+
+class                         Chain r k         where (|>) :: (a -> Maybe r) -> (a -> k) -> a -> k
+instance {-# OVERLAPPABLE #-} Chain a a         where (|>) = liftA2 (flip fromMaybe)
+instance {-# OVERLAPS #-}     Chain a (Maybe a) where (|>) = liftA2 (<|>)
+
+data Unit1 k = Unit
+newtype Const1 a k = Const1 {getConst1 :: a}
+
+data Unit4 i j k l = Unit4
+newtype Const4 a i j k l = Const4 {getConst4 :: a}
diff --git a/src/ghc/Parsley/Internal/Common/Queue.hs b/src/ghc/Parsley/Internal/Common/Queue.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Common/Queue.hs
@@ -0,0 +1,41 @@
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
+{-# LANGUAGE ViewPatterns,
+             DerivingStrategies #-}
+module Parsley.Internal.Common.Queue (Queue, empty, enqueue, dequeue, null, size, foldr) where
+
+import Prelude hiding (null, foldr)
+
+import qualified Prelude (foldr)
+
+data Queue a = Queue {
+  outsz :: Int,
+  outs  :: [a],
+  insz  :: Int,
+  ins   :: [a]
+} deriving stock Eq
+
+empty :: Queue a
+empty = Queue 0 [] 0 []
+
+enqueue :: a -> Queue a -> Queue a
+enqueue x q = q {insz = insz q + 1, ins = x : ins q}
+
+dequeue :: Queue a -> (a, Queue a)
+dequeue q@(outs -> (x:outs')) = (x, q {outsz = outsz q - 1, outs = outs'})
+dequeue q@(outs -> [])        = dequeue (Queue (insz q) (reverse (ins q)) 0 [])
+
+null :: Queue a -> Bool
+null (Queue 0 [] 0 []) = True
+null _ = False
+
+size :: Queue a -> Int
+size q = insz q + outsz q
+
+toList :: Queue a -> [a]
+toList q = outs q ++ reverse (ins q)
+
+foldr :: (a -> b -> b) -> b -> Queue a -> b
+foldr f k = Prelude.foldr f k . toList
+
+instance Show a => Show (Queue a) where
+  show = show . toList
diff --git a/src/ghc/Parsley/Internal/Common/State.hs b/src/ghc/Parsley/Internal/Common/State.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Common/State.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE DeriveFunctor,
+             MultiParamTypeClasses,
+             DerivingStrategies,
+             CPP #-}
+module Parsley.Internal.Common.State (
+    State, StateT,
+    runState, evalState, execState,
+    runStateT, evalStateT, execStateT,
+    module Control.Monad.State.Class
+  ) where
+
+import Control.Applicative       (liftA2, Alternative(..))
+#if __GLASGOW_HASKELL__ < 808
+import Control.Monad.Fail        (MonadFail(..))
+#endif
+import Control.Monad.Fix         (MonadFix(..))
+import Control.Monad.Identity    (Identity, runIdentity)
+import Control.Monad.State.Class
+import Control.Monad.Trans       (MonadTrans(..), MonadIO(..))
+
+#if __GLASGOW_HASKELL__ < 808
+import qualified Control.Monad.Fail as Fail (MonadFail(fail))
+#endif
+
+type State s = StateT s Identity
+{-# INLINE runState #-}
+runState :: State s a -> s -> (a, s)
+runState mx = runIdentity . runStateT mx
+
+{-# INLINE evalState #-}
+evalState :: State s a -> s -> a
+evalState mx = runIdentity . evalStateT mx
+
+{-# INLINE execState #-}
+execState :: State s a -> s -> s
+execState mx = runIdentity . execStateT mx
+
+newtype StateT s m a = StateT {unStateT :: forall r. s -> (a -> s -> m r) -> m r} deriving stock Functor
+
+{-# INLINE runStateT #-}
+runStateT :: Monad m => StateT s m a -> s -> m (a, s)
+runStateT (StateT f) s = f s (curry return)
+
+{-# INLINE evalStateT #-}
+evalStateT :: Monad m => StateT s m a -> s -> m a
+evalStateT (StateT f) s = f s (const . return)
+
+{-# INLINE execStateT #-}
+execStateT :: Monad m => StateT s m a -> s -> m s
+execStateT (StateT f) s = f s (const return)
+
+instance Applicative (StateT s m) where
+  {-# INLINE pure #-}
+  pure x = StateT (flip ($ x))
+  {-# INLINE liftA2 #-}
+  liftA2 f (StateT mx) (StateT my) = StateT (\s k -> mx s (\x s' -> my s' (\y s'' -> k (f x y) s'')))
+
+instance Monad (StateT s m) where
+  {-# INLINE return #-}
+  return = pure
+  {-# INLINE (>>=) #-}
+  StateT mx >>= f = StateT (\s k -> mx s (\x s' -> unStateT (f x) s' k))
+
+instance MonadFix m => MonadFix (StateT s m) where
+  {-# INLINE mfix #-}
+  mfix f = StateT (\s k -> mfix (\ ~(x, _) -> runStateT (f x) s) >>= uncurry k)
+
+instance MonadTrans (StateT s) where
+  {-# INLINE lift #-}
+  lift m = StateT (\s k -> m >>= (`k` s))
+
+instance MonadIO m => MonadIO (StateT s m) where liftIO = lift . liftIO
+
+instance MonadFail m => MonadFail (StateT s m) where
+#if __GLASGOW_HASKELL__ < 808
+  fail msg = StateT (\_ _ -> Fail.fail msg)
+#else
+  fail msg = StateT (\_ _ -> fail msg)
+#endif
+
+instance Alternative m => Alternative (StateT s m) where
+  empty = StateT (\_ _ -> empty)
+  StateT mx <|> StateT my = StateT (\s k -> mx s k <|> my s k)
+
+instance MonadState s (StateT s m) where
+  get = StateT (\s k -> k s s)
+  put s = StateT (\_ k -> k () s)
diff --git a/src/ghc/Parsley/Internal/Common/Utils.hs b/src/ghc/Parsley/Internal/Common/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Common/Utils.hs
@@ -0,0 +1,116 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE UndecidableInstances,
+             CPP #-}
+#if __GLASGOW_HASKELL__ >= 810
+{-# LANGUAGE StandaloneKindSignatures #-}
+#endif
+module Parsley.Internal.Common.Utils (WQ(..), Code, Quapplicative(..), intercalate, intercalateDiff) where
+
+import Data.List (intersperse)
+import Data.String (IsString(..))
+
+#if __GLASGOW_HASKELL__ >= 810
+import Data.Kind    (Type)
+import GHC.Exts    (TYPE, RuntimeRep)
+#endif
+
+#if __GLASGOW_HASKELL__ < 900
+import Language.Haskell.TH (TExp, Q)
+#else
+import qualified Language.Haskell.TH as TH (Code, Q)
+#endif
+
+{-|
+A type alias for typed template haskell code, which represents the Haskell AST for a given value.
+
+@since 0.1.0.0
+-}
+#if __GLASGOW_HASKELL__ == 810
+type Code :: forall (r :: RuntimeRep). TYPE r -> Type
+#endif
+#if __GLASGOW_HASKELL__ < 900
+type Code a = Q (TExp a)
+#else
+type Code a = TH.Code TH.Q a
+#endif
+
+{-|
+Pronounced \"with code\", this datatype is the representation for user-land values. It pairs
+a value up with its representation as Haskell @Code@. It should be manipulated using
+`Quapplicative`.
+
+@since 0.1.0.0
+-}
+data WQ a = WQ { __val :: a, __code :: Code a }
+
+{-|
+This class is used to manipulate the representations of both user-land values and defunctionalised
+representations. It can be used to construct these values as well as extract their underlying value
+and code representation on demand.
+
+It is named after the @Applicative@ class, with the @Q@ standing for \"code\". The @(`>*<`)@ operator
+is analogous to @(\<*>)@ and `makeQ` analogous to @pure@.
+
+@since 0.1.0.0
+-}
+class Quapplicative q where
+  {-|
+  Combines a value with its representation to build one of the representation types.
+
+  @since 0.1.0.0
+  -}
+  makeQ :: a -> Code a -> q a
+
+  {-|
+  Extracts the regular value out of the representation.
+
+  @since 0.1.0.0
+  -}
+  _val :: q a -> a
+
+  {-|
+  Extracts the representation of the value as code.
+
+  @since 0.1.0.0
+  -}
+  _code :: q a -> Code a
+
+  {-|
+  Pronounced \"quapp\", this can be used to combine the code of a function with the code of a value.
+
+  > const5 = makeQ const [||const||] >*< makeQ 5 [||5||]
+
+  is the same as saying
+
+  > const5 = makeQ (const 5) [||const 5||]
+
+  It is more idiomatically found as the output to the @IdiomsPlugin@.
+
+  @since 0.1.0.0
+  -}
+  (>*<) :: q (a -> b) -> q a -> q b
+  f >*< x = makeQ ((_val f) (_val x)) [||$$(_code f) $$(_code x)||]
+infixl 9 >*<
+
+{-|
+This instance is used to manipulate values of `WQ`.
+
+@since 0.1.0.0
+-}
+instance Quapplicative WQ where
+  makeQ = WQ
+  _code = __code
+  _val = __val
+
+intercalate :: Monoid w => w -> [w] -> w
+intercalate xs xss = mconcat (intersperse xs xss)
+
+instance IsString (String -> String) where
+  fromString = showString
+
+newtype Id a = Id {unId :: a -> a}
+instance Semigroup (Id a) where f <> g = Id $ unId f . unId g
+instance Monoid (Id a) where mempty = Id $ id
+
+intercalateDiff :: (a -> a) -> [(a -> a)] -> a -> a
+intercalateDiff sep xs = unId $ intercalate (Id sep) (map Id xs)
diff --git a/src/ghc/Parsley/Internal/Common/Vec.hs b/src/ghc/Parsley/Internal/Common/Vec.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Common/Vec.hs
@@ -0,0 +1,23 @@
+module Parsley.Internal.Common.Vec (module Parsley.Internal.Common.Vec, Nat(..)) where
+
+import Parsley.Internal.Common.Indexed (Nat(..))
+
+data Vec n a where
+  VNil :: Vec Zero a
+  VCons :: a -> Vec n a -> Vec (Succ n) a
+
+replicateVec :: SNat n -> a -> Vec n a
+replicateVec SZero _     = VNil
+replicateVec (SSucc n) x = VCons x (replicateVec n x)
+
+zipWithVec :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c
+zipWithVec _ VNil         VNil         = VNil
+zipWithVec f (VCons x xs) (VCons y ys) = VCons (f x y) (zipWithVec f xs ys)
+
+data SNat (n :: Nat) where
+  SZero :: SNat Zero
+  SSucc :: SNat n -> SNat (Succ n)
+
+class SingNat (n :: Nat) where sing :: SNat n
+instance SingNat Zero where sing = SZero
+instance SingNat n => SingNat (Succ n) where sing = SSucc sing
diff --git a/src/ghc/Parsley/Internal/Core.hs b/src/ghc/Parsley/Internal/Core.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Core.hs
@@ -0,0 +1,19 @@
+{-|
+Module      : Parsley.Internal.Core
+Description : The main AST and datatypes are found here
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : unstable
+
+@since 0.1.0.0
+-}
+module Parsley.Internal.Core (
+    Parser,
+    ParserOps,
+    module Parsley.Internal.Core.Defunc,
+    module Parsley.Internal.Core.InputTypes
+  ) where
+
+import Parsley.Internal.Core.Defunc hiding (genDefunc, genDefunc1, genDefunc2, ap)
+import Parsley.Internal.Core.InputTypes
+import Parsley.Internal.Core.Primitives (Parser, ParserOps)
diff --git a/src/ghc/Parsley/Internal/Core/CombinatorAST.hs b/src/ghc/Parsley/Internal/Core/CombinatorAST.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Core/CombinatorAST.hs
@@ -0,0 +1,132 @@
+{-# LANGUAGE ApplicativeDo,
+             OverloadedStrings #-}
+module Parsley.Internal.Core.CombinatorAST (module Parsley.Internal.Core.CombinatorAST) where
+
+import Data.Kind                         (Type)
+import Parsley.Internal.Common           (IFunctor(..), Fix, Const1(..), cata, intercalateDiff, (:+:))
+import Parsley.Internal.Core.Identifiers (MVar, ΣVar)
+import Parsley.Internal.Core.Defunc      (Defunc)
+
+{-|
+The opaque datatype that represents parsers.
+
+@since 0.1.0.0
+-}
+newtype Parser a = Parser {unParser :: Fix (Combinator :+: ScopeRegister) a}
+
+-- Core datatype
+data Combinator (k :: Type -> Type) (a :: Type) where
+  Pure           :: Defunc a -> Combinator k a
+  Satisfy        :: Defunc (Char -> Bool) -> Combinator k Char
+  (:<*>:)        :: k (a -> b) -> k a -> Combinator k b
+  (:*>:)         :: k a -> k b -> Combinator k b
+  (:<*:)         :: k a -> k b -> Combinator k a
+  (:<|>:)        :: k a -> k a -> Combinator k a
+  Empty          :: Combinator k a
+  Try            :: k a -> Combinator k a
+  LookAhead      :: k a -> Combinator k a
+  Let            :: Bool -> MVar a -> k a -> Combinator k a
+  NotFollowedBy  :: k a -> Combinator k ()
+  Branch         :: k (Either a b) -> k (a -> c) -> k (b -> c) -> Combinator k c
+  Match          :: k a -> [Defunc (a -> Bool)] -> [k b] -> k b -> Combinator k b
+  ChainPre       :: k (a -> a) -> k a -> Combinator k a
+  ChainPost      :: k a -> k (a -> a) -> Combinator k a
+  MakeRegister   :: ΣVar a -> k a -> k b -> Combinator k b
+  GetRegister    :: ΣVar a -> Combinator k a
+  PutRegister    :: ΣVar a -> k a -> Combinator k ()
+  Debug          :: String -> k a -> Combinator k a
+  MetaCombinator :: MetaCombinator -> k a -> Combinator k a
+
+data ScopeRegister (k :: Type -> Type) (a :: Type) where
+  ScopeRegister :: k a -> (forall r. Reg r a -> k b) -> ScopeRegister k b
+
+{-|
+This is an opaque representation of a parsing register. It cannot be manipulated as a user, and the
+type parameter @r@ is used to ensure that it cannot leak out of the scope it has been created in.
+It is the abstracted representation of a runtime storage location.
+
+@since 0.1.0.0
+-}
+newtype Reg (r :: Type) a = Reg (ΣVar a)
+
+data MetaCombinator where
+  Cut         :: MetaCombinator
+  RequiresCut :: MetaCombinator
+
+-- Instances
+instance IFunctor Combinator where
+  imap _ (Pure x)             = Pure x
+  imap _ (Satisfy p)          = Satisfy p
+  imap f (p :<*>: q)          = f p :<*>: f q
+  imap f (p :*>: q)           = f p :*>: f q
+  imap f (p :<*: q)           = f p :<*: f q
+  imap f (p :<|>: q)          = f p :<|>: f q
+  imap _ Empty                = Empty
+  imap f (Try p)              = Try (f p)
+  imap f (LookAhead p)        = LookAhead (f p)
+  imap f (Let r v p)          = Let r v (f p)
+  imap f (NotFollowedBy p)    = NotFollowedBy (f p)
+  imap f (Branch b p q)       = Branch (f b) (f p) (f q)
+  imap f (Match p fs qs d)    = Match (f p) fs (map f qs) (f d)
+  imap f (ChainPre op p)      = ChainPre (f op) (f p)
+  imap f (ChainPost p op)     = ChainPost (f p) (f op)
+  imap f (MakeRegister σ p q) = MakeRegister σ (f p) (f q)
+  imap _ (GetRegister σ)      = GetRegister σ
+  imap f (PutRegister σ p)    = PutRegister σ (f p)
+  imap f (Debug name p)       = Debug name (f p)
+  imap f (MetaCombinator m p) = MetaCombinator m (f p)
+
+instance Show (Fix Combinator a) where
+  show = ($ "") . getConst1 . cata (Const1 . alg)
+    where
+      alg (Pure x)                                  = "(pure " . shows x . ")"
+      alg (Satisfy f)                               = "(satisfy " . shows f . ")"
+      alg (Const1 pf :<*>: Const1 px)               = "(" . pf . " <*> " .  px . ")"
+      alg (Const1 p :*>: Const1 q)                  = "(" . p . " *> " . q . ")"
+      alg (Const1 p :<*: Const1 q)                  = "(" . p . " <* " . q . ")"
+      alg (Const1 p :<|>: Const1 q)                 = "(" . p . " <|> " . q . ")"
+      alg Empty                                     = "empty"
+      alg (Try (Const1 p))                          = "(try " . p . ")"
+      alg (LookAhead (Const1 p))                    = "(lookAhead " . p . ")"
+      alg (Let False v _)                           = "(let-bound " . shows v . ")"
+      alg (Let True v _)                            = "(rec " . shows v . ")"
+      alg (NotFollowedBy (Const1 p))                = "(notFollowedBy " . p . ")"
+      alg (Branch (Const1 b) (Const1 p) (Const1 q)) = "(branch " . b . " " . p . " " . q . ")"
+      alg (Match (Const1 p) fs qs (Const1 def))     = "(match " . p . " " . shows fs . " [" . intercalateDiff ", " (map getConst1 qs) . "] "  . def . ")"
+      alg (ChainPre (Const1 op) (Const1 p))         = "(chainPre " . op . " " . p . ")"
+      alg (ChainPost (Const1 p) (Const1 op))        = "(chainPost " . p . " " . op . ")"
+      alg (MakeRegister σ (Const1 p) (Const1 q))    = "(make " . shows σ . " " . p . " " . q . ")"
+      alg (GetRegister σ)                           = "(get " . shows σ . ")"
+      alg (PutRegister σ (Const1 p))                = "(put " . shows σ . " " . p . ")"
+      alg (Debug _ (Const1 p))                      = p
+      alg (MetaCombinator m (Const1 p))             = p . " [" . shows m . "]"
+
+instance IFunctor ScopeRegister where
+  imap f (ScopeRegister p g) = ScopeRegister (f p) (f . g)
+
+instance Show MetaCombinator where
+  show Cut = "coins after"
+  show RequiresCut = "requires cut"
+
+{-# INLINE traverseCombinator #-}
+traverseCombinator :: Applicative m => (forall a. f a -> m (k a)) -> Combinator f a -> m (Combinator k a)
+traverseCombinator expose (pf :<*>: px)        = do pf' <- expose pf; px' <- expose px; pure (pf' :<*>: px')
+traverseCombinator expose (p :*>: q)           = do p' <- expose p; q' <- expose q; pure (p' :*>: q')
+traverseCombinator expose (p :<*: q)           = do p' <- expose p; q' <- expose q; pure (p' :<*: q')
+traverseCombinator expose (p :<|>: q)          = do p' <- expose p; q' <- expose q; pure (p' :<|>: q')
+traverseCombinator _      Empty                = do pure Empty
+traverseCombinator expose (Try p)              = do p' <- expose p; pure (Try p')
+traverseCombinator expose (LookAhead p)        = do p' <- expose p; pure (LookAhead p')
+traverseCombinator expose (NotFollowedBy p)    = do p' <- expose p; pure (NotFollowedBy p')
+traverseCombinator expose (Branch b p q)       = do b' <- expose b; p' <- expose p; q' <- expose q; pure (Branch b' p' q')
+traverseCombinator expose (Match p fs qs d)    = do p' <- expose p; qs' <- traverse expose qs; d' <- expose d; pure (Match p' fs qs' d')
+traverseCombinator expose (ChainPre op p)      = do op' <- expose op; p' <- expose p; pure (ChainPre op' p')
+traverseCombinator expose (ChainPost p op)     = do p' <- expose p; op' <- expose op; pure (ChainPost p' op')
+traverseCombinator expose (MakeRegister σ p q) = do p' <- expose p; q' <- expose q; pure (MakeRegister σ p' q')
+traverseCombinator _      (GetRegister σ)      = do pure (GetRegister σ)
+traverseCombinator expose (PutRegister σ p)    = do p' <- expose p; pure (PutRegister σ p')
+traverseCombinator expose (Debug name p)       = do p' <- expose p; pure (Debug name p')
+traverseCombinator _      (Pure x)             = do pure (Pure x)
+traverseCombinator _      (Satisfy f)          = do pure (Satisfy f)
+traverseCombinator expose (Let r v p)          = do p' <- expose p; pure (Let r v p')
+traverseCombinator expose (MetaCombinator m p) = do p' <- expose p; pure (MetaCombinator m p')
diff --git a/src/ghc/Parsley/Internal/Core/Defunc.hs b/src/ghc/Parsley/Internal/Core/Defunc.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Core/Defunc.hs
@@ -0,0 +1,143 @@
+{-# LANGUAGE PatternSynonyms #-}
+module Parsley.Internal.Core.Defunc (module Parsley.Internal.Core.Defunc) where
+
+import Language.Haskell.TH.Syntax (Lift(..))
+import Parsley.Internal.Common.Utils (WQ(..), Code, Quapplicative(..))
+
+{-|
+This datatype is useful for providing an /inspectable/ representation of common Haskell functions.
+These can be provided in place of `WQ` to any combinator that requires it. The only difference is
+that the Parsley compiler is able to manipulate and match on the constructors, which might lead to
+optimisations. They can also be more convenient than constructing the `WQ` object itself:
+
+> ID ~= WQ id [||id||]
+> APP_H f x ~= WQ (f x) [||f x||]
+
+@since 0.1.0.0
+-}
+data Defunc a where
+  -- | Corresponds to the standard @id@ function
+  ID      :: Defunc (a -> a)
+  -- | Corresponds to the standard @(.)@ function applied to no arguments
+  COMPOSE :: Defunc ((b -> c) -> (a -> b) -> (a -> c))
+  -- | Corresponds to the standard @flip@ function applied to no arguments
+  FLIP    :: Defunc ((a -> b -> c) -> b -> a -> c)
+  -- | Corresponds to function application of two other `Defunc` values
+  APP_H   :: Defunc (a -> b) -> Defunc a -> Defunc b
+  -- | Corresponds to the partially applied @(== x)@ for some `Defunc` value @x@
+  EQ_H    :: Eq a => Defunc a -> Defunc (a -> Bool)
+  -- | Represents a liftable, showable value
+  LIFTED  :: (Show a, Lift a) => a -> Defunc a
+  -- | Represents the standard @(:)@ function applied to no arguments
+  CONS    :: Defunc (a -> [a] -> [a])
+  -- | Represents the standard @const@ function applied to no arguments
+  CONST   :: Defunc (a -> b -> a)
+  -- | Represents the empty list @[]@
+  EMPTY   :: Defunc [a]
+  -- | Wraps up any value of type `WQ`
+  BLACK   :: WQ a -> Defunc a
+
+{-|
+This instance is used to manipulate values of `Defunc`.
+
+@since 0.1.0.0
+-}
+instance Quapplicative Defunc where
+  makeQ x qx       = BLACK (makeQ x qx)
+  _val ID          = id
+  _val COMPOSE     = (.)
+  _val FLIP        = flip
+  _val (APP_H f x) = (_val f) (_val x)
+  _val (LIFTED x)  = x
+  _val (EQ_H x)    = ((_val x) ==)
+  _val CONS        = (:)
+  _val CONST       = const
+  _val EMPTY       = []
+  _val (BLACK f)   = _val f
+  _code = genDefunc
+  (>*<) = APP_H
+
+{-|
+This pattern represents fully applied composition of two `Defunc` values
+
+@since 0.1.0.0
+-}
+pattern COMPOSE_H     :: () => ((x -> y -> z) ~ ((b -> c) -> (a -> b) -> a -> c)) => Defunc x -> Defunc y -> Defunc z
+pattern COMPOSE_H f g = APP_H (APP_H COMPOSE f) g
+{-|
+This pattern corresponds to the standard @flip@ function applied to a single argument
+
+@since 0.1.0.0
+-}
+pattern FLIP_H        :: () => ((x -> y) ~ ((a -> b -> c) -> b -> a -> c)) => Defunc x -> Defunc y
+pattern FLIP_H f      = APP_H FLIP f
+{-|
+Represents the flipped standard @const@ function applied to no arguments
+
+@since 0.1.0.0
+-}
+pattern FLIP_CONST    :: () => (x ~ (a -> b -> b)) => Defunc x
+pattern FLIP_CONST    = FLIP_H CONST
+{-|
+This pattern represents the unit value @()@
+
+@since 0.1.0.0
+-}
+pattern UNIT          :: Defunc ()
+pattern UNIT          = LIFTED ()
+
+ap :: Defunc (a -> b) -> Defunc a -> Defunc b
+ap f x = APP_H f x
+
+genDefunc :: Defunc a -> Code a
+genDefunc ID              = [|| \x -> x ||]
+genDefunc COMPOSE         = [|| \f g x -> f (g x) ||]
+genDefunc FLIP            = [|| \f x y -> f y x ||]
+genDefunc (COMPOSE_H f g) = [|| \x -> $$(genDefunc1 (COMPOSE_H f g) [||x||]) ||]
+genDefunc CONST           = [|| \x _ -> x ||]
+genDefunc FLIP_CONST      = [|| \_ y -> y ||]
+genDefunc (FLIP_H f)      = [|| \x -> $$(genDefunc1 (FLIP_H f) [||x||]) ||]
+genDefunc (APP_H f x)     = genDefunc1 f (genDefunc x)
+genDefunc (LIFTED x)      = [|| x ||]
+genDefunc (EQ_H x)        = [|| \y -> $$(genDefunc1 (EQ_H x) [||y||]) ||]
+genDefunc CONS            = [|| \x xs -> x : xs ||]
+genDefunc EMPTY           = [|| [] ||]
+genDefunc (BLACK f)       = _code f
+
+genDefunc1 :: Defunc (a -> b) -> Code a -> Code b
+genDefunc1 ID              qx = qx
+genDefunc1 COMPOSE         qf = [|| \g x -> $$qf (g x) ||]
+genDefunc1 FLIP            qf = [|| \x y -> $$qf y x ||]
+genDefunc1 (COMPOSE_H f g) qx = genDefunc1 f (genDefunc1 g qx)
+genDefunc1 (APP_H ID f)    qx = genDefunc1 f qx
+genDefunc1 (APP_H f x)     qy = genDefunc2 f (genDefunc x) qy
+genDefunc1 CONST           qx = [|| \_ -> $$qx ||]
+genDefunc1 FLIP_CONST      _  = genDefunc ID
+genDefunc1 (FLIP_H f)      qx = [|| \y -> $$(genDefunc2 (FLIP_H f) qx [||y||]) ||]
+genDefunc1 (EQ_H x)        qy = [|| $$(genDefunc x)  == $$qy ||]
+genDefunc1 f               qx = [|| $$(genDefunc f) $$qx ||]
+
+genDefunc2 :: Defunc (a -> b -> c) -> Code a -> Code b -> Code c
+genDefunc2 ID              qf qx  = [|| $$qf $$qx ||]
+genDefunc2 COMPOSE         qf qg  = [|| \x -> $$qf ($$qg x) ||]
+genDefunc2 FLIP            qf qx  = [|| \y -> $$qf y $$qx ||]
+genDefunc2 (COMPOSE_H f g) qx qy  = genDefunc2 f (genDefunc1 g qx) qy
+genDefunc2 CONST           qx _   = qx
+genDefunc2 FLIP_CONST      _  qy  = qy
+genDefunc2 (FLIP_H f)      qx qy  = genDefunc2 f qy qx
+genDefunc2 CONS            qx qxs = [|| $$qx : $$qxs ||]
+genDefunc2 f               qx qy  = [|| $$(genDefunc f) $$qx $$qy ||]
+
+instance Show (Defunc a) where
+  show COMPOSE = "(.)"
+  show FLIP = "flip"
+  show (FLIP_H f) = concat ["(flip ", show f, ")"]
+  show (COMPOSE_H f g) = concat ["(", show f, " . ", show g, ")"]
+  show (APP_H f x) = concat ["(", show f, " ", show x, ")"]
+  show (LIFTED x) = show x
+  show (EQ_H x) = concat ["(== ", show x, ")"]
+  show ID  = "id"
+  show EMPTY = "[]"
+  show CONS = "(:)"
+  show CONST = "const"
+  show _ = "x"
diff --git a/src/ghc/Parsley/Internal/Core/Identifiers.hs b/src/ghc/Parsley/Internal/Core/Identifiers.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Core/Identifiers.hs
@@ -0,0 +1,44 @@
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
+{-# LANGUAGE DerivingStrategies,
+             GeneralizedNewtypeDeriving #-}
+module Parsley.Internal.Core.Identifiers (
+    MVar(..), IMVar,
+    ΣVar(..), IΣVar,
+  ) where
+
+import Data.Array        (Ix)
+import Data.GADT.Compare (GEq, GCompare, gcompare, geq, GOrdering(..))
+import Data.Kind         (Type)
+import Data.Typeable     ((:~:)(Refl))
+import Data.Word         (Word64)
+import Unsafe.Coerce     (unsafeCoerce)
+
+newtype ΣVar (a :: Type) = ΣVar IΣVar
+newtype MVar (a :: Type) = MVar IMVar
+newtype IMVar = IMVar Word64 deriving newtype (Ord, Eq, Num, Enum, Show, Ix)
+newtype IΣVar = IΣVar Word64 deriving newtype (Ord, Eq, Num, Enum, Show, Ix)
+
+instance Show (MVar a) where show (MVar μ) = "μ" ++ show μ
+instance Show (ΣVar a) where show (ΣVar σ) = "σ" ++ show σ
+
+instance GEq ΣVar where
+  geq (ΣVar u) (ΣVar v)
+    | u == v    = Just (unsafeCoerce Refl)
+    | otherwise = Nothing
+
+instance GCompare ΣVar where
+  gcompare σ1@(ΣVar u) σ2@(ΣVar v) = case compare u v of
+    LT -> GLT
+    EQ -> case geq σ1 σ2 of Just Refl -> GEQ
+    GT -> GGT
+
+instance GEq MVar where
+  geq (MVar u) (MVar v)
+    | u == v    = Just (unsafeCoerce Refl)
+    | otherwise = Nothing
+
+instance GCompare MVar where
+  gcompare μ1@(MVar u) μ2@(MVar v) = case compare u v of
+    LT -> GLT
+    EQ -> case geq μ1 μ2 of Just Refl -> GEQ
+    GT -> GGT
diff --git a/src/ghc/Parsley/Internal/Core/InputTypes.hs b/src/ghc/Parsley/Internal/Core/InputTypes.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Core/InputTypes.hs
@@ -0,0 +1,38 @@
+module Parsley.Internal.Core.InputTypes (module Parsley.Internal.Core.InputTypes) where
+
+import Data.Text (Text)
+
+{-|
+By wrapping a regular @Text@ input with this newtype, Parsley will assume that all
+of the characters fit into exactly one 16-bit chunk. This allows the consumption of
+characters in the datatype to be consumed much faster, but does not support multi-word
+characters. 
+
+@since 0.1.0.0
+-}
+newtype Text16 = Text16 Text
+
+--newtype CacheText = CacheText Text
+
+{-|
+By wrapping a regular @String@ with this newtype, Parsley will not preprocess it into
+an array of characters, instead using regular pattern matching for the implementation.
+
+@since 0.1.0.0
+-}
+newtype CharList = CharList String
+
+{-|
+An input type that represents an infinite stream of input characters.
+
+@since 0.1.0.0
+-}
+data Stream = {-# UNPACK #-} !Char :> Stream
+
+{-|
+The \"end\" of a stream, an infinite stream of \'\\0\' (null) characters
+
+@since 0.1.0.0
+-}
+nomore :: Stream
+nomore = '\0' :> nomore
diff --git a/src/ghc/Parsley/Internal/Core/Primitives.hs b/src/ghc/Parsley/Internal/Core/Primitives.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Core/Primitives.hs
@@ -0,0 +1,247 @@
+module Parsley.Internal.Core.Primitives (
+    Parser,
+    Reg,
+    module Parsley.Internal.Core.Primitives
+  ) where
+
+import Prelude hiding                      (pure)
+import Parsley.Internal.Core.CombinatorAST (Combinator(..), ScopeRegister(..), Reg(..), Parser(..))
+import Parsley.Internal.Core.Defunc        (Defunc(BLACK))
+import Parsley.Internal.Common.Indexed     (Fix(In), (:+:)(..))
+import Parsley.Internal.Common.Utils       (WQ)
+
+{-|
+This typeclass is used to allow abstraction of the representation of user-level functions.
+See the instances for information on what these representations are. This may be required
+as a constraint on custom built combinators that make use of one of the minimal required methods
+of this class.
+
+@since 0.1.0.0
+-}
+class ParserOps rep where
+  {-|
+  Lift a value into the parser world without consuming input or having any other effect.
+
+  @since 0.1.0.0
+  -}
+  pure :: rep a -> Parser a
+
+  {-|
+  Attempts to read a single character matching the provided predicate. If it succeeds, the
+  character will be returned and consumed, otherwise the parser will fail having consumed no input.
+
+  @since 0.1.0.0
+  -}
+  satisfy :: rep (Char -> Bool) -- ^ The predicate that a character must satisfy to be parsed
+          -> Parser Char        -- ^ A parser that matches a single character matching the predicate
+
+  {-|
+  @conditional fqs p def@ first parses @p@, then it will try each of the predicates in @fqs@ in turn
+  until one of them returns @True@. The corresponding parser for the first predicate that succeeded
+  is then executes, or if none of the predicates succeeded then the @def@ parser is executed.
+
+  @since 0.1.0.0
+  -}
+  conditional :: [(rep (a -> Bool), Parser b)] -- ^ A list of predicates and their outcomes
+              -> Parser a                      -- ^ A parser whose result is used to choose an outcome
+              -> Parser b                      -- ^ A parser who will be executed if no predicates succeed
+              -> Parser b
+
+{-|
+This is the default representation used for user-level functions and values: plain old code.
+
+@since 0.1.0.0
+-}
+instance ParserOps WQ where
+  pure = pure . BLACK
+  satisfy = satisfy . BLACK
+  conditional = conditional . map (\(f, t) -> (BLACK f, t))
+
+{-|
+This is used to allow defunctionalised versions of many standard Haskell functions to be used
+directly as an argument to relevant combinators.
+
+@since 0.1.0.0
+-}
+instance {-# INCOHERENT #-} x ~ Defunc => ParserOps x where
+  pure = _pure
+  satisfy = _satisfy
+  conditional = _conditional
+
+-- Core smart constructors
+{-# INLINE _pure #-}
+_pure :: Defunc a -> Parser a
+_pure = Parser . In . L . Pure
+
+{-|
+Sequential application of one parser's result to another's. The parsers must both succeed, one after
+the other to combine their results. If either parser fails then the combinator will fail.
+
+@since 0.1.0.0
+-}
+infixl 4 <*>
+(<*>) :: Parser (a -> b) -> Parser a -> Parser b
+Parser p <*> Parser q = Parser (In (L (p :<*>: q)))
+
+{-|
+Sequence two parsers, keeping the result of the second and discarding the result of the first.
+
+@since 0.1.0.0
+-}
+infixl 4 <*
+(<*) :: Parser a -> Parser b -> Parser a
+Parser p <* Parser q = Parser (In (L (p :<*: q)))
+
+{-|
+Sequence two parsers, keeping the result of the first and discarding the result of the second.
+
+@since 0.1.0.0
+-}
+infixl 4 *>
+(*>) :: Parser a -> Parser b -> Parser b
+Parser p *> Parser q = Parser (In (L (p :*>: q)))
+
+{-|
+This combinator always fails.
+
+@since 0.1.0.0
+-}
+empty :: Parser a
+empty = Parser (In (L Empty))
+
+{-|
+This combinator implements branching within a parser. It is left-biased, so that if the first branch
+succeeds, the second will not be attempted. In accordance with @parsec@ semantics, if the first
+branch failed having consumed input the second branch cannot be taken. (see `try`)
+
+@since 0.1.0.0
+-}
+infixr 3 <|>
+(<|>) :: Parser a -> Parser a -> Parser a
+Parser p <|> Parser q = Parser (In (L (p :<|>: q)))
+
+{-# INLINE _satisfy #-}
+_satisfy :: Defunc (Char -> Bool) -> Parser Char
+_satisfy = Parser . In . L . Satisfy
+
+{-|
+This combinator will attempt to parse a given parser. If it succeeds, the result is returned without
+having consumed any input. If it fails, however, any consumed input remains consumed.
+
+@since 0.1.0.0
+-}
+lookAhead :: Parser a -> Parser a
+lookAhead = Parser . In . L . LookAhead . unParser
+
+{-|
+This combinator will ensure that a given parser fails. If the parser does fail, a @()@ is returned
+and no input is consumed. If the parser succeeded, then this combinator will fail, however it will
+not consume any input.
+
+@since 0.1.0.0
+-}
+notFollowedBy :: Parser a -> Parser ()
+notFollowedBy = Parser . In . L . NotFollowedBy . unParser
+
+{-|
+This combinator allows a parser to backtrack on failure, which is to say that it will
+not have consumed any input if it were to fail. This is important since @parsec@ semantics demand
+that the second branch of @(`<|>`)@ can only be taken if the first did not consume input on failure.
+
+Excessive use of `try` will reduce the efficiency of the parser and effect the generated error
+messages. It should only be used in one of two circumstances:
+
+* When two branches of a parser share a common leading prefix (in which case, it is often better
+  to try and factor this out).
+* When a parser needs to be executed atomically (for example, tokens).
+
+@since 0.1.0.0
+-}
+try :: Parser a -> Parser a
+try = Parser . In . L . Try . unParser
+
+{-# INLINE _conditional #-}
+_conditional :: [(Defunc (a -> Bool), Parser b)] -> Parser a -> Parser b -> Parser b
+_conditional cs (Parser p) (Parser def) =
+  let (fs, qs) = unzip cs
+  in Parser (In (L (Match p fs (map unParser qs) def)))
+
+{-|
+One of the core @Selective@ operations. The behaviour of @branch p l r@ is to first to parse
+@p@, if it fails then the combinator fails. If @p@ succeeded then if its result is a @Left@, then
+the parser @l@ is executed and applied to the result of @p@, otherwise @r@ is executed and applied
+to the right from a @Right@.
+
+Crucially, only one of @l@ or @r@ will be executed on @p@'s success.
+
+@since 0.1.0.0
+-}
+branch :: Parser (Either a b) -- ^ The first parser to execute
+       -> Parser (a -> c)     -- ^ The parser to execute if the first returned a @Left@
+       -> Parser (b -> c)     -- ^ The parser to execute if the first returned a @Right@
+       -> Parser c
+branch (Parser c) (Parser p) (Parser q) = Parser (In (L (Branch c p q)))
+
+{-|
+This combinator parses repeated applications of an operator to a single final operand. This is
+primarily used to parse prefix operators in expressions.
+
+@since 0.1.0.0
+-}
+chainPre :: Parser (a -> a) -> Parser a -> Parser a
+chainPre (Parser op) (Parser p) = Parser (In (L (ChainPre op p)))
+
+{-|
+This combinator parses repeated applications of an operator to a single initial operand. This is
+primarily used to parse postfix operators in expressions.
+
+@since 0.1.0.0
+-}
+chainPost :: Parser a -> Parser (a -> a) -> Parser a
+chainPost (Parser p) (Parser op) = Parser (In (L (ChainPost p op)))
+
+{-|
+Creates a new register initialised with the value obtained from parsing the first
+argument. This register is provided to the second argument, a function that generates a parser
+depending on operations derived from the register. This parser is then performed.
+
+Note: The rank-2 type here serves a similar purpose to that in the @ST@ monad. It prevents the
+register from leaking outside of the scope of the function, safely encapsulating the stateful
+effect of the register.
+
+@since 0.1.0.0
+-}
+newRegister :: Parser a                        -- ^ Parser with which to initialise the register
+            -> (forall r. Reg r a -> Parser b) -- ^ Used to generate the second parser to execute
+            -> Parser b
+newRegister (Parser p) f = Parser (In (R (ScopeRegister p (unParser . f))))
+
+{-|
+Fetches a value from a register and returns it as its result.
+
+@since 0.1.0.0
+-}
+get :: Reg r a -> Parser a
+get (Reg reg) = Parser (In (L (GetRegister reg)))
+
+{-|
+Puts the result of the given parser into the given register. The old value in the register will be
+lost.
+
+@since 0.1.0.0
+-}
+put :: Reg r a -> Parser a -> Parser ()
+put (Reg reg) (Parser p) = Parser (In (L (PutRegister reg p)))
+
+{-|
+This combinator can be used to debug parsers that have gone wrong. Simply
+wrap a parser with @debug name@ and when that parser is executed it will
+print a debug trace on entry and exit along with the current context of the
+input.
+
+@since 0.1.0.0
+-}
+debug :: String   -- ^ The name that identifies the wrapped parser in the debug trace
+      -> Parser a -- ^ The parser to track during execution
+      -> Parser a
+debug name (Parser p) = Parser (In (L (Debug name p)))
diff --git a/src/ghc/Parsley/Internal/Frontend.hs b/src/ghc/Parsley/Internal/Frontend.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Frontend.hs
@@ -0,0 +1,14 @@
+{-|
+Module      : Parsley.Internal.Frontend
+Description : The frontend is concerned with AST manipulation and processing
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : stable
+
+@since 0.1.0.0
+-}
+module Parsley.Internal.Frontend (
+    module Parsley.Internal.Frontend.Compiler,
+  ) where
+
+import Parsley.Internal.Frontend.Compiler (compile)
diff --git a/src/ghc/Parsley/Internal/Frontend/CombinatorAnalyser.hs b/src/ghc/Parsley/Internal/Frontend/CombinatorAnalyser.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Frontend/CombinatorAnalyser.hs
@@ -0,0 +1,241 @@
+{-# LANGUAGE DerivingStrategies #-}
+module Parsley.Internal.Frontend.CombinatorAnalyser (analyse, compliance, Compliance(..), emptyFlags, AnalysisFlags(..)) where
+
+--import Control.Applicative                 (liftA2)
+--import Control.Monad.Reader                (ReaderT, ask, runReaderT, local)
+--import Control.Monad.State.Strict          (State, get, put, evalState)
+import Data.Coerce                         (coerce)
+import Data.Kind                           (Type)
+--import Data.Map.Strict                     (Map)
+--import Data.Set                            (Set)
+import Parsley.Internal.Common.Indexed     (Fix(..){-, imap, cata-}, zygo, (:*:)(..), ifst)
+import Parsley.Internal.Core.CombinatorAST (Combinator(..), MetaCombinator(..))
+--import Parsley.Internal.Core.Identifiers   (IMVar, MVar(..))
+
+--import qualified Data.Map.Strict as Map
+--import qualified Data.Set        as Set
+
+newtype AnalysisFlags = AnalysisFlags {
+  letBound :: Bool
+}
+emptyFlags :: AnalysisFlags
+emptyFlags = AnalysisFlags False
+
+analyse :: AnalysisFlags -> Fix Combinator a -> Fix Combinator a
+analyse flags = cutAnalysis (letBound flags) {-. terminationAnalysis-}
+
+data Compliance (k :: Type) = DomComp | NonComp | Comp | FullPure deriving stock (Show, Eq)
+
+seqCompliance :: Compliance a -> Compliance b -> Compliance c
+seqCompliance c FullPure = coerce c
+seqCompliance FullPure c = coerce c
+seqCompliance Comp _     = Comp
+seqCompliance _ _        = NonComp
+
+caseCompliance :: Compliance a -> Compliance b -> Compliance c
+caseCompliance c FullPure              = coerce c
+caseCompliance FullPure c              = coerce c
+caseCompliance c1 c2 | c1 == coerce c2 = coerce c1
+caseCompliance _ _                     = NonComp
+
+{-# INLINE compliance #-}
+compliance :: Combinator Compliance a -> Compliance a
+compliance (Pure _)                 = FullPure
+compliance (Satisfy _)              = NonComp
+compliance Empty                    = FullPure
+compliance Let{}                    = DomComp
+compliance (Try _)                  = DomComp
+compliance (NonComp :<|>: FullPure) = Comp
+compliance (_ :<|>: _)              = NonComp
+compliance (l :<*>: r)              = seqCompliance l r
+compliance (l :<*: r)               = seqCompliance l r
+compliance (l :*>: r)               = seqCompliance l r
+compliance (LookAhead c)            = c -- Lookahead will consume input on failure, so its compliance matches that which is beneath it
+compliance (NotFollowedBy _)        = FullPure
+compliance (Debug _ c)              = c
+compliance (ChainPre NonComp p)     = seqCompliance Comp p
+compliance (ChainPre _ p)           = seqCompliance NonComp p
+compliance (ChainPost p NonComp)    = seqCompliance p Comp
+compliance (ChainPost p _)          = seqCompliance p NonComp
+compliance (Branch b p q)           = seqCompliance b (caseCompliance p q)
+compliance (Match p _ qs def)       = seqCompliance p (foldr1 caseCompliance (def:qs))
+compliance (MakeRegister _ l r)     = seqCompliance l r
+compliance (GetRegister _)          = FullPure
+compliance (PutRegister _ c)        = coerce c
+compliance (MetaCombinator _ c)     = c
+
+newtype CutAnalysis a = CutAnalysis {doCut :: Bool -> (Fix Combinator a, Bool)}
+
+biliftA2 :: (a -> b -> c) -> (x -> y -> z) -> (a, x) -> (b, y) -> (c, z)
+biliftA2 f g (x1, y1) (x2, y2) = (f x1 x2, g y1 y2)
+
+cutAnalysis :: Bool -> Fix Combinator a -> Fix Combinator a
+cutAnalysis letBound = fst . ($ letBound) . doCut . zygo (CutAnalysis . alg) compliance
+  where
+    mkCut True = In . MetaCombinator Cut
+    mkCut False = id
+
+    requiresCut = In . MetaCombinator RequiresCut
+
+    seqAlg :: (Fix Combinator a -> Fix Combinator b -> Combinator (Fix Combinator) c) -> Bool -> CutAnalysis a -> CutAnalysis b -> (Fix Combinator c, Bool)
+    seqAlg con cut l r =
+      let (l', handled) = doCut l cut
+          (r', handled') = doCut r (cut && not handled)
+      in (In (con l' r'), handled || handled')
+
+    rewrap :: (Fix Combinator a -> Combinator (Fix Combinator) b) -> Bool -> CutAnalysis a -> (Fix Combinator b, Bool)
+    rewrap con cut p = let (p', handled) = doCut p cut in (In (con p'), handled)
+
+    alg :: Combinator (CutAnalysis :*: Compliance) a -> Bool -> (Fix Combinator a, Bool)
+    alg (Pure x) _ = (In (Pure x), False)
+    alg (Satisfy f) cut = (mkCut cut (In (Satisfy f)), True)
+    alg Empty _ = (In Empty, False)
+    alg (Let r μ p) cut = (mkCut (not cut) (In (Let r μ (fst (doCut (ifst p) True)))), False) -- If there is no cut, we generate a piggy for the continuation
+    alg (Try p) _ = False <$ rewrap Try False (ifst p)
+    alg ((p :*: NonComp) :<|>: (q :*: FullPure)) _ = (requiresCut (In (fst (doCut p True) :<|>: fst (doCut q False))), True)
+    alg (p :<|>: q) cut =
+      let (q', handled) = doCut (ifst q) cut
+      in (In (fst (doCut (ifst p) False) :<|>: q'), handled)
+    alg (l :<*>: r) cut = seqAlg (:<*>:) cut (ifst l) (ifst r)
+    alg (l :<*: r) cut = seqAlg (:<*:) cut (ifst l) (ifst r)
+    alg (l :*>: r) cut = seqAlg (:*>:) cut (ifst l) (ifst r)
+    alg (LookAhead p) cut = rewrap LookAhead cut (ifst p)
+    alg (NotFollowedBy p) _ = False <$ rewrap NotFollowedBy False (ifst p)
+    alg (Debug msg p) cut = rewrap (Debug msg) cut (ifst p)
+    alg (ChainPre (op :*: NonComp) p) _ =
+      let (op', _) = doCut op True
+          (p', _) = doCut (ifst p) False
+      in (requiresCut (In (ChainPre op' p')), True)
+    alg (ChainPre op p) cut =
+      let (op', _) = doCut (ifst op) False
+          (p', handled) = doCut (ifst p) cut
+      in (mkCut (not cut) (In (ChainPre op' p')), handled)
+    alg (ChainPost p (op :*: NonComp)) cut =
+      let (p', _) = doCut (ifst p) cut
+          (op', _) = doCut op True
+      in (requiresCut (In (ChainPost p' op')), True)
+    alg (ChainPost p op) cut =
+      let (p', handled) = doCut (ifst p) cut
+          (op', _) = doCut (ifst op) False
+      in (mkCut (cut && handled) (In (ChainPost p' op')), handled)
+    alg (Branch b p q) cut =
+      let (b', handled) = doCut (ifst b) cut
+          (p', handled') = doCut (ifst p) (cut && not handled)
+          (q', handled'') = doCut (ifst q) (cut && not handled)
+      in (In (Branch b' p' q'), handled || (handled' && handled''))
+    alg (Match p f qs def) cut =
+      let (p', handled) = doCut (ifst p) cut
+          (def', handled') = doCut (ifst def) (cut && not handled)
+          (qs', handled'') = foldr (\q -> biliftA2 (:) (&&) (doCut (ifst q) (cut && not handled))) ([], handled') qs
+      in (In (Match p' f qs' def'), handled || handled'')
+    alg (MakeRegister σ l r) cut = seqAlg (MakeRegister σ) cut (ifst l) (ifst r)
+    alg (GetRegister σ) _ = (In (GetRegister σ), False)
+    alg (PutRegister σ p) cut = rewrap (PutRegister σ) cut (ifst p)
+    alg (MetaCombinator m p) cut = rewrap (MetaCombinator m) cut (ifst p)
+
+-- Termination Analysis (Generalised left-recursion checker)
+{-data Consumption = Some | None | Never
+data Prop = Prop {success :: Consumption, fails :: Consumption, indisputable :: Bool} | Unknown
+
+looping (Prop Never Never _)          = True
+looping _                             = False
+strongLooping (Prop Never Never True) = True
+strongLooping _                       = False
+neverSucceeds (Prop Never _ _)        = True
+neverSucceeds _                       = False
+neverFails (Prop _ Never _)           = True
+neverFails _                          = False
+
+Never ||| _     = Never
+_     ||| Never = Never
+Some  ||| _     = Some
+None  ||| p     = p
+
+Some  &&& _    = Some
+_     &&& Some = Some
+None  &&& _    = None
+Never &&& p    = p
+
+Never ^^^ _     = Never
+_     ^^^ Never = Never
+None  ^^^ _     = None
+Some  ^^^ p     = p
+
+(==>) :: Prop -> Prop -> Prop
+p ==> _ | neverSucceeds p            = p
+_ ==> Prop Never Never True          = Prop Never Never True
+Prop None _ _ ==> Prop Never Never _ = Prop Never Never False
+Prop s1 f1 b1 ==> Prop s2 f2 b2      = Prop (s1 ||| s2) (f1 &&& (s1 ||| f2)) (b1 && b2)
+
+branching :: Prop -> [Prop] -> Prop
+branching b ps
+  | neverSucceeds b = b
+  | any strongLooping ps = Prop Never Never True
+branching (Prop None f _) ps
+  | any looping ps = Prop Never Never False
+  | otherwise      = Prop (foldr1 (|||) (map success ps)) (f &&& (foldr1 (^^^) (map fails ps))) False
+branching (Prop Some f _) ps = Prop (foldr (|||) Some (map success ps)) f False
+
+--data InferredTerm = Loops | Safe | Undecidable
+newtype Termination a = Termination {runTerm :: ReaderT (Set IMVar) (State (Map IMVar Prop)) Prop}
+terminationAnalysis :: Fix Combinator a -> Fix Combinator a
+terminationAnalysis p = if not (looping (evalState (runReaderT (runTerm (cata (Termination . alg) p)) Set.empty) Map.empty)) then p
+                        else error "Parser will loop indefinitely: either it is left-recursive or iterates over pure computations"
+  where
+    alg :: Combinator Termination a -> ReaderT (Set IMVar) (State (Map IMVar Prop)) Prop
+    alg (Satisfy _)                          = return $! Prop Some None True
+    alg (Pure _)                             = return $! Prop None Never True
+    alg Empty                                = return $! Prop Never None True
+    alg (Try p)                              =
+      do x <- runTerm p
+         return $! if looping x then x
+                   else Prop (success x) None (indisputable x)
+    alg (LookAhead p)                        =
+      do x <- runTerm p
+         return $! if looping x then x
+                   else Prop None (fails x) (indisputable x)
+    alg (NotFollowedBy p)                    =
+      do x <- runTerm p
+         return $! if looping x then x
+                   else Prop None None True
+    alg (p :<*>: q)                          = liftA2 (==>) (runTerm p) (runTerm q)
+    alg (p :*>: q)                           = liftA2 (==>) (runTerm p) (runTerm q)
+    alg (p :<*: q)                           = liftA2 (==>) (runTerm p) (runTerm q)
+    alg (p :<|>: q)                          =
+      do x <- runTerm p; case x of
+           -- If we fail without consuming input then q governs behaviour
+           Prop _ None _       -> runTerm q
+           -- If p never fails then q is irrelevant
+           x | neverFails x    -> return $! x
+           -- If p never succeeds then q governs
+           x | neverSucceeds x -> runTerm q
+           Prop s1 Some i1     -> do ~(Prop s2 f i2) <- runTerm q; return $! Prop (s1 &&& s2) (Some ||| f) (i1 && i2)
+    alg (Branch b p q)                       = liftA2 branching (runTerm b) (sequence [runTerm p, runTerm q])
+    alg (Match p _ qs def)                   = liftA2 branching (runTerm p) (traverse runTerm (def:qs))
+    alg (ChainPre op p)                      =
+      do x <- runTerm op; case x of
+           -- Never failing implies you must either loop or not consume input
+           Prop _ Never _ -> return $! Prop Never Never True
+           -- Reaching p can take a route that consumes no input, if op failed
+           _ -> do y <- runTerm p
+                   return $! if looping y then y
+                             else y -- TODO Verify!
+    alg (ChainPost p op)                     =
+      do y <- runTerm op; case y of
+           Prop None _ _ -> return $! Prop Never Never True
+           y -> do x <- runTerm p; case (x, y) of
+                     (Prop Some f _, Prop _ Never _) -> return $! Prop Some f False
+                     (x, y)                          -> return $! Prop (success x) (fails x &&& fails y) False -- TODO Verify
+    alg (Let True (MVar v) p)                =
+      do props <- get
+         seen <- ask
+         case Map.lookup v props of
+           Just prop -> return $! prop
+           Nothing | Set.member v seen -> return $! Prop Never Never False
+           Nothing -> do prop <- local (Set.insert v) (runTerm p)
+                         let prop' = if looping prop then Prop Never Never True else prop
+                         put (Map.insert v prop' props)
+                         return $! prop'
+    alg (Debug _ p)                          = runTerm p
+    --alg _                                    = return $! Unknown
+-}
diff --git a/src/ghc/Parsley/Internal/Frontend/Compiler.hs b/src/ghc/Parsley/Internal/Frontend/Compiler.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Frontend/Compiler.hs
@@ -0,0 +1,179 @@
+{-# OPTIONS_GHC -fno-hpc #-}
+{-# LANGUAGE AllowAmbiguousTypes,
+             MagicHash,
+             MultiParamTypeClasses,
+             MultiWayIf,
+             RecursiveDo,
+             UndecidableInstances #-}
+module Parsley.Internal.Frontend.Compiler (compile) where
+
+import Prelude hiding (pred)
+import Data.Dependent.Map                           (DMap)
+import Data.Hashable                                (Hashable, hashWithSalt, hash)
+import Data.HashMap.Strict                          (HashMap)
+import Data.HashSet                                 (HashSet)
+import Data.IORef                                   (IORef, newIORef, readIORef, writeIORef)
+import Data.Kind                                    (Type)
+import Data.Maybe                                   (isJust)
+import Data.Set                                     (Set)
+import Control.Arrow                                (first, second)
+import Control.Monad                                (void, when)
+import Control.Monad.Reader                         (ReaderT, runReaderT, local, ask, MonadReader)
+import GHC.Exts                                     (Int(..), unsafeCoerce#)
+import GHC.Prim                                     (StableName#)
+import GHC.StableName                               (StableName(..), makeStableName, hashStableName, eqStableName)
+import Numeric                                      (showHex)
+import Parsley.Internal.Core.CombinatorAST          (Combinator(..), ScopeRegister(..), Reg(..), Parser(..), traverseCombinator)
+import Parsley.Internal.Core.Identifiers            (IMVar, MVar(..), IΣVar, ΣVar(..))
+import Parsley.Internal.Common.Fresh                (HFreshT, newVar, runFreshT)
+import Parsley.Internal.Common.Indexed              (Fix(In), cata, cata', IFunctor(imap), (:+:)(..), (\/), Const1(..))
+import Parsley.Internal.Common.State                (State, get, gets, runState, execState, modify', MonadState)
+import Parsley.Internal.Frontend.Optimiser          (optimise)
+import Parsley.Internal.Frontend.CombinatorAnalyser (analyse, emptyFlags, AnalysisFlags(..))
+import Parsley.Internal.Frontend.Dependencies       (dependencyAnalysis)
+import Parsley.Internal.Trace                       (Trace(trace))
+import System.IO.Unsafe                             (unsafePerformIO)
+
+import qualified Data.Dependent.Map  as DMap    ((!), empty, insert, mapWithKey, size)
+import qualified Data.HashMap.Strict as HashMap (lookup, insert, empty, insertWith, foldrWithKey, (!))
+import qualified Data.HashSet        as HashSet (member, insert, empty)
+import qualified Data.Map            as Map     ((!))
+import qualified Data.Set            as Set     (empty)
+
+{-# INLINEABLE compile #-}
+compile :: forall compiled a. Trace => Parser a -> (forall x. Maybe (MVar x) -> Fix Combinator x -> Set IΣVar -> IMVar -> IΣVar -> compiled x) -> (compiled a, DMap MVar compiled)
+compile (Parser p) codeGen = trace ("COMPILING NEW PARSER WITH " ++ show (DMap.size μs') ++ " LET BINDINGS") (codeGen' Nothing p', DMap.mapWithKey (codeGen' . Just) μs')
+  where
+    (p', μs, maxV) = preprocess p
+    (μs', frs, maxΣ) = dependencyAnalysis p' μs
+
+    freeRegs :: Maybe (MVar x) -> Set IΣVar
+    freeRegs = maybe Set.empty (\(MVar v) -> frs Map.! v)
+
+    codeGen' :: Maybe (MVar x) -> Fix Combinator x -> compiled x
+    codeGen' letBound p = codeGen letBound (analyse (emptyFlags {letBound = isJust letBound}) p) (freeRegs letBound) (maxV + 1) (maxΣ + 1)
+
+preprocess :: Fix (Combinator :+: ScopeRegister) a -> (Fix Combinator a, DMap MVar (Fix Combinator), IMVar)
+preprocess p =
+  let q = tagParser p
+      (lets, recs) = findLets q
+      (p', μs, maxV) = letInsertion lets recs q
+  in (p', μs, maxV)
+
+data ParserName = forall a. ParserName (StableName# (Fix (Combinator :+: ScopeRegister) a))
+data Tag t f (k :: Type -> Type) a = Tag {tag :: t, tagged :: f k a}
+
+tagParser :: Fix (Combinator :+: ScopeRegister) a -> Fix (Tag ParserName Combinator) a
+tagParser p = cata' tagAlg p
+  where
+    tagAlg p = In . Tag (makeParserName p) . (id \/ descope)
+    descope (ScopeRegister p f) = freshReg regMaker (\reg@(Reg σ) -> MakeRegister σ p (f reg))
+    regMaker :: IORef IΣVar
+    regMaker = newRegMaker p
+
+data LetFinderState = LetFinderState { preds  :: HashMap ParserName Int
+                                     , recs   :: HashSet ParserName }
+type LetFinderCtx   = HashSet ParserName
+newtype LetFinder a = LetFinder { doLetFinder :: ReaderT LetFinderCtx (State LetFinderState) () }
+
+findLets :: Fix (Tag ParserName Combinator) a -> (HashSet ParserName, HashSet ParserName)
+findLets p = (lets, recs)
+  where
+    state = LetFinderState HashMap.empty HashSet.empty
+    ctx = HashSet.empty
+    LetFinderState preds recs = execState (runReaderT (doLetFinder (cata findLetsAlg p)) ctx) state
+    lets = HashMap.foldrWithKey (\k n ls -> if n > 1 then HashSet.insert k ls else ls) HashSet.empty preds
+
+findLetsAlg :: Tag ParserName Combinator LetFinder a -> LetFinder a
+findLetsAlg p = LetFinder $ do
+  let name = tag p
+  addPred name
+  ifSeen name
+    (do addRec name)
+    (ifNotProcessedBefore name
+      (void (addName name (traverseCombinator (fmap Const1 . doLetFinder) (tagged p)))))
+
+newtype LetInserter a =
+  LetInserter {
+      doLetInserter :: HFreshT IMVar
+                       (State ( HashMap ParserName IMVar
+                              , DMap MVar (Fix Combinator)))
+                       (Fix Combinator a)
+    }
+letInsertion :: HashSet ParserName -> HashSet ParserName -> Fix (Tag ParserName Combinator) a -> (Fix Combinator a, DMap MVar (Fix Combinator), IMVar)
+letInsertion lets recs p = (p', μs, μMax)
+  where
+    m = cata alg p
+    ((p', μMax), (_, μs)) = runState (runFreshT (doLetInserter m) 0) (HashMap.empty, DMap.empty)
+    alg :: Tag ParserName Combinator LetInserter a -> LetInserter a
+    alg p = LetInserter $ do
+      let name = tag p
+      let q = tagged p
+      (vs, μs) <- get
+      let bound = HashSet.member name lets
+      let recu = HashSet.member name recs
+      if bound || recu then case HashMap.lookup name vs of
+        Just v  -> let μ = MVar v in return $! optimise (Let recu μ (μs DMap.! μ))
+        Nothing -> do
+          v <- newVar
+          let μ = MVar v
+          modify' (first (HashMap.insert name v))
+          rec
+            modify' (second (DMap.insert μ q'))
+            q' <- doLetInserter (postprocess q) -- This line should be moved above when there is an inliner pass
+          return $! optimise (Let recu μ q')
+      else do doLetInserter (postprocess q)
+
+postprocess :: Combinator LetInserter a -> LetInserter a
+postprocess = LetInserter . fmap optimise . traverseCombinator doLetInserter
+
+modifyPreds :: MonadState LetFinderState m => (HashMap ParserName Int -> HashMap ParserName Int) -> m ()
+modifyPreds f = modify' (\st -> st {preds = f (preds st)})
+
+modifyRecs :: MonadState LetFinderState m => (HashSet ParserName -> HashSet ParserName) -> m ()
+modifyRecs f = modify' (\st -> st {recs = f (recs st)})
+
+addPred :: MonadState LetFinderState m => ParserName -> m ()
+addPred k = modifyPreds (HashMap.insertWith (+) k 1)
+
+addRec :: MonadState LetFinderState m => ParserName -> m ()
+addRec = modifyRecs . HashSet.insert
+
+ifSeen :: MonadReader LetFinderCtx m => ParserName -> m a -> m a -> m a
+ifSeen x yes no = do seen <- ask; if HashSet.member x seen then yes else no
+
+ifNotProcessedBefore :: MonadState LetFinderState m => ParserName -> m () -> m ()
+ifNotProcessedBefore x m =
+  do oneReference <- gets ((== 1) . (HashMap.! x) . preds)
+     when oneReference m
+
+addName :: MonadReader LetFinderCtx m => ParserName -> m b -> m b
+addName x = local (HashSet.insert x)
+
+makeParserName :: Fix (Combinator :+: ScopeRegister) a -> ParserName
+-- Force evaluation of p to ensure that the stableName is correct first time
+makeParserName !p = unsafePerformIO (fmap (\(StableName name) -> ParserName name) (makeStableName p))
+
+-- The argument here stops GHC from floating it out, it should be provided something from the scope
+{-# NOINLINE newRegMaker #-}
+newRegMaker :: a -> IORef IΣVar
+newRegMaker x = x `seq` unsafePerformIO (newIORef 0)
+
+{-# NOINLINE freshReg #-}
+freshReg :: IORef IΣVar -> (forall r. Reg r a -> x) -> x
+freshReg maker scope = scope $ unsafePerformIO $ do
+  x <- readIORef maker
+  writeIORef maker (x + 1)
+  return $! Reg (ΣVar x)
+
+instance IFunctor f => IFunctor (Tag t f) where
+  imap f (Tag t k) = Tag t (imap f k)
+
+instance Eq ParserName where
+  (ParserName n) == (ParserName m) = eqStableName (StableName n) (StableName m)
+instance Hashable ParserName where
+  hash (ParserName n) = hashStableName (StableName n)
+  hashWithSalt salt (ParserName n) = hashWithSalt salt (StableName n)
+
+-- There is great evil in this world, and I'm probably responsible for half of it
+instance Show ParserName where showsPrec _ (ParserName n) = showHex (I# (unsafeCoerce# n))
diff --git a/src/ghc/Parsley/Internal/Frontend/Dependencies.hs b/src/ghc/Parsley/Internal/Frontend/Dependencies.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Frontend/Dependencies.hs
@@ -0,0 +1,164 @@
+{-# LANGUAGE RecordWildCards #-}
+module Parsley.Internal.Frontend.Dependencies (dependencyAnalysis) where
+
+import Control.Arrow                        (first, second)
+import Control.Monad                        (unless, forM_)
+import Data.Array                           (Array, (!), listArray)
+import Data.Array.MArray                    (readArray, writeArray, newArray)
+import Data.Array.ST                        (runSTUArray)
+import Data.Array.Unboxed                   (assocs)
+import Data.Dependent.Map                   (DMap)
+import Data.List                            (foldl', partition, sortOn)
+import Data.Map.Strict                      (Map)
+import Data.Maybe                           (fromMaybe)
+import Data.Set                             (Set, insert, (\\), union, notMember, empty)
+import Data.STRef                           (newSTRef, readSTRef, writeSTRef)
+import Parsley.Internal.Common.Indexed      (Fix, cata, Const1(..), (:*:)(..), zipper)
+import Parsley.Internal.Common.State        (State, MonadState, execState, modify')
+import Parsley.Internal.Core.CombinatorAST  (Combinator(..), traverseCombinator)
+import Parsley.Internal.Core.Identifiers    (IMVar, MVar(..), IΣVar, ΣVar(..))
+
+import qualified Data.Dependent.Map as DMap (foldrWithKey, filterWithKey)
+import qualified Data.Map.Strict    as Map  ((!), empty, insert, mapMaybeWithKey, findMax, elems, lookup, foldMapWithKey)
+import qualified Data.Set           as Set  (elems, empty, insert, lookupMax)
+
+type Graph = Array IMVar [IMVar]
+
+-- TODO This actually should be in the backend... dead bindings and the topological ordering can be computed here
+--      but the register stuff should come after register optimisation and instruction peephole
+
+dependencyAnalysis :: Fix Combinator a -> DMap MVar (Fix Combinator) -> (DMap MVar (Fix Combinator), Map IMVar (Set IΣVar), IΣVar)
+dependencyAnalysis toplevel μs =
+  let -- Step 1: find roots of the toplevel
+      roots = directDependencies toplevel
+      -- Step 2: build immediate dependencies
+      DependencyMaps{..} = buildDependencyMaps μs
+      -- Step 3: find the largest name
+      n = fst (Map.findMax immediateDependencies)
+      -- Step 4: Build a dependency graph
+      graph = buildGraph n immediateDependencies
+      -- Step 5: construct the seen set (dfnum)
+      -- Step 6: dfs from toplevel (via roots) all with same seen set
+      -- Step 7: elems of seen set with dfnum 0 are dead, otherwise they are collected into a list in descending order
+      (topo, dead) = topoOrdering roots n graph
+      -- Step 8: perform a dfs on each of the topo, with a new seen set for each,
+      --         building the flattened dependency map. If the current focus has
+      --         already been computed, add all its deps to the seen set and skip.
+      --         The end seen set becomes out flattened deps.
+      trueDeps = flattenDependencies topo (minMax topo) graph
+      -- Step 8: Compute the new registers, and remove dead ones
+      addNewRegs v uses
+        | notMember v dead = let deps = trueDeps Map.! v
+                                 defs = definedRegisters Map.! v
+                                 subUses = foldMap (usedRegisters Map.!) deps
+                                 subDefs = foldMap (definedRegisters Map.!) deps
+                             in Just $ (uses \\ defs) `union` (subUses \\ subDefs)
+        | otherwise        = Nothing
+      trueRegs = Map.mapMaybeWithKey addNewRegs usedRegisters
+      largestRegister = fromMaybe (-1) (Set.lookupMax (Map.foldMapWithKey (const id) definedRegisters))
+  in (DMap.filterWithKey (\(MVar v) _ -> notMember v dead) μs, trueRegs, largestRegister)
+
+minMax :: Ord a => [a] -> (a, a)
+minMax []     = error "cannot find minimum or maximum of empty list"
+minMax (x:xs) = foldl' (\(small, big) x -> (min small x, max big x)) (x, x) xs
+
+buildGraph :: IMVar -> Map IMVar (Set IMVar) -> Graph
+buildGraph n = listArray (0, n) . map Set.elems . Map.elems
+
+topoOrdering :: Set IMVar -> IMVar -> Graph -> ([IMVar], Set IMVar)
+topoOrdering roots n graph =
+  let dfnums = runSTUArray $ do
+        dfnums <- newArray (0, n) (0 :: Int)
+        nextDfnum <- newSTRef 1
+        let hasSeen v = (/= 0) <$> readArray dfnums v
+        let setSeen v = do dfnum <- readSTRef nextDfnum
+                           writeArray dfnums v dfnum
+                           writeSTRef nextDfnum (dfnum + 1)
+        forM_ roots (dfs hasSeen setSeen graph)
+        return dfnums
+      (lives, deads) = partition ((/= 0) . snd) (assocs dfnums)
+  in (reverseMap fst (sortOn snd lives), foldl' (\ds v0 -> Set.insert (fst v0) ds) Set.empty deads)
+
+reverseMap :: (a -> b) -> [a] -> [b]
+reverseMap f = foldl' (\xs x -> f x : xs) []
+
+flattenDependencies :: [IMVar] -> (IMVar, IMVar) -> Graph -> Map IMVar (Set IMVar)
+flattenDependencies topo range graph = foldl' reachable Map.empty topo
+  where
+    reachable :: Map IMVar (Set IMVar) -> IMVar -> Map IMVar (Set IMVar)
+    reachable deps root =
+      let seen = runSTUArray $ do
+            seen <- newArray range False
+            let setSeen v = writeArray seen v True
+            let seenOrSkip v = case Map.lookup v deps of
+                  Nothing -> readArray seen v
+                  Just ds -> setSeen v >> forM_ ds setSeen >> return True
+            dfs seenOrSkip setSeen graph root
+            return seen
+          ds = foldl' (\ds (v, b) -> if b then Set.insert v ds else ds) Set.empty (assocs seen)
+      in Map.insert root ds deps
+
+dfs :: Monad m => (IMVar -> m Bool) -> (IMVar -> m ()) -> Graph -> IMVar -> m ()
+dfs hasSeen setSeen graph = go
+  where
+    go v = do seen <- hasSeen v
+              unless seen $
+                do setSeen v
+                   forM_ (graph ! v) go
+
+-- IMMEDIATE DEPENDENCY MAPS
+data DependencyMaps = DependencyMaps {
+  usedRegisters         :: Map IMVar (Set IΣVar), -- Leave Lazy
+  immediateDependencies :: Map IMVar (Set IMVar), -- Could be Strict
+  definedRegisters      :: Map IMVar (Set IΣVar)
+}
+
+buildDependencyMaps :: DMap MVar (Fix Combinator) -> DependencyMaps
+buildDependencyMaps = DMap.foldrWithKey (\(MVar v) p deps@DependencyMaps{..} ->
+  let (frs, defs, ds) = freeRegistersAndDependencies v p
+  in deps { usedRegisters = Map.insert v frs usedRegisters
+          , immediateDependencies = Map.insert v ds immediateDependencies
+          , definedRegisters = Map.insert v defs definedRegisters}) (DependencyMaps Map.empty Map.empty Map.empty)
+
+freeRegistersAndDependencies :: IMVar -> Fix Combinator a -> (Set IΣVar,  Set IΣVar, Set IMVar)
+freeRegistersAndDependencies v p =
+  let frsm :*: depsm = zipper freeRegistersAlg (dependenciesAlg (Just v)) p
+      (frs, defs) = runFreeRegisters frsm
+      ds = runDependencies depsm
+  in (frs, defs, ds)
+
+-- DEPENDENCY ANALYSIS
+newtype Dependencies a = Dependencies { doDependencies :: State (Set IMVar) () }
+runDependencies :: Dependencies a -> Set IMVar
+runDependencies = flip execState empty. doDependencies
+
+directDependencies :: Fix Combinator a -> Set IMVar
+directDependencies = runDependencies . cata (dependenciesAlg Nothing)
+
+{-# INLINE dependenciesAlg #-}
+dependenciesAlg :: Maybe IMVar -> Combinator Dependencies a -> Dependencies a
+dependenciesAlg (Just v) (Let _ μ@(MVar u) _) = Dependencies $ do unless (u == v) (dependsOn μ)
+dependenciesAlg Nothing  (Let _ μ _)          = Dependencies $ do dependsOn μ
+dependenciesAlg _ p                           = Dependencies $ do traverseCombinator (fmap Const1 . doDependencies) p; return ()
+
+dependsOn :: MonadState (Set IMVar) m => MVar a -> m ()
+dependsOn (MVar v) = modify' (insert v)
+
+-- FREE REGISTER ANALYSIS
+newtype FreeRegisters a = FreeRegisters { doFreeRegisters :: State (Set IΣVar, Set IΣVar) () }
+runFreeRegisters :: FreeRegisters a -> (Set IΣVar, Set IΣVar)
+runFreeRegisters = flip execState (empty, empty) . doFreeRegisters
+
+{-# INLINE freeRegistersAlg #-}
+freeRegistersAlg :: Combinator FreeRegisters a -> FreeRegisters a
+freeRegistersAlg (GetRegister σ)      = FreeRegisters $ do uses σ
+freeRegistersAlg (PutRegister σ p)    = FreeRegisters $ do uses σ; doFreeRegisters p
+freeRegistersAlg (MakeRegister σ p q) = FreeRegisters $ do defs σ; doFreeRegisters p; doFreeRegisters q
+freeRegistersAlg Let{}                = FreeRegisters $ do return () -- TODO This can be removed when Let doesn't have the body in it...
+freeRegistersAlg p                    = FreeRegisters $ do traverseCombinator (fmap Const1 . doFreeRegisters) p; return ()
+
+uses :: MonadState (Set IΣVar, vs) m => ΣVar a -> m ()
+uses (ΣVar σ) = modify' (first (insert σ)) --tell (singleton σ, mempty)
+
+defs :: MonadState (vs, Set IΣVar) m => ΣVar a -> m ()
+defs (ΣVar σ) = modify' (second (insert σ)) --tell (mempty, singleton σ)
diff --git a/src/ghc/Parsley/Internal/Frontend/Optimiser.hs b/src/ghc/Parsley/Internal/Frontend/Optimiser.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Frontend/Optimiser.hs
@@ -0,0 +1,177 @@
+{-# LANGUAGE LambdaCase,
+             PatternSynonyms,
+             ViewPatterns #-}
+module Parsley.Internal.Frontend.Optimiser (optimise) where
+
+import Prelude hiding                      ((<$>))
+import Parsley.Internal.Common             (Fix(In), Quapplicative(..))
+import Parsley.Internal.Core.CombinatorAST (Combinator(..))
+import Parsley.Internal.Core.Defunc        (Defunc(..), pattern FLIP_H, pattern COMPOSE_H, pattern FLIP_CONST, pattern UNIT)
+
+pattern (:<$>:) :: Defunc (a -> b) -> Fix Combinator a -> Combinator (Fix Combinator) b
+pattern f :<$>: p = In (Pure f) :<*>: p
+pattern (:$>:) :: Fix Combinator a -> Defunc b -> Combinator (Fix Combinator) b
+pattern p :$>: x = p :*>: In (Pure x)
+pattern (:<$:) :: Defunc a -> Fix Combinator b -> Combinator (Fix Combinator) a
+pattern x :<$: p = In (Pure x) :<*: p
+
+optimise :: Combinator (Fix Combinator) a -> Fix Combinator a
+-- DESTRUCTIVE OPTIMISATION
+-- Right Absorption Law: empty <*> u                    = empty
+optimise (In Empty :<*>: _)                             = In Empty
+-- Failure Weakening Law: u <*> empty                   = u *> empty
+optimise (u :<*>: In Empty)                             = optimise (u :*>: In Empty)
+-- Right Absorption Law: empty *> u                     = empty
+optimise (In Empty :*>: _)                              = In Empty
+-- Right Absorption Law: empty <* u                     = empty
+optimise (In Empty :<*: _)                              = In Empty
+-- Failure Weakening Law: u <* empty                    = u *> empty
+optimise (u :<*: In Empty)                              = optimise (u :*>: In Empty)
+-- Branch Absorption Law: branch empty p q              = empty
+optimise (Branch (In Empty) _ _)                        = In Empty
+-- Branch Weakening Law: branch b empty empty           = b *> empty
+optimise (Branch b (In Empty) (In Empty))               = optimise (b :*>: In Empty)
+-- Match Absorption Law: match _ empty _ def            = def
+optimise (Match (In Empty) _ _ def)                     = def
+-- Match Weakening Law: match _ p (const empty) empty   = p *> empty
+optimise (Match p _ qs (In Empty))
+  | all (\case {In Empty -> True; _ -> False}) qs = optimise (p :*>: In Empty)
+-- APPLICATIVE OPTIMISATION
+-- Identity Law: id <$> u                               = u
+optimise (ID :<$>: u)                                   = u
+-- Flip const optimisation: flip const <$> u            = u *> pure id
+optimise (FLIP_CONST :<$>: u)                           = optimise (u :*>: In (Pure ID))
+-- Homomorphism Law: pure f <*> pure x                  = pure (f x)
+optimise (f :<$>: In (Pure x))                          = In (Pure (APP_H f x))
+-- NOTE: This is basically a shortcut, it can be caught by the Composition Law and Homomorphism law
+-- Functor Composition Law: f <$> (g <$> p)             = (f . g) <$> p
+optimise (f :<$>: In (g :<$>: p))                       = optimise (COMPOSE_H f g :<$>: p)
+-- Composition Law: u <*> (v <*> w)                     = (.) <$> u <*> v <*> w
+optimise (u :<*>: In (v :<*>: w))                       = optimise (optimise (optimise (COMPOSE :<$>: u) :<*>: v) :<*>: w)
+-- Definition of *>
+optimise (In (FLIP_CONST :<$>: p) :<*>: q)              = In (p :*>: q)
+-- Definition of <*
+optimise (In (CONST :<$>: p) :<*>: q)                   = In (p :<*: q)
+-- Reassociation Law 1: (u *> v) <*> w                  = u *> (v <*> w)
+optimise (In (u :*>: v) :<*>: w)                        = optimise (u :*>: (optimise (v :<*>: w)))
+-- Interchange Law: u <*> pure x                        = pure ($ x) <*> u
+optimise (u :<*>: In (Pure x))                          = optimise (APP_H (FLIP_H ID) x :<$>: u)
+-- Right Absorption Law: (f <$> p) *> q                 = p *> q
+optimise (In (_ :<$>: p) :*>: q)                        = In (p :*>: q)
+-- Left Absorption Law: p <* (f <$> q)                  = p <* q
+optimise (p :<*: (In (_ :<$>: q)))                      = In (p :<*: q)
+-- Reassociation Law 2: u <*> (v <* w)                  = (u <*> v) <* w
+optimise (u :<*>: In (v :<*: w))                        = optimise (optimise (u :<*>: v) :<*: w)
+-- Reassociation Law 3: u <*> (v $> x)                  = (u <*> pure x) <* v
+optimise (u :<*>: In (v :$>: x))                        = optimise (optimise (u :<*>: In (Pure x)) :<*: v)
+-- ALTERNATIVE OPTIMISATION
+-- Left Catch Law: pure x <|> u                         = pure x
+optimise (p@(In (Pure _)) :<|>: _)                      = p
+-- Left Neutral Law: empty <|> u                        = u
+optimise (In Empty :<|>: u)                             = u
+-- Right Neutral Law: u <|> empty                       = u
+optimise (u :<|>: In Empty)                             = u
+-- Associativity Law: (u <|> v) <|> w                   = u <|> (v <|> w)
+optimise (In (u :<|>: v) :<|>: w)                       = In (u :<|>: optimise (v :<|>: w))
+-- SEQUENCING OPTIMISATION
+-- Identity law: pure x *> u                            = u
+optimise (In (Pure _) :*>: u)                           = u
+-- Identity law: (u $> x) *> v                          = u *> v
+optimise (In (u :$>: _) :*>: v)                         = In (u :*>: v)
+-- Associativity Law: u *> (v *> w)                     = (u *> v) *> w
+optimise (u :*>: In (v :*>: w))                         = optimise (optimise (u :*>: v) :*>: w)
+-- Identity law: u <* pure x                            = u
+optimise (u :<*: In (Pure _))                           = u
+-- Identity law: u <* (v $> x)                          = u <* v
+optimise (u :<*: In (v :$>: _))                         = optimise (u :<*: v)
+-- Commutativity Law: x <$ u                            = u $> x
+optimise (x :<$: u)                                     = optimise (u :$>: x)
+-- Associativity Law (u <* v) <* w                      = u <* (v <* w)
+optimise (In (u :<*: v) :<*: w)                         = optimise (u :<*: optimise (v :<*: w))
+-- Pure lookahead: lookAhead (pure x)                   = pure x
+optimise (LookAhead p@(In (Pure _)))                    = p
+-- Dead lookahead: lookAhead empty                      = empty
+optimise (LookAhead p@(In Empty))                       = p
+-- Pure negative-lookahead: notFollowedBy (pure x)      = empty
+optimise (NotFollowedBy (In (Pure _)))                  = In Empty
+-- Dead negative-lookahead: notFollowedBy empty         = unit
+optimise (NotFollowedBy (In Empty))                     = In (Pure UNIT)
+-- Double Negation Law: notFollowedBy . notFollowedBy   = lookAhead . try . void
+optimise (NotFollowedBy (In (NotFollowedBy p)))         = optimise (LookAhead (In (In (Try p) :*>: In (Pure UNIT))))
+-- Zero Consumption Law: notFollowedBy (try p)          = notFollowedBy p
+optimise (NotFollowedBy (In (Try p)))                   = optimise (NotFollowedBy p)
+-- Idempotence Law: lookAhead . lookAhead               = lookAhead
+optimise (LookAhead (In (LookAhead p)))                 = In (LookAhead p)
+-- Right Identity Law: notFollowedBy . lookAhead        = notFollowedBy
+optimise (NotFollowedBy (In (LookAhead p)))             = optimise (NotFollowedBy p)
+-- Left Identity Law: lookAhead . notFollowedBy         = notFollowedBy
+optimise (LookAhead (In (NotFollowedBy p)))             = In (NotFollowedBy p)
+-- Transparency Law: notFollowedBy (try p <|> q)        = notFollowedBy p *> notFollowedBy q
+optimise (NotFollowedBy (In (In (Try p) :<|>: q)))      = optimise (optimise (NotFollowedBy p) :*>: optimise (NotFollowedBy q))
+-- Distributivity Law: lookAhead p <|> lookAhead q      = lookAhead (try p <|> q)
+optimise (In (LookAhead p) :<|>: In (LookAhead q))      = optimise (LookAhead (optimise (In (Try p) :<|>: q)))
+-- Interchange Law: lookAhead (p $> x)                  = lookAhead p $> x
+optimise (LookAhead (In (p :$>: x)))                    = optimise (optimise (LookAhead p) :$>: x)
+-- Interchange law: lookAhead (f <$> p)                 = f <$> lookAhead p
+optimise (LookAhead (In (f :<$>: p)))                   = optimise (f :<$>: optimise (LookAhead p))
+-- Absorption Law: p <*> notFollowedBy q                = (p <*> unit) <* notFollowedBy q
+optimise (p :<*>: In (NotFollowedBy q))                 = optimise (optimise (p :<*>: In (Pure UNIT)) :<*: In (NotFollowedBy q))
+-- Idempotence Law: notFollowedBy (p $> x)              = notFollowedBy p
+optimise (NotFollowedBy (In (p :$>: _)))                = optimise (NotFollowedBy p)
+-- Idempotence Law: notFollowedBy (f <$> p)             = notFollowedBy p
+optimise (NotFollowedBy (In (_ :<$>: p)))               = optimise (NotFollowedBy p)
+-- Interchange Law: try (p $> x)                        = try p $> x
+optimise (Try (In (p :$>: x)))                          = optimise (optimise (Try p) :$>: x)
+-- Interchange law: try (f <$> p)                       = f <$> try p
+optimise (Try (In (f :<$>: p)))                         = optimise (f :<$>: optimise (Try p))
+-- pure Left law: branch (pure (Left x)) p q            = p <*> pure x
+optimise (Branch (In (Pure (l@(_val -> Left x)))) p _)  = optimise (p :<*>: In (Pure (makeQ x qx))) where qx = [||case $$(_code l) of Left x -> x||]
+-- pure Right law: branch (pure (Right x)) p q          = q <*> pure x
+optimise (Branch (In (Pure (r@(_val -> Right x)))) _ q) = optimise (q :<*>: In (Pure (makeQ x qx))) where qx = [||case $$(_code r) of Right x -> x||]
+-- Generalised Identity law: branch b (pure f) (pure g) = either f g <$> b
+optimise (Branch b (In (Pure f)) (In (Pure g)))         = optimise ({-([either f g])-}makeQ (either (_val f) (_val g)) [||either $$(_code f) $$(_code g)||] :<$>: b)
+-- Interchange law: branch (x *> y) p q                 = x *> branch y p q
+optimise (Branch (In (x :*>: y)) p q)                   = optimise (x :*>: optimise (Branch y p q))
+-- Negated Branch law: branch b p empty                 = branch (swapEither <$> b) empty p
+optimise (Branch b p (In Empty))                        = In (Branch (In (In (Pure (makeQ (either Right Left) [||either Right Left||])) :<*>: b)) (In Empty) p)
+-- Branch Fusion law: branch (branch b empty (pure f)) empty k                  = branch (g <$> b) empty k where g is a monad transforming (>>= f)
+optimise (Branch (In (Branch b (In Empty) (In (Pure f)))) (In Empty) k) = optimise (Branch (optimise (In (Pure (makeQ g qg)) :<*>: b)) (In Empty) k)
+  where
+    g (Left _) = Left ()
+    g (Right x) = case _val f x of
+      Left _ -> Left ()
+      Right x -> Right x
+    qg = [||\case Left _ -> Left ()
+                  Right x -> case $$(_code f) x of
+                               Left _ -> Left ()
+                               Right y -> Right y||]
+-- Distributivity Law: f <$> branch b p q                = branch b ((f .) <$> p) ((f .) <$> q)
+optimise (f :<$>: In (Branch b p q))                     = optimise (Branch b (optimise (APP_H COMPOSE f :<$>: p)) (optimise (APP_H COMPOSE f :<$>: q)))
+-- pure Match law: match vs (pure x) f def               = if elem x vs then f x else def
+optimise (Match (In (Pure x)) fs qs def)                 = foldr (\(f, q) k -> if _val f (_val x) then q else k) def (zip fs qs)
+-- TODO I'm not actually sure this one is a good optimisation? might have some size constraint on it
+-- Generalised Identity Match law: match vs p (pure . f) def = f <$> (p >?> flip elem vs) <|> def
+{-optimise (Match p fs qs def)
+  | all (\case {In (Pure _) -> True; _ -> False}) qs     = optimise (optimise (makeQ apply qapply :<$>: (p >?> (makeQ validate qvalidate))) :<|>: def)
+    where apply x    = foldr (\(f, In (Pure y)) k -> if _val f x then _val y else k) (error "whoopsie") (zip fs qs)
+          qapply     = [||\x -> $$(foldr (\(f, In (Pure y)) k -> [||if $$(_code f) x then $$(_code y) else $$k||]) ([||error "whoopsie"||]) (zip fs qs))||]
+          validate x = foldr (\f b -> _val f x || b) False fs
+          qvalidate  = [||\x -> $$(foldr (\f k -> [||$$(_code f) x || $$k||]) [||False||] fs)||]-}
+-- Distributivity Law: f <$> match vs p g def            = match vs p ((f <$>) . g) (f <$> def)
+optimise (f :<$>: (In (Match p fs qs def)))              = In (Match p fs (map (optimise . (f :<$>:)) qs) (optimise (f :<$>: def)))
+-- Trivial let-bindings - NOTE: These will get moved when Let nodes no longer have the "source" in them
+optimise (Let False _ p@(In (Pure _)))                               = p
+optimise (Let False _ p@(In Empty))                                  = p
+optimise (Let False _ p@(In (Satisfy _)))                            = p
+optimise (Let False _ p@(In (In (Satisfy _) :$>: _)))                = p
+optimise (Let False _ p@(In (GetRegister _)))                        = p
+optimise (Let False _ p@(In (In (Pure _) :<*>: In (GetRegister _)))) = p
+optimise p                                                           = In p
+
+-- try (lookAhead p *> p *> lookAhead q) = lookAhead (p *> q) <* try p
+
+{-(>?>) :: Fix Combinator a -> Defunc (a -> Bool) -> Fix Combinator a
+p >?> f = In (Branch (In (makeQ g qg :<$>: p)) (In Empty) (In (Pure ID)))
+  where
+    g x = if _val f x then Right x else Left ()
+    qg = [||\x -> if $$(_code f) x then Right x else Left ()||]-}
diff --git a/src/ghc/Parsley/Internal/Trace.hs b/src/ghc/Parsley/Internal/Trace.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Trace.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-|
+Module      : Parsley.Internal.Trace
+Description : Definition of `Trace` class for debugging internals
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : stable
+
+This module contains the defintion of the `Trace` class, used to print additional debug information
+from the internals.
+
+@since 0.1.0.0
+-}
+module Parsley.Internal.Trace (Trace, trace, traceShow) where
+
+class Trace where
+  trace :: String -> a -> a
+
+traceShow :: (Trace, Show a) => a -> a
+traceShow = show >>= trace
diff --git a/src/ghc/Parsley/Internal/Verbose.hs b/src/ghc/Parsley/Internal/Verbose.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Verbose.hs
@@ -0,0 +1,29 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-|
+Module      : Parsley.Internal.Verbose
+Description : Contains instance that enables verbose debugging output for Parsley compiler
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : stable
+
+This module contains a single orphan instance that enables debugging output on the Parsley compiler.
+This output is not useful for the user, but may potentially serve as useful additional information
+when submitting a bug report.
+
+@since 0.1.0.0
+-}
+
+module Parsley.Internal.Verbose () where
+
+import Parsley.Internal.Trace (Trace(trace))
+import qualified Debug.Trace (trace)
+
+{-|
+This instance, when in scope, will enable additional debug output from the Parsley compilation
+process. It will always superscede the default instance defined in "Parsley".
+
+@since 0.1.0.0
+-}
+instance Trace where
+  trace = Debug.Trace.trace
diff --git a/src/ghc/Parsley/Precedence.hs b/src/ghc/Parsley/Precedence.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Precedence.hs
@@ -0,0 +1,108 @@
+{-# LANGUAGE AllowAmbiguousTypes,
+             MultiParamTypeClasses #-}
+{-|
+Module      : Parsley.Precedence
+Description : The precedence parser functionality
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : stable
+
+This module exposes the required machinery for parsing expressions given by a precedence
+table. Unlike those found in [parser-combinators](https://hackage.haskell.org/package/parser-combinators-1.3.0/docs/Control-Monad-Combinators-Expr.html)
+or [parsec](https://hackage.haskell.org/package/parsec-3.1.14.0/docs/Text-Parsec-Expr.html), this
+implementation allows the precedence layers to change type in the table.
+
+@since 0.1.0.0
+-}
+module Parsley.Precedence (module Parsley.Precedence) where
+
+import Prelude hiding      ((<$>))
+import Parsley.Alternative (choice)
+import Parsley.Applicative ((<$>))
+import Parsley.Fold        (chainPre, chainPost, chainl1', chainr1')
+import Parsley.Internal    (WQ, Parser, Defunc(BLACK, ID))
+
+{-|
+This combinator will construct and expression parser will provided with a table of precedence along
+with a terminal atom.
+
+@since 0.1.0.0
+-}
+precedence :: Prec a b -> Parser a -> Parser b
+precedence NoLevel atom = atom
+precedence (Level lvl lvls) atom = precedence lvls (level lvl atom)
+  where
+    level (InfixL ops wrap) atom  = chainl1' wrap atom (choice ops)
+    level (InfixR ops wrap) atom  = chainr1' wrap atom (choice ops)
+    level (Prefix ops wrap) atom  = chainPre (choice ops) (wrap <$> atom)
+    level (Postfix ops wrap) atom = chainPost (wrap <$> atom) (choice ops)
+
+{-|
+A simplified version of `precedence` that does not use the heterogeneous list `Prec`, but
+instead requires all layers of the table to have the same type.
+
+@since 0.1.0.0
+-}
+monolith :: [Level a a] -> Prec a a
+monolith = foldr Level NoLevel
+
+{-|
+A heterogeneous list that represents a precedence table so that @Prec a b@ transforms the type @a@
+into @b@ via various layers of operators.
+
+@since 0.1.0.0
+-}
+data Prec a b where
+  NoLevel :: Prec a a
+  Level :: Level a b -> Prec b c -> Prec a c
+
+{-|
+This datatype represents levels of the precedence table `Prec`, where each constructor
+takes many parsers of the same level and fixity.
+
+@since 0.1.0.0
+-}
+data Level a b = InfixL  [Parser (b -> a -> b)] (Defunc (a -> b)) -- ^ left-associative infix operators
+               | InfixR  [Parser (a -> b -> b)] (Defunc (a -> b)) -- ^ right-associative infix operators
+               | Prefix  [Parser (b -> b)]      (Defunc (a -> b)) -- ^ prefix unary operators
+               | Postfix [Parser (b -> b)]      (Defunc (a -> b)) -- ^ postfix unary operators
+
+{-|
+This class provides a way of working with the `Level` datatype without needing to
+provide wrappers, or not providing `Defunc` arguments.
+
+@since 0.1.0.0
+-}
+class Monolith a b c where
+  -- | Used to construct a precedence level of infix left-associative operators
+  infixL  :: [Parser (b -> a -> b)] -> c
+  -- | Used to construct a precedence level of infix right-associative operators
+  infixR  :: [Parser (a -> b -> b)] -> c
+  -- | Used to construct a precedence level of prefix operators
+  prefix  :: [Parser (b -> b)]      -> c
+  -- | Used to construct a precedence level of postfix operators
+  postfix :: [Parser (b -> b)]      -> c
+
+{-|
+This instance is used to handle monolithic types where the input and output are the same,
+it does not require the wrapping function to be provided.
+
+@since 0.1.0.0
+-}
+instance x ~ a => Monolith x a (Level a a) where
+  infixL  = flip InfixL ID
+  infixR  = flip InfixR ID
+  prefix  = flip Prefix ID
+  postfix = flip Postfix ID
+
+{-|
+This instance is used to handle non-monolithic types: i.e. where the input and output types of
+a level differ.
+
+@since 0.1.0.0
+-}
+instance {-# INCOHERENT #-} x ~ (WQ (a -> b) -> Level a b) => Monolith a b x where
+  infixL  ops = InfixL ops . BLACK
+  infixR  ops = InfixR ops . BLACK
+  prefix  ops = Prefix ops . BLACK
+  postfix ops = Postfix ops . BLACK
diff --git a/src/ghc/Parsley/Register.hs b/src/ghc/Parsley/Register.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Register.hs
@@ -0,0 +1,153 @@
+{-|
+Module      : Parsley.Register
+Description : The register combinators
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : stable
+
+This module exposes combinators designed to work with /registers/. These are small pieces of state
+that are carried through the parsing process. They can be used, for example, to perform indentation
+sensitive parsing. In fact, they are a flexible replacement for the monadic combinators, in conjunction
+with the "Parsley.Selective" combinators. In particular, the `bind` combinator implements a limited form
+of the @(>>=)@ operation, where the structure of the resulting parser will still be statically
+determinable. Registers paired with "Parsley.Selective" combinators are Turing-Compete.
+
+@since 0.1.0.0
+-}
+module Parsley.Register (
+    Reg, newRegister, get, put,
+    newRegister_,
+    put_,
+    gets, gets_,
+    modify, modify_,
+    move, swap,
+    bind, local, rollback,
+    for
+  ) where
+
+import Prelude hiding      (pure, (<*>), (*>), (<*))
+import Parsley.Alternative (empty, (<|>))
+import Parsley.Applicative (pure, (<*>), (*>), (<*))
+import Parsley.Internal    (Parser, ParserOps, Reg, newRegister, get, put)
+import Parsley.Selective   (when, while)
+
+{-|
+Like `newRegister`, except the initial value of the register is seeded from a pure value as opposed
+to the result of a parser.
+
+@since 0.1.0.0
+-}
+newRegister_ :: ParserOps rep => rep a -> (forall r. Reg r a -> Parser b) -> Parser b
+newRegister_ x = newRegister (pure x)
+
+{-|
+Like `put`, except the new value of the register is a pure value as opposed to the result of a parser.
+
+@since 0.1.0.0
+-}
+put_ :: ParserOps rep => Reg r a -> rep a -> Parser ()
+put_ r = put r . pure
+
+{-|
+@gets reg p@ first parses @p@ to get as a result, function @f@. Then, taking into account any changes
+made during @p@, the value is fetched from @reg@ and applied to @f@.
+
+@since 0.1.0.0
+-}
+gets :: Reg r a -> Parser (a -> b) -> Parser b
+gets r p = p <*> get r
+
+{-|
+Like `gets`, except the adapter function is a pure argument as opposed to the result of a parser.
+
+@since 0.1.0.0
+-}
+gets_ :: ParserOps rep => Reg r a -> rep (a -> b) -> Parser b
+gets_ r = gets r . pure
+
+{-|
+@modify reg p@ first parses @p@ to collect the function @f@, then taking into account any changes
+made during @f@, the value in @reg@ is modified using the function @f@ and put back into it.
+
+@since 0.1.0.0
+-}
+modify :: Reg r a -> Parser (a -> a) -> Parser ()
+modify r p = put r (gets r p)
+
+{-|
+Like `modify`, except the modification function is a pure argument as opposed to the result of a parser.
+
+@since 0.1.0.0
+-}
+modify_ :: ParserOps rep => Reg r a -> rep (a -> a) -> Parser ()
+modify_ r = modify r . pure
+
+{-|
+@move dst src@ takes the value stored in @src@ and additionally stores it into @dst@.
+
+@since 0.1.0.0
+-}
+move :: Reg r1 a -> Reg r2 a -> Parser ()
+move dst src = put dst (get src)
+
+{-|
+This combinator uses registers to emulate a restricted form of @(`>>=`)@: in a traditional monadic
+setting, this would be considered to be the implementation:
+
+> bind p f = p >>= f . pure
+
+Essentially, the result of @p@ is available to be summoned purely as many times as needed. However,
+it cannot be used to dynamically create structure: the selective combinators can be used to provide
+that functionality partially.
+
+@since 0.1.0.0
+-}
+bind :: Parser a -> (Parser a -> Parser b) -> Parser b
+bind p f = newRegister p (f . get)
+
+{-|
+@local reg p q@ first parses @p@ and stores its value in @reg@ for the /duration/ of parsing @q@.
+If @q@ succeeds, @reg@ will be restored to its original state /before/ @p@ was parsed.
+
+@since 0.1.0.0
+-}
+local :: Reg r a -> Parser a -> Parser b -> Parser b
+local r p q = bind (get r) $ \x -> put r p
+                                *> q
+                                <* put r x
+
+{-|
+This combinator will swap the values contained in two registers.
+
+@since 0.1.0.0
+-}
+swap :: Reg r1 a -> Reg r2 a -> Parser ()
+swap r1 r2 = bind (get r1) $ \x -> move r1 r2
+                                *> put r2 x
+
+{-|
+@rollback reg p@ will perform @p@ and if it fails without consuming input, @reg@ will be restored
+to its original state from /before/ @p@ was parsed, and the combinator will fail. If @p@ succeeds
+the state in @reg@ will not be restored to an old version.
+
+@since 0.1.0.0
+-}
+rollback :: Reg r a -> Parser b -> Parser b
+rollback r p = bind (get r) $ \x -> p <|> put r x *> empty
+
+{-|
+This combinator is like a traditional imperative-style @for@-loop. Given @for init cond step body@,
+@init@ is first parsed to initialise a register called @i@; the parser @cond@ is then performed to
+check that the value in @i@ adheres to the predicate it returns; if so, then the @body@ is parsed,
+@step@ modifies the state in @i@, and then the process repeats from @cond@ again. When @cond@ returns
+@False@ for the predicate applied to @i@'s state, the loop terminates gracefully. If any component
+of this parser fails the loop will fail.
+
+@since 0.1.0.0
+-}
+for :: Parser a -> Parser (a -> Bool) -> Parser (a -> a) -> Parser () -> Parser ()
+for init cond step body =
+  newRegister init $ \i ->
+    let cond' :: Parser Bool
+        cond' = gets i cond
+    in when cond' (while (body *> modify i step *> cond'))
diff --git a/src/ghc/Parsley/Selective.hs b/src/ghc/Parsley/Selective.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Selective.hs
@@ -0,0 +1,164 @@
+{-|
+Module      : Parsley.Selective
+Description : The @Selective@ combinators
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : stable
+
+A version of the @Selective@ combinators as described in [/Selective Applicative Functors/
+(Mokhov et al. 2019)](https://dl.acm.org/doi/10.1145/3341694).
+
+Like the @Applicative@ and @Alternative@ combinators, these cannot be properly described by the
+@Selective@ typeclass, since the API relies on Template Haskell code being used by @Applicative@.
+
+@since 0.1.0.0
+-}
+module Parsley.Selective (
+    branch, select,
+    (>??>), filteredBy, (>?>),
+    predicate, (<?:>),
+    conditional, match, (||=),
+    when, while,
+    fromMaybeP
+  ) where
+
+import Prelude hiding             (pure, (<$>))
+import Data.Function              (fix)
+import Language.Haskell.TH.Syntax (Lift(..))
+import Parsley.Alternative        (empty)
+import Parsley.Applicative        (pure, (<$>), liftA2, unit, constp)
+import Parsley.Internal           (makeQ, Code, Parser, Defunc(ID, EQ_H), ParserOps, conditional, branch)
+
+{-|
+Similar to `branch`, except the given branch is only executed on a @Left@ returned.
+
+> select p q = branch p q (pure id)
+
+@since 0.1.0.0
+-}
+select :: Parser (Either a b) -> Parser (a -> b) -> Parser b
+select p q = branch p q (pure ID)
+
+-- Filter Combinators
+{-|
+This combinator is used for filtering. Given @px >??> pf@, if @px@ succeeds, then @pf@ will be
+attempted too. Then the result of @px@ is given to @pf@'s. If the function returns true then the
+parser succeeds and returns the result of @px@, otherwise it will fail.
+
+@since 0.1.0.0
+-}
+infixl 4 >??>
+(>??>) :: Parser a -> Parser (a -> Bool) -> Parser a
+px >??> pf = select (liftA2 (makeQ g qg) pf px) empty
+  where
+    g :: (a -> Bool) -> a -> Either () a
+    g f x = if f x then Right x else Left ()
+    qg :: Code ((a -> Bool) -> a -> Either () a)
+    qg = [||\f x -> if f x then Right x else Left ()||]
+
+{-|
+An alias for @(`>?>`)@.
+
+@since 0.1.0.0
+-}
+filteredBy :: ParserOps rep => Parser a -> rep (a -> Bool) -> Parser a
+filteredBy p f = p >??> pure f
+
+{-|
+This combinator is used for filtering, similar to @(`>??>`)@ except the predicate is given without
+parsing anything.
+
+> px >?> f = px >??> pure f
+
+@since 0.1.0.0
+-}
+infixl 4 >?>
+(>?>) :: ParserOps rep => Parser a -> rep (a -> Bool) -> Parser a
+(>?>) = filteredBy
+
+-- Conditional Combinators
+{-|
+Similar to an @if@ statement: @predicate f p t e@ first parses @p@ and collects its result @x@.
+If @f x@ is @True@ then @t@ is parsed, else @e@ is parsed.
+
+@since 0.1.0.0
+-}
+predicate :: ParserOps rep => rep (a -> Bool) -> Parser a -> Parser b -> Parser b -> Parser b
+predicate cond p t e = conditional [(cond, t)] p e
+
+{-|
+A \"ternary\" combinator, essentially `predicate` given the identity function.
+
+@since 0.1.0.0
+-}
+infixl 4 <?:>
+(<?:>) :: Parser Bool -> (Parser a, Parser a) -> Parser a
+cond <?:> (p, q) = predicate ID cond p q
+
+-- Match Combinators
+{-|
+The `match` combinator can be thought of as a restricted form of @(>>=)@, where there is a fixed
+domain on the valid outputs of the second argument.
+
+More concretely, @match dom p f def@ first parses @p@, and, if its result is an element of the list
+@dom@, its result is applied to the function @f@ and the resulting parser is executed. If the result
+was not in @dom@, then @def@ will be executed.
+
+Note: To eliminate the dynamic nature of the operation, every possible outcome of the parser is
+enumerated and tried in turn.
+
+@since 0.1.0.0
+-}
+match :: (Eq a, Lift a)
+      => [a]             -- ^ The domain of the function given as the third argument
+      -> Parser a        -- ^ The parser whose result will be given to the function
+      -> (a -> Parser b) -- ^ A function uses to generate the parser to execute
+      -> Parser b        -- ^ A parser to execute if the result is not in the domain of the function
+      -> Parser b
+match vs p f = conditional (map (\v -> (EQ_H (makeQ v [||v||]), f v)) vs) p
+
+{-|
+This combinator, known as @sbind@ in the literature, is best avoided for efficiency sake. It is
+built on `match`, but where the domain of the function is /all/ of the possible values of the
+datatype. This means the type must be finite, or else this combinator would never terminate.
+
+The problem with the combinator is not so much that it takes linear time to take the right branch
+(as opposed to monadic @(>>=)@) but that it generates a /massive/ amount of code when the datatype
+gets too big. For instance, using it for `Char` would generate a 66535-way case split!
+
+The role this combinator fulfils is the branching behaviour that monadic operations can provide.
+For the persistence or duplication of data that monads can provide, `Parsley.Register.bind` is a much better
+alternative.
+
+@since 0.1.0.0
+-}
+infixl 1 ||=
+(||=) :: (Enum a, Bounded a, Eq a, Lift a) => Parser a -> (a -> Parser b) -> Parser b
+p ||= f = match [minBound..maxBound] p f empty
+
+-- Composite Combinators
+{-|
+This combinator will only execute its second argument if the first one returned @True@.
+
+@since 0.1.0.0
+-}
+when :: Parser Bool -> Parser () -> Parser ()
+when p q = p <?:> (q, unit)
+
+{-|
+The fixed-point of the `when` combinator: it will continuously parse its argument until either it
+fails (in which case it fails), or until it returns @False@.
+
+@since 0.1.0.0
+-}
+while :: Parser Bool -> Parser ()
+while x = fix (when x)
+
+{-|
+Given @fromMaybeP p def@, if @p@ returns a @Nothing@ then @def@ is executed, otherwise the result
+of @p@ will be returned with the @Just@ removed.
+
+@since 0.1.0.0
+-}
+fromMaybeP :: Parser (Maybe a) -> Parser a -> Parser a
+fromMaybeP pm px = select (makeQ (maybe (Left ()) Right) [||maybe (Left ()) Right||] <$> pm) (constp px)