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
data MemoTable_0 str_1 s_2
= MemoTable_3 {tbl_delimiter :: (HashTable s_2
Int
(Result str_1 ())),
tbl_syntax :: (HashTable s_2 Int (Result str_1 Syntax)),
tbl_definition :: (HashTable s_2 Int (Result str_1 Definition)),
tbl_expr :: (HashTable s_2 Int (Result str_1 Expr)),
tbl_choiceExpr :: (HashTable s_2 Int (Result str_1 Expr)),
tbl_semanticExpr :: (HashTable s_2 Int (Result str_1 Expr)),
tbl_sequenceExpr :: (HashTable s_2 Int (Result str_1 Expr)),
tbl_namedExpr :: (HashTable s_2 Int (Result str_1 Expr)),
tbl_suffixExpr :: (HashTable s_2 Int (Result str_1 Expr)),
tbl_suffixExpr_tail :: (HashTable s_2
Int
(Result str_1 (Expr -> Expr))),
tbl_prefixExpr :: (HashTable s_2 Int (Result str_1 Expr)),
tbl_primExpr :: (HashTable s_2 Int (Result str_1 Expr)),
tbl_charLit :: (HashTable s_2 Int (Result str_1 Char)),
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 TermType)),
tbl_codeFragment :: (HashTable s_2
Int
(Result str_1 CodeFragment)),
tbl_codePart :: (HashTable s_2 Int (Result str_1 CodePart)),
tbl_argument :: (HashTable s_2 Int (Result str_1 CodePart)),
tbl_digit :: (HashTable s_2 Int (Result str_1 Char)),
tbl_hexDigit :: (HashTable s_2 Int (Result str_1 Char)),
tbl_ident :: (HashTable s_2 Int (Result str_1 String)),
tbl_skip :: (HashTable s_2 Int (Result str_1 ())),
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_4)
where newTable = do t_5 <- new
t_6 <- new
t_7 <- new
t_8 <- new
t_9 <- new
t_10 <- new
t_11 <- new
t_12 <- new
t_13 <- new
t_14 <- new
t_15 <- new
t_16 <- new
t_17 <- new
t_18 <- new
t_19 <- new
t_20 <- new
t_21 <- new
t_22 <- new
t_23 <- new
t_24 <- new
t_25 <- new
t_26 <- new
t_27 <- new
t_28 <- new
t_29 <- new
t_30 <- new
t_31 <- 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 t_30 t_31)
delimiter :: forall str_32 s_33 . ListLike str_32 Char =>
Parser (MemoTable_0 str_32) str_32 s_33 ()
delimiter = memo tbl_delimiter $ defaultDelimiter
syntax :: forall str_34 s_35 . ListLike str_34 Char =>
Parser (MemoTable_0 str_34) str_34 s_35 Syntax
syntax = memo tbl_syntax $ (do v1 <- many definition
unexpect (do v1 <- many skip
v2 <- anyChar
return $ (v1, v2))
return $ (v1))
definition :: forall str_36 s_37 . ListLike str_36 Char =>
Parser (MemoTable_0 str_36) str_36 s_37 Definition
definition = memo tbl_definition $ token skip delimiter ((do v1 <- ident
token skip delimiter (string ":::")
v2 <- haskellType
token skip delimiter (string "=")
v3 <- expr
return (Definition v1 v2 (Token v3))) <|> (do v1 <- ident
token skip delimiter (string "::")
v2 <- haskellType
token skip delimiter (string "=")
v3 <- expr
return (Definition v1 v2 v3)))
expr :: forall str_38 s_39 . ListLike str_38 Char =>
Parser (MemoTable_0 str_38) str_38 s_39 Expr
expr = memo tbl_expr $ (do v1 <- choiceExpr
return $ (v1))
choiceExpr :: forall str_40 s_41 . ListLike str_40 Char =>
Parser (MemoTable_0 str_40) str_40 s_41 Expr
choiceExpr = memo tbl_choiceExpr $ (do v1 <- (do v1 <- do v1 <- semanticExpr
return $ (v1)
v2 <- many (do v1 <- do v1 <- do token skip delimiter (string "/")
return $ ()
return ()
v2 <- do v1 <- semanticExpr
return $ (v1)
return v2)
return (v1 : v2)) <|> (do v1 <- return ()
return [])
return (Choice v1))
semanticExpr :: forall str_42 s_43 . ListLike str_42 Char =>
Parser (MemoTable_0 str_42) str_42 s_43 Expr
semanticExpr = memo tbl_semanticExpr $ ((do v1 <- sequenceExpr
token skip delimiter (string "{")
v2 <- codeFragment
token skip delimiter (string "}")
return (Semantic v1 v2)) <|> (do v1 <- sequenceExpr
return $ (v1)))
sequenceExpr :: forall str_44 s_45 . ListLike str_44 Char =>
Parser (MemoTable_0 str_44) str_44 s_45 Expr
sequenceExpr = memo tbl_sequenceExpr $ (do v1 <- some (do v1 <- namedExpr
unexpect (token skip delimiter (string "::"))
unexpect (token skip delimiter (string "="))
return $ (v1))
return (Sequence v1))
namedExpr :: forall str_46 s_47 . ListLike str_46 Char =>
Parser (MemoTable_0 str_46) str_46 s_47 Expr
namedExpr = memo tbl_namedExpr $ ((do v1 <- ident
token skip delimiter (string ":")
v2 <- suffixExpr
return (Named v1 v2)) <|> (do v1 <- suffixExpr
return $ (v1)))
suffixExpr :: forall str_48 s_49 . ListLike str_48 Char =>
Parser (MemoTable_0 str_48) str_48 s_49 Expr
suffixExpr = memo tbl_suffixExpr $ (do v1 <- do v1 <- prefixExpr
return $ (v1)
v2 <- suffixExpr_tail
return (v2 v1))
suffixExpr_tail :: forall str_50 s_51 . ListLike str_50 Char =>
Parser (MemoTable_0 str_50) str_50 s_51 (Expr -> Expr)
suffixExpr_tail = memo tbl_suffixExpr_tail $ ((((do token skip delimiter (string "*")
v1 <- suffixExpr_tail
return (\v999 -> v1 (Many v999))) <|> (do token skip delimiter (string "+")
v1 <- suffixExpr_tail
return (\v999 -> v1 (Some v999)))) <|> (do token skip delimiter (string "?")
v1 <- suffixExpr_tail
return (\v999 -> v1 (Optional v999)))) <|> (do v1 <- return ()
return id))
prefixExpr :: forall str_52 s_53 . ListLike str_52 Char =>
Parser (MemoTable_0 str_52) str_52 s_53 Expr
prefixExpr = memo tbl_prefixExpr $ (((do token skip delimiter (string "&")
v1 <- primExpr
return (And v1)) <|> (do token skip delimiter (string "!")
v1 <- primExpr
return (Not v1))) <|> (do v1 <- primExpr
return $ (v1)))
primExpr :: forall str_54 s_55 . ListLike str_54 Char =>
Parser (MemoTable_0 str_54) str_54 s_55 Expr
primExpr = memo tbl_primExpr $ token skip delimiter (((((((((do string "\""
v1 <- many charLit
string "\""
return (Terminals True True v1)) <|> (do string "'"
v1 <- many charLit
string "'"
return (Terminals False False v1))) <|> (do string "[^"
v1 <- many range
string "]"
return (TerminalCmp v1))) <|> (do string "["
v1 <- many range
string "]"
return (TerminalSet v1))) <|> (do token skip delimiter (string ".")
return TerminalAny)) <|> (do v1 <- ident
return (NonTerminal v1))) <|> (do token skip delimiter (string "(")
v1 <- expr
token skip delimiter (string ",")
v2 <- expr
token skip delimiter (string ")")
return (SepBy v1 v2))) <|> (do token skip delimiter (string "(")
v1 <- expr
token skip delimiter (string ";")
v2 <- expr
token skip delimiter (string ")")
return (SepBy1 v1 v2))) <|> (do token skip delimiter (string "(")
v1 <- expr
token skip delimiter (string ")")
return $ (v1)))
charLit :: forall str_56 s_57 . ListLike str_56 Char =>
Parser (MemoTable_0 str_56) str_56 s_57 Char
charLit = memo tbl_charLit $ ((do string "\\"
v1 <- escChar
return $ (v1)) <|> (do unexpect (satisfy (\c -> (c == '\'') || (c == '"')))
v1 <- anyChar
return $ (v1)))
escChar :: forall str_58 s_59 . ListLike str_58 Char =>
Parser (MemoTable_0 str_58) str_58 s_59 Char
escChar = memo tbl_escChar $ (((((((do string "n"
return '\n') <|> (do string "r"
return '\r')) <|> (do string "t"
return '\t')) <|> (do string "\\"
return '\\')) <|> (do string "\""
return '"')) <|> (do string "'"
return '\'')) <|> (do string "x"
v1 <- hexDigit
v2 <- hexDigit
return ((chr . (fst . (head . readHex))) $ [v1,
v2])))
range :: forall str_60 s_61 . ListLike str_60 Char =>
Parser (MemoTable_0 str_60) str_60 s_61 CharRange
range = memo tbl_range $ ((do v1 <- rchar
string "-"
v2 <- rchar
return (CharRange v1 v2)) <|> (do v1 <- rchar
return (CharOne v1)))
rchar :: forall str_62 s_63 . ListLike str_62 Char =>
Parser (MemoTable_0 str_62) str_62 s_63 Char
rchar = memo tbl_rchar $ ((((((do string "\\"
v1 <- escChar
return $ (v1)) <|> (do string "\\]"
return ']')) <|> (do string "\\["
return '[')) <|> (do string "\\^"
return '^')) <|> (do string "\\-"
return '-')) <|> (do v1 <- satisfy $ (not . (\c -> c == ']'))
return $ (v1)))
haskellType :: forall str_64 s_65 . ListLike str_64 Char =>
Parser (MemoTable_0 str_64) str_64 s_65 TermType
haskellType = memo tbl_haskellType $ (do v1 <- some (satisfy $ (not . (\c -> c == '=')))
return $ (v1))
codeFragment :: forall str_66 s_67 . ListLike str_66 Char =>
Parser (MemoTable_0 str_66) str_66 s_67 CodeFragment
codeFragment = memo tbl_codeFragment $ (do v1 <- many codePart
return $ (v1))
codePart :: forall str_68 s_69 . ListLike str_68 Char =>
Parser (MemoTable_0 str_68) str_68 s_69 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_70 s_71 . ListLike str_70 Char =>
Parser (MemoTable_0 str_70) str_70 s_71 CodePart
argument = memo tbl_argument $ ((((do string "$$"
v1 <- some digit
return (AntiArgument $ read v1)) <|> (do string "$"
v1 <- some digit
return (Argument $ read v1))) <|> (do string "$"
string "p"
return ArgPos)) <|> (do string "$"
string "s"
return ArgSpan))
digit :: forall str_72 s_73 . ListLike str_72 Char =>
Parser (MemoTable_0 str_72) str_72 s_73 Char
digit = memo tbl_digit $ (do v1 <- satisfy (\c -> ('0' <= c) && (c <= '9'))
return $ (v1))
hexDigit :: forall str_74 s_75 . ListLike str_74 Char =>
Parser (MemoTable_0 str_74) str_74 s_75 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_76 s_77 . ListLike str_76 Char =>
Parser (MemoTable_0 str_76) str_76 s_77 String
ident = memo tbl_ident $ token skip delimiter (do v1 <- satisfy (\c -> (('a' <= c) && (c <= 'z')) || (c == '_'))
v2 <- many (satisfy (\c -> (((('0' <= c) && (c <= '9')) || (('a' <= c) && (c <= 'z'))) || (('A' <= c) && (c <= 'Z'))) || (c == '_')))
return (v1 : v2))
skip :: forall str_78 s_79 . ListLike str_78 Char =>
Parser (MemoTable_0 str_78) str_78 s_79 ()
skip = memo tbl_skip $ ((do satisfy (\c -> (((c == ' ') || (c == '\r')) || (c == '\n')) || (c == '\t'))
return $ ()) <|> (do v1 <- comment
return $ (v1)))
comment :: forall str_80 s_81 . ListLike str_80 Char =>
Parser (MemoTable_0 str_80) str_80 s_81 ()
comment = memo tbl_comment $ ((do v1 <- lineComment
return $ (v1)) <|> (do v1 <- regionComment
return $ (v1)))
lineComment :: forall str_82 s_83 . ListLike str_82 Char =>
Parser (MemoTable_0 str_82) str_82 s_83 ()
lineComment = memo tbl_lineComment $ (do string "--"
many (do unexpect (string "\n")
anyChar
return $ ())
string "\n"
return $ ())
regionComment :: forall str_84 s_85 . ListLike str_84 Char =>
Parser (MemoTable_0 str_84) str_84 s_85 ()
regionComment = memo tbl_regionComment $ (do string "{-"
many ((do v1 <- regionComment
return $ (v1)) <|> (do unexpect (string "-}")
anyChar
return $ ()))
string "-}"
return $ ())