diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,3 @@
+## 0.1.0.0 -- 2021-01-XX
+
+* First version. Released on an unsuspecting world.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,5 @@
+Apache-2.0 OR MPL-2.0
+
+---
+
+See https://github.com/mizunashi-mana/tlex/blob/master/LICENSE
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,1 @@
+See https://hackage.haskell.org/package/tlex
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import           Distribution.Extra.Doctest (defaultMainWithDoctests)
+
+main :: IO ()
+main = defaultMainWithDoctests "doctest"
diff --git a/src/Language/Lexer/Tlex/Data/Bag.hs b/src/Language/Lexer/Tlex/Data/Bag.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Lexer/Tlex/Data/Bag.hs
@@ -0,0 +1,45 @@
+module Language.Lexer.Tlex.Data.Bag (
+    Bag,
+    fromList,
+    singleton,
+) where
+
+import           Language.Lexer.Tlex.Prelude
+
+
+data Bag a
+    = EmptyBag
+    | UnitBag a
+    | IncludeBags (Bag a) (Bag a)
+    | ListBag [a]
+    deriving (Show, Functor)
+
+instance Foldable Bag where
+    foldr k z = \case
+        EmptyBag          -> z
+        UnitBag x         -> k x z
+        IncludeBags b1 b2 -> foldr k (foldr k z b2) b1
+        ListBag xs        -> foldr k z xs
+
+    foldMap f = \case
+        EmptyBag          -> mempty
+        UnitBag x         -> f x
+        IncludeBags b1 b2 -> foldMap f b1 <> foldMap f b2
+        ListBag xs        -> foldMap f xs
+
+instance Eq a => Eq (Bag a) where
+    b1 == b2 = toList b1 == toList b2
+
+instance Semigroup (Bag a) where
+    EmptyBag <> b2 = b2
+    b1 <> EmptyBag = b1
+    b1 <> b2       = IncludeBags b1 b2
+
+instance Monoid (Bag a) where
+    mempty = EmptyBag
+
+fromList :: [a] -> Bag a
+fromList xs = ListBag xs
+
+singleton :: a -> Bag a
+singleton x = UnitBag x
diff --git a/src/Language/Lexer/Tlex/Data/EnumMap.hs b/src/Language/Lexer/Tlex/Data/EnumMap.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Lexer/Tlex/Data/EnumMap.hs
@@ -0,0 +1,103 @@
+module Language.Lexer.Tlex.Data.EnumMap (
+    EnumMap,
+    empty,
+    insert,
+    assocs,
+    keys,
+    toAscList,
+    toDescList,
+    lookup,
+    member,
+    insertOrUpdate,
+    fromList,
+    foldlWithKey',
+    update,
+    delete,
+    singleton,
+    unionWith,
+    intersectionWith,
+    mapWithKey,
+    mergeWithKey,
+) where
+
+import           Prelude            hiding (lookup)
+
+import qualified Data.Coerce        as Coerce
+import qualified Data.IntMap.Strict as IntMap
+
+
+newtype EnumMap k a = EnumMap
+    { unEnumMap :: IntMap.IntMap a
+    }
+    deriving (Eq, Show, Functor)
+
+empty :: Enum k => EnumMap k a
+empty = EnumMap IntMap.empty
+
+singleton :: Enum k => k -> a -> EnumMap k a
+singleton k x = EnumMap do IntMap.singleton (fromEnum k) x
+
+insert :: Enum k => k -> a -> EnumMap k a -> EnumMap k a
+insert k x (EnumMap m) = EnumMap do IntMap.insert (fromEnum k) x m
+
+assocs :: Enum k => EnumMap k a -> [(k, a)]
+assocs (EnumMap m) = [ (toEnum i, x) | (i, x) <- IntMap.assocs m ]
+
+keys :: Enum k => EnumMap k a -> [k]
+keys (EnumMap m) = [ toEnum k | k <- IntMap.keys m ]
+
+toAscList :: Enum k => EnumMap k a -> [(k, a)]
+toAscList (EnumMap m) = [ (toEnum i, x) | (i, x) <- IntMap.toAscList m ]
+
+toDescList :: Enum k => EnumMap k a -> [(k, a)]
+toDescList (EnumMap m) = [ (toEnum i, x) | (i, x) <- IntMap.toDescList m ]
+
+lookup :: Enum k => k -> EnumMap k a -> Maybe a
+lookup k (EnumMap m) = IntMap.lookup (fromEnum k) m
+
+member :: Enum k => k -> EnumMap k a -> Bool
+member k (EnumMap m) = IntMap.member (fromEnum k) m
+
+insertOrUpdate :: Enum k => k -> a -> (a -> a) -> EnumMap k a -> EnumMap k a
+insertOrUpdate k ~dx ~uf (EnumMap m) =
+    let ik = fromEnum k
+    in EnumMap case IntMap.lookup ik m of
+        Nothing -> IntMap.insert ik dx m
+        Just x  -> IntMap.insert ik (uf x) m
+
+fromList :: Enum k => [(k, a)] -> EnumMap k a
+fromList xs = EnumMap do IntMap.fromList [ (fromEnum i, x) | (i, x) <- xs ]
+
+delete :: Enum k => k -> EnumMap k a -> EnumMap k a
+delete k (EnumMap m) = EnumMap do IntMap.delete (fromEnum k) m
+
+foldlWithKey' :: Enum k => (b -> k -> a -> b) -> b -> EnumMap k a -> b
+foldlWithKey' f acc0 (EnumMap m) = IntMap.foldlWithKey' (\acc i x -> f acc (toEnum i) x) acc0 m
+
+update :: Enum k => (a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
+update f k (EnumMap m) = EnumMap do IntMap.update f (fromEnum k) m
+
+unionWith :: Enum k => (a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
+unionWith f (EnumMap m1) (EnumMap m2) = EnumMap do IntMap.unionWith f m1 m2
+
+intersectionWith :: Enum k => (a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
+intersectionWith f (EnumMap m1) (EnumMap m2) = EnumMap do IntMap.intersectionWith f m1 m2
+
+mapWithKey :: Enum k => (k -> a -> b) -> EnumMap k a -> EnumMap k b
+mapWithKey f (EnumMap m) = EnumMap do
+    IntMap.mapWithKey
+        do \i x -> f (toEnum i) x
+        do m
+
+mergeWithKey :: Enum k
+    => (k -> a -> b -> Maybe c)
+    -> (EnumMap k a -> EnumMap k c)
+    -> (EnumMap k b -> EnumMap k c)
+    -> EnumMap k a -> EnumMap k b -> EnumMap k c
+mergeWithKey f g1 g2 (EnumMap m1) (EnumMap m2) = EnumMap do
+    IntMap.mergeWithKey
+        do \i x y -> f (toEnum i) x y
+        do \m -> Coerce.coerce g1 m
+        do \m -> Coerce.coerce g2 m
+        do m1
+        do m2
diff --git a/src/Language/Lexer/Tlex/Data/EnumSet.hs b/src/Language/Lexer/Tlex/Data/EnumSet.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Lexer/Tlex/Data/EnumSet.hs
@@ -0,0 +1,61 @@
+module Language.Lexer.Tlex.Data.EnumSet (
+    EnumSet,
+    empty,
+    singleton,
+    insert,
+    union,
+    intersection,
+    difference,
+    partition,
+    fromList,
+    toList,
+    toIntSet,
+) where
+
+import           Language.Lexer.Tlex.Prelude hiding (empty, toList)
+
+import qualified Data.Hashable               as Hashable
+import qualified Data.IntSet                 as IntSet
+
+
+newtype EnumSet a = EnumSet IntSet.IntSet
+    deriving (Eq, Show)
+
+instance Hashable.Hashable (EnumSet a) where
+    hashWithSalt s (EnumSet x) = Hashable.hashWithSalt s do IntSet.toAscList x
+
+empty :: Enum a => EnumSet a
+empty = EnumSet IntSet.empty
+
+singleton :: Enum a => a -> EnumSet a
+singleton x = EnumSet do IntSet.singleton do fromEnum x
+
+insert :: Enum a => a -> EnumSet a -> EnumSet a
+insert x (EnumSet s) = EnumSet
+    do IntSet.insert
+        do fromEnum x
+        do s
+
+union :: Enum a => EnumSet a -> EnumSet a -> EnumSet a
+union (EnumSet s1) (EnumSet s2) = EnumSet do IntSet.union s1 s2
+
+intersection :: Enum a => EnumSet a -> EnumSet a -> EnumSet a
+intersection (EnumSet s1) (EnumSet s2) = EnumSet do IntSet.intersection s1 s2
+
+difference :: Enum a => EnumSet a -> EnumSet a -> EnumSet a
+difference (EnumSet s1) (EnumSet s2) = EnumSet do IntSet.difference s1 s2
+
+partition :: Enum a => (a -> Bool) -> EnumSet a -> (EnumSet a, EnumSet a)
+partition p (EnumSet s) = coerce
+    do IntSet.partition
+        do \i -> p do toEnum i
+        s
+
+fromList :: Enum a => [a] -> EnumSet a
+fromList xs = EnumSet do IntSet.fromList [ fromEnum x | x <- xs ]
+
+toList :: Enum a => EnumSet a -> [a]
+toList (EnumSet xs) = [ toEnum x | x <- IntSet.toList xs ]
+
+toIntSet :: Enum a => EnumSet a -> IntSet.IntSet
+toIntSet (EnumSet m) = m
diff --git a/src/Language/Lexer/Tlex/Data/Graph.hs b/src/Language/Lexer/Tlex/Data/Graph.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Lexer/Tlex/Data/Graph.hs
@@ -0,0 +1,13 @@
+module Language.Lexer.Tlex.Data.Graph (
+    transClosure,
+) where
+
+import qualified Data.Array    as Array
+import           Data.Foldable
+import qualified Data.Graph    as Graph
+
+transClosure :: Graph.Graph -> Graph.Graph
+transClosure gr = Array.listArray r [ goDfs v | v <- Graph.vertices gr ] where
+    r = Array.bounds gr
+
+    goDfs v = foldMap (\t -> toList t) do Graph.dfs gr [v]
diff --git a/src/Language/Lexer/Tlex/Data/SymEnumSet.hs b/src/Language/Lexer/Tlex/Data/SymEnumSet.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Lexer/Tlex/Data/SymEnumSet.hs
@@ -0,0 +1,142 @@
+module Language.Lexer.Tlex.Data.SymEnumSet (
+    SymEnumSet,
+    empty,
+    full,
+    complement,
+    singleton,
+    union,
+    intersection,
+    difference,
+    fromEnumSet,
+    toEnumSet,
+) where
+
+import           Prelude
+
+import qualified Language.Lexer.Tlex.Data.EnumSet as EnumSet
+
+
+data SymEnumSet a = SymEnumSet
+    { isStraight      :: Bool
+    , internalEnumSet :: EnumSet.EnumSet a
+    }
+    deriving (Eq, Show)
+
+empty :: Enum a => SymEnumSet a
+empty = SymEnumSet
+    { isStraight = True
+    , internalEnumSet = EnumSet.empty
+    }
+
+full :: Enum a => SymEnumSet a
+full = SymEnumSet
+    { isStraight = False
+    , internalEnumSet = EnumSet.empty
+    }
+
+complement :: Enum a => SymEnumSet a -> SymEnumSet a
+complement s = s
+    { isStraight = not do isStraight s
+    }
+
+singleton :: Enum a => a -> SymEnumSet a
+singleton x = SymEnumSet
+    { isStraight = True
+    , internalEnumSet = EnumSet.singleton x
+    }
+
+union :: Enum a => SymEnumSet a -> SymEnumSet a -> SymEnumSet a
+union s1 s2 = case isStraight s1 of
+    True -> case isStraight s2 of
+        True -> SymEnumSet
+            { isStraight = True
+            , internalEnumSet = EnumSet.union
+                do internalEnumSet s1
+                do internalEnumSet s2
+            }
+        False -> SymEnumSet
+            { isStraight = False
+            , internalEnumSet = EnumSet.difference
+                do internalEnumSet s2
+                do internalEnumSet s1
+            }
+    False -> case isStraight s2 of
+        True -> SymEnumSet
+            { isStraight = False
+            , internalEnumSet = EnumSet.difference
+                do internalEnumSet s1
+                do internalEnumSet s2
+            }
+        False -> SymEnumSet
+            { isStraight = False
+            , internalEnumSet = EnumSet.intersection
+                do internalEnumSet s1
+                do internalEnumSet s2
+            }
+
+intersection :: Enum a => SymEnumSet a -> SymEnumSet a -> SymEnumSet a
+intersection s1 s2 = case isStraight s1 of
+    True -> case isStraight s2 of
+        True -> SymEnumSet
+            { isStraight = True
+            , internalEnumSet = EnumSet.intersection
+                do internalEnumSet s1
+                do internalEnumSet s2
+            }
+        False -> SymEnumSet
+            { isStraight = True
+            , internalEnumSet = EnumSet.difference
+                do internalEnumSet s1
+                do internalEnumSet s2
+            }
+    False -> case isStraight s2 of
+        True -> SymEnumSet
+            { isStraight = True
+            , internalEnumSet = EnumSet.difference
+                do internalEnumSet s2
+                do internalEnumSet s1
+            }
+        False -> SymEnumSet
+            { isStraight = False
+            , internalEnumSet = EnumSet.union
+                do internalEnumSet s1
+                do internalEnumSet s2
+            }
+
+difference :: Enum a => SymEnumSet a -> SymEnumSet a -> SymEnumSet a
+difference s1 s2 = case isStraight s1 of
+    True -> case isStraight s2 of
+        True -> SymEnumSet
+            { isStraight = True
+            , internalEnumSet = EnumSet.difference
+                do internalEnumSet s1
+                do internalEnumSet s2
+            }
+        False -> SymEnumSet
+            { isStraight = True
+            , internalEnumSet = EnumSet.intersection
+                do internalEnumSet s1
+                do internalEnumSet s2
+            }
+    False -> case isStraight s2 of
+        True -> SymEnumSet
+            { isStraight = False
+            , internalEnumSet = EnumSet.union
+                do internalEnumSet s2
+                do internalEnumSet s1
+            }
+        False -> SymEnumSet
+            { isStraight = True
+            , internalEnumSet = EnumSet.difference
+                do internalEnumSet s2
+                do internalEnumSet s1
+            }
+
+fromEnumSet :: Enum a => Bool -> EnumSet.EnumSet a -> SymEnumSet a
+fromEnumSet b s = SymEnumSet
+    { isStraight = b
+    , internalEnumSet = s
+    }
+
+toEnumSet :: Enum a => SymEnumSet a -> (Bool, EnumSet.EnumSet a)
+toEnumSet s = (isStraight s, internalEnumSet s)
diff --git a/src/Language/Lexer/Tlex/Machine/DFA.hs b/src/Language/Lexer/Tlex/Machine/DFA.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Lexer/Tlex/Machine/DFA.hs
@@ -0,0 +1,100 @@
+module Language.Lexer.Tlex.Machine.DFA (
+    DFA (..),
+    DFAState (..),
+    DFABuilder,
+    DFABuilderContext,
+    buildDFA,
+    newStateNum,
+    insertTrans,
+    accept,
+    initial,
+) where
+
+import           Language.Lexer.Tlex.Prelude
+
+import qualified Data.IntMap                         as IntMap
+import qualified Data.List                           as List
+import qualified Language.Lexer.Tlex.Data.EnumMap    as EnumMap
+import qualified Language.Lexer.Tlex.Machine.Pattern as Pattern
+import qualified Language.Lexer.Tlex.Machine.State   as MState
+
+
+data DFA a = DFA
+    { dfaInitials :: EnumMap.EnumMap Pattern.StartState MState.StateNum
+    , dfaTrans    :: MState.StateArray (DFAState a)
+    }
+    deriving (Eq, Show, Functor)
+
+data DFAState a = DState
+    { dstAccepts    :: [Pattern.Accept a]
+    , dstTrans      :: IntMap.IntMap MState.StateNum
+    , dstOtherTrans :: Maybe MState.StateNum
+    }
+    deriving (Eq, Show, Functor)
+
+
+data DFABuilderContext m = DFABuilderContext
+    { dfaBCtxInitials     :: EnumMap.EnumMap Pattern.StartState MState.StateNum
+    , dfaBCtxNextStateNum :: MState.StateNum
+    , dfaBCtxStateMap     :: MState.StateMap (DFAState m)
+    }
+    deriving (Eq, Show, Functor)
+
+type DFABuilder m = State (DFABuilderContext m)
+
+buildDFA :: DFABuilder m () -> DFA m
+buildDFA builder =
+    let bctx = execState builder initialBCtx
+        arr = MState.totalStateMapToArray
+            do dfaBCtxNextStateNum bctx
+            do dfaBCtxStateMap bctx
+    in DFA
+        { dfaInitials = dfaBCtxInitials bctx
+        , dfaTrans = arr
+        }
+    where
+        initialBCtx = DFABuilderContext
+            { dfaBCtxInitials = EnumMap.empty
+            , dfaBCtxNextStateNum = MState.initialStateNum
+            , dfaBCtxStateMap = MState.emptyMap
+            }
+
+newStateNum :: DFABuilder m MState.StateNum
+newStateNum = do
+    ctx0 <- get
+    let nextStateNum = dfaBCtxNextStateNum ctx0
+    put do ctx0
+            { dfaBCtxNextStateNum = succ nextStateNum
+            }
+    pure nextStateNum
+
+insertTrans :: MState.StateNum -> DFAState m -> DFABuilder m ()
+insertTrans sf st = modify' \ctx0@DFABuilderContext{ dfaBCtxStateMap } -> ctx0
+    { dfaBCtxStateMap = addCondTrans dfaBCtxStateMap
+    }
+    where
+        addCondTrans n = MState.insertMap sf st n
+
+accept :: MState.StateNum -> Pattern.Accept m -> DFABuilder m ()
+accept s x = modify' \ctx0@DFABuilderContext{ dfaBCtxStateMap } -> ctx0
+    { dfaBCtxStateMap = addAccept dfaBCtxStateMap
+    }
+    where
+        addAccept n = MState.insertOrUpdateMap s
+            do DState
+                { dstAccepts = [x]
+                , dstTrans = IntMap.empty
+                , dstOtherTrans = Nothing
+                }
+            do \ds@DState { dstAccepts } -> ds
+                { dstAccepts = List.insertBy
+                    Pattern.compareAcceptsByPriority
+                    x
+                    dstAccepts
+                }
+            do n
+
+initial :: MState.StateNum -> Pattern.StartState -> DFABuilder m ()
+initial s x = modify' \ctx0@DFABuilderContext{ dfaBCtxInitials } -> ctx0
+    { dfaBCtxInitials = EnumMap.insert x s dfaBCtxInitials
+    }
diff --git a/src/Language/Lexer/Tlex/Machine/NFA.hs b/src/Language/Lexer/Tlex/Machine/NFA.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Lexer/Tlex/Machine/NFA.hs
@@ -0,0 +1,146 @@
+module Language.Lexer.Tlex.Machine.NFA
+    (
+        NFA (..),
+        NFAState(..),
+        NFAStateTrans(..),
+        NFABuilder,
+        NFABuilderContext,
+        buildNFA,
+        epsilonClosed,
+        newStateNum,
+        epsilonTrans,
+        condTrans,
+        accept,
+        initial,
+    ) where
+
+import           Language.Lexer.Tlex.Prelude
+
+import qualified Data.IntSet                         as IntSet
+import qualified Language.Lexer.Tlex.Data.Graph      as Graph
+import qualified Language.Lexer.Tlex.Machine.Pattern as Pattern
+import qualified Language.Lexer.Tlex.Machine.State   as MState
+
+
+data NFA a = NFA
+    { nfaInitials :: [(MState.StateNum, Pattern.StartState)]
+    , nfaTrans    :: MState.StateArray (NFAState a)
+    }
+    deriving (Eq, Show, Functor)
+
+data NFAState a = NState
+    { nstAccepts      :: [Pattern.Accept a]
+    , nstEpsilonTrans :: [MState.StateNum]
+    , nstTrans        :: [NFAStateTrans]
+    }
+    deriving (Eq, Show, Functor)
+
+data NFAStateTrans = NFAStateTrans
+    { nstTransIsStraight :: Bool
+    , nstTransRange      :: IntSet.IntSet
+    , nstTransNextState  :: MState.StateNum
+    }
+    deriving (Eq, Show)
+
+epsilonClosed :: NFA a -> NFA a
+epsilonClosed nfa@NFA{ nfaTrans } = nfa
+    { nfaTrans = MState.mapArrayWithIx go nfaTrans
+    }
+    where
+        go v s = s
+            { nstEpsilonTrans = gr `MState.indexGraph` v
+            }
+
+        gr = MState.liftGraphOp Graph.transClosure
+            do MState.stateArrayToGraph do fmap nstEpsilonTrans nfaTrans
+
+
+data NFABuilderContext m = NFABuilderContext
+    { nfaBCtxInitials     :: [(MState.StateNum, Pattern.StartState)]
+    , nfaBCtxNextStateNum :: MState.StateNum
+    , nfaBCtxStateMap     :: MState.StateMap (NFAState m)
+    }
+
+type NFABuilder m = State (NFABuilderContext m)
+
+buildNFA :: NFABuilder m () -> NFA m
+buildNFA builder =
+    let bctx = execState builder initialBCtx
+        arr = MState.totalStateMapToArray
+            do nfaBCtxNextStateNum bctx
+            do nfaBCtxStateMap bctx
+    in epsilonClosed
+        do NFA
+            { nfaInitials = nfaBCtxInitials bctx
+            , nfaTrans = arr
+            }
+    where
+        initialBCtx = NFABuilderContext
+            { nfaBCtxInitials = []
+            , nfaBCtxNextStateNum = MState.initialStateNum
+            , nfaBCtxStateMap = MState.emptyMap
+            }
+
+newStateNum :: NFABuilder m MState.StateNum
+newStateNum = do
+    ctx0 <- get
+    let nextStateNum = nfaBCtxNextStateNum ctx0
+    put do ctx0
+            { nfaBCtxNextStateNum = succ nextStateNum
+            }
+    pure nextStateNum
+
+epsilonTrans :: MState.StateNum -> MState.StateNum -> NFABuilder m ()
+epsilonTrans sf st
+    | sf == st  = pure ()
+    | otherwise = modify' \ctx0@NFABuilderContext{ nfaBCtxStateMap } -> ctx0
+        { nfaBCtxStateMap = addEpsTrans nfaBCtxStateMap
+        }
+    where
+        addEpsTrans n = MState.insertOrUpdateMap sf
+            do NState
+                { nstAccepts = []
+                , nstEpsilonTrans = [st]
+                , nstTrans = []
+                }
+            do \s@NState{ nstEpsilonTrans } -> s
+                { nstEpsilonTrans = st:nstEpsilonTrans
+                }
+            do n
+
+condTrans :: MState.StateNum -> NFAStateTrans -> NFABuilder m ()
+condTrans sf st = modify' \ctx0@NFABuilderContext{ nfaBCtxStateMap } -> ctx0
+    { nfaBCtxStateMap = addCondTrans nfaBCtxStateMap
+    }
+    where
+        addCondTrans n = MState.insertOrUpdateMap sf
+            do NState
+                { nstAccepts = []
+                , nstEpsilonTrans = []
+                , nstTrans = [st]
+                }
+            do \s@NState{ nstTrans } -> s
+                { nstTrans = st:nstTrans
+                }
+            do n
+
+accept :: MState.StateNum -> Pattern.Accept m -> NFABuilder m ()
+accept s x = modify' \ctx0@NFABuilderContext{ nfaBCtxStateMap } -> ctx0
+    { nfaBCtxStateMap = addAccept nfaBCtxStateMap
+    }
+    where
+        addAccept n = MState.insertOrUpdateMap s
+            do NState
+                { nstAccepts = [x]
+                , nstEpsilonTrans = []
+                , nstTrans = []
+                }
+            do \ns@NState{ nstAccepts } -> ns
+                { nstAccepts = x:nstAccepts
+                }
+            do n
+
+initial :: MState.StateNum -> Pattern.StartState -> NFABuilder m ()
+initial s x = modify' \ctx0@NFABuilderContext{ nfaBCtxInitials } -> ctx0
+    { nfaBCtxInitials = (s, x):nfaBCtxInitials
+    }
diff --git a/src/Language/Lexer/Tlex/Machine/Pattern.hs b/src/Language/Lexer/Tlex/Machine/Pattern.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Lexer/Tlex/Machine/Pattern.hs
@@ -0,0 +1,67 @@
+module Language.Lexer.Tlex.Machine.Pattern (
+    Pattern (..),
+    enumsP,
+    straightEnumSetP,
+    anyoneP,
+    AcceptPriority (..),
+    mostPriority,
+    Accept (..),
+    compareAcceptsByPriority,
+    StartState (..),
+    startStateFromEnum,
+) where
+
+import           Language.Lexer.Tlex.Prelude
+
+import qualified Data.Hashable                       as Hashable
+import qualified Language.Lexer.Tlex.Data.EnumSet    as EnumSet
+import qualified Language.Lexer.Tlex.Data.SymEnumSet as SymEnumSet
+
+
+newtype StartState = StartState Int
+    deriving (Eq, Show)
+    deriving Enum via Int
+
+startStateFromEnum :: Enum s => s -> StartState
+startStateFromEnum x = StartState do fromEnum x
+
+
+newtype AcceptPriority = AcceptPriority Int
+    deriving (Eq, Show)
+    deriving Ord via Down Int
+    deriving (Hashable.Hashable, Enum) via Int
+
+mostPriority :: AcceptPriority
+mostPriority = AcceptPriority 0
+
+data Accept a = Accept
+    { accPriority       :: AcceptPriority
+    , accSemanticAction :: a
+    }
+    deriving (Eq, Show, Functor)
+
+compareAcceptsByPriority :: Accept a -> Accept a -> Ordering
+compareAcceptsByPriority Accept{ accPriority = p1 } Accept{ accPriority = p2 } = p1 `compare` p2
+
+data Pattern e
+    = Epsilon
+    | Pattern e :^: Pattern e
+    | Pattern e :|: Pattern e
+    | Many (Pattern e)
+    | Range (SymEnumSet.SymEnumSet e)
+    deriving (Eq, Show)
+
+instance Enum e => Semigroup (Pattern e) where
+    (<>) = (:^:)
+
+instance Enum e => Monoid (Pattern e) where
+    mempty = Epsilon
+
+enumsP :: Enum e => [e] -> Pattern e
+enumsP l = straightEnumSetP do EnumSet.fromList l
+
+straightEnumSetP :: Enum e => EnumSet.EnumSet e -> Pattern e
+straightEnumSetP s = Range do SymEnumSet.fromEnumSet True s
+
+anyoneP :: Enum e => Pattern e
+anyoneP = Range SymEnumSet.full
diff --git a/src/Language/Lexer/Tlex/Machine/State.hs b/src/Language/Lexer/Tlex/Machine/State.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Lexer/Tlex/Machine/State.hs
@@ -0,0 +1,144 @@
+module Language.Lexer.Tlex.Machine.State (
+    StateNum,
+    initialStateNum,
+
+    StateSet,
+    emptySet,
+    singletonSet,
+    listToSet,
+    setToList,
+    nullSet,
+    insertSet,
+    intersectSet,
+    diffSet,
+    unionSet,
+    lengthSet,
+    memberSet,
+
+    StateMap,
+    emptyMap,
+    insertOrUpdateMap,
+    insertMap,
+    lookupMap,
+    assocsMap,
+
+    StateArray,
+    totalStateMapToArray,
+    mapArrayWithIx,
+    indexArray,
+    arrayAssocs,
+
+    StateGraph,
+    stateArrayToGraph,
+    liftGraphOp,
+    indexGraph,
+) where
+
+import           Language.Lexer.Tlex.Prelude
+
+import qualified Data.Array                  as Array
+import qualified Data.Graph                  as Graph
+import qualified Data.Hashable               as Hashable
+import qualified Data.IntMap.Strict          as IntMap
+import qualified Data.IntSet                 as IntSet
+
+
+newtype StateNum = StateNum Int
+    deriving (Eq, Ord, Show, Ix)
+    deriving (Hashable.Hashable, Enum) via Int
+
+initialStateNum :: StateNum
+initialStateNum = StateNum 0
+
+
+newtype StateSet = StateSet IntSet.IntSet
+    deriving (Eq, Show)
+
+instance Hashable.Hashable StateSet where
+    hashWithSalt s (StateSet x) = Hashable.hashWithSalt s do IntSet.toAscList x
+
+emptySet :: StateSet
+emptySet = StateSet IntSet.empty
+
+singletonSet :: StateNum -> StateSet
+singletonSet (StateNum s) = StateSet do IntSet.singleton s
+
+insertSet :: StateNum -> StateSet -> StateSet
+insertSet (StateNum s) (StateSet ss) = StateSet do IntSet.insert s ss
+
+listToSet :: [StateNum] -> StateSet
+listToSet ss = StateSet do IntSet.fromList do coerce ss
+
+setToList :: StateSet -> [StateNum]
+setToList (StateSet ss) = coerce do IntSet.toList ss
+
+nullSet :: StateSet -> Bool
+nullSet (StateSet ss) = IntSet.null ss
+
+intersectSet :: StateSet -> StateSet -> StateSet
+intersectSet (StateSet ss1) (StateSet ss2) = StateSet do IntSet.intersection ss1 ss2
+
+diffSet :: StateSet -> StateSet -> StateSet
+diffSet (StateSet ss1) (StateSet ss2) = StateSet do IntSet.difference ss1 ss2
+
+unionSet :: StateSet -> StateSet -> StateSet
+unionSet (StateSet ss1) (StateSet ss2) = StateSet do IntSet.union ss1 ss2
+
+lengthSet :: StateSet -> Int
+lengthSet (StateSet ss) = IntSet.size ss
+
+memberSet :: StateNum -> StateSet -> Bool
+memberSet (StateNum s) (StateSet ss) = IntSet.member s ss
+
+
+newtype StateMap a = StateMap (IntMap.IntMap a)
+    deriving (Eq, Show, Functor)
+
+emptyMap :: StateMap a
+emptyMap = StateMap IntMap.empty
+
+insertMap :: StateNum -> a -> StateMap a -> StateMap a
+insertMap (StateNum k) x (StateMap m) = StateMap do IntMap.insert k x m
+
+insertOrUpdateMap :: StateNum -> a -> (a -> a) -> StateMap a -> StateMap a
+insertOrUpdateMap (StateNum k) ~dx ~uf (StateMap m) = StateMap case IntMap.lookup k m of
+    Nothing -> IntMap.insert k dx m
+    Just x  -> IntMap.insert k (uf x) m
+
+lookupMap :: StateNum -> StateMap a -> Maybe a
+lookupMap (StateNum sn) (StateMap m) = IntMap.lookup sn m
+
+assocsMap :: StateMap a -> [(StateNum, a)]
+assocsMap (StateMap m) = coerce do IntMap.assocs m
+
+
+newtype StateArray a = StateArray (Array.Array Int a)
+    deriving (Eq, Show, Functor, Foldable)
+
+totalStateMapToArray :: StateNum -> StateMap a -> StateArray a
+totalStateMapToArray (StateNum boundState) (StateMap m) = StateArray
+    do Array.array (0, pred boundState) do IntMap.toAscList m
+
+mapArrayWithIx :: (StateNum -> a -> a) -> StateArray a -> StateArray a
+mapArrayWithIx f (StateArray arr) = StateArray
+    do Array.listArray
+        do Array.bounds arr
+        do [ f (StateNum i) x | (i, x) <- Array.assocs arr ]
+
+indexArray :: StateArray a -> StateNum -> a
+indexArray (StateArray arr) (StateNum i) = arr Array.! i
+
+arrayAssocs :: StateArray a -> [(StateNum, a)]
+arrayAssocs (StateArray arr) = coerce do Array.assocs arr
+
+
+newtype StateGraph = StateGraph Graph.Graph
+
+stateArrayToGraph :: StateArray [StateNum] -> StateGraph
+stateArrayToGraph (StateArray m) = StateGraph do coerce m
+
+liftGraphOp :: (Graph.Graph -> Graph.Graph) -> StateGraph -> StateGraph
+liftGraphOp f x = coerce f x
+
+indexGraph :: StateGraph -> StateNum -> [StateNum]
+indexGraph (StateGraph x) (StateNum i) = coerce do x Array.! i
diff --git a/src/Language/Lexer/Tlex/Pipeline/MinDfa.hs b/src/Language/Lexer/Tlex/Pipeline/MinDfa.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Lexer/Tlex/Pipeline/MinDfa.hs
@@ -0,0 +1,362 @@
+module Language.Lexer.Tlex.Pipeline.MinDfa (
+    minDfa,
+) where
+
+import           Language.Lexer.Tlex.Prelude
+
+import qualified Data.HashMap.Strict                 as HashMap
+import qualified Data.HashSet                        as HashSet
+import qualified Data.IntMap.Strict                  as IntMap
+import qualified Language.Lexer.Tlex.Data.EnumMap    as EnumMap
+import qualified Language.Lexer.Tlex.Machine.DFA     as DFA
+import qualified Language.Lexer.Tlex.Machine.Pattern as Pattern
+import qualified Language.Lexer.Tlex.Machine.State   as MState
+
+
+minDfa :: DFA.DFA a -> DFA.DFA a
+minDfa dfa = DFA.buildDFA
+    do modify' \dfaBuilderCtx0 -> minDfaCtxDFABuilderCtx
+        do execState
+            do minDfaM dfa
+            do MinDfaContext
+                { minDfaCtxStateMap = MState.emptyMap
+                , minDfaCtxDFABuilderCtx = dfaBuilderCtx0
+                }
+
+
+data MinDfaContext m = MinDfaContext
+    { minDfaCtxStateMap      :: MState.StateMap MState.StateNum
+    , minDfaCtxDFABuilderCtx :: DFA.DFABuilderContext m
+    }
+    deriving (Eq, Show, Functor)
+
+type MinDfaM m = State (MinDfaContext m)
+
+liftBuilderOp :: DFA.DFABuilder m a -> MinDfaM m a
+liftBuilderOp builder = do
+    ctx0 <- get
+    let (x, builderCtx1) = runState builder do minDfaCtxDFABuilderCtx ctx0
+    put do ctx0
+            { minDfaCtxDFABuilderCtx = builderCtx1
+            }
+    pure x
+
+registerNewState :: MState.StateNum -> MinDfaM m MState.StateNum
+registerNewState r = do
+    sn <- liftBuilderOp DFA.newStateNum
+    modify' \ctx0@MinDfaContext{ minDfaCtxStateMap } -> ctx0
+        { minDfaCtxStateMap = MState.insertMap r sn minDfaCtxStateMap
+        }
+    pure sn
+
+getOrRegisterState :: MState.StateNum -> MinDfaM m MState.StateNum
+getOrRegisterState r = do
+    ctx0 <- get
+    case MState.lookupMap r do minDfaCtxStateMap ctx0 of
+        Just sn -> pure sn
+        Nothing -> registerNewState r
+
+minDfaM :: DFA.DFA a -> MinDfaM a ()
+minDfaM dfa@DFA.DFA{ dfaTrans } = do
+    forM_
+        do EnumMap.assocs do DFA.dfaInitials dfa
+        do \(startS, sn) -> do
+            newSn <- getOrRegisterStateByOldState sn
+            liftBuilderOp do DFA.initial newSn startS
+
+    forM_
+        do MState.assocsMap do partitionMember p
+        do \(r, ss) -> do
+            newSn <- getOrRegisterState r
+            newDst <- buildDFAState ss
+            liftBuilderOp do DFA.insertTrans newSn newDst
+    where
+        p = buildPartition dfa
+
+        getOrRegisterStateByOldState oldSn =
+            let r = case MState.lookupMap oldSn do partitionMap p of
+                    Nothing -> error "unreachable"
+                    Just s  -> s
+            in getOrRegisterState r
+
+        buildDFAState ss = buildDst do
+            forM_
+                do MState.setToList ss
+                do \s -> do
+                    let dst = MState.indexArray dfaTrans s
+                    forM_
+                        do DFA.dstAccepts dst
+                        do \acc -> insertAcceptToDst acc
+
+                    forM_
+                        do IntMap.assocs do DFA.dstTrans dst
+                        do \(c, sn) -> do
+                            ctx0 <- get
+                            case IntMap.lookup c do dstBuilderCtxTrans ctx0 of
+                                Just{}  -> pure ()
+                                Nothing -> do
+                                    newSn <- liftMinDfaOp do getOrRegisterStateByOldState sn
+                                    modify' \ctx -> ctx
+                                        { dstBuilderCtxTrans = IntMap.insert c newSn
+                                            do dstBuilderCtxTrans ctx
+                                        }
+
+                    case DFA.dstOtherTrans dst of
+                        Nothing -> pure ()
+                        Just sn -> do
+                            ctx <- get
+                            case dstBuilderCtxOtherTrans ctx of
+                                Just{}  -> pure ()
+                                Nothing -> do
+                                    newSn <- liftMinDfaOp do getOrRegisterStateByOldState sn
+                                    put do ctx
+                                            { dstBuilderCtxOtherTrans = Just newSn
+                                            }
+
+data DFAStateBuilderContext a = DStateBuilderContext
+    { dstBuilderCtxAccepts    :: EnumMap.EnumMap Pattern.AcceptPriority (Pattern.Accept a)
+    , dstBuilderCtxTrans      :: IntMap.IntMap MState.StateNum
+    , dstBuilderCtxOtherTrans :: Maybe MState.StateNum
+    , dstBuilderCtxMinDfaCtx  :: MinDfaContext a
+    }
+    deriving (Eq, Show, Functor)
+
+type DFAStateBuilder a = State (DFAStateBuilderContext a)
+
+buildDst :: DFAStateBuilder a () -> MinDfaM a (DFA.DFAState a)
+buildDst builder = do
+    minDfaCtx0 <- get
+    let ctx = execState builder do
+            DStateBuilderContext
+                { dstBuilderCtxAccepts = EnumMap.empty
+                , dstBuilderCtxTrans = IntMap.empty
+                , dstBuilderCtxOtherTrans = Nothing
+                , dstBuilderCtxMinDfaCtx = minDfaCtx0
+                }
+    put do dstBuilderCtxMinDfaCtx ctx
+    pure DFA.DState
+        { DFA.dstAccepts = [ acc | (_, acc) <- EnumMap.toDescList do dstBuilderCtxAccepts ctx ]
+        , DFA.dstTrans   = dstBuilderCtxTrans ctx
+        , DFA.dstOtherTrans = dstBuilderCtxOtherTrans ctx
+        }
+
+liftMinDfaOp :: MinDfaM m a -> DFAStateBuilder m a
+liftMinDfaOp builder = do
+    ctx0 <- get
+    let (x, builderCtx1) = runState builder do dstBuilderCtxMinDfaCtx ctx0
+    put do ctx0
+            { dstBuilderCtxMinDfaCtx = builderCtx1
+            }
+    pure x
+
+insertAcceptToDst :: Pattern.Accept a -> DFAStateBuilder a ()
+insertAcceptToDst acc = modify' \builder -> builder
+    { dstBuilderCtxAccepts = EnumMap.insert
+        do Pattern.accPriority acc
+        do acc
+        do dstBuilderCtxAccepts builder
+    }
+
+
+data Partition = Partition
+    { partitionMap    :: MState.StateMap MState.StateNum
+    , partitionMember :: MState.StateMap MState.StateSet
+    }
+    deriving (Eq, Show)
+
+emptyPartition :: Partition
+emptyPartition = Partition
+    { partitionMap = MState.emptyMap
+    , partitionMember = MState.emptyMap
+    }
+
+insertToPartition :: MState.StateSet -> Partition -> Partition
+insertToPartition ss p0 = case MState.setToList ss of
+    []   -> p0
+    s0:_ -> Partition
+        { partitionMap = foldl'
+            do \m s -> MState.insertMap s s0 m
+            do partitionMap p0
+            do MState.setToList ss
+        , partitionMember = MState.insertMap s0 ss
+            do partitionMember p0
+        }
+
+buildPartition :: DFA.DFA a -> Partition
+buildPartition dfa =
+    let (p0, q0) = foldl'
+            do \(p, q) (k, ss) ->
+                ( insertToPartition ss p
+                , case k of
+                    Nothing -> q
+                    Just{}  -> HashSet.insert ss q
+                )
+            do (emptyPartition, HashSet.empty)
+            do HashMap.toList do acceptGroup dfa
+    in go p0 q0
+    where
+        go p0 q0 = case HashSet.toList q0 of
+            []  -> p0
+            a:_ ->
+                let (p1, q1) = go2 a p0 do
+                        HashSet.delete a q0
+                in go p1 q1
+
+        go2 a p0 q0 = foldl'
+            do \(p, q) x -> go3 p q x
+            do (p0, q0)
+            let rt = findIncomingTrans a
+            in HashSet.toList do
+                HashSet.fromList
+                    [ x
+                    | x <- dfaRevTransOther rt:
+                        [ x | (_, x) <- IntMap.assocs do dfaRevTrans rt ]
+                    , not do MState.nullSet x
+                    ]
+
+        go3 p0 q0 x = foldl'
+            do \(p, q) (sp, xy) ->
+                let y = case MState.lookupMap sp do partitionMember p0 of
+                        Nothing -> error "unreachable"
+                        Just ss -> ss
+                    lengthY = MState.lengthSet y
+                    lengthXY = MState.lengthSet xy
+                in if
+                    | lengthY == lengthXY ->
+                        (p, q)
+                    | otherwise ->
+                        let diffYX = MState.diffSet y xy
+                            splitY s1 s2 = case MState.setToList s2 of
+                                []    -> error "unreachable"
+                                sp2:_ -> Partition
+                                    { partitionMap = foldl'
+                                        do \m s -> MState.insertMap s sp2 m
+                                        do partitionMap p
+                                        do MState.setToList s2
+                                    , partitionMember = partitionMember p
+                                        & MState.insertMap sp s1
+                                        & MState.insertMap sp2 s2
+                                    }
+                            p' = case MState.memberSet sp xy of
+                                True  -> splitY xy diffYX
+                                False -> splitY diffYX xy
+                            q' = case HashSet.member y q of
+                                True -> HashSet.delete y q
+                                    & HashSet.insert xy
+                                    & HashSet.insert diffYX
+                                False ->
+                                    let y' = case lengthXY <= lengthY `div` 2 of
+                                            True  -> xy
+                                            False -> diffYX
+                                    in HashSet.insert y' q
+                        in (p', q')
+            do (p0, q0)
+            do MState.assocsMap do findY p0 x
+
+        findY Partition{ partitionMap } x = foldl'
+            do \ym s -> case MState.lookupMap s partitionMap of
+                Nothing -> error "unreachable"
+                Just sp -> MState.insertOrUpdateMap sp
+                    do MState.singletonSet s
+                    do \ss -> MState.insertSet s ss
+                    do ym
+            do MState.emptyMap
+            do MState.setToList x
+
+        findIncomingTrans ss = foldl'
+            do \rt0 s -> case MState.lookupMap s rtrans of
+                Nothing -> rt0
+                Just rt -> DFARevTrans
+                    { dfaRevTrans = IntMap.mergeWithKey
+                        do \_ ss1 ss2 -> Just do MState.unionSet ss1 ss2
+                        do \t1 -> t1 <&> \ss1 -> MState.unionSet ss1
+                            do dfaRevTransOther rt
+                        do \t2 -> t2 <&> \ss2 -> MState.unionSet ss2
+                            do dfaRevTransOther rt0
+                        do dfaRevTrans rt0
+                        do dfaRevTrans rt
+                    , dfaRevTransOther = MState.unionSet
+                        do dfaRevTransOther rt0
+                        do dfaRevTransOther rt
+                    }
+            do DFARevTrans
+                { dfaRevTrans = IntMap.empty
+                , dfaRevTransOther = MState.emptySet
+                }
+            do MState.setToList ss
+
+        rtrans = revTrans dfa
+
+acceptGroup :: DFA.DFA a -> HashMap.HashMap (Maybe Pattern.AcceptPriority) MState.StateSet
+acceptGroup DFA.DFA{ dfaTrans } = foldl'
+    do \m (s, dst) -> case DFA.dstAccepts dst of
+        []    -> insertState Nothing s m
+        acc:_ -> insertState
+            do Just do Pattern.accPriority acc
+            do s
+            do m
+    do HashMap.empty
+    do MState.arrayAssocs dfaTrans
+    where
+        insertState k s m = case HashMap.lookup k m of
+            Nothing -> HashMap.insert k
+                do MState.singletonSet s
+                do m
+            Just ss -> HashMap.insert k
+                do MState.insertSet s ss
+                do m
+
+
+data DFARevTrans a = DFARevTrans
+    { dfaRevTrans      :: IntMap.IntMap MState.StateSet
+    , dfaRevTransOther :: MState.StateSet
+    }
+
+revTrans :: DFA.DFA a -> MState.StateMap (DFARevTrans a)
+revTrans DFA.DFA{ dfaTrans } = foldl'
+    do \m0 (sf, dst) ->
+        let trans = DFA.dstTrans dst
+            m1 = foldl'
+                do \m (c, st) -> insertTrans sf c st m
+                do m0
+                do IntMap.assocs trans
+        in case DFA.dstOtherTrans dst of
+            Nothing -> m1
+            Just st -> insertOtherTrans sf st trans m1
+    do MState.emptyMap
+    do MState.arrayAssocs dfaTrans
+    where
+        insertTrans sf c st m0 = MState.insertOrUpdateMap st
+            do DFARevTrans
+                { dfaRevTrans = IntMap.singleton c do MState.singletonSet sf
+                , dfaRevTransOther = MState.emptySet
+                }
+            do \rtrans ->
+                let rtransRevTrans = dfaRevTrans rtrans
+                in rtrans
+                    { dfaRevTrans = case IntMap.lookup c rtransRevTrans of
+                        Nothing -> IntMap.insert c
+                            do MState.insertSet sf do dfaRevTransOther rtrans
+                            do rtransRevTrans
+                        Just ss -> IntMap.insert c
+                            do MState.insertSet sf ss
+                            do rtransRevTrans
+                    }
+            do m0
+
+        insertOtherTrans sf st trans m0 = MState.insertOrUpdateMap st
+            do DFARevTrans
+                { dfaRevTrans = trans <&> \_ -> MState.emptySet
+                , dfaRevTransOther = MState.singletonSet sf
+                }
+            do \rtrans -> DFARevTrans
+                { dfaRevTrans = IntMap.mergeWithKey
+                    do \_ ss _ -> Just ss
+                    do \rt -> rt <&> \ss -> MState.insertSet sf ss
+                    do \t -> t <&> \_ -> dfaRevTransOther rtrans
+                    do dfaRevTrans rtrans
+                    do trans
+                , dfaRevTransOther = MState.insertSet sf
+                    do dfaRevTransOther rtrans
+                }
+            do m0
diff --git a/src/Language/Lexer/Tlex/Pipeline/Nfa2Dfa.hs b/src/Language/Lexer/Tlex/Pipeline/Nfa2Dfa.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Lexer/Tlex/Pipeline/Nfa2Dfa.hs
@@ -0,0 +1,159 @@
+module Language.Lexer.Tlex.Pipeline.Nfa2Dfa (
+    nfa2Dfa,
+) where
+
+import           Language.Lexer.Tlex.Prelude
+
+import qualified Data.HashMap.Strict                 as HashMap
+import qualified Data.IntMap.Strict                  as IntMap
+import qualified Data.IntSet                         as IntSet
+import qualified Language.Lexer.Tlex.Data.EnumMap    as EnumMap
+import qualified Language.Lexer.Tlex.Machine.DFA     as DFA
+import qualified Language.Lexer.Tlex.Machine.NFA     as NFA
+import qualified Language.Lexer.Tlex.Machine.Pattern as Pattern
+import qualified Language.Lexer.Tlex.Machine.State   as MState
+
+
+nfa2Dfa :: NFA.NFA a -> DFA.DFA a
+nfa2Dfa nfa = DFA.buildDFA
+    do modify' \dfaBuilderCtx0 -> nfa2DfaCtxDFABuilderCtx
+        do execState
+            do nfa2DfaM nfa
+            do Nfa2DfaContext
+                { nfa2DfaCtxStateMap = HashMap.empty
+                , nfa2DfaCtxDFABuilderCtx = dfaBuilderCtx0
+                }
+
+
+data Nfa2DfaContext m = Nfa2DfaContext
+    { nfa2DfaCtxStateMap      :: HashMap.HashMap MState.StateSet MState.StateNum
+    , nfa2DfaCtxDFABuilderCtx :: DFA.DFABuilderContext m
+    }
+
+type Nfa2DfaM m = State (Nfa2DfaContext m)
+
+liftBuilderOp :: DFA.DFABuilder m a -> Nfa2DfaM m a
+liftBuilderOp builder = do
+    ctx0 <- get
+    let (x, builderCtx1) = runState builder do nfa2DfaCtxDFABuilderCtx ctx0
+    put do ctx0
+            { nfa2DfaCtxDFABuilderCtx = builderCtx1
+            }
+    pure x
+
+registerNewState :: MState.StateSet -> Nfa2DfaM m MState.StateNum
+registerNewState nfaSs = do
+    dfaSn <- liftBuilderOp DFA.newStateNum
+    modify' \ctx0@Nfa2DfaContext{ nfa2DfaCtxStateMap } -> ctx0
+        { nfa2DfaCtxStateMap = HashMap.insert nfaSs dfaSn nfa2DfaCtxStateMap
+        }
+    pure dfaSn
+
+nfa2DfaM :: NFA.NFA m -> Nfa2DfaM m ()
+nfa2DfaM NFA.NFA{ nfaInitials, nfaTrans } = do
+    initials <- forM nfaInitials \(nfaSn, s) -> do
+        let nfaSs = buildNfaSs nfaSn
+        dfaSn <- registerNewState nfaSs
+        liftBuilderOp do DFA.initial dfaSn s
+        pure (dfaSn, nfaSs)
+
+    buildStateMap initials
+    where
+        buildNfaSs nfaSn =
+            let nfaState = nfaTrans `MState.indexArray` nfaSn
+            in MState.listToSet do NFA.nstEpsilonTrans nfaState
+
+        insertNfaSn nfaSn0 nfaSs0 =
+            let nfaState0 = nfaTrans `MState.indexArray` nfaSn0
+            in foldl'
+                do \nfaSs nfaSn -> MState.insertSet nfaSn nfaSs
+                do nfaSs0
+                do NFA.nstEpsilonTrans nfaState0
+
+        buildStateMap = \case
+            []                   -> pure ()
+            (dfaSn, nfaSs):rest0 -> do
+                (rest1, dst) <- buildDFAState nfaSs rest0
+                liftBuilderOp do DFA.insertTrans dfaSn dst
+                buildStateMap rest1
+
+        buildDFAState nfaSs0 rest0 = do
+            (accs1, trans1, otherTrans1) <- foldM
+                do \(accs, trans, otherTrans) nfaSn ->
+                    let nfaState = nfaTrans `MState.indexArray` nfaSn
+                        accs' = foldl'
+                                do \m acc -> EnumMap.insert
+                                    do Pattern.accPriority acc
+                                    do acc
+                                    do m
+                                do accs
+                                do NFA.nstAccepts nfaState
+                        (trans', otherTrans') = foldl' insertTrans (trans, otherTrans)
+                                                    do NFA.nstTrans nfaState
+                    in pure (accs', trans', otherTrans')
+                do (EnumMap.empty, EnumMap.empty, MState.emptySet)
+                do MState.setToList nfaSs0
+
+            let getOrRegisterNfaSs nfaSs rest = do
+                    ctx0 <- get
+                    let stateMap = nfa2DfaCtxStateMap ctx0
+                    case HashMap.lookup nfaSs stateMap of
+                        Just dfaSn -> pure (rest, dfaSn)
+                        Nothing -> do
+                            dfaSn <- registerNewState nfaSs
+                            pure ((dfaSn, nfaSs):rest, dfaSn)
+
+            (rest1, trans2) <- foldM
+                do \(rest, trans) (c, nfaSs) -> do
+                    (rest', dfaSn) <- getOrRegisterNfaSs nfaSs rest
+                    pure (rest', IntMap.insert (fromEnum c) dfaSn trans)
+                do (rest0, IntMap.empty)
+                do EnumMap.assocs trans1
+
+            (rest2, otherTrans2) <- case MState.nullSet otherTrans1 of
+                True  -> pure (rest1, Nothing)
+                False -> do
+                    (rest, dfaSn) <- getOrRegisterNfaSs otherTrans1 rest1
+                    pure (rest, Just dfaSn)
+
+            pure
+                ( rest2
+                , DFA.DState
+                    { dstAccepts = [ acc | (_, acc) <- EnumMap.toDescList accs1 ]
+                    , dstTrans = trans2
+                    , dstOtherTrans = otherTrans2
+                    }
+                )
+
+        insertTrans (trans0, otherTrans0) st =
+            let cs = NFA.nstTransRange st
+                nfaSn = NFA.nstTransNextState st
+            in case NFA.nstTransIsStraight st of
+                True ->
+                    let ~newTrans = insertNfaSn nfaSn otherTrans0
+                        trans1 = IntSet.foldl'
+                            do \trans c -> EnumMap.insertOrUpdate c
+                                do newTrans
+                                do \ss -> insertNfaSn nfaSn ss
+                                do trans
+                            do trans0
+                            do cs
+                    in (trans1, otherTrans0)
+                False ->
+                    let (diffTrans1, trans1) = IntSet.foldl'
+                                                do \(diffTrans, trans) c ->
+                                                    ( EnumMap.delete c diffTrans
+                                                    , EnumMap.insertOrUpdate c
+                                                        MState.emptySet
+                                                        id
+                                                        trans
+                                                    )
+                                                do (trans0, trans0)
+                                                do cs
+                        trans2 = EnumMap.foldlWithKey'
+                                    do \trans c ss -> EnumMap.insert c
+                                        do insertNfaSn nfaSn ss
+                                        do trans
+                                    do trans1
+                                    do diffTrans1
+                    in (trans2, insertNfaSn nfaSn otherTrans0)
diff --git a/src/Language/Lexer/Tlex/Pipeline/Pattern2Nfa.hs b/src/Language/Lexer/Tlex/Pipeline/Pattern2Nfa.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Lexer/Tlex/Pipeline/Pattern2Nfa.hs
@@ -0,0 +1,40 @@
+module Language.Lexer.Tlex.Pipeline.Pattern2Nfa (
+    pattern2Nfa,
+) where
+
+import           Language.Lexer.Tlex.Prelude
+
+import qualified Language.Lexer.Tlex.Data.EnumSet    as EnumSet
+import qualified Language.Lexer.Tlex.Data.SymEnumSet as SymEnumSet
+import qualified Language.Lexer.Tlex.Machine.NFA     as NFA
+import qualified Language.Lexer.Tlex.Machine.Pattern as Pattern
+import qualified Language.Lexer.Tlex.Machine.State   as MState
+
+
+pattern2Nfa
+    :: Enum e
+    => MState.StateNum -> MState.StateNum -> Pattern.Pattern e
+    -> NFA.NFABuilder m ()
+pattern2Nfa = go where
+    go b e = \case
+        Pattern.Epsilon -> NFA.epsilonTrans b e
+        Pattern.Range s -> NFA.condTrans b
+            do
+                let (isStraight, es) = SymEnumSet.toEnumSet s
+                NFA.NFAStateTrans
+                    { NFA.nstTransIsStraight = isStraight
+                    , NFA.nstTransRange = EnumSet.toIntSet es
+                    , NFA.nstTransNextState = e
+                    }
+        p1 Pattern.:^: p2 -> do
+            s <- NFA.newStateNum
+            pattern2Nfa b s p1
+            pattern2Nfa s e p2
+        p1 Pattern.:|: p2 -> do
+            pattern2Nfa b e p1
+            pattern2Nfa b e p2
+        Pattern.Many p -> do
+            s <- NFA.newStateNum
+            NFA.epsilonTrans b s
+            pattern2Nfa s s p
+            NFA.epsilonTrans s e
diff --git a/src/Language/Lexer/Tlex/Prelude.hs b/src/Language/Lexer/Tlex/Prelude.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Lexer/Tlex/Prelude.hs
@@ -0,0 +1,5 @@
+module Language.Lexer.Tlex.Prelude (
+  module Language.Lexer.Tlex.Prelude.Core,
+) where
+
+import           Language.Lexer.Tlex.Prelude.Core
diff --git a/src/Language/Lexer/Tlex/Prelude/Core.hs b/src/Language/Lexer/Tlex/Prelude/Core.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Lexer/Tlex/Prelude/Core.hs
@@ -0,0 +1,40 @@
+module Language.Lexer.Tlex.Prelude.Core (
+    module Prelude,
+    module Control.Applicative,
+    module Control.Monad,
+    module Control.Monad.IO.Class,
+    module Control.Monad.Trans.State.Strict,
+    module Data.Coerce,
+    module Data.Foldable,
+    module Data.Function,
+    module Data.Functor,
+    module Data.Functor.Identity,
+    module Data.Functor.Compose,
+    module Data.Ix,
+    module Data.Kind,
+    module Data.List.NonEmpty,
+    module Data.Ord,
+    module Data.Proxy,
+    module Data.Typeable,
+    module Data.Word,
+) where
+
+import           Control.Applicative
+import           Control.Monad
+import           Control.Monad.IO.Class
+import           Control.Monad.Trans.State.Strict hiding (modify)
+import           Data.Coerce
+import           Data.Foldable                    hiding (foldl, foldr')
+import           Data.Function                    hiding (($))
+import           Data.Functor
+import           Data.Functor.Compose
+import           Data.Functor.Identity
+import           Data.Ix                          (Ix)
+import           Data.Kind                        (Type)
+import           Data.List.NonEmpty               (NonEmpty (..))
+import           Data.Ord                         (Down (..))
+import           Data.Proxy                       (Proxy (..))
+import           Data.Typeable                    (Typeable)
+import           Data.Word                        (Word, Word8)
+import           Prelude                          hiding (String, foldl, foldr,
+                                                   head, pi, tail, ($))
diff --git a/test/doctest/Doctest.hs b/test/doctest/Doctest.hs
new file mode 100644
--- /dev/null
+++ b/test/doctest/Doctest.hs
@@ -0,0 +1,21 @@
+module Main where
+
+import           Prelude
+
+import qualified Build_doctests     as BuildF
+import           Control.Monad
+import qualified System.Environment as IO
+import qualified System.IO          as IO
+import           Test.DocTest       (doctest)
+
+main :: IO ()
+main = forM_ BuildF.components \(BuildF.Component name flags pkgs sources) -> do
+  putStrLn "============================================="
+  print name
+  putStrLn "---------------------------------------------"
+  IO.hFlush IO.stdout
+  let args = flags ++ pkgs ++ sources
+  IO.unsetEnv "GHC_ENVIRONMENT"
+  doctest args
+  putStrLn "============================================="
+  IO.hFlush IO.stdout
diff --git a/test/spec/HSpecDriver.hs b/test/spec/HSpecDriver.hs
new file mode 100644
--- /dev/null
+++ b/test/spec/HSpecDriver.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
diff --git a/tlex-core.cabal b/tlex-core.cabal
new file mode 100644
--- /dev/null
+++ b/tlex-core.cabal
@@ -0,0 +1,169 @@
+cabal-version:       3.0
+build-type:          Custom
+
+name:                tlex-core
+version:             0.1.0.0
+license:             Apache-2.0 OR MPL-2.0
+license-file:        LICENSE
+copyright:           (c) 2021 Mizunashi Mana
+author:              Mizunashi Mana
+maintainer:          mizunashi-mana@noreply.git
+
+category:            Parsing
+homepage:            https://github.com/mizunashi-mana/tlex
+bug-reports:         https://github.com/mizunashi-mana/tlex/issues
+synopsis:            A lexer generator
+description:
+    Tlex is haskell libraries and toolchains for generating lexical analyzer.
+    See also: https://github.com/mizunashi-mana/tlex
+
+extra-source-files:
+    README.md
+    CHANGELOG.md
+
+source-repository head
+  type:     git
+  location: https://github.com/mizunashi-mana/tlex.git
+
+flag develop
+    default:     False
+    manual:      True
+    description: Turn on some options for development
+
+common general
+    default-language:
+        Haskell2010
+    default-extensions:
+        NoImplicitPrelude
+        BangPatterns
+        BinaryLiterals
+        BlockArguments
+        ConstraintKinds
+        DataKinds
+        DefaultSignatures
+        DeriveFoldable
+        DeriveFunctor
+        DeriveGeneric
+        DeriveLift
+        DeriveTraversable
+        DerivingVia
+        DuplicateRecordFields
+        EmptyCase
+        FlexibleContexts
+        FlexibleInstances
+        FunctionalDependencies
+        GADTs
+        InstanceSigs
+        LambdaCase
+        MagicHash
+        MultiParamTypeClasses
+        MultiWayIf
+        NamedFieldPuns
+        NegativeLiterals
+        NumericUnderscores
+        OverloadedLabels
+        PackageImports
+        PatternSynonyms
+        PolyKinds
+        RankNTypes
+        ScopedTypeVariables
+        StandaloneDeriving
+        Strict
+        TypeApplications
+        TypeFamilies
+        TypeOperators
+        UnboxedSums
+        UnboxedTuples
+
+    if flag(develop)
+        ghc-options:
+            -Wall
+            -Wcompat
+            -Wincomplete-uni-patterns
+            -Wmonomorphism-restriction
+            -Wpartial-fields
+
+            -fprint-explicit-foralls
+            -frefinement-level-hole-fits=1
+
+            -dcore-lint
+
+    build-depends:
+        base                 >= 4.12.0 && < 4.15,
+
+        -- project depends
+        array                >= 0.5.3 && < 0.6,
+        containers           >= 0.6.0 && < 0.7,
+        hashable             >= 1.3.0 && < 1.4,
+        transformers         >= 0.5.6 && < 0.6,
+        unordered-containers >= 0.2.13 && < 0.3,
+
+    autogen-modules:
+        Paths_tlex_core
+    other-modules:
+        Paths_tlex_core
+
+custom-setup
+    setup-depends:
+        base,
+        Cabal,
+        cabal-doctest,
+
+library
+    import:
+        general,
+    hs-source-dirs:
+        src
+    exposed-modules:
+        Language.Lexer.Tlex.Prelude
+        Language.Lexer.Tlex.Machine.State
+        Language.Lexer.Tlex.Machine.Pattern
+        Language.Lexer.Tlex.Machine.NFA
+        Language.Lexer.Tlex.Machine.DFA
+        Language.Lexer.Tlex.Pipeline.Pattern2Nfa
+        Language.Lexer.Tlex.Pipeline.Nfa2Dfa
+        Language.Lexer.Tlex.Pipeline.MinDfa
+        Language.Lexer.Tlex.Data.EnumSet
+        Language.Lexer.Tlex.Data.EnumMap
+        Language.Lexer.Tlex.Data.SymEnumSet
+        Language.Lexer.Tlex.Data.Bag
+
+    other-modules:
+        Language.Lexer.Tlex.Prelude.Core
+        Language.Lexer.Tlex.Data.Graph
+
+test-suite doctest
+    import:
+        general,
+    type:
+        exitcode-stdio-1.0
+    hs-source-dirs:
+        test/doctest
+    main-is:
+        Doctest.hs
+    build-depends:
+        doctest,
+        QuickCheck,
+    autogen-modules:
+        Build_doctests
+    other-modules:
+        Build_doctests
+
+test-suite spec
+    import:
+        general,
+    type:
+        exitcode-stdio-1.0
+    hs-source-dirs:
+        test/spec
+    main-is:
+        HSpecDriver.hs
+    ghc-options:
+        -Wno-missing-home-modules
+    build-tool-depends:
+        hspec-discover:hspec-discover,
+    build-depends:
+        tlex-core,
+
+        hspec,
+        QuickCheck,