peggy 0.2.0 → 0.2.0.1
raw patch · 15 files changed
+377/−267 lines, 15 files
Files
- Text/Peggy/Parser.hs +57/−57
- Text/Peggy/Prim.hs +58/−31
- Text/Peggy/Quote.hs +80/−1
- Text/Peggy/Syntax.hs +3/−3
- bootstrap/Bootstrap.hs +39/−0
- bootstrap/README.md +10/−0
- bootstrap/Stage1.hs +10/−0
- bootstrap/Stage2.hs +13/−0
- bootstrap/peggy.peggy +95/−0
- bootstrup/Bootstrup.hs +0/−39
- bootstrup/README.md +0/−10
- bootstrup/Stage1.hs +0/−10
- bootstrup/Stage2.hs +0/−13
- bootstrup/peggy.peggy +0/−95
- peggy.cabal +12/−8
Text/Peggy/Parser.hs view
@@ -10,7 +10,7 @@ import Text.Peggy.Syntax data MemoTable_0 str_1 s_2- = MemoTable_0 {tbl_syntax :: (HashTable s_2+ = MemoTable_3 {tbl_syntax :: (HashTable s_2 Int (Result str_1 Syntax)), tbl_definition :: (HashTable s_2 Int (Result str_1 Definition)),@@ -28,7 +28,7 @@ tbl_escChar :: (HashTable s_2 Int (Result str_1 Char)), tbl_range :: (HashTable s_2 Int (Result str_1 CharRange)), tbl_rchar :: (HashTable s_2 Int (Result str_1 Char)),- tbl_haskellType :: (HashTable s_2 Int (Result str_1 HaskellType)),+ tbl_haskellType :: (HashTable s_2 Int (Result str_1 TermType)), tbl_codeFragment :: (HashTable s_2 Int (Result str_1 CodeFragment)),@@ -41,9 +41,8 @@ tbl_comment :: (HashTable s_2 Int (Result str_1 ())), tbl_lineComment :: (HashTable s_2 Int (Result str_1 ())), tbl_regionComment :: (HashTable s_2 Int (Result str_1 ()))}-instance MemoTable (MemoTable_0 str_3)- where newTable = do t_4 <- new- t_5 <- new+instance MemoTable (MemoTable_0 str_4)+ where newTable = do t_5 <- new t_6 <- new t_7 <- new t_8 <- new@@ -67,16 +66,17 @@ t_26 <- new t_27 <- new t_28 <- new- return (MemoTable_0 t_4 t_5 t_6 t_7 t_8 t_9 t_10 t_11 t_12 t_13 t_14 t_15 t_16 t_17 t_18 t_19 t_20 t_21 t_22 t_23 t_24 t_25 t_26 t_27 t_28)-syntax :: forall str_29 s_30 . ListLike str_29 Char =>- Parser (MemoTable_0 str_29) str_29 s_30 Syntax+ t_29 <- new+ return (MemoTable_3 t_5 t_6 t_7 t_8 t_9 t_10 t_11 t_12 t_13 t_14 t_15 t_16 t_17 t_18 t_19 t_20 t_21 t_22 t_23 t_24 t_25 t_26 t_27 t_28 t_29)+syntax :: forall str_30 s_31 . ListLike str_30 Char =>+ Parser (MemoTable_0 str_30) str_30 s_31 Syntax syntax = memo tbl_syntax $ (do v1 <- many definition unexpect (do v1 <- many skip v2 <- anyChar return $ (v1, v2)) return $ (v1))-definition :: forall str_31 s_32 . ListLike str_31 Char =>- Parser (MemoTable_0 str_31) str_31 s_32 Definition+definition :: forall str_32 s_33 . ListLike str_32 Char =>+ Parser (MemoTable_0 str_32) str_32 s_33 Definition definition = memo tbl_definition $ ((many skip *> ((do v1 <- ident (many skip *> string ":::") <* many skip v2 <- haskellType@@ -88,12 +88,12 @@ (many skip *> string "=") <* many skip v3 <- expr return (Definition v1 v2 v3)))) <* many skip)-expr :: forall str_33 s_34 . ListLike str_33 Char =>- Parser (MemoTable_0 str_33) str_33 s_34 Expr+expr :: forall str_34 s_35 . ListLike str_34 Char =>+ Parser (MemoTable_0 str_34) str_34 s_35 Expr expr = memo tbl_expr $ (do v1 <- choiceExpr return $ (v1))-choiceExpr :: forall str_35 s_36 . ListLike str_35 Char =>- Parser (MemoTable_0 str_35) str_35 s_36 Expr+choiceExpr :: forall str_36 s_37 . ListLike str_36 Char =>+ Parser (MemoTable_0 str_36) str_36 s_37 Expr choiceExpr = memo tbl_choiceExpr $ (do v1 <- (do v1 <- do v1 <- semanticExpr return $ (v1) v2 <- many (do v1 <- do v1 <- do (many skip *> string "/") <* many skip@@ -105,29 +105,29 @@ return (v1 : v2)) <|> (do v1 <- return () return []) return (Choice v1))-semanticExpr :: forall str_37 s_38 . ListLike str_37 Char =>- Parser (MemoTable_0 str_37) str_37 s_38 Expr+semanticExpr :: forall str_38 s_39 . ListLike str_38 Char =>+ Parser (MemoTable_0 str_38) str_38 s_39 Expr semanticExpr = memo tbl_semanticExpr $ ((do v1 <- sequenceExpr (many skip *> string "{") <* many skip v2 <- codeFragment (many skip *> string "}") <* many skip return (Semantic v1 v2)) <|> (do v1 <- sequenceExpr return $ (v1)))-sequenceExpr :: forall str_39 s_40 . ListLike str_39 Char =>- Parser (MemoTable_0 str_39) str_39 s_40 Expr+sequenceExpr :: forall str_40 s_41 . ListLike str_40 Char =>+ Parser (MemoTable_0 str_40) str_40 s_41 Expr sequenceExpr = memo tbl_sequenceExpr $ (do v1 <- some (do v1 <- suffixExpr unexpect ((many skip *> string "::") <* many skip) unexpect ((many skip *> string "=") <* many skip) return $ (v1)) return (Sequence v1))-suffixExpr :: forall str_41 s_42 . ListLike str_41 Char =>- Parser (MemoTable_0 str_41) str_41 s_42 Expr+suffixExpr :: forall str_42 s_43 . ListLike str_42 Char =>+ Parser (MemoTable_0 str_42) str_42 s_43 Expr suffixExpr = memo tbl_suffixExpr $ (do v1 <- do v1 <- prefixExpr return $ (v1) v2 <- suffixExpr_tail return (v2 v1))-suffixExpr_tail :: forall str_43 s_44 . ListLike str_43 Char =>- Parser (MemoTable_0 str_43) str_43 s_44 (Expr -> Expr)+suffixExpr_tail :: forall str_44 s_45 . ListLike str_44 Char =>+ Parser (MemoTable_0 str_44) str_44 s_45 (Expr -> Expr) suffixExpr_tail = memo tbl_suffixExpr_tail $ ((((do (many skip *> string "*") <* many skip v1 <- suffixExpr_tail return (\v999 -> v1 (Many v999))) <|> (do (many skip *> string "+") <* many skip@@ -136,16 +136,16 @@ v1 <- suffixExpr_tail return (\v999 -> v1 (Optional v999)))) <|> (do v1 <- return () return id))-prefixExpr :: forall str_45 s_46 . ListLike str_45 Char =>- Parser (MemoTable_0 str_45) str_45 s_46 Expr+prefixExpr :: forall str_46 s_47 . ListLike str_46 Char =>+ Parser (MemoTable_0 str_46) str_46 s_47 Expr prefixExpr = memo tbl_prefixExpr $ (((do (many skip *> string "&") <* many skip v1 <- primExpr return (And v1)) <|> (do (many skip *> string "!") <* many skip v1 <- primExpr return (Not v1))) <|> (do v1 <- primExpr return $ (v1)))-primExpr :: forall str_47 s_48 . ListLike str_47 Char =>- Parser (MemoTable_0 str_47) str_47 s_48 Expr+primExpr :: forall str_48 s_49 . ListLike str_48 Char =>+ Parser (MemoTable_0 str_48) str_48 s_49 Expr primExpr = memo tbl_primExpr $ ((many skip *> (((((((((do string "\"" v1 <- many charLit string "\""@@ -174,15 +174,15 @@ v1 <- expr (many skip *> string ")") <* many skip return $ (v1)))) <* many skip)-charLit :: forall str_49 s_50 . ListLike str_49 Char =>- Parser (MemoTable_0 str_49) str_49 s_50 Char+charLit :: forall str_50 s_51 . ListLike str_50 Char =>+ Parser (MemoTable_0 str_50) str_50 s_51 Char charLit = memo tbl_charLit $ ((do string "\\" v1 <- escChar return $ (v1)) <|> (do unexpect (satisfy (\c -> (c == '\'') || (c == '"'))) v1 <- anyChar return $ (v1)))-escChar :: forall str_51 s_52 . ListLike str_51 Char =>- Parser (MemoTable_0 str_51) str_51 s_52 Char+escChar :: forall str_52 s_53 . ListLike str_52 Char =>+ Parser (MemoTable_0 str_52) str_52 s_53 Char escChar = memo tbl_escChar $ (((((((do string "n" return '\n') <|> (do string "r" return '\r')) <|> (do string "t"@@ -194,15 +194,15 @@ v2 <- hexDigit return ((chr . (fst . (head . readHex))) $ [v1, v2])))-range :: forall str_53 s_54 . ListLike str_53 Char =>- Parser (MemoTable_0 str_53) str_53 s_54 CharRange+range :: forall str_54 s_55 . ListLike str_54 Char =>+ Parser (MemoTable_0 str_54) str_54 s_55 CharRange range = memo tbl_range $ ((do v1 <- rchar string "-" v2 <- rchar return (CharRange v1 v2)) <|> (do v1 <- rchar return (CharOne v1)))-rchar :: forall str_55 s_56 . ListLike str_55 Char =>- Parser (MemoTable_0 str_55) str_55 s_56 Char+rchar :: forall str_56 s_57 . ListLike str_56 Char =>+ Parser (MemoTable_0 str_56) str_56 s_57 Char rchar = memo tbl_rchar $ ((((((do string "\\" v1 <- escChar return $ (v1)) <|> (do string "\\]"@@ -211,60 +211,60 @@ return '^')) <|> (do string "\\-" return '-')) <|> (do v1 <- satisfy $ (not . (\c -> c == ']')) return $ (v1)))-haskellType :: forall str_57 s_58 . ListLike str_57 Char =>- Parser (MemoTable_0 str_57) str_57 s_58 HaskellType+haskellType :: forall str_58 s_59 . ListLike str_58 Char =>+ Parser (MemoTable_0 str_58) str_58 s_59 TermType haskellType = memo tbl_haskellType $ (do v1 <- some (satisfy $ (not . (\c -> c == '='))) return $ (v1))-codeFragment :: forall str_59 s_60 . ListLike str_59 Char =>- Parser (MemoTable_0 str_59) str_59 s_60 CodeFragment+codeFragment :: forall str_60 s_61 . ListLike str_60 Char =>+ Parser (MemoTable_0 str_60) str_60 s_61 CodeFragment codeFragment = memo tbl_codeFragment $ (do v1 <- many codePart return $ (v1))-codePart :: forall str_61 s_62 . ListLike str_61 Char =>- Parser (MemoTable_0 str_61) str_61 s_62 CodePart+codePart :: forall str_62 s_63 . ListLike str_62 Char =>+ Parser (MemoTable_0 str_62) str_62 s_63 CodePart codePart = memo tbl_codePart $ ((do v1 <- argument return $ (v1)) <|> (do v1 <- some (do unexpect (string "}") unexpect argument v1 <- anyChar return $ (v1)) return (Snippet v1)))-argument :: forall str_63 s_64 . ListLike str_63 Char =>- Parser (MemoTable_0 str_63) str_63 s_64 CodePart+argument :: forall str_64 s_65 . ListLike str_64 Char =>+ Parser (MemoTable_0 str_64) str_64 s_65 CodePart argument = memo tbl_argument $ (do string "$" v1 <- some digit return (Argument $ read v1))-digit :: forall str_65 s_66 . ListLike str_65 Char =>- Parser (MemoTable_0 str_65) str_65 s_66 Char+digit :: forall str_66 s_67 . ListLike str_66 Char =>+ Parser (MemoTable_0 str_66) str_66 s_67 Char digit = memo tbl_digit $ (do v1 <- satisfy (\c -> ('0' <= c) && (c <= '9')) return $ (v1))-hexDigit :: forall str_67 s_68 . ListLike str_67 Char =>- Parser (MemoTable_0 str_67) str_67 s_68 Char+hexDigit :: forall str_68 s_69 . ListLike str_68 Char =>+ Parser (MemoTable_0 str_68) str_68 s_69 Char hexDigit = memo tbl_hexDigit $ (do v1 <- satisfy (\c -> ((('0' <= c) && (c <= '9')) || (('a' <= c) && (c <= 'f'))) || (('A' <= c) && (c <= 'F'))) return $ (v1))-ident :: forall str_69 s_70 . ListLike str_69 Char =>- Parser (MemoTable_0 str_69) str_69 s_70 String-ident = memo tbl_ident $ ((many skip *> (do v1 <- satisfy (\c -> ((('a' <= c) && (c <= 'z')) || (('A' <= c) && (c <= 'Z'))) || (c == '_'))+ident :: forall str_70 s_71 . ListLike str_70 Char =>+ Parser (MemoTable_0 str_70) str_70 s_71 String+ident = memo tbl_ident $ ((many skip *> (do v1 <- satisfy (\c -> ('a' <= c) && (c <= 'z')) v2 <- many (satisfy (\c -> (((('0' <= c) && (c <= '9')) || (('a' <= c) && (c <= 'z'))) || (('A' <= c) && (c <= 'Z'))) || (c == '_'))) return (v1 : v2))) <* many skip)-skip :: forall str_71 s_72 . ListLike str_71 Char =>- Parser (MemoTable_0 str_71) str_71 s_72 ()+skip :: forall str_72 s_73 . ListLike str_72 Char =>+ Parser (MemoTable_0 str_72) str_72 s_73 () skip = memo tbl_skip $ ((do v1 <- satisfy (\c -> (((c == ' ') || (c == '\r')) || (c == '\n')) || (c == '\t')) return ()) <|> (do v1 <- comment return $ (v1)))-comment :: forall str_73 s_74 . ListLike str_73 Char =>- Parser (MemoTable_0 str_73) str_73 s_74 ()+comment :: forall str_74 s_75 . ListLike str_74 Char =>+ Parser (MemoTable_0 str_74) str_74 s_75 () comment = memo tbl_comment $ ((do v1 <- lineComment return $ (v1)) <|> (do v1 <- regionComment return $ (v1)))-lineComment :: forall str_75 s_76 . ListLike str_75 Char =>- Parser (MemoTable_0 str_75) str_75 s_76 ()+lineComment :: forall str_76 s_77 . ListLike str_76 Char =>+ Parser (MemoTable_0 str_76) str_76 s_77 () lineComment = memo tbl_lineComment $ (do string "--" v1 <- many (do unexpect (string "\n") v1 <- anyChar return $ (v1)) string "\n" return ())-regionComment :: forall str_77 s_78 . ListLike str_77 Char =>- Parser (MemoTable_0 str_77) str_77 s_78 ()+regionComment :: forall str_78 s_79 . ListLike str_78 Char =>+ Parser (MemoTable_0 str_78) str_78 s_79 () regionComment = memo tbl_regionComment $ (do string "{-" v1 <- many ((do v1 <- regionComment return $ (v1)) <|> (do unexpect (string "-}")
Text/Peggy/Prim.hs view
@@ -2,21 +2,42 @@ {-# Language FlexibleContexts #-} {-# Language RankNTypes #-} +-- |+-- Module : Text.Peggy.Prim+-- Copyright : (c) Hideyuki Tanaka 2011+-- License : BSD-style+--+-- Maintainer : tanaka.hideyuki@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- The monadic parser type and combinators to construct+-- packrat parsers for code generator.+--+ module Text.Peggy.Prim (+ -- * Parsing functions+ parse,+ parseString,+ parseFile,+ + -- * The parser type Parser(..),+ -- * The (internal) result type Result(..),+ -- * The error type ParseError(..),+ -- * The cache type MemoTable(..), - parse,- parseString,- parseFile,- + -- * Memoising combinator memo, + -- * Position functions getPos, setPos, + -- * Combinators anyChar, satisfy, char,@@ -25,6 +46,7 @@ expect, unexpect, + -- * Utiligy space, ) where @@ -37,6 +59,38 @@ import Text.Peggy.SrcLoc +-- | Parsing function+parse :: MemoTable tbl+ => (forall s . Parser tbl str s a) -- ^ parser+ -> SrcPos -- ^ input information+ -> str -- ^ input string+ -> Either ParseError a -- ^ result+parse p pos str = runST $ do+ tbl <- newTable+ res <- unParser p tbl pos str+ case res of+ Parsed _ _ ret -> return $ Right ret+ Failed err -> return $ Left err++-- | Parsing function with only input name+parseString :: MemoTable tbl+ => (forall s . Parser tbl str s a) -- ^ parser+ -> String -- ^ input name+ -> str -- ^ input string+ -> Either ParseError a -- ^ result+parseString p inputName str =+ parse p (SrcPos inputName 0 1 1) str++-- | Parse from file+parseFile :: MemoTable tbl+ => (forall s . Parser tbl String s a) -- ^ parser+ -> FilePath -- ^ input filename+ -> IO (Either ParseError a) -- ^ result+parseFile p fp =+ parse p (SrcPos fp 0 1 1) <$> readFile fp++--+ newtype Parser tbl str s a = Parser { unParser :: tbl s -> SrcPos -> str -> ST s (Result str a) } @@ -107,33 +161,6 @@ v <- unParser p tbl pos s HT.insert (ft tbl) n v return v--parse :: MemoTable tbl- => (forall s . Parser tbl str s a)- -> SrcPos- -> str- -> Either ParseError a-parse p pos str = runST $ do- tbl <- newTable- res <- unParser p tbl pos str- case res of- Parsed _ _ ret -> return $ Right ret- Failed err -> return $ Left err--parseString :: MemoTable tbl- => (forall s . Parser tbl str s a)- -> String- -> str- -> Either ParseError a-parseString p inputName str =- parse p (SrcPos inputName 0 1 1) str--parseFile :: MemoTable tbl- => (forall s . Parser tbl String s a)- -> FilePath- -> IO (Either ParseError a)-parseFile p fp =- parse p (SrcPos fp 0 1 1) <$> readFile fp getPos :: Parser tbl str s SrcPos getPos = Parser $ \_ pos str -> return $ Parsed pos str pos
Text/Peggy/Quote.hs view
@@ -1,9 +1,23 @@ {-# Language RankNTypes #-} +-- |+-- Module : Text.Peggy.Quote+-- Copyright : (c) Hideyuki Tanaka 2011+-- License : BSD-style+--+-- Maintainer : tanaka.hideyuki@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- The quasi-quoters of peggy syntax.+--+ module Text.Peggy.Quote (+ -- * Quasi Quoters peggy, peggyFile, + -- * Parser and Quasi-quoter generating function genParser, ) where @@ -16,9 +30,52 @@ import Text.Peggy.SrcLoc import Text.Peggy.CodeGen.TH +-- | quasi-quoter for peggy syntax+-- When it is used at top-level of source code,+-- definitions of parsers are generated.+--+-- > {-# LANGUAGE TemplateHaskell, QuasiQuotes, FlexibleContexts #-}+-- > import Text.Peggy+-- > +-- > [peggy|+-- > foo :: [Int]+-- > = num*+-- > num ::: Int+-- > = [0-9]+ { read $1 }+-- > |]+-- > +-- > main :: IO ()+-- > main = print . parseString foo "<stdin>" =<< getContents+--+-- When it is used as expression,+-- the result value is 'Syntax'.+--+-- > main = print [peggy|+-- > num :: Int+-- > = [0-9]+ { read $1 }+-- > |]+--+-- The result is:+--+-- > $ runhaskell Test.hs+-- > [Definition "num" "Int\n " (Choice [Semantic (Sequence [Some (TerminalSet [CharRange '0' '9'])]) [Snippet "read ",Argument 1,Snippet " "]])]+-- peggy :: QuasiQuoter peggy = QuasiQuoter { quoteDec = qDecs, quoteExp = qExp, quotePat = undefined, quoteType = undefined } +-- | Parse peggy syntax from File+-- Parse a peggy syntax file and return a 'Syntax' as a result value.+--+-- > $ cat test.peggy+-- > num :: Int+-- > = [0-9]+ { return $1 }+--+-- > main = print $(peggyFile "test.peggy")+--+-- The result is:+--+-- > [Definition "num" "Int\n " (Choice [Semantic (Sequence [Some (TerminalSet [CharRange '0' '9'])]) [Snippet "read ",Argument 1,Snippet " "]])]+-- peggyFile :: FilePath -> Q Exp peggyFile filename = do res <- runIO $ parseFile syntax filename@@ -36,7 +93,29 @@ loc <- location dataToExpQ (const Nothing) $ parseSyntax (locToPos loc) txt -genParser :: [(String, String)] -> Syntax -> Q [Dec]+-- | Generates parsers and quasi-quoters.+-- First argument is a list of names of quasi-quoter you want to define.+-- For example:+-- +-- > genParser [("fooqq", "foo")] [peggy|+-- > foo :: [Int]+-- > = num*+-- > num ::: Int+-- > = [0-9]+ { read $1 }+-- > |]+--+-- this code defines parsers named 'foo', 'num' and+-- quasi-quoter named 'fooqq'.+--+-- It can use it as follow:+--+-- > main :: IO ()+-- > main = print [fooqq| 1 2 3 4 5 |]+--+genParser :: [(String, String)] -- ^ a list of pair of name of+ -- quasi-quoter and its start nonterminal+ -> Syntax -- ^ syntax+ -> Q [Dec] -- ^ definitions of parsers and quasi-quoters genParser qqs syn = do qq <- mapM (genQQ syn) qqs dec <- genDecs syn
Text/Peggy/Syntax.hs view
@@ -8,7 +8,7 @@ CodeFragment, CodePart(..), Identifier,- HaskellType,+ TermType, ) where import Data.Data@@ -16,7 +16,7 @@ type Syntax = [Definition] data Definition- = Definition Identifier HaskellType Expr+ = Definition Identifier TermType Expr deriving (Show, Eq, Typeable, Data) data Expr@@ -58,4 +58,4 @@ deriving (Show, Eq, Typeable, Data) type Identifier = String-type HaskellType = String+type TermType = String
+ bootstrap/Bootstrap.hs view
@@ -0,0 +1,39 @@+{-# Language TemplateHaskell, QuasiQuotes, FlexibleContexts #-}++import Data.Char+import Numeric+import Language.Haskell.TH+import Language.Haskell.Meta.Utils++import qualified Stage2++import Text.Peggy.Prim+import Text.Peggy.Quote+import Text.Peggy.CodeGen.TH+import Text.Peggy.Syntax+import Text.Peggy.SrcLoc++header :: String+header =+ unlines+ [ "{-# Language RankNTypes #-}"+ , "{-# Language FlexibleContexts #-}"+ , "module Text.Peggy.Parser (syntax) where"+ , "import Control.Applicative"+ , "import Data.ListLike.Base hiding (head)"+ , "import Data.HashTable.ST.Basic"+ , "import Numeric"+ , "import Data.Char"+ , "import Text.Peggy.Prim"+ , "import Text.Peggy.Syntax"+ ]++main :: IO ()+main = do+ res <- parseFile Stage2.syntax "./peggy.peggy"+ case res of+ Left err -> error $ show err+ Right defs -> do+ code <- runQ $ genDecs defs+ putStrLn header+ putStrLn $ pp code
+ bootstrap/README.md view
@@ -0,0 +1,10 @@+# Bootstrap Instructions #++# Pre-requirement++Previous version of peggy (>= 0.1.3) required.++# Bootstrap++ $ cd bootstrap+ $ runhaskell Bootstrap.hs > ../Text/Peggy/Parser.hs
+ bootstrap/Stage1.hs view
@@ -0,0 +1,10 @@+{-# Language TemplateHaskell, QuasiQuotes, FlexibleContexts #-}++module Stage1 where++import Data.Char+import Language.Haskell.TH.Quote+import Numeric+import Text.Peggy++genParser [] $(peggyFile "peggy.peggy")
+ bootstrap/Stage2.hs view
@@ -0,0 +1,13 @@+{-# Language TemplateHaskell, QuasiQuotes, FlexibleContexts #-}++module Stage2 where++import qualified Stage1++import Data.Char+import Numeric+import Language.Haskell.TH+import Language.Haskell.TH.Quote+import Text.Peggy++genParser [] $(runIO (parseFile Stage1.syntax "peggy.peggy") >>= \res -> case res of Left err -> error $ show err; Right syn -> dataToExpQ (const Nothing) syn)
+ bootstrap/peggy.peggy view
@@ -0,0 +1,95 @@+-- A Parser for peggy itself.++syntax :: Syntax+ = definition* !(skip* .)++definition ::: Definition+ = ident ":::" haskellType "=" expr { Definition $1 $2 (Token $3) }+ / ident "::" haskellType "=" expr { Definition $1 $2 $3 }++expr :: Expr+ = choiceExpr++choiceExpr :: Expr+ = (semanticExpr, "/") { Choice $1 }++semanticExpr :: Expr+ = sequenceExpr "{" codeFragment "}" { Semantic $1 $2 }+ / sequenceExpr++sequenceExpr :: Expr+ = (suffixExpr !"::" !"=")+ { Sequence $1 }++suffixExpr :: Expr+ = suffixExpr "*" { Many $1 }+ / suffixExpr "+" { Some $1 }+ / suffixExpr "?" { Optional $1 }+ / prefixExpr++prefixExpr :: Expr+ = "&" primExpr { And $1 }+ / "!" primExpr { Not $1 }+ / primExpr++primExpr ::: Expr+ = '\"' charLit* '\"' { Terminals True True $1 }+ / '\'' charLit* '\'' { Terminals False False $1 }+ / '[^' range* ']' { TerminalCmp $1 }+ / '[' range* ']' { TerminalSet $1 }+ / "." { TerminalAny }+ / ident { NonTerminal $1 }+ / "(" expr "," expr ")" { SepBy $1 $2 }+ / "(" expr ";" expr ")" { SepBy1 $1 $2 }+ / "(" expr ")"++charLit :: Char+ = '\\' escChar+ / ![\'\"] .++escChar :: Char+ = 'n' { '\n' }+ / 'r' { '\r' }+ / 't' { '\t' }+ / '\\' { '\\' }+ / '\"' { '\"' }+ / '\'' { '\'' }+ / 'x' hexDigit hexDigit { chr . fst . head . readHex $ [$1, $2] }++range :: CharRange+ = rchar '-' rchar { CharRange $1 $2 }+ / rchar { CharOne $1 }++rchar :: Char+ = '\\' escChar+ / '\\]' {']'} / '\\[' { '[' } / '\\^' { '^' } / '\\-' { '-' }+ / [^\]]++haskellType :: TermType+ = [^=]+++codeFragment :: CodeFragment+ = codePart*++codePart :: CodePart+ = argument+ / (!'}' !argument .)+ { Snippet $1 }++argument :: CodePart+ = '$' digit+ { Argument $ read $1 }++digit :: Char = [0-9] +hexDigit :: Char = [0-9a-fA-F]++ident ::: String = [a-z] [0-9a-zA-Z_]* { $1 : $2 }++skip :: ()+ = [ \r\n\t] { () } / comment++comment :: ()+ = lineComment / regionComment++lineComment :: ()+ = '--' (!'\n' .)* '\n' { () }++regionComment :: ()+ = '{-' (regionComment / !'-}' . { () } )* '-}' { () }
− bootstrup/Bootstrup.hs
@@ -1,39 +0,0 @@-{-# Language TemplateHaskell, QuasiQuotes, FlexibleContexts #-}--import Data.Char-import Numeric-import Language.Haskell.TH-import Language.Haskell.Meta.Utils--import qualified Stage2--import Text.Peggy.Prim-import Text.Peggy.Quote-import Text.Peggy.CodeGen.TH-import Text.Peggy.Syntax-import Text.Peggy.SrcLoc--header :: String-header =- unlines- [ "{-# Language RankNTypes #-}"- , "{-# Language FlexibleContexts #-}"- , "module Text.Peggy.Parser (syntax) where"- , "import Control.Applicative"- , "import Data.ListLike.Base hiding (head)"- , "import Data.HashTable.ST.Basic"- , "import Numeric"- , "import Data.Char"- , "import Text.Peggy.Prim"- , "import Text.Peggy.Syntax"- ]--main :: IO ()-main = do- res <- parseFile Stage2.syntax "peggy.peggy"- case res of- Left err -> error $ show err- Right defs -> do- code <- runQ $ genDecs defs- putStrLn header- putStrLn $ pp code
− bootstrup/README.md
@@ -1,10 +0,0 @@-# Bootstrup Instructions #--# Pre-requirement--Previous version of peggy (>= 0.1.3) required.--# Bootstrup-- $ cd bootstrup- $ runhaskell Bootstrup.hs > ../Text/Peggy/Parser.hs
− bootstrup/Stage1.hs
@@ -1,10 +0,0 @@-{-# Language TemplateHaskell, QuasiQuotes, FlexibleContexts #-}--module Stage1 where--import Data.Char-import Language.Haskell.TH.Quote-import Numeric-import Text.Peggy--genParser [] $(peggyFile "peggy.peggy")
− bootstrup/Stage2.hs
@@ -1,13 +0,0 @@-{-# Language TemplateHaskell, QuasiQuotes, FlexibleContexts #-}--module Stage2 where--import qualified Stage1--import Data.Char-import Numeric-import Language.Haskell.TH-import Language.Haskell.TH.Quote-import Text.Peggy--genParser [] $(runIO (parseFile Stage1.syntax "peggy.peggy") >>= \res -> case res of Left err -> error $ show err; Right syn -> dataToExpQ (const Nothing) syn)
− bootstrup/peggy.peggy
@@ -1,95 +0,0 @@--- A Parser for peggy itself.--syntax :: Syntax- = definition* !(skip* .)--definition ::: Definition- = ident ":::" haskellType "=" expr { Definition $1 $2 (Token $3) }- / ident "::" haskellType "=" expr { Definition $1 $2 $3 }--expr :: Expr- = choiceExpr--choiceExpr :: Expr- = (semanticExpr, "/") { Choice $1 }--semanticExpr :: Expr- = sequenceExpr "{" codeFragment "}" { Semantic $1 $2 }- / sequenceExpr--sequenceExpr :: Expr- = (suffixExpr !"::" !"=")+ { Sequence $1 }--suffixExpr :: Expr- = suffixExpr "*" { Many $1 }- / suffixExpr "+" { Some $1 }- / suffixExpr "?" { Optional $1 }- / prefixExpr--prefixExpr :: Expr- = "&" primExpr { And $1 }- / "!" primExpr { Not $1 }- / primExpr--primExpr ::: Expr- = '\"' charLit* '\"' { Terminals True True $1 }- / '\'' charLit* '\'' { Terminals False False $1 }- / '[^' range* ']' { TerminalCmp $1 }- / '[' range* ']' { TerminalSet $1 }- / "." { TerminalAny }- / ident { NonTerminal $1 }- / "(" expr "," expr ")" { SepBy $1 $2 }- / "(" expr ";" expr ")" { SepBy1 $1 $2 }- / "(" expr ")"--charLit :: Char- = '\\' escChar- / ![\'\"] .--escChar :: Char- = 'n' { '\n' }- / 'r' { '\r' }- / 't' { '\t' }- / '\\' { '\\' }- / '\"' { '\"' }- / '\'' { '\'' }- / 'x' hexDigit hexDigit { chr . fst . head . readHex $ [$1, $2] }--range :: CharRange- = rchar '-' rchar { CharRange $1 $2 }- / rchar { CharOne $1 }--rchar :: Char- = '\\' escChar- / '\\]' {']'} / '\\[' { '[' } / '\\^' { '^' } / '\\-' { '-' }- / [^\]]--haskellType :: HaskellType- = [^=]+--codeFragment :: CodeFragment- = codePart*--codePart :: CodePart- = argument- / (!'}' !argument .)+ { Snippet $1 }--argument :: CodePart- = '$' digit+ { Argument $ read $1 }--digit :: Char = [0-9] -hexDigit :: Char = [0-9a-fA-F]--ident ::: String = [a-zA-Z_] [0-9a-zA-Z_]* { $1 : $2 }--skip :: ()- = [ \r\n\t] { () } / comment--comment :: ()- = lineComment / regionComment--lineComment :: ()- = '--' (!'\n' .)* '\n' { () }--regionComment :: ()- = '{-' (regionComment / !'-}' . { () } )* '-}' { () }
peggy.cabal view
@@ -1,10 +1,14 @@ Name: peggy-Version: 0.2.0+Version: 0.2.0.1 Synopsis: The Parser Generator for Haskell -Description: The Parser Generator for Haskell+Description: -Homepage: http://github.com/tanakh/peggy+ The Parser Generator for Haskell+ <http://tanakh.github.com/Peggy>+++Homepage: http://tanakh.github.com/Peggy License: BSD3 License-file: LICENSE Author: Hideyuki Tanaka@@ -14,11 +18,11 @@ Build-type: Simple Extra-source-files: README.md- bootstrup/README.md- bootstrup/Stage1.hs- bootstrup/Stage2.hs- bootstrup/Bootstrup.hs- bootstrup/peggy.peggy+ bootstrap/README.md+ bootstrap/Stage1.hs+ bootstrap/Stage2.hs+ bootstrap/Bootstrap.hs+ bootstrap/peggy.peggy Cabal-version: >=1.8