Ptera: A Parser Generator for PEGs

Installation

Add dependencies on package.cabal:

build-depends:
    base,
    ptera,          -- main
    ptera-th,       -- for outputing parser with Template Haskell
    template-haskell,

Usage

Write parser rules:

module Parser.Rules where

import Language.Haskell.TH
import Language.Parser.Ptera.TH

data Token
    = TokDigit
    | TokSymPlus
    | TokSymMulti
    | TokEndOfInput
    deriving (Eq, Show, Enum)

data Ast
    = Value
    | Sum Ast Ast
    | Product Ast Ast

$(genGrammarToken (mkName "Tokens") [t|Token|]
    [ ("+", [p|TokSymPlus|])
    , ("*", [p|TokSymMulti|])
    , ("n", [p|TokDigit|])
    , ("^Z", [p|TokEndOfInput{}|])
    ])

$(Ptera.genRules
    do TH.mkName "RuleDefs"
    do GenRulesTypes
        { genRulesCtxTy = [t|()|]
        , genRulesTokensTy = [t|Tokens|]
        , genRulesTokenTy = [t|Token|]
        }
    [ (TH.mkName "ruleExprEos", "expr ^Z", [t|Ast|])
    , (TH.mkName "ruleExpr", "expr", [t|Ast|])
    , (TH.mkName "ruleSum", "sum", [t|Ast|])
    , (TH.mkName "ruleProduct", "product", [t|Ast|])
    , (TH.mkName "ruleValue", "value", [t|Ast|])
    ]
    )

$(Ptera.genParsePoints
    do TH.mkName "ParsePoints"
    do TH.mkName "RuleDefs"
    [ "expr ^Z"
    ]
    )

grammar :: Grammar RuleDefs Tokens Token ParsePoints
grammar = fixGrammar $ RuleDefs
    { ruleExprEos = rExprEos
    , ruleExpr = rExpr
    , ruleSum = rSum
    , ruleProduct = rProduct
    , ruleValue = rValue
    }

type Rule = RuleExpr RuleDefs Tokens Token


rExprEos :: Rule Ast
rExprEos = ruleExpr
    [ varA @"expr" <^> tokA @"^Z"
        <:> \(e :* _ :* HNil) -> e
    ]

rExpr :: Rule Ast
rExpr = ruleExpr
    [ varA @"sum"
        <:> \(e :* HNil) -> e
    ]

rSum :: Rule Ast
rSum = ruleExpr
    [ varA @"product" <^> tokA @"+" <^> varA @"sum"
        <:> \(e1 :* _ :* e2 :* HNil) -> [|| Sum $$(e1) $$(e2) ||]
    , varA @"product"
        <:> \(e :* HNil) -> e
    ]

rProduct :: Rule Ast
rProduct = ruleExpr
    [ varA @"value" <^> tokA @"*" <^> varA @"product"
        <:> \(e1 :* _ :* e2 :* HNil) -> [|| Product $$(e1) $$(e2) ||]
    , varA @"value"
        <:> \(e :* HNil) -> e
    ]

rValue :: Rule Ast
rValue = ruleExpr
    [ tokA @"n" <:> \(n :* HNil) ->
        [|| case $$(n) of
            TokDigit -> Value
            _        -> error "unreachable: expected digit token"
        ||]
    ]

And, generate parser:

module Parser where

import Parser.Rules
import Language.Parser.Ptera.TH
import Data.Proxy

$(genRunner
    (GenParam
        { startsTy = [t|ParsePoints|]
        , rulesTy  = [t|RuleDefs|]
        , tokensTy = [t|Tokens|]
        , tokenTy  = [t|Token|]
        , customCtxTy = defaultCustomCtxTy
        })
    grammar
    )

exprParser :: Scanner posMark Token m => m (Result posMark Ast)
exprParser = runParser (Proxy :: Proxy "expr EOS") pteraTHRunner

Examples

• Small language: https://github.com/mizunashi-mana/ptera/tree/master/example/small-lang-th
• Haskell2010: https://github.com/mizunashi-mana/ptera/tree/master/example/haskell2010