-- | Sample grammars for tests
{-# LANGUAGE QuasiQuotes #-}
module Data.Cfg.TestGrammars (
-- * Assertion for equality in 'Cfg'
assertEqCfg,
-- * Grammars for sanity checks
g0,
micro,
wiki,
-- * Convenience functions for the REPL
pretty'
) where
import Data.Cfg.Augment
import Data.Cfg.Bnf
import Data.Cfg.Cfg(Cfg(..), V(..), eqCfg)
import Data.Cfg.CPretty
import Data.Cfg.FreeCfg
import Text.PrettyPrint
import Test.HUnit(assertBool)
-- | An assertion for testing equality of 'Cfg'.
assertEqCfg :: (Cfg cfg t nt, CPretty (cfg t nt) ctxt,
Cfg cfg' t nt, CPretty (cfg' t nt) ctxt',
Eq t, Eq nt)
=> ctxt -> ctxt' -> String -> cfg t nt -> cfg' t nt -> IO ()
assertEqCfg ctxt ctxt' msg expected actual =
assertBool msg' (eqCfg expected actual)
where
msg' = show $ vcat [text msg, expected', actual']
expected' = text "Expected:" <+> cpretty expected ctxt
actual' = text "Actual:" <+> cpretty actual ctxt'
pretty' :: AugFreeCfg String String -> Doc
pretty' cfg = cpretty cfg ctxt
where
ctxt :: AugV String String -> Doc
ctxt v = text $ case v of
NT nt -> case nt of
StartSymbol -> "$start"
AugNT s -> s
T t -> case t of
EOF -> "$EOF"
AugT s -> s
-- | A test grammar. Found in Crafting a compiler, by Charles
-- N. Fischer and Richard J. LeBlanc, Jr., (c) 1998, pg. 95.
g0 :: FreeCfg (AugT String) (AugNT String)
g0 = augmentCfg [bnf|
e ::= prefix LPAREN e RPAREN.
e ::= V tail.
prefix ::= F.
prefix ::= .
tail ::= PLUS e.
tail ::= .
|]
-- | A test grammar. Found in Fischer and LeBlanc, pg. 111.
micro :: FreeCfg (AugT String) (AugNT String)
micro = augmentCfg [bnf|
program ::= BEGIN statement_list END.
statement_list ::= statement statement_tail.
statement_tail ::= statement statement_tail.
statement_tail ::=.
statement ::= ID ASSIGN expression SEMI.
statement ::= READ LPAREN id_list RPAREN SEMI.
statement ::= WRITE LPAREN expr_list RPAREN SEMI.
id_list ::= ID id_tail.
id_tail ::= COMMA ID id_tail.
id_tail ::=.
expr_list ::= expression expr_tail.
expr_tail ::= COMMA expression expr_tail.
expr_tail ::=.
expression ::= primary primary_tail.
primary_tail ::= add_op primary primary_tail.
primary_tail ::=.
primary ::= LPAREN expression RPAREN.
primary ::= ID.
primary ::= INT_LITERAL.
add_op ::= PLUS.
add_op ::= MINUS.
|]
-- | A test grammar. Found at
-- http://en.wikipedia.org/wiki/Useless_rules; retrieved 2015-03-14.
wiki :: Grammar String String
wiki = [bnf|
s ::= b B | c C | e E.
b ::= b B | B.
c ::= c C | C.
d ::= b D | c D | D.
e ::= e E.
|]