diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c)2011, Hideyuki Tanaka
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Hideyuki Tanaka nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Main.hs b/Main.hs
new file mode 100644
--- /dev/null
+++ b/Main.hs
@@ -0,0 +1,32 @@
+{-# Language QuasiQuotes #-}
+{-# Language FlexibleContexts #-}
+
+module Main (main) where
+
+import Text.Peggy
+
+[peggy|
+-- Simple Arithmetic Expression Parser
+
+top :: Double = expr !.
+
+expr :: Double
+  = expr "+" fact { $1 + $2 }
+  / expr "-" fact { $1 - $2 }
+  / fact
+
+fact :: Double
+  = fact "*" term { $1 * $2 }
+  / fact "/" term { $1 / $2 }
+  / term
+
+term :: Double
+  = "(" expr ")"
+  / number
+
+number ::: Double
+  = [1-9] [0-9]* { read ($1 : $2) }
+|]
+
+main :: IO ()
+main = print . parse top =<< getContents
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,67 @@
+# Peggy: A Parser Generator of Parsing Expression Grammer (PEG) #
+
+# About
+
+This is an yet another parser generator of Parsing Expression Grammer (PEG) which is:
+
+* Simple
+* Concise
+* Fast
+* Modern
+
+# Usage
+
+You can find a recent stable release in Hackage DB.
+You can install this as following instruction:
+
+    $ cabal update
+    $ cabal install Peggy
+
+# Why should you use Peggy?
+
+Haskell has commonly used parser generators, one of them are Alex/Happy.
+But I think Alex/Happy are not good in these points:
+
+* Generates regacy codes
+
+Alex uses only too basic libraries.
+It does not use monad-transformers, iteratee, ListLike, Text, and so on.
+
+* Tradisional Regexp/CFG based parser
+
+Parsec has no good error recovery.
+
+unnun, kannun...
+
+...
+
+# Quick Start
+
+Here is an example of parsing arithmetic expressions.
+
+    {-# QuasiQuotes #-}
+    {-# Language FlexibleContexts #-}
+    
+    import Text.Peggy
+    
+    [peggy|
+    exp :: Double
+      = exp "+" fact  { $1 + $2 }
+      / exp "-" fact  { $1 - $2 }
+      / fact
+    fact :: Double
+      = fact "*" term { $1 * $2 }
+      / fact "/" term { $1 / $2 }
+      / term
+    term :: Double
+      = "(" exp ")"
+      / number
+    number ::: Double
+      = ([1-9][0-9]*) { read $1 }
+    |]
+    
+    main :: IO ()
+    main =
+      print . parse exp =<< getContents
+
+...
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Text/Peggy.hs b/Text/Peggy.hs
new file mode 100644
--- /dev/null
+++ b/Text/Peggy.hs
@@ -0,0 +1,9 @@
+module Text.Peggy (
+  module Text.Peggy.PrimST,
+  module Text.Peggy.SrcLoc,
+  module Text.Peggy.Quote,
+  ) where
+
+import Text.Peggy.PrimST
+import Text.Peggy.SrcLoc
+import Text.Peggy.Quote
diff --git a/Text/Peggy/CodeGen/TH.hs b/Text/Peggy/CodeGen/TH.hs
new file mode 100644
--- /dev/null
+++ b/Text/Peggy/CodeGen/TH.hs
@@ -0,0 +1,184 @@
+{-# Language TemplateHaskell #-}
+{-# Language TupleSections #-}
+{-# Language FlexibleContexts #-}
+
+module Text.Peggy.CodeGen.TH (
+  genCode,
+  removeLeftRecursion,
+  ) where
+
+import Control.Applicative
+import Control.Monad
+import qualified Data.HashTable.ST.Basic as HT
+import qualified Data.ListLike as LL
+import Language.Haskell.Meta
+import Language.Haskell.TH
+import Text.Peggy.PrimST
+import Text.Peggy.Syntax
+import Text.Peggy.SrcLoc
+import Text.Peggy.Normalize
+import Text.Peggy.LeftRec
+
+genCode :: Syntax -> Q [Dec]
+genCode = generate . removeLeftRecursion . normalize
+
+generate :: Syntax -> Q [Dec]
+generate defs = do
+  tblName <- newName "MemoTable"
+  ps <- parsers tblName
+  sequence $ [defTbl tblName, instTbl tblName] ++ ps
+  where
+  n = length defs
+  
+  defTbl tblName = do
+    s <- newName "s"
+    str <- newName "str"
+    dataD (cxt []) tblName [PlainTV str, PlainTV s] [con s str] []
+    where
+      con s str = recC tblName $ map toMem defs where
+        toMem (Definition nont typ _) = do
+          t <- [t| HT.HashTable $(varT s) Int
+                   (Result $(varT str) $(parseType' typ)) |]
+          return (mkName $ "tbl_" ++nont, NotStrict, t)
+
+  instTbl tblName = do
+    str <- newName "str"
+    instanceD (cxt []) (conT ''MemoTable `appT` (conT tblName `appT` varT str))
+      [ valD (varP 'newTable) (normalB body) [] ]
+    where
+    body = do
+      names <- replicateM n (newName "t")
+      doE $ map (\name -> bindS (varP name) [| HT.new |]) names
+            ++ [ noBindS $ appsE [varE 'return, appsE $ conE tblName : map varE names]]
+
+  parsers tblName = concat <$> mapM (gen tblName) defs
+  
+  gen tblName (Definition nont typ e) = do
+    str <- newName "str"
+    s <- newName "s"
+    return $
+      [ sigD (mkName nont) $
+        forallT [PlainTV str, PlainTV s]
+                (cxt [classP ''LL.ListLike [varT str, conT ''Char]]) $
+        conT ''Parser `appT`
+        (conT tblName `appT` varT str) `appT`
+        varT str `appT`
+        varT s `appT`
+        parseType' typ
+      , funD (mkName nont)
+        [clause [] (normalB [| memo $(varE $ mkName $ "tbl_" ++ nont) $ $(genP e) |]) []]]
+  
+  genP e = case e of
+    Terminals False False str ->
+      [| string str |]
+    Terminals True  False str ->
+      [| many $(varE skip) *> string str |]
+    Terminals False True  str ->
+      [| string str <* many $(varE skip) |]
+    Terminals True True  str ->
+      [| many $(varE skip) *> string str <* many $(varE skip) |]
+
+    TerminalSet rs ->
+      [| satisfy $(genRanges rs) |]
+    TerminalCmp rs ->
+      [| satisfy $ not . $(genRanges rs) |]
+    TerminalAny ->
+      [| anyChar |]
+    NonTerminal nont ->
+      [| $(varE $ mkName nont) |]
+    Primitive name ->
+      [| $(varE $ mkName name) |]
+    Empty ->
+      [| return () |]
+
+    Semantic (Sequence es) cf ->
+      doE $ genBinds 1 es ++ [ noBindS [| return $(genCF cf) |] ]
+    Semantic f cf ->
+      genP (Semantic (Sequence [f]) cf)
+
+    Sequence es -> do
+      binds <- sequence $ genBinds 1 es
+      let vn = length $ filter isBind binds
+      doE $ do
+        map return binds ++
+          [ noBindS [| return $ $(tupE $ map (varE .mkName  . var) [1..vn]) |] ]
+
+    Choice es ->
+      foldl1 (\a b -> [| $a <|> $b |]) $ map genP es
+
+    Many f ->
+      [| many $(genP f) |]
+    Some f ->
+      [| some $(genP f) |]
+    Optional f ->
+      [| optional $(genP f) |]
+    And f ->
+      [| expect $(genP f) |]
+    Not f ->
+      [| unexpect $(genP f) |]
+
+    Token f ->
+      [| many $(varE skip) *> $(genP f) <* many $(varE skip) |]
+
+    -- these are removed normalized phase
+    SepBy  {} -> error "internal desugar error"
+    SepBy1 {} -> error "internal desugar error"
+
+    Named {} -> error "named expr must has semantic."
+
+    where
+      skip = mkName "skip"
+
+      genBinds _ [] = []
+      genBinds ix (f:fs) = case f of
+        Named name g ->
+          bindS (asP (mkName name) $ varP $ mkName (var ix)) (genP g) :
+          genBinds (ix+1) fs
+        _ | shouldBind f ->
+          bindS (varP $ mkName $ var ix) (genP f) :
+          genBinds (ix+1) fs
+        _ ->
+          noBindS (genP f) :
+          genBinds ix fs
+
+      shouldBind f = case f of
+        Terminals _ _ _ -> False
+        And _ -> False
+        Not _ -> False
+        _ -> True
+
+      isBind (BindS _ _) = True
+      isBind _ = False
+  
+  genRanges rs =
+    let c = mkName "c" in
+    lamE [varP c] $ foldl1 (\a b -> [| $a || $b |]) $ map (genRange c) rs
+  genRange c (CharRange l h) =
+    [| l <= $(varE c) && $(varE c) <= h |]
+  genRange c (CharOne v) =
+    [| $(varE c) == v |]
+
+  genCF cf =
+    case parsed of
+      Left _ ->
+        error $ "code fragment parse error: " ++ scf
+      Right ret ->
+        return ret
+    where
+    parsed = parseExp scf
+    scf = concatMap toStr cf
+    toStr (Snippet str) = str
+    toStr (Argument n)  = var n
+
+  var n = "v" ++ show (n :: Int)
+
+parseType' typ =
+  case parseType typ of
+    Left err -> error $ "type parse error :" ++ typ ++ ", " ++ err
+    Right t -> case t of
+      -- GHC.Unit.() is not a type name. Is it a bug of haskell-src-meta?
+      -- Use (TupleT 0) insted.
+      ConT con | show con == "GHC.Unit.()" ->
+        return $ TupleT 0
+      _ ->
+        return t
diff --git a/Text/Peggy/LeftRec.hs b/Text/Peggy/LeftRec.hs
new file mode 100644
--- /dev/null
+++ b/Text/Peggy/LeftRec.hs
@@ -0,0 +1,72 @@
+module Text.Peggy.LeftRec (
+  removeLeftRecursion,
+  ) where
+
+import Text.Peggy.Syntax
+
+-- Remove only direct left recursion
+-- TODO: indirect left recursion
+removeLeftRecursion :: Syntax -> Syntax
+removeLeftRecursion = concatMap remove where
+  remove (Definition nont typ (Choice es)) | not $ null alphas =
+    [ Definition nont typ $ Choice
+      [ Semantic (Sequence $ beta : [NonTerminal rest]) betaFrag
+      | beta <- betas
+      ]
+    , Definition rest ("(" ++ typ ++ ") -> (" ++ typ ++")") $ Choice $
+      [ Sequence $ fs ++ [NonTerminal rest]
+      | Sequence (_: fs) <- alphas
+      ] ++
+      [ Semantic
+        (Sequence $ fs ++ [NonTerminal rest])
+        (alphaFrag cf $ length (filter hasSemantic fs) + 1)
+      | Semantic (Sequence (_: fs)) cf <- alphas
+      ] ++
+      [ Semantic Empty idFrag ]
+    ]
+    where
+      rest = nont ++ "_tail"
+      (alphas, betas) = span isLeftRec es
+      
+      idFrag =
+        [ Snippet "id"
+        ]
+        
+      betaFrag =
+        [ Argument 2
+        , Snippet " "
+        , Argument 1
+        ]
+      
+      alphaFrag org ano =
+        [ Snippet "\\v999 -> "
+        , Argument ano
+        , Snippet " ( "
+        ] ++
+        map trans org ++
+        [ Snippet " )" ]
+      
+      trans (Argument n)
+        | n == 1 = Argument 999
+        | otherwise = Argument (n - 1)
+      trans e = e
+
+      isLeftRec (Sequence (NonTerminal nt : _))
+        = nt == nont
+      isLeftRec (Semantic e _)
+        = isLeftRec e
+      isLeftRec (Named _ e)
+        = isLeftRec e
+      isLeftRec _
+        = False
+      
+      hasSemantic (Terminals _ _ _) = False
+      hasSemantic (And           _) = False
+      hasSemantic (Not           _) = False
+      hasSemantic _                 = True
+  
+  remove d@(Definition nont _ (NonTerminal nt))
+    | nont == nt = error "cannot remove left recursion"
+    | otherwise = [d]
+
+  remove e = [e]
diff --git a/Text/Peggy/Normalize.hs b/Text/Peggy/Normalize.hs
new file mode 100644
--- /dev/null
+++ b/Text/Peggy/Normalize.hs
@@ -0,0 +1,59 @@
+module Text.Peggy.Normalize (
+  normalize,
+  ) where
+
+import Text.Peggy.Syntax
+
+normalize :: Syntax -> Syntax
+normalize = map desugarDef . addSkip
+
+addSkip :: Syntax -> Syntax
+addSkip defs
+  | hasSkip = defs
+  | otherwise = defaultSkipImpl : defs
+  where
+    hasSkip = not $ null [ () | Definition nont _ _ <- defs , nont == "skip" ]
+    
+    defaultSkipImpl =
+      Definition "skip" "()" $ Primitive "space"
+
+desugarDef :: Definition -> Definition
+desugarDef (Definition nont typ expr) =
+  Definition nont typ (desugar expr)
+  where
+    desugar e = case e of
+      Terminals {}-> e
+      TerminalSet {} -> e
+      TerminalCmp {} -> e
+      TerminalAny {} -> e
+      NonTerminal {} -> e
+      Primitive {} -> e
+      Empty -> e
+      
+      Named name f -> Named name $ desugar f
+      
+      Sequence es -> Sequence $ map desugar es
+      Choice es -> Choice $ map desugar es
+      Many f -> Many $ desugar f
+      Some f -> Some $ desugar f
+      Optional f -> Optional $ desugar f
+      And f -> And $ desugar f
+      Not f -> Not $ desugar f
+      
+      Semantic f cf -> Semantic (desugar f) cf
+      
+      SepBy f g ->
+        desugar (Choice [SepBy1 f g, Semantic Empty [Snippet "[]"]])
+        
+      SepBy1 f g ->
+        let f' = desugar f in
+        let g' = desugar g in
+        let g'' = Semantic g' [Snippet "()"] in
+        Semantic (Sequence [f', (Many (Semantic (Sequence [g'', f']) [Argument 2]))])
+        [ Argument 1
+        , Snippet ":"
+        , Argument 2
+        ]
+      
+      Token f ->
+        Token $ desugar f
diff --git a/Text/Peggy/Parser.hs b/Text/Peggy/Parser.hs
new file mode 100644
--- /dev/null
+++ b/Text/Peggy/Parser.hs
@@ -0,0 +1,154 @@
+module Text.Peggy.Parser (
+  syntax,
+  ) where
+
+import Control.Applicative
+import Data.Char
+import Numeric
+import Text.Parsec hiding ((<|>), many)
+import Text.Parsec.String
+
+import Text.Peggy.Syntax
+
+syntax :: Parser Syntax
+syntax = many definition <* skips <* eof
+
+definition :: Parser Definition
+definition =
+  try (Definition <$> identifier <* symbol ":::" <*> haskellType <* symbol "=" <*> (Token <$> expr)) <|>
+  (Definition <$> identifier <* symbol "::" <*> haskellType <* symbol "=" <*> expr)
+  <?> "definition"
+
+expr :: Parser Expr
+expr = choiceExpr
+  
+choiceExpr :: Parser Expr
+choiceExpr = sepBy1 semanticExpr (symbol "/")  >>= \es -> case es of
+  [e] -> pure e
+  _ -> pure $ Choice es
+  <?> "choice expr"
+
+semanticExpr :: Parser Expr
+semanticExpr = sequenceExpr >>= \e ->
+  option e $
+    Semantic e <$> (symbol "{" *> codeFragment <* symbol "}")
+
+sequenceExpr :: Parser Expr
+sequenceExpr = some (try (namedExpr <* notFollowedBy (symbol "::" <|> symbol "="))) >>= \es -> case es of
+  [e] -> pure e
+  _ -> pure $ Sequence es
+
+namedExpr :: Parser Expr
+namedExpr =
+  try (Named <$> identifier <* symbol ":" <*> suffixExpr) <|>
+  suffixExpr
+
+suffixExpr :: Parser Expr
+suffixExpr = prefixExpr >>= go where
+  go e = option e (symbol "*" *> go (Many e) <|>
+                   symbol "+" *> go (Some e) <|>
+                   symbol "?" *> go (Optional e))
+
+prefixExpr :: Parser Expr
+prefixExpr =
+  (And <$ symbol "?" <*> primExpr) <|>
+  (Not <$ symbol "!" <*> primExpr) <|>
+  primExpr
+
+primExpr :: Parser Expr
+primExpr =
+  terminals <|>
+  (TerminalCmp <$> set "[^") <|>
+  (TerminalSet <$> set "[") <|>
+  (TerminalAny <$ symbol ".") <|>
+  (NonTerminal <$> identifier) <|>
+  try (SepBy  <$ symbol "(" <*> expr <* symbol "," <*> expr <* symbol ")") <|>
+  try (SepBy1 <$ symbol "(" <*> expr <* symbol ";" <*> expr <* symbol ")") <|>
+  symbol "(" *> expr <* symbol ")"
+  <?> "primitive expression"
+
+terminals :: Parser Expr
+terminals = lexeme (do
+  b <- oneOf "\"\'"
+  s <- many charLit
+  e <- oneOf "\"\'"
+  return $ Terminals (b=='\"') (e=='\"') s)
+  <?> "terminals"
+
+charLit :: Parser Char
+charLit = escaped <|> noneOf "\"\'" where
+  escaped = char '\\' >> escChar
+
+escChar :: Parser Char
+escChar =
+  ('\n' <$ char 'n' ) <|>
+  ('\r' <$ char 'r' ) <|>
+  ('\t' <$ char 't' ) <|>
+  ('\\' <$ char '\\') <|>
+  ('\"' <$ char '\"') <|>
+  ('\'' <$ char '\'') <|>
+  (chr . fst . head . readHex <$ char 'x' <*> count 2 hexDigit)
+
+set :: String -> Parser [CharRange]
+set st = lexeme $ string st *> many range <* char ']'
+
+range :: Parser CharRange
+range =
+  try (CharRange <$> rchar <* char '-' <*> rchar) <|>
+  (CharOne <$> rchar)
+  where
+    rchar = escaped <|> noneOf "]"
+    escaped =
+      char '\\' >>
+      (escChar <|> 
+       (']' <$ char ']') <|>
+       ('^' <$ char '^') <|>
+       ('-' <$ char '-'))
+
+haskellType :: Parser HaskellType
+haskellType = some (noneOf "=")
+  <?> "type signature"
+
+codeFragment :: Parser CodeFragment
+codeFragment = many codePart
+  <?> "code fragment"
+
+codePart :: Parser CodePart
+codePart =
+  try argument <|>
+  Snippet <$> some (try (notFollowedBy argument >> noneOf "}"))
+
+argument :: Parser CodePart
+argument = try $ Argument <$ char '$' <*> number where
+  number = read <$> some digit
+
+--
+
+identifier :: Parser String
+identifier =
+  lexeme ((:) <$> startChar <*> many subsequentChar)
+  <?> "identifier"  
+  where
+    startChar = char '_' <|> letter
+    subsequentChar = startChar <|> digit
+
+symbol :: String -> Parser String
+symbol s = lexeme (string s)
+  <?> "symbol: " ++ s
+
+lexeme :: Parser a -> Parser a
+lexeme p = try $ skips *> p
+
+skips :: Parser ()
+skips = () <$ many ((() <$ space) <|> comment)
+
+comment :: Parser ()
+comment = lineComment <|> regionComment
+  <?> "comment"
+
+lineComment :: Parser ()
+lineComment = () <$ try (string "--") <* manyTill anyChar (char '\n')
+
+regionComment :: Parser ()
+regionComment = () <$ try (string "{-") <* com <* string "-}" where
+  com = () <$ many (regionComment <|> (notFollowedBy (string "-}") <* anyChar))
diff --git a/Text/Peggy/Prim.hs b/Text/Peggy/Prim.hs
new file mode 100644
--- /dev/null
+++ b/Text/Peggy/Prim.hs
@@ -0,0 +1,177 @@
+{-# Language GeneralizedNewtypeDeriving #-}
+{-# Language MultiParamTypeClasses #-}
+
+module Text.Peggy.Prim (
+  Parser(..),
+  ParseError(..),
+  Result(..),
+  Derivs(..),
+  runParser,
+  
+  getPos,
+  parseError,
+  backtrack,
+  annot,
+  
+  anyChar,
+  satisfy,
+  char,
+  string,
+  empty,
+  (<|>),
+  many,
+  some,
+  optional,
+  expect,
+  unexpect,
+  
+  space,
+  ) where
+
+import Control.Applicative
+import Control.Monad.State
+import Control.Monad.Error
+import Data.Char
+
+import Text.Peggy.SrcLoc
+
+newtype Parser d a
+  = Parser
+    { -- annotation :: String
+      unParser :: d -> Result d a
+    }
+
+data ParseError = ParseError SrcLoc String
+  deriving (Show)
+
+nullError :: ParseError
+nullError = ParseError (LocPos (SrcPos "" 0 1 1)) ""
+
+data Result d a
+  = Parsed d a
+  | Failed ParseError
+
+instance Show a => Show (Result d a) where
+  show (Parsed _ a) = "Parsed " ++ show a
+  show (Failed err) = "Failed (" ++ show err ++ ")"
+
+class Derivs d where
+  dvPos  :: d -> SrcPos
+  dvChar :: d -> Result d Char
+  parse  :: SrcPos -> String -> d
+
+runParser :: Derivs d => Parser d a -> String -> String -> Result d a
+runParser p sourceName source =
+  unParser p $ parse (SrcPos sourceName 0 1 1) source
+
+instance Functor (Parser d) where
+  fmap f (Parser p) = Parser $ \d ->
+    case p d of
+      Parsed e a ->
+        Parsed e (f a)
+      Failed err ->
+        Failed err
+
+instance Applicative (Parser d) where
+  pure a = Parser $ \d -> Parsed d a
+  
+  Parser p <*> Parser q = Parser $ \d ->
+    case p d of
+      Parsed e g ->
+        case q e of
+          Parsed f a ->
+            Parsed f (g a)
+          Failed err ->
+            Failed err
+      Failed err ->
+        Failed err
+
+instance Monad (Parser d) where
+  return = pure
+  
+  Parser p >>= f = Parser $ \d -> 
+    case p d of
+      Parsed e a ->
+        unParser (f a) e
+      Failed err ->
+        Failed err
+
+instance Derivs d => Alternative (Parser d) where
+  empty =
+    Parser $ \d -> Failed (ParseError (LocPos $ dvPos d) "")
+  Parser p <|> Parser q =
+    Parser $ \d -> 
+    case p d of
+      Parsed e a ->
+        Parsed e a
+      Failed _ ->
+        q d
+
+instance MonadError ParseError (Parser d) where
+  throwError e = Parser $ \_ ->
+    Failed e
+  catchError (Parser p) h = Parser $ \d ->
+    case p d of
+      Parsed e a ->
+        Parsed e a
+      Failed err ->
+        unParser (h err) d
+
+--
+
+backtrack :: Derivs d => Parser d a -> Parser d a
+backtrack (Parser p) = Parser $ \d ->
+  case p d of
+    Parsed _ r ->
+      Parsed d r
+    Failed e ->
+      Failed e
+
+annot :: Derivs d => String -> Parser d a -> Parser d a
+annot ann p = p -- Parser ann (unParser p)
+
+getPos :: Derivs d => Parser d SrcPos
+getPos = Parser $ \d ->
+  Parsed d (dvPos d)
+
+parseError :: Derivs d => String -> Parser d a
+parseError msg = do
+  pos <- getPos
+  throwError $ ParseError (LocPos pos) msg
+
+-----
+
+anyChar :: Derivs d => Parser d Char
+anyChar = Parser dvChar
+
+satisfy :: Derivs d => (Char -> Bool) -> Parser d Char
+satisfy p = do
+  c <- anyChar
+  when (not $ p c) $
+    throwError nullError
+  return c
+
+char :: Derivs d => Char -> Parser d Char
+char c = annot (show c) $
+  satisfy (== c)
+  `catchError` 
+  (const $ parseError $ "expect " ++ show c)
+
+string :: Derivs d => String -> Parser d String
+string str = annot (show str) $
+  mapM char str
+  `catchError`
+  (const $ parseError $ "expect " ++ show str)
+
+expect :: Derivs d => Parser d a -> Parser d ()
+expect p = backtrack $ () <$ p
+
+unexpect :: Derivs d => Parser d a -> Parser d ()
+unexpect p = backtrack $ do
+  b <- catchError (True <$ p) (\_ -> pure False)
+  when b $ parseError $ "unexpect " -- ++ annotation p
+
+-----
+
+space :: Derivs d => Parser d ()
+space = () <$ satisfy isSpace
diff --git a/Text/Peggy/PrimST.hs b/Text/Peggy/PrimST.hs
new file mode 100644
--- /dev/null
+++ b/Text/Peggy/PrimST.hs
@@ -0,0 +1,154 @@
+{-# Language MultiParamTypeClasses #-}
+{-# Language FlexibleContexts #-}
+{-# Language RankNTypes #-}
+
+module Text.Peggy.PrimST (
+  Parser(..),
+  Result(..),
+  ParseError(..),
+  MemoTable(..),
+  
+  memo,
+  parse,
+  
+  anyChar,
+  satisfy,
+  char,
+  string,
+  
+  expect,
+  unexpect,
+  
+  space,
+  ) where
+
+import Control.Applicative
+import Control.Monad.ST
+import Control.Monad.Error
+import Data.Char
+import Data.HashTable.ST.Basic as HT
+import qualified Data.ListLike as LL
+
+import Text.Peggy.SrcLoc
+
+newtype Parser tbl str s a
+  = Parser { unParser :: tbl s -> SrcPos -> str -> ST s (Result str a) }
+
+data Result str a
+  = Parsed SrcPos str a
+  | Failed ParseError
+
+data ParseError
+  = ParseError SrcLoc String
+  deriving (Show)
+
+instance Error ParseError
+
+nullError :: ParseError
+nullError = ParseError (LocPos $ SrcPos "" 0 1 1) ""
+
+class MemoTable tbl where
+  newTable :: ST s (tbl s)
+
+instance Monad (Parser tbl str s) where
+  return v = Parser $ \_ pos s -> return $ Parsed pos s v
+  p >>= f = Parser $ \tbl pos s -> do
+    res <- unParser p tbl pos s
+    case res of
+      Parsed qos t x ->
+        unParser (f x) tbl qos t
+      Failed err ->
+        return $ Failed err
+
+instance Functor (Parser tbl str s) where
+  fmap f p = return . f =<< p
+
+instance Applicative (Parser tbl str s) where
+  pure = return
+  p <*> q = do
+    f <- p
+    x <- q
+    return $ f x
+
+instance MonadError ParseError (Parser tbl str s) where
+  throwError err = Parser $ \_ _ _ -> return $ Failed err
+  catchError p h = Parser $ \tbl pos s -> do
+    res <- unParser p tbl pos s
+    case res of
+      Parsed {} -> return res
+      Failed err -> unParser (h err) tbl pos s
+
+instance Alternative (Parser tbl str s) where
+  empty = throwError nullError
+  p <|> q = catchError p (const q)
+
+memo :: (tbl s -> HT.HashTable s Int (Result str a))
+        -> Parser tbl str s a 
+        -> Parser tbl str s a
+memo ft p = Parser $ \tbl pos@(SrcPos _ n _ _) s -> do
+  cache <- HT.lookup (ft tbl) n
+  case cache of
+    Just v -> return v
+    Nothing -> do
+      v <- unParser p tbl pos s
+      HT.insert (ft tbl) n v
+      return v
+
+parse :: MemoTable tbl
+         => (forall s . Parser tbl str s a)
+         -> str
+         -> Either ParseError a
+parse p str = runST $ do
+  tbl <- newTable
+  res <- unParser p tbl (SrcPos "<input>" 0 1 1) str
+  case res of
+    Parsed _ _ ret -> return $ Right ret
+    Failed err -> return $ Left err
+
+getPos :: Parser tbl str s SrcPos
+getPos = Parser $ \_ pos str -> return $ Parsed pos str pos
+
+parseError :: String -> Parser tbl str s a
+parseError msg =
+  throwError =<< ParseError . LocPos <$> getPos <*> pure msg
+
+anyChar :: LL.ListLike str Char => Parser tbl str s Char
+anyChar = Parser $ \_ pos str ->
+  if LL.null str
+  then return $ Failed nullError
+  else do
+    let c  = LL.head str
+        cs = LL.tail str
+    return $ Parsed (pos `advance` c) cs c
+
+satisfy :: LL.ListLike str Char => (Char -> Bool) -> Parser tbl str s Char
+satisfy p = do
+  c <- anyChar
+  when (not $ p c) $ parseError "unexpected input"
+  return c
+
+char :: LL.ListLike str Char => Char -> Parser tbl str s Char
+char c = satisfy (==c) <|> parseError ("expect " ++ show c)
+
+string :: LL.ListLike str Char => String -> Parser tbl str s String
+string str = mapM char str <|> parseError ("expect " ++ show str)
+
+expect :: LL.ListLike str Char => Parser tbl str s a -> Parser tbl str s ()
+expect p = do
+  b <- test p
+  when (not b) $ parseError "unexpected input"
+
+unexpect :: LL.ListLike str Char => Parser tbl str s a -> Parser tbl str s ()
+unexpect p = do
+  b <- test p
+  when b $ parseError "unexpected input"
+
+test :: LL.ListLike str Char => Parser tbl str s a -> Parser tbl str s Bool
+test p = Parser $ \tbl pos str -> do
+  res <- unParser p tbl pos str
+  return $ case res of
+    Parsed _ _ _ -> Parsed pos str True
+    Failed _ -> Parsed pos str False
+
+space :: LL.ListLike str Char => Parser tbl str s ()
+space = () <$ satisfy isSpace
diff --git a/Text/Peggy/Quote.hs b/Text/Peggy/Quote.hs
new file mode 100644
--- /dev/null
+++ b/Text/Peggy/Quote.hs
@@ -0,0 +1,27 @@
+module Text.Peggy.Quote (
+  peggy,
+  peggy_f,
+  ) where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Quote
+import Text.Parsec
+import Text.Parsec.Pos
+
+import Text.Peggy.Parser
+import Text.Peggy.CodeGen.TH
+
+peggy :: QuasiQuoter
+peggy = QuasiQuoter { quoteDec = quote, quoteExp = undefined, quotePat = undefined, quoteType = undefined }
+
+peggy_f :: QuasiQuoter
+peggy_f = quoteFile peggy
+
+quote :: String -> Q [Dec]
+quote txt = do
+  loc <- location
+  case parse (setPosition (initPos loc) >> syntax) (loc_filename loc) txt of
+    Left err -> error $ "peggy syntax-error: " ++ show err
+    Right defs -> genCode defs
+  where
+    initPos loc = newPos (loc_filename loc) (fst $ loc_start loc) (snd $ loc_start loc)
diff --git a/Text/Peggy/SrcLoc.hs b/Text/Peggy/SrcLoc.hs
new file mode 100644
--- /dev/null
+++ b/Text/Peggy/SrcLoc.hs
@@ -0,0 +1,30 @@
+module Text.Peggy.SrcLoc (
+  SrcLoc(..),
+  SrcPos(..),
+  
+  advance,
+  ) where
+
+data SrcLoc
+  = LocPos  !SrcPos
+  | LocSpan !SrcPos !SrcPos
+  deriving (Show)
+
+data SrcPos =
+  SrcPos
+  { locFile :: !FilePath
+  , locAbs  :: {-# UNPACK #-} !Int
+  , locLine :: {-# UNPACK #-} !Int
+  , locCol  :: {-# UNPACK #-} !Int
+  }
+  deriving (Show)
+
+tabWidth :: Int
+tabWidth = 8
+
+advance :: SrcPos -> Char -> SrcPos
+advance (SrcPos f a l c) x =
+  case x of
+    '\t' -> SrcPos f (a + 1) l ((c - 1 + tabWidth - 1) `div` tabWidth * tabWidth + 1)
+    '\n' -> SrcPos f (a + 1) (l + 1) 1
+    _    -> SrcPos f (a + 1) l (c + 1)
diff --git a/Text/Peggy/Syntax.hs b/Text/Peggy/Syntax.hs
new file mode 100644
--- /dev/null
+++ b/Text/Peggy/Syntax.hs
@@ -0,0 +1,57 @@
+module Text.Peggy.Syntax (
+  Syntax,
+  Definition(..),
+  Expr(..),
+  CharRange(..),
+  CodeFragment,
+  CodePart(..),
+  Identifier,
+  HaskellType,
+  ) where
+
+type Syntax = [Definition]
+
+data Definition
+  = Definition Identifier HaskellType Expr
+  deriving (Show)
+
+data Expr
+  = Terminals Bool Bool String
+  | TerminalSet [CharRange]
+  | TerminalCmp [CharRange]
+  | TerminalAny
+  | NonTerminal Identifier
+  | Primitive Identifier
+  | Empty
+    
+  | Named Identifier Expr
+  
+  | Sequence [Expr]
+  | Choice   [Expr]
+  | Many     Expr
+  | Some     Expr
+  | Optional Expr
+  | And      Expr
+  | Not      Expr
+    
+  | SepBy  Expr Expr
+  | SepBy1 Expr Expr
+  | Token  Expr
+    
+  | Semantic Expr CodeFragment
+  deriving (Show)
+
+data CharRange
+  = CharRange Char Char
+  | CharOne Char
+  deriving (Show)
+
+type CodeFragment = [CodePart]
+
+data CodePart
+  = Snippet String
+  | Argument Int
+  deriving (Show)
+
+type Identifier = String
+type HaskellType = String
diff --git a/peggy.cabal b/peggy.cabal
new file mode 100644
--- /dev/null
+++ b/peggy.cabal
@@ -0,0 +1,57 @@
+Name:                peggy
+Version:             0.1.0
+Synopsis:            The Parser Generator for Haskell
+
+Description:         The Parser Generator for Haskell
+
+Homepage:            http://github.com/tanakh/peggy
+License:             BSD3
+License-file:        LICENSE
+Author:              Hideyuki Tanaka
+Maintainer:          Hideyuki Tanaka <tanaka.hideyuki@gmail.com>
+Copyright:           Copyright (c)2011, Hideyuki Tanaka
+Category:            Language
+Build-type:          Simple
+
+Extra-source-files:  README.md
+
+Cabal-version:       >=1.8
+
+Library
+  Exposed-modules:     Text.Peggy
+                     , Text.Peggy.CodeGen.TH
+                     , Text.Peggy.LeftRec
+                     , Text.Peggy.Normalize
+                     , Text.Peggy.Parser
+                     , Text.Peggy.Prim
+                     , Text.Peggy.PrimST
+                     , Text.Peggy.Quote
+                     , Text.Peggy.SrcLoc
+                     , Text.Peggy.Syntax
+  
+  Build-depends:       base >= 4 && < 5
+                     , mtl >= 2.0 && < 2.1
+                     , ListLike >= 3.1 && < 3.2
+                     , hashtables >= 1.0 && < 1.1
+                     , monad-control >= 0.2 && < 0.3
+                     , parsec >= 3.1 && < 3.2
+                     , template-haskell >= 2.5 && < 2.7
+                     , haskell-src-meta >= 0.5 && < 0.6
+  
+  -- Other-modules:       
+  
+Executable peggy
+  Main-is:             Main.hs
+
+  Build-depends:       base >= 4 && < 5
+                     , mtl >= 2.0 && < 2.1
+                     , ListLike >= 3.1 && < 3.2
+                     , hashtables >= 1.0 && < 1.1
+                     , monad-control >= 0.2 && < 0.3
+                     , parsec >= 3.1 && < 3.2
+                     , template-haskell >= 2.5 && < 2.7
+                     , haskell-src-meta >= 0.5 && < 0.6
+
+Source-repository head
+  Type:              git
+  Location:          git://github.com/tanakh/Peggy.git