使用 Parsec 解析各种二进制函数链的正确方法？
Right way to parse chain of various binary functions with `Parsec`?
确实 Parsec 有 chainl 和 chainr 来解析左关联或右关联 操作链 (即 a -> a -> a)。所以我可以很容易地以 ((a + y) + z) 或 (a + (y + z)) 的方式解析 x + y + z 之类的东西。
然而，
- 没有标准的方法来解析
a -> b -> c 函数 和 a = b 时的特定情况：a -> a -> c，例如 a = b = c 认为是比较函数(a -> a -> Bool);
- 没有实现操作 "importance" 的标准方法：例如
a + b = b + a 应该解析为 ((a + b) = (b + a)) 而不是 (((a + b) = b) + a))。
我对解析问题有点陌生，所以如果能得到这两个问题的答案就太好了。
好的，这是一个可能有帮助的长答案。首先，这些是我正在使用的进口商品，如果您想继续：
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall #-}
import Control.Applicative (some)
import Text.Parsec
import Text.Parsec.Expr
import Text.Parsec.String
为什么 a -> a -> a 还不错...
运算符类型签名 a -> a -> a 的限制较少，而且比您最初想象的更有意义。一个关键点是 通常 当我们解析表达式时，我们不会编写解析器来直接评估它们，而是将它们解析成一些中间抽象语法树 (AST)，稍后评估。例如，考虑一个带有加法、减法、相等和布尔连接词的简单无类型 AST：
data Expr
= IntE Int -- integer literals
| FalseE | TrueE -- boolean literals (F, T)
| AddE Expr Expr -- x + y
| SubE Expr Expr -- x - y
| EqE Expr Expr -- x = y
| OrE Expr Expr -- x | y
| AndE Expr Expr -- x & y
deriving (Show)
如果我们想编写一个解析器来将所有这些运算符视为相同优先级的左关联运算符，我们可以像这样编写一个基于 chainl 的解析器。 （为简单起见，此解析器不允许使用空格。）
expr :: Parser Expr
expr = chainl1 term op
where op = AddE <$ char '+'
<|> SubE <$ char '-'
<|> EqE <$ char '='
<|> OrE <$ char '|'
<|> AndE <$ char '&'
term :: Parser Expr
term = IntE . read <$> some digit
<|> FalseE <$ char 'F' <|> TrueE <$ char 'T'
<|> parens expr
parens :: Parser a -> Parser a
parens = between (char '(') (char ')')
我们得到：
> parseTest expr "1+2+3"
AddE (AddE (IntE 1) (IntE 2)) (IntE 3)
> parseTest expr "1=2=F"
EqE (EqE (IntE 1) (IntE 2)) FalseE
>
然后我们将其留给解释器来处理类型（即类型检查程序）：
data Value = BoolV Bool | IntV Int deriving (Eq, Show)
eval :: Expr -> Value
eval (IntE x) = IntV x
eval FalseE = BoolV False
eval TrueE = BoolV True
eval (AddE e1 e2)
= let IntV v1 = eval e1 -- pattern match ensures right type
IntV v2 = eval e2
in IntV (v1 + v2)
eval (SubE e1 e2)
= let IntV v1 = eval e1
IntV v2 = eval e2
in IntV (v1 - v2)
eval (EqE e1 e2) = BoolV (eval e1 == eval e2) -- equal if same type and value
eval (OrE e1 e2)
= let BoolV v1 = eval e1
BoolV v2 = eval e2
in BoolV (v1 || v2)
eval (AndE e1 e2)
= let BoolV v1 = eval e1
BoolV v2 = eval e2
in BoolV (v1 && v2)
evalExpr :: String -> Value
evalExpr str = let Right e = parse expr "<evalExpr>" str in eval e
给予：
> evalExpr "1+2+3"
IntV 6
> evalExpr "1=2=F"
BoolV True
>
请注意，即使“=”运算符的类型类似于 Eq a => a -> a -> Bool（或者实际上是 a -> b -> Bool，因为我们允许比较不相等的类型），它表示为AST 作为 Expr -> Expr -> Expr 类型的构造函数 EqE，因此 a -> a -> a 类型是有意义的。
即使我们将上面的解析器和求值器组合成一个函数，我们可能会发现使用动态 Value 类型最简单，因此所有运算符都是 [=36= 类型] 符合 a -> a -> a 模式：
expr' :: Parser Value
expr' = chainl1 term' op
where op = add <$ char '+'
<|> sub <$ char '-'
<|> eq <$ char '='
<|> or <$ char '|'
<|> and <$ char '&'
add (IntV x) (IntV y) = IntV $ x + y
sub (IntV x) (IntV y) = IntV $ x - y
eq v1 v2 = BoolV $ v1 == v2
or (BoolV x) (BoolV y) = BoolV $ x || y
and (BoolV x) (BoolV y) = BoolV $ x && y
term' :: Parser Value
term' = IntV . read <$> some digit
<|> BoolV False <$ char 'F' <|> BoolV True <$ char 'T'
<|> parens expr'
这也有效，解析器直接计算表达式
> parseTest expr' "1+2+3"
IntV 6
> parseTest expr' "1=2=F"
BoolV True
>
您可能会发现在解析和评估期间使用动态类型有点不尽如人意，但请参阅下文。
运算符优先级
添加运算符优先级的标准方法是定义多个表达式 "levels" 与运算符的子集一起使用。如果我们想要一个从高到低的优先顺序 addition/subtraction，然后是相等，然后是布尔值 "and"，然后是布尔值 "or"，我们可以用以下内容替换 expr'。请注意，每个 chainl1 调用都用作 "terms" 下一个 (higher-precedence) 表达式级别：
expr0 :: Parser Value
expr0 = chainl1 expr1 op
where op = or <$ char '|'
or (BoolV x) (BoolV y) = BoolV $ x || y
expr1 :: Parser Value
expr1 = chainl1 expr2 op
where op = and <$ char '&'
and (BoolV x) (BoolV y) = BoolV $ x && y
expr2 :: Parser Value
expr2 = chainl1 expr3 op
where op = eq <$ char '='
eq v1 v2 = BoolV $ v1 == v2
expr3 :: Parser Value
expr3 = chainl1 term'' op
where op = add <$ char '+' -- two operators at same precedence
<|> sub <$ char '-'
add (IntV x) (IntV y) = IntV $ x + y
sub (IntV x) (IntV y) = IntV $ x - y
term'' :: Parser Value
term'' = IntV . read <$> some digit
<|> BoolV False <$ char 'F' <|> BoolV True <$ char 'T'
<|> parens expr0
之后：
> parseTest expr0 "(1+5-6=2-3+1&2+2=4)=(T|F)"
BoolV True
>
因为这可能很乏味，Parsec 提供了一个 Text.Parsec.Expr 让这更容易。以下内容替换了上面的 expr0 到 expr3：
expr0' :: Parser Value
expr0' = buildExpressionParser table term''
where table = [ [binary '+' add, binary '-' sub]
, [binary '=' eq]
, [binary '&' and]
, [binary '|' or]
]
binary c op = Infix (op <$ char c) AssocLeft
add (IntV x) (IntV y) = IntV $ x + y
sub (IntV x) (IntV y) = IntV $ x - y
eq v1 v2 = BoolV $ v1 == v2
and (BoolV x) (BoolV y) = BoolV $ x && y
or (BoolV x) (BoolV y) = BoolV $ x || y
类型化解析
你可能会觉得上面我们使用无类型 AST（即所有内容都是 Expr）和动态类型 Value 而不是使用 Haskell 的类型系统很奇怪解析。可以设计一个解析器，其中运算符实际上期望 Haskell 类型。在上面的语言中，相等会导致一些问题，但如果我们只允许整数相等，则可以按如下方式编写类型化 parser/evaluator。这里 bexpr 和 iexpr 分别用于 boolean-valued 和 integer-values 表达式。
bexpr0 :: Parser Bool
bexpr0 = chainl1 bexpr1 op
where op = (||) <$ char '|'
bexpr1 :: Parser Bool
bexpr1 = chainl1 bexpr2 op
where op = (&&) <$ char '&'
bexpr2 :: Parser Bool
bexpr2 = False <$ char 'F' <|> True <$ char 'T'
<|> try eqexpr
<|> parens bexpr0
where eqexpr = (==) <$> iexpr3 <* char '=' <*> iexpr3 -- this can't chain now
iexpr3 :: Parser Int
iexpr3 = chainl1 iterm op
where op = (+) <$ char '+'
<|> (-) <$ char '-'
iterm :: Parser Int
iterm = read <$> some digit
<|> parens iexpr3
请注意，我们仍然可以使用 chainl1，但是整数和布尔类型之间存在优先级强制的边界，因此我们只能链接 Int -> Int -> Int 或 Bool -> Bool -> Bool运算符，我们不让 Int -> Int -> Bool 整数相等运算符链。
这也意味着我们需要使用不同的解析器来解析布尔值和整数表达式：
> parseTest bexpr0 "1+2=3"
True
> parseTest iexpr3 "1+2-3" -- iexpr3 is top-most integer expression parser
0
>
请注意，如果您希望将整数相等性链接为一组相等性，以便 1+1=2=3-1 会检查所有三个项是否相等，您可以使用 chainl1 使用一些技巧来做到这一点列表和单例值，但使用 sepBy1 并用定义替换上面的 eqexpr 更容易：
eqexpr' = do
x:xs <- sepBy1 iexpr3 (char '=')
return $ all (==x) xs
给予：
> parseTest bexpr0 "1+1=2=3-1"
True
整个程序
总而言之，这里是所有代码：
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall #-}
import Control.Applicative (some)
import Text.Parsec
import Text.Parsec.Expr
import Text.Parsec.String
-- * Untyped parser to AST
data Expr
= IntE Int -- integer literals
| FalseE | TrueE -- boolean literals (F, T)
| AddE Expr Expr -- x + y
| SubE Expr Expr -- x - y
| EqE Expr Expr -- x = y
| OrE Expr Expr -- x | y
| AndE Expr Expr -- x & y
deriving (Show)
expr :: Parser Expr
expr = chainl1 term op
where op = AddE <$ char '+'
<|> SubE <$ char '-'
<|> EqE <$ char '='
<|> OrE <$ char '|'
<|> AndE <$ char '&'
term :: Parser Expr
term = IntE . read <$> some digit
<|> FalseE <$ char 'F' <|> TrueE <$ char 'T'
<|> parens expr
parens :: Parser a -> Parser a
parens = between (char '(') (char ')')
-- * Interpreter
data Value = BoolV Bool | IntV Int deriving (Eq, Show)
eval :: Expr -> Value
eval (IntE x) = IntV x
eval FalseE = BoolV False
eval TrueE = BoolV True
eval (AddE e1 e2)
= let IntV v1 = eval e1 -- pattern match ensures right type
IntV v2 = eval e2
in IntV (v1 + v2)
eval (SubE e1 e2)
= let IntV v1 = eval e1
IntV v2 = eval e2
in IntV (v1 - v2)
eval (EqE e1 e2) = BoolV (eval e1 == eval e2) -- equal if same type and value
eval (OrE e1 e2)
= let BoolV v1 = eval e1
BoolV v2 = eval e2
in BoolV (v1 || v2)
eval (AndE e1 e2)
= let BoolV v1 = eval e1
BoolV v2 = eval e2
in BoolV (v1 && v2)
-- * Combined parser/interpreter with no intermediate AST
expr' :: Parser Value
expr' = chainl1 term' op
where op = add <$ char '+'
<|> sub <$ char '-'
<|> eq <$ char '='
<|> or <$ char '|'
<|> and <$ char '&'
add (IntV x) (IntV y) = IntV $ x + y
sub (IntV x) (IntV y) = IntV $ x - y
eq v1 v2 = BoolV $ v1 == v2
or (BoolV x) (BoolV y) = BoolV $ x || y
and (BoolV x) (BoolV y) = BoolV $ x && y
term' :: Parser Value
term' = IntV . read <$> some digit
<|> BoolV False <$ char 'F' <|> BoolV True <$ char 'T'
<|> parens expr'
-- * Parser/interpreter with operator precendence
expr0 :: Parser Value
expr0 = chainl1 expr1 op
where op = or <$ char '|'
or (BoolV x) (BoolV y) = BoolV $ x || y
expr1 :: Parser Value
expr1 = chainl1 expr2 op
where op = and <$ char '&'
and (BoolV x) (BoolV y) = BoolV $ x && y
expr2 :: Parser Value
expr2 = chainl1 expr3 op
where op = eq <$ char '='
eq v1 v2 = BoolV $ v1 == v2
expr3 :: Parser Value
expr3 = chainl1 term'' op
where op = add <$ char '+' -- two operators at same precedence
<|> sub <$ char '-'
add (IntV x) (IntV y) = IntV $ x + y
sub (IntV x) (IntV y) = IntV $ x - y
term'' :: Parser Value
term'' = IntV . read <$> some digit
<|> BoolV False <$ char 'F' <|> BoolV True <$ char 'T'
<|> parens expr0
-- * Alternate implementation using buildExpressionParser
expr0' :: Parser Value
expr0' = buildExpressionParser table term''
where table = [ [binary '+' add, binary '-' sub]
, [binary '=' eq]
, [binary '&' and]
, [binary '|' or]
]
binary c op = Infix (op <$ char c) AssocLeft
add (IntV x) (IntV y) = IntV $ x + y
sub (IntV x) (IntV y) = IntV $ x - y
eq v1 v2 = BoolV $ v1 == v2
and (BoolV x) (BoolV y) = BoolV $ x && y
or (BoolV x) (BoolV y) = BoolV $ x || y
-- * Typed parser/interpreter with separate boolean and integer expressions
bexpr0 :: Parser Bool
bexpr0 = chainl1 bexpr1 op
where op = (||) <$ char '|'
bexpr1 :: Parser Bool
bexpr1 = chainl1 bexpr2 op
where op = (&&) <$ char '&'
bexpr2 :: Parser Bool
bexpr2 = False <$ char 'F' <|> True <$ char 'T'
<|> try eqexpr
<|> parens bexpr0
where eqexpr = (==) <$> iexpr3 <* char '=' <*> iexpr3 -- this can't chain now
iexpr3 :: Parser Int
iexpr3 = chainl1 iterm op
where op = (+) <$ char '+'
<|> (-) <$ char '-'
iterm :: Parser Int
iterm = read <$> some digit
<|> parens iexpr3
-- * Alternate definition of eqexpr to allow 4=2+2=1+3
eqexpr' = do
x:xs <- sepBy1 iexpr3 (char '=')
return $ all (==x) xs
确实 Parsec 有 chainl 和 chainr 来解析左关联或右关联 操作链 (即 a -> a -> a)。所以我可以很容易地以 ((a + y) + z) 或 (a + (y + z)) 的方式解析 x + y + z 之类的东西。
然而，
- 没有标准的方法来解析
a -> b -> c函数 和a = b时的特定情况：a -> a -> c，例如a = b = c认为是比较函数(a -> a -> Bool); - 没有实现操作 "importance" 的标准方法：例如
a + b = b + a应该解析为((a + b) = (b + a))而不是(((a + b) = b) + a))。
我对解析问题有点陌生，所以如果能得到这两个问题的答案就太好了。
好的，这是一个可能有帮助的长答案。首先，这些是我正在使用的进口商品，如果您想继续：
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall #-}
import Control.Applicative (some)
import Text.Parsec
import Text.Parsec.Expr
import Text.Parsec.String
为什么 a -> a -> a 还不错...
运算符类型签名 a -> a -> a 的限制较少，而且比您最初想象的更有意义。一个关键点是 通常 当我们解析表达式时，我们不会编写解析器来直接评估它们，而是将它们解析成一些中间抽象语法树 (AST)，稍后评估。例如，考虑一个带有加法、减法、相等和布尔连接词的简单无类型 AST：
data Expr
= IntE Int -- integer literals
| FalseE | TrueE -- boolean literals (F, T)
| AddE Expr Expr -- x + y
| SubE Expr Expr -- x - y
| EqE Expr Expr -- x = y
| OrE Expr Expr -- x | y
| AndE Expr Expr -- x & y
deriving (Show)
如果我们想编写一个解析器来将所有这些运算符视为相同优先级的左关联运算符，我们可以像这样编写一个基于 chainl 的解析器。 （为简单起见，此解析器不允许使用空格。）
expr :: Parser Expr
expr = chainl1 term op
where op = AddE <$ char '+'
<|> SubE <$ char '-'
<|> EqE <$ char '='
<|> OrE <$ char '|'
<|> AndE <$ char '&'
term :: Parser Expr
term = IntE . read <$> some digit
<|> FalseE <$ char 'F' <|> TrueE <$ char 'T'
<|> parens expr
parens :: Parser a -> Parser a
parens = between (char '(') (char ')')
我们得到：
> parseTest expr "1+2+3"
AddE (AddE (IntE 1) (IntE 2)) (IntE 3)
> parseTest expr "1=2=F"
EqE (EqE (IntE 1) (IntE 2)) FalseE
>
然后我们将其留给解释器来处理类型（即类型检查程序）：
data Value = BoolV Bool | IntV Int deriving (Eq, Show)
eval :: Expr -> Value
eval (IntE x) = IntV x
eval FalseE = BoolV False
eval TrueE = BoolV True
eval (AddE e1 e2)
= let IntV v1 = eval e1 -- pattern match ensures right type
IntV v2 = eval e2
in IntV (v1 + v2)
eval (SubE e1 e2)
= let IntV v1 = eval e1
IntV v2 = eval e2
in IntV (v1 - v2)
eval (EqE e1 e2) = BoolV (eval e1 == eval e2) -- equal if same type and value
eval (OrE e1 e2)
= let BoolV v1 = eval e1
BoolV v2 = eval e2
in BoolV (v1 || v2)
eval (AndE e1 e2)
= let BoolV v1 = eval e1
BoolV v2 = eval e2
in BoolV (v1 && v2)
evalExpr :: String -> Value
evalExpr str = let Right e = parse expr "<evalExpr>" str in eval e
给予：
> evalExpr "1+2+3"
IntV 6
> evalExpr "1=2=F"
BoolV True
>
请注意，即使“=”运算符的类型类似于 Eq a => a -> a -> Bool（或者实际上是 a -> b -> Bool，因为我们允许比较不相等的类型），它表示为AST 作为 Expr -> Expr -> Expr 类型的构造函数 EqE，因此 a -> a -> a 类型是有意义的。
即使我们将上面的解析器和求值器组合成一个函数，我们可能会发现使用动态 Value 类型最简单，因此所有运算符都是 [=36= 类型] 符合 a -> a -> a 模式：
expr' :: Parser Value
expr' = chainl1 term' op
where op = add <$ char '+'
<|> sub <$ char '-'
<|> eq <$ char '='
<|> or <$ char '|'
<|> and <$ char '&'
add (IntV x) (IntV y) = IntV $ x + y
sub (IntV x) (IntV y) = IntV $ x - y
eq v1 v2 = BoolV $ v1 == v2
or (BoolV x) (BoolV y) = BoolV $ x || y
and (BoolV x) (BoolV y) = BoolV $ x && y
term' :: Parser Value
term' = IntV . read <$> some digit
<|> BoolV False <$ char 'F' <|> BoolV True <$ char 'T'
<|> parens expr'
这也有效，解析器直接计算表达式
> parseTest expr' "1+2+3"
IntV 6
> parseTest expr' "1=2=F"
BoolV True
>
您可能会发现在解析和评估期间使用动态类型有点不尽如人意，但请参阅下文。
运算符优先级
添加运算符优先级的标准方法是定义多个表达式 "levels" 与运算符的子集一起使用。如果我们想要一个从高到低的优先顺序 addition/subtraction，然后是相等，然后是布尔值 "and"，然后是布尔值 "or"，我们可以用以下内容替换 expr'。请注意，每个 chainl1 调用都用作 "terms" 下一个 (higher-precedence) 表达式级别：
expr0 :: Parser Value
expr0 = chainl1 expr1 op
where op = or <$ char '|'
or (BoolV x) (BoolV y) = BoolV $ x || y
expr1 :: Parser Value
expr1 = chainl1 expr2 op
where op = and <$ char '&'
and (BoolV x) (BoolV y) = BoolV $ x && y
expr2 :: Parser Value
expr2 = chainl1 expr3 op
where op = eq <$ char '='
eq v1 v2 = BoolV $ v1 == v2
expr3 :: Parser Value
expr3 = chainl1 term'' op
where op = add <$ char '+' -- two operators at same precedence
<|> sub <$ char '-'
add (IntV x) (IntV y) = IntV $ x + y
sub (IntV x) (IntV y) = IntV $ x - y
term'' :: Parser Value
term'' = IntV . read <$> some digit
<|> BoolV False <$ char 'F' <|> BoolV True <$ char 'T'
<|> parens expr0
之后：
> parseTest expr0 "(1+5-6=2-3+1&2+2=4)=(T|F)"
BoolV True
>
因为这可能很乏味，Parsec 提供了一个 Text.Parsec.Expr 让这更容易。以下内容替换了上面的 expr0 到 expr3：
expr0' :: Parser Value
expr0' = buildExpressionParser table term''
where table = [ [binary '+' add, binary '-' sub]
, [binary '=' eq]
, [binary '&' and]
, [binary '|' or]
]
binary c op = Infix (op <$ char c) AssocLeft
add (IntV x) (IntV y) = IntV $ x + y
sub (IntV x) (IntV y) = IntV $ x - y
eq v1 v2 = BoolV $ v1 == v2
and (BoolV x) (BoolV y) = BoolV $ x && y
or (BoolV x) (BoolV y) = BoolV $ x || y
类型化解析
你可能会觉得上面我们使用无类型 AST（即所有内容都是 Expr）和动态类型 Value 而不是使用 Haskell 的类型系统很奇怪解析。可以设计一个解析器，其中运算符实际上期望 Haskell 类型。在上面的语言中，相等会导致一些问题，但如果我们只允许整数相等，则可以按如下方式编写类型化 parser/evaluator。这里 bexpr 和 iexpr 分别用于 boolean-valued 和 integer-values 表达式。
bexpr0 :: Parser Bool
bexpr0 = chainl1 bexpr1 op
where op = (||) <$ char '|'
bexpr1 :: Parser Bool
bexpr1 = chainl1 bexpr2 op
where op = (&&) <$ char '&'
bexpr2 :: Parser Bool
bexpr2 = False <$ char 'F' <|> True <$ char 'T'
<|> try eqexpr
<|> parens bexpr0
where eqexpr = (==) <$> iexpr3 <* char '=' <*> iexpr3 -- this can't chain now
iexpr3 :: Parser Int
iexpr3 = chainl1 iterm op
where op = (+) <$ char '+'
<|> (-) <$ char '-'
iterm :: Parser Int
iterm = read <$> some digit
<|> parens iexpr3
请注意，我们仍然可以使用 chainl1，但是整数和布尔类型之间存在优先级强制的边界，因此我们只能链接 Int -> Int -> Int 或 Bool -> Bool -> Bool运算符，我们不让 Int -> Int -> Bool 整数相等运算符链。
这也意味着我们需要使用不同的解析器来解析布尔值和整数表达式：
> parseTest bexpr0 "1+2=3"
True
> parseTest iexpr3 "1+2-3" -- iexpr3 is top-most integer expression parser
0
>
请注意，如果您希望将整数相等性链接为一组相等性，以便 1+1=2=3-1 会检查所有三个项是否相等，您可以使用 chainl1 使用一些技巧来做到这一点列表和单例值，但使用 sepBy1 并用定义替换上面的 eqexpr 更容易：
eqexpr' = do
x:xs <- sepBy1 iexpr3 (char '=')
return $ all (==x) xs
给予：
> parseTest bexpr0 "1+1=2=3-1"
True
整个程序
总而言之，这里是所有代码：
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall #-}
import Control.Applicative (some)
import Text.Parsec
import Text.Parsec.Expr
import Text.Parsec.String
-- * Untyped parser to AST
data Expr
= IntE Int -- integer literals
| FalseE | TrueE -- boolean literals (F, T)
| AddE Expr Expr -- x + y
| SubE Expr Expr -- x - y
| EqE Expr Expr -- x = y
| OrE Expr Expr -- x | y
| AndE Expr Expr -- x & y
deriving (Show)
expr :: Parser Expr
expr = chainl1 term op
where op = AddE <$ char '+'
<|> SubE <$ char '-'
<|> EqE <$ char '='
<|> OrE <$ char '|'
<|> AndE <$ char '&'
term :: Parser Expr
term = IntE . read <$> some digit
<|> FalseE <$ char 'F' <|> TrueE <$ char 'T'
<|> parens expr
parens :: Parser a -> Parser a
parens = between (char '(') (char ')')
-- * Interpreter
data Value = BoolV Bool | IntV Int deriving (Eq, Show)
eval :: Expr -> Value
eval (IntE x) = IntV x
eval FalseE = BoolV False
eval TrueE = BoolV True
eval (AddE e1 e2)
= let IntV v1 = eval e1 -- pattern match ensures right type
IntV v2 = eval e2
in IntV (v1 + v2)
eval (SubE e1 e2)
= let IntV v1 = eval e1
IntV v2 = eval e2
in IntV (v1 - v2)
eval (EqE e1 e2) = BoolV (eval e1 == eval e2) -- equal if same type and value
eval (OrE e1 e2)
= let BoolV v1 = eval e1
BoolV v2 = eval e2
in BoolV (v1 || v2)
eval (AndE e1 e2)
= let BoolV v1 = eval e1
BoolV v2 = eval e2
in BoolV (v1 && v2)
-- * Combined parser/interpreter with no intermediate AST
expr' :: Parser Value
expr' = chainl1 term' op
where op = add <$ char '+'
<|> sub <$ char '-'
<|> eq <$ char '='
<|> or <$ char '|'
<|> and <$ char '&'
add (IntV x) (IntV y) = IntV $ x + y
sub (IntV x) (IntV y) = IntV $ x - y
eq v1 v2 = BoolV $ v1 == v2
or (BoolV x) (BoolV y) = BoolV $ x || y
and (BoolV x) (BoolV y) = BoolV $ x && y
term' :: Parser Value
term' = IntV . read <$> some digit
<|> BoolV False <$ char 'F' <|> BoolV True <$ char 'T'
<|> parens expr'
-- * Parser/interpreter with operator precendence
expr0 :: Parser Value
expr0 = chainl1 expr1 op
where op = or <$ char '|'
or (BoolV x) (BoolV y) = BoolV $ x || y
expr1 :: Parser Value
expr1 = chainl1 expr2 op
where op = and <$ char '&'
and (BoolV x) (BoolV y) = BoolV $ x && y
expr2 :: Parser Value
expr2 = chainl1 expr3 op
where op = eq <$ char '='
eq v1 v2 = BoolV $ v1 == v2
expr3 :: Parser Value
expr3 = chainl1 term'' op
where op = add <$ char '+' -- two operators at same precedence
<|> sub <$ char '-'
add (IntV x) (IntV y) = IntV $ x + y
sub (IntV x) (IntV y) = IntV $ x - y
term'' :: Parser Value
term'' = IntV . read <$> some digit
<|> BoolV False <$ char 'F' <|> BoolV True <$ char 'T'
<|> parens expr0
-- * Alternate implementation using buildExpressionParser
expr0' :: Parser Value
expr0' = buildExpressionParser table term''
where table = [ [binary '+' add, binary '-' sub]
, [binary '=' eq]
, [binary '&' and]
, [binary '|' or]
]
binary c op = Infix (op <$ char c) AssocLeft
add (IntV x) (IntV y) = IntV $ x + y
sub (IntV x) (IntV y) = IntV $ x - y
eq v1 v2 = BoolV $ v1 == v2
and (BoolV x) (BoolV y) = BoolV $ x && y
or (BoolV x) (BoolV y) = BoolV $ x || y
-- * Typed parser/interpreter with separate boolean and integer expressions
bexpr0 :: Parser Bool
bexpr0 = chainl1 bexpr1 op
where op = (||) <$ char '|'
bexpr1 :: Parser Bool
bexpr1 = chainl1 bexpr2 op
where op = (&&) <$ char '&'
bexpr2 :: Parser Bool
bexpr2 = False <$ char 'F' <|> True <$ char 'T'
<|> try eqexpr
<|> parens bexpr0
where eqexpr = (==) <$> iexpr3 <* char '=' <*> iexpr3 -- this can't chain now
iexpr3 :: Parser Int
iexpr3 = chainl1 iterm op
where op = (+) <$ char '+'
<|> (-) <$ char '-'
iterm :: Parser Int
iterm = read <$> some digit
<|> parens iexpr3
-- * Alternate definition of eqexpr to allow 4=2+2=1+3
eqexpr' = do
x:xs <- sepBy1 iexpr3 (char '=')
return $ all (==x) xs