Exteremely naive CFG parser

CFG.hs

import Data.List qualified as List
import Test.Tasty.Bench.Fit (fit, mkFitConfig)

data CFG = CFG String [(String, [Symbol])]

data Symbol = T Char | NT String

splits :: String -> [(String, String)]
splits [] = [([], [])]
splits (x : xs) = ([], x : xs) : map (\(y, z) -> (x : y, z)) (splits xs)

(!) :: Eq k => [(k, v)] -> k -> [v]
xs ! x = map snd $ filter ((== x) . fst) xs

lfpFrom :: Eq t => t -> (t -> t) -> t
lfpFrom x f = let y = f x in if x == y then x else lfpFrom y f

denoteCFG :: CFG -> String -> Bool
denoteCFG (CFG start g) xs = or $ m ! (start, xs)
  where
    m :: [((String, String), Bool)]
    m =
      lfpFrom
        [((nt, xs'), False) | nt <- nts, xs' <- List.tails xs]
        ( \m' ->
            [ ((nt, xs'), any (\p -> denoteProd p m' xs') (g ! nt))
            | nt <- nts
            , xs' <- List.tails xs
            ]
        )

    nts = List.nub (map fst g)

denoteProd :: [Symbol] -> [((String, String), Bool)] -> String -> Bool
denoteProd [] = \_ xs -> null xs
denoteProd (s : ss) = \m xs -> any (\(y, z) -> denoteSymbol s m y && denoteProd ss m z) (splits xs)

denoteSymbol :: Symbol -> [((String, String), Bool)] -> String -> Bool
denoteSymbol (T c) _ [x] = c == x
denoteSymbol T{} _ _ = False
denoteSymbol (NT nt) m xs = or (m ! (nt, xs))

example :: CFG
example = CFG "E" [("E", [NT "E", T '+', NT "E"]), ("E", [T 'a'])]

main :: IO ()
main = print =<< fit (mkFitConfig (\n -> denoteCFG example ('a' : concat (replicate (fromIntegral n) "+a"))) (0, 80))

Low hanging fruit:

• Replace splits by deterministic mechanism
• Use better (Int)Map/Vector data structures
• Use less naive fixed point (lfpFrom)
• Use Text/ByteString instead of String