diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
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/ptera/blob/master/LICENSE
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,67 @@
+# Ptera: A Generator for Parsers
+
+[![Hackage](https://img.shields.io/hackage/v/ptera.svg)](https://hackage.haskell.org/package/ptera)
+
+## Installation
+
+Add dependencies on `package.cabal`:
+
+```
+build-depends:
+    base,
+    bytestring,
+    ptera,          -- main
+    ptera-th,       -- for outputing parser with Template Haskell
+    charset,
+    template-haskell,
+```
+
+## Usage
+
+Write parser rules:
+
+```haskell
+data Terminal
+    = Digit
+    | SymPlus
+    | SymMulti
+    deriving (Eq, Show, Enum)
+
+data NonTerminal
+    | Expr
+    | Sum
+    | Product
+    | Value
+    deriving (Eq, Show, Enum)
+
+type ParseRule = Rule Terminal NonTerminal
+
+
+data Ast
+    = GenValue
+    | GenSum (NonEmpty Ast)
+    | GenProduct Ast Ast
+
+rExpr :: ParseRule Ast
+rExpr = rule Expr rSum
+
+rSum :: ParseRule Ast
+rSum = rule Sum do
+    (rProduct <,> manyP do token SymPlus *> rProduct) <&> \(e, es) -> GenSum do e :| es
+
+rProduct :: ParseRule Ast
+rProduct = rule Product do
+    orP
+        [
+            (rValue <* token SymMulti <,> rProduct) <&> \(e1, e2) -> GenProduct e1 e2,
+            rValue
+        ]
+
+rValue :: ParseRule Ast
+rValue = rule Value do token Digit *> pure GenValue
+```
+
+## Examples
+
+* Small language: https://github.com/mizunashi-mana/ptera/tree/master/example/small-lang
+* Haskell2010: https://github.com/mizunashi-mana/ptera/tree/master/example/haskell2010
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/ptera.cabal b/ptera.cabal
new file mode 100644
--- /dev/null
+++ b/ptera.cabal
@@ -0,0 +1,168 @@
+cabal-version:       3.0
+build-type:          Custom
+
+name:                ptera
+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/ptera
+bug-reports:         https://github.com/mizunashi-mana/ptera/issues
+synopsis:            A parser generator
+description:
+    Ptera is haskell libraries and toolchains for generating parser.
+
+extra-source-files:
+    README.md
+    CHANGELOG.md
+
+source-repository head
+  type:     git
+  location: https://github.com/mizunashi-mana/ptera.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
+        StandaloneKindSignatures
+        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.14.0 && < 5,
+
+        -- project depends
+        ptera-core              >= 0.1.0 && < 0.2,
+        containers              >= 0.6.0 && < 0.7,
+        unordered-containers    >= 0.2.0 && < 0.3,
+        membership              >= 0.0.1 && < 0.1,
+        enummapset-th           >= 0.6.0 && < 0.7,
+
+    autogen-modules:
+        Paths_ptera
+    other-modules:
+        Paths_ptera
+
+custom-setup
+    setup-depends:
+        base,
+        Cabal,
+        cabal-doctest,
+
+library
+    import:
+        general,
+    hs-source-dirs:
+        src
+    exposed-modules:
+        Language.Parser.Ptera
+
+        Language.Parser.Ptera.Syntax
+        Language.Parser.Ptera.Syntax.SafeGrammar
+        Language.Parser.Ptera.Scanner
+        Language.Parser.Ptera.Runner
+        Language.Parser.Ptera.Runner.Parser
+        Language.Parser.Ptera.Runner.RunT
+        Language.Parser.Ptera.Pipeline.Grammar2Runner
+        Language.Parser.Ptera.Pipeline.SafeGrammar2SRB
+        Language.Parser.Ptera.Pipeline.SRB2Parser
+
+        Language.Parser.Ptera.Data.HEnum
+    reexported-modules:
+        Language.Parser.Ptera.Data.HFList
+
+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:
+        ptera,
+
+        hspec,
+        QuickCheck,
diff --git a/src/Language/Parser/Ptera.hs b/src/Language/Parser/Ptera.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Parser/Ptera.hs
@@ -0,0 +1,25 @@
+module Language.Parser.Ptera (
+    module Language.Parser.Ptera.Syntax,
+    module Language.Parser.Ptera.Runner,
+    module Language.Parser.Ptera.Scanner,
+
+    Parser,
+    genRunner,
+) where
+
+import           Language.Parser.Ptera.Prelude
+
+import qualified Language.Parser.Ptera.Pipeline.Grammar2Runner as Grammar2Runner
+import           Language.Parser.Ptera.Runner                  (ParseResult (..),
+                                                                Result,
+                                                                runParser)
+import qualified Language.Parser.Ptera.Runner                  as Runner
+import           Language.Parser.Ptera.Scanner                 hiding (T)
+import           Language.Parser.Ptera.Syntax                  hiding (T, semAct, semActM)
+
+type Parser = Runner.T
+
+genRunner :: GrammarToken tokens elem
+    => GrammarM ctx rules tokens elem initials
+    -> Either [StringLit] (Parser ctx rules elem initials)
+genRunner g = Grammar2Runner.grammar2Runner g
diff --git a/src/Language/Parser/Ptera/Data/HEnum.hs b/src/Language/Parser/Ptera/Data/HEnum.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Parser/Ptera/Data/HEnum.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+module Language.Parser.Ptera.Data.HEnum where
+
+import           Language.Parser.Ptera.Prelude
+
+import qualified Type.Membership               as Membership
+import qualified Type.Membership.Internal      as MembershipInternal
+
+type T = HEnum
+
+newtype HEnum (as :: [k]) = UnsafeHEnum
+    {
+        unsafeHEnum :: Int
+    }
+    deriving (Eq, Show)
+
+henum :: forall a as. Membership.Membership as a -> HEnum as
+henum m = UnsafeHEnum do Membership.getMemberId m
+
+henumA :: forall a as. Membership.Member as a => HEnum as
+henumA = henum do MembershipInternal.membership @as @a
+
+unHEnum :: forall a as. Membership.Membership as a -> HEnum as -> Bool
+unHEnum m (UnsafeHEnum i) = Membership.getMemberId m == i
diff --git a/src/Language/Parser/Ptera/Pipeline/Grammar2Runner.hs b/src/Language/Parser/Ptera/Pipeline/Grammar2Runner.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Parser/Ptera/Pipeline/Grammar2Runner.hs
@@ -0,0 +1,19 @@
+module Language.Parser.Ptera.Pipeline.Grammar2Runner where
+
+import           Language.Parser.Ptera.Prelude
+
+import qualified Language.Parser.Ptera.Pipeline.SRB2Parser      as SRB2Parser
+import qualified Language.Parser.Ptera.Pipeline.SafeGrammar2SRB as SafeGrammar2SRB
+import qualified Language.Parser.Ptera.Runner                   as Runner
+import qualified Language.Parser.Ptera.Syntax                   as Syntax
+
+grammar2Runner :: forall initials ctx rules tokens elem
+    .  Syntax.GrammarToken tokens elem
+    => Syntax.GrammarM ctx rules tokens elem initials
+    -> Either [StringLit] (Runner.T ctx rules elem initials)
+grammar2Runner g = do
+    srb <- SafeGrammar2SRB.safeGrammar2Srb g
+    let parser = SRB2Parser.srb2Parser
+            do Proxy @tokens
+            do srb
+    pure do Runner.UnsafeRunnerM parser
diff --git a/src/Language/Parser/Ptera/Pipeline/SRB2Parser.hs b/src/Language/Parser/Ptera/Pipeline/SRB2Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Parser/Ptera/Pipeline/SRB2Parser.hs
@@ -0,0 +1,121 @@
+module Language.Parser.Ptera.Pipeline.SRB2Parser where
+
+import           Language.Parser.Ptera.Prelude
+
+import qualified Data.EnumMap.Strict                        as EnumMap
+import qualified Language.Parser.Ptera.Data.Alignable.Array as AlignableArray
+import qualified Language.Parser.Ptera.Data.HEnum           as HEnum
+import qualified Language.Parser.Ptera.Data.Symbolic.IntMap as SymbolicIntMap
+import qualified Language.Parser.Ptera.Machine.LAPEG        as LAPEG
+import qualified Language.Parser.Ptera.Machine.PEG          as PEG
+import qualified Language.Parser.Ptera.Machine.SRB          as SRB
+import qualified Language.Parser.Ptera.Runner.Parser        as Parser
+import qualified Language.Parser.Ptera.Syntax               as Syntax
+import qualified Language.Parser.Ptera.Syntax.Grammar       as Grammar
+import qualified Unsafe.Coerce                              as Unsafe
+
+type Action ctx = Grammar.Action (Syntax.SemActM ctx)
+
+srb2Parser :: forall ctx tokens elem altHelp
+    .  Syntax.GrammarToken tokens elem
+    => Proxy tokens -> SRB.T Int StringLit (Maybe altHelp) (Action ctx)
+    -> Parser.T ctx elem altHelp
+srb2Parser p srb = Parser.RunnerParser
+    { parserInitial = \s -> coerce do EnumMap.lookup s do SRB.initials srb
+    , parserGetTokenNum = \tok ->
+        HEnum.unsafeHEnum do Syntax.tokenToTerminal p tok
+    , parserTrans = \s0 t -> if s0 < 0
+        then Parser.Trans
+            {
+                transState = -1,
+                transOps = []
+            }
+        else
+            let srbSt = AlignableArray.forceIndex
+                    do SRB.states srb
+                    do SRB.StateNum s0
+            in buildTrans t srbSt
+    , parserAltKind = \alt -> LAPEG.altKind
+        do AlignableArray.forceIndex
+            do SRB.alts srb
+            do LAPEG.AltNum alt
+    , parserAction = \alt -> runAction
+        do LAPEG.altAction
+            do AlignableArray.forceIndex
+                do SRB.alts srb
+                do LAPEG.AltNum alt
+    , parserStateHelp = \s ->
+        let srbSt = AlignableArray.forceIndex
+                do SRB.states srb
+                do SRB.StateNum s
+        in buildStateHelp do SRB.stateAltItems srbSt
+    , parserAltHelp = \alt ->
+        let vn = LAPEG.altVar
+                do AlignableArray.forceIndex
+                    do SRB.alts srb
+                    do LAPEG.AltNum alt
+            v = AlignableArray.forceIndex
+                do SRB.vars srb
+                do vn
+        in (PEG.varHelp v, Nothing)
+    }
+
+buildTrans :: Int -> SRB.MState -> Parser.Trans
+buildTrans t srbSt = case SymbolicIntMap.lookup t do SRB.stateTrans srbSt of
+    Nothing ->
+        Parser.Trans
+            {
+                transState = -1,
+                transOps = []
+            }
+    Just (SRB.TransWithOps ops (SRB.StateNum s1)) ->
+        Parser.Trans
+            {
+                transState = s1,
+                transOps = transOp <$> ops
+            }
+    Just (SRB.TransReduce (LAPEG.AltNum alt)) ->
+        Parser.Trans
+            {
+                transState = -1,
+                transOps = [Parser.TransOpReduce alt]
+            }
+
+buildStateHelp :: [SRB.AltItem] -> [(Parser.AltNum, Int)]
+buildStateHelp altItems =
+    [
+        ( coerce do SRB.altItemAltNum altItem
+        , coerce do SRB.altItemCurPos altItem
+        )
+    | altItem <- altItems
+    ]
+
+transOp :: SRB.TransOp -> Parser.TransOp
+transOp = \case
+    SRB.TransOpEnter (LAPEG.VarNum v) needBack mEnterSn ->
+        let enterSn = case mEnterSn of
+                Nothing ->
+                    -1
+                Just (SRB.StateNum x) ->
+                    x
+        in Parser.TransOpEnter v needBack enterSn
+    SRB.TransOpPushBackpoint (SRB.StateNum backSn) ->
+        Parser.TransOpPushBackpoint backSn
+    SRB.TransOpHandleNot (LAPEG.AltNum alt) ->
+        Parser.TransOpHandleNot alt
+    SRB.TransOpShift ->
+        Parser.TransOpShift
+
+runAction :: Action ctx -> Parser.ActionM ctx
+runAction (Grammar.Action (Syntax.SemActM f)) = Parser.ActionM \l ->
+        Parser.ReduceArgument <$> f do goL l
+    where
+        goL = \case
+            [] ->
+                unsafeCoerceHList Syntax.HNil
+            Parser.ReduceArgument x:xs ->
+                unsafeCoerceHList do x Syntax.:* goL xs
+
+        unsafeCoerceHList :: Syntax.HList us1 -> Syntax.HList us2
+        unsafeCoerceHList = Unsafe.unsafeCoerce
+
diff --git a/src/Language/Parser/Ptera/Pipeline/SafeGrammar2SRB.hs b/src/Language/Parser/Ptera/Pipeline/SafeGrammar2SRB.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Parser/Ptera/Pipeline/SafeGrammar2SRB.hs
@@ -0,0 +1,27 @@
+module Language.Parser.Ptera.Pipeline.SafeGrammar2SRB where
+
+import           Language.Parser.Ptera.Prelude
+
+import qualified Language.Parser.Ptera.Data.Alignable.Array as AlignableArray
+import qualified Language.Parser.Ptera.Data.Alignable.Set   as AlignableSet
+import qualified Language.Parser.Ptera.Machine.PEG          as PEG
+import qualified Language.Parser.Ptera.Machine.SRB          as SRB
+import qualified Language.Parser.Ptera.Pipeline.Grammar2PEG as Grammar2PEG
+import qualified Language.Parser.Ptera.Pipeline.LAPEG2SRB   as LAPEG2SRB
+import qualified Language.Parser.Ptera.Pipeline.PEG2LAPEG   as PEG2LAPEG
+import qualified Language.Parser.Ptera.Syntax.Grammar       as Grammar
+import qualified Language.Parser.Ptera.Syntax.SafeGrammar   as SafeGrammar
+
+safeGrammar2Srb :: SafeGrammar.T action rules tokens elem initials
+    -> Either [StringLit] (SRB.T Int StringLit (Maybe ()) (Grammar.Action action))
+safeGrammar2Srb (SafeGrammar.UnsafeGrammar g) = do
+    let peg = Grammar2PEG.grammar2Peg g
+    laPeg <- case runExcept do PEG2LAPEG.peg2LaPeg peg of
+        Right x -> Right x
+        Left vns -> do
+            let vs = PEG.vars peg
+            Left
+                [ PEG.varHelp do AlignableArray.forceIndex vs vn
+                | vn <- AlignableSet.toList vns
+                ]
+    pure do LAPEG2SRB.laPeg2Srb laPeg
diff --git a/src/Language/Parser/Ptera/Runner.hs b/src/Language/Parser/Ptera/Runner.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Parser/Ptera/Runner.hs
@@ -0,0 +1,52 @@
+module Language.Parser.Ptera.Runner (
+    T,
+
+    RunnerM (..),
+    Result,
+    RunT.ParseResult (..),
+    runParserM,
+    runParser,
+) where
+
+import           Language.Parser.Ptera.Prelude
+
+import qualified Language.Parser.Ptera.Runner.Parser      as Parser
+import qualified Language.Parser.Ptera.Runner.RunT        as RunT
+import qualified Language.Parser.Ptera.Scanner            as Scanner
+import qualified Language.Parser.Ptera.Syntax             as Syntax
+import qualified Language.Parser.Ptera.Syntax.SafeGrammar as SafeGrammar
+import qualified Type.Membership                          as Membership
+import qualified Type.Membership.Internal                 as MembershipInternal
+
+type T = RunnerM
+
+type RunnerM :: Type -> Type -> Type -> [Symbol] -> Type
+newtype RunnerM ctx rules elem initials = UnsafeRunnerM
+    { unRunnerM :: Parser.T ctx elem ()
+    }
+
+type Runner = RunnerM ()
+
+type Result posMark = RunT.ParseResult posMark ()
+
+runParserM :: forall v initials ctx posMark m rules elem proxy
+    .  Membership.Member initials v => Scanner.T posMark elem m
+    => proxy v -> RunnerM ctx rules elem initials -> ctx
+    -> m (Result posMark (Syntax.RuleExprReturnType rules v))
+runParserM _ (UnsafeRunnerM p) customCtx0 =
+    case RunT.initialContext p customCtx0 pos of
+        Nothing ->
+            error "Not found the start point."
+        Just initialCtx ->
+            evalStateT
+                do RunT.unRunT RunT.runT
+                initialCtx
+    where
+        pos = SafeGrammar.genStartPoint
+            do MembershipInternal.membership @initials @v
+
+runParser :: forall v initials posMark m rules elem proxy
+    .  Membership.Member initials v => Scanner.T posMark elem m
+    => proxy v -> Runner rules elem initials
+    -> m (Result posMark (Syntax.RuleExprReturnType rules v))
+runParser p r = runParserM p r ()
diff --git a/src/Language/Parser/Ptera/Runner/Parser.hs b/src/Language/Parser/Ptera/Runner/Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Parser/Ptera/Runner/Parser.hs
@@ -0,0 +1,70 @@
+module Language.Parser.Ptera.Runner.Parser (
+    T,
+
+    StartNum,
+    StateNum,
+    TokenNum,
+    VarNum,
+    AltNum,
+    AltKind (..),
+
+    RunnerParser (..),
+    Syntax.GrammarToken (..),
+    ActionM (..),
+    ReduceArgument (..),
+    Syntax.ActionTask (..),
+    Syntax.getAction,
+    Syntax.modifyAction,
+    Syntax.failAction,
+    Trans (..),
+    TransOp (..),
+
+    eosToken,
+) where
+
+import           Language.Parser.Ptera.Prelude
+
+import           Language.Parser.Ptera.Machine.PEG (AltKind (..))
+import qualified Language.Parser.Ptera.Syntax      as Syntax
+
+type StartNum = Int
+type StateNum = Int
+type TokenNum = Int
+type VarNum = Int
+type AltNum = Int
+
+type T = RunnerParser
+
+newtype ActionM ctx = ActionM
+    { runActionM :: [ReduceArgument] -> Syntax.ActionTask ctx ReduceArgument
+    }
+
+data ReduceArgument where
+    ReduceArgument :: a -> ReduceArgument
+
+data RunnerParser ctx elem altHelp = RunnerParser
+    { parserInitial     :: StartNum -> Maybe StateNum
+    , parserGetTokenNum :: elem -> TokenNum
+    , parserTrans       :: StateNum -> TokenNum -> Trans
+    , parserAltKind     :: AltNum -> AltKind
+    , parserStateHelp   :: StateNum -> [(AltNum, Int)]
+    , parserAltHelp     :: AltNum -> (StringLit, Maybe altHelp)
+    , parserAction      :: AltNum -> ActionM ctx
+    }
+
+data Trans = Trans
+    { transState :: StateNum
+    , transOps   :: [TransOp]
+    }
+    deriving (Eq, Show)
+
+data TransOp
+    = TransOpEnter VarNum Bool StateNum
+    | TransOpPushBackpoint StateNum
+    | TransOpHandleNot AltNum
+    | TransOpShift
+    | TransOpReduce AltNum
+    deriving (Eq, Show)
+
+eosToken :: TokenNum
+eosToken = -1
diff --git a/src/Language/Parser/Ptera/Runner/RunT.hs b/src/Language/Parser/Ptera/Runner/RunT.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Parser/Ptera/Runner/RunT.hs
@@ -0,0 +1,638 @@
+{-# LANGUAGE CPP #-}
+
+module Language.Parser.Ptera.Runner.RunT (
+    T,
+
+    RunT (..),
+    runT,
+
+    ParseResult (..),
+    Context (..),
+    initialContext,
+    Position (..),
+) where
+
+import           Language.Parser.Ptera.Prelude
+
+import qualified Data.IntMap.Strict                       as IntMap
+import qualified Language.Parser.Ptera.Data.Alignable     as Alignable
+import qualified Language.Parser.Ptera.Data.Alignable.Map as AlignableMap
+import qualified Language.Parser.Ptera.Machine.PEG        as PEG
+import qualified Language.Parser.Ptera.Runner.Parser      as Parser
+import qualified Language.Parser.Ptera.Scanner            as Scanner
+import qualified Language.Parser.Ptera.Syntax             as Syntax
+import qualified Unsafe.Coerce                            as Unsafe
+
+#define DEBUG 0
+
+type T = RunT
+
+newtype RunT ctx posMark elem altHelp m a = RunT
+    {
+        unRunT :: StateT (Context ctx posMark elem altHelp) m a
+    }
+    deriving Functor
+    deriving (
+        Applicative,
+        Monad
+    ) via (StateT (Context ctx posMark elem altHelp) m)
+
+instance MonadTrans (RunT ctx posMark elem altHelp) where
+    lift mx = RunT do lift mx
+
+runT :: forall ctx posMark elem altHelp m a. Scanner.T posMark elem m
+    => RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a)
+runT = go where
+    go = do
+        (tok, _) <- consumeIfNeeded
+        sn <- getCtx ctxState
+        if sn < 0
+            then goResult tok
+            else transByInput tok >>= \case
+                ContParse ->
+                    go
+                CantContParse ->
+                    goFailed
+
+    goResult
+        :: Parser.TokenNum
+        -> RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a)
+    goResult tok = getCtx ctxItemStack >>= \case
+        [ItemArgument (Parser.ReduceArgument x)] ->
+            pure do Parsed do Unsafe.unsafeCoerce x
+        _ -> do
+            if tok >= 0
+                then reportError FailedByEarlyParsed
+                else reportError FailedByNotEnoughInput
+            goFailed
+
+    goFailed :: RunT ctx posMark elem altHelp m (ParseResult posMark altHelp a)
+    goFailed = getCtx ctxDeepestError >>= \case
+        Just (_, posMark0, failedReason) ->
+            pure do ParseFailed posMark0 failedReason
+        Nothing ->
+            error "unreachable: any errors are available."
+
+data ParseResult posMark altHelp a
+    = Parsed a
+    | ParseFailed posMark (FailedReason altHelp)
+    deriving (Show, Functor)
+
+data FailedReason altHelp
+    = FailedWithHelp [(StringLit, Maybe altHelp, Maybe Int)]
+    | FailedToStart
+    | FailedByEarlyParsed
+    | FailedByNotEnoughInput
+    deriving (Show, Functor)
+
+data Context ctx posMark elem altHelp = Context
+    { ctxParser             :: Parser.T ctx elem altHelp
+    , ctxState              :: Parser.StateNum
+    , ctxItemStack          :: [Item posMark ctx]
+    , ctxLookAHeadToken     :: Maybe (Position, posMark, Parser.TokenNum, Maybe elem)
+    , ctxNextPosition       :: Position
+    , ctxDeepestError       :: Maybe (Position, posMark, FailedReason altHelp)
+    , ctxMemoTable          :: AlignableMap.T Position (IntMap.IntMap (MemoItem posMark))
+    , ctxNeedBackItemsCount :: Int
+    , ctxCustomContext      :: ctx
+    }
+
+newtype Position = Position Int
+    deriving (Eq, Ord, Show)
+    deriving Alignable.T via Alignable.Inst
+
+data MemoItem posMark
+    = MemoItemParsed Position posMark Parser.ReduceArgument
+    | MemoItemFailed
+
+data Item posMark ctx
+    = ItemEnter Position (Maybe posMark) Parser.VarNum Parser.StateNum
+    | ItemHandleNot Parser.AltNum
+    | ItemBackpoint Position posMark Parser.StateNum
+    | ItemArgument Parser.ReduceArgument
+    | ItemModifyCustomContext ctx
+
+data RunningResult
+    = ContParse
+    | CantContParse
+    deriving (Eq, Show)
+
+initialContext
+    :: Parser.T ctx elem altHelp -> ctx -> Parser.StartNum
+    -> Maybe (Context ctx posMark elem altHelp)
+initialContext parser ctx0 s0 = do
+    sn0 <- Parser.parserInitial parser s0
+    pure do
+        Context
+            { ctxParser = parser
+            , ctxState = sn0
+            , ctxLookAHeadToken = Nothing
+            , ctxItemStack = []
+            , ctxNextPosition = Alignable.initialAlign
+            , ctxMemoTable = AlignableMap.empty
+            , ctxNeedBackItemsCount = 0
+            , ctxCustomContext = ctx0
+            , ctxDeepestError = Nothing
+            }
+
+transByInput :: forall ctx posMark elem altHelp m
+    .  Scanner.T posMark elem m
+    => Parser.TokenNum -> RunT ctx posMark elem altHelp m RunningResult
+transByInput tok = go where
+    go = do
+        parser <- getCtx ctxParser
+        sn0 <- getCtx ctxState
+        let trans1 = Parser.parserTrans parser sn0 tok
+        let sn1 = Parser.transState trans1
+        setNextState sn1
+#if DEBUG
+        (pos0, _) <- getCurrentPosition
+        itemStackShow <- prettyShowItemStack
+        debugTraceShow ("transByInput", sn0, pos0, tok, trans1, itemStackShow) do pure ()
+#endif
+        case Parser.transOps trans1 of
+            ops@(_:_) ->
+                goTransOps ops
+            []
+                | sn1 < 0 ->
+                    parseFailWithState sn0
+                | otherwise ->
+                    pure ContParse
+
+    goTransOps :: [Parser.TransOp]
+        -> RunT ctx posMark elem altHelp m RunningResult
+    goTransOps = \case
+        [] ->
+            pure ContParse
+        op:ops -> do
+            result <- runTransOp op
+            case result of
+                ContParse ->
+                    goTransOps ops
+                CantContParse ->
+                    pure CantContParse
+
+#if DEBUG
+prettyShowItemStack :: Monad m => RunT ctx posMark elem altHelp m [StringLit]
+prettyShowItemStack = do
+    itemStack <- getCtx ctxItemStack
+    pure [ showItem item | item <- itemStack ]
+    where
+        showItem = \case
+            ItemEnter p _ v s ->
+                "ItemEnter " <> show (p, v, s)
+            ItemHandleNot alt ->
+                "ItemHandleNot " <> show alt
+            ItemBackpoint p _ s ->
+                "ItemBackpoint " <> show (p, s)
+            ItemArgument _ ->
+                "ItemArgument"
+            ItemModifyCustomContext _ ->
+                "ItemModifyCustomContext"
+#endif
+
+runTransOp :: Scanner.T posMark elem m
+    => Parser.TransOp -> RunT ctx posMark elem altHelp m RunningResult
+runTransOp = \case
+    Parser.TransOpEnter v needBack enterSn ->
+        runEnter v needBack enterSn
+    Parser.TransOpPushBackpoint backSn -> do
+        (pos, mark) <- getCurrentPosition
+        pushItem do ItemBackpoint pos mark backSn
+        pure ContParse
+    Parser.TransOpHandleNot alt -> do
+        pushItem do ItemHandleNot alt
+        pure ContParse
+    Parser.TransOpShift -> consumeIfNeeded >>= \case
+        (_, Nothing) ->
+            parseFail do Just FailedByNotEnoughInput
+        (_, Just x) -> do
+            pushItem do ItemArgument do Parser.ReduceArgument x
+            shift
+            pure ContParse
+    Parser.TransOpReduce alt ->
+        runReduce alt
+
+runEnter :: Scanner.T posMark elem m
+    => Parser.VarNum -> Bool -> Parser.StateNum
+    -> RunT ctx posMark elem altHelp m RunningResult
+runEnter v needBack enterSn = do
+    (pos0, mark0) <- getCurrentPosition
+    memoTable <- getCtx ctxMemoTable
+    let vm = case AlignableMap.lookup pos0 memoTable of
+            Nothing -> IntMap.empty
+            Just m  -> m
+    case IntMap.lookup v vm of
+        Nothing -> do
+            let mmark0 = if needBack
+                    then Just mark0
+                    else Nothing
+            pushItem do ItemEnter pos0 mmark0 v enterSn
+            pure ContParse
+        Just memoItem -> case memoItem of
+            MemoItemParsed pos1 mark1 x -> do
+#if DEBUG
+                debugTraceShow ("runEnter / MemoItemParsed", v, enterSn, pos1) do pure ()
+#endif
+                setNextState enterSn
+                pushItem do ItemArgument x
+                seekToMark pos1 mark1
+                pure ContParse
+            MemoItemFailed -> do
+#if DEBUG
+                debugTraceShow ("runEnter / MemoItemFailed", v, enterSn) do pure ()
+#endif
+                parseFail Nothing
+
+#if DEBUG
+debugShowHelpAlt :: Monad m
+    => StringLit -> Parser.AltNum -> RunT ctx posMark elem altHelp m ()
+debugShowHelpAlt msg alt = do
+    parser <- getCtx ctxParser
+    let (dv, _) = Parser.parserAltHelp parser alt
+    debugTraceShow (msg, alt, dv) do pure ()
+#endif
+
+runReduce :: forall ctx posMark elem altHelp m
+    .  Scanner.T posMark elem m
+    => Parser.AltNum -> RunT ctx posMark elem altHelp m RunningResult
+runReduce alt = go0 where
+    go0 = do
+#if DEBUG
+        debugShowHelpAlt "runReduce" alt
+#endif
+        capturedCtxForFail <- captureCtx
+        go capturedCtxForFail Nothing []
+
+    go capturedCtxForFail mrollbackCustomCtx0 args = popItem >>= \case
+        Nothing ->
+            pure CantContParse
+        Just item -> case item of
+            ItemArgument x -> do
+                go capturedCtxForFail mrollbackCustomCtx0 do x:args
+            ItemModifyCustomContext customCtx ->
+                go capturedCtxForFail
+                    do Just customCtx
+                    do args
+            ItemBackpoint{} -> do
+                go capturedCtxForFail mrollbackCustomCtx0 args
+            ItemHandleNot{} -> do
+                forM_ mrollbackCustomCtx0 \customCtx -> updateCustomContext customCtx
+                parseFailWithAlt alt
+            ItemEnter pos mmark v enterSn ->
+                goEnter capturedCtxForFail mrollbackCustomCtx0 args pos mmark v enterSn
+
+    goEnter capturedCtxForFail mrollbackCustomCtx args pos0 mmark0 v enterSn = do
+        parser <- getCtx ctxParser
+        case Parser.parserAltKind parser alt of
+            PEG.AltSeq -> runActionAndSaveEnterResult v pos0 mrollbackCustomCtx alt args >>= \case
+                False -> do
+                    restoreCtx capturedCtxForFail
+                    parseFailWithAlt alt
+                True -> do
+                    setNextState enterSn
+                    pure ContParse
+            PEG.AltAnd -> runActionAndSaveEnterResult v pos0 mrollbackCustomCtx alt args >>= \case
+                False -> do
+                    restoreCtx capturedCtxForFail
+                    parseFailWithAlt alt
+                True -> do
+                    let mark0 = case mmark0 of
+                            Nothing ->
+                                error "unreachable: no mark with and alternative"
+                            Just x ->
+                                x
+                    seekToMark pos0 mark0
+                    setNextState enterSn
+                    pure ContParse
+            PEG.AltNot ->
+                pure CantContParse
+
+parseFailWithAlt :: forall ctx posMark elem altHelp m
+    .  Scanner.T posMark elem m
+    => Parser.AltNum -> RunT ctx posMark elem altHelp m RunningResult
+parseFailWithAlt alt = do
+    parser <- getCtx ctxParser
+    let (varHelp, altHelp) = Parser.parserAltHelp parser alt
+    parseFail do Just do FailedWithHelp [(varHelp, altHelp, Nothing)]
+
+parseFailWithState :: forall ctx posMark elem altHelp m
+    .  Scanner.T posMark elem m
+    => Parser.StateNum -> RunT ctx posMark elem altHelp m RunningResult
+parseFailWithState sn = do
+    parser <- getCtx ctxParser
+    let altItems = Parser.parserStateHelp parser sn
+    let helps =
+            [
+                ( varHelp
+                , altHelp
+                , Just pos
+                )
+            | (alt, pos) <- altItems
+            , let (varHelp, altHelp) = Parser.parserAltHelp parser alt
+            ]
+    parseFail do Just do FailedWithHelp helps
+
+parseFail :: forall ctx posMark elem altHelp m
+    .  Scanner.T posMark elem m
+    => Maybe (FailedReason altHelp) -> RunT ctx posMark elem altHelp m RunningResult
+parseFail = go0 where
+    go0 :: Maybe (FailedReason altHelp) -> RunT ctx posMark elem altHelp m RunningResult
+    go0 mayFailedReason = do
+#if DEBUG
+        debugTraceShow ("parseFail", fmap (const ()) <$> mayFailedReason) do pure ()
+#endif
+        case mayFailedReason of
+            Nothing ->
+                pure ()
+            Just failedReason -> do
+                reportError failedReason
+        go Nothing
+
+    go :: Maybe ctx -> RunT ctx posMark elem altHelp m RunningResult
+    go mrollbackCustomCtx0 = popItem >>= \case
+        Nothing ->
+            pure CantContParse
+        Just item -> case item of
+            ItemBackpoint pos p backSn -> do
+                forM_ mrollbackCustomCtx0 \customCtx -> updateCustomContext customCtx
+                setNextState backSn
+                seekToMark pos p
+                pure ContParse
+            ItemHandleNot alt -> do
+                forM_ mrollbackCustomCtx0 \customCtx -> updateCustomContext customCtx
+                capturedCtxForFail <- captureCtx
+                goHandleNot capturedCtxForFail Nothing alt
+            ItemModifyCustomContext customCtx ->
+                go do Just customCtx
+            ItemArgument{} ->
+                go mrollbackCustomCtx0
+            ItemEnter pos0 _ v _ -> do
+                saveFailedEnterAction v pos0
+                go mrollbackCustomCtx0
+
+    goHandleNot capturedCtxForFail mrollbackCustomCtx0 alt = popItem >>= \case
+        Nothing ->
+            pure CantContParse
+        Just item -> case item of
+            ItemEnter pos0 mmark0 v enterSn ->
+                goEnter capturedCtxForFail mrollbackCustomCtx0 alt pos0 mmark0 v enterSn
+            ItemArgument{} ->
+                goHandleNot capturedCtxForFail mrollbackCustomCtx0 alt
+            ItemBackpoint{} ->
+                goHandleNot capturedCtxForFail mrollbackCustomCtx0 alt
+            ItemHandleNot{} ->
+                pure CantContParse
+            ItemModifyCustomContext customCtx ->
+                goHandleNot capturedCtxForFail
+                    do Just customCtx
+                    do alt
+
+    goEnter
+        :: Context ctx posMark elem altHelp -> Maybe ctx
+        -> Parser.AltNum -> Position -> Maybe posMark -> Parser.VarNum -> Parser.StateNum
+        -> RunT ctx posMark elem altHelp m RunningResult
+    goEnter capturedCtxForFail mrollbackCustomCtx alt pos0 mmark0 v enterSn = do
+        parser <- getCtx ctxParser
+        case Parser.parserAltKind parser alt of
+            PEG.AltSeq ->
+                error "unreachable: a not handling with seq alternative"
+            PEG.AltAnd ->
+                error "unreachable: a not handling with and alternative"
+            PEG.AltNot -> runActionAndSaveEnterResult v pos0 mrollbackCustomCtx alt [] >>= \case
+                False -> do
+                    restoreCtx capturedCtxForFail
+                    parseFailWithAlt alt
+                True -> do
+                    let mark0 = case mmark0 of
+                            Nothing ->
+                                error "unreachable: no mark with not alternative"
+                            Just x ->
+                                x
+                    seekToMark pos0 mark0
+                    setNextState enterSn
+                    pure ContParse
+
+runActionAndSaveEnterResult
+    :: Scanner.T posMark elem m
+    => Parser.VarNum -> Position
+    -> Maybe ctx -> Parser.AltNum -> [Parser.ReduceArgument]
+    -> RunT ctx posMark elem altHelp m Bool
+runActionAndSaveEnterResult v pos0 mrollbackCustomCtx alt args =
+    runAction alt args >>= \case
+        Syntax.ActionTaskFail ->
+            pure False
+        Syntax.ActionTaskResult res -> do
+            saveParsedEnterAction v pos0 mrollbackCustomCtx Nothing res
+            pure True
+        Syntax.ActionTaskModifyResult ctx1 res -> do
+            saveParsedEnterAction v pos0 mrollbackCustomCtx (Just ctx1) res
+            pure True
+
+runAction :: Scanner.T posMark elem m
+    => Parser.AltNum -> [Parser.ReduceArgument]
+    -> RunT ctx posMark elem altHelp m (Syntax.ActionTaskResult ctx Parser.ReduceArgument)
+runAction alt args = do
+    parser <- getCtx ctxParser
+    ctx0 <- getCtx ctxCustomContext
+    let actionTask = Parser.runActionM
+            do Parser.parserAction parser alt
+            do args
+    pure do Syntax.runActionTask actionTask ctx0
+
+saveParsedEnterAction
+    :: Scanner.T posMark elem m
+    => Parser.VarNum -> Position -> Maybe ctx -> Maybe ctx -> Parser.ReduceArgument
+    -> RunT ctx posMark elem altHelp m ()
+saveParsedEnterAction v pos0 mrollbackCustomCtx mactionCustomCtx res = do
+    forM_ mrollbackCustomCtx \customCtx -> do
+        needBack <- isNeedBack
+        when needBack do
+            pushItem do ItemModifyCustomContext customCtx
+    case mactionCustomCtx of
+        Just customCtx ->
+            updateCustomContext customCtx
+        Nothing -> insertMemoItemIfNeeded v pos0 do
+            (pos1, pm1) <- getCurrentPosition
+            pure do MemoItemParsed pos1 pm1 res
+    pushItem do ItemArgument res
+
+saveFailedEnterAction
+    :: Monad m
+    => Parser.VarNum -> Position -> RunT ctx posMark elem altHelp m ()
+saveFailedEnterAction v pos = insertMemoItemIfNeeded v pos do
+    pure MemoItemFailed
+
+reportError
+    :: Scanner.T posMark elem m
+    => FailedReason altHelp -> RunT ctx posMark elem altHelp m ()
+reportError failedReason = do
+    (pos0, posMark0) <- getCurrentPosition
+    RunT do
+        modify' \ctx -> ctx
+            { ctxDeepestError = case ctxDeepestError ctx of
+                oldErr@(Just (pos1, _, _)) | pos0 < pos1 ->
+                    oldErr
+                _ ->
+                    Just (pos0, posMark0, failedReason)
+            }
+
+insertMemoItemIfNeeded
+    :: Monad m
+    => Parser.VarNum -> Position
+    -> RunT ctx posMark elem altHelp m (MemoItem posMark)
+    -> RunT ctx posMark elem altHelp m ()
+insertMemoItemIfNeeded v pos mitem = do
+    needBack <- isNeedBack
+    when needBack do
+        memoItem <- mitem
+        RunT do
+            modify' \ctx -> ctx
+                { ctxMemoTable = AlignableMap.insert pos
+                    do case AlignableMap.lookup pos do ctxMemoTable ctx of
+                        Nothing -> IntMap.singleton v memoItem
+                        Just vm -> IntMap.insert v memoItem vm
+                    do ctxMemoTable ctx
+                }
+
+updateCustomContext :: Monad m => ctx -> RunT ctx posMark elem altHelp m ()
+updateCustomContext customCtx = RunT do
+    modify' \ctx -> ctx
+        { ctxMemoTable = AlignableMap.empty
+        , ctxCustomContext = customCtx
+        }
+
+setNextState :: Monad m => Parser.StateNum -> RunT ctx posMark elem altHelp m ()
+setNextState sn = RunT do
+    modify' \ctx -> ctx
+        { ctxState = sn
+        }
+
+getCtx :: Monad m
+    => (Context ctx posMark elem altHelp -> a)
+    -> RunT ctx posMark elem altHelp m a
+getCtx f = RunT do f <$> get
+{-# INLINE getCtx #-}
+
+captureCtx :: Monad m => RunT ctx posMark elem altHelp m (Context ctx posMark elem altHelp)
+captureCtx = RunT get
+
+restoreCtx :: Monad m => Context ctx posMark elem altHelp -> RunT ctx posMark elem altHelp m ()
+restoreCtx ctx = RunT do put ctx
+
+getCurrentPosition :: Scanner.T posMark elem m
+    => RunT ctx posMark elem altHelp m (Position, posMark)
+getCurrentPosition = getCtx ctxLookAHeadToken >>= \case
+    Just (pos, pm, _, _) ->
+        pure (pos, pm)
+    Nothing -> do
+        pm <- lift Scanner.getPosMark
+        pos <- getCtx ctxNextPosition
+        pure (pos, pm)
+
+consumeIfNeeded :: Scanner.T posMark elem m
+    => RunT ctx posMark elem altHelp m (Parser.TokenNum, Maybe elem)
+consumeIfNeeded = getCtx ctxLookAHeadToken >>= \case
+    Just (_, _, tn, mt) ->
+        pure (tn, mt)
+    Nothing -> do
+        pm <- lift Scanner.getPosMark
+        r@(tn, mt) <- lift Scanner.consumeInput >>= \case
+            Nothing ->
+                pure (Parser.eosToken, Nothing)
+            Just t -> do
+                parser <- getCtx ctxParser
+                let tn = Parser.parserGetTokenNum parser t
+                pure (tn, Just t)
+        RunT do
+            modify' \ctx -> ctx
+                { ctxNextPosition = Alignable.nextAlign
+                    do ctxNextPosition ctx
+                , ctxLookAHeadToken = Just
+                    (ctxNextPosition ctx, pm, tn, mt)
+                }
+        pure r
+
+shift :: Monad m => RunT ctx posMark elem altHelp m ()
+shift = getCtx ctxLookAHeadToken >>= \case
+    Nothing ->
+        error "Must consume before shift"
+    Just (_, _, _, Nothing) ->
+        error "No more shift"
+    Just (_, _, _, Just{}) ->
+        RunT do
+            modify' \ctx -> ctx
+                {
+                    ctxLookAHeadToken = Nothing
+                }
+
+seekToMark :: Scanner.T posMark elem m
+    => Position -> posMark -> RunT ctx posMark elem altHelp m ()
+seekToMark pos pm = do
+    RunT do
+        modify' \ctx -> ctx
+            { ctxLookAHeadToken = Nothing
+            , ctxNextPosition = pos
+            }
+    lift do Scanner.seekToPosMark pm
+
+isNeedBack :: Monad m => RunT ctx posMark elem altHelp m Bool
+isNeedBack = do
+    needBackItemsCount <- getCtx ctxNeedBackItemsCount
+    pure do needBackItemsCount > 0
+
+pushItem
+    :: Scanner.T posMark elem m
+    => Item posMark ctx -> RunT ctx posMark elem altHelp m ()
+pushItem item = do
+    (pos, p) <- getCurrentPosition
+    bc0 <- getCtx ctxNeedBackItemsCount
+    let bc1 = if isNeedBackItem item then bc0 + 1 else bc0
+    when do bc0 == 0 && bc1 > 0
+        do lift do Scanner.scanMode do Scanner.ScanModeNeedBack p
+    RunT do
+        modify' \ctx -> ctx
+            { ctxItemStack = item:ctxItemStack ctx
+            , ctxNeedBackItemsCount = bc1
+            , ctxMemoTable = if bc0 == 0 && bc1 > 0
+                then do
+                    AlignableMap.restrictGreaterOrEqual
+                        do pos
+                        do ctxMemoTable ctx
+                else
+                    ctxMemoTable ctx
+            }
+
+popItem
+    :: Scanner.T posMark elem m
+    => RunT ctx posMark elem altHelp m (Maybe (Item posMark ctx))
+popItem = getCtx ctxItemStack >>= \case
+    [] ->
+        pure Nothing
+    item:rest -> do
+        bc0 <- getCtx ctxNeedBackItemsCount
+        let bc1 = if isNeedBackItem item then bc0 - 1 else bc0
+        when do bc1 == 0
+            do lift do Scanner.scanMode Scanner.ScanModeNoBack
+        RunT do
+            modify' \ctx -> ctx
+                { ctxItemStack = rest
+                , ctxNeedBackItemsCount = bc1
+                }
+        pure do Just item
+
+isNeedBackItem :: Item posMark ctx -> Bool
+isNeedBackItem = \case
+    ItemHandleNot{} ->
+        False
+    ItemBackpoint{} ->
+        True
+    ItemModifyCustomContext{} ->
+        False
+    ItemEnter _ mmark _ _ -> case mmark of
+        Nothing ->
+            False
+        Just{} ->
+            True
+    ItemArgument{} ->
+        False
diff --git a/src/Language/Parser/Ptera/Scanner.hs b/src/Language/Parser/Ptera/Scanner.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Parser/Ptera/Scanner.hs
@@ -0,0 +1,42 @@
+module Language.Parser.Ptera.Scanner where
+
+import           Language.Parser.Ptera.Prelude
+
+
+type T = Scanner
+
+class Monad m => Scanner posMark elem m | m -> posMark, m -> elem where
+    consumeInput :: m (Maybe elem)
+    getPosMark :: m posMark
+    seekToPosMark :: posMark -> m ()
+    scanMode :: ScanMode posMark -> m ()
+
+data ScanMode posMark
+    = ScanModeNoBack
+    | ScanModeNeedBack posMark
+    deriving (Eq, Show)
+
+
+newtype ListScanner e a = ListScanner
+    {
+        unListScanner :: State [e] a
+    }
+    deriving (Functor, Applicative, Monad) via State [e]
+
+runListScanner :: ListScanner e a -> [e] -> a
+runListScanner (ListScanner scanner) xs = evalState scanner xs
+
+instance Scanner [e] e (ListScanner e) where
+    consumeInput = ListScanner do
+        get >>= \case
+            [] ->
+                pure Nothing
+            x:xs -> do
+                put xs
+                pure do Just x
+
+    getPosMark = ListScanner get
+
+    seekToPosMark xs = ListScanner do put xs
+
+    scanMode _ = pure ()
diff --git a/src/Language/Parser/Ptera/Syntax.hs b/src/Language/Parser/Ptera/Syntax.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Parser/Ptera/Syntax.hs
@@ -0,0 +1,160 @@
+module Language.Parser.Ptera.Syntax (
+    T,
+
+    HasField (..),
+    SafeGrammar.HasRuleExprField (..),
+    SafeGrammar.TokensTag,
+    SafeGrammar.RulesTag,
+    SafeGrammar.RuleExprType,
+
+    GrammarM,
+    SafeGrammar.MemberInitials (..),
+    SafeGrammar.Rules (..),
+    SafeGrammar.GrammarToken (..),
+    RuleExprM,
+    AltM,
+    SafeGrammar.Expr,
+    HFList.HFList (..),
+    HFList.DictF (..),
+    HList,
+    pattern HNil,
+    pattern (:*),
+    SemActM (..),
+    semActM,
+    ActionTask (..),
+    ActionTaskResult (..),
+    getAction,
+    modifyAction,
+    failAction,
+
+    Grammar,
+    RuleExpr,
+    Alt,
+    SemAct,
+    semAct,
+
+    SafeGrammar.fixGrammar,
+    SafeGrammar.ruleExpr,
+    (SafeGrammar.<^>),
+    (<:>),
+    eps,
+    (<::>),
+    epsM,
+    SafeGrammar.var,
+    SafeGrammar.varA,
+    SafeGrammar.tok,
+    SafeGrammar.TokensMember (..),
+    SafeGrammar.tokA,
+) where
+
+import           Language.Parser.Ptera.Prelude
+
+import qualified Language.Parser.Ptera.Data.HFList as HFList
+import qualified Language.Parser.Ptera.Syntax.SafeGrammar as SafeGrammar
+
+
+type T ctx = GrammarM ctx
+
+type GrammarM ctx = SafeGrammar.Grammar (SemActM ctx)
+type RuleExprM ctx = SafeGrammar.RuleExpr (SemActM ctx)
+type AltM ctx = SafeGrammar.Alt (SemActM ctx)
+
+type Grammar = GrammarM ()
+type RuleExpr = RuleExprM ()
+type Alt = AltM ()
+
+
+(<:>)
+    :: SafeGrammar.Expr rules tokens elem us -> (HList us -> a)
+    -> AltM ctx rules tokens elem a
+e <:> act = e SafeGrammar.<:> semAct act
+
+infixl 4 <:>
+
+eps :: (HList '[] -> a) -> AltM ctx rules tokens elem a
+eps act = SafeGrammar.eps do semAct act
+
+(<::>)
+    :: SafeGrammar.Expr rules tokens elem us -> (HList us -> ActionTask ctx a)
+    -> AltM ctx rules tokens elem a
+e <::> act = e SafeGrammar.<:> semActM act
+
+infixl 4 <::>
+
+epsM :: (HList '[] -> ActionTask ctx a) -> AltM ctx rules tokens elem a
+epsM act = SafeGrammar.eps do semActM act
+
+
+type HList = HFList.T Identity
+
+pattern HNil :: HList '[]
+pattern HNil = HFList.HFNil
+
+pattern (:*) :: u -> HList us -> HList (u ': us)
+pattern x :* xs = HFList.HFCons (Identity x) xs
+
+infixr 6 :*
+
+
+newtype SemActM ctx us a = SemActM
+    { semanticAction :: HList us -> ActionTask ctx a
+    }
+    deriving Functor
+
+type SemAct = SemActM ()
+
+semActM :: (HList us -> ActionTask ctx a) -> SemActM ctx us a
+semActM = SemActM
+
+semAct :: (HList us -> a) -> SemActM ctx us a
+semAct f = SemActM \l -> pure do f l
+
+
+newtype ActionTask ctx a = ActionTask
+    { runActionTask :: ctx -> ActionTaskResult ctx a
+    }
+    deriving Functor
+
+data ActionTaskResult ctx a
+    = ActionTaskFail
+    | ActionTaskResult a
+    | ActionTaskModifyResult ctx a
+    deriving (Eq, Show, Functor)
+
+getAction :: ActionTask ctx ctx
+getAction = ActionTask \ctx0 -> ActionTaskResult ctx0
+
+modifyAction :: (ctx -> ctx) -> ActionTask ctx ()
+modifyAction f = ActionTask \ctx0 -> ActionTaskModifyResult (f ctx0) ()
+
+failAction :: ActionTask ctx a
+failAction = ActionTask \_ -> ActionTaskFail
+
+instance Applicative (ActionTask ctx) where
+    pure x = ActionTask \_ -> ActionTaskResult x
+    ActionTask mf <*> ActionTask mx = ActionTask \ctx0 -> case mf ctx0 of
+        ActionTaskFail ->
+            ActionTaskFail
+        ActionTaskResult f -> case mx ctx0 of
+            ActionTaskFail ->
+                ActionTaskFail
+            ActionTaskResult x ->
+                ActionTaskResult do f x
+            ActionTaskModifyResult ctx1 x ->
+                ActionTaskModifyResult ctx1 do f x
+        ActionTaskModifyResult ctx1 f -> case mx ctx1 of
+            ActionTaskFail ->
+                ActionTaskFail
+            ActionTaskResult x ->
+                ActionTaskModifyResult ctx1 do f x
+            ActionTaskModifyResult ctx2 x ->
+                ActionTaskModifyResult ctx2 do f x
+
+instance Monad (ActionTask ctx) where
+    ActionTask mx >>= f = ActionTask \ctx0 -> case mx ctx0 of
+        ActionTaskFail ->
+            ActionTaskFail
+        ActionTaskResult x ->
+            runActionTask (f x) ctx0
+        ActionTaskModifyResult ctx1 x ->
+            runActionTask (f x) ctx1
diff --git a/src/Language/Parser/Ptera/Syntax/SafeGrammar.hs b/src/Language/Parser/Ptera/Syntax/SafeGrammar.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Parser/Ptera/Syntax/SafeGrammar.hs
@@ -0,0 +1,243 @@
+{-# LANGUAGE AllowAmbiguousTypes     #-}
+{-# LANGUAGE UndecidableInstances    #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
+
+module Language.Parser.Ptera.Syntax.SafeGrammar (
+    T,
+
+    Grammar (..),
+    TokensTag,
+    RulesTag,
+    RuleExprType,
+    GrammarToken (..),
+    fixGrammar,
+
+    StartPoint,
+    Terminal,
+    NonTerminal,
+    HasRuleExprField (..),
+    MemberInitials (..),
+    Rules (..),
+    genStartPoint,
+
+    RuleExpr (..),
+    Alt (..),
+    Expr (..),
+    ruleExpr,
+    (<^>),
+    (<:>),
+    eps,
+    var,
+    varA,
+    tok,
+    TokensMember (..),
+    tokA,
+) where
+
+import           Language.Parser.Ptera.Prelude
+
+import qualified Data.HashMap.Strict                  as HashMap
+import qualified Language.Parser.Ptera.Data.HEnum     as HEnum
+import qualified Language.Parser.Ptera.Data.HFList     as HFList
+import qualified Language.Parser.Ptera.Syntax.Grammar as SyntaxGrammar
+import           Prelude                              (String)
+import qualified Type.Membership                      as Membership
+
+
+type T = Grammar
+
+type Grammar
+    :: ([Type] -> Type -> Type) -> Type -> Type -> Type -> [Symbol]
+    -> Type
+newtype Grammar action rules tokens elem initials = UnsafeGrammar
+    {
+        unsafeGrammar :: SyntaxGrammar.FixedGrammar
+            StartPoint
+            NonTerminal
+            Terminal
+            elem
+            StringLit
+            (Maybe ())
+            action
+    }
+
+type family TokensTag (tokens :: Type) :: [Symbol]
+type family RulesTag (rules :: Type) :: [Symbol]
+type family RuleExprType (rules :: Type) :: Type -> Type
+
+class GrammarToken tokens elem where
+    tokenToTerminal :: Proxy tokens -> elem -> HEnum.T (TokensTag tokens)
+
+class
+    ( KnownSymbol v
+    , HasField v rules ((RuleExprType rules) (RuleExprReturnType rules v))
+    ) => HasRuleExprField rules v where
+    type RuleExprReturnType rules v :: Type
+
+    nonTerminalName :: rules -> proxy v -> String
+    nonTerminalName _ p = symbolVal p
+
+type GrammarMForFixGrammar elem action = SyntaxGrammar.GrammarT
+    StartPoint
+    NonTerminal
+    Terminal
+    elem
+    StringLit
+    (Maybe ())
+    action
+    Identity
+
+fixGrammar
+    :: forall initials action rules tokens elem
+    .  MemberInitials rules initials
+    => Rules rules => RuleExprType rules ~ RuleExpr action rules tokens elem
+    => rules -> Grammar action rules tokens elem initials
+fixGrammar ruleDefs = UnsafeGrammar do
+    runIdentity do
+        SyntaxGrammar.fixGrammarT do
+            HFList.hforMWithIndex
+                memberInitials
+                fixInitial
+            HFList.hforMWithIndex
+                generateRules
+                fixRule
+    where
+        fixInitial
+            :: Membership.Membership initials v
+            -> HFList.DictF (HasRuleExprField rules) v
+            -> GrammarMForFixGrammar elem action ()
+        fixInitial m HFList.DictF = do
+            let sn = genStartPoint m
+            let vn = getNewV do symbolVal m
+            SyntaxGrammar.initialT sn vn
+
+        fixRule
+            :: forall v
+            .  Membership.Membership (RulesTag rules) v
+            -> HFList.DictF (HasRuleExprField rules) v
+            -> GrammarMForFixGrammar elem action ()
+        fixRule m HFList.DictF = do
+            let vn = getNewV do symbolVal m
+            let d = nonTerminalName ruleDefs m
+            SyntaxGrammar.ruleT vn d do
+                fixRuleExpr do getField @v ruleDefs
+
+        fixRuleExpr :: RuleExpr action rules tokens elem a
+            -> SyntaxGrammar.RuleExpr NonTerminal Terminal elem (Maybe ()) action
+        fixRuleExpr = \case
+            RuleExpr alts -> SyntaxGrammar.RuleExpr
+                [ fixAlt origAlt | origAlt <- alts ]
+
+        fixAlt :: Alt action rules tokens elem a
+            -> SyntaxGrammar.Alt NonTerminal Terminal elem (Maybe ()) action a
+        fixAlt (UnsafeAlt origAlt) = case origAlt of
+            SyntaxGrammar.Alt e h act -> SyntaxGrammar.Alt
+                do fixExpr e
+                do h
+                do act
+
+        fixExpr :: SyntaxGrammar.Expr IntermNonTerminal Terminal elem us
+            -> SyntaxGrammar.Expr NonTerminal Terminal elem us
+        fixExpr = HFList.hmapWithIndex
+            do \_ u1 -> fixUnit u1
+
+        fixUnit :: SyntaxGrammar.Unit IntermNonTerminal Terminal elem u
+            -> SyntaxGrammar.Unit NonTerminal Terminal elem u
+        fixUnit u = case u of
+            SyntaxGrammar.UnitToken t ->
+                SyntaxGrammar.UnitToken t
+            SyntaxGrammar.UnitVar v ->
+                SyntaxGrammar.UnitVar do getNewV v
+
+        rulesTag = genRulesTagMap do proxy# @rules
+
+        getNewV v = case HashMap.lookup v rulesTag of
+            Just newV ->
+                newV
+            Nothing ->
+                error "unreachable: rulesTag must include v."
+
+type StartPoint = Int
+type Terminal = Int
+type NonTerminal = Int
+type IntermNonTerminal = String
+
+
+class MemberInitials rules initials where
+    memberInitials :: HFList.T (HFList.DictF (HasRuleExprField rules)) initials
+
+class Rules rules where
+    generateRules :: HFList.T (HFList.DictF (HasRuleExprField rules)) (RulesTag rules)
+
+
+genStartPoint :: forall initials v. Membership.Membership initials v -> StartPoint
+genStartPoint m = Membership.getMemberId m
+
+genRulesTagMap :: forall rules.
+    Rules rules => Proxy# rules -> HashMap.HashMap IntermNonTerminal NonTerminal
+genRulesTagMap _ = HFList.hfoldlWithIndex HashMap.empty go generateRules where
+    go :: forall v
+        .  HashMap.HashMap IntermNonTerminal NonTerminal
+        -> Membership.Membership (RulesTag rules) v
+        -> HFList.DictF (HasRuleExprField rules) v
+        -> HashMap.HashMap IntermNonTerminal NonTerminal
+    go vMap m HFList.DictF = HashMap.insert
+        do symbolVal' do proxy# @v
+        do Membership.getMemberId m
+        do vMap
+
+type RuleExpr :: ([Type] -> Type -> Type) -> Type -> Type -> Type -> Type -> Type
+newtype RuleExpr action rules tokens elem a = RuleExpr
+    { unRuleExpr :: [Alt action rules tokens elem a]
+    }
+
+type Alt :: ([Type] -> Type -> Type) -> Type -> Type -> Type -> Type -> Type
+newtype Alt action rules tokens elem a = UnsafeAlt
+    { unsafeAlt
+        :: SyntaxGrammar.Alt IntermNonTerminal Terminal elem (Maybe ()) action a
+    }
+
+type Expr :: Type -> Type -> Type -> [Type] -> Type
+newtype Expr rules tokens elem us = UnsafeExpr
+    { unsafeExpr :: SyntaxGrammar.Expr IntermNonTerminal Terminal elem us
+    }
+
+class TokensMember tokens t where
+    tokensMembership :: Proxy# '(tokens, t) -> Membership.Membership (TokensTag tokens) t
+
+ruleExpr :: [Alt action rules tokens elem a] -> RuleExpr action rules tokens elem a
+ruleExpr alts = RuleExpr alts
+
+(<:>)
+    :: Expr rules tokens elem us -> action us a
+    -> Alt action rules tokens elem a
+UnsafeExpr e <:> act = UnsafeAlt do SyntaxGrammar.Alt e Nothing act
+
+infixl 4 <:>
+
+eps :: action '[] a -> Alt action rules tokens elem a
+eps act = UnsafeAlt do SyntaxGrammar.Alt HFList.HFNil Nothing act
+
+(<^>)
+    :: Expr rules tokens elem us1 -> Expr rules tokens elem us2
+    -> Expr rules tokens elem (HFList.Concat us1 us2)
+UnsafeExpr e1 <^> UnsafeExpr e2 = UnsafeExpr do HFList.hconcat e1 e2
+
+infixr 5 <^>
+
+var :: KnownSymbol v => proxy v -> Expr rules tokens elem '[RuleExprReturnType rules v]
+var p = UnsafeExpr do HFList.HFCons u HFList.HFNil where
+    u = SyntaxGrammar.UnitVar do symbolVal p
+
+varA :: forall v rules tokens elem.
+    KnownSymbol v => Expr rules tokens elem '[RuleExprReturnType rules v]
+varA = var do Proxy @v
+
+tok :: Membership.Membership (TokensTag tokens) t -> Expr rules tokens elem '[elem]
+tok p = UnsafeExpr do HFList.HFCons u HFList.HFNil where
+    u = SyntaxGrammar.UnitToken
+        do HEnum.unsafeHEnum do HEnum.henum p
+
+tokA :: forall t rules tokens elem.
+    TokensMember tokens t => Expr rules tokens elem '[elem]
+tokA = tok do tokensMembership do proxy# @'(tokens, t)
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,23 @@
+module Main where
+
+import           Prelude
+
+import qualified Build_doctests     as BuildF
+import qualified Control.Exception  as Exception
+import           Control.Monad
+import qualified System.Environment as IO
+import qualified System.IO          as IO
+import qualified Test.DocTest       as 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.doctest args `Exception.catch`
+    \(e :: Exception.SomeException) -> print e
+  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 #-}