Brzozowski derivatives are neat, but good old denotational semantics of regular expressions can be very elegant too:

data RE = Empty | Eps | Ch Char | App RE RE | Alt RE RE | Star RE

foldRE :: p -> p -> (Char -> p) -> (p -> p -> p) -> (p -> p -> p) -> (p -> p) -> RE -> p
foldRE emp eps ch app alt star = go where
  go = \case
    Empty -> emp
    Eps -> eps
    Ch c -> ch c
    App p q -> app (go p) (go q)
    Alt p q -> alt (go p) (go q)
    Star p -> star (go p)

recognise :: RE -> String -> [String]
recognise =
  foldRE (pure empty) pure (\c -> \case x : xs | c == x -> [xs]; _ -> [])
    (>=>) (liftA2 (<|>)) (\p -> fix (\t -> liftA2 (<|>) pure (p >=> t)))

#haskell

  • jaror@kbin.socialOP
    link
    fedilink
    arrow-up
    1
    ·
    1 year ago

    Of course StateT is perhaps more common and as elegant as Kleisli:

    recognise :: RE -> StateT String [] ()
    recognise =
      foldRE empty (pure ()) ch (*>) (&lt;|>) (\p -> fix (\t -> p *> t &lt;|> pure ())) where
        ch c = StateT (\case x : xs | c == x -> [((), xs)]; _ -> [])
    
    
      • jaror@kbin.socialOP
        link
        fedilink
        arrow-up
        1
        ·
        1 year ago

        @mangoiv perhaps it is slightly easier to read like this?

        data RE = Empty | Eps | Ch Char | App RE RE | Alt RE RE | Star RE
        
        data REalg a = REalg
          { emp :: a
          , eps :: a
          , ch :: Char -> a
          , app :: a -> a -> a
          , alt :: a -> a -> a
          , star :: a -> a
          }
        
        foldRE :: REalg a -> RE -> a
        foldRE alg = go where
          go = \case
            Empty -> emp alg
            Eps -> eps alg
            Ch c -> ch alg c
            App p q -> app alg (go p) (go q)
            Alt p q -> alt alg (go p) (go q)
            Star p -> star alg (go p)
        
        recognise :: RE -> StateT String [] ()
        recognise = foldRE REalg
          { emp = empty
          , eps = pure ()
          , ch = \c -> StateT (\case x : xs | c == x -> [((), xs)]; _ -> [])
          , app = (*>)
          , alt = (&lt;|>)
          , star = \p -> fix (\t -> p *> t &lt;|> pure ())
          }