Я работаю над приложением, которое включает регулярные выражения с подсчетом. Кроме того, эти регулярные выражения не обязательно относятся к некоторому фиксированному алфавиту, но относятся к некоторому классу предикатов над битовыми векторами.
Я хотел бы иметь возможность анализировать / разобрать эти объекты. Я придумал что-то, что работает, но меня беспокоит, что в таком виде требуется слишком много паролей, и обычно люди не хотят использовать парные скобки в тех местах, где я строго этого требую. Предложения о том, как я могу сделать все это ближе к человеческому синтаксису, приветствуются.
Также приветствуются общие комментарии по стилям программирования haskell.
Вот файл Types.hs
где определены типы, а также разбор
module Regex.Types where
import Data.List (intercalate)
data Regex a = -- this is required elsewhere
Empty
| Epsilon
| Char a
| Union [Regex a]
| Concat [Regex a]
| Star (Regex a)
deriving Show
data CntRegex a =
CEmpty
| CEpsilon
| CChar a
| CUnion [CntRegex a]
| CConcat [CntRegex a]
| CStar (CntRegex a)
| CCount Int Int (CntRegex a)
| CCountUnbounded Int (CntRegex a)
data BoolExp a =
BTrue
| BFalse
| BSelect a
| BNot (BoolExp a)
| BAnd [BoolExp a]
| BOr [(BoolExp a)]
instance Show a => Show (BoolExp a) where
show BTrue = "true"
show BFalse = "false"
show (BSelect a) = show a
show (BNot a) = "! " ++ parenwrap (show a)
show (BAnd as) = intercalate " & " ( (parenwrap . show) <$> as)
show (BOr as) = intercalate " | " ( (parenwrap . show) <$> as)
instance Show a => Show (CntRegex a) where
show (CEmpty) = "empty"
show (CEpsilon) = "epsilon"
show (CChar a) = bracketwrap $ show a
show (CUnion as) = intercalate " | " ( (parenwrap . show) <$> as)
show (CConcat as) = intercalate " " ( (parenwrap . show) <$> as)
show (CStar a) = parenwrap (show a) ++ " *"
show (CCount i j a) = parenwrap (show a) ++ "{ " ++ show i ++ ", " ++ show j ++ " }"
show (CCountUnbounded i a) = parenwrap (show a) ++ "{ " ++ show i ++ ", }"
parenwrap p = "(" ++ p ++ ")"
bracketwrap p = "[" ++ p ++ "]"
Это Parser.hs
файл:
module Regex.Parser where
import Text.Parsec
import Text.Parsec.String
import qualified Text.Parsec.Token as P
import Text.Parsec.Language (emptyDef)
import Regex.Types
lexer = P.makeTokenParser emptyDef
parens = P.parens lexer
braces = P.braces lexer
brackets = P.brackets lexer
symbol = P.symbol lexer
natural = P.natural lexer
whiteSpace = P.whiteSpace lexer
pSelect :: Integral a => Parser (BoolExp a)
pSelect = BSelect <$> fromIntegral <$> natural
pAnd :: Parser (BoolExp a) -> Parser (BoolExp a)
pAnd prsr = BAnd <$> prsr `sepBy1` (symbol "&")
pOr :: Parser (BoolExp a) -> Parser (BoolExp a)
pOr prsr = BOr <$> prsr `sepBy1` (symbol "|")
pNot :: Parser (BoolExp a) -> Parser (BoolExp a)
pNot prsr = BNot <$> ((symbol "!") *> prsr)
parseBool :: Integral a => Parser (BoolExp a)
parseBool = try (parens $ pNot parseBool)
<|> try (parens $ pOr parseBool)
<|> try (parens $ pAnd parseBool)
<|> try (parens parseBool)
<|> try (symbol "true" *> pure BTrue)
<|> try (symbol "false" *> pure BFalse)
<|> pSelect
parseRegex :: Integral a => Parser (CntRegex (BoolExp a))
parseRegex = whiteSpace *> pRegex <* eof
pRegex :: Integral a => Parser (CntRegex (BoolExp a))
pRegex = try (parens $ pStar pRegex)
<|> try (parens $ pUnion pRegex)
<|> try (parens $ pConcat pRegex)
<|> try (parens $ pCount pRegex)
<|> try (parens $ pSingleCount pRegex)
<|> try (parens $ pCountUnbounded pRegex)
<|> try (parens $ pRegex)
<|> try (brackets $ CChar <$> parseBool)
<|> try pEmpty
<|> pEpsilon
pEmpty :: Parser (CntRegex a)
pEmpty = symbol "empty" *> pure CEmpty
pEpsilon :: Parser (CntRegex a)
pEpsilon = symbol "epsilon" *> pure CEpsilon
pUnion :: Parser (CntRegex a) -> Parser (CntRegex a)
pUnion subparser = CUnion <$> subparser `sepBy1` (symbol "|")
pConcat :: Parser (CntRegex a) -> Parser (CntRegex a)
pConcat subparser = CConcat <$> many1 subparser
pStar :: Parser (CntRegex a) -> Parser (CntRegex a)
pStar subparser = CStar <$> subparser <* symbol "*"
pSingleCount :: Parser (CntRegex a) -> Parser (CntRegex a)
pSingleCount subparser = do
exp <- subparser
int <- fromIntegral <$> braces natural
pure $ CCount int int exp
pCount :: Parser (CntRegex a) -> Parser (CntRegex a)
pCount subparser = do
exp <- subparser
symbol "{"
lo <- fromIntegral <$> natural
symbol ","
hi <- fromIntegral <$> natural
symbol "}"
pure $ CCount lo hi exp
pCountUnbounded :: Parser (CntRegex a) -> Parser (CntRegex a)
pCountUnbounded subparser = do
exp <- subparser
symbol "{"
lo <- fromIntegral <$> natural
symbol ","
symbol "}"
pure $ CCountUnbounded lo exp
```
1 ответ
Разбор с приоритетом
Я так понимаю, вы хотите добавить приоритет своим операторам, чтобы вы могли написать:
15 | !6 & 12
на месте:
(15 | (!6) & 12)
с пониманием того, что !
связывает крепче, чем &
который связывает крепче, чем |
. К счастью, Parsec поддерживает это в Text.Parsec.Expr
модуль. Вы используете его для написания табличного синтаксического анализатора для «выражений», которые состоят из операторов, применяемых к «терминам». Термины включают оба атома (например, ваш pSelect
) и выражения в скобках.
(Если вы также хотите увидеть ручную альтернативу табличному подходу, вы можете найти этот Мой ответ на переполнение стека полезный. См., В частности, раздел «Приоритет операторов».)
Итак, сначала мы определяем синтаксический анализатор для логических терминов:
reserved = P.reserved lexer
boolTerm :: Integral a => Parser (BoolExp a)
boolTerm = BTrue <$ reserved "true"
<|> BFalse <$ reserved "false"
<|> BSelect . fromIntegral <$> natural
<|> parens boolExpr
<?> "boolean term"
Несколько примечаний:
- Обратите внимание на альтернативный способ написания парсеров для
true
а такжеfalse
с помощью(<$)
оператор. Это довольно распространенное явление. - Также,
reserved
здесь правильно, а неsymbol
, хотя для вашего парсера это не имеет значения. Проблема в том, чтоsymbol "false"
соответствует первым пяти символам"falsehood"
а затем уйти"hood"
для последующего синтаксического анализа, что вам редко бывает нужно. Альтернативаreserved "false"
избегает этого, только разбор"false"
если это не префикс действительного буквенно-цифрового идентификатора. - Также обратите внимание на использование
f . g <$> natural
на местеf <$> g <$> natural
, хотя это незначительный стилистический выбор. - Наконец, обратите внимание, что
try
здесь не нужно. Вам нужно толькоtry
если парсер может выйти из строя после потребления ввода и вы хотите попробовать последующие альтернативы. Здесь ни один из этих парсеров не может выйти из строя после использования ввода, ожидайтеparens
, который может завершиться неудачно, если за открытой круглой скобкой следует что-то иное, кроме допустимого выражения типа bool и закрывающей круглой скобки, но если это произойдет, нечего пытаться (т. е. нет действительных синтаксических анализов, начинающихся с открытой круглой скобки, кроме этого один), так чтоtry
по-прежнему не нужен.
Затем мы пишем синтаксический анализатор на основе таблиц для выражений. Таблица представляет собой список списков спецификаций операторов: каждый внутренний список содержит спецификации операторов с одинаковым приоритетом, а во внешнем списке сначала идут операторы с наивысшим приоритетом (самая жесткая привязка). В этом парсере !
связывает крепче, чем &
который связывает крепче, чем |
.
boolExpr :: Integral a => Parser (BoolExp a)
boolExpr = buildExpressionParser table boolTerm <?> "boolean expression"
where table =
[ [prefix BNot "!"]
, [binary band' "&"]
, [binary bor' "|"]
]
prefix op str = Prefix (op <$ symbol str)
binary op str = Infix (op <$ symbol str) AssocRight
band' x (BAnd ys) = BAnd (x:ys)
band' (BAnd xs) y = BAnd (xs ++ [y])
band' x y = BAnd [x,y]
bor' x (BOr ys) = BOr (x:ys)
bor' (BOr xs) y = BOr (xs ++ [y])
bor' x y = BOr [x,y]
Ваш выбор типа данных сделал это немного сложнее, чем обычно. Если BAnd
а также BOr
вместо этого были бинарными конструкторами (что является более обычным представлением бинарных операторов в ADT), например:
data BoolExp a =
...
| BAnd (BoolExp a)
| BOr (BoolExp a)
...
тогда boolExpr
будет выглядеть примерно так:
boolExpr :: Integral a => Parser (BoolExp a)
boolExpr = buildExpressionParser table boolTerm <?> "boolean expression"
where table =
[ [prefix BNot "!"]
, [binary BAnd "&"]
, [binary BOr "|"]
]
prefix op str = Prefix (op <$ symbol str)
binary op str = Infix (op <$ symbol str) AssocLeft
Мы можем переписать парсер для CntRegex
по аналогии. В countTerm
синтаксический анализатор анализирует атомы, а также логические выражения в квадратных скобках и выражения подсчета в скобках:
countTerm :: Integral a => Parser (CntRegex (BoolExp a))
countTerm = CEmpty <$ reserved "empty"
<|> CEpsilon <$ reserved "epsilon"
<|> brackets (CChar <$> boolExpr)
<|> parens countExpr
<?> "count term"
Опять же нет try
здесь нужны. Если какой-либо из этих синтаксических анализаторов выйдет из строя после использования ввода, последующий синтаксический анализатор не будет работать, поэтому try
это бессмысленно.
Соответствующие countExpr
парсер основан на таблицах, но использует несколько уловок:
countExpr :: Integral a => Parser (CntRegex (BoolExp a))
countExpr = buildExpressionParser table countTerm <?> "count expression"
where table =
[ [ Postfix postfix ]
, [ Infix (pure cconcat') AssocRight ]
, [ Infix (cunion' <$ symbol "|") AssocRight]
]
postfix = foldr1 (flip (.)) <$> many1 (CStar <$ symbol "*" <|> braces countSpec)
cconcat' x (CConcat ys) = CConcat (x:ys)
cconcat' (CConcat xs) y = CConcat (xs ++ [y])
cconcat' x y = CConcat [x,y]
cunion' x (CUnion ys) = CUnion (x:ys)
cunion' (CUnion xs) y = CUnion (xs ++ [y])
cunion' x y = CUnion [x,y]
countSpec = do
-- there's always a lower bound
lo <- fromIntegral <$> natural
-- there might be an upper bound, possibly empty/unbounded
hi <- optionMaybe (symbol "," *> optionMaybe (fromIntegral <$> natural))
case hi of
-- no comma/bound
Nothing -> pure $ CCount lo lo
-- comma but no bound
Just Nothing -> pure $ CCountUnbounded lo
-- comma and upper bound
Just (Just hi') -> pure $ CCount lo hi'
Заметки:
- Приоритет здесь — любое количество постфиксных операторов, связывающих наиболее плотно, с последующим сопоставлением (
CConcat
) и, наконец, союзы. - Умышленное ограничение парсеров выражений на основе таблиц Parsec состоит в том, что они не будут анализировать несколько постфиксных операторов с одинаковым приоритетом, поэтому вам нужно объединить их в один парсер (
postfix
здесь помощник), который разбирает их все и превращает в правильную композицию функций для применения к постфиксному термину. - Сопоставление реализуется записью в таблице, которая ничего не анализирует.
(pure concat')
. - Обратите внимание, как я объединил ваши парсеры с несколькими счетчиками в один do-блок. Если бы вы сохранили их как отдельные альтернативы, это было бы единственное место в вашем парсере, где было бы законно использовать
try
.
Этого достаточно, чтобы разобрать довольно сложные выражения без скобок:
> parseTest parseRegex "empty{15} empty{3,4}* | [true & !15]{8,}"
(((empty){ 15, 15 }) (((empty){ 3, 4 }) *)) | (([(true) & (! (15))]){ 8, })
Тем не менее, я не проводил исчерпывающих тестов, поэтому могут быть некоторые сохраняющиеся ошибки.
Красивая печать с приоритетом
На Show
сторону, вы можете использовать showsPrec
чтобы упростить печатное представление, избегая ненужных скобок. Значения приоритета здесь в основном произвольные. Я попытался сопоставить их по приоритету с аналогичными операторами Haskell, где это возможно. Опять же, я не проводил исчерпывающего тестирования, поэтому могут быть некоторые ошибки.
showAtom d = showParen (d > 10) . showString
showPolyOp d d' op xs = showParen (d > d') $ foldr1 (.) $ intersperse (showString op) $ map (showsPrec (d'+1)) xs
instance Show a => Show (BoolExp a) where
showsPrec d BTrue = showAtom d "true"
showsPrec d BFalse = showAtom d "false"
showsPrec d (BSelect a) = showsPrec d a
showsPrec d (BNot a) = showParen (d > 9) $ showString "!" . showsPrec 10 a
showsPrec d (BAnd as) = showPolyOp d 3 " & " as
showsPrec d (BOr as) = showPolyOp d 2 " | " as
instance Show a => Show (CntRegex a) where
showsPrec d CEmpty = showAtom d "empty"
showsPrec d CEpsilon = showAtom d "epsilon"
showsPrec d (CChar a) = showString "[" . showsPrec 0 a . showString "]"
showsPrec d (CUnion as) = showPolyOp d 2 " | " as
showsPrec d (CConcat as) = showPolyOp d 3 " " as
showsPrec d (CStar a) = showParen (d > 9) $ showsPrec 9 a . showString "*"
showsPrec d (CCount i j a) = showParen (d > 9) $ showsPrec 9 a
. showString "{" . showsPrec 0 i . showString "," . showsPrec 0 j . showString "}"
showsPrec d (CCountUnbounded i a) = showParen (d > 9) $ showsPrec 9 a
. showString "{" . showsPrec 0 i . showString ",}"
Имейте в виду, что многие люди считают подобные вещи злоупотреблением Show
тип класс. Идея в том, что Show
должен произвести Haskell-читаемое представление ваших данных, не обязательно удобочитаемое для человека. Возможно, было бы лучше определить отдельный класс красивого печатного типа, как я сделал ниже.
Полная программа
Вот моя полная версия программы:
import Data.List (intersperse)
import Text.Parsec
import Text.Parsec.String
import Text.Parsec.Expr
import qualified Text.Parsec.Token as P
import Text.Parsec.Language (emptyDef)
data Regex a
= Empty
| Epsilon
| Char a
| Union [Regex a]
| Concat [Regex a]
| Star (Regex a)
deriving Show
data CntRegex a
= CEmpty
| CEpsilon
| CChar a
| CUnion [CntRegex a]
| CConcat [CntRegex a]
| CStar (CntRegex a)
| CCount Int Int (CntRegex a)
| CCountUnbounded Int (CntRegex a)
deriving (Show)
data BoolExp a
= BTrue
| BFalse
| BSelect a
| BNot (BoolExp a)
| BAnd [BoolExp a]
| BOr [BoolExp a]
deriving (Show, Eq)
pprintAtom d = showParen (d > 10) . showString
pprintPolyOp d d' op xs = showParen (d > d') $ foldr1 (.) $ intersperse (showString op) $ map (pprintPrec (d'+1)) xs
class PPrint a where
pprint :: a -> String
pprint = ($ "") . pprintPrec 0
pprintPrec :: Int -> a -> ShowS
instance Show a => PPrint (BoolExp a) where
pprintPrec d BTrue = pprintAtom d "true"
pprintPrec d BFalse = pprintAtom d "false"
pprintPrec d (BSelect a) = showsPrec d a
pprintPrec d (BNot a) = showParen (d > 9) $ showString "!" . pprintPrec 10 a
pprintPrec d (BAnd as) = pprintPolyOp d 3 " & " as
pprintPrec d (BOr as) = pprintPolyOp d 2 " | " as
instance PPrint a => PPrint (CntRegex a) where
pprintPrec d CEmpty = pprintAtom d "empty"
pprintPrec d CEpsilon = pprintAtom d "epsilon"
pprintPrec d (CChar a) = showString "[" . pprintPrec 0 a . showString "]"
pprintPrec d (CUnion as) = pprintPolyOp d 2 " | " as
pprintPrec d (CConcat as) = pprintPolyOp d 3 " " as
pprintPrec d (CStar a) = showParen (d > 9) $ pprintPrec 9 a . showString "*"
pprintPrec d (CCount i j a) = showParen (d > 9) $ pprintPrec 9 a
. showString "{" . showsPrec 0 i . showString "," . showsPrec 0 j . showString "}"
pprintPrec d (CCountUnbounded i a) = showParen (d > 9) $ pprintPrec 9 a
. showString "{" . showsPrec 0 i . showString ",}"
lexer = P.makeTokenParser emptyDef
parens = P.parens lexer
braces = P.braces lexer
brackets = P.brackets lexer
symbol = P.symbol lexer
natural = P.natural lexer
whiteSpace = P.whiteSpace lexer
reserved = P.reserved lexer
boolTerm :: Integral a => Parser (BoolExp a)
boolTerm = BTrue <$ reserved "true"
<|> BFalse <$ reserved "false"
<|> BSelect . fromIntegral <$> natural
<|> parens boolExpr
<?> "boolean term"
boolExpr :: Integral a => Parser (BoolExp a)
boolExpr = buildExpressionParser table boolTerm <?> "boolean expression"
where table =
[ [prefix BNot "!"]
, [binary band' "&"]
, [binary bor' "|"]
]
prefix op str = Prefix (op <$ symbol str)
binary op str = Infix (op <$ symbol str) AssocRight
band' x (BAnd ys) = BAnd (x:ys)
band' (BAnd xs) y = BAnd (xs ++ [y])
band' x y = BAnd [x,y]
bor' x (BOr ys) = BOr (x:ys)
bor' (BOr xs) y = BOr (xs ++ [y])
bor' x y = BOr [x,y]
countTerm :: Integral a => Parser (CntRegex (BoolExp a))
countTerm = CEmpty <$ reserved "empty"
<|> CEpsilon <$ reserved "epsilon"
<|> brackets (CChar <$> boolExpr)
<|> parens countExpr
<?> "count term"
countExpr :: Integral a => Parser (CntRegex (BoolExp a))
countExpr = buildExpressionParser table countTerm <?> "count expression"
where table =
[ [ Postfix postfix ]
, [ Infix (pure cconcat') AssocRight ]
, [ Infix (cunion' <$ symbol "|") AssocRight]
]
postfix = foldr1 (flip (.)) <$> many1 (CStar <$ symbol "*" <|> braces countSpec)
cconcat' x (CConcat ys) = CConcat (x:ys)
cconcat' (CConcat xs) y = CConcat (xs ++ [y])
cconcat' x y = CConcat [x,y]
cunion' x (CUnion ys) = CUnion (x:ys)
cunion' (CUnion xs) y = CUnion (xs ++ [y])
cunion' x y = CUnion [x,y]
countSpec = do
-- there's always a lower bound
lo <- fromIntegral <$> natural
-- there might be an upper bound, possibly empty/unbounded
hi <- optionMaybe (symbol "," *> optionMaybe (fromIntegral <$> natural))
case hi of
-- no comma/bound
Nothing -> pure $ CCount lo lo
-- comma but no bound
Just Nothing -> pure $ CCountUnbounded lo
-- comma and upper bound
Just (Just hi') -> pure $ CCount lo hi'
parseRegex :: Integral a => Parser (CntRegex (BoolExp a))
parseRegex = whiteSpace *> countExpr <* eof
main = do
-- I think this tests all the constructors
let ex1 = "empty{1}** | epsilon*{2,3} [true|!false&15]{4,}*"
let Right val1 = parse parseRegex "<string>" ex1
print (val1 :: CntRegex (BoolExp Int))
putStrLn . pprint $ val1
-- A test for uniform handling of associativity
print $ Right (BOr (replicate 3 (BAnd (map BSelect [5::Int,6,7]))))
== parse boolExpr "" "5 & 6 & 7 | (5 & 6) & 7 | 5 & (6 & 7)"