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_0 {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_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 HaskellType)),
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_3)
where newTable = do t_4 <- new
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
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
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 = memo tbl_definition $ ((many skip *> ((do v1 <- ident
(many skip *> string ":::") <* many skip
v2 <- haskellType
(many skip *> string "=") <* many skip
v3 <- expr
return (Definition v1 v2 (Token v3))) <|> (do v1 <- ident
(many skip *> string "::") <* many skip
v2 <- haskellType
(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 = 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 = memo tbl_choiceExpr $ (do v1 <- (do v1 <- do v1 <- semanticExpr
return $ (v1)
v2 <- many (do v1 <- do v1 <- do (many skip *> string "/") <* many skip
return $ ()
return ()
v2 <- do v1 <- semanticExpr
return $ (v1)
return v2)
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 = 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 = 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 = 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 = memo tbl_suffixExpr_tail $ ((((do (many skip *> string "*") <* many skip
v1 <- suffixExpr_tail
return (\v999 -> v1 (Many v999))) <|> (do (many skip *> string "+") <* many skip
v1 <- suffixExpr_tail
return (\v999 -> v1 (Some v999)))) <|> (do (many skip *> string "?") <* many skip
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 = 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 = memo tbl_primExpr $ ((many skip *> (((((((((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 (many skip *> string ".") <* many skip
return TerminalAny)) <|> (do v1 <- ident
return (NonTerminal v1))) <|> (do (many skip *> string "(") <* many skip
v1 <- expr
(many skip *> string ",") <* many skip
v2 <- expr
(many skip *> string ")") <* many skip
return (SepBy v1 v2))) <|> (do (many skip *> string "(") <* many skip
v1 <- expr
(many skip *> string ";") <* many skip
v2 <- expr
(many skip *> string ")") <* many skip
return (SepBy1 v1 v2))) <|> (do (many skip *> string "(") <* many skip
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 = 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 = 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_53 s_54 . ListLike str_53 Char =>
Parser (MemoTable_0 str_53) str_53 s_54 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 = 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_57 s_58 . ListLike str_57 Char =>
Parser (MemoTable_0 str_57) str_57 s_58 HaskellType
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 = 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 = 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 = 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 = 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 = 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 == '_'))
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 = 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 = 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 = 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 = memo tbl_regionComment $ (do string "{-"
v1 <- many ((do v1 <- regionComment
return $ (v1)) <|> (do unexpect (string "-}")
v1 <- anyChar
return ()))
string "-}"
return ())