diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -139,3 +139,25 @@
 * Added `Typeable` constraint to `LIFTED`.
 * Removed `lamTermBool` and `userBool` from the API: `Typeable` subsumes them.
 * Added `RANGES` to the `Defunc` API.
+
+## 2.1.0.0 -- 2022-01-12
+
+* Added `RangeSet` datastructure.
+* Added `Pos` module for static manipulation of position information.
+* Added `CharPred` as a specialised defunctionalisation of `Char -> Bool` functions.
+* Moved `InputCharacteristic` to its own module.
+* Use `CharPred` for `Sat` and `Satisfy`.
+* Simplified the interface for `Ops.sat`.
+* Simplified `buildYesHandler` and allowed it to capture a statically annotated offset.
+* Introduced `buildIterYesHandler` which can capture static offet.
+* Changed types of `bindSameHandler` and `bindIterSame`.
+* Added `StaYesHandler` type to `Ops`.
+* Renamed `updatePos` to `updatePosQ`.
+* Added many methods for manipulating positions to `PosOps`.
+* Made `initPos` fully static.
+* Changed the type of `readChar`.
+* Hid some internals of `Input`.
+* Exposed some new methods for `Input`.
+* Added `INPUT` to 8.6+ backend for `Defunc`.
+* Added a `poke` method to `QueueLike`.
+* Added a `charPred` converter to `Defunc`.
diff --git a/benchmarks/BenchmarkUtils.hs b/benchmarks/BenchmarkUtils.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/BenchmarkUtils.hs
@@ -0,0 +1,7 @@
+module BenchmarkUtils where
+
+import Gauge.Main         (Benchmark, defaultMainWith)
+import Gauge.Main.Options (Config(displayMode), defaultConfig, DisplayMode(Condensed))
+
+condensedMain :: [Benchmark] -> IO ()
+condensedMain = defaultMainWith (defaultConfig {displayMode = Condensed})
diff --git a/benchmarks/RangeSetBench.hs b/benchmarks/RangeSetBench.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/RangeSetBench.hs
@@ -0,0 +1,161 @@
+{-# LANGUAGE StandaloneDeriving, DeriveAnyClass, DeriveGeneric, BangPatterns #-}
+{-# OPTIONS_GHC -ddump-simpl -ddump-to-file #-}
+module Main where
+
+import Gauge
+import BenchmarkUtils
+
+import Parsley.Internal.Common.RangeSet (RangeSet)
+import Data.Set (Set)
+import Test.QuickCheck
+
+import Control.Monad
+import Control.DeepSeq
+
+import GHC.Generics (Generic)
+
+import qualified Parsley.Internal.Common.RangeSet as RangeSet
+import qualified Data.Set as Set
+import qualified Data.List as List
+
+deriving instance (Generic a, NFData a) => NFData (RangeSet a)
+deriving instance Generic a => Generic (RangeSet a)
+deriving instance Generic Int
+deriving instance Generic Word
+deriving instance Generic Char
+
+main :: IO ()
+main = do
+  xss <- forM [1..10] $ \n -> generate (vectorOf (n * 10) (chooseInt (0, n * 20)))
+  condensedMain [
+      rangeFromList,
+      rangeMemberDeleteBench,
+      rangeUnionBench,
+      rangeDiffBench,
+      rangeIntersectBench,
+      setMemberDeleteBench,
+      fromListBench xss
+    ]
+
+rangeFromList :: Benchmark
+rangeFromList =
+  env (return (xs1, xs2, xs3, xs4)) $ \xs -> bgroup "RangeSet.fromList" [
+      bench "Pathological" $ nf RangeSet.fromList (pi4_1 xs),
+      bench "4 way split" $ nf RangeSet.fromList (pi4_2 xs),
+      bench "Small" $ nf RangeSet.fromList (pi4_3 xs),
+      bench "alphaNum" $ nf RangeSet.fromList (pi4_4 xs)
+  ]
+
+fromListBench :: [[Int]] -> Benchmark
+fromListBench xss =
+  bgroup "fromList" (map (makeBench (show . length)
+                                    [ ("Set", nf Set.fromList)
+                                    , ("RangeSet", nf RangeSet.fromList)
+                                    ]) xss)
+
+pi4_1 :: (a, b, c, d) -> a
+pi4_1 (x, _, _, _) = x
+
+pi4_2 :: (a, b, c, d) -> b
+pi4_2 (_, x, _, _) = x
+
+pi4_3 :: (a, b, c, d) -> c
+pi4_3 (_, _, x, _) = x
+
+pi4_4 :: (a, b, c, d) -> d
+pi4_4 (_, _, _, x) = x
+
+xs1, xs2, xs3 :: [Word]
+xs1 = [0,2..2048]
+xs2 = List.delete 1536 (List.delete 512 (List.delete 1024 [0..2048]))
+xs3 = [1, 2, 3, 5, 6, 7, 8, 11, 12, 13, 14, 16, 17, 18, 19, 20, 21, 22, 23, 25]
+xs4 = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ['_']
+
+ys1 = [0..2048]
+ys2 = [0..27]
+ys3 = ['\x00'..'\xff']
+
+rangeMemberDeleteBench :: Benchmark
+rangeMemberDeleteBench =
+  env (return (RangeSet.fromList xs1,
+               RangeSet.fromList xs2,
+               RangeSet.fromList xs3,
+               RangeSet.fromList xs4)) $ \t ->
+    bgroup "RangeSet" [
+      bgroup "member" [
+        bench "Pathological" $ nf (f ys1) (pi4_1 t),
+        bench "4 way split" $ nf (f ys1) (pi4_2 t),
+        bench "Small" $ nf (f ys2) (pi4_3 t),
+        bench "alphaNum" $ nf (f ys3) (pi4_4 t)
+      ],
+      bgroup "delete" [
+        bench "Pathological" $ nf (g ys1) (pi4_1 t),
+        bench "4 way split" $ nf (g ys1) (pi4_2 t),
+        bench "Small" $ nf (g ys2) (pi4_3 t),
+        bench "alphaNum" $ nf (g ys3) (pi4_4 t)
+      ]
+    ]
+  where
+    f ys t = List.foldl' (\ !_ y -> RangeSet.member y t) False ys
+    g ys t = List.foldl' (\ !t y -> RangeSet.delete y t) t ys
+
+setMemberDeleteBench :: Benchmark
+setMemberDeleteBench =
+  env (return (Set.fromList xs1,
+               Set.fromList xs2,
+               Set.fromList xs3,
+               Set.fromList xs4)) $ \t ->
+    bgroup "Set" [
+            bgroup "member" [
+        bench "Pathological" $ nf (f ys1) (pi4_1 t),
+        bench "4 way split" $ nf (f ys1) (pi4_2 t),
+        bench "Small" $ nf (f ys2) (pi4_3 t),
+        bench "alphaNum" $ nf (f ys3) (pi4_4 t)
+      ],
+      bgroup "delete" [
+        bench "Pathological" $ nf (g ys1) (pi4_1 t),
+        bench "4 way split" $ nf (g ys1) (pi4_2 t),
+        bench "Small" $ nf (g ys2) (pi4_3 t),
+        bench "alphaNum" $ nf (g ys3) (pi4_4 t)
+      ]
+    ]
+  where
+    f ys t = List.foldl' (\ !_ y -> Set.member y t) False ys
+    g ys t = List.foldl' (\ !t y -> Set.delete y t) t ys
+
+zs1, zs2, zs3, zs4 :: RangeSet Word
+zs1 = RangeSet.fromRanges [(0, 50), (100, 150), (200, 250), (300, 350), (400, 450), (475, 500)]
+zs2 = RangeSet.fromRanges [(25, 75), (125, 175), (225, 275), (325, 375), (425, 475), (485, 500)]
+zs3 = RangeSet.fromRanges [(51, 99), (151, 199), (251, 299), (351, 399), (451, 474)]
+zs4 = RangeSet.fromRanges [(0, 125), (140, 222), (230, 240), (310, 351), (373, 381), (462, 491)]
+
+rangeUnionBench :: Benchmark
+rangeUnionBench =
+  env (return (zs1, zs2, zs3, zs4)) $ \t -> bgroup "union" [
+      bench "same" $ nf (RangeSet.union (pi4_1 t)) (pi4_1 t),
+      bench "overlaps" $ nf (RangeSet.union (pi4_1 t)) (pi4_2 t),
+      bench "disjoint" $ nf (RangeSet.union (pi4_1 t)) (pi4_3 t),
+      bench "messy" $ nf (RangeSet.union (pi4_1 t)) (pi4_4 t)
+  ]
+
+rangeDiffBench :: Benchmark
+rangeDiffBench =
+  env (return (zs1, zs2, zs3, zs4)) $ \t -> bgroup "difference" [
+      bench "same" $ nf (RangeSet.difference (pi4_1 t)) (pi4_1 t),
+      bench "overlaps" $ nf (RangeSet.difference (pi4_1 t)) (pi4_2 t),
+      bench "disjoint" $ nf (RangeSet.difference (pi4_1 t)) (pi4_3 t),
+      bench "messy" $ nf (RangeSet.difference (pi4_1 t)) (pi4_4 t)
+  ]
+
+rangeIntersectBench :: Benchmark
+rangeIntersectBench =
+  env (return (zs1, zs2, zs3, zs4)) $ \t -> bgroup "intersection" [
+      bench "same" $ nf (RangeSet.intersection (pi4_1 t)) (pi4_1 t),
+      bench "overlaps" $ nf (RangeSet.intersection (pi4_1 t)) (pi4_2 t),
+      bench "disjoint" $ nf (RangeSet.intersection (pi4_1 t)) (pi4_3 t),
+      bench "messy" $ nf (RangeSet.intersection (pi4_1 t)) (pi4_4 t)
+  ]
+
+makeBench :: NFData a => (a -> String) -> [(String, a -> Benchmarkable)] -> a -> Benchmark
+makeBench caseName cases x = env (return x) (\x ->
+  bgroup (caseName x) (map (\(name, gen) -> bench name $ gen x) cases))
diff --git a/parsley-core.cabal b/parsley-core.cabal
--- a/parsley-core.cabal
+++ b/parsley-core.cabal
@@ -5,7 +5,7 @@
 --                   | +------- breaking internal API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             2.0.0.0
+version:             2.1.0.0
 synopsis:            A fast parser combinator library backed by Typed Template Haskell
 description:         This package contains the internals of the @parsley@ package.
                      .
@@ -45,6 +45,7 @@
                        Parsley.Internal.Common.Fresh,
                        Parsley.Internal.Common.Indexed,
                        Parsley.Internal.Common.QueueLike,
+                       Parsley.Internal.Common.RangeSet,
                        Parsley.Internal.Common.State,
                        Parsley.Internal.Common.Utils,
                        Parsley.Internal.Common.Vec,
@@ -57,6 +58,7 @@
 
                        Parsley.Internal.Core,
                        Parsley.Internal.Core.CombinatorAST,
+                       Parsley.Internal.Core.CharPred,
                        Parsley.Internal.Core.Defunc,
                        Parsley.Internal.Core.Identifiers,
                        Parsley.Internal.Core.InputTypes,
@@ -96,6 +98,7 @@
 
                        Parsley.Internal.Backend.Machine.Types,
                        Parsley.Internal.Backend.Machine.Types.Coins,
+                       Parsley.Internal.Backend.Machine.Types.InputCharacteristic,
                        Parsley.Internal.Backend.Machine.Types.State
 
   if impl(ghc >= 8.10)
@@ -108,8 +111,8 @@
                        Parsley.Internal.Backend.Machine.Types.Input,
                        Parsley.Internal.Backend.Machine.Types.Statics,
 
-                       Parsley.Internal.Backend.Machine.Types.Input.Offset
-                       --Parsley.Internal.Backend.Machine.Types.Input.Pos
+                       Parsley.Internal.Backend.Machine.Types.Input.Offset,
+                       Parsley.Internal.Backend.Machine.Types.Input.Pos
 
   default-extensions:  BangPatterns
                        DataKinds
@@ -187,7 +190,7 @@
   type:                exitcode-stdio-1.0
   build-depends:       tasty-hunit, tasty-quickcheck
   main-is:             CommonTest.hs
-  other-modules:       CommonTest.Queue, CommonTest.RewindQueue
+  other-modules:       CommonTest.Queue, CommonTest.RewindQueue, CommonTest.RangeSet
 
 test-suite regression-test
   import:              test-common
@@ -195,6 +198,22 @@
   build-depends:       tasty-hunit, tasty-quickcheck, containers
   main-is:             RegressionTest.hs
   other-modules:       Regression.Issue27
+
+common benchmark-common
+  build-depends:       base >=4.10 && <5,
+                       parsley-core,
+                       gauge,
+                       deepseq
+  hs-source-dirs:      benchmarks
+  other-modules:       BenchmarkUtils
+  default-language:    Haskell2010
+
+benchmark rangeset-bench
+  import:              benchmark-common
+  type:                exitcode-stdio-1.0
+  build-depends:       containers,
+                       QuickCheck
+  main-is:             RangeSetBench.hs
 
 source-repository head
   type:                git
diff --git a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Defunc.hs b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Defunc.hs
--- a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Defunc.hs
+++ b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Defunc.hs
@@ -99,9 +99,9 @@
 @since 1.0.0.0
 -}
 genDefunc :: Defunc a -> Code a
-genDefunc (LAM x)    = normaliseGen x
-genDefunc BOTTOM      = [||undefined||]
-genDefunc (INPUT _)  = error "Cannot materialise an input in the regular way"
+genDefunc (LAM x) = normaliseGen x
+genDefunc BOTTOM  = [||undefined||]
+genDefunc INPUT{} = error "Cannot materialise an input in the regular way"
 
 {-|
 Pattern that normalises a `Lam` before returning it.
diff --git a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Eval.hs b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Eval.hs
--- a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Eval.hs
+++ b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Eval.hs
@@ -24,7 +24,7 @@
 import Control.Monad                                       (forM, liftM2, liftM3, when)
 import Control.Monad.Reader                                (ask, asks, reader, local)
 import Control.Monad.ST                                    (runST)
-import Parsley.Internal.Backend.Machine.Defunc             (Defunc(INPUT), pattern FREEVAR, genDefunc, ap, ap2, _if)
+import Parsley.Internal.Backend.Machine.Defunc             (Defunc(INPUT, LAM), pattern FREEVAR, genDefunc, ap, ap2, _if)
 import Parsley.Internal.Backend.Machine.Identifiers        (MVar(..), ΦVar, ΣVar)
 import Parsley.Internal.Backend.Machine.InputOps           (InputDependant, InputOps(InputOps))
 import Parsley.Internal.Backend.Machine.InputRep           (Rep)
@@ -33,13 +33,13 @@
 import Parsley.Internal.Backend.Machine.LetRecBuilder      (letRec)
 import Parsley.Internal.Backend.Machine.Ops
 import Parsley.Internal.Backend.Machine.Types              (MachineMonad, Machine(..), run)
-import Parsley.Internal.Backend.Machine.PosOps             (initPos, extractCol, extractLine)
+import Parsley.Internal.Backend.Machine.PosOps             (initPos)
 import Parsley.Internal.Backend.Machine.Types.Context
 import Parsley.Internal.Backend.Machine.Types.Coins        (willConsume, int)
-import Parsley.Internal.Backend.Machine.Types.Input        (Input(Input, off, pos))
-import Parsley.Internal.Backend.Machine.Types.Input.Offset (mkOffset)
+import Parsley.Internal.Backend.Machine.Types.Input        (Input(off), mkInput, forcePos, updatePos)
 import Parsley.Internal.Backend.Machine.Types.State        (Γ(..), OpStack(..))
 import Parsley.Internal.Common                             (Fix4, cata4, One, Code, Vec(..), Nat(..))
+import Parsley.Internal.Core.CharPred                      (CharPred, lamTerm, optimisePredGiven)
 import Parsley.Internal.Trace                              (Trace(trace))
 import System.Console.Pretty                               (color, Color(Green))
 
@@ -61,7 +61,7 @@
         in letRec fs
              nameLet
              (\μ exp rs names -> buildRec μ rs (emptyCtx names) (readyMachine exp))
-             (run (readyMachine (body binding)) (Γ Empty halt (Input (mkOffset [||offset||] 0) initPos) (VCons fatal VNil)) . nextUnique . emptyCtx))
+             (run (readyMachine (body binding)) (Γ Empty halt (mkInput [||offset||] initPos) (VCons fatal VNil)) . nextUnique . emptyCtx))
   ||]
   where
     nameLet :: MVar x -> String
@@ -116,7 +116,7 @@
 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 (Rep o), Trace) => Defunc (Char -> Bool) -> Machine s o (Char : xs) (Succ n) r a -> MachineMonad s o xs (Succ n) r a
