Предложения по тому, как сделать этот формат синтаксического анализа более удобным для человека

Question 1

Я работаю над приложением, которое включает регулярные выражения с подсчетом. Кроме того, эти регулярные выражения не обязательно относятся к некоторому фиксированному алфавиту, но относятся к некоторому классу предикатов над битовыми векторами.

Я хотел бы иметь возможность анализировать / разобрать эти объекты. Я придумал что-то, что работает, но меня беспокоит, что в таком виде требуется слишком много паролей, и обычно люди не хотят использовать парные скобки в тех местах, где я строго этого требую. Предложения о том, как я могу сделать все это ближе к человеческому синтаксису, приветствуются.

Также приветствуются общие комментарии по стилям программирования 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
```

Question 2

Разбор с приоритетом

Я так понимаю, вы хотите добавить приоритет своим операторам, чтобы вы могли написать:

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)"

Разбор с приоритетом

Красивая печать с приоритетом

Полная программа

Похожие записи:

Добавить комментарий Отменить ответ