-- BNFC 3 -- (C) 2021 Andreas Abel -- | Converting back to and forth from LBNF regular regular expression. module BNFC.Check.Regex ( normRegex , ReifyRegex(reifyRegex) ) where import BNFC.Prelude import BNFC.Types.Regex import qualified BNFC.Abs as A -- | Convert LBNF regular expression into internal format. normRegex :: A.Reg -> Regex normRegex = \case -- Character classes A.RChar _ c -> rChar c A.RDigit _ -> RChar $ cDigit A.RLetter _ -> RChar $ cLetter A.RUpper _ -> RChar $ cUpper A.RLower _ -> RChar $ cLower A.RAny _ -> RChar $ cAny A.RAlts _ cs -> RChar $ cAlts cs -- Sum, difference A.RAlt _ r1 r2 -> normRegex r1 `rAlt` normRegex r2 A.RMinus _ r1 r2 -> normRegex r1 `rMinus` normRegex r2 -- Sequences A.RSeq _ r1 r2 -> normRegex r1 `rSeq` normRegex r2 A.RSeqs _ cs -> rSeqs $ map rChar cs A.REps _ -> REps -- Iteration A.RStar _ r -> rStar $ normRegex r A.RPlus _ r -> rPlus $ normRegex r A.ROpt _ r -> rOpt $ normRegex r -- | Convert from internal format to LBNF regular expression. class ReifyRegex a where reifyRegex :: a -> A.Reg instance ReifyRegex Regex where reifyRegex = \case RChar c -> reifyRegex c REps -> A.REps nop RStar r -> A.RStar nop $ reifyRegex r RPlus r -> A.RPlus nop $ reifyRegex r ROpt r -> A.ROpt nop $ reifyRegex r -- left associative: RAlts (List2 r1 r2 rs) -> foldl arAlt (reifyRegex r1 `arAlt` reifyRegex r2) $ map reifyRegex rs RSeqs (List2 r1 r2 rs) -> foldl arSeq (reifyRegex r1 `arSeq` reifyRegex r2) $ map reifyRegex rs RMinus r1 r2 -> reifyRegex r1 `arMinus` reifyRegex r2 arAlt, arSeq, arMinus :: A.Reg' (Maybe a) -> A.Reg' (Maybe a) -> A.Reg' (Maybe a) arAlt = A.RAlt nop arSeq = A.RSeq nop arMinus = A.RMinus nop nop :: Maybe a nop = Nothing instance ReifyRegex CharClass where reifyRegex (CMinus p m) | m == mempty = reifyRegex p | p == mempty = A.RAlts nop "" | otherwise = reifyRegex p `arMinus` reifyRegex m instance ReifyRegex CharClassUnion where reifyRegex CAny = A.RAny nop reifyRegex (CAlt cs) = case rs of [] -> A.RAlts nop "" [r] -> r rss -> foldr1 arAlt rss where -- collect elements of cs into St start = St False False False [] step st = \case CChar c -> st { stAlts = c : stAlts st } CDigit -> st { stDigit = True } CLower -> st { stLower = True } CUpper -> st { stUpper = True } (St digit upper lower alts) = foldr (flip step) start cs rs = concat [ [ A.RChar nop c | [c] <- [alts] ] , [ A.RAlts nop alts | (_:_:_) <- [alts] ] , [ A.RDigit nop | digit ] , [ A.RLetter nop | upper && lower ] , [ A.RUpper nop | upper && not lower ] , [ A.RLower nop | lower && not upper ] ] -- Local state type data St = St { stDigit, stUpper, stLower :: Bool, stAlts :: String }