如何使用 parsec 在 Haskell 中解析 Python 风格的链接运算符？

Question

在我目前正在进行的项目中，我以秒差距构建表达式解析器。代码类似于：

opTable :: [[Operator Parser Expr]]
  opTable =
    [ 
      -- ...
      [ InfixL $ binary (ArithOp . Exp) TokExp ]
    , [ InfixL $ binary (ArithOp . Mod) TokMod
      , InfixL $ binary (ArithOp . Mul) TokMul
      , InfixL $ binary (ArithOp . Div) TokDiv
      ]

    , [ InfixL $ binary (ArithOp . Add) TokAdd
      , InfixL $ binary (ArithOp . Sub) TokSub
      ]

    , [ InfixL $ binary (ArithOp . Max) TokMax
      , InfixL $ binary (ArithOp . Min) TokMin
      ]

      -- =
    , [ InfixL $ binary (ChainOp . EQ) TokEQ
      -- ~, <, <=, >, >=
      , InfixL $ binary (ChainOp . NEQ) TokNEQ
      , InfixL $ binary (ChainOp . NEQU) TokNEQU
      , InfixL $ binary (ChainOp . LT) TokLT
      , InfixL $ binary (ChainOp . LTE) TokLTE
      , InfixL $ binary (ChainOp . LTEU) TokLTEU
      , InfixL $ binary (ChainOp . GT) TokGT
      , InfixL $ binary (ChainOp . GTE) TokGTE
      , InfixL $ binary (ChainOp . GTEU) TokGTEU
      ]

      -- &&
    , [ InfixL $ binary (ArithOp . Conj) TokConj
      , InfixL $ binary (ArithOp . ConjU) TokConjU
      -- ||
      , InfixL $ binary (ArithOp . Disj) TokDisj
      , InfixL $ binary (ArithOp . DisjU) TokDisjU
      ]
      -- =>
    , [ InfixR $ binary (ArithOp . Implies) TokImpl
      , InfixR $ binary (ArithOp . ImpliesU) TokImplU
      -- <=>
      , InfixL $ binary (ChainOp . EQProp) TokEQProp
      , InfixL $ binary (ChainOp . EQPropU) TokEQPropU
      ]
    ]

请注意，有 2 种运算符，即

ArithOp

和

ChainOp

。

ArithOp

是普通运算符，

ChainOp

是Python风格的链接运算符，例如

a <= b < c

。有许多连锁运营商。例如，有

TokLT

(

<

) 和

TokEQProp

(

<=>

) 不幸的是，

ArithOp

和

ChainOp

的优先级是混合的。现在假设我想将表达式解析到这个语法树中：

data Expr
  = Lit Lit
  | Var Name
  | Op Op
  | App Expr Expr
  | Chain Chain
  -- ...

-- ...

data Chain = Pure Expr | Ch Chain Op Expr

我们是否可以使用表达式解析器来构造这样的带有链的语法树？例如，类似

1 <= 1 + 1 < 3

的内容应该变成：

Ch (
  Ch (
    Lit 1
  )
  ( Op "<=")
  (
    App (
      App (Op "+") (Lit 1)
    )
    (Lit 1)
  )
)
(Op "<")
(Lit 3)

（为了清楚起见，我省略了一些构造函数。）

这种链接运算符可以使用表达式解析器进行解析吗？我知道我可以通过将解析器重写为解析器层来手动构建解析器。然而，使用表达式解析器肯定更简单。

我发现了一些组合器，例如

chainl

。然而，用它来形成上面的

Chain

似乎不太可能。告诉我是否可以使用上面的表达式解析器。如果不是，请告诉我不是，我将手工构建它。

Answer 1

从语法上讲，链运算符和算术运算符之间没有真正的区别。 它们是具有不同优先级的（左或右）关联运算符，标准表达式解析器解析它们应该没有问题。 您需要做的就是确保构建适当的 AST，您可以通过在运算符表的元素中使用

binary

函数的两种变体来实现：

作为一个精简的示例，类似以下内容应该有效：

opTable :: [[Operator Parser Expr]]
opTable =
    [ [ InfixL $ arithOp Mul "*" ]
    , [ InfixL $ arithOp Add "+" ]
    , [ InfixL $ chainOp Eq "=" ]
    , [ InfixL $ arithOp Conj "&&" ]
    , [ InfixR $ arithOp Implies "=>" ]
    , [ InfixL $ chainOp EQProp "<=>" ]
    ]
  where arithOp op tok = makeArith <$ string tok
          where makeArith a b = App (App (Op op) a) b
        chainOp op tok = makeChain <$ string tok
          where makeChain a b = Chain $ Ch (asChain a) op b
                asChain (Chain c) = c
                asChain e = Pure e

这里唯一棘手的部分是正确定义

makeChain

，它需要处理链和非链作为其第一个参数。

一个完整的、可运行的示例：

import Text.Parsec
import Text.Parsec.String
import Control.Monad.Combinators.Expr

type Lit = Int
type Name = String

data Expr
  = Lit Lit
  | Var Name
  | Op Op
  | App Expr Expr
  | Chain Chain
  deriving (Show)

data Chain = Pure Expr | Ch Chain Op Expr
  deriving (Show)

data Op = Mul | Add | Eq | Lte | Lt | Conj | Implies | EQProp
  deriving (Show)

reservedOp :: String -> Parser String
reservedOp s = try $ string s <* notFollowedBy (oneOf "*+=<>&")

opTable :: [[Operator Parser Expr]]
opTable =
    [ [ InfixL $ arithOp Mul "*" ]
    , [ InfixL $ arithOp Add "+" ]
    , [ InfixL $ chainOp Eq "="
      , InfixL $ chainOp Lte "<="
      , InfixL $ chainOp Lt "<"
      ]
    , [ InfixL $ arithOp Conj "&&" ]
    , [ InfixR $ arithOp Implies "=>" ]
    , [ InfixL $ chainOp EQProp "<=>" ]
    ]
  where arithOp op tok = makeArith <$ reservedOp tok
          where makeArith a b = App (App (Op op) a) b
        chainOp op tok = makeChain <$ reservedOp tok
          where makeChain a b = Chain $ Ch (asChain a) op b
                asChain (Chain c) = c
                asChain e = Pure e

expr :: Parser Expr
expr = makeExprParser term opTable

term :: Parser Expr
term = Lit . read <$> many1 digit

main :: IO ()
main = do
  parseTest expr "1<=1+1<3"
  -- output: Chain (Ch (Ch (Pure (Lit 1)) Lte (App (App (Op Add) (Lit 1)) (Lit 1))) Lt (Lit 3))