+evalSat :: forall s o xs n r a. (?ops :: InputOps (Rep o), PositionOps (Rep o), Trace) => CharPred -> Machine s o (Char : xs) (Succ n) r a -> MachineMonad s o xs (Succ n) r a
 evalSat p k@(Machine k') = do
   bankrupt <- asks isBankrupt
   hasChange <- asks hasCoin
@@ -127,23 +127,19 @@
           do check <- asks (emitCheckAndFetch . coins)
              check (Machine (local spendCoin k'))
   where
-    satFetch :: (?ops :: InputOps (Rep o))
-             => Machine s o (Char : xs) (Succ n) r a
-             -> MachineMonad s o xs (Succ n) r a
+    satFetch :: Machine s o (Char : xs) (Succ n) r a -> MachineMonad s o xs (Succ n) r a
     satFetch mk = reader $ \ctx γ ->
-      sat (ap p) (readChar ctx (fetch (input γ)))
-                 (continue mk γ)
-                 (raise γ)
+      readChar ctx p (fetch (input γ)) $ \c staOldPred staPosPred input' ctx' ->
+        let staPredC' = optimisePredGiven p staOldPred
+        in sat (ap (LAM (lamTerm staPredC'))) c (continue mk γ (updatePos input' c staPosPred) ctx')
+                                                (raise γ)
 
-    emitCheckAndFetch :: (?ops :: InputOps (Rep o), PositionOps (Rep o))
-                      => Int
-                      -> Machine s o (Char : xs) (Succ n) r a
-                      -> MachineMonad s o xs (Succ n) r a
+    emitCheckAndFetch :: Int -> Machine s o (Char : xs) (Succ n) r a -> MachineMonad s o xs (Succ n) r a
     emitCheckAndFetch n mk = do
       sat <- satFetch mk
       return $ \γ -> emitLengthCheck n (sat γ) (raise γ) (off (input γ))
 
-    continue mk γ c input' = run mk (γ {input = input', operands = Op c (operands γ)})
+    continue mk γ input' ctx v = run mk (γ {input = input', operands = Op v (operands γ)}) ctx
 
 evalEmpt :: MachineMonad s o xs (Succ n) r a
 evalEmpt = return $! raise
@@ -156,7 +152,7 @@
   Always gh (Machine h) ->
     liftM2 (\mk mh γ -> bindAlwaysHandler γ gh (buildHandler γ mh u) mk) k h
   Same gyes (Machine yes) gno (Machine no) ->
-    liftM3 (\mk myes mno γ -> bindSameHandler γ gyes (buildYesHandler γ myes u) gno (buildHandler γ mno u) mk) k yes no
+    liftM3 (\mk myes mno γ -> bindSameHandler γ gyes (buildYesHandler γ myes{- u-}) gno (buildHandler γ mno u) mk) k yes no
 
 evalTell :: Machine s o (o : xs) n r a -> MachineMonad s o xs n r a
 evalTell (Machine k) = k <&> \mk γ -> mk (γ {operands = Op (INPUT (input γ)) (operands γ)})
@@ -189,7 +185,7 @@
         Always gh (Machine h) ->
           liftM2 (\mh ctx γ -> bindIterAlways ctx μ l gh (buildHandler γ mh u1) (input γ) u2) h ask
         Same gyes (Machine yes) gno (Machine no) ->
-          liftM3 (\myes mno ctx γ -> bindIterSame ctx μ l gyes (buildYesHandler γ myes u1) gno (buildHandler γ mno u1) (input γ) u2) yes no ask
+          liftM3 (\myes mno ctx γ -> bindIterSame ctx μ l gyes (buildIterYesHandler γ myes u1) gno (buildHandler γ mno u1) (input γ) u2) yes no ask
 
 evalJoin :: ΦVar x -> MachineMonad s o (x : xs) n r a
 evalJoin φ = askΦ φ <&> resume
@@ -218,10 +214,9 @@
   let Op x xs = operands γ
   in writeΣ σ a x (run k (γ {operands = xs})) ctx
 
--- TODO: FREEVAR is the wrong abstraction really...
 evalSelectPos :: PosSelector -> Machine s o (Int : xs) n r a -> MachineMonad s o xs n r a
-evalSelectPos Line (Machine k) = k <&> \m γ -> m (γ {operands = Op (FREEVAR (extractLine (pos (input γ)))) (operands γ)})
-evalSelectPos Col (Machine k) = k <&> \m γ -> m (γ {operands = Op (FREEVAR (extractCol (pos (input γ)))) (operands γ)})
+evalSelectPos sel (Machine k) = k <&> \m γ -> forcePos (input γ) sel $ \component input' ->
+  m (γ {operands = Op (FREEVAR component) (operands γ), input = input'})
 
 evalLogEnter :: (?ops :: InputOps (Rep o), LogHandler o, HandlerOps o)
              => String -> Machine s o xs (Succ (Succ n)) r a -> MachineMonad s o xs (Succ n) r a
diff --git a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/InputOps.hs b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/InputOps.hs
--- a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/InputOps.hs
+++ b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/InputOps.hs
@@ -157,7 +157,7 @@
 
 instance InputPrep (UArray Int Char) where
   prepare qinput = [||
-      let UArray _ _ (I# size#) input# = $$qinput
+      let !(UArray _ _ (I# size#) input#) = $$qinput
           next i# = (# C# (indexWideCharArray# input# i#), i# +# 1# #)
       in (# next, \qi -> $$(intLess [||qi||] [||size#||]), 0# #)
     ||]
diff --git a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Ops.hs b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Ops.hs
--- a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Ops.hs
+++ b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Ops.hs
@@ -34,7 +34,7 @@
     -- *** Basic handlers and operations
     fatal, raise,
     -- *** Handler preparation
-    buildHandler, buildYesHandler,
+    buildHandler, buildYesHandler, buildIterYesHandler,
     -- *** Handler binding
     bindAlwaysHandler, bindSameHandler,
     -- ** Continuation Operations
@@ -55,38 +55,38 @@
     -- ** Log Operations
     logHandler, preludeString,
     -- ** Convenience Types
-    Ops, LogHandler, StaHandlerBuilder,
+    Ops, LogHandler, StaHandlerBuilder, StaYesHandler,
     -- * Re-exports from "Parsley.Internal.Backend.Machine.InputOps"
     HandlerOps, JoinBuilder, RecBuilder, PositionOps, MarshalOps, LogOps
   ) where
 
-import Control.Monad                                   (liftM2)
-import Control.Monad.Reader                            (ask, local)
-import Control.Monad.ST                                (ST)
-import Data.STRef                                      (writeSTRef, readSTRef, newSTRef)
-import Data.Void                                       (Void)
-import Debug.Trace                                     (trace)
-import GHC.Exts                                        (Int(..), (-#))
-import Language.Haskell.TH.Syntax                      (liftTyped)
+import Control.Monad                                              (liftM2)
+import Control.Monad.Reader                                       (ask, local)
+import Control.Monad.ST                                           (ST)
+import Data.STRef                                                 (writeSTRef, readSTRef, newSTRef)
+import Data.Void                                                  (Void)
+import Debug.Trace                                                (trace)
+import GHC.Exts                                                   (Int(..), (-#))
+import Language.Haskell.TH.Syntax                                 (liftTyped)
 import Parsley.Internal.Backend.Machine.BindingOps
-import Parsley.Internal.Backend.Machine.Defunc         (Defunc(INPUT), genDefunc, _if, pattern FREEVAR)
-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)
-import Parsley.Internal.Backend.Machine.Instructions   (Access(..))
-import Parsley.Internal.Backend.Machine.LetBindings    (Regs(..), Metadata(failureInputCharacteristic, successInputCharacteristic), InputCharacteristic(..))
-import Parsley.Internal.Backend.Machine.PosOps         (updatePos)
-import Parsley.Internal.Backend.Machine.THUtils        (eta)
-import Parsley.Internal.Backend.Machine.Types          (MachineMonad, Machine(..), run)
+import Parsley.Internal.Backend.Machine.Defunc                    (Defunc(INPUT), genDefunc, _if, pattern FREEVAR)
+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)
+import Parsley.Internal.Backend.Machine.Instructions              (Access(..))
+import Parsley.Internal.Backend.Machine.LetBindings               (Regs(..), Metadata(failureInputCharacteristic, successInputCharacteristic))
+import Parsley.Internal.Backend.Machine.THUtils                   (eta)
+import Parsley.Internal.Backend.Machine.Types                     (MachineMonad, Machine(..), run)
 import Parsley.Internal.Backend.Machine.Types.Context
-import Parsley.Internal.Backend.Machine.Types.Dynamics (DynFunc, DynCont, DynHandler)
-import Parsley.Internal.Backend.Machine.Types.Input    (Input(..), Input#(..), toInput, fromInput)
-import Parsley.Internal.Backend.Machine.Types.State    (Γ(..), OpStack(..))
+import Parsley.Internal.Backend.Machine.Types.Dynamics            (DynFunc, DynCont, DynHandler)
+import Parsley.Internal.Backend.Machine.Types.Input               (Input(..), Input#(..), toInput, fromInput, consume, chooseInput)
+import Parsley.Internal.Backend.Machine.Types.InputCharacteristic (InputCharacteristic)
+import Parsley.Internal.Backend.Machine.Types.State               (Γ(..), OpStack(..))
 import Parsley.Internal.Backend.Machine.Types.Statics
-import Parsley.Internal.Common                         (One, Code, Vec(..), Nat(..))
-import System.Console.Pretty                           (color, Color(Green, White, Red, Blue))
+import Parsley.Internal.Common                                    (One, Code, Vec(..), Nat(..))
+import System.Console.Pretty                                      (color, Color(Green, White, Red, Blue))
 
-import Parsley.Internal.Backend.Machine.Types.Input.Offset as Offset (Offset(..), moveOne, moveN)
+import Parsley.Internal.Backend.Machine.Types.Input.Offset as Offset (Offset(..))
 
 {- General Operations -}
 {-|
@@ -118,14 +118,14 @@
 from the input within @γ@, executing the failure code if it does not
 exist or does not match.
 
-@since 1.8.0.0
+@since 2.1.0.0
 -}
 sat :: (Defunc Char -> Defunc Bool)                        -- ^ Predicate to test the character with.
-    -> ((Code Char -> Input o -> aux -> Code b) -> Code b) -- ^ The source of the character
-    -> (Defunc Char -> Input o -> aux -> Code b)           -- ^ Code to execute on success.
+    -> Code Char                                           -- ^ The character to test against.
+    -> (Defunc Char -> Code b)                             -- ^ Code to execute on success.
     -> Code b                                              -- ^ Code to execute on failure.
     -> Code b
-sat p src good bad = src $ \c input' aux -> let v = FREEVAR c in _if (p v) (good v input' aux) bad
+sat p c good bad = let v = FREEVAR c in _if (p v) (good v) bad
 
 {-|
 Consumes the next character and adjusts the offset to match.
@@ -134,9 +134,8 @@
 -}
 fetch :: (?ops :: InputOps (Rep o))
       => Input o -> (Code Char -> Input o -> Code b) -> Code b
-fetch input k = next (offset (off input)) $ \c offset' ->
-  k c (input {off = moveOne (off input) offset',
-              pos = updatePos (pos input) c})
+fetch input k = next (offset (off input)) $ \c offset' -> k c (consume offset' input)
+
 {-|
 Emits a length check for a number of characters \(n\) in the most efficient
 way it can. It takes two continuations a @good@ and a @bad@: the @good@ is used
@@ -238,14 +237,26 @@
 the handler /always/ knows that the inputs are equal, so does not require
 both a captured and a current offset. Otherwise, is similar to `buildHandler`.
 
-@since 1.4.0.0
+@since 2.1.0.0
 -}
 buildYesHandler :: Γ s o xs n r a
                 -> (Γ s o xs n r a -> Code (ST s (Maybe a)))
-                -> Word
-                -> StaHandler s o a
-buildYesHandler γ h u = fromStaHandler# $ \inp -> h (γ {input = toInput u inp})
+                -> StaYesHandler s o a
+buildYesHandler γ h inp = h (γ {input = inp})
 
+{-|
+Converts a partially evaluated parser into a "yes" handler: this means that
+the handler /always/ knows that the inputs are equal, so does not require
+both a captured and a current offset. Otherwise, is similar to `buildHandler`.
+
+@since 2.1.0.0
+-}
+buildIterYesHandler :: Γ s o xs n r a
+                    -> (Γ s o xs n r a -> Code (ST s (Maybe a)))
+                    -> Word
+                    -> StaHandler s o a
+buildIterYesHandler γ h u = fromStaHandler# (buildYesHandler γ h . toInput u)
+
 -- Handler binding
 {-|
 Wraps around `bindHandler#` to create a binding for "always" handlers, which always
@@ -269,18 +280,18 @@
 for the case where they are the same, the case where they differ, and the case
 where they are unknown (which is defined in terms of the previous two).
 
-@since 1.4.0.0
+@since 2.1.0.0
 -}
 bindSameHandler :: forall s o xs n r a b. (HandlerOps o, PositionOps (Rep o))
                 => Γ s o xs n r a                    -- ^ The state from which to capture the offset.
                 -> Bool                              -- ^ Is a binding required for the matching handler?
-                -> StaHandler s o a                  -- ^ The handler that handles matching input.
+                -> StaYesHandler s o a               -- ^ The handler that handles matching input.
                 -> Bool                              -- ^ Is a binding required for the mismatched handler?
                 -> StaHandlerBuilder s o a           -- ^ The handler that handles mismatched input.
                 -> (Γ s o xs (Succ n) r a -> Code b) -- ^ The parser to receive the composite handler.
                 -> Code b
 bindSameHandler γ yesNeeded yes noNeeded no k =
-  bindYesInline# yesNeeded (staHandler# yes (fromInput (input γ))) $ \qyes ->
+  bindYesInline# yesNeeded (yes (input γ)) $ \qyes ->
     bindHandlerInline# noNeeded (staHandler# (no (input γ))) $ \qno ->
       let handler inp = [||if $$(same (offset (off (input γ))) (off# inp)) then $$qyes else $$(staHandler# qno inp)||]
       in bindHandlerInline# @o True handler $ \qhandler ->
@@ -357,19 +368,11 @@
        -> (Γ s o (x : xs) (Succ n) r a -> Code (ST s (Maybe a))) -- ^ The return continuation to generate
        -> Γ s o xs (Succ n) r a                                  --
        -> Code (ST s (Maybe a))
-callCC u sub k γ = callWithContinuation sub (suspend k γ (chooseOffset (successInputCharacteristic (meta sub)))) inp (handlers γ)
+callCC u sub k γ = callWithContinuation sub (suspend k γ (chooseInput (successInputCharacteristic (meta sub)) u inp)) inp (handlers γ)
   where
     inp :: Input o
     inp = input γ
 
-    -- TODO: move to Offset module (along with Input#?)
-    chooseOffset :: InputCharacteristic -> Input# o -> Input o
-    chooseOffset (AlwaysConsumes n) inp#  = inp { off = moveN n (off inp) (off# inp#), pos = pos# inp# }
-    -- Technically, in this case, we know the whole input is unchanged. This essentially ignores the continuation arguments
-    -- hopefully GHC could optimise this better?
-    chooseOffset NeverConsumes      _inp# = inp -- { off = (off inp) {offset = off# inp# }, pos = pos# inp# }
-    chooseOffset MayConsume         inp#  = toInput u inp#
-
 {- Join Point Operations -}
 {-|
 Wraps around `setupJoinPoint#` to make a join point and register it
@@ -418,7 +421,7 @@
 Similar to `bindIterAlways`, but builds a handler that performs in
 the same way as `bindSameHandler`.
 
-@since 1.8.0.0
+@since 2.1.0.0
 -}
 bindIterSame :: forall s o a. (RecBuilder o, HandlerOps o, PositionOps (Rep o))
              => Ctx s o a                  -- ^ The context to store the binding in.
@@ -428,7 +431,7 @@
              -> StaHandler s o a           -- ^ The handler when input is the same.
              -> Bool                       -- ^ Is a binding required for the differing handler?
              -> StaHandlerBuilder s o a    -- ^ The handler when input differs.
-             -> Input o                   -- ^ The initial offset of the loop.
+             -> Input o                    -- ^ The initial offset of the loop.
              -> Word                       -- ^ The unique name of the captured offsets /and/ the iteration offset.
              -> Code (ST s (Maybe a))
 bindIterSame ctx μ l neededYes yes neededNo no inp u =
@@ -577,3 +580,10 @@
 @since 1.2.0.0
 -}
 type StaHandlerBuilder s o a = Input o -> StaHandler s o a
+
+{-|
+A "yes-handler" that has not yet captured its offset
+
+@since 2.1.0.0
+-}
+type StaYesHandler s o a = Input o -> Code (ST s (Maybe a))
diff --git a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/PosOps.hs b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/PosOps.hs
--- a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/PosOps.hs
+++ b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/PosOps.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP, MagicHash, UnboxedTuples, NumericUnderscores #-}
+{-# OPTIONS_GHC -Wno-overflowed-literals #-}
 {-|
 Module      : Parsley.Internal.Backend.Machine.PosOps
 Description : Collection of platform dependent position operations
@@ -11,49 +12,165 @@
 
 @since 1.8.0.0
 -}
-module Parsley.Internal.Backend.Machine.PosOps (module Parsley.Internal.Backend.Machine.PosOps) where
+module Parsley.Internal.Backend.Machine.PosOps (
+    initPos, tabWidth,
+    extractLine, extractCol,
+    liftPos,
+    updatePos, updatePosQ,
+    updatePosNewlineOnly, updatePosNewlineOnlyQ,
+    shiftLineAndSetCol, shiftCol, shiftAlignAndShiftCol,
+    shiftLineAndSetColQ, shiftColQ, shiftAlignAndShiftColQ,
+    toNextTab
+  ) where
 
 #include "MachDeps.h"
 #if WORD_SIZE_IN_BITS < 64
 #define FULL_WIDTH_POSITIONS
 #endif
 
+import Data.Bits                                   ( (.&.), (.|.)
+#ifndef FULL_WIDTH_POSITIONS
+                                                   , unsafeShiftL
+#endif
+                                                   )
 import Parsley.Internal.Backend.Machine.Types.Base (Pos)
 import Parsley.Internal.Common                     (Code)
-import GHC.Exts                                    (Int(..))
-import GHC.Prim                                    (plusWord#, and#, or#, word2Int#,
+import GHC.Exts                                    (Int(..), Word(W#))
+import GHC.Prim                                    ( plusWord#, and#, or#, word2Int#
 #ifdef FULL_WIDTH_POSITIONS
-                                                    minusWord#
+                                                   , minusWord#
 #else
-                                                    uncheckedShiftRL#
+                                                   , uncheckedShiftRL#
 #endif
                                                    )
 
 {-|
-Given a position and a character, returns the representation of the updated position.
+Advances a column to the next tab column.
 
-@since 1.8.0.0
+@since 2.1.0.0
 -}
-updatePos :: Code Pos -> Code Char -> Code Pos
-updatePos pos c = [||updatePos# $$pos $$c||]
+toNextTab :: Word -> Word
+toNextTab x = (x + tabWidth - 1) .&. negate tabWidth .|. 1
 
 {-|
+Given a dynamic character and a static position, produces a new dynamic position.
+
+@since 2.1.0.0
+-}
+updatePos :: Code Char -> Word -> Word -> Code Pos
+updatePos c line col = [||updatePos# $$(liftPos line col) $$c||]
+
+{-|
+Given a dynamic character and a static position, produces a new dynamic position.
+For this variant, newlines are the only character than can affect the update.
+
+@since 2.1.0.0
+-}
+updatePosNewlineOnly :: Code Char -> Word -> Code Pos
+updatePosNewlineOnly c line = [||updatePos0ColNewlineOnly# $$(liftPos line 0) $$c||]
+
+{-|
+Given a dynamic character and a dynamic position, returns the representation of the updated position.
+
+@since 2.1.0.0
+-}
+updatePosQ :: Code Char -> Code Pos -> Code Pos
+updatePosQ c pos = [||updatePos# $$pos $$c||]
+
+{-|
+Given a dynamic character and a dynamic position, returns the representation of the updated position.
+For this variant, newlines are the only character than can affect the update.
+
+@since 2.1.0.0
+-}
+updatePosNewlineOnlyQ :: Code Char -> Code Pos -> Code Pos
+updatePosNewlineOnlyQ c pos = [||updatePosNewlineOnly# $$pos $$c||]
+
+{-|
+Shift a static postion's column by a given amount
+
+@since 2.1.0.0
+-}
+shiftCol :: Word -- ^ The amount to shift the column by
+         -> Word -- ^ The line
+         -> Word -- ^ The column
+         -> (Word, Word)
+shiftCol n line col = (line, col + n)
+
+{-|
+Shift a static line by a given amount and then set the column
+
+@since 2.1.0.0
+-}
+shiftLineAndSetCol :: Word -- ^ The amount to shift the line by
+                   -> Word -- ^ The new column
+                   -> Word -- ^ The line
+                   -> (Word, Word)
+shiftLineAndSetCol n col line = (line + n, col)
+
+{-|
+Shift a static position by first adjusting the column, then aligning to a tab, then shifting further
+
+@since 2.1.0.0
+-}
+shiftAlignAndShiftCol :: Word -- ^ Amount to shift column by before the tab shift
+                      -> Word -- ^ Amount to shift column by after the tab shift
+                      -> Word -- ^ The line
+                      -> Word -- ^ The new column
+                      -> (Word, Word)
+shiftAlignAndShiftCol firstBy thenBy line col = (line, toNextTab (col + firstBy) + thenBy)
+
+{-|
 The initial position used by the parser. This is some representation of (1, 1).
 
 @since 1.8.0.0
 -}
-initPos :: Code Pos
+initPos :: (Word, Word)
+initPos = (1, 1)
 
-{-# INLINEABLE updatePos# #-}
 {-|
-Updates a given position assuming the given character was read. Tab characters are aligned to the
-nearest 4th space boundary.
+The size of a tab.
 
-@since 1.8.0.0
+@since 2.1.0.0
 -}
+tabWidth :: Num a => a
+tabWidth = 4
+
+{-# INLINEABLE updatePos# #-}
 updatePos# :: Pos -> Char -> Pos
+{-# INLINE updatePosNewlineOnly# #-}
+updatePosNewlineOnly# :: Pos -> Char -> Pos
+{-# INLINEABLE updatePos0ColNewlineOnly# #-}
+updatePos0ColNewlineOnly# :: Pos -> Char -> Pos
 
 {-|
+Shift a dynamic postion's column by a given amount
+
+@since 2.1.0.0
+-}
+shiftColQ :: Word -- ^ The amount to shift the column by
+          -> Code Pos
+          -> Code Pos
+{-|
+Shift a dynamic line by a given amount and then set the column
+
+@since 2.1.0.0
+-}
+shiftLineAndSetColQ :: Word -- ^ The amount to shift the line by
+                    -> Word -- ^ The new column
+                    -> Code Pos
+                    -> Code Pos
+{-|
+Shift a dynamic position by first adjusting the column, then aligning to a tab, then shifting further
+
+@since 2.1.0.0
+-}
+shiftAlignAndShiftColQ :: Word -- ^ Amount to shift column by before the tab shift
+                       -> Word -- ^ Amount to shift column by after the tab shift
+                       -> Code Pos
+                       -> Code Pos
+
+{-|
 Given the opaque representation of a position, extracts the line number out of it.
 
 @since 1.8.0.0
@@ -67,23 +184,67 @@
 -}
 extractCol :: Code Pos -> Code Int
 
+{-|
+Converts a static position into a dynamic one.
+
+@since 2.1.0.0
+-}
+liftPos :: Word -> Word -> Code Pos
+
 #ifndef FULL_WIDTH_POSITIONS
-initPos = [|| 0x00000001_00000001## ||]
 
+-- This is referred to directly in generated code, leave optimised primitives
 updatePos# pos '\n' = (pos `and#` 0xffffffff_00000000##) `plusWord#` 0x00000001_00000001##
 updatePos# pos '\t' = ((pos `plusWord#` 0x00000000_00000003##) `and#` 0xffffffff_fffffffc##) `or#` 0x00000000_00000001##
 updatePos# pos _    = pos `plusWord#` 0x00000000_00000001##
 
+-- This is referred to directly in generated code, leave optimised primitives
+updatePosNewlineOnly# pos = updatePos0ColNewlineOnly# (pos `and#` 0xffffffff_00000000##)
+
+-- This is referred to directly in generated code, leave optimised primitives
+updatePos0ColNewlineOnly# pos0Col '\n' = pos0Col `plusWord#` 0x00000001_00000000##
+updatePos0ColNewlineOnly# pos0Col _ = pos0Col
+
+shiftLineAndSetColQ n col qpos = [|| ($$qpos `and#` 0xffffffff_00000000##) `plusWord#` $$(liftPos n col) ||]
+shiftColQ (W# n) qpos = [|| $$qpos `plusWord#` n ||]
+shiftAlignAndShiftColQ firstBy thenBy qpos =
+  let !(W# pre) = firstBy + 3 -- offset first, then add 3 to overshoot
+      !(W# mask) = -4         -- constant fold this into raw literal
+      !(W# post) = thenBy + 1 -- add the offset of tab boundary from power of two, then remaining positions
+  in if thenBy == 0 then [|| (($$qpos `plusWord#` pre) `and#` mask) `or#` 0x00000000_00000001## ||] -- because tab widths are multiples of two
+     else                [|| (($$qpos `plusWord#` pre) `and#` mask) `plusWord#` post ||]
+
 extractLine qpos = [||I# (word2Int# ($$qpos `uncheckedShiftRL#` 32#))||]
 extractCol qpos = [||I# (word2Int# ($$qpos `and#` 0x00000000_ffffffff##))||]
 
-#else
-initPos = [|| (# 1##, 1## #) ||]
+liftPos line col = let !(W# p) = (line `unsafeShiftL` 32) .|. col in [||p||]
 
+#else
+-- This is referred to directly in generated code, leave optimised primitives
 updatePos# (# line, _ #)   '\n' = (# line `plusWord#` 1##, 1## #)
 updatePos# (# line, col #) '\t' = (# line, ((col `plusWord#` 3##) `and#` (0## `minusWord#` 4##)) `or#` 1## #) -- nearest tab boundary `c + (4 - (c - 1) % 4)`
 updatePos# (# line, col #) _    = (# line, col `plusWord#` 1## #)
 
+-- This is referred to directly in generated code, leave optimised primitives
+updatePosNewlineOnly# = updatePos0ColNewlineOnly#
+
+-- This is referred to directly in generated code, leave optimised primitives
+updatePos0ColNewlineOnly# (# line, _ #) '\n' = (# line `plusWord#` 1##, 0## #)
+updatePos0ColNewlineOnly# pos           _    = pos
+
+shiftLineAndSetColQ (W# n) (W# col) qpos = [|| case $$qpos of (# line, _ #) -> (# line `plusWord#` n, col #) ||]
+shiftColQ (W# n) qpos = [|| case $$qpos of (# line, col #) -> (# line, col `plusWord#` n #) ||]
+shiftAlignAndShiftColQ firstBy thenBy qpos =
+  let !(W# pre) = firstBy + 3 -- offset first, then add 3 to overshoot
+      !(W# mask) = -4         -- constant fold this into raw literal
+      !(W# post) = thenBy + 1 -- add the offset of tab boundary from power of two, then remaining positions
+  in [|| case $$qpos of
+           (# line, col #) -> (# line,
+             $$(if thenBy == 0 then [|| ((col `plusWord#` pre) `and#` mask) `or#` 1## ||] -- because tab widths are multiples of two
+                else                [|| ((col `plusWord#` pre) `and#` mask) `plusWord#` post ||]) #) ||]
+
 extractLine qpos = [|| case $$qpos of (# line, _ #) -> I# (word2Int# line) ||]
 extractCol qpos = [|| case $$qpos of (# _, col #) -> I# (word2Int# col) ||]
+
+liftPos (W# line) (W# col) = [||(# line, col #)||]
 #endif
diff --git a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/Context.hs b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/Context.hs
--- a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/Context.hs
+++ b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/Context.hs
@@ -1,7 +1,8 @@
 {-# LANGUAGE DeriveAnyClass,
              MagicHash,
              DerivingStrategies,
-             UnboxedTuples #-}
+             UnboxedTuples,
+             PatternSynonyms #-}
 {-|
 Module      : Parsley.Internal.Backend.Machine.Types.Context
 Description : Fully static context required to generate a parser
@@ -69,7 +70,8 @@
 import Parsley.Internal.Backend.Machine.Types.Dynamics (DynFunc, DynSubroutine)
 import Parsley.Internal.Backend.Machine.Types.Input    (Input)
 import Parsley.Internal.Backend.Machine.Types.Statics  (QSubroutine(..), StaFunc, StaSubroutine, StaCont)
-import Parsley.Internal.Common                         (Queue, enqueue, dequeue, Code, RewindQueue)
+import Parsley.Internal.Common                         (Queue, enqueue, dequeue, poke, Code, RewindQueue)
+import Parsley.Internal.Core.CharPred                  (CharPred, pattern Item, andPred)
 
 import qualified Data.Dependent.Map                           as DMap  ((!), insert, empty, lookup)
 import qualified Parsley.Internal.Common.QueueLike            as Queue (empty, null)
@@ -83,14 +85,14 @@
 
 @since 1.0.0.0
 -}
-data Ctx s o a = Ctx { μs         :: DMap MVar (QSubroutine s o a)     -- ^ Map of subroutine bindings.
-                     , φs         :: DMap ΦVar (QJoin s o a)           -- ^ Map of join point bindings.
-                     , σs         :: DMap ΣVar (Reg s)                 -- ^ Map of available registers.
-                     , debugLevel :: Int                               -- ^ Approximate depth of debug combinator.
-                     , coins      :: Int                               -- ^ Number of tokens free to consume without length check.
-                     , offsetUniq :: Word                              -- ^ Next unique offset identifier.
-                     , piggies    :: Queue Coins                       -- ^ Queue of future length check credit.
-                     , knownChars :: RewindQueue (Code Char, Input o) -- ^ Characters that can be reclaimed on backtrack.
+data Ctx s o a = Ctx { μs         :: !(DMap MVar (QSubroutine s o a))              -- ^ Map of subroutine bindings.
+                     , φs         :: !(DMap ΦVar (QJoin s o a))                    -- ^ Map of join point bindings.
+                     , σs         :: !(DMap ΣVar (Reg s))                          -- ^ Map of available registers.
+                     , debugLevel :: {-# UNPACK #-} !Int                           -- ^ Approximate depth of debug combinator.
+                     , coins      :: {-# UNPACK #-} !Int                           -- ^ Number of tokens free to consume without length check.
+                     , offsetUniq :: {-# UNPACK #-} !Word                          -- ^ Next unique offset identifier.
+                     , piggies    :: !(Queue Coins)                                -- ^ Queue of future length check credit.
+                     , knownChars :: !(RewindQueue (Code Char, CharPred, Input o)) -- ^ Characters that can be reclaimed on backtrack.
                      }
 
 {-|
@@ -425,25 +427,32 @@
 @since 1.5.0.0
 -}
 addChar :: Code Char -> Input o -> Ctx s o a -> Ctx s o a
-addChar c o ctx = ctx { knownChars = enqueue (c, o) (knownChars ctx) }
+addChar c o ctx = ctx { knownChars = enqueue (c, Item, o) (knownChars ctx) }
 
 {-|
 Reads a character from the context's retrieval queue if one exists.
 If not, reads a character from another given source (and adds it to the
 rewind buffer).
 
-@since 1.5.0.0
+@since 2.1.0.0
 -}
-readChar :: Ctx s o a                                     -- ^ The original context.
-         -> ((Code Char -> Input o -> Code b) -> Code b)  -- ^ The fallback source of input.
-         -> (Code Char -> Input o -> Ctx s o a -> Code b) -- ^ The continuation that needs the read characters and updated context.
+readChar :: Ctx s o a                                                             -- ^ The original context.
+         -> CharPred                                                              -- ^ The predicate that this character will be tested against
+         -> ((Code Char -> Input o -> Code b) -> Code b)                          -- ^ The fallback source of input.
+         -> (Code Char -> CharPred -> CharPred -> Input o -> Ctx s o a -> Code b) -- ^ The continuation that needs the read characters and updated context.
          -> Code b
-readChar ctx fallback k
+readChar ctx pred fallback k
   | reclaimable = unsafeReadChar ctx k
   | otherwise   = fallback $ \c o -> unsafeReadChar (addChar c o ctx) k
   where
     reclaimable = not (Queue.null (knownChars ctx))
-    unsafeReadChar ctx k = let ((c, o), q) = dequeue (knownChars ctx) in k c o (ctx { knownChars = q })
+    unsafeReadChar ctx k = let -- combine the old information with the new information, refining the predicate
+                               -- This works for notFollowedBy at the /moment/ because the predicate does not cross the handler boundary...
+                               -- Perhaps any that cross handler boundaries should be complemented if that ever happens.
+                               updateChar (c, p, o) = (c, andPred p pred, o)
+                               ((_, pOld, _), q) = poke updateChar (knownChars ctx)
+                               ((c, p, o), q') = dequeue q
+                           in k c pOld p o (ctx { knownChars = q' })
 
 -- Exceptions
 newtype MissingDependency = MissingDependency IMVar deriving anyclass Exception
diff --git a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/Input.hs b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/Input.hs
--- a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/Input.hs
+++ b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/Input.hs
@@ -11,23 +11,33 @@
 
 @since 1.8.0.0
 -}
-module Parsley.Internal.Backend.Machine.Types.Input (module Parsley.Internal.Backend.Machine.Types.Input) where
+module Parsley.Internal.Backend.Machine.Types.Input (
+    Input(off), Input#(..),
+    mkInput, fromInput, toInput,
+    consume,
+    forcePos, updatePos,
+    chooseInput
+  ) where
 
-import Parsley.Internal.Backend.Machine.InputRep           (Rep)
-import Parsley.Internal.Backend.Machine.Types.Base         (Pos)
-import Parsley.Internal.Backend.Machine.Types.Input.Offset (Offset(offset), mkOffset)
---import Parsley.Internal.Backend.Machine.Types.Input.Pos    ()
-import Parsley.Internal.Common.Utils                       (Code)
+import Parsley.Internal.Backend.Machine.InputRep                  (Rep)
+import Parsley.Internal.Backend.Machine.Types.Input.Offset        (Offset(offset), mkOffset, moveOne, moveN)
+import Parsley.Internal.Backend.Machine.Types.Input.Pos           (StaPos, DynPos, toDynPos, fromDynPos, fromStaPos, force, update)
+import Parsley.Internal.Backend.Machine.Types.InputCharacteristic (InputCharacteristic(..))
+import Parsley.Internal.Common.Utils                              (Code)
+import Parsley.Internal.Core.CharPred                             (CharPred)
+import Parsley.Internal.Core.CombinatorAST                        (PosSelector)
 
 {-|
 Packages known static information about offsets (via `Offset`) with static information about positions
 (currently unavailable).
 
-@since 1.8.0.0
+@since 2.1.0.0
 -}
 data Input o = Input {
-    off  :: Offset o,
-    pos :: Code Pos
+    -- | The offset contained within the input
+    off  :: !(Offset o),
+    -- | The position contained within the input
+    pos :: !StaPos
   }
 
 {-|
@@ -36,17 +46,25 @@
 @since 1.8.0.0
 -}
 data Input# o = Input# {
-    off#  :: Code (Rep o),
-    pos#  :: Code Pos
+    off#  :: !(Code (Rep o)),
+    pos#  :: !DynPos
   }
 
 {-|
+Constructs an `Input` given a dynamic offset and a static position.
+
+@since 2.1.0.0
+-}
+mkInput :: Code (Rep o) -> (Word, Word) -> Input o
+mkInput off = Input (mkOffset off 0) . fromStaPos
+
+{-|
 Strips away static information, returning the raw dynamic components.
 
 @since 1.8.0.0
 -}
 fromInput :: Input o -> Input# o
-fromInput Input{..} = Input# (offset off) pos
+fromInput Input{..} = Input# (offset off) (toDynPos pos)
 
 {-|
 Given a unique identifier, forms a plainly annotated static combination of position and offset.
@@ -54,4 +72,47 @@
 @since 1.8.0.0
 -}
 toInput :: Word -> Input# o -> Input o
-toInput u Input#{..} = Input (mkOffset off# u) pos#
+toInput u Input#{..} = Input (mkOffset off# u) (fromDynPos pos#)
+
+{-|
+Register that a character has been consumed on this input, incorporating the new dynamic offset.
+
+@since 2.1.0.0
+-}
+consume :: Code (Rep o) -> Input o -> Input o
+consume offset' input = input {
+    off = moveOne (off input) offset'
+  }
+
+{-|
+Collapse the position stored inside the input applying all updates to it. Once this has been completed,
+the given `PosSelector` will be used to extract one of the line or column and return it to the given
+continuation, along with the updated input post-collapse.
+
+@since 2.1.0.0
+-}
+forcePos :: Input o -> PosSelector -> (Code Int -> Input o -> Code r) -> Code r
+forcePos input sel k = force (pos input) sel (\dp sp -> k dp (input { pos = sp }))
+
+{-|
+Updates the position within the `Input` when a character has been consumed, providing it the
+dynamic character that was produced as well as the static character-predicate that guarded it.
+
+@since 2.1.0.0
+-}
+updatePos :: Input o -> Code Char -> CharPred -> Input o
+updatePos input c p = input { pos = update (pos input) c p }
+
+{-|
+Given knowledge about how input has been consumed through a call boundary, this function can update
+the input using statically acquired knowledge.
+
+@since 2.1.0.0
+-}
+-- TODO: In future, we could adjust InputCharacteristic to provide information about the static behaviours of the positions too...
+chooseInput :: InputCharacteristic -> Word -> Input o -> Input# o -> Input o
+chooseInput (AlwaysConsumes n) _ inp  inp#  = inp { off = moveN n (off inp) (off# inp#), pos = fromDynPos (pos# inp#) }
+-- Technically, in this case, we know the whole input is unchanged. This essentially ignores the continuation arguments
+-- hopefully GHC could optimise this better?
+chooseInput NeverConsumes      _ inp  _inp# = inp -- { off = (off inp) {offset = off# inp# }, pos = pos# inp# }
+chooseInput MayConsume         u _inp inp#  = toInput u inp#
diff --git a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/Input/Pos.hs b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/Input/Pos.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/Input/Pos.hs
@@ -0,0 +1,251 @@
+{-# LANGUAGE RecordWildCards, UnboxedTuples, PatternSynonyms #-}
+{-|
+Module      : Parsley.Internal.Backend.Machine.Types.Input.Pos
+Description : Packaging of offsets and positions.
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : experimental
+
+This module contains the machinery for manipulating position information, both in static and dynamic
+forms.
+
+@since 2.1.0.0
+-}
+module Parsley.Internal.Backend.Machine.Types.Input.Pos (
+    StaPos, DynPos,
+    fromDynPos, toDynPos, fromStaPos,
+    force, update
+  ) where
+
+import Data.Bits                               ((.|.))
+import Data.List                               (foldl')
+import Parsley.Internal.Common.Utils           (Code)
+import Parsley.Internal.Core.CharPred          (CharPred, pattern Specific, apply)
+import Parsley.Internal.Core.CombinatorAST     (PosSelector(..))
+import Parsley.Internal.Backend.Machine.PosOps (liftPos)
+
+import qualified Parsley.Internal.Backend.Machine.PosOps as Ops
+import qualified Parsley.Internal.Backend.Machine.Types.Base as Base (Pos)
+
+{-|
+The type-alias for dynamic positions.
+
+@since 2.1.0.0
+-}
+type DynPos = Code Base.Pos
+
+{-|
+Type that represents static positions and their associated data.
+
+@since 2.1.0.0
+-}
+data StaPos = StaPos {
+    dynPos :: !Pos,
+    alignment :: !Alignment,
+    contributing :: ![StaChar]
+  }
+
+{-|
+Converts a dynamic position into an unannotated static one.
+
+@since 2.1.0.0
+-}
+fromDynPos :: DynPos -> StaPos
+fromDynPos = mkStaPos . Dynamic
+
+{-|
+Forgets the static information found in a position and converts it into a dynamic one.
+
+@since 2.1.0.0
+-}
+toDynPos :: StaPos -> DynPos
+toDynPos = fromPos . collapse
+
+{-|
+Produce a static position from a given line and column pair.
+
+@since 2.1.0.0
+-}
+fromStaPos :: (Word, Word) -> StaPos
+fromStaPos = mkStaPos . uncurry Static
+
+{-|
+Given a static position, and a component to select, collapse the position down to its smallest form
+(binding this to a let if necessary) and extract the desired component. The new, potentially rebound,
+position is provided to the continuation too.
+
+@since 2.1.0.0
+-}
+force :: StaPos -> PosSelector -> (Code Int -> StaPos -> Code r) -> Code r
+force p sel k
+  | null (contributing p) = k (extract sel (dynPos p)) p
+  | otherwise = case collapse p of
+    p'@Static{} -> k (extract sel p') (newPos p')
+    Dynamic qpos -> [||
+        let pos = $$qpos
+        in $$(k (extract sel (Dynamic [||pos||])) (newPos (Dynamic [||pos||])))
+      ||]
+  where
+    newPos pos = StaPos {
+      dynPos = pos,
+      alignment = updateAlignment (contributing p) (alignment p),
+      contributing = []
+    }
+    extract Line (Dynamic pos) = Ops.extractLine pos
+    extract Line (Static line _) = let line' = fromEnum line in [||line'||]
+    extract Col (Dynamic pos) = Ops.extractCol pos
+    extract Col (Static _ col) = let col' = fromEnum col in [||col'||]
+
+{-|
+Advance a static position accounting for the dynamic character that was last read and the
+static predicate that guarded that read.
+
+@since 2.1.0.0
+-}
+update :: StaPos -> Code Char -> CharPred -> StaPos
+update pos c p = pos { contributing = StaChar c p : contributing pos }
+
+{-----------------}
+{-   INTERNALS   -}
+{-----------------}
+
+-- Data
+
+-- TODO: This could be more fine-grained, for instance a partially static position.
+data Pos = Static {-# UNPACK #-} !Word {-# UNPACK #-} !Word | Dynamic DynPos
+
+data Alignment = Unknown | Unaligned {-# UNPACK #-} !Word
+
+pattern Aligned :: Alignment
+pattern Aligned = Unaligned 0
+
+data StaChar = StaChar {
+    char :: !(Code Char),
+    predicate :: !CharPred
+  }
+
+data CharClass = Tab | Newline | Regular | NonNewline
+
+data Updater = DynUpdater !DynUpdater !(Code Char)
+             | StaUpdater !StaUpdater
+
+data StaUpdater = OffsetLineAndSetCol {-# UNPACK #-} !Word {-# UNPACK #-} !Word
+                | OffsetCol {-# UNPACK #-} !Word
+                | OffsetAlignOffsetCol {-# UNPACK #-} !Word {-# UNPACK #-} !Word
+
+data DynUpdater = FullUpdate
+                | NoNewlineUpdate
+                | NoColUpdate
+
+-- Functions
+
+mkStaPos :: Pos -> StaPos
+mkStaPos pos = StaPos { dynPos = pos, alignment = alignment pos, contributing = [] }
+  where
+    alignment Dynamic{} = Unknown
+    alignment (Static _ col) = Unaligned (col - 1 `mod` Ops.tabWidth)
+
+fromPos :: Pos -> DynPos
+fromPos (Static l c) = liftPos l c
+fromPos (Dynamic p) = p
+
+updateAlignment :: [StaChar] -> Alignment -> Alignment
+updateAlignment cs a = foldr (updateAlignment' . knownChar . predicate) a cs
+  where
+    updateAlignment' Nothing           _             = Unknown
+    updateAlignment' (Just Regular)    (Unaligned n) = Unaligned (n + 1 `mod` Ops.tabWidth)
+    updateAlignment' (Just Regular)    Unknown       = Unknown
+    updateAlignment' (Just NonNewline) _             = Unknown
+    updateAlignment' _                 _             = Aligned
+
+collapse :: StaPos -> Pos
+collapse StaPos{..} = applyUpdaters dynPos (buildUpdaters alignment contributing)
+
+updateTab :: Maybe StaUpdater -> StaUpdater
+updateTab Nothing = OffsetAlignOffsetCol 0 0
+updateTab (Just (OffsetLineAndSetCol n m)) = OffsetLineAndSetCol n (Ops.toNextTab m)
+updateTab (Just (OffsetCol n)) = OffsetAlignOffsetCol n 0
+updateTab (Just (OffsetAlignOffsetCol firstBy thenBy)) = OffsetAlignOffsetCol firstBy (toNextTabFromKnownAlignment thenBy)
+
+updateRegular :: Maybe StaUpdater -> StaUpdater
+updateRegular Nothing = OffsetCol 1
+updateRegular (Just (OffsetLineAndSetCol n m)) = OffsetLineAndSetCol n (m + 1)
+updateRegular (Just (OffsetCol n)) = OffsetCol (n + 1)
+updateRegular (Just (OffsetAlignOffsetCol firstBy thenBy)) = OffsetAlignOffsetCol firstBy (thenBy + 1)
+
+updateNewline :: Maybe StaUpdater -> StaUpdater
+updateNewline (Just (OffsetLineAndSetCol n _)) = OffsetLineAndSetCol (n + 1) 1
+updateNewline _ = OffsetLineAndSetCol 1 1
+
+toNextTabFromKnownAlignment :: Word -> Word
+toNextTabFromKnownAlignment x = (x .|. Ops.tabWidth - 1) + 1
+
+{-| Takes the initial alignment and contributing characters and
+    return the list of updaters (in order from left-to-right)
+    that must be applied to update the position properly -}
+buildUpdaters :: Alignment -> [StaChar] -> [Updater]
+buildUpdaters alignment = applyAlignment alignment . removeDeadUpdates . uncurry combine . foldr f (Nothing, [])
+  where
+    -- The known initial alignment can affect the /first/ updater
+    applyAlignment :: Alignment -> [Updater] -> [Updater]
+    applyAlignment (Unaligned n) (StaUpdater (OffsetAlignOffsetCol firstBy thenBy) : updaters) =
+      -- We know what the current alignment boundary is, so can eliminate the Align
+      let pre = n + firstBy
+          nextTabIn = toNextTabFromKnownAlignment pre
+      in StaUpdater (OffsetCol (nextTabIn + thenBy)) : updaters
+    applyAlignment _ updaters = updaters
+
+    combine :: Maybe StaUpdater -> [Updater] -> [Updater]
+    combine Nothing updaters = updaters
+    combine (Just updater) updaters = StaUpdater updater : updaters
+
+    f :: StaChar -> (Maybe StaUpdater, [Updater]) -> (Maybe StaUpdater, [Updater])
+    f StaChar{..} (updater, updaters) =
+      let charClass = knownChar predicate
+      in case charClass of
+        Just Tab        -> (Just (updateTab updater), updaters)
+        Just Newline    -> (Just (updateNewline updater), updaters)
+        Just Regular    -> (Just (updateRegular updater), updaters)
+        Just NonNewline -> (Nothing, DynUpdater NoNewlineUpdate char : combine updater updaters)
+        _               -> (Nothing, DynUpdater FullUpdate char : combine updater updaters)
+
+    -- This function should reverse the list, and also remove any redundant updaters:
+    -- when a newline is known, any updater before it is only useful for the newlines.
+    removeDeadUpdates :: [Updater] -> [Updater]
+    removeDeadUpdates = fst . foldl' g ([], True)
+      where
+        g :: ([Updater], Bool) -> Updater -> ([Updater], Bool)
+        g res@(updaters, keep) updater@(DynUpdater kind c)
+          | keep                              = (updater : updaters, True)
+          -- If we're dropping because of lines, then a dynamic update known not to affect lines isn't needed
+          | not keep, NoNewlineUpdate <- kind = res
+          -- If we're dropping because of lines, then we don't need column updates
+          | otherwise                         = (DynUpdater NoColUpdate c : updaters, False)
+        -- This is a line updater, no tab or regular updaters matter anymore
+        g (updaters, _) updater@(StaUpdater OffsetLineAndSetCol{}) = (updater : updaters, False)
+        -- This a static non-line related update, we can drop it if needed
+        g res@(updaters, keep) updater@StaUpdater{}
+          | keep      = (updater : updaters, True)
+          | otherwise = res
+
+applyUpdaters :: Pos -> [Updater] -> Pos
+applyUpdaters = foldl' applyUpdater
+  where
+    applyUpdater (Static line _) (DynUpdater NoColUpdate c) = Dynamic (Ops.updatePosNewlineOnly c line)
+    applyUpdater (Dynamic pos) (DynUpdater NoColUpdate c)   = Dynamic (Ops.updatePosNewlineOnlyQ c pos)
+    applyUpdater (Static line col) (DynUpdater _ c)         = Dynamic (Ops.updatePos c line col)
+    applyUpdater (Dynamic pos) (DynUpdater _ c)             = Dynamic (Ops.updatePosQ c pos)
+    applyUpdater pos (StaUpdater updater)                   = applyStaUpdater pos updater
+
+    applyStaUpdater (Static line _)   (OffsetLineAndSetCol n m)             = uncurry Static $ Ops.shiftLineAndSetCol n m line
+    applyStaUpdater (Static line col) (OffsetCol n)                         = uncurry Static $ Ops.shiftCol n line col
+    applyStaUpdater (Static line col) (OffsetAlignOffsetCol firstBy thenBy) = uncurry Static $ Ops.shiftAlignAndShiftCol firstBy thenBy line col
+    applyStaUpdater (Dynamic pos)     (OffsetLineAndSetCol n m)             = Dynamic $ Ops.shiftLineAndSetColQ n m pos
+    applyStaUpdater (Dynamic pos)     (OffsetCol n)                         = Dynamic $ Ops.shiftColQ n pos
+    applyStaUpdater (Dynamic pos)     (OffsetAlignOffsetCol firstBy thenBy) = Dynamic $ Ops.shiftAlignAndShiftColQ firstBy thenBy pos
+
+knownChar :: CharPred -> Maybe CharClass
+knownChar (Specific '\t')         = Just Tab
+knownChar (Specific '\n')         = Just Newline
+knownChar p | not (apply p '\n')  = Just $ if not (apply p '\t') then Regular else NonNewline
+knownChar _                       = Nothing
diff --git a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/State.hs b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/State.hs
--- a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/State.hs
+++ b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/State.hs
@@ -41,8 +41,8 @@
 
 @since 1.4.0.0
 -}
-data Γ s o xs n r a = Γ { operands :: OpStack xs                        -- ^ The current values available for applicative application.
-                        , retCont  :: StaCont s o a r                   -- ^ The current return continuation when this parser is finished.
-                        , input    :: Input o                           -- ^ The current offset into the input of the parser.
-                        , handlers :: Vec n (AugmentedStaHandler s o a) -- ^ The failure handlers that are used to process failure during a parser.
+data Γ s o xs n r a = Γ { operands :: !(OpStack xs)                        -- ^ The current values available for applicative application.
+                        , retCont  :: !(StaCont s o a r)                   -- ^ The current return continuation when this parser is finished.
+                        , input    :: !(Input o)                           -- ^ The current offset into the input of the parser.
+                        , handlers :: !(Vec n (AugmentedStaHandler s o a)) -- ^ The failure handlers that are used to process failure during a parser.
                         }
diff --git a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/Statics.hs b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/Statics.hs
--- a/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/Statics.hs
+++ b/src/ghc-8.10+/Parsley/Internal/Backend/Machine/Types/Statics.hs
@@ -46,15 +46,16 @@
     staSubroutine#, meta,
   ) where
 
-import Control.Monad.ST                                    (ST)
-import Data.STRef                                          (STRef)
-import Data.Kind                                           (Type)
-import Data.Maybe                                          (fromMaybe)
-import Parsley.Internal.Backend.Machine.LetBindings        (Regs(..), Metadata, newMeta, InputCharacteristic(..))
-import Parsley.Internal.Backend.Machine.Types.Dynamics     (DynCont, DynHandler, DynFunc)
-import Parsley.Internal.Backend.Machine.Types.Input        (Input(..), Input#(..), fromInput)
-import Parsley.Internal.Backend.Machine.Types.Input.Offset (Offset, same)
-import Parsley.Internal.Common.Utils                       (Code)
+import Control.Monad.ST                                           (ST)
+import Data.STRef                                                 (STRef)
+import Data.Kind                                                  (Type)
+import Data.Maybe                                                 (fromMaybe)
+import Parsley.Internal.Backend.Machine.LetBindings               (Regs(..), Metadata, newMeta)
+import Parsley.Internal.Backend.Machine.Types.Dynamics            (DynCont, DynHandler, DynFunc)
+import Parsley.Internal.Backend.Machine.Types.Input               (Input(..), Input#(..), fromInput)
+import Parsley.Internal.Backend.Machine.Types.Input.Offset        (Offset, same)
+import Parsley.Internal.Backend.Machine.Types.InputCharacteristic (InputCharacteristic(..))
+import Parsley.Internal.Common.Utils                              (Code)
 
 -- Handlers
 {-|
diff --git a/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Defunc.hs b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Defunc.hs
--- a/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Defunc.hs
+++ b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Defunc.hs
@@ -11,6 +11,7 @@
 data Defunc a where
   LAM     :: Lam a -> Defunc a
   BOTTOM  :: Defunc a
+  INPUT   :: Code o -> (Code Int, Code Int) -> Defunc o
   SAME    :: PositionOps o => Defunc (o -> o -> Bool)
 
 user :: Core.Defunc a -> Defunc a
@@ -20,7 +21,8 @@
 ap f x = LAM (Lam.App (unliftDefunc f) (unliftDefunc x))
 
 ap2 :: Defunc (a -> b -> c) -> Defunc a -> Defunc b -> Defunc c
-ap2 f x = ap (ap f x)
+ap2 SAME (INPUT o1 _) (INPUT o2 _) = LAM (Lam.Var False [|| $$same $$o1 $$o2 ||])
+ap2 f x y = ap (ap f x) y
 
 _if :: Defunc Bool -> Code a -> Code a -> Code a
 _if c t e = normaliseGen (Lam.If (unliftDefunc c) (Lam.Var False t) (Lam.Var False e))
@@ -32,6 +34,7 @@
 genDefunc :: Defunc a -> Code a
 genDefunc (LAM x) = normaliseGen x
 genDefunc BOTTOM  = [||undefined||]
+genDefunc INPUT{} = error "Cannot materialise an input in the regular way"
 genDefunc SAME    = same
 
 pattern NormLam :: Lam a -> Defunc a
@@ -45,4 +48,5 @@
 instance Show (Defunc a) where
   show (LAM x) = show x
   show SAME = "same"
+  show INPUT{} = "input"
   show BOTTOM = "[[irrelevant]]"
diff --git a/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Eval.hs b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Eval.hs
--- a/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Eval.hs
+++ b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Eval.hs
@@ -11,7 +11,7 @@
 import Control.Monad                                  (forM, liftM2)
 import Control.Monad.Reader                           (ask, asks, local)
 import Control.Monad.ST                               (runST)
-import Parsley.Internal.Backend.Machine.Defunc        (Defunc(LAM, SAME), pattern FREEVAR, genDefunc, ap, ap2, _if)
+import Parsley.Internal.Backend.Machine.Defunc        (Defunc(LAM, SAME, INPUT), pattern FREEVAR, genDefunc, ap, ap2, _if)
 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(..), PosSelector(..))
@@ -21,6 +21,7 @@
 import Parsley.Internal.Backend.Machine.Types.Coins   (willConsume)
 import Parsley.Internal.Backend.Machine.Types.State
 import Parsley.Internal.Common                        (Fix4, cata4, One, Code, Vec(..), Nat(..))
+import Parsley.Internal.Core                          (CharPred)
 import Parsley.Internal.Trace                         (Trace(trace))
 import System.Console.Pretty                          (color, Color(Green))
 
@@ -91,7 +92,7 @@
 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 :: (?ops :: InputOps o, PositionOps o, BoxOps o, HandlerOps o, Trace) => CharPred -> 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
@@ -99,9 +100,9 @@
      | hasChange -> maybeEmitCheck Nothing <$> local spendCoin k
      | otherwise -> trace "I have a piggy :)" $ local breakPiggy (asks ((maybeEmitCheck . Just) . coins) <*> local spendCoin k)
   where
-    maybeEmitCheck Nothing mk γ = sat (ap p) mk (raise γ) γ
+    maybeEmitCheck Nothing mk γ = sat p mk (raise γ) γ
     maybeEmitCheck (Just n) mk γ =
-      [|| let bad = $$(raise γ) in $$(emitLengthCheck n (sat (ap p) mk [||bad||]) [||bad||] γ)||]
+      [|| let bad = $$(raise γ) in $$(emitLengthCheck n (sat p mk [||bad||]) [||bad||] γ)||]
 
 evalEmpt :: (BoxOps o, HandlerOps o) => MachineMonad s o xs (Succ n) r a
 evalEmpt = return $! raise
@@ -121,10 +122,10 @@
         Machine (evalChoices [LAM (Abs id)] [Machine (evalPop yes)] no)))))))
 
 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 γ)})
+evalTell (Machine k) = k <&> \mk γ -> mk (γ {operands = Op (INPUT (input γ) (pos γ)) (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})
+evalSeek (Machine k) = k <&> \mk γ -> let Op (INPUT input pos) xs = operands γ in mk (γ {operands = xs, input = input, pos = pos})
 
 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 γ ->
diff --git a/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Ops.hs b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Ops.hs
--- a/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Ops.hs
+++ b/src/ghc-8.6+/Parsley/Internal/Backend/Machine/Ops.hs
@@ -19,7 +19,7 @@
 import Data.Text                                     (Text)
 import Data.Void                                     (Void)
 import Debug.Trace                                   (trace)
-import Parsley.Internal.Backend.Machine.Defunc       (Defunc, pattern FREEVAR, genDefunc, _if)
+import Parsley.Internal.Backend.Machine.Defunc       (Defunc(LAM, INPUT), pattern FREEVAR, genDefunc, ap, _if)
 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-})
@@ -28,6 +28,7 @@
 import Parsley.Internal.Backend.Machine.Types.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.CharPred                (CharPred, lamTerm)
 import System.Console.Pretty                         (color, Color(Green, White, Red, Blue))
 
 #define inputInstances(derivation) \
@@ -48,10 +49,10 @@
 updatePos (qline, qcol) qc k = [|| case updatePos# $$qline $$qcol $$qc of (# line', col' #) -> $$(k ([||line'||], [||col'||])) ||]
 
 {- Input Operations -}
-sat :: (?ops :: InputOps o) => (Defunc Char -> Defunc 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 :: (?ops :: InputOps o) => CharPred -> (Γ 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' -> let v = FREEVAR c in
                         updatePos pos c $ \pos' ->
-                          _if (p v)
+                          _if (ap (LAM (lamTerm p)) v)
                               (k (γ {operands = Op v operands, input = input', pos = pos'}))
                               bad
 
@@ -65,6 +66,7 @@
 {- General Operations -}
 dup :: Defunc x -> (Defunc x -> Code r) -> Code r
 dup (FREEVAR x) k = k (FREEVAR x)
+dup (INPUT o pos) k = k (INPUT o pos)
 dup x k = [|| let !dupx = $$(genDefunc x) in $$(k (FREEVAR [||dupx||])) ||]
 
 {-# INLINE returnST #-}
@@ -98,23 +100,23 @@
   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)
+               -> Code o -> (Code Int, Code Int) -> 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))
+             -> (Code o -> (Code Int, Code Int) -> 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 γ))
+    let handler = $$(h (input γ) (pos γ))
     in $$(k (γ {handlers = VCons [||handler||] (handlers γ)}))
   ||]
 
 #define deriveHandlerOps(_o)                         \
 instance HandlerOps _o where                         \
 {                                                    \
-  buildHandler γ h c = [||\(o# :: Unboxed _o) !(line :: Int) !(col :: Int) ->     \
-    $$(h (γ {operands = Op (FREEVAR c) (operands γ), \
+  buildHandler γ h c pos = [||\(o# :: Unboxed _o) !(line :: Int) !(col :: Int) ->     \
+    $$(h (γ {operands = Op (INPUT c pos) (operands γ), \
              input = [||$$box o#||], pos = ([||line||], [||col||])}))||];           \
   fatal = [||\(!_) !_ !_ -> returnST Nothing ||];          \
   raise γ = let VCons h _ = handlers γ               \
@@ -157,7 +159,7 @@
 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 Int, Code Int) -> Code (ST s (Maybe a))
+            -> (Code o -> (Code Int, Code Int) -> Code (Handler s o a)) -> Code o -> (Code Int, Code Int) -> Code (ST s (Maybe a))
   buildRec  :: MVar r
             -> Regs rs
             -> Ctx s o a
@@ -180,10 +182,10 @@
 instance RecBuilder _o where                                                     \
 {                                                                                \
   buildIter ctx μ l h o (line, col) = let bx = box in [||                                    \
-      let handler !o# !line !col = $$(h [||$$bx o#||]) line col;                                     \
+      let handler !o# !line !col = $$(h [||$$bx o#||] ([||line||], [||col||]));           \
           loop !o# !line !col =                                                             \
         $$(run l                                                                 \
-            (Γ Empty (noreturn @_o) [||$$bx o#||] ([||line||], [||col||]) (VCons [||handler o#||] VNil)) \
+            (Γ Empty (noreturn @_o) [||$$bx o#||] ([||line||], [||col||]) (VCons [||handler o# line col||] VNil)) \
             (voidCoins (insertSub μ [||\_ (!o#) !line !col _ -> loop o# line col||] ctx)))           \
       in loop ($$unbox $$o) $$line $$col                                                      \
     ||];                                                                         \
@@ -199,7 +201,7 @@
 
 {- 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)
+  logHandler :: (?ops :: InputOps o) => String -> Ctx s o a -> Γ s o xs (Succ n) ks a -> Code o -> (Code Int, Code Int) -> 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 "^"] ||]
@@ -222,7 +224,7 @@
 #define deriveLogHandler(_o)                                                                         \
 instance LogHandler _o where                                                                         \
 {                                                                                                    \
-  logHandler name ctx γ _ = let VCons h _ = handlers γ in [||\(!o#) ->                               \
+  logHandler name ctx γ _ _ = let VCons h _ = handlers γ in [||\(!o#) ->                             \
       trace $$(preludeString name '<' (γ {input = [||$$box o#||]}) ctx (color Red " Fail")) ($$h o#) \
     ||];                                                                                             \
 };
diff --git a/src/ghc/Parsley/Internal/Backend/Analysis/Coins.hs b/src/ghc/Parsley/Internal/Backend/Analysis/Coins.hs
--- a/src/ghc/Parsley/Internal/Backend/Analysis/Coins.hs
+++ b/src/ghc/Parsley/Internal/Backend/Analysis/Coins.hs
@@ -67,7 +67,7 @@
 alg _     (Dup k)                                 = getConst4 k
 alg _     (Make _ _ k)                            = getConst4 k
 alg _     (Get _ _ k)                             = getConst4 k
-alg _     (Put _ _ k)                             = getConst4 k
+alg _     (Put _ _ (Const4 k))                    = first (const zero) k
 alg _     (SelectPos _ k)                         = getConst4 k
 alg _     (LogEnter _ k)                          = getConst4 k
 alg _     (LogExit _ k)                           = getConst4 k
diff --git a/src/ghc/Parsley/Internal/Backend/CodeGenerator.hs b/src/ghc/Parsley/Internal/Backend/CodeGenerator.hs
--- a/src/ghc/Parsley/Internal/Backend/CodeGenerator.hs
+++ b/src/ghc/Parsley/Internal/Backend/CodeGenerator.hs
@@ -66,6 +66,8 @@
 pattern TryOrElse ::  k a -> k a -> Combinator (Cofree Combinator k) a
 pattern TryOrElse p q <- (_ :< Try (p :< _)) :<|>: (q :< _)
 
+-- it would be nice to generate `yesSame` handler bindings for Try, perhaps a special flag?
+-- relevancy analysis might help too I guess, for a more general one?
 rollbackHandler :: Handler o (Fix4 (Instr o)) (o : xs) (Succ n) r a
 rollbackHandler = Always False (In4 (Seek (In4 Empt)))
 
@@ -118,7 +120,7 @@
 
 shallow :: Trace => Combinator (CodeGen o a) x -> Fix4 (Instr o) (x : xs) (Succ n) r a -> CodeGenStack (Fix4 (Instr o) xs (Succ n) r a)
 shallow (Pure x)      m = do return $! In4 (Push (user x) m)
-shallow (Satisfy p)   m = do return $! In4 (Sat (user p) m)
+shallow (Satisfy p)   m = do return $! In4 (Sat p m)
 shallow (pf :<*>: px) m = do pxc <- runCodeGen px (In4 (_App m)); runCodeGen pf pxc
 shallow (p :*>: q)    m = do qc <- runCodeGen q m; runCodeGen p (In4 (Pop qc))
 shallow (p :<*: q)    m = do qc <- runCodeGen q (In4 (Pop m)); runCodeGen p qc
diff --git a/src/ghc/Parsley/Internal/Backend/Machine/Instructions.hs b/src/ghc/Parsley/Internal/Backend/Machine/Instructions.hs
--- a/src/ghc/Parsley/Internal/Backend/Machine/Instructions.hs
+++ b/src/ghc/Parsley/Internal/Backend/Machine/Instructions.hs
@@ -35,6 +35,7 @@
 import Parsley.Internal.Backend.Machine.Types.Coins (Coins(Coins))
 import Parsley.Internal.Common                      (IFunctor4, Fix4(In4), Const4(..), imap4, cata4, Nat(..), One, intercalateDiff)
 import Parsley.Internal.Core.CombinatorAST          (PosSelector(..))
+import Parsley.Internal.Core.CharPred               (CharPred)
 
 import Parsley.Internal.Backend.Machine.Defunc as Machine (Defunc, user)
 import Parsley.Internal.Core.Defunc            as Core    (Defunc(ID), pattern FLIP_H)
@@ -73,9 +74,9 @@
             -> Instr o k (y : x : xs) n r a
   {-| Reads a character so long as it matches a given predicate. If it does not, or no input is available, this instruction fails.
 
-  @since 1.0.0.0 -}
-  Sat       :: Machine.Defunc (Char -> Bool) {- ^ Predicate to apply. -}
-            -> k (Char : xs) (Succ n) r a    {- ^ Machine requiring read character. -}
+  @since 2.1.0.0 -}
+  Sat       :: CharPred                   {- ^ Predicate to apply. -}
+            -> k (Char : xs) (Succ n) r a {- ^ Machine requiring read character. -}
             -> Instr o k xs (Succ n) r a
   {-| Calls another let-bound parser.
 
diff --git a/src/ghc/Parsley/Internal/Backend/Machine/LetBindings.hs b/src/ghc/Parsley/Internal/Backend/Machine/LetBindings.hs
--- a/src/ghc/Parsley/Internal/Backend/Machine/LetBindings.hs
+++ b/src/ghc/Parsley/Internal/Backend/Machine/LetBindings.hs
@@ -12,20 +12,21 @@
 @since 1.0.0.0
 -}
 module Parsley.Internal.Backend.Machine.LetBindings (
-    LetBinding(..), Metadata, InputCharacteristic(..),
+    LetBinding(..), Metadata,
     Regs(..),
     makeLetBinding, newMeta,
     successInputCharacteristic, failureInputCharacteristic,
     Binding
   ) where
 
-import Prelude hiding                                (foldr)
-import Data.Kind                                     (Type)
-import Data.Set                                      (Set, foldr)
-import Data.Some                                     (Some, pattern Some)
-import Parsley.Internal.Backend.Machine.Identifiers  (ΣVar, SomeΣVar(..))
-import Parsley.Internal.Backend.Machine.Instructions (Instr)
-import Parsley.Internal.Common                       (Fix4, One)
+import Prelude hiding                                             (foldr)
+import Data.Kind                                                  (Type)
+import Data.Set                                                   (Set, foldr)
+import Data.Some                                                  (Some, pattern Some)
+import Parsley.Internal.Backend.Machine.Identifiers               (ΣVar, SomeΣVar(..))
+import Parsley.Internal.Backend.Machine.Instructions              (Instr)
+import Parsley.Internal.Backend.Machine.Types.InputCharacteristic (InputCharacteristic(..))
+import Parsley.Internal.Common                                    (Fix4, One)
 
 {-|
 Type represents a binding, which is a completed parser that can
@@ -74,24 +75,6 @@
     -}
     failureInputCharacteristic :: InputCharacteristic
   }
-
-{-|
-Provides a way to describe how input is consumed in certain circumstances:
-
-* The input may be always the same on all paths
-* The input may always be consumed, but not the same on all paths
-* The input may never be consumed in any path
-* It may be inconsistent
-
-@since 1.5.0.0
--}
-data InputCharacteristic = AlwaysConsumes (Maybe Word)
-                         -- ^ On all paths, input must be consumed: `Nothing` when the extact
-                         --   amount is inconsistent across paths.
-                         | NeverConsumes
-                         -- ^ On all paths, no input is consumed.
-                         | MayConsume
-                         -- ^ The input characteristic is unknown or inconsistent.
 
 {-|
 Given a `Binding` , a set of existential `ΣVar`s, and some `Metadata`, produces a
diff --git a/src/ghc/Parsley/Internal/Backend/Machine/Types/InputCharacteristic.hs b/src/ghc/Parsley/Internal/Backend/Machine/Types/InputCharacteristic.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Backend/Machine/Types/InputCharacteristic.hs
@@ -0,0 +1,32 @@
+{-|
+Module      : Parsley.Internal.Backend.Machine.Types.InputCharacteristic
+Description : Packaging of offsets and positions.
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : experimental
+
+This module contains the `InputCharacteristic` datatype, that describes how bindings consume input.
+
+@since 2.1.0.0
+-}
+module Parsley.Internal.Backend.Machine.Types.InputCharacteristic (
+    module Parsley.Internal.Backend.Machine.Types.InputCharacteristic
+  ) where
+
+{-|
+Provides a way to describe how input is consumed in certain circumstances:
+
+* The input may be always the same on all paths
+* The input may always be consumed, but not the same on all paths
+* The input may never be consumed in any path
+* It may be inconsistent
+
+@since 2.1.0.0
+-}
+data InputCharacteristic = AlwaysConsumes (Maybe Word)
+                         -- ^ On all paths, input must be consumed: `Nothing` when the extact
+                         --   amount is inconsistent across paths.
+                         | NeverConsumes
+                         -- ^ On all paths, no input is consumed.
+                         | MayConsume
+                         -- ^ The input characteristic is unknown or inconsistent.
diff --git a/src/ghc/Parsley/Internal/Common/Queue.hs b/src/ghc/Parsley/Internal/Common/Queue.hs
--- a/src/ghc/Parsley/Internal/Common/Queue.hs
+++ b/src/ghc/Parsley/Internal/Common/Queue.hs
@@ -13,9 +13,9 @@
 module Parsley.Internal.Common.Queue (module Queue) where
 
 import Parsley.Internal.Common.Queue.Impl as Queue (
-    Queue, empty, enqueue, dequeue, null, size, foldr, enqueueAll
+    Queue, empty, enqueue, dequeue, null, size, foldr, enqueueAll, poke
   )
-import Parsley.Internal.Common.QueueLike  (QueueLike(empty, null, size, enqueue, dequeue, enqueueAll))
+import Parsley.Internal.Common.QueueLike  (QueueLike(empty, null, size, enqueue, dequeue, enqueueAll, poke))
 
 instance QueueLike Queue where
   empty      = Queue.empty
@@ -24,3 +24,4 @@
   enqueue    = Queue.enqueue
   dequeue    = Queue.dequeue
   enqueueAll = Queue.enqueueAll
+  poke       = Queue.poke
diff --git a/src/ghc/Parsley/Internal/Common/Queue/Impl.hs b/src/ghc/Parsley/Internal/Common/Queue/Impl.hs
--- a/src/ghc/Parsley/Internal/Common/Queue/Impl.hs
+++ b/src/ghc/Parsley/Internal/Common/Queue/Impl.hs
@@ -68,6 +68,17 @@
   | otherwise   = error "dequeue of empty queue"
 
 {-|
+modifies the head of the queue, without removal. Returns the old head
+
+@since 2.1.0.0
+-}
+poke :: (a -> a) -> Queue a -> (a, Queue a)
+poke f q@(outs -> (x:outs')) = (x, q {outs = f x : outs'})
+poke f q@(outs -> [])
+  | insz q /= 0 = poke f (Queue (insz q) (reverse (ins q)) 0 [])
+  | otherwise   = error "poke of empty queue"
+
+{-|
 Is the queue empty?
 
 @since 1.5.0.0
diff --git a/src/ghc/Parsley/Internal/Common/QueueLike.hs b/src/ghc/Parsley/Internal/Common/QueueLike.hs
--- a/src/ghc/Parsley/Internal/Common/QueueLike.hs
+++ b/src/ghc/Parsley/Internal/Common/QueueLike.hs
@@ -49,6 +49,12 @@
   -}
   dequeue    :: q a -> (a, q a)
   {-|
+  modifies the head of the queue, without removal. Returns the old head
+
+  @since 2.1.0.0
+  -}
+  poke :: (a -> a) -> q a -> (a, q a)
+  {-|
   Adds each of the elements onto the queue, from left-to-right.
 
   @since 1.5.0.0
diff --git a/src/ghc/Parsley/Internal/Common/RangeSet.hs b/src/ghc/Parsley/Internal/Common/RangeSet.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Common/RangeSet.hs
@@ -0,0 +1,817 @@
+{-# LANGUAGE DerivingStrategies, MagicHash, UnboxedTuples, RoleAnnotations, TypeApplications #-}
+{-# OPTIONS_HADDOCK prune #-}
+{-|
+Module      : Parsley.Internal.Common.RangeSet
+Description : Packaging of offsets and positions.
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : experimental
+
+This module contains the implementation of an efficient set for contiguous data. It has a much
+smaller memory footprint than a @Set@, and can result in asymptotically faster operations.
+
+@since 2.1.0.0
+-}
+module Parsley.Internal.Common.RangeSet (
+    RangeSet(..),
+    empty, singleton, null, full, isSingle, extractSingle, size, sizeRanges,
+    member, notMember, findMin, findMax,
+    insert, delete,
+    union, intersection, difference, disjoint, complement,
+    isSubsetOf, isProperSubsetOf,
+    allLess, allMore,
+    elems, unelems, fromRanges, insertRange, fromList,
+    fold,
+    -- Testing
+    valid
+  ) where
+
+import Prelude hiding (null)
+import Control.Applicative (liftA2)
+
+import GHC.Exts (reallyUnsafePtrEquality#, isTrue#)
+
+{-# INLINE ptrEq #-}
+ptrEq :: a -> a -> Bool
+ptrEq x y = isTrue# (reallyUnsafePtrEquality# x y)
+
+{-# INLINE range #-}
+range :: Enum a => a -> a -> [a]
+range l u = [l..u]
+
+{-# INLINE diff #-}
+diff :: Enum a => a -> a -> Size
+diff !l !u = fromEnum u - fromEnum l + 1
+
+type Size = Int
+{-|
+A @Set@ type designed for types that are `Enum` as well as `Ord`. This allows the `RangeSet` to
+compress the data when it is contiguous, reducing memory-footprint and enabling otherwise impractical
+operations like `complement` for `Bounded` types.
+
+@since 2.1.0.0
+-}
+data RangeSet a = Fork {-# UNPACK #-} !Int {-# UNPACK #-} !Size !a !a !(RangeSet a) !(RangeSet a)
+                | Tip
+                deriving stock Show
+type role RangeSet nominal
+
+{-|
+The empty `RangeSet`.
+
+@since 2.1.0.0
+-}
+{-# INLINE empty #-}
+empty :: RangeSet a
+empty = Tip
+
+{-|
+A `RangeSet` containing a single value.
+
+@since 2.1.0.0
+-}
+singleton :: a -> RangeSet a
+singleton x = single 1 x x
+
+{-# INLINE fork #-}
+fork :: Enum a => a -> a -> RangeSet a -> RangeSet a -> RangeSet a
+fork !l !u !lt !rt = forkSz (size lt + size rt + diff l u) l u lt rt
+
+forkSz :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
+forkSz !sz !l !u !lt !rt = Fork (max (height lt) (height rt) + 1) sz l u lt rt
+
+{-# INLINE single #-}
+single :: Size -> a -> a -> RangeSet a
+single !sz !l !u = Fork 1 sz l u Tip Tip
+
+{-|
+Is this set empty?
+
+@since 2.1.0.0
+-}
+null :: RangeSet a -> Bool
+null Tip = True
+null _ = False
+
+{-|
+Is this set full?
+
+@since 2.1.0.0
+-}
+full :: (Eq a, Bounded a) => RangeSet a -> Bool
+full Tip = False
+full (Fork _ _ l u _ _) = l == minBound && maxBound == u
+
+{-|
+Does this set contain a single element?
+
+@since 2.1.0.0
+-}
+isSingle :: RangeSet a -> Bool
+isSingle (Fork _ 1 _ _ _ _) = True
+isSingle _ = False
+
+{-|
+Possibly extract the element contained in the set if it is a singleton set.
+
+@since 2.1.0.0
+-}
+extractSingle :: Eq a => RangeSet a -> Maybe a
+extractSingle (Fork _ _ x y Tip Tip) | x == y = Just x
+extractSingle _                               = Nothing
+
+{-# INLINE height #-}
+height :: RangeSet a -> Int
+height Tip = 0
+height (Fork h _ _ _ _ _) = h
+
+{-|
+Return the number of /elements/ in the set.
+
+@since 2.1.0.0
+-}
+{-# INLINE size #-}
+size :: RangeSet a -> Int
+size Tip = 0
+size (Fork _ sz _ _ _ _) = sz
+
+{-|
+Return the number of /contiguous ranges/ that populate the set.
+
+@since 2.1.0.0
+-}
+sizeRanges :: RangeSet a -> Int
+sizeRanges = fold (\_ _ szl szr -> szl + szr + 1) 0
+
+{-|
+Test whether or not a given value is found within the set.
+
+@since 2.1.0.0
+-}
+{-# INLINEABLE member #-}
+member :: forall a. Ord a => a -> RangeSet a -> Bool
+member !x = go
+  where
+    go (Fork _ _ l u lt rt)
+      | l <= x    = x <= u || go rt
+      | otherwise = go lt
+    go Tip = False
+
+{-|
+Test whether or not a given value is not found within the set.
+
+@since 2.1.0.0
+-}
+{-# INLINEABLE notMember #-}
+notMember :: Ord a => a -> RangeSet a -> Bool
+notMember x = not . member x
+
+{-# INLINE ifeq #-}
+ifeq :: RangeSet a -> RangeSet a -> RangeSet a -> (RangeSet a -> RangeSet a) -> RangeSet a
+ifeq !x !x' y f = if size x == size x' then y else f x'
+
+{-|
+Insert a new element into the set.
+
+@since 2.1.0.0
+-}
+{-# INLINEABLE insert #-}
+insert :: forall a. (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
+insert !x Tip = single 1 x x
+insert x t@(Fork h sz l u lt rt)
+  -- Nothing happens when it's already in range
+  | l <= x, x <= u = t
+  -- If it is adjacent to the lower, it may fuse
+  | x < l, x == pred l = fuseLeft h (sz + 1) x u lt rt                    -- the equality must be guarded by an existence check
+  -- Otherwise, insert and balance for left
+  | x < l = ifeq lt (insert x lt) t $ \lt' -> balance (sz + 1) l u lt' rt -- cannot be biased, because fusion can shrink a tree
+  -- If it is adjacent to the upper range, it may fuse
+  | x == succ u = fuseRight h (sz + 1) l x lt rt                          -- we know x > u since x <= l && not x <= u
+  -- Otherwise, insert and balance for right
+  | otherwise = ifeq rt (insert x rt) t (balance (sz + 1) l u lt)         -- cannot be biased, because fusion can shrink a tree
+  where
+    {-# INLINE fuseLeft #-}
+    fuseLeft !h !sz !x !u Tip !rt = Fork h sz x u lt rt
+    fuseLeft h sz x u lt rt
+      | (# !l, !x', lt' #) <- unsafeMaxDelete lt
+      -- we know there exists an element larger than x'
+      -- if x == x' or x == x' + 1, we fuse
+      -- x >= x' since it is one less than x''s strict upper bound
+      -- x >= x' && (x == x' || x == x' + 1) === x >= x' && x <= x' + 1
+      , x <= succ x' = balanceR sz l u lt' rt
+      | otherwise    = Fork h sz x u lt rt
+    {-# INLINE fuseRight #-}
+    fuseRight !h !sz !l !x !lt Tip = Fork h sz l x lt rt
+    fuseRight h sz l x lt rt
+      | (# !x', !u, rt' #) <- unsafeMinDelete rt
+      -- we know there exists an element smaller than x'
+      -- if x == x' or x == x' - 1, we fuse
+      -- x <= x' since it is one greater than x''s strict lower bound,
+      -- x <= x' && (x == x' || x == x' - 1) === x <= x' && x >= x' - 1
+      , x >= pred x' = balanceL sz l u lt rt'
+      | otherwise    = Fork h sz l x lt rt
+
+{-|
+Remove an element from the set, if it appears.
+
+@since 2.1.0.0
+-}
+{-# INLINEABLE delete #-}
+delete :: (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
+delete !_ Tip = Tip
+delete x t@(Fork h sz l u lt rt) =
+  case compare l x of
+    -- If its the only part of the range, the node is removed
+    EQ | x == u    -> glue (sz - 1) lt rt
+    -- If it's at an extreme, it shrinks the range
+       | otherwise -> Fork h (sz - 1) (succ l) u lt rt
+    LT -> case compare x u of
+    -- If it's at an extreme, it shrinks the range
+       EQ          -> Fork h (sz - 1) l (pred u) lt rt
+    -- Otherwise, if it's still in range, the range undergoes fission
+       LT          -> fission (sz - 1) l x u lt rt
+    -- Otherwise delete and balance for one of the left or right
+       GT          -> ifeq rt (delete x rt) t $ balance (sz - 1) l u lt             -- cannot be biased, because fisson can grow a tree
+    GT             -> ifeq lt (delete x lt) t $ \lt' -> balance (sz - 1) l u lt' rt -- cannot be biased, because fisson can grow a tree
+  where
+    {- Fission breaks a node into two new ranges
+       we'll push the range down into the right arbitrarily
+       To do this, we have to make it a child of the right-tree's left most position. -}
+    {-# INLINE fission #-}
+    fission !sz !l1 !x !u2 !lt !rt =
+      let u1 = pred x
+          l2 = succ x
+          rt' = unsafeInsertL (diff l2 u2) l2 u2 rt
+      in balanceR sz l1 u1 lt rt'
+
+{-|
+Inserts an range at the left-most position in the tree.
+It *must* not overlap with any other range within the tree.
+It *must* be /known/ not to exist within the tree.
+-}
+{-# INLINEABLE unsafeInsertL #-}
+unsafeInsertL :: Size -> a -> a -> RangeSet a -> RangeSet a
+unsafeInsertL !newSz l u Tip = single newSz l u
+unsafeInsertL newSz l u (Fork _ sz l' u' lt rt) = balanceL (sz + newSz) l' u' (unsafeInsertL newSz l u lt) rt
+
+{-|
+Inserts an range at the right-most position in the tree.
+It *must* not overlap with any other range within the tree.
+It *must* be /known/ not to exist within the tree.
+-}
+{-# INLINEABLE unsafeInsertR #-}
+unsafeInsertR :: Size -> a -> a -> RangeSet a -> RangeSet a
+unsafeInsertR !newSz l u Tip = single newSz l u
+unsafeInsertR newSz l u (Fork _ sz l' u' lt rt) = balanceR (sz + newSz) l' u' lt (unsafeInsertR newSz l u rt)
+
+{-|
+This deletes the left-most range of the tree.
+It *must not* be used with an empty tree.
+-}
+{-# INLINEABLE unsafeDeleteL #-}
+unsafeDeleteL :: Size -> RangeSet a -> RangeSet a
+unsafeDeleteL !_ (Fork _ _ _ _ Tip rt) = rt
+unsafeDeleteL szRemoved (Fork _ sz l u lt rt) = balanceR (sz - szRemoved) l u (unsafeDeleteL szRemoved lt) rt
+unsafeDeleteL _ _ = error "unsafeDeleteL called on empty tree"
+
+{-|
+This deletes the right-most range of the tree.
+It *must not* be used with an empty tree.
+-}
+{-{-# INLINEABLE unsafeDeleteR #-}
+unsafeDeleteR :: Int -> RangeSet a -> RangeSet a
+unsafeDeleteR !_ (Fork _ _ _ _ lt Tip) = lt
+unsafeDeleteR szRemoved (Fork _ sz l u lt rt) = balanceL (sz - szRemoved) l u lt (unsafeDeleteR szRemoved rt)
+unsafeDeleteR _ _ = error "unsafeDeleteR called on empty tree"-}
+
+{-|
+Find the minimum value within the set, if one exists.
+
+@since 2.1.0.0
+-}
+{-# INLINE findMin #-}
+findMin :: RangeSet a -> Maybe a
+findMin Tip = Nothing
+findMin t = let (# !m, !_ #) = unsafeMinRange t in Just m
+
+-- | Should /not/ be called with an empty tree!
+{-# INLINEABLE unsafeMinRange #-}
+unsafeMinRange :: RangeSet a -> (# a, a #)
+unsafeMinRange (Fork _ _ l u Tip _) = (# l, u #)
+unsafeMinRange (Fork _ _ _ _ lt _) = unsafeMinRange lt
+unsafeMinRange Tip = error "unsafeMinRange called on empty tree"
+
+{-|
+Find the maximum value within the set, if one exists.
+
+@since 2.1.0.0
+-}
+{-# INLINE findMax #-}
+findMax :: RangeSet a -> Maybe a
+findMax Tip = Nothing
+findMax t = let (# !_, !m #) = unsafeMaxRange t in Just m
+
+-- | Should /not/ be called with an empty tree!
+{-# INLINEABLE unsafeMaxRange #-}
+unsafeMaxRange :: RangeSet a -> (# a, a #)
+unsafeMaxRange (Fork _ _ l u _ Tip) = (# l, u #)
+unsafeMaxRange (Fork _ _ _ _ _ rt) = unsafeMaxRange rt
+unsafeMaxRange Tip = error "unsafeMaxRange called on empty tree"
+
+{-# INLINE unsafeMinDelete #-}
+unsafeMinDelete :: RangeSet a -> (# a, a, RangeSet a #)
+unsafeMinDelete (Fork _ sz l u lt rt) = let (# !ml, !mu, !_, t' #) = go sz l u lt rt in (# ml, mu, t' #)
+  where
+    go !sz !l !u Tip !rt = (# l, u, sz - size rt, rt #)
+    go sz l u (Fork _ lsz ll lu llt lrt) rt =
+      let (# !ml, !mu, !msz, lt' #) = go lsz ll lu llt lrt
+      in (# ml, mu, msz, balanceR (sz - msz) l u lt' rt #)
+unsafeMinDelete Tip = error "unsafeMinDelete called on empty tree"
+
+{-# INLINE unsafeMaxDelete #-}
+unsafeMaxDelete :: RangeSet a -> (# a, a, RangeSet a #)
+unsafeMaxDelete (Fork _ sz l u lt rt) = let (# !ml, !mu, !_, t' #) = go sz l u lt rt in (# ml, mu, t' #)
+  where
+    go !sz !l !u !lt Tip = (# l, u, sz - size lt, lt #)
+    go sz l u lt (Fork _ rsz rl ru rlt rrt) =
+      let (# !ml, !mu, !msz, rt' #) = go rsz rl ru rlt rrt
+      in (# ml, mu, msz, balanceL (sz - msz) l u lt rt' #)
+unsafeMaxDelete Tip = error "unsafeMaxDelete called on empty tree"
+
+{-# INLINABLE balance #-}
+balance :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
+balance !sz !l !u lt rt
+  | height lt > height rt + 1 = balanceL sz l u lt rt
+  | height rt > height lt + 1 = balanceR sz l u lt rt
+  | otherwise = forkSz sz l u lt rt
+
+{-# NOINLINE balanceL #-}
+balanceL :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
+-- PRE: left grew or right shrank, difference in height at most 2 biasing to the left
+balanceL !sz !l1 !u1 lt@(Fork !hlt !szl !l2 !u2 !llt !rlt) !rt
+  -- both sides are equal height or off by one
+  | dltrt <= 1 = forkSz sz l1 u1 lt rt
+  -- The bias is 2 (dltrt == 2)
+  | hllt >= hrlt = rotr sz l1 u1 lt rt
+  | otherwise    = rotr sz l1 u1 (rotl szl l2 u2 llt rlt) rt
+  where
+    !dltrt = hlt - height rt
+    !hllt = height llt
+    !hrlt = height rlt
+-- If the right shrank (or nothing changed), we have to be prepared to handle the Tip case for lt
+balanceL sz l u Tip rt | height rt <= 1 = forkSz sz l u Tip rt
+balanceL _ _ _ Tip _ = error "Right should have shrank, but is still 1 taller than a Tip!"
+
+{-# NOINLINE balanceR #-}
+balanceR :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
+-- PRE: left shrank or right grew, difference in height at most 2 biasing to the right
+balanceR !sz !l1 !u1 !lt rt@(Fork !hrt szr l2 u2 lrt rrt)
+  -- both sides are equal height or off by one
+  | drtlt <= 1 = forkSz sz l1 u1 lt rt
+  -- The bias is 2 (drtlt == 2)
+  | hrrt >= hlrt = rotl sz l1 u1 lt rt
+  | otherwise    = rotl sz l1 u1 lt (rotr szr l2 u2 lrt rrt)
+  where
+    !drtlt = hrt - height lt
+    !hlrt = height lrt
+    !hrrt = height rrt
+-- If the left shrank (or nothing changed), we have to be prepared to handle the Tip case for rt
+balanceR sz l u lt Tip | height lt <= 1 = forkSz sz l u lt Tip
+balanceR _ _ _ _ Tip = error "Left should have shrank, but is still 1 taller than a Tip!"
+
+{-# INLINE rotr #-}
+rotr :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
+rotr !sz !l1 !u1 (Fork _ szl l2 u2 p q) !r = forkSz sz l2 u2 p (forkSz (sz - szl + size q) l1 u1 q r)
+rotr _ _ _ _ _ = error "rotr on Tip"
+
+{-# INLINE rotl #-}
+rotl :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
+rotl !sz !l1 !u1 !p (Fork _ szr l2 u2 q r) = forkSz sz l2 u2 (forkSz (sz - szr + size q) l1 u1 p q) r
+rotl _ _ _ _ _ = error "rotr on Tip"
+
+{-|
+Unions two sets together such that if and only if an element appears in either one of the sets, it
+will appear in the result set.
+
+@since 2.1.0.0
+-}
+{-# INLINABLE union #-}
+union :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
+union t Tip = t
+union Tip t = t
+union t@(Fork _ _ l u lt rt) t' = case split l u t' of
+  (# lt', rt' #)
+    | ltlt' `ptrEq` lt, rtrt' `ptrEq` rt -> t
+    | otherwise                          -> link l u ltlt' rtrt'
+    where !ltlt' = lt `union` lt'
+          !rtrt' = rt `union` rt'
+
+{-|
+Intersects two sets such that an element appears in the result if and only if it is present in both
+of the provided sets.
+
+@since 2.1.0.0
+-}
+{-# INLINABLE intersection #-}
+intersection :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
+intersection Tip _ = Tip
+intersection _ Tip = Tip
+intersection t1@(Fork _ _ l1 u1 lt1 rt1) t2 =
+  case overlap of
+    Tip -> unsafeMerge lt1lt2 rt1rt2
+    Fork 1 sz x y _ _
+      | x == l1, y == u1
+      , lt1lt2 `ptrEq` lt1, rt1rt2 `ptrEq` rt1 -> t1
+      | otherwise -> unsafeLink sz x y lt1lt2 rt1rt2
+    Fork _ sz x y lt' rt' -> unsafeLink (sz - size lt' - size rt') x y (unsafeMerge lt1lt2 lt') (unsafeMerge rt' rt1rt2)
+  where
+    (# !lt2, !overlap, !rt2 #) = splitOverlap l1 u1 t2
+    !lt1lt2 = intersection lt1 lt2
+    !rt1rt2 = intersection rt1 rt2
+
+{-|
+Do two sets have no elements in common?
+
+@since 2.1.0.0
+-}
+{-# INLINE disjoint #-}
+disjoint :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> Bool
+disjoint Tip _ = True
+disjoint _ Tip = True
+disjoint (Fork _ _ l u lt rt) t = case splitOverlap l u t of
+  (# lt', Tip, rt' #) -> disjoint lt lt' && disjoint rt rt'
+  _                   -> False
+
+{-|
+Removes all elements from the first set that are found in the second set.
+
+@since 2.1.0.0
+-}
+{-# INLINEABLE difference #-}
+difference :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
+difference Tip _ = Tip
+difference t Tip = t
+difference t (Fork _ _ l u lt rt) = case split l u t of
+  (# lt', rt' #)
+    | size lt'lt + size rt'rt == size t -> t
+    | otherwise -> unsafeMerge lt'lt rt'rt
+    where
+      !lt'lt = difference lt' lt
+      !rt'rt = difference rt' rt
+
+{-# INLINEABLE unsafeInsertLAdj #-}
+unsafeInsertLAdj :: (Enum a, Eq a) => Size -> a -> a -> RangeSet a -> RangeSet a
+unsafeInsertLAdj !newSz !l !u !t = case unsafeMinRange t of
+  (# !l', _ #) | l' == succ u -> unsafeFuseL newSz l t
+               | otherwise    -> unsafeInsertL newSz l u t
+
+{-# INLINEABLE unsafeInsertRAdj #-}
+unsafeInsertRAdj :: (Enum a, Eq a) => Size -> a -> a -> RangeSet a -> RangeSet a
+unsafeInsertRAdj !newSz !l !u !t = case unsafeMaxRange t of
+  (# _, !u' #) | u' == pred l -> unsafeFuseR newSz u t
+               | otherwise    -> unsafeInsertR newSz l u t
+
+{-# INLINEABLE unsafeFuseL #-}
+unsafeFuseL :: Size -> a -> RangeSet a -> RangeSet a
+unsafeFuseL !newSz !l' (Fork h sz l u lt rt) = case lt of
+  Tip -> Fork h (newSz + sz) l' u Tip rt
+  lt  -> Fork h (newSz + sz) l u (unsafeFuseL newSz l' lt) rt
+unsafeFuseL _ _ Tip = error "unsafeFuseL called on Tip"
+
+{-# INLINEABLE unsafeFuseR #-}
+unsafeFuseR :: Size -> a -> RangeSet a -> RangeSet a
+unsafeFuseR !newSz !u' (Fork h sz l u lt rt) = case rt of
+  Tip -> Fork h (newSz + sz) l u' lt Tip
+  rt  -> Fork h (newSz + sz) l u lt (unsafeFuseR newSz u' rt)
+unsafeFuseR _ _ Tip = error "unsafeFuseR called on Tip"
+
+{-# INLINABLE link #-}
+link :: (Enum a, Eq a) => a -> a -> RangeSet a -> RangeSet a -> RangeSet a
+link !l !u Tip Tip = single (diff l u) l u
+link l u Tip rt = unsafeInsertLAdj (diff l u) l u rt
+link l u lt Tip = unsafeInsertRAdj (diff l u) l u lt
+link l u lt rt = unsafeLink (diff l' u') l' u' lt'' rt''
+  where
+    -- we have to check for fusion up front
+    (# !lmaxl, !lmaxu, lt' #) = unsafeMaxDelete lt
+    (# !rminl, !rminu, rt' #) = unsafeMinDelete rt
+
+    (# !l', !lt'' #) | lmaxu == pred l = (# lmaxl, lt' #)
+                     | otherwise       = (# l, lt #)
+
+    (# !u', !rt'' #) | rminl == succ u = (# rminu, rt' #)
+                     | otherwise       = (# u, rt #)
+
+{-# INLINEABLE unsafeLink #-}
+unsafeLink :: Size -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
+unsafeLink !newSz !l !u Tip rt = unsafeInsertL newSz l u rt
+unsafeLink newSz l u lt Tip = unsafeInsertR newSz l u lt
+unsafeLink newSz l u lt@(Fork hl szl ll lu llt lrt) rt@(Fork hr szr rl ru rlt rrt)
+  | hl < hr + 1 = balanceL (newSz + szl + szr) rl ru (unsafeLink newSz l u lt rlt) rrt
+  | hr < hl + 1 = balanceR (newSz + szl + szr) ll lu llt (unsafeLink newSz l u lrt rt)
+  | otherwise   = forkSz (newSz + szl + szr) l u lt rt
+
+-- This version checks for fusion between the two trees to be merged
+{-{-# INLINEABLE merge #-}
+merge :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
+merge Tip Tip = Tip
+merge t Tip = t
+merge Tip t = t
+merge t1 t2 =
+  let (# !_, !u1 #) = unsafeMaxRange t1
+      (# !l2, !u2, t2' #) = unsafeMinDelete t2
+  in if succ u1 == l2 then unsafeMerge (unsafeFuseR (diff l2 u2) u2 t1) t2'
+     else unsafeMerge t1 t2-}
+
+-- This assumes that the trees are /totally/ disjoint
+{-# INLINEABLE unsafeMerge #-}
+unsafeMerge :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> RangeSet a
+unsafeMerge Tip rt = rt
+unsafeMerge lt Tip = lt
+unsafeMerge lt@(Fork hl szl ll lu llt lrt) rt@(Fork hr szr rl ru rlt rrt)
+  | hl < hr + 1 = balanceL (szl + szr) rl ru (unsafeMerge lt rlt) rrt
+  | hr < hl + 1 = balanceR (szl + szr) ll lu llt (unsafeMerge lrt rt)
+  | otherwise   = glue (szl + szr) lt rt
+
+-- Trees must be balanced with respect to eachother, since we pull from the tallest, no balancing is required
+{-# INLINEABLE glue #-}
+glue :: Size -> RangeSet a -> RangeSet a -> RangeSet a
+glue !_ Tip rt = rt
+glue _ lt Tip  = lt
+glue sz lt rt
+  | height lt < height rt = let (# !l, !u, !rt' #) = unsafeMinDelete rt in forkSz sz l u lt rt'
+  | otherwise = let (# !l, !u, !lt' #) = unsafeMaxDelete lt in forkSz sz l u lt' rt
+
+{-|
+Filters a set by removing all values greater than or equal to the given value.
+
+@since 2.1.0.0
+-}
+{-# INLINEABLE allLess #-}
+allLess :: (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
+allLess !_ Tip = Tip
+allLess x (Fork _ _ l u lt rt) = unsafeAllLess x l u lt rt
+
+{-|
+Filters a set by removing all values less than or equal to the given value.
+
+@since 2.1.0.0
+-}
+{-# INLINEABLE allMore #-}
+allMore :: (Enum a, Ord a) => a -> RangeSet a -> RangeSet a
+allMore !_ Tip = Tip
+allMore x (Fork _ _ l u lt rt) = unsafeAllMore x l u lt rt
+
+{-# INLINEABLE unsafeAllLess #-}
+unsafeAllLess :: (Enum a, Ord a) => a -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
+unsafeAllLess !x !l !u !lt !rt = case compare x l of
+  EQ          -> lt
+  LT          -> allLess x lt
+  GT | x <= u -> unsafeInsertR (diff l (pred x)) l (pred x) (allLess x lt)
+  GT          -> link l u lt (allLess x rt)
+
+{-# INLINEABLE unsafeAllMore #-}
+unsafeAllMore :: (Enum a, Ord a) => a -> a -> a -> RangeSet a -> RangeSet a -> RangeSet a
+unsafeAllMore !x !l !u !lt !rt = case compare u x of
+  EQ          -> rt
+  LT          -> allMore x rt
+  GT | l <= x -> unsafeInsertL (diff (succ x) u) (succ x) u (allMore x rt)
+  GT          -> link l u (allMore x lt) rt
+
+{-# INLINEABLE split #-}
+split :: (Enum a, Ord a) => a -> a -> RangeSet a -> (# RangeSet a, RangeSet a #)
+split !_ !_ Tip = (# Tip, Tip #)
+split l u (Fork _ _ l' u' lt rt)
+  | u < l' = let (# !llt, !lgt #) = split l u lt in (# llt, link l' u' lgt rt #)
+  | u' < l = let (# !rlt, !rgt #) = split l u rt in (# link l' u' lt rlt, rgt #)
+  -- The ranges overlap in some way
+  | otherwise = let !lt' = case compare l' l of
+                      EQ -> lt
+                      LT -> unsafeInsertR (diff l' (pred l)) l' (pred l) lt
+                      GT -> allLess l lt
+                    !rt' = case compare u u' of
+                      EQ -> rt
+                      LT -> unsafeInsertL (diff (succ u) u') (succ u) u' rt
+                      GT -> allMore u rt
+                in (# lt', rt' #)
+
+{-# INLINE splitOverlap #-}
+splitOverlap :: (Enum a, Ord a) => a -> a -> RangeSet a -> (# RangeSet a, RangeSet a, RangeSet a #)
+splitOverlap !l !u !t = let (# lt', rt' #) = split l u t in (# lt', overlapping l u t, rt' #)
+
+{-# INLINABLE overlapping #-}
+overlapping :: (Ord a, Enum a) => a -> a -> RangeSet a -> RangeSet a
+overlapping !_ !_ Tip = Tip
+overlapping x y (Fork _ sz l u lt rt) =
+  case compare l x of
+    -- range is outside to the left
+    GT -> let !lt' = overlapping x (min (pred l) y) lt
+          in case cmpY of
+               -- range is totally outside
+               GT -> unsafeLink nodeSz l u lt' rt'
+               EQ -> unsafeInsertR nodeSz l u lt'
+               LT | y >= l -> unsafeInsertR (diff l y) l y lt'
+               LT          -> lt'
+    -- range is inside on the left
+    EQ -> case cmpY of
+      -- range is outside on the right
+      GT -> unsafeInsertL nodeSz l u rt'
+      LT -> t'
+      EQ -> single nodeSz l u
+    LT -> case cmpY of
+      -- range is outside on the right
+      GT | x <= u -> unsafeInsertL (diff x u) x u rt'
+      GT          -> rt'
+      _           -> t'
+  where
+    !cmpY = compare y u
+    !nodeSz = sz - size lt - size rt
+    -- leave lazy!
+    rt' = overlapping (max (succ u) x) y rt
+    t' = single (diff x y) x y
+
+data StrictMaybe a = SJust !a | SNothing
+
+{-|
+Inverts a set: every value which was an element is no longer an element, and every value that
+was not an element now is. This is only possible on `Bounded` types.
+
+@since 2.1.0.0
+-}
+{-# INLINEABLE complement #-}
+complement :: forall a. (Bounded a, Enum a, Eq a) => RangeSet a -> RangeSet a
+complement Tip = single (diff @a minBound maxBound) minBound maxBound
+complement t | full t = Tip
+complement t@Fork{} = t'''
+  where
+    (# !min, !min' #) = unsafeMinRange t
+
+    -- The complement of a tree is at most 1 larger or smaller than the original
+    -- if both min and max are minBound and maxBound, it will shrink
+    -- if neither min or max are minBound or maxBound, it will grow
+    -- otherwise, the tree will not change size
+    -- The insert or shrink will happen at an extremity, and rebalance need only occur along the spine
+    (# !t', !initial #) | min == minBound = (# unsafeDeleteL (diff minBound min') t, succ min' #) -- this is safe, because we've checked for the maxSet case already
+                        | otherwise       = (# t , minBound #)
+    (# !t'', !final #) = go initial t'
+    t''' | SJust x <- final = unsafeInsertR (diff x maxBound) x maxBound t''
+         | otherwise        = t''
+
+    safeSucc !x
+      | x == maxBound = SNothing
+      | otherwise     = SJust (succ x)
+
+    -- the argument l should not be altered, it /must/ be the correct lower bound
+    -- the return /must/ be the next correct lower bound
+    go :: a -> RangeSet a -> (# RangeSet a, StrictMaybe a #)
+    go !l Tip = (# Tip, SJust l #)
+    go l (Fork _ _ u l'' lt Tip) =
+      let (# !lt', SJust l' #) = go l lt
+          !t' = fork l' (pred u) lt' Tip
+      in  (# t', safeSucc l'' #)
+    go l (Fork _ _ u l'' lt rt) =
+      let (# !lt', SJust l' #) = go l lt
+          (# !rt', !l''' #) = go (succ l'') rt -- this is safe, because we know the right-tree is not Tip
+          !t' = fork l' (pred u) lt' rt'
+      in  (# t', l''' #)
+
+{-|
+Tests if all the element of the first set appear in the second, but also that the first and second
+sets are not equal.
+
+@since 2.1.0.0
+-}
+{-# INLINE isProperSubsetOf #-}
+isProperSubsetOf :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> Bool
+isProperSubsetOf t1 t2 = size t1 < size t2 && uncheckedSubsetOf t1 t2
+
+{-|
+Tests if all the elements of the first set appear in the second.
+
+@since 2.1.0.0
+-}
+{-# INLINEABLE isSubsetOf #-}
+isSubsetOf :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> Bool
+isSubsetOf t1 t2 = size t1 <= size t2 && uncheckedSubsetOf t1 t2
+
+uncheckedSubsetOf :: (Enum a, Ord a) => RangeSet a -> RangeSet a -> Bool
+uncheckedSubsetOf Tip _ = True
+uncheckedSubsetOf _ Tip = False
+uncheckedSubsetOf (Fork _ _ l u lt rt) t = case splitOverlap l u t of
+  (# lt', Fork 1 _ x y _ _, rt' #) ->
+       x == l && y == u
+    && size lt <= size lt' && size rt <= size rt'
+    && uncheckedSubsetOf lt lt' && uncheckedSubsetOf rt rt'
+  _                              -> False
+
+{-|
+Returns all the elements found within the set.
+
+@since 2.1.0.0
+-}
+{-# INLINE elems #-}
+elems :: Enum a => RangeSet a -> [a]
+elems t = fold (\l u lt rt -> lt . (range l u ++) . rt) id t []
+
+{-|
+Returns all the values that are not found within the set.
+
+@since 2.1.0.0
+-}
+{-# INLINEABLE unelems #-}
+unelems :: (Bounded a, Enum a, Eq a) => RangeSet a -> [a]
+unelems t = fold fork tip t minBound maxBound []
+  where
+    fork l' u' lt rt l u = dxs . dys
+      where
+        dxs | l' == l   = id
+            | otherwise = lt l (pred l')
+        dys | u == u'   = id
+            | otherwise = rt (succ u') u
+    tip l u = (range l u ++)
+
+{-|
+Constructs a `RangeSet` given a list of ranges.
+
+@since 2.1.0.0
+-}
+-- TODO: This could be better?
+{-# INLINEABLE fromRanges #-}
+fromRanges :: (Enum a, Ord a) => [(a, a)] -> RangeSet a
+fromRanges [(x, y)] = single (diff x y) x y
+fromRanges rs = foldr (uncurry insertRange) empty rs
+
+{-|
+Inserts a range into a `RangeSet`.
+
+@since 2.1.0.0
+-}
+-- This could be improved, but is OK
+{-# INLINE insertRange #-}
+insertRange :: (Enum a, Ord a) => a -> a -> RangeSet a -> RangeSet a
+insertRange l u t = let (# lt, rt #) = split l u t in link l u lt rt
+
+{-|
+Builds a `RangeSet` from a given list of elements.
+
+@since 2.1.0.0
+-}
+-- TODO: This can be made better if we account for orderedness
+{-# INLINE fromList #-}
+fromList :: (Enum a, Ord a) => [a] -> RangeSet a
+fromList = foldr insert empty
+
+{-|
+Folds a range set.
+
+@since 2.1.0.0
+-}
+{-# INLINEABLE fold #-}
+fold :: (a -> a -> b -> b -> b) -- ^ Function that combines the lower and upper values (inclusive) for a range with the folded left- and right-subtrees.
+     -> b                       -- ^ Value to be substituted at the leaves.
+     -> RangeSet a
+     -> b
+fold _ tip Tip = tip
+fold fork tip (Fork _ _ l u lt rt) = fork l u (fold fork tip lt) (fold fork tip rt)
+
+-- Instances
+instance Eq a => Eq (RangeSet a) where
+  t1 == t2 = size t1 == size t2 && ranges t1 == ranges t2
+    where
+      {-# INLINE ranges #-}
+      ranges :: RangeSet a -> [(a, a)]
+      ranges t = fold (\l u lt rt -> lt . ((l, u) :) . rt) id t []
+
+-- Testing Utilities
+valid :: (Ord a, Enum a) => RangeSet a -> Bool
+valid t = balanced t && wellSized t && orderedNonOverlappingAndCompressed True t
+
+balanced :: RangeSet a -> Bool
+balanced Tip = True
+balanced (Fork h _ _ _ lt rt) =
+  h == max (height lt) (height rt) + 1 &&
+  height rt < h &&
+  abs (height lt - height rt) <= 1 &&
+  balanced lt &&
+  balanced rt
+
+wellSized :: Enum a => RangeSet a -> Bool
+wellSized Tip = True
+wellSized (Fork _ sz l u lt rt) = sz == size lt + size rt + diff l u && wellSized lt && wellSized rt
+
+orderedNonOverlappingAndCompressed :: (Enum a, Ord a) => Bool -> RangeSet a -> Bool
+orderedNonOverlappingAndCompressed checkCompressed = bounded (const True) (const True)
+  where
+    bounded _ _ Tip = True
+    bounded lo hi (Fork _ _ l u lt rt) =
+      l <= u &&
+      lo l &&
+      hi u &&
+      bounded lo (boundAbove l) lt &&
+      bounded (boundBelow u) hi rt
+
+    boundAbove l | checkCompressed = liftA2 (&&) (< l) (< pred l)
+                 | otherwise = (< l)
+
+    boundBelow u | checkCompressed = liftA2 (&&) (> u) (> succ u)
+                 | otherwise = (> u)
diff --git a/src/ghc/Parsley/Internal/Common/RewindQueue.hs b/src/ghc/Parsley/Internal/Common/RewindQueue.hs
--- a/src/ghc/Parsley/Internal/Common/RewindQueue.hs
+++ b/src/ghc/Parsley/Internal/Common/RewindQueue.hs
@@ -13,9 +13,9 @@
 module Parsley.Internal.Common.RewindQueue (module RewindQueue) where
 
 import Parsley.Internal.Common.RewindQueue.Impl as RewindQueue (
-    RewindQueue, empty, enqueue, dequeue, rewind, null, size, foldr, enqueueAll
+    RewindQueue, empty, enqueue, dequeue, rewind, null, size, foldr, enqueueAll, poke
   )
-import Parsley.Internal.Common.QueueLike  (QueueLike(empty, null, size, enqueue, dequeue, enqueueAll))
+import Parsley.Internal.Common.QueueLike  (QueueLike(empty, null, size, enqueue, dequeue, enqueueAll, poke))
 
 instance QueueLike RewindQueue where
   empty      = RewindQueue.empty
@@ -24,3 +24,4 @@
   enqueue    = RewindQueue.enqueue
   dequeue    = RewindQueue.dequeue
   enqueueAll = RewindQueue.enqueueAll
+  poke       = RewindQueue.poke
diff --git a/src/ghc/Parsley/Internal/Common/RewindQueue/Impl.hs b/src/ghc/Parsley/Internal/Common/RewindQueue/Impl.hs
--- a/src/ghc/Parsley/Internal/Common/RewindQueue/Impl.hs
+++ b/src/ghc/Parsley/Internal/Common/RewindQueue/Impl.hs
@@ -18,7 +18,7 @@
 import Parsley.Internal.Common.Queue.Impl as Queue (Queue(..), toList)
 
 import qualified Parsley.Internal.Common.Queue.Impl as Queue (
-    empty, enqueue, enqueueAll, dequeue, null, size, foldr
+    empty, enqueue, enqueueAll, dequeue, null, size, foldr, poke
   )
 
 {-|
@@ -68,6 +68,14 @@
 dequeue RewindQueue{..} =
   let (x, queue') = Queue.dequeue queue
   in (x, RewindQueue { queue = queue', undo = x : undo, undosz = undosz + 1 })
+
+{-|
+modifies the head of the queue, without removal. Returns the old head
+
+@since 2.1.0.0
+-}
+poke :: (a -> a) -> RewindQueue a -> (a, RewindQueue a)
+poke f q = let (x, queue') = Queue.poke f (queue q) in (x, q { queue = queue' })
 
 {-|
 Undoes the last \(n\) `dequeue` operations but /only/ if there are that many
diff --git a/src/ghc/Parsley/Internal/Core.hs b/src/ghc/Parsley/Internal/Core.hs
--- a/src/ghc/Parsley/Internal/Core.hs
+++ b/src/ghc/Parsley/Internal/Core.hs
@@ -9,10 +9,12 @@
 -}
 module Parsley.Internal.Core (
     Parser,
+    module Parsley.Internal.Core.CharPred,
     module Parsley.Internal.Core.Defunc,
     module Parsley.Internal.Core.InputTypes
   ) where
 
+import Parsley.Internal.Core.CharPred (CharPred)
 import Parsley.Internal.Core.Defunc hiding (lamTerm)
 import Parsley.Internal.Core.InputTypes
 import Parsley.Internal.Core.Primitives (Parser)
diff --git a/src/ghc/Parsley/Internal/Core/CharPred.hs b/src/ghc/Parsley/Internal/Core/CharPred.hs
new file mode 100644
--- /dev/null
+++ b/src/ghc/Parsley/Internal/Core/CharPred.hs
@@ -0,0 +1,201 @@
+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
+{-|
+Module      : Parsley.Internal.Core.CharPred
+Description : Packaging of offsets and positions.
+License     : BSD-3-Clause
+Maintainer  : Jamie Willis
+Stability   : experimental
+
+This module contains `CharPred`, a specialised defunctionalising for @Char -> Bool@ functions.
+This can be used to efficiently query for character class membership.
+
+@since 2.1.0.0
+-}
+module Parsley.Internal.Core.CharPred (
+    CharPred(..), pattern Item, pattern Specific,
+    apply, andPred, orPred, diffPred, optimisePredGiven,
+    members, nonMembers,
+    lamTerm
+  ) where
+
+import Prelude hiding (null)
+
+import Parsley.Internal.Common.RangeSet (RangeSet, elems, unelems, fromRanges, full, member, fold, null, union, extractSingle, singleton, intersection, difference, isSubsetOf, sizeRanges)
+import Parsley.Internal.Core.Lam        (Lam(Abs, App, Var, T, F, If))
+
+{-|
+Represents @Char -> Bool@ functions, potentially in a more inspectable way.
+
+@since 2.1.0.0
+-}
+data CharPred where
+  -- | This is a raw user-defined predicate, with little inspectability other than membership.
+  UserPred :: (Char -> Bool) -> Lam (Char -> Bool) -> CharPred
+  -- | This accounts for a character-class, implemented using a `RangeSet` for efficient querying and space.
+  Ranges :: RangeSet Char -> CharPred
+
+{-|
+Represents @const True@.
+
+@since 2.1.0.0
+-}
+pattern Item :: CharPred
+pattern Item <- Ranges (full -> True)
+  where Item = Ranges (fromRanges [(minBound, maxBound)])
+
+{-|
+Represents @(== c)@ for some specific @c@.
+
+@since 2.1.0.0
+-}
+pattern Specific :: Char -> CharPred
+pattern Specific c <- Ranges (extractSingle -> Just c)
+  where Specific c = Ranges (singleton c)
+
+{-|
+Tests whether a given character falls within the predicate.
+
+@since 2.1.0.0
+-}
+apply :: CharPred -> Char -> Bool
+apply (UserPred f _) c = f c
+apply (Ranges rngs) c = member c rngs
+
+{-|
+Merges two predicates by creating one which only returns true when a character
+is in both original predicates.
+
+@since 2.1.0.0
+-}
+andPred :: CharPred -> CharPred -> CharPred
+andPred (UserPred f lf) p = UserPred (\c -> f c && apply p c) (Abs $ \c -> andLam (App lf c) (App (lamTerm p) c))
+andPred p (UserPred f lf) = UserPred (\c -> apply p c && f c) (Abs $ \c -> andLam (App (lamTerm p) c) (App lf c))
+andPred (Ranges rngs1) (Ranges rngs2) = Ranges (rngs1 `intersection` rngs2)
+
+{-|
+Occasionally, characters can pass through a predicate only to pass through another at a later point.
+This given information can be used to optimise the new predicate the character is fed through.
+
+This works as follows:
+  * If the given knowledge is a subset of the new predicate, then we /know/ that any character check
+    will have passed, because it already passed a stricter check. The predicate can, therefore, be
+    optimised to `Item`.
+  * Otherwise, the character can only pass through both predicates if it can pass through their
+    intersection. If the intersection is smaller (in terms of the number of checks required to
+    establish membership), then it should be used as it generates smaller code.
+  * If neither of the above conditions are true, then the original predicate remains the most
+    efficient for future tests.
+
+@since 2.1.0.0
+-}
+optimisePredGiven :: CharPred -- ^ A predicate to be optimised with previous given knowledge.
+                  -> CharPred -- ^ A predicate that is known to already be true.
+                  -> CharPred
+optimisePredGiven (Ranges pred) (Ranges given)
+  | isSubsetOf given pred = Item
+  | sizeRanges inter <= sizeRanges pred = Ranges inter
+  | otherwise = Ranges pred
+  where
+    inter = intersection given pred
+optimisePredGiven p _ = p
+
+{-|
+Merges two predicates by creating one which only returns true when a character
+is in either of the original predicates.
+
+@since 2.1.0.0
+-}
+orPred :: CharPred -> CharPred -> CharPred
+orPred (UserPred f lf) p = UserPred (\c -> f c || apply p c) (Abs $ \c -> orLam (App lf c) (App (lamTerm p) c))
+orPred p (UserPred f lf) = UserPred (\c -> apply p c || f c) (Abs $ \c -> orLam (App (lamTerm p) c) (App lf c))
+orPred (Ranges rngs1) (Ranges rngs2) = Ranges (rngs1 `union` rngs2)
+
+{-|
+Merges two predicates by creating one which only returns true when a character
+is in the first but not the second predicate.
+
+@since 2.1.0.0
+-}
+diffPred :: CharPred -> CharPred -> CharPred
+diffPred (UserPred f lf) p = UserPred (\c -> f c && not (apply p c)) (Abs $ \c -> andLam (App lf c) (notLam (App (lamTerm p) c)))
+diffPred p (UserPred f lf) = UserPred (\c -> apply p c && not (f c)) (Abs $ \c -> andLam (App (lamTerm p) c) (notLam (App lf c)))
+diffPred (Ranges rngs1) (Ranges rngs2) = Ranges (rngs1 `difference` rngs2)
+
+{-|
+Given a predicate, returns the full range of characters it returns @True@ for.
+
+@since 2.1.0.0
+-}
+members :: CharPred -> [Char]
+members (UserPred f _) = filter f [minBound..maxBound]
+members (Ranges rngs)  = elems rngs
+
+{-|
+Given a predicate, returns the full range of characters it returns @False@ for.
+
+@since 2.1.0.0
+-}
+nonMembers :: CharPred -> [Char]
+nonMembers (UserPred f _)      = filter (not . f) [minBound..maxBound]
+nonMembers (Ranges rngs)       = unelems rngs
+
+{-|
+Converts this predicate into a `Lam` term represention. This representation can
+be optimised.
+
+@since 2.1.0.0
+-}
+lamTerm :: CharPred -> Lam (Char -> Bool)
+lamTerm (UserPred _ t) = t
+lamTerm Item = Abs (const T)
+lamTerm (Ranges (null -> True)) = Abs (const F)
+lamTerm (Ranges rngs) =
+  Abs $ \c ->
+    fold (conv c) F rngs
+  where
+    conv c l u lb rb
+    --  | l == u = eq c (Var True [||l||]) `or` (lb `or` rb)
+    --  | otherwise = (lte (Var True [||l||]) c `and` lte c (Var True [||u||])) `or` (lb `or` rb)
+      | l == u        = eq c (Var True [||l||]) `or` if' (lt c (Var True [||l||])) lb rb
+      -- the left can be omitted here
+      | l == minBound = lte c (Var True [||u||]) `or` rb
+      -- the right can be omitted here
+      | u == maxBound = lte (Var True [||l||]) c `or` lb
+      | otherwise     = if' (lte (Var True [||l||]) c) (lte c (Var True [||u||]) `or` rb) lb
+
+    or = orLam
+    and = andLam
+    lte :: Lam Char -> Lam Char -> Lam Bool
+    lte = App . App (Var True [||(<=)||])
+    lt :: Lam Char -> Lam Char -> Lam Bool
+    lt = App . App (Var True [||(<)||])
+    eq :: Lam Char -> Lam Char -> Lam Bool
+    eq = App . App (Var True [||(==)||])
+    if' x y F = and x y
+    if' c x y = If c x y
+
+instance Show CharPred where
+  show (UserPred _ f) = show f
+  show Item = "const True"
+  show (Specific c) = concat ["(== ", show c, ")"]
+  show (Ranges rngs) = "elem " ++ show rngs
+
+
+andLam :: Lam Bool -> Lam Bool -> Lam Bool
+andLam T y = y
+andLam x T = x
+andLam F _ = F
+andLam _ F = F
+andLam x y = App (App (Var True [||(&&)||]) x) y
+
+orLam :: Lam Bool -> Lam Bool -> Lam Bool
+orLam T _ = T
+orLam _ T = T
+orLam F y = y
+orLam y F = y
+orLam x y = App (App (Var True [||(||)||]) x) y
+
+notLam :: Lam Bool -> Lam Bool
+notLam T = F
+notLam F = T
+notLam x = App (Var True [||not||]) x
diff --git a/src/ghc/Parsley/Internal/Core/CombinatorAST.hs b/src/ghc/Parsley/Internal/Core/CombinatorAST.hs
--- a/src/ghc/Parsley/Internal/Core/CombinatorAST.hs
+++ b/src/ghc/Parsley/Internal/Core/CombinatorAST.hs
@@ -4,6 +4,7 @@
 import Data.Kind                         (Type)
 import Parsley.Internal.Common           (IFunctor(..), Fix, Const1(..), cata, intercalateDiff, (:+:))
 import Parsley.Internal.Core.Identifiers (MVar, ΣVar)
+import Parsley.Internal.Core.CharPred    (CharPred)
 import Parsley.Internal.Core.Defunc      (Defunc)
 
 {-|
@@ -16,7 +17,7 @@
 -- Core datatype
 data Combinator (k :: Type -> Type) (a :: Type) where
   Pure           :: Defunc a -> Combinator k a
-  Satisfy        :: Defunc (Char -> Bool) -> Combinator k Char
+  Satisfy        :: CharPred -> 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
diff --git a/src/ghc/Parsley/Internal/Core/Defunc.hs b/src/ghc/Parsley/Internal/Core/Defunc.hs
--- a/src/ghc/Parsley/Internal/Core/Defunc.hs
+++ b/src/ghc/Parsley/Internal/Core/Defunc.hs
@@ -14,15 +14,18 @@
 module Parsley.Internal.Core.Defunc (
     Defunc(..),
     pattern COMPOSE_H, pattern FLIP_H, pattern FLIP_CONST, pattern UNIT,
-    lamTerm
+    lamTerm, charPred
   ) where
 
-import Data.List                     (intercalate)
-import Data.Typeable                 (Typeable, (:~:)(Refl), eqT)
-import Language.Haskell.TH.Syntax    (Lift(..))
-import Parsley.Internal.Common.Utils (WQ(..), Code, Quapplicative(..))
-import Parsley.Internal.Core.Lam     (normaliseGen, Lam(..))
+import Data.Typeable                    (Typeable, (:~:)(Refl), eqT)
+import Language.Haskell.TH.Syntax       (Lift(..))
+import Parsley.Internal.Common.RangeSet (fromRanges, empty, complement)
+import Parsley.Internal.Common.Utils    (WQ(..), Code, Quapplicative(..))
+import Parsley.Internal.Core.CharPred   (CharPred(..), pattern Item, pattern Specific)
+import Parsley.Internal.Core.Lam        (normaliseGen, Lam(..))
 
+import qualified Parsley.Internal.Core.CharPred as CharPred (lamTerm)
+
 {-|
 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
@@ -159,22 +162,26 @@
 lamTerm EMPTY = Var True [||[]||]
 lamTerm CONST = Abs (Abs . const)
 lamTerm (BLACK x) = Var False (_code x)
-lamTerm (RANGES incl []) = Abs (const (if incl then F else T))
-lamTerm (RANGES incl [(l, u)]) | l == minBound, u == maxBound = Abs (const (if incl then T else F))
-lamTerm (RANGES incl rngs) =
-  Abs $ \c ->
-    App (if incl then Abs id else Var True [||not||])
-        (foldr1 (App . App (Var True [||(||)||]))
-          (map (\(l, u) ->
-            if l == u then App (App (Var True [||(==)||]) c) (Var True [||l||])
-                      else App (App (Var True [||(&&)||])
-                               (App (App (Var True [||(<=)||]) (Var True [||l||])) c))
-                               (App (App (Var True [||(<=)||]) c) (Var True [||u||])))
-           rngs))
+lamTerm rngs@(RANGES _ _) = CharPred.lamTerm (charPred rngs)
 lamTerm (LAM_S f) = Abs (adaptLam f)
 lamTerm (IF_S c t e) = If (lamTerm c) (lamTerm t) (lamTerm e)
 lamTerm (LET_S x f) = Let (lamTerm x) (adaptLam f)
 
+{-|
+Converts a `Defunc` value into an equivalent `CharPred` value.
+
+@since 2.1.0.0
+-}
+charPred :: Defunc (Char -> Bool) -> CharPred
+charPred (EQ_H (LIFTED c)) = Specific c
+charPred (RANGES False []) = Item
+charPred (RANGES True [(l, u)]) | l == minBound, u == maxBound = Item
+charPred (RANGES True cs) = Ranges (fromRanges cs)
+charPred (RANGES False cs) = Ranges (complement (fromRanges cs))
+charPred (APP_H CONST (LIFTED True)) = Item
+charPred (APP_H CONST (LIFTED False)) = Ranges empty
+charPred p = UserPred (_val p) (lamTerm p)
+
 adaptLam :: (Defunc a -> Defunc b) -> (Lam a -> Lam b)
 adaptLam f = lamTerm . f . defuncTerm
   where
@@ -204,5 +211,5 @@
   show CONST = "const"
   show (IF_S c b e) = concat ["(if ", show c, " then ", show b, " else ", show e, ")"]
   show (LAM_S _) = "f"
-  show (RANGES incl rngs) = concat [if incl then "not " else "", "elem (", intercalate " ++ " (map (\(l, u) -> concat ["[", show l, "..", show u, "]"]) rngs), ")"]
+  show p@(RANGES{}) = show (charPred p)
   show _ = "x"
diff --git a/src/ghc/Parsley/Internal/Core/Primitives.hs b/src/ghc/Parsley/Internal/Core/Primitives.hs
--- a/src/ghc/Parsley/Internal/Core/Primitives.hs
+++ b/src/ghc/Parsley/Internal/Core/Primitives.hs
@@ -7,7 +7,7 @@
 
 import Prelude hiding                      (pure, (<*>))
 import Parsley.Internal.Core.CombinatorAST (Combinator(..), ScopeRegister(..), Reg(..), Parser(..), PosSelector(..))
-import Parsley.Internal.Core.Defunc        (Defunc)
+import Parsley.Internal.Core.Defunc        (Defunc, charPred)
 
 import Parsley.Internal.Common.Indexed     (Fix(In), (:+:)(..))
 
@@ -18,7 +18,7 @@
 
 {-# INLINE satisfy #-}
 satisfy :: Defunc (Char -> Bool) -> Parser Char
-satisfy = Parser . In . L . Satisfy
+satisfy = Parser . In . L . Satisfy . charPred
 
 {-# INLINE conditional #-}
 conditional :: [(Defunc (a -> Bool), Parser b)] -> Parser a -> Parser b -> Parser b
diff --git a/test/CommonTest.hs b/test/CommonTest.hs
--- a/test/CommonTest.hs
+++ b/test/CommonTest.hs
@@ -3,6 +3,7 @@
 import Test.Tasty
 import qualified CommonTest.Queue as QueueTest
 import qualified CommonTest.RewindQueue as RewindQueueTest
+import qualified CommonTest.RangeSet as RangeSetTest
 
 main :: IO ()
 main = defaultMain tests
@@ -10,4 +11,5 @@
 tests :: TestTree
 tests = testGroup "Common Tests" [ QueueTest.tests
                                  , RewindQueueTest.tests
+                                 , RangeSetTest.tests
                                  ]
diff --git a/test/CommonTest/RangeSet.hs b/test/CommonTest/RangeSet.hs
new file mode 100644
--- /dev/null
+++ b/test/CommonTest/RangeSet.hs
@@ -0,0 +1,154 @@
+{-# LANGUAGE TypeApplications, StandaloneDeriving, DeriveGeneric, MonoLocalBinds #-}
+module CommonTest.RangeSet where
+import Test.Tasty (testGroup, TestTree)
+import Test.Tasty.HUnit ( testCase, (@?=) )
+import Test.Tasty.QuickCheck
+  ( listOf, chooseEnum,
+    (===),
+    (==>),
+    (.&&.),
+    property,
+    testProperty,
+    elements,
+    forAll,
+    genericShrink,
+    Arbitrary(arbitrary, shrink),
+    Property )
+
+import Prelude hiding (null)
+
+import Parsley.Internal.Common.RangeSet
+import Data.List (nub, sort, intersect)
+import GHC.Generics (Generic)
+
+import Data.Word (Word8)
+
+deriving instance Generic (RangeSet a)
+
+data Digit = Zero | One | Two | Three | Four | Five | Six | Seven | Eight | Nine deriving (Ord, Eq, Enum, Bounded, Show, Generic)
+
+instance (Arbitrary a, Enum a, Ord a) => Arbitrary (RangeSet a) where
+  arbitrary = fmap fromList (listOf arbitrary)
+  shrink = filter valid . genericShrink
+
+instance Arbitrary Digit where
+  arbitrary = chooseEnum (Zero, Nine)
+  shrink Zero = []
+  shrink n = [Zero .. pred n]
+
+tests :: TestTree
+tests = testGroup "RangeSet" [
+    testProperty "arbitrary RangeSets should be valid" $ valid @Word,
+    emptyTests,
+    memberTests,
+    insertTests,
+    deleteTests,
+    fromListTests,
+    testProperty "elems and unelems shoudld be disjoint" $ elemUnelemDisjoint @Word8,
+    testProperty "complement . complement = id" $ complementInverse @Digit,
+    testProperty "unelems == elems . complement" $ complementElemsInverse @Digit,
+    testProperty "findMin should find the minimum" $ findMinMinimum @Word,
+    testProperty "findMax should find the maximum" $ findMaxMaximum @Int,
+    testProperty "allLess should find everything strictly less than a value" $ allLessMin @Word,
+    testProperty "allMore should find everything strictly more than a value" $ allMoreMax @Word,
+    testProperty "union should union" $ uncurry (unionProperty @Int),
+    testProperty "intersection should intersect" $ uncurry (intersectionProperty @Digit),
+    testProperty "difference should differentiate" $ uncurry (differenceProperty @Word)
+  ]
+
+emptyTests :: TestTree
+emptyTests = testGroup "empty should" [
+    testCase "be null" $ null empty @?= True,
+    testCase "have size 0" $ size @Int empty @?= 0
+  ]
+
+-- member, notMember
+memberTests :: TestTree
+memberTests = testGroup "member should" [
+    testCase "work when out of range" $ notMember 5 (fromRanges [(0, 4), (6, 9)]) @?= True,
+    testCase "work when in range" $ member 5 (fromRanges [(0, 9)]) @?= True,
+    testCase "work for exact" $ member 5 (fromRanges [(5, 5)]) @?= True,
+    testProperty "perform like elem on elems" $ uncurry (memberElemProperty @Word)
+  ]
+
+-- insert
+insertTests :: TestTree
+insertTests =
+  let t = fromList [6, 2, 7, 1, 5] -- 1-2, 5-7
+  in testGroup "insert should" [
+    testCase "add something in" $ member 3 (insert 3 t) @?= True,
+    testCase "not affect membership for other items" $ member 4 (insert 3 t) @?= False,
+    testCase "not remove membership" $ member 5 (insert 4 (insert 3 t)) @?= True
+  ]
+
+-- delete
+deleteTests :: TestTree
+deleteTests =
+  let t = fromList [6, 2, 7, 1, 5] -- 1-2, 5-7
+  in testGroup "delete should" [
+    testCase "remove an element" $ notMember 2 (delete 2 t) @?= True,
+    testCase "not affect membership for other items" $ member 1 (delete 2 t) @?= True,
+    testCase "produce valid trees" $ all valid (scanr delete t (sort (elems t))) @?= True
+  ]
+
+fromListTests :: TestTree
+fromListTests = testGroup "fromList" [
+    testProperty "should compose with elems to form (sort . nub)" $ nubSortProperty @Int,
+    testProperty "specifically, case 1" $ nubSortProperty [2,0,3,4,2,6],
+    testProperty "specifically, case 2" $ nubSortProperty [6,7,4,0,6,10,2,12,8]
+  ]
+
+findMinMinimum :: (Ord a, Show a, Enum a) => RangeSet a -> Property
+findMinMinimum t = findMin t === safeMinimum (elems t)
+  where
+    safeMinimum [] = Nothing
+    safeMinimum xs = Just $ minimum xs
+
+findMaxMaximum :: (Ord a, Show a, Enum a) => RangeSet a -> Property
+findMaxMaximum t = findMax t === safeMaximum (elems t)
+  where
+    safeMaximum [] = Nothing
+    safeMaximum xs = Just $ maximum xs
+
+nubSortProperty :: (Enum a, Ord a, Show a) => [a] -> Property
+nubSortProperty xs = sort (nub xs) === elems (fromList xs)
+
+memberElemProperty :: (Enum a, Ord a, Show a) => a -> RangeSet a -> Property
+memberElemProperty x t = member x t === elem x (elems t)
+
+elemUnelemDisjoint :: (Enum a, Bounded a, Eq a, Show a) => RangeSet a -> Property
+elemUnelemDisjoint t = intersect (elems t) (unelems t) === []
+
+complementInverse :: (Enum a, Bounded a, Ord a, Show a) => RangeSet a -> Property
+complementInverse t = elems (complement (complement t)) === elems t
+
+complementElemsInverse :: (Enum a, Bounded a, Ord a, Show a) => RangeSet a -> Property
+complementElemsInverse t = unelems t === elems (complement t)
+
+unionProperty :: (Ord a, Enum a, Show a) => RangeSet a -> RangeSet a -> Property
+unionProperty t1 t2 = not (null t1 && null t2) ==>
+  forAll (elements (elems t1 ++ elems t2)) (\x ->
+         member x (t1 `union` t2))
+  .&&. valid (t1 `union` t2)
+
+intersectionProperty :: (Ord a, Enum a, Show a) => RangeSet a -> RangeSet a -> Property
+intersectionProperty t1 t2 = not (null t1 && null t2) ==>
+  forAll (elements (elems t1 ++ elems t2)) (\x ->
+         (member x t1 && member x t2) === member x (t1 `intersection` t2))
+  .&&. valid (t1 `intersection` t2)
+
+differenceProperty :: (Ord a, Enum a, Show a) => RangeSet a -> RangeSet a -> Property
+differenceProperty t1 t2 = not (null t1 && null t2) ==>
+  forAll (elements (elems t1 ++ elems t2)) (\x ->
+         (member x t1 && not (member x t2)) === member x (t1 `difference` t2))
+  .&&. valid (t1 `difference` t2)
+
+allLessMin :: (Ord a, Enum a, Show a) => RangeSet a -> a -> Property
+allLessMin t x = allLess x t === fromList (filter (< x) (elems t))
+
+allMoreMax :: (Ord a, Enum a, Show a) => RangeSet a -> a -> Property
+allMoreMax t x = allMore x t === fromList (filter (> x) (elems t))
+
+{-
+    fromRanges, insertRange
+-}
diff --git a/test/Primitive.hs b/test/Primitive.hs
--- a/test/Primitive.hs
+++ b/test/Primitive.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell, UnboxedTuples, ScopedTypeVariables, TypeApplications #-}
+-- {-# OPTIONS_GHC -ddump-splices #-}
 module Main where
 import Test.Tasty
 import Test.Tasty.HUnit
@@ -132,6 +133,12 @@
 posAfterTab :: String -> Maybe ((Int, Int), (Int, Int))
 posAfterTab = $$(parseMocked Parsers.posAfterTab  [||Parsers.posAfterTab||])
 
+posAfterLookahead :: String -> Maybe ((Int, Int), (Int, Int))
+posAfterLookahead = $$(parseMocked Parsers.posAfterLookahead [||Parsers.posAfterLookahead||])
+
+posAfterNotFollowedBy :: String -> Maybe ((Int, Int), (Int, Int))
+posAfterNotFollowedBy = $$(parseMocked Parsers.posAfterNotFollowedBy [||Parsers.posAfterNotFollowedBy||])
+
 positionTests :: TestTree
 positionTests = testGroup "position combinators should"
   [ testCase "start at line 1" $ lineStarts1 "" @?= Just 1
@@ -139,4 +146,6 @@
   , testCase "advance by 1 column only after regular character" $ posAfterA "a" @?= Just (1, 2)
   , testCase "advance by 1 line and reset column after newline" $ posAfterNewline "a\n\n" @?= Just ((2, 1), (3, 1))
   , testCase "advance to nearest tab boundary on tab" $ posAfterTab "\ta\t" @?= Just ((1, 5), (1, 9))
+  , testCase "work with lookahead" $ posAfterLookahead "\t" @?= Just ((1, 1), (1, 5))
+  , testCase "work with notFollowedBy" $ posAfterNotFollowedBy "\n" @?= Just ((1, 1), (2, 1))
   ]
diff --git a/test/Primitive/Parsers.hs b/test/Primitive/Parsers.hs
--- a/test/Primitive/Parsers.hs
+++ b/test/Primitive/Parsers.hs
@@ -3,13 +3,14 @@
 
 import Prelude hiding (pure, (<*>), (*>), (<*))
 import Data.Char (isDigit)
-import Parsley.Internal (Parser, Defunc(EMPTY, LIFTED, EQ_H, CONS, LAM_S), makeQ, pure, satisfy, (*>), (<*), (<|>), (<*>), satisfy, lookAhead, line, col)
+import Parsley.Internal (Parser, Defunc(EMPTY, LIFTED, RANGES, CONS), makeQ, pure, satisfy, (*>), (<*), (<|>), (<*>), satisfy, lookAhead, notFollowedBy, line, col)
+import Text.ParserCombinators.ReadP (look)
 
 char :: Char -> Parser Char
-char c = satisfy (EQ_H (LIFTED c))
+char c = satisfy (RANGES True [(c, c)])
 
 item :: Parser Char
-item = satisfy (LAM_S (const (LIFTED True)))
+item = satisfy (RANGES False [])
 
 pure7 :: Parser Int
 pure7 = pure (LIFTED 7)
@@ -48,3 +49,9 @@
 
 posAfterTab :: Parser ((Int, Int), (Int, Int))
 posAfterTab = (char '\t' *> pos) <~> (char 'a' *> char '\t' *> pos)
+
+posAfterLookahead :: Parser ((Int, Int), (Int, Int))
+posAfterLookahead = lookAhead (char '\t') *> pos <~> (item *> pos)
+
+posAfterNotFollowedBy :: Parser ((Int, Int), (Int, Int))
+posAfterNotFollowedBy = notFollowedBy (char '\t') *> pos <~> (item *> pos)