用`Parsec`解析各种二元函数链的正确方法?

Ser*_*bov 3 parsing haskell parsec operator-precedence associativity

确实Parsec具有chainlchainr解析左关联或右关联操作链(即a -> a -> a)。所以我可以很容易地x + y + z以 a((a + y) + z)(a + (y + z))方式解析某些东西。

然而,

  1. 在以下情况下没有解析a -> b -> c 函数和特定情况的标准方法a = ba -> a -> c例如a = b = c认为是比较函数 ( a -> a -> Bool);
  2. 没有标准的方法来实现一个操作的“重要性”:例如a + b = b + a应该被解析为((a + b) = (b + a))和不是(((a + b) = b) + a))

我对解析问题有点陌生,所以得到这两个问题的答案会很棒。

K. *_*uhr 8

好的,这是一个很长的答案,可能会有所帮助。首先,这些是我正在使用的导入,如果你想跟随:

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall #-}
import Control.Applicative (some)
import Text.Parsec
import Text.Parsec.Expr
import Text.Parsec.String
Run Code Online (Sandbox Code Playgroud)

为什么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)
Run Code Online (Sandbox Code Playgroud)

如果我们想编写一个解析器来将所有这些运算符视为相同优先级的左关联,我们可以chainl像这样编写一个基于 -based 的解析器。(为简单起见,此解析器不允许使用空格。)

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 ')')
Run Code Online (Sandbox Code Playgroud)

我们得到:

> 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
>
Run Code Online (Sandbox Code Playgroud)

然后我们将它留给解释器来处理类型(即,对程序进行类型检查):

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
Run Code Online (Sandbox Code Playgroud)

给予:

> evalExpr "1+2+3"
IntV 6
> evalExpr "1=2=F"
BoolV True
>
Run Code Online (Sandbox Code Playgroud)

请注意,即使 " =" 运算符的类型类似于Eq a => a -> a -> Bool(或实际上a -> b -> Bool,因为我们允许比较不相等的类型),但它在 AST 中表示EqE为 type的构造函数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'
Run Code Online (Sandbox Code Playgroud)

这也有效,解析器直接评估表达式

> parseTest expr' "1+2+3"
IntV 6
> parseTest expr' "1=2=F"
BoolV True
>
Run Code Online (Sandbox Code Playgroud)

您可能会发现在解析和评估期间使用动态类型有点不满意,但请参见下文。

运算符优先级

添加运算符优先级的标准方法是定义多个使用运算符子集的表达式“级别”。如果我们想要一个从高到低的加法/减法的优先顺序,然后是相等,然后是布尔值“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
Run Code Online (Sandbox Code Playgroud)

之后:

> parseTest expr0 "(1+5-6=2-3+1&2+2=4)=(T|F)"
BoolV True
>
Run Code Online (Sandbox Code Playgroud)

由于这可能很乏味,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
Run Code Online (Sandbox Code Playgroud)

类型解析

您可能会发现上面我们使用无类型 AST(即,一切都是 an Expr)并动态类型化Value而不是在解析中使用 Haskell 的类型系统很奇怪。可以设计一个解析器,其中运算符实际上具有预期的 Haskell 类型。在上面的语言中,相等会导致一些问题,但是如果我们只允许整数相等,则可以编写如下类型的解析器/求值器。这里bexpriexpr分别用于布尔值和整数值表达式。

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
Run Code Online (Sandbox Code Playgroud)

请注意,我们仍然可以使用chainl1,但是整数和布尔类型之间有一个由优先级强制执行的边界,所以我们只链接Int -> Int -> IntBool -> Bool -> Bool运算符,我们不让Int -> Int -> Bool整数相等运算符链接。

这也意味着我们需要使用不同的解析器来解析布尔表达式和整数表达式:

> parseTest bexpr0 "1+2=3"
True
> parseTest iexpr3 "1+2-3"  -- iexpr3 is top-most integer expression parser
0
>
Run Code Online (Sandbox Code Playgroud)

请注意,如果您希望将整数相等作为一组相等进行链接,以便1+1=2=3-1检查所有三个项是否相等,您可以chainl1通过对列表和单例值使用一些技巧来做到这一点,但更容易使用sepBy1并替换eqexpr上面的定义:

eqexpr' = do
  x:xs <- sepBy1 iexpr3 (char '=')
  return $ all (==x) xs
Run Code Online (Sandbox Code Playgroud)

给予:

> parseTest bexpr0 "1+1=2=3-1"
True

Run Code Online (Sandbox Code Playgroud)

整个节目

总而言之,这里是所有代码:

{-# 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
Run Code Online (Sandbox Code Playgroud)