diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2023, Oleg Grenrus
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Oleg Grenrus nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/example.json b/example.json
new file mode 100644
--- /dev/null
+++ b/example.json
@@ -0,0 +1,4 @@
+{
+    "literals": [true, false, null],
+    "numbers": [0, 123]
+}
diff --git a/sasha.cabal b/sasha.cabal
new file mode 100644
--- /dev/null
+++ b/sasha.cabal
@@ -0,0 +1,84 @@
+cabal-version:      3.0
+name:               sasha
+version:            0
+author:             Oleg Grenrus <oleg.grenrus@iki.fi>
+maintainer:         Oleg Grenrus <oleg.grenrus@iki.fi>
+synopsis:           A staged lexer generator
+description:
+  Like @alex@, @sasha@ is lexer\/scanner generator; but it is using Typed Template Haskell.
+  .
+  The generated scanners are comparable in speed to @alex@ generated ones.
+
+category:           Lexing, Development
+license:            BSD-3-Clause
+license-file:       LICENSE
+homepage:           https://github.com/phadej/sasha
+bug-reports:        https://github.com/phadej/sasha/issues
+extra-source-files: example.json
+tested-with:        GHC ==9.0.2 || ==9.2.5 || ==9.4.4
+
+source-repository head
+  type:     git
+  location: https://github.com/phadej/sasha.git
+
+common common
+  default-language:   Haskell2010
+  ghc-options:        -Wall
+  default-extensions:
+    BangPatterns
+    OverloadedStrings
+    PatternSynonyms
+    ScopedTypeVariables
+    TypeApplications
+
+library
+  import:            common
+  hs-source-dirs:    src
+  build-depends:
+    , base              ^>=4.15.0.0  || ^>=4.16.0.0 || ^>=4.17.0.0
+    , bytestring        ^>=0.10.12.1 || ^>=0.11.3.1
+    , containers        ^>=0.6.4.1
+    , lattices          ^>=2.1
+    , QuickCheck        ^>=2.14.2
+    , template-haskell
+    , th-letrec         ^>=0.1
+    , wide-word         ^>=0.1.4.0
+
+  exposed-modules:
+    Sasha
+    Sasha.Internal.ERE
+    Sasha.Internal.Word8Set
+    Sasha.TTH
+
+  x-docspec-options:
+    -XOverloadedStrings --check-properties "--property-variables=c p r s t q"
+
+test-suite sasha-tests
+  import:             common
+  type:               exitcode-stdio-1.0
+  hs-source-dirs:     tests
+  main-is:            sasha-tests.hs
+  other-modules:
+    Sasha.Example.Alex
+    Sasha.Example.Sasha
+    Sasha.Example.SaTTH
+    Sasha.Example.Token
+
+  build-depends:
+    , aeson
+    , array
+    , base
+    , bytestring
+    , deepseq
+    , lattices
+    , sasha
+
+  -- test dependencies
+  build-depends:
+    , tasty             ^>=1.4.3
+    , tasty-bench       ^>=0.3.2
+    , tasty-hunit       ^>=0.10.0.3
+    , tasty-quickcheck  ^>=0.10.2
+    , text              ^>=1.2.5.0  || ^>=2.0
+
+  build-tool-depends: alex:alex ^>=3.2.7.1
diff --git a/src/Sasha.hs b/src/Sasha.hs
new file mode 100644
--- /dev/null
+++ b/src/Sasha.hs
@@ -0,0 +1,68 @@
+module Sasha (
+    -- * Sasha the lexer
+
+    -- | This is the ordinary Haskell (i.e. slow) interface.
+    --
+    -- The fast one is in "Sasha.TTH" module, but that requires @TemplateHaskell@.
+    --
+    Sasha,
+    sasha,
+    -- * ERE specification
+    ERE,
+    empty,
+    eps,
+    char,
+    charRange,
+    utf8Char,
+    anyChar,
+    anyUtf8Char,
+    appends,
+    unions,
+    intersections,
+    star,
+    plus,
+    string,
+    utf8String,
+    complement,
+    satisfy,
+    digit,
+) where
+
+import Control.Applicative ((<|>))
+import Data.Maybe          (listToMaybe)
+import Data.Word           (Word8)
+
+import qualified Data.ByteString as BS
+
+import Sasha.Internal.ERE
+
+-- | Lexer grammar specification: tags and regular expressions.
+type Sasha tag = [(tag, ERE)]
+
+-- | Scan for a single token.
+sasha
+    :: forall tag. Sasha tag                      -- ^ scanner definition
+    -> BS.ByteString                              -- ^ input
+    -> Maybe (tag, BS.ByteString, BS.ByteString)  -- ^ matched token, consumed bytestring, left over bytestring
+sasha grammar input0 = finish <$> go Nothing 0 input0 grammar
+  where
+    finish :: (tag, Int) -> (tag, BS.ByteString, BS.ByteString)
+    finish (tag, i) = case BS.splitAt i input0 of
+        (pfx, sfx) -> (tag, pfx, sfx)
+
+    go :: Maybe (tag, Int) -> Int -> BS.ByteString -> Sasha tag -> Maybe (tag, Int)
+    go acc !_   _       [] = acc
+    go acc !pfx input   ts = case BS.uncons input of
+        Nothing       -> acc
+        Just (c, sfx) -> go (acc' <|> acc) (pfx + 1) sfx ts'
+          where
+            ts' = derivativeSasha c ts
+            acc' = listToMaybe [ (tag, pfx + 1) | (tag, ere) <- ts', nullable ere]
+
+derivativeSasha :: Word8 -> Sasha tag -> Sasha tag
+derivativeSasha c ts =
+    [ (t, ere')
+    | (t, ere) <- ts
+    , let ere' = derivative c ere
+    , not (isEmpty ere')
+    ]
diff --git a/src/Sasha/Internal/ERE.hs b/src/Sasha/Internal/ERE.hs
new file mode 100644
--- /dev/null
+++ b/src/Sasha/Internal/ERE.hs
@@ -0,0 +1,455 @@
+{-# LANGUAGE BangPatterns           #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs                  #-}
+{-# LANGUAGE PatternGuards          #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+module Sasha.Internal.ERE (
+    ERE (..),
+    -- * Construction
+    --
+    -- | Binary operators are
+    --
+    -- * '<>' for append
+    -- * '\/' for union
+    -- * '/\' for intersection
+    --
+    empty,
+    eps,
+    char,
+    charRange,
+    utf8Char,
+    anyChar,
+    anyUtf8Char,
+    appends,
+    unions,
+    intersections,
+    star,
+    plus,
+    string,
+    utf8String,
+    complement,
+    everything,
+    satisfy,
+    digit,
+    -- * Equivalence
+    equivalent,
+    -- * Derivative
+    nullable,
+    derivative,
+    match,
+    -- * Other
+    isEmpty,
+    isEverything,
+    ) where
+
+import Algebra.Lattice
+       (BoundedJoinSemiLattice (..), BoundedMeetSemiLattice (..), Lattice (..))
+import Data.Bits               (shiftR, (.&.), (.|.))
+import Data.Char               (ord)
+import Data.Foldable           (toList)
+import Data.Set                (Set)
+import Data.String             (IsString (..))
+import Data.Word               (Word8)
+import Sasha.Internal.Word8Set (Word8Set)
+import Test.QuickCheck       (Arbitrary (..))
+
+import qualified Test.QuickCheck as QC
+import qualified Data.Set                as Set
+import qualified Sasha.Internal.Word8Set as W8S
+
+-------------------------------------------------------------------------------
+-- Doctest
+-------------------------------------------------------------------------------
+
+-- $setup
+-- >>> :set -XOverloadedStrings 
+-- >>> import Control.Monad (void)
+-- >>> import Data.Foldable (traverse_)
+-- >>> import Data.List (sort)
+-- >>> import Algebra.Lattice ((/\), (\/))
+--
+-- >>> import Test.QuickCheck ((===))
+-- >>> import qualified Test.QuickCheck as QC
+--
+-------------------------------------------------------------------------------
+-- ERE
+-------------------------------------------------------------------------------
+
+-- | Extended regular expression
+--
+data ERE
+    = EREAppend [ERE]              -- ^ Concatenation
+    | EREUnion Word8Set (Set ERE)  -- ^ Union
+    | EREStar ERE                  -- ^ Kleene star
+    | ERENot ERE                   -- ^ Complement
+  deriving (Eq, Ord, Show)
+
+-------------------------------------------------------------------------------
+-- Smart constructor
+-------------------------------------------------------------------------------
+
+-- | Empty regex. Doesn't accept anything.
+--
+-- prop> match empty s === False
+--
+empty :: ERE
+empty = EREUnion W8S.empty Set.empty
+
+-- | Everything.
+--
+-- prop> match everything s === True
+--
+everything :: ERE
+everything = complement empty
+
+-- | Empty string. /Note:/ different than 'empty'.
+--
+-- prop> match eps s === null s
+--
+eps :: ERE
+eps = EREAppend []
+
+-- | Character.
+--
+char :: Word8 -> ERE
+char c = EREUnion (W8S.singleton c) Set.empty
+
+-- | Character range.
+--
+charRange :: Word8 -> Word8 -> ERE
+charRange l u = EREUnion (W8S.range l u) Set.empty
+
+-- | Any character.
+--
+anyChar :: ERE
+anyChar = EREUnion W8S.full Set.empty
+
+anyUtf8Char :: ERE
+anyUtf8Char = unions
+    [ charRange 0x00 0x7F
+    , charRange 0xC2 0xDF <> charRange 0x80 0xBF
+    , charRange 0xE0 0xE0 <> charRange 0xa0 0xBF <> charRange 0x80 0xBF
+    , charRange 0xE1 0xEC <> charRange 0x80 0xBF <> charRange 0x80 0xBF
+    , charRange 0xED 0xED <> charRange 0x80 0x9F <> charRange 0x80 0xBF
+    , charRange 0xEE 0xEF <> charRange 0x80 0xBF <> charRange 0x80 0xBF
+    , charRange 0xF0 0xF0 <> charRange 0x90 0xBF <> charRange 0x80 0xBF <> charRange 0x80 0xBF
+    , charRange 0xF1 0xF3 <> charRange 0x80 0xBF <> charRange 0x80 0xBF <> charRange 0x80 0xBF
+    , charRange 0xF4 0xF4 <> charRange 0x80 0x8f <> charRange 0x80 0xBF <> charRange 0x80 0xBF
+    ]
+
+-- | Concatenate regular expressions.
+--
+-- prop> r <> empty === empty
+-- prop> empty <>  r === empty
+-- prop> ( r <> s) <> t === r <> (s <> t)
+--
+-- prop>  r <> eps === r
+-- prop> eps <>  r === r
+--
+appends :: [ERE] -> ERE
+appends rs0
+    | elem empty rs1 = empty
+    | otherwise = case rs1 of
+        [r] -> r
+        rs  -> EREAppend rs
+  where
+    -- flatten one level of EREAppend
+    rs1 = concatMap f rs0
+
+    f (EREAppend rs) = rs
+    f r             = [r]
+
+-- | Union of regular expressions.
+--
+-- prop>  r \/ r === r
+-- prop>  r \/ s === s \/ r
+-- prop> ( r \/ s) \/ t === r \/ (s \/ t)
+--
+-- prop> empty \/  r === r
+-- prop>  r \/ empty === r
+--
+-- prop> everything \/  r === everything
+-- prop>  r \/ everything === everything
+--
+unions :: [ERE] -> ERE
+unions = uncurry mk . foldMap f where
+    mk cs rss
+        | Set.null rss = EREUnion cs Set.empty
+        | Set.member everything rss = everything
+        | W8S.null cs = case Set.toList rss of
+            []  -> empty
+            [r] -> r
+            _   -> EREUnion cs rss
+        | otherwise    = EREUnion cs rss
+
+    f (EREUnion cs rs) = (cs, rs)
+    f r                = (W8S.empty, Set.singleton r)
+
+-- | Intersection of regular expressions.
+--
+-- prop>  r /\ r === r
+-- prop>  r /\ s === s /\ r
+-- prop> ( r /\ s) /\ t === r /\ (s /\ t)
+--
+-- prop> empty /\  r === empty
+-- prop>  r /\ empty === empty
+--
+-- prop> everything /\  r === r
+-- prop>  r /\ everything === r
+--
+intersections :: [ERE] -> ERE
+intersections = complement . unions . map complement
+
+-- | Complement.
+--
+-- prop> complement (complement r) ===  r
+--
+complement :: ERE -> ERE
+complement r = case r of
+    ERENot r'                    -> r'
+    _                            -> ERENot r
+
+-- | Kleene star.
+--
+-- prop> star (star r) === star ( r)
+--
+-- prop> star eps     ===  eps
+-- prop> star empty   ===  eps
+-- prop> star anyChar ===  everything
+--
+-- prop> star (r \/ eps) === star r
+-- prop> star (char c \/ eps) === star (char c)
+-- prop> star (empty \/ eps) === eps
+--
+star :: ERE -> ERE
+star r = case r of
+    EREStar _                          -> r
+    EREAppend []                       -> eps
+    EREUnion cs rs
+        | W8S.null cs, Set.null rs     -> eps
+        | W8S.isFull cs, Set.null rs   -> everything
+        | Set.member eps rs -> case Set.toList rs' of
+            []                  -> star (EREUnion cs Set.empty)
+            [r'] | W8S.null cs  -> star r'
+            _                   -> EREStar (EREUnion cs rs')
+          where
+            rs' = Set.delete eps rs
+    _                                  -> EREStar r
+
+-- | Kleene plus
+--
+-- @
+-- 'plus' r = r <> 'star' r
+-- @
+plus :: ERE -> ERE
+plus r = r <> star r
+
+-- | Literal string.
+--
+string :: [Word8] -> ERE
+string []  = eps
+string [c] = EREUnion (W8S.singleton c) Set.empty
+string cs  = EREAppend $ map char cs
+
+-- | UTF8 string
+utf8String :: String -> ERE
+utf8String = string . concatMap encodeCharUtf8
+
+-- | UTF8 character, i.e. may match multiple bytes.
+utf8Char :: Char -> ERE
+utf8Char = string . encodeCharUtf8
+
+satisfy :: (Word8 -> Bool) -> ERE
+satisfy p = EREUnion (W8S.fromList [ x | x <- [ minBound .. maxBound], p x ]) Set.empty
+
+digit :: ERE
+digit = charRange (fromIntegral (ord '0')) (fromIntegral (ord '9'))
+
+-------------------------------------------------------------------------------
+-- derivative
+-------------------------------------------------------------------------------
+
+instance Semigroup ERE where
+    r <> r' = appends [r, r']
+
+instance Monoid ERE where
+    mempty  = eps
+    mappend = (<>)
+    mconcat = appends
+
+instance Lattice ERE where
+    r \/ r' = unions [r, r']
+    r /\ r' = intersections [r, r']
+
+instance BoundedJoinSemiLattice ERE where
+    bottom = empty
+
+instance BoundedMeetSemiLattice ERE where
+    top = everything
+
+-- | Uses 'utf8string'.
+instance IsString ERE where
+    fromString = utf8String
+
+-- | Uses smart constructors.
+instance Arbitrary ERE where
+    arbitrary = QC.sized arb
+      where
+        arb n | n <= 1    = QC.frequency
+            [ (20, EREUnion <$> arbitrary <*> pure Set.empty)
+            , (1, pure eps)
+            , (1, pure empty)
+            ] 
+              | otherwise = QC.oneof
+            [ do
+                p <- arbPartition (n - 1)
+                unions <$> traverse arb p
+            , do
+                p <- arbPartition (n - 1)
+                appends <$> traverse arb p
+  
+            , star <$> arb (n - 1)
+            , complement <$> arb (n - 1)
+            ]
+
+    shrink (EREAppend rs) = rs
+    shrink (EREStar r)    = r : map EREStar (shrink r)
+    shrink (ERENot r)     = r : map ERENot (shrink r)
+    shrink _              = []
+
+arbPartition :: Int -> QC.Gen [Int]
+arbPartition k = case compare k 1 of
+    LT -> pure []
+    EQ -> pure [1]
+    GT -> do
+        first <- QC.chooseInt (1, k)
+        rest <- arbPartition $ k - first
+        QC.shuffle (first : rest)
+
+
+
+-------------------------------------------------------------------------------
+-- derivative
+-------------------------------------------------------------------------------
+
+-- | We say that a regular expression r is nullable if the language it defines
+-- contains the empty string.
+--
+-- >>> nullable eps
+-- True
+--
+-- >>> nullable (star "x")
+-- True
+--
+-- >>> nullable "foo"
+-- False
+--
+-- >>> nullable (complement eps)
+-- False
+--
+nullable :: ERE -> Bool
+nullable (EREAppend rs)    = all nullable rs
+nullable (EREUnion _cs rs) = any nullable rs
+nullable (EREStar _)       = True
+nullable (ERENot r)        = not (nullable r)
+
+-- | Intuitively, the derivative of a language \(\mathcal{L} \subset \Sigma^\star\)
+-- with respect to a symbol \(a \in \Sigma\) is the language that includes only
+-- those suffixes of strings with a leading symbol \(a\) in \(\mathcal{L}\).
+--
+derivative :: Word8 -> ERE -> ERE
+derivative c (EREUnion cs rs)  = unions $ derivativeChars c cs : [ derivative c r | r <- toList rs]
+derivative c (EREAppend rs)    = derivativeAppend c rs
+derivative c rs@(EREStar r)    = derivative c r <> rs
+derivative c (ERENot r)        = complement (derivative c r)
+
+derivativeAppend :: Word8 -> [ERE] -> ERE
+derivativeAppend _ []      = empty
+derivativeAppend c [r]     = derivative c r
+derivativeAppend c (r:rs)
+    | nullable r         = unions [r' <> appends rs, rs']
+    | otherwise          = r' <> appends rs
+  where
+    r'  = derivative c r
+    rs' = derivativeAppend c rs
+
+derivativeChars :: Word8 -> Word8Set -> ERE
+derivativeChars c cs
+    | c `W8S.member` cs      = eps
+    | otherwise              = empty
+
+match :: ERE -> [Word8] -> Bool
+match ere []     = nullable ere
+match ere (w:ws) = match (derivative w ere) ws
+
+-------------------------------------------------------------------------------
+-- isEmpty
+-------------------------------------------------------------------------------
+
+-- | Whether 'ERE' is (structurally) equal to 'empty'.
+isEmpty :: ERE -> Bool
+isEmpty (EREUnion cs rs) = W8S.null cs && Set.null rs
+isEmpty _                = False
+
+-- | Whether 'ERE' is (structurally) equal to 'everything'.
+isEverything :: ERE -> Bool
+isEverything (ERENot (EREUnion cs rs)) = W8S.null cs && Set.null rs
+isEverything _                         = False
+
+-------------------------------------------------------------------------------
+-- Utf8
+-------------------------------------------------------------------------------
+
+encodeCharUtf8 :: Char -> [Word8]
+encodeCharUtf8 c
+  | c <= '\x07F'  = w8
+                  : []
+  | c <= '\x7FF'  = (0xC0 .|.  w8ShiftR  6          )
+                  : (0x80 .|. (w8          .&. 0x3F))
+                  : []
+  | c <= '\xD7FF' = (0xE0 .|.  w8ShiftR 12          )
+                  : (0x80 .|. (w8ShiftR  6 .&. 0x3F))
+                  : (0x80 .|. (w8          .&. 0x3F))
+                  : []
+  | c <= '\xDFFF' = 0xEF : 0xBF : 0xBD -- U+FFFD
+                  : []
+  | c <= '\xFFFF' = (0xE0 .|.  w8ShiftR 12          )
+                  : (0x80 .|. (w8ShiftR  6 .&. 0x3F))
+                  : (0x80 .|. (w8          .&. 0x3F))
+                  : []
+  | otherwise     = (0xf0 .|.  w8ShiftR 18          )
+                  : (0x80 .|. (w8ShiftR 12 .&. 0x3F))
+                  : (0x80 .|. (w8ShiftR  6 .&. 0x3F))
+                  : (0x80 .|. (w8          .&. 0x3F))
+                  : []
+  where
+    w8 :: Word8
+    w8 = fromIntegral (ord c)
+
+    w8ShiftR :: Int -> Word8
+    w8ShiftR b = fromIntegral (shiftR (ord c) b)
+
+-------------------------------------------------------------------------------
+-- Equivalance
+-------------------------------------------------------------------------------
+
+equivalent :: ERE -> ERE -> Bool
+equivalent x0 y0 = agree (x0, y0) && go mempty [(x0, y0)] []
+  where
+    -- we use two queues, so we can append chunks cheaply.
+    go :: Set (ERE, ERE) -> [(ERE, ERE)] -> [[(ERE,ERE)]] -> Bool
+    go !_  []              []       = True
+    go acc []              (zs:zss) = go acc zs zss
+    go acc (p@(x, y) : zs) zss
+        | p `Set.member` acc = go acc zs zss
+        -- if two regexps are structurally the same, we don't need to recurse.
+        | x == y             = go (Set.insert p acc) zs zss
+        | all agree ps       = go (Set.insert p acc) zs (ps : zss)
+        | otherwise          = False
+      where
+        cs = [minBound .. maxBound] :: [Word8]
+        ps = map (\c -> (derivative c x, derivative c y)) cs
+
+    agree :: (ERE, ERE) -> Bool
+    agree (x, y) = nullable x == nullable y
diff --git a/src/Sasha/Internal/Word8Set.hs b/src/Sasha/Internal/Word8Set.hs
new file mode 100644
--- /dev/null
+++ b/src/Sasha/Internal/Word8Set.hs
@@ -0,0 +1,218 @@
+{-# LANGUAGE TemplateHaskellQuotes #-}
+module Sasha.Internal.Word8Set (
+    -- * Set type
+    Word8Set,
+    Key,
+
+    -- * Construction
+    empty,
+    full,
+    singleton,
+    range,
+    fromList,
+
+    -- * Insertion
+    insert,
+
+    -- * Deletion
+    delete,
+
+    -- * Query
+    member,
+    memberCode,
+    isSubsetOf,
+    null,
+    isFull,
+    isSingleRange,
+    size,
+
+    -- * Combine
+    union,
+    intersection,
+    complement,
+
+    -- * Min\/Max
+    findMin,
+    findMax,
+    -- * Conversion to List
+    elems,
+    toList,
+) where
+
+import Prelude
+       (Bool (..), Eq ((==)), Int, Monoid (..), Ord, Semigroup (..),
+       Show (showsPrec), fromIntegral, negate, otherwise, showParen, showString,
+       ($), (&&), (+), (-), (.), (<), (<=), (>), (||), return)
+
+import Data.Bits             ((.&.), (.|.))
+import Data.Foldable         (foldl')
+import Data.WideWord.Word256 (Word256 (..))
+import Data.Word             (Word64, Word8)
+import Test.QuickCheck       (Arbitrary (..))
+import Algebra.Lattice
+       (BoundedJoinSemiLattice (..), BoundedMeetSemiLattice (..), Lattice (..))
+
+import Language.Haskell.TH.Syntax
+
+import qualified Data.Bits as Bits
+
+-------------------------------------------------------------------------------
+-- Types
+-------------------------------------------------------------------------------
+
+newtype Word8Set = W8S Word256
+  deriving (Eq, Ord)
+
+type Key = Word8
+
+-------------------------------------------------------------------------------
+-- Instances
+-------------------------------------------------------------------------------
+
+instance Show Word8Set where
+    showsPrec d xs = showParen (d > 10) $ showString "fromList " . showsPrec 11 (toList xs)
+
+instance Lift Word8Set where
+    liftTyped (W8S (Word256 a b c d)) =
+        [|| W8S (Word256 a b c d) ||]
+
+instance Semigroup Word8Set where
+    (<>) = union
+
+instance Monoid Word8Set where
+    mempty = empty
+
+instance Arbitrary Word8Set where
+    arbitrary = do
+        a <- arbitrary
+        b <- arbitrary
+        c <- arbitrary
+        d <- arbitrary
+        return (W8S (Word256 a b c d))
+
+instance Lattice Word8Set where
+    (\/) = union
+    (/\) = intersection
+
+instance BoundedJoinSemiLattice Word8Set where
+    bottom = empty
+
+instance BoundedMeetSemiLattice Word8Set where
+    top = full
+
+-------------------------------------------------------------------------------
+-- Construction
+-------------------------------------------------------------------------------
+
+empty :: Word8Set
+empty = W8S Bits.zeroBits
+
+full :: Word8Set
+full = W8S ones
+
+ones :: Word256
+ones = Bits.complement Bits.zeroBits
+
+singleton :: Word8 -> Word8Set
+singleton x = W8S (Bits.bit (fromIntegral x))
+
+range :: Word8 -> Word8 -> Word8Set
+range mi ma
+    | mi <= ma  = W8S $ Bits.shiftL (Bits.shiftR ones (fromIntegral (negate (1 + ma - mi)))) (fromIntegral mi)
+    | otherwise = empty
+
+-------------------------------------------------------------------------------
+-- Insertion
+-------------------------------------------------------------------------------
+
+insert :: Word8 -> Word8Set -> Word8Set
+insert x (W8S xs) = W8S (Bits.setBit xs (fromIntegral x))
+
+-------------------------------------------------------------------------------
+-- Deletion
+-------------------------------------------------------------------------------
+
+delete :: Word8 -> Word8Set -> Word8Set
+delete x (W8S xs) = W8S (Bits.clearBit xs (fromIntegral x))
+
+-------------------------------------------------------------------------------
+-- Query
+-------------------------------------------------------------------------------
+
+null :: Word8Set -> Bool
+null (W8S xs) = xs == Bits.zeroBits
+
+isFull :: Word8Set -> Bool
+isFull (W8S xs) = xs == ones
+
+size :: Word8Set -> Int
+size (W8S xs) = Bits.popCount xs
+
+member :: Word8 -> Word8Set -> Bool
+member x (W8S xs) = Bits.testBit xs (fromIntegral x)
+
+-- | Optimized routing to check membership when 'Word8Set' is statically known.
+--
+-- @
+-- 'memberCode' c ws = [||'member' $$c $$(liftTyped ws) ||]
+-- @
+--
+memberCode :: Code Q Word8 -> Word8Set -> Code Q Bool
+memberCode c ws
+    -- simple cases
+    | null ws                     = [|| False ||]
+    | isFull ws                   = [|| True ||]
+    | size ws == 1                = [|| $$c == $$(liftTyped (findMin ws)) ||]
+    | size ws == 2                = [|| $$c == $$(liftTyped (findMin ws)) || $$c == $$(liftTyped (findMax ws)) ||]
+
+    -- continuos range
+    | isSingleRange ws            = [|| $$(liftTyped (findMin ws)) <= $$c && $$c <= $$(liftTyped (findMax ws)) ||]
+
+    -- low chars
+    | W8S (Word256 0 0 0 x) <- ws = [|| $$c < 64 && Bits.testBit ($$(liftTyped x) :: Word64) (fromIntegral ($$c :: Word8)) ||]
+
+    -- fallback
+    | otherwise                   = [|| member $$c $$(liftTyped ws) ||]
+
+isSubsetOf :: Word8Set -> Word8Set -> Bool
+isSubsetOf a b = b == union a b
+
+isSingleRange :: Word8Set -> Bool
+isSingleRange (W8S 0)  = True
+isSingleRange (W8S ws) = Bits.popCount ws + Bits.countLeadingZeros ws + Bits.countTrailingZeros ws == 256
+
+-------------------------------------------------------------------------------
+-- Combine
+-------------------------------------------------------------------------------
+
+complement :: Word8Set -> Word8Set
+complement (W8S xs) = W8S (Bits.complement xs)
+
+union :: Word8Set -> Word8Set -> Word8Set
+union (W8S xs) (W8S ys) = W8S (xs .|. ys)
+
+intersection :: Word8Set -> Word8Set -> Word8Set
+intersection (W8S xs) (W8S ys) = W8S (xs .&. ys)
+
+-------------------------------------------------------------------------------
+-- Min/Max
+-------------------------------------------------------------------------------
+
+findMin :: Word8Set -> Word8
+findMin (W8S xs) = fromIntegral (Bits.countTrailingZeros xs)
+
+findMax :: Word8Set -> Word8
+findMax (W8S xs) = fromIntegral (255 - Bits.countLeadingZeros xs)
+
+-------------------------------------------------------------------------------
+-- List
+-------------------------------------------------------------------------------
+
+elems :: Word8Set -> [Word8]
+elems = toList
+
+toList :: Word8Set -> [Word8]
+toList xs = [ w8 | w8 <- [0x00..0xff], member w8 xs]
+
+fromList :: [Word8] -> Word8Set
+fromList w8s = W8S $ foldl' (\acc w8 -> Bits.setBit acc (fromIntegral w8)) Bits.zeroBits w8s
diff --git a/src/Sasha/TTH.hs b/src/Sasha/TTH.hs
new file mode 100644
--- /dev/null
+++ b/src/Sasha/TTH.hs
@@ -0,0 +1,232 @@
+{-# LANGUAGE TemplateHaskellQuotes #-}
+module Sasha.TTH (
+    -- * SaTTH, staged Sasha the lexer.
+    SaTTH,
+    satth,
+    -- * ERE specification
+    ERE,
+    empty,
+    eps,
+    char,
+    charRange,
+    utf8Char,
+    anyChar,
+    anyUtf8Char,
+    appends,
+    unions,
+    intersections,
+    star,
+    plus,
+    string,
+    utf8String,
+    complement,
+    satisfy,
+    digit,
+) where
+
+import Language.Haskell.TH (Code, CodeQ, Exp, Q)
+
+import Control.Monad               (forM)
+import Data.List                   (sortOn)
+import Data.Map                    (Map)
+import Data.Maybe                  (listToMaybe)
+import Data.Ord                    (Down (..))
+import Data.Word                   (Word8)
+import Language.Haskell.TTH.LetRec (letrecE)
+
+import qualified Data.ByteString     as BS
+import qualified Data.Map.Strict     as Map
+import qualified Language.Haskell.TH as TH
+
+import Sasha.Internal.ERE
+import Sasha.Internal.Word8Set (Word8Set)
+
+import qualified Sasha.Internal.Word8Set as W8S
+
+-- | Lexer grammar specification: tag codes and regular expressions.
+type SaTTH tag = [(Code Q tag, ERE)]
+
+-- | Generate a scanner code.
+satth :: forall tag. SaTTH tag -> Code Q (BS.ByteString -> Maybe (tag, BS.ByteString, BS.ByteString))
+satth grammar0 = letrecE
+    (\_ -> "state")
+    trans
+    start
+  where
+    grammar0' :: SaTTH' tag
+    grammar0' =
+        [ S i t ere
+        | (i, (t, ere)) <- zip [0..] grammar0
+        ]
+
+    start :: Monad m => (SaTTH' tag -> m (Code Q (R tag))) -> m (Code Q (BS.ByteString -> Maybe (tag, BS.ByteString, BS.ByteString)))
+    start rec = do
+        startCode <- rec grammar0'
+        -- we assume that none of the tokens accepts an empty string,
+        -- so we start without specifying last match.
+        return [|| \input -> case $$startCode Nothing (0 :: Int) input of
+            Nothing       -> Nothing
+            Just (tag, i) -> case BS.splitAt i input of
+                (pfx, sfx) -> Just (tag, pfx, sfx)
+            ||]
+
+    trans :: Monad m => (SaTTH' tag -> m (Code Q (R tag))) -> SaTTH' tag -> m (Code Q (R tag))
+    trans _rec grammar
+        | emptySashaTTH grammar
+        = return [|| \ !acc _ _ -> acc ||]
+
+    trans  rec grammar = do
+        -- if the input is not empty?
+        let grammarM1 :: Map (SaTTH' tag) Word8Set
+            grammarM1 = Map.fromListWith W8S.union
+                [ (derivativeSaTTH c grammar, W8S.singleton c)
+                | c <- [ minBound .. maxBound ]
+                ]
+
+            -- non-empty map
+            grammarM :: [(Word8Set, SaTTH' tag, M tag)]
+            grammarM =
+                [ (c, grammar', makeM grammar')
+                | (grammar', c) <- Map.toList grammarM1
+                ]
+
+        -- next states
+        nexts0 <- forM grammarM $ \(ws, grammar', modify) -> do
+            if emptySashaTTH grammar' then return (ws, NextEmpty, modify)
+            else if epsSashaTTH grammar' then return (ws, NextEps, modify)
+            else do
+                next <- rec grammar'
+                return (ws, Next next, modify)
+
+        -- sort next states
+        let nexts :: [(Word8Set, Next (Code Q (R tag)), M tag)]
+            nexts = sortOn (\(ws, _, _) -> meas ws) nexts0
+
+        -- transition case
+        let caseAnalysis
+                :: Code Q (Maybe (tag, Int))
+                -> Code Q Int
+                -> Code Q Word8
+                -> Code Q BS.ByteString
+                -> Code Q (Maybe (tag, Int))
+            caseAnalysis acc pfx c sfx = caseTTH [|| () ||]
+                [ (W8S.memberCode c ws, body)
+
+                | (ws, mnext, modify) <- nexts
+                , let body = case mnext of
+                        NextEmpty -> acc
+                        NextEps   -> modify acc [|| $$pfx + 1 ||]
+                        Next next -> [|| let !pfx' = $$pfx + 1 in $$next $$(modify acc [|| pfx' ||]) pfx' $$sfx ||]
+                ]
+
+        let debugWarns :: Q ()
+            debugWarns = return ()
+
+        return $ TH.bindCode_ debugWarns [|| \ !acc !_pfx !input -> case BS.uncons input of
+            Nothing        -> acc
+            Just (c, _sfx) -> $$(caseAnalysis [|| acc ||] [|| _pfx ||] [|| c ||] [|| _sfx ||])
+            ||]
+
+-------------------------------------------------------------------------------
+-- Sorting transitions
+-------------------------------------------------------------------------------
+
+data Meas
+    = MeasLite Word8Set
+    | MeasCont !(Down Int) !Word8Set
+    | MeasSize !Int !Word8Set
+  deriving (Eq, Ord)
+
+meas :: Word8Set -> Meas
+meas ws
+    | W8S.size ws < 2      = MeasLite ws
+    | W8S.isSingleRange ws = MeasCont (Down (W8S.size ws)) ws
+    | otherwise            = MeasSize (W8S.size ws) ws
+
+-------------------------------------------------------------------------------
+-- Aliases
+-------------------------------------------------------------------------------
+
+-- | Inner scanner function.
+--
+-- * previous match
+-- * position
+-- * input
+--
+type R tag = Maybe (tag, Int) -> Int -> BS.ByteString -> Maybe (tag, Int)
+
+-- | Last accept modifier.
+type M tag = Code Q (Maybe (tag, Int)) -> CodeQ Int -> CodeQ (Maybe (tag, Int))
+
+makeM :: forall tag. SaTTH' tag -> M tag
+makeM grammar acc pfx = case acc' of
+    Nothing  -> acc
+    Just tag -> [|| Just ($$tag, $$pfx) ||]
+  where
+    acc' :: Maybe (Code Q tag)
+    acc' = listToMaybe
+        [ tag
+        | S _ tag ere <- grammar
+        , nullable ere
+        ]
+
+data Next a
+    = NextEmpty
+    | NextEps
+    | Next a
+
+-------------------------------------------------------------------------------
+-- TTH extras
+-------------------------------------------------------------------------------
+
+caseTTH :: Code Q a -> [(Code Q Bool, CodeQ r)] -> Code Q r
+caseTTH c guards = TH.unsafeCodeCoerce $ TH.caseE (TH.unTypeCode c)
+    [ TH.match TH.wildP (TH.guardedB (go guards))  [] ]
+  where
+    go :: [(Code Q Bool, Code Q r)] -> [Q (TH.Guard, Exp)]
+    go []          = []
+    go [(_,b)]     = [TH.normalGE [| otherwise |] (TH.unTypeCode b)]
+    go ((g,b):gbs) = TH.normalGE (TH.unTypeCode g) (TH.unTypeCode b) : go gbs
+
+-------------------------------------------------------------------------------
+-- State
+-------------------------------------------------------------------------------
+
+-- | We give each tag an integer, so we can order them.
+data S tag = S !Int !(Code Q tag) !ERE
+
+instance Show (S tag) where
+    show (S i _ ere) = show (i, ere)
+
+instance Eq (S tag) where
+    S i _ ere == S i' _ ere' = (i, ere) == (i', ere')
+
+instance Ord (S tag) where
+    compare (S i _ ere) (S i' _ ere') = compare (i, ere) (i', ere')
+
+type SaTTH' tag = [S tag]
+
+-------------------------------------------------------------------------------
+-- Derivative
+-------------------------------------------------------------------------------
+
+derivativeSaTTH :: Word8 -> SaTTH' tag -> SaTTH' tag
+derivativeSaTTH c ts =
+    [ S i code ere''
+    | S i code ere <- ts
+    , let ere' = derivative c ere
+    , let ere'' = simplifyERE ere'
+    , not (equivalent empty ere'')
+    ]
+
+simplifyERE :: ERE -> ERE
+simplifyERE ere
+    | equivalent ere eps = eps
+    | otherwise          = ere
+
+-- does it make sense to look further?
+emptySashaTTH :: SaTTH' tag -> Bool
+emptySashaTTH = null
+
+epsSashaTTH :: SaTTH' tag -> Bool
+epsSashaTTH grammar = and [ equivalent ere eps | S _ _ ere <- grammar ]
diff --git a/tests/Sasha/Example/Alex.hs b/tests/Sasha/Example/Alex.hs
new file mode 100644
--- /dev/null
+++ b/tests/Sasha/Example/Alex.hs
@@ -0,0 +1,363 @@
+{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-}
+{-# LANGUAGE CPP,MagicHash #-}
+{-# LINE 1 "Alex.x" #-}
+
+module Sasha.Example.Alex (alexToken) where
+
+import Data.Word (Word8)
+
+import qualified Data.ByteString as BS
+
+import Sasha.Example.Token
+
+
+#if __GLASGOW_HASKELL__ >= 603
+#include "ghcconfig.h"
+#elif defined(__GLASGOW_HASKELL__)
+#include "config.h"
+#endif
+#if __GLASGOW_HASKELL__ >= 503
+import Data.Array
+#else
+import Array
+#endif
+#if __GLASGOW_HASKELL__ >= 503
+import Data.Array.Base (unsafeAt)
+import GHC.Exts
+#else
+import GlaExts
+#endif
+alex_tab_size :: Int
+alex_tab_size = 8
+alex_base :: AlexAddr
+alex_base = AlexA#
+  "\xf8\xff\xff\xff\x9e\xff\xff\xff\x9f\xff\xff\xff\x91\xff\xff\xff\x94\xff\xff\xff\x93\xff\xff\xff\xa8\xff\xff\xff\xa0\xff\xff\xff\x98\xff\xff\xff\xa1\xff\xff\xff\x01\x00\x00\x00\xa2\xff\xff\xff\x05\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+
+alex_table :: AlexAddr
+alex_table = AlexA#
+  "\x00\x00\x0d\x00\x0d\x00\x16\x00\x17\x00\x0d\x00\x01\x00\x02\x00\x09\x00\x07\x00\x03\x00\xff\xff\x04\x00\x0b\x00\x18\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x00\x00\x0a\x00\x00\x00\x0d\x00\x0d\x00\x00\x00\x00\x00\x0d\x00\x00\x00\x00\x00\xff\xff\x13\x00\x00\x00\x00\x00\x14\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x12\x00\x0d\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+
+alex_check :: AlexAddr
+alex_check = AlexA#
+  "\xff\xff\x09\x00\x0a\x00\x65\x00\x65\x00\x0d\x00\x75\x00\x73\x00\x75\x00\x61\x00\x72\x00\x0a\x00\x6c\x00\x6c\x00\x6c\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x22\x00\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\x22\x00\x2c\x00\xff\xff\xff\xff\x22\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x20\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5b\x00\xff\xff\x5d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+
+alex_deflt :: AlexAddr
+alex_deflt = AlexA#
+  "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x00\xff\xff\x0c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+
+alex_accept = listArray (0 :: Int, 24)
+  [ AlexAccNone
+  , AlexAccNone
+  , AlexAccNone
+  , AlexAccNone
+  , AlexAccNone
+  , AlexAccNone
+  , AlexAccNone
+  , AlexAccNone
+  , AlexAccNone
+  , AlexAccNone
+  , AlexAccNone
+  , AlexAccNone
+  , AlexAccNone
+  , AlexAcc 11
+  , AlexAcc 10
+  , AlexAcc 9
+  , AlexAcc 8
+  , AlexAcc 7
+  , AlexAcc 6
+  , AlexAcc 5
+  , AlexAcc 4
+  , AlexAcc 3
+  , AlexAcc 2
+  , AlexAcc 1
+  , AlexAcc 0
+  ]
+
+alex_actions = array (0 :: Int, 12)
+  [ (11,alex_action_0)
+  , (10,alex_action_1)
+  , (9,alex_action_2)
+  , (8,alex_action_3)
+  , (7,alex_action_4)
+  , (6,alex_action_5)
+  , (5,alex_action_6)
+  , (4,alex_action_7)
+  , (3,alex_action_8)
+  , (2,alex_action_9)
+  , (1,alex_action_10)
+  , (0,alex_action_11)
+  ]
+
+{-# LINE 32 "Alex.x" #-}
+
+type AlexInput = BS.ByteString
+
+alexGetByte :: AlexInput -> Maybe (Word8, AlexInput)
+alexGetByte = BS.uncons
+
+alexToken :: BS.ByteString -> Maybe (Tk, BS.ByteString, BS.ByteString)
+alexToken bs = case alexScan bs 0 of
+    AlexEOF          -> Nothing
+    AlexError _      -> Nothing
+    AlexSkip bs' _   -> alexToken bs'
+    AlexToken _ i tk -> case BS.splitAt i bs of
+      (pfx, sfx) -> Just (tk, pfx, sfx)
+
+alex_action_0 =  TkSpace 
+alex_action_1 =  TkBraceOpen 
+alex_action_2 =  TkBraceClose 
+alex_action_3 =  TkBracketOpen 
+alex_action_4 =  TkBracketClose 
+alex_action_5 =  TkColon 
+alex_action_6 =  TkComma 
+alex_action_7 =  TkString 
+alex_action_8 =  TkNumber 
+alex_action_9 =  TkTrue 
+alex_action_10 =  TkFalse 
+alex_action_11 =  TkNull 
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+-- -----------------------------------------------------------------------------
+-- ALEX TEMPLATE
+--
+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use
+-- it for any purpose whatsoever.
+
+-- -----------------------------------------------------------------------------
+-- INTERNALS and main scanner engine
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.
+#if __GLASGOW_HASKELL__ > 706
+#define GTE(n,m) (tagToEnum# (n >=# m))
+#define EQ(n,m) (tagToEnum# (n ==# m))
+#else
+#define GTE(n,m) (n >=# m)
+#define EQ(n,m) (n ==# m)
+#endif
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+data AlexAddr = AlexA# Addr#
+-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.
+#if __GLASGOW_HASKELL__ < 503
+uncheckedShiftL# = shiftL#
+#endif
+
+{-# INLINE alexIndexInt16OffAddr #-}
+alexIndexInt16OffAddr :: AlexAddr -> Int# -> Int#
+alexIndexInt16OffAddr (AlexA# arr) off =
+#ifdef WORDS_BIGENDIAN
+  narrow16Int# i
+  where
+        i    = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)
+        high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
+        low  = int2Word# (ord# (indexCharOffAddr# arr off'))
+        off' = off *# 2#
+#else
+#if __GLASGOW_HASKELL__ >= 901
+  int16ToInt#
+#endif
+    (indexInt16OffAddr# arr off)
+#endif
+
+
+
+
+
+{-# INLINE alexIndexInt32OffAddr #-}
+alexIndexInt32OffAddr :: AlexAddr -> Int# -> Int#
+alexIndexInt32OffAddr (AlexA# arr) off =
+#ifdef WORDS_BIGENDIAN
+  narrow32Int# i
+  where
+   i    = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`
+                     (b2 `uncheckedShiftL#` 16#) `or#`
+                     (b1 `uncheckedShiftL#` 8#) `or#` b0)
+   b3   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))
+   b2   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))
+   b1   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
+   b0   = int2Word# (ord# (indexCharOffAddr# arr off'))
+   off' = off *# 4#
+#else
+#if __GLASGOW_HASKELL__ >= 901
+  int32ToInt#
+#endif
+    (indexInt32OffAddr# arr off)
+#endif
+
+
+
+
+
+
+#if __GLASGOW_HASKELL__ < 503
+quickIndex arr i = arr ! i
+#else
+-- GHC >= 503, unsafeAt is available from Data.Array.Base.
+quickIndex = unsafeAt
+#endif
+
+
+
+
+-- -----------------------------------------------------------------------------
+-- Main lexing routines
+
+data AlexReturn a
+  = AlexEOF
+  | AlexError  !AlexInput
+  | AlexSkip   !AlexInput !Int
+  | AlexToken  !AlexInput !Int a
+
+-- alexScan :: AlexInput -> StartCode -> AlexReturn a
+alexScan input__ (I# (sc))
+  = alexScanUser undefined input__ (I# (sc))
+
+alexScanUser user__ input__ (I# (sc))
+  = case alex_scan_tkn user__ input__ 0# input__ sc AlexNone of
+  (AlexNone, input__') ->
+    case alexGetByte input__ of
+      Nothing ->
+
+
+
+                                   AlexEOF
+      Just _ ->
+
+
+
+                                   AlexError input__'
+
+  (AlexLastSkip input__'' len, _) ->
+
+
+
+    AlexSkip input__'' len
+
+  (AlexLastAcc k input__''' len, _) ->
+
+
+
+    AlexToken input__''' len (alex_actions ! k)
+
+
+-- Push the input through the DFA, remembering the most recent accepting
+-- state it encountered.
+
+alex_scan_tkn user__ orig_input len input__ s last_acc =
+  input__ `seq` -- strict in the input
+  let
+  new_acc = (check_accs (alex_accept `quickIndex` (I# (s))))
+  in
+  new_acc `seq`
+  case alexGetByte input__ of
+     Nothing -> (new_acc, input__)
+     Just (c, new_input) ->
+
+
+
+      case fromIntegral c of { (I# (ord_c)) ->
+        let
+                base   = alexIndexInt32OffAddr alex_base s
+                offset = (base +# ord_c)
+                check  = alexIndexInt16OffAddr alex_check offset
+
+                new_s = if GTE(offset,0#) && EQ(check,ord_c)
+                          then alexIndexInt16OffAddr alex_table offset
+                          else alexIndexInt16OffAddr alex_deflt s
+        in
+        case new_s of
+            -1# -> (new_acc, input__)
+                -- on an error, we want to keep the input *before* the
+                -- character that failed, not after.
+            _ -> alex_scan_tkn user__ orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len)
+                                                -- note that the length is increased ONLY if this is the 1st byte in a char encoding)
+                        new_input new_s new_acc
+      }
+  where
+        check_accs (AlexAccNone) = last_acc
+        check_accs (AlexAcc a  ) = AlexLastAcc a input__ (I# (len))
+        check_accs (AlexAccSkip) = AlexLastSkip  input__ (I# (len))
+
+
+
+
+
+
+
+
+
+
+
+
+
+data AlexLastAcc
+  = AlexNone
+  | AlexLastAcc !Int !AlexInput !Int
+  | AlexLastSkip     !AlexInput !Int
+
+data AlexAcc user
+  = AlexAccNone
+  | AlexAcc Int
+  | AlexAccSkip
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/Sasha/Example/SaTTH.hs b/tests/Sasha/Example/SaTTH.hs
new file mode 100644
--- /dev/null
+++ b/tests/Sasha/Example/SaTTH.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE TemplateHaskell #-}
+-- {-# OPTIONS_GHC -ddump-splices #-}
+module Sasha.Example.SaTTH where
+
+import Algebra.Lattice ((/\))
+
+import qualified Data.ByteString  as BS
+
+import Sasha.Example.Token
+import Sasha.TTH
+
+satthToken :: BS.ByteString -> Maybe (Tk, BS.ByteString, BS.ByteString)
+satthToken = $$(satth
+    -- Lexer specification of JSON(like) tokens.
+    [ [|| TkSpace        ||] := plus (unions (map utf8Char (" \t\r\n")))
+    , [|| TkBraceOpen    ||] := "{"
+    , [|| TkBraceClose   ||] := "}"
+    , [|| TkBracketOpen  ||] := "["
+    , [|| TkBracketClose ||] := "]"
+    , [|| TkComma        ||] := ","
+    , [|| TkColon        ||] := ":"
+    , [|| TkString       ||] := appends [ "\"", star (anyChar /\ complement (utf8Char '"')), "\"" ]
+    , [|| TkNumber       ||] := plus digit
+    , [|| TkTrue         ||] := "true"
+    , [|| TkFalse        ||] := "false"
+    , [|| TkNull         ||] := "null"
+    ])
+
+
+satthUtf8 :: BS.ByteString -> Maybe ((), BS.ByteString, BS.ByteString)
+satthUtf8 = $$(satth [ [|| () ||] := anyUtf8Char ] )
diff --git a/tests/Sasha/Example/Sasha.hs b/tests/Sasha/Example/Sasha.hs
new file mode 100644
--- /dev/null
+++ b/tests/Sasha/Example/Sasha.hs
@@ -0,0 +1,31 @@
+module Sasha.Example.Sasha (sashaToken, sashaUtf8) where
+
+import Algebra.Lattice ((/\))
+
+import qualified Data.ByteString  as BS
+
+import Sasha.Example.Token
+import Sasha
+
+-- | Lexer specification of JSON(like) tokens.
+grammar :: Sasha Tk
+grammar =
+    [ TkSpace        := plus (unions (map utf8Char (" \t\r\n")))
+    , TkBraceOpen    := "{"
+    , TkBraceClose   := "}"
+    , TkBracketOpen  := "["
+    , TkBracketClose := "]"
+    , TkComma        := ","
+    , TkColon        := ":"
+    , TkString       := appends [ "\"", star (anyChar /\ complement (utf8Char '"')), "\"" ]
+    , TkNumber       := plus digit
+    , TkTrue         := "true"
+    , TkFalse        := "false"
+    , TkNull         := "null"
+    ]
+
+sashaToken :: BS.ByteString -> Maybe (Tk, BS.ByteString, BS.ByteString)
+sashaToken = sasha grammar
+
+sashaUtf8 :: BS.ByteString -> Maybe ((), BS.ByteString, BS.ByteString)
+sashaUtf8 = sasha [ () := anyUtf8Char ]
diff --git a/tests/Sasha/Example/Token.hs b/tests/Sasha/Example/Token.hs
new file mode 100644
--- /dev/null
+++ b/tests/Sasha/Example/Token.hs
@@ -0,0 +1,25 @@
+module Sasha.Example.Token where
+
+import Control.DeepSeq (NFData (rnf))
+
+data Tk
+    = TkErr
+    | TkSpace
+    | TkBraceOpen
+    | TkBraceClose
+    | TkBracketOpen
+    | TkBracketClose
+    | TkComma
+    | TkColon
+    | TkString
+    | TkNumber
+    | TkTrue
+    | TkFalse
+    | TkNull
+  deriving (Eq, Show)
+
+instance NFData Tk where
+    rnf !_ = ()
+
+pattern (:=) :: a -> b -> (a, b)
+pattern x := y = (x, y)
diff --git a/tests/sasha-tests.hs b/tests/sasha-tests.hs
new file mode 100644
--- /dev/null
+++ b/tests/sasha-tests.hs
@@ -0,0 +1,116 @@
+{-# LANGUAGE CPP #-}
+module Main (main) where
+
+import Data.Either           (isRight)
+import System.Environment    (getArgs, withArgs)
+import Test.Tasty            (defaultMain, testGroup)
+import Test.Tasty.HUnit      (testCase, (@?=))
+import Test.Tasty.QuickCheck (label, testProperty, (===))
+
+import qualified Data.Aeson         as A
+import qualified Data.ByteString    as BS
+import qualified Data.Text.Encoding as TE
+import qualified Test.Tasty.Bench   as B
+
+import Sasha.Example.Alex
+import Sasha.Example.Sasha
+import Sasha.Example.SaTTH
+import Sasha.Example.Token
+
+main :: IO ()
+main = do
+    input <- BS.readFile "example.json"
+    args  <- getArgs
+    case args of
+        "bench" : args' -> withArgs args' $ B.defaultMain
+            [ B.bgroup "json"
+                [ B.bench "sasha" $ B.nf (tokens sashaToken)       input
+                , B.bench "alex"  $ B.nf (tokens alexToken)        input
+                , B.bench "satth" $ B.nf (tokens satthToken)       input
+                , B.bench "aeson" $ B.nf (A.decodeStrict @A.Value) input
+                ]
+            , B.bgroup "utf8"
+                [ B.bench "sasha"      $ B.whnf (accepts sashaToken) input
+                , B.bench "satth"      $ B.whnf (accepts satthToken) input
+#if MIN_VERSION_bytestring(0,11,2)
+                , B.bench "bytestring" $ B.whnf BS.isValidUtf8 input
+#endif
+                ]
+            ]
+
+        _ -> defaultMain $ testGroup "sasha-json"
+            [ testGroup "json"
+                [ testCase "sasha" $ tokens sashaToken input @?= expectedJson
+                , testCase "satth" $ tokens satthToken input @?= expectedJson
+                , testCase "alex"  $ tokens alexToken  input @?= expectedJson
+                ]
+            , testGroup "utf8"
+                [ testProperty "sasha" $ \w8s ->
+                    let bs = BS.pack w8s
+                        isValid = isRight (TE.decodeUtf8' bs)
+                    in label (show isValid) $ accepts sashaUtf8 bs === isValid
+
+                , testProperty "sasha" $ \w8s ->
+                    let bs = BS.pack w8s
+                        isValid = isRight (TE.decodeUtf8' bs)
+                    in label (show isValid) $ accepts satthUtf8 bs === isValid
+                ]
+            ]
+
+tokens
+    :: (BS.ByteString -> Maybe (Tk, BS.ByteString, BS.ByteString))  -- ^ single token scanner
+    -> BS.ByteString                                                -- ^ input
+    -> [(Tk, BS.ByteString)]                                        -- ^ result list of tokens
+tokens scan = go
+  where
+    go !bs
+        | BS.null bs = []
+        | otherwise  = case scan bs of
+            Nothing             -> [(TkErr, bs)]
+            Just (tk, pfx, sfx) -> (tk, pfx) : go sfx
+{-# INLINE tokens #-}
+
+accepts
+    :: (BS.ByteString -> Maybe (a, b, BS.ByteString))  -- ^ single token scanner
+    -> BS.ByteString                                   -- ^ input
+    -> Bool
+accepts scan = go
+  where
+    go !bs
+        | BS.null bs = True
+        | otherwise  = case scan bs of
+            Nothing          -> False
+            Just (_, _, sfx) -> go sfx
+{-# INLINE accepts #-}
+
+expectedJson :: [(Tk, BS.ByteString)]
+expectedJson =
+    [ TkBraceOpen    := "{"
+    , TkSpace        := "\n    "
+    , TkString       := "\"literals\""
+    , TkColon        := ":"
+    , TkSpace        := " "
+    , TkBracketOpen  := "["
+    , TkTrue         := "true"
+    , TkComma        := ","
+    , TkSpace        := " "
+    , TkFalse        := "false"
+    , TkComma        := ","
+    , TkSpace        := " "
+    , TkNull         := "null"
+    , TkBracketClose := "]"
+    , TkComma        := ","
+    , TkSpace        := "\n    "
+    , TkString       := "\"numbers\""
+    , TkColon        := ":"
+    , TkSpace        := " "
+    , TkBracketOpen  := "["
+    , TkNumber       := "0"
+    , TkComma        := ","
+    , TkSpace        := " "
+    , TkNumber       := "123"
+    , TkBracketClose := "]"
+    , TkSpace        := "\n"
+    , TkBraceClose   := "}"
+    , TkSpace        := "\n"
+    ]