用`Parsec`解析各种二进制函数链的正确方法？

时间：2019-05-24 15:41:15

标签： haskell parsec

的确，Parsec具有chainl和chainr来解析左关联或右关联操作的链（即{{1} }。因此，我可以轻松地以a -> a -> a或x + y + z的方式解析类似((a + y) + z)的内容。

但是

  1. 在(a + (y + z))：a -> b -> c（例如a = b）被认为是比较对象的情况下，没有解析a -> a -> c 功能和特定情况的标准方法功能（a = b = c）;
  2. 没有实现操作“重要性”的标准方法：例如a -> a -> Bool应该解析为a + b = b + a而不是((a + b) = (b + a))。

我是解析问题的新手，因此很高兴能获得两个问题的答案。

1 个答案:

答案 0 :(得分：0)

好的，这是一个很长的答案，可能会有所帮助。首先，这些是我正在使用的导入，如果您想遵循的话：

{-# 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中表示作为EqE类型的构造函数Expr -> Expr -> Expr，因此a -> a -> a类型是有意义的。

即使将上面的解析器和评估器组合为一个函数，我们也可能会发现使用动态Value类型最简单，因此所有运算符的类型均为Value -> Value -> Value符合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
>

您可能会发现在解析和评估过程中这种对动态类型的使用并不令人满意，但请参见下文。

操作员优先级

添加运算符优先级的标准方法是定义与运算符子集一起使用的多个表达式“级别”。如果我们想要从加/减的最高值到最低值，然后等于，然后是布尔值“ and”，然后是布尔值“ or”的优先级排序，则可以用以下内容替换expr'。请注意，每个chainl1调用都将下一个（较高优先级）表达式级别用作“项”：

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类型的地方设计一个解析器。在上面的语言中，相等性会引起一些问题，但是如果我们仅允许整数相等性，则可以如下编写类型化的解析器/评估器。这里的bexpr和iexpr分别是布尔值和整数值的表达式。

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
相关问题
最新问题