>
> module Text.Regex.PDeriv.RE where
> import Data.List (nub)
> import Data.Char (chr)
> import Text.Regex.PDeriv.Common (IsEmpty(..), IsGreedy(..), GFlag(..))
> import Text.Regex.PDeriv.Dictionary (Key(..), primeL, primeR)
------------------------
>
> data RE = Phi
> | Empty
> | L Char
> | Choice RE RE GFlag
> | Seq RE RE
> | Star RE GFlag
> | Any
> | Not [Char]
>
> instance Eq RE where
> (==) Empty Empty = True
> (==) (L x) (L y) = x == y
> (==) (Choice r1 r2 g1) (Choice r3 r4 g2) = (g1 == g2) && (r2 == r4) && (r1 == r3)
> (==) (Seq r1 r2) (Seq r3 r4) = (r1 == r3) && (r2 == r4)
> (==) (Star r1 g1) (Star r2 g2) = g1 == g2 && r1 == r2
> (==) Any Any = True
> (==) (Not cs) (Not cs') = cs == cs'
> (==) _ _ = False
>
> instance Show RE where
> show Phi = "{}"
> show Empty = "<>"
> show (L c) = show c
> show (Choice r1 r2 g) = "(" ++ show r1 ++ "|" ++ show r2 ++ ")" ++ show g
> show (Seq r1 r2) = "<" ++ show r1 ++ "," ++ show r2 ++ ">"
> show (Star r g) = show r ++ "*" ++ show g
> show Any = "."
> show (Not cs) = "[^" ++ cs ++ "]"
> instance IsGreedy RE where
> isGreedy Phi = True
> isGreedy Empty = False
> isGreedy (Choice r1 r2 Greedy) = True
> isGreedy (Choice r1 r2 NotGreedy) = False
> isGreedy (Seq r1 r2) = (isGreedy r1) || (isGreedy r2)
> isGreedy (Star r Greedy) = True
> isGreedy (Star r NotGreedy) = False
> isGreedy (L _) = True
> isGreedy Any = True
> isGreedy (Not _) = True
> instance Key RE where
> hash Phi = [0]
> hash Empty = [1]
> hash (Choice r1 r2 Greedy) = [3]
> hash (Choice r1 r2 NotGreedy) = [4]
> hash (Seq r1 r2) = [5]
> hash (Star r Greedy) = [6]
> hash (Star r NotGreedy) = [7]
> hash (L c) = [8]
> hash Any = [2]
> hash (Not _) = [9]
>
> resToRE :: [RE] -> RE
> resToRE (r:res) = foldl (\x y -> Choice x y Greedy) r res
> resToRE [] = Phi
>
> instance IsEmpty RE where
> isEmpty Phi = False
> isEmpty Empty = True
> isEmpty (Choice r1 r2 g) = (isEmpty r1) || (isEmpty r2)
> isEmpty (Seq r1 r2) = (isEmpty r1) && (isEmpty r2)
> isEmpty (Star r g) = True
> isEmpty (L _) = False
> isEmpty Any = False
> isEmpty (Not _) = False
>
> partDeriv :: RE -> Char -> [RE]
> partDeriv r l = nub (partDerivSub r l)
> partDerivSub Phi l = []
> partDerivSub Empty l = []
> partDerivSub (L l') l
> | l == l' = [Empty]
> | otherwise = []
> partDerivSub Any l = [Empty]
> partDerivSub (Not cs) l
> | l `elem` cs = []
> | otherwise = [Empty]
> partDerivSub (Choice r1 r2 g) l =
> let
> s1 = partDerivSub r1 l
> s2 = partDerivSub r2 l
> in (s1 ++ s2)
> partDerivSub (Seq r1 r2) l
> | isEmpty r1 =
> let
> s0 = partDerivSub r1 l
> s1 = s0 `seq` [ (Seq r1' r2) | r1' <- s0 ]
> s2 = partDerivSub r2 l
> in (s1 ++ s2)
> | otherwise =
> let
> s0 = partDerivSub r1 l
> in [ (Seq r1' r2) | r1' <- s0 ]
> partDerivSub (Star r g) l =
> let
> s0 = partDerivSub r l
> in [ (Seq r' (Star r g)) | r' <- s0 ]
>
> sigmaRE :: RE -> [Char]
> sigmaRE r = let s = (sigmaREsub r)
> in s `seq` nub s
> sigmaREsub (L l) = [l]
> sigmaREsub Any = map chr [32 .. 127]
> sigmaREsub (Not cs) = filter (\c -> not (c `elem` cs)) (map chr [32 .. 127])
> sigmaREsub (Seq r1 r2) = (sigmaREsub r1) ++ (sigmaREsub r2)
> sigmaREsub (Choice r1 r2 g) = (sigmaREsub r1) ++ (sigmaREsub r2)
> sigmaREsub (Star r g) = sigmaREsub r
> sigmaREsub Phi = []
> sigmaREsub Empty = []