-- ------------------------------------------------------------ {- | Module : Text.XML.HXT.DTDValidation.RE Copyright : Copyright (C) 2008 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de) Stability : experimental Portability: portable A module for regular expression matching based on derivatives of regular expressions. The code was taken from Joe English (). Tested and extended by Martin Schmidt. Further references for the algorithm: Janusz A. Brzozowski. Derivatives of Regular Expressions. Journal of the ACM, Volume 11, Issue 4, 1964. Mark Hopkins. Regular Expression Package. Posted to comp.compilers, 1994. Available per FTP at . -} -- ------------------------------------------------------------ module Text.XML.HXT.DTDValidation.RE ( RE(..) , re_unit , re_zero , re_sym , re_rep , re_plus , re_opt , re_seq , re_alt , re_dot , checkRE , matches , nullable , printRE ) where import Data.List (foldl') -- | -- Data type for regular expressions. data RE a = RE_ZERO String --' L(0) = {} (empty set) | RE_UNIT --' L(1) = { [] } (empty sequence) | RE_SYM a --' L(x) = { [x] } | RE_DOT --' accept any single symbol | RE_REP (RE a) --' L(e*) = { [] } `union` L(e+) | RE_PLUS (RE a) --' L(e+) = { x ++ y | x <- L(e), y <- L(e*) } | RE_OPT (RE a) --' L(e?) = L(e) `union` { [] } | RE_SEQ (RE a) (RE a) --' L(e,f) = { x ++ y | x <- L(e), y <- L(f) } | RE_ALT (RE a) (RE a) --' L(e|f) = L(e) `union` L(f) deriving (Show, Eq, Ord) -- ------------------------------------------------------------ -- Constructor functions to simplify regular expressions when constructing them. -- | -- Constructs a regular expression for an empty set. -- -- * 1.parameter errMsg : error message -- -- - returns : regular expression for an empty set re_zero :: String -> RE a re_zero m = RE_ZERO m -- | -- Constructs a regular expression for an empty sequence. -- -- - returns : regular expression for an empty sequence re_unit :: RE a re_unit = RE_UNIT -- | -- Constructs a regular expression for accepting a symbol -- -- * 1.parameter sym : the symbol to be accepted -- -- - returns : regular expression for accepting a symbol re_sym :: a -> RE a re_sym x = RE_SYM x -- | -- Constructs a regular expression for accepting any singel symbol -- -- - returns : regular expression for accepting any singel symbol re_dot :: RE a re_dot = RE_DOT -- | -- Constructs an optional repetition (*) of a regular expression -- -- * 1.parameter re_a : regular expression to be repeted -- -- - returns : new regular expression re_rep :: RE a -> RE a re_rep RE_UNIT = RE_UNIT re_rep (RE_ZERO _) = RE_UNIT re_rep e@(RE_REP _) = RE_REP (rem_rep e) -- remove nested reps re_rep e@(RE_ALT _ _) = RE_REP (rem_rep e) -- remove nested reps in alternatives re_rep e = RE_REP e -- | -- remove redundant nested *'s in RE -- theoretically this is unneccessary, -- but without this simplification the runtime can increase exponentally -- when computing deltas, e.g. for a** or (a|b*)* which is the same as (a|b)* rem_rep :: RE a -> RE a rem_rep (RE_ALT RE_UNIT e2) = e2 rem_rep (RE_ALT e1 e2) = RE_ALT (rem_rep e1) (rem_rep e2) rem_rep (RE_REP e1) = rem_rep e1 rem_rep e1 = e1 -- | -- Constructs a repetition (+) of a regular expression -- -- * 1.parameter re_a : regular expression to be repeted -- -- - returns : new regular expression re_plus :: RE a -> RE a re_plus RE_UNIT = RE_UNIT re_plus (RE_ZERO m) = RE_ZERO m re_plus e | nullable e = re_rep e -- nullable e => e+ == e* | otherwise = re_seq e (re_rep e) -- | -- Constructs an option (?) of a regular expression -- -- * 1.parameter re_a : regular expression to be optional -- -- - returns : new regular expression re_opt :: (Ord a) => RE a -> RE a re_opt RE_UNIT = RE_UNIT re_opt (RE_ZERO _) = RE_UNIT re_opt e = re_alt RE_UNIT e -- | -- Constructs a sequence (,) of two regular expressions -- -- * 1.parameter re_a : first regular expression in sequence -- -- - 2.parameter re_b : second regular expression in sequence -- -- - returns : new regular expression re_seq :: RE a -> RE a -> RE a re_seq e1@(RE_ZERO _) _ = e1 -- simplification re_seq RE_UNIT e2 = e2 -- simplification re_seq _ e2@(RE_ZERO _) = e2 -- simplification re_seq e1 RE_UNIT = e1 -- simplification re_seq (RE_SEQ e11 e12) e2 = re_seq e11 (re_seq e12 e2) -- right assoc. re_seq e1 e2 = RE_SEQ e1 e2 -- | -- Constructs an alternative (|) of two regular expressions -- -- * 1.parameter re_a : first regular expression of alternative -- -- - 2.parameter re_b : second regular expression of alternative -- -- - returns : new regular expression re_alt :: (Ord a) => RE a -> RE a -> RE a re_alt (RE_ZERO _) e2 = e2 re_alt e1 (RE_ZERO _) = e1 re_alt (RE_ALT e11 e12) e2 = re_alt e11 (re_alt e12 e2) -- is right assoc re_alt e1 e2@(RE_ALT e21 e22) | e1 == e21 = e2 -- duplicates removed, the effective rule | e1 > e21 = re_alt e21 (re_alt e1 e22) -- sort alternatives | otherwise = RE_ALT e1 e2 re_alt e1 e2 | e1 == e2 = e2 -- simplification, the effective rule | e1 > e2 = re_alt e2 e1 -- sort alts for unique repr. | otherwise = RE_ALT e1 e2 -- ------------------------------------------------------------ -- | -- Checks if a regular expression matches the empty sequence. -- -- nullable e == [] `in` L(e) -- -- This check indicates if a regular expression fits to a sentence or not. -- -- * 1.parameter re : regular expression to be checked -- -- - returns : true if regular expression matches the empty sequence, -- otherwise false nullable :: RE a -> Bool nullable (RE_ZERO _) = False nullable RE_UNIT = True nullable (RE_SYM _) = False nullable (RE_REP _) = True nullable (RE_PLUS e) = nullable e nullable (RE_OPT _) = True nullable (RE_SEQ e f) = nullable e && nullable f nullable (RE_ALT e f) = nullable e || nullable f nullable RE_DOT = False -- | -- Derives a regular expression with respect to one symbol. -- -- L(delta e x) = x \ L(e) -- -- * 1.parameter re : regular expression to be derived -- -- - 2.parameter sym : the symbol on which the regular expression is applied -- -- - returns : the derived regular expression delta :: (Ord a, Show a) => RE a -> a -> RE a delta re x = case re of RE_ZERO _ -> re -- re_zero m RE_UNIT -> re_zero ("Symbol " ++ show x ++ " unexpected.") RE_SYM sym | x == sym -> re_unit | otherwise -> re_zero ("Symbol " ++ show sym ++ " expected, but symbol " ++ show x ++ " found.") RE_REP e -> re_seq (delta e x) re -- (re_rep e) RE_PLUS e -> re_seq (delta e x) (re_rep e) RE_OPT e -> delta e x RE_SEQ e f | nullable e -> re_alt (re_seq (delta e x) f) (delta f x) | otherwise -> re_seq (delta e x) f RE_ALT e f -> re_alt (delta e x) (delta f x) RE_DOT -> re_unit -- | -- Derives a regular expression with respect to a sentence. -- -- * 1.parameter re : regular expression -- -- - 2.parameter s : sentence to which the regular expression is applied -- -- - returns : the derived regular expression matches :: (Ord a, Show a) => RE a -> [a] -> RE a matches e = foldl' delta e -- | -- Checks if an input matched a regular expression. The function should be -- called after matches. -- -- Was the sentence used in @matches@ in the language of the regular expression? -- -> matches e s == s `in` L(e)? -- -- * 1.parameter re : the derived regular expression -- -- - returns : empty String if input matched the regular expression, otherwise -- an error message is returned checkRE :: (Eq a, Show a) => RE a -> String checkRE (RE_UNIT) = "" checkRE (RE_ZERO m) = m checkRE re | nullable re = "" | otherwise = "Input must match " ++ printRE re -- ------------------------------------------------------------ -- | -- Constructs a string representation of a regular expression. -- -- * 1.parameter re : a regular expression -- -- - returns : the string representation of the regular expression printRE :: (Eq a, Show a) => RE a -> String printRE re' = "( " ++ printRE1 re' ++ " )" where -- printRE1 :: (Eq a, Show a) => RE a -> String printRE1 re = case re of RE_ZERO m -> "ERROR: " ++ m RE_UNIT -> "" RE_SYM sym -> show sym RE_DOT -> "." RE_REP e | isSingle e -> printRE1 e ++ "*" | otherwise -> "(" ++ printRE1 e ++ ")*" RE_PLUS e | isSingle e -> printRE1 e ++ "+" | otherwise -> "(" ++ printRE1 e ++ ")+" RE_OPT e | isSingle e -> printRE1 e ++ "?" | otherwise -> "(" ++ printRE1 e ++ ")?" RE_SEQ e1 (RE_REP e2) | e1 == e2 -> printRE1 (RE_PLUS e1) RE_SEQ e1 (RE_SEQ (RE_REP e2) e3) | e1 == e2 -> printRE1 (RE_SEQ (RE_PLUS e1) e3) RE_SEQ e f | isAlt e && not (isAlt f) -> "(" ++ printRE1 e ++ ") , " ++ printRE1 f | not (isAlt e) && isAlt f -> printRE1 e ++ " , (" ++ printRE1 f ++ ")" | isAlt e && isAlt f -> "(" ++ printRE1 e ++ ") , (" ++ printRE1 f ++ ")" | otherwise -> printRE1 e ++ " , " ++ printRE1 f RE_ALT RE_UNIT f -> printRE1 (RE_OPT f) RE_ALT e f | isSeq e && not (isSeq f) -> "(" ++ printRE1 e ++ ") | " ++ printRE1 f | not (isSeq e) && isSeq f -> printRE1 e ++ " | (" ++ printRE1 f ++ ")" | isSeq e && isSeq f -> "(" ++ printRE1 e ++ ") | (" ++ printRE1 f ++ ")" | otherwise -> printRE1 e ++ " | " ++ printRE1 f isSingle :: RE a -> Bool isSingle (RE_ZERO _) = True isSingle RE_UNIT = True isSingle (RE_SYM _) = True isSingle _ = False isSeq :: (Eq a) => RE a -> Bool isSeq (RE_SEQ e1 (RE_REP e2)) | e1 == e2 = False -- is transformed back into RE_PLUS isSeq (RE_SEQ _ _) = True isSeq _ = False isAlt :: RE a -> Bool isAlt (RE_ALT RE_UNIT _)= False -- is transformed back into a RE_OPT isAlt (RE_ALT _ _) = True isAlt _ = False