Обработка концевых паттернов после чего-то вроде `. *` При построении движка регулярных выражений - PullRequest
0 голосов
/ 22 сентября 2019

Я попытался реализовать движок регулярных выражений с использованием комбинаторов синтаксического анализа в Haskell.

Идея состоит в том, чтобы сначала проанализировать шаблон для построения синтаксического анализатора регулярных выражений, а затем использовать анализатор для синтаксического анализа входного текста.

Но мой код не может обработать этот сценарий: если шаблон похож на a?(a|b).*h+, то h+ после .* никогда не будет удовлетворен, так как часть .* будет использовать все входные данные.

(Обычно <|> реализован с помощью функции try, из-за эффективности. Но здесь я не думаю, что это так.

Ниже мой код

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Matcher where

import           Data.Function (on)
import           Data.Functor (($>))
import           Control.Monad
import           Control.Applicative

newtype Parser a = Parser { runParser :: String -> Maybe (a, String) }

parse :: Parser a -> String -> Maybe a
parse parser inp = case runParser parser inp of
  Just (a, []) -> Just a
  _ -> Nothing

instance Functor Parser where
  fmap t (Parser g) = Parser $ \inp -> fmap (\(a, inp') -> (t a, inp')) (g inp)

instance Applicative Parser where
  pure a = Parser $ \inp -> Just (a, inp)

  (Parser f) <*> (Parser g) = Parser
    $ \inp -> case f inp of
      Nothing        -> Nothing
      Just (t, inp') -> case g inp' of
        Nothing         -> Nothing
        Just (a, inp'') -> Just (t a, inp'')

instance Alternative Parser where
  empty = Parser $ const Nothing

  (Parser f) <|> (Parser g) = Parser
    $ \inp -> case f inp of
      Nothing -> g inp
      Just r  -> Just r

  some p = (:) <$> p <*> (some p <|> pure [])

instance Monad Parser where
  (Parser f) >>= g = Parser
    $ \inp -> case f inp of
      Nothing        -> Nothing
      Just (a, inp') -> runParser (g a) inp'

satisfy p = Parser
  $ \case
    (x:xs)
      | p x -> Just (x, xs)
    _      -> Nothing

char :: Char -> Parser Char
char c = satisfy (== c)

string :: String -> Parser String
string "" = pure ""
string (c:cs) = do
  char c
  string cs
  return (c:cs)

between :: Parser a -> Parser b -> Parser c -> Parser b
between left content right = left *> content <* right

unit :: Parser (Parser String)
unit = (do
          c <- satisfy (`notElem` ['.', '*', '?', '+', '(', ')', '|'])
          return $ fmap (:[]) (char c))
  <|> (char '.' $> fmap (:[]) (satisfy (const True)))
  <|> oneOf

oneOf :: Parser (Parser String)
oneOf = between (char '(') content (char ')')
  where
    content = do
      p1 <- unit
      rest <- many $ char '|' *> unit
      return $ foldr (<|>) p1 rest

oneOrMore :: Parser (Parser String)
oneOrMore = do
  arp <- unit
  char '+'
  return $ fmap concat (some arp)

zeroOrMore :: Parser (Parser String)
zeroOrMore = do
  arp <- unit
  char '*'
  return $ fmap concat (many arp)

zeroOrOne :: Parser (Parser String)
zeroOrOne = do
  arp <- unit
  char '?'
  return $ arp <|> pure ""

reg :: Parser (Parser String)
reg = fmap
  (foldr (liftA2 (++)) (pure ""))
  (some $ zeroOrMore <|> zeroOrOne <|> oneOrMore <|> unit)

createRegParser :: String -> Maybe (Parser String)
createRegParser = parse reg

example = createRegParser "a?(a|b).*h+"
...