Хорошо, вот длинный ответ, который может помочь. Во-первых, это импорт, который я использую, если вы хотите следовать:
{-# 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
>
Использование динамической типизации во время синтаксического анализа и оценки может показаться немного неэффективным, но см. Ниже.
Приоритет оператора
Стандартный способ добавления приоритета операторов заключается в определении нескольких «уровней» выражений, которые работают с подмножеством операторов. Если мы хотим упорядочить приоритет от наивысшего к низшему из сложения / вычитания, затем равенства, затем логических «и», а затем логических «или», мы можем заменить 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