1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
module K.Parsing where
import K.Ast
import Text.Parsec
import Control.Monad.Identity
import qualified Text.Parsec.Token as Token
import qualified Text.Parsec.Expr as Expr
reservedNames = []
reservedOps = []
type Parser a = Parsec String () a
langDef :: Token.LanguageDef ()
langDef = Token.LanguageDef
{ Token.commentStart = "{-"
, Token.commentEnd = "-}"
, Token.commentLine = "--"
, Token.nestedComments = True
, Token.identStart = letter
, Token.identLetter = alphaNum <|> oneOf "_'"
, Token.opStart = oneOf ":!#$%&*+./<=>?@\\^|-~"
, Token.opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~"
, Token.reservedNames = reservedNames
, Token.reservedOpNames = reservedOps
, Token.caseSensitive = True
}
lexer :: Token.TokenParser ()
lexer = Token.makeTokenParser langDef
parens :: Parser a -> Parser a
parens = Token.parens lexer
reserved :: String -> Parser ()
reserved = Token.reserved lexer
semiSep :: Parser a -> Parser [a]
semiSep = Token.semiSep lexer
reservedOp :: String -> Parser ()
reservedOp = Token.reservedOp lexer
prefixOp :: String -> (a -> a) -> Expr.Operator String () Identity a
prefixOp s f = Expr.Prefix (reservedOp s >> return f)
table :: Expr.OperatorTable String () Identity Expr
table = [
[ prefixOp "succ" Succ
, prefixOp "pred" Pred
, prefixOp "iszero" IsZero
]]
ifthen :: Parser Expr
ifthen = do
reserved "if"
cond <- expr
reservedOp "then"
true <- expr
reservedOp "else"
false <- expr
return (If cond true false)
true, false, zero :: Parser Expr
true = reserved "true" >> return Tru
false =reserved "false" >> return Fals
zero = reserved "0" >> return Zero
factor :: Parser Expr
factor = foldr1 (<|>) [true, false, zero, ifthen, parens expr]
expr :: Parser Expr
expr = Expr.buildExpressionParser table factor
contents :: Parser a -> Parser a
contents p = do
Token.whiteSpace lexer
r <- p
eof
return r
parseExpr s = parse (contents expr) "<stdin>" s
|
