[haskell] brzozowski derivative
This commit is contained in:
parent
41eb5cf26a
commit
09ede3acde
|
@ -0,0 +1,95 @@
|
||||||
|
-- {-# LANGUAGE UnicodeSyntax #-}
|
||||||
|
|
||||||
|
-- Brzozowski derivatives
|
||||||
|
|
||||||
|
-- | Type of regexes
|
||||||
|
data Re a
|
||||||
|
= Nil
|
||||||
|
| Eps
|
||||||
|
| Chr a
|
||||||
|
| Cat (Re a) (Re a)
|
||||||
|
| Alt (Re a) (Re a)
|
||||||
|
| Star (Re a)
|
||||||
|
|
||||||
|
instance Show a => Show (Re a) where
|
||||||
|
show r =
|
||||||
|
case r of
|
||||||
|
Nil -> "Nil"
|
||||||
|
Eps -> "Eps"
|
||||||
|
Chr c -> "C " ++ (show c)
|
||||||
|
Cat r1 r2 -> (show r1) ++ "; " ++ (show r2)
|
||||||
|
Alt r1 r2 -> (show r1) ++ "| " ++ (show r2)
|
||||||
|
Star r -> (show r) ++ "* "
|
||||||
|
|
||||||
|
-- | Check if ε can be derived from a regex
|
||||||
|
εderiv :: Eq a => Re a -> Bool
|
||||||
|
εderiv r =
|
||||||
|
case r of
|
||||||
|
Nil -> False
|
||||||
|
Eps -> True
|
||||||
|
Chr _ -> False
|
||||||
|
Cat r1 r2 -> (εderiv r1) && (εderiv r2)
|
||||||
|
Alt r1 r2 -> (εderiv r1) || (εderiv r2)
|
||||||
|
Star _ -> True
|
||||||
|
|
||||||
|
-- | Find Brzozowski derivative of a regex with respect to a letter
|
||||||
|
deriv :: Eq a => a -> Re a -> Re a
|
||||||
|
deriv a r =
|
||||||
|
case r of
|
||||||
|
Nil -> Nil
|
||||||
|
Eps -> Nil
|
||||||
|
Chr c ->
|
||||||
|
if c==a then Eps
|
||||||
|
else Nil
|
||||||
|
Cat r1 r2 ->
|
||||||
|
if εderiv r1 then deriv a r2
|
||||||
|
else Cat (deriv a r1) r2
|
||||||
|
Alt r1 r2 -> Alt (deriv a r1) (deriv a r2)
|
||||||
|
Star rr -> Cat (deriv a rr) (Star rr)
|
||||||
|
|
||||||
|
|
||||||
|
-- | See if a string matches a regex
|
||||||
|
-- exact match only
|
||||||
|
match :: Eq a => [a] -> Re a -> Bool
|
||||||
|
match [] r =
|
||||||
|
if εderiv r then True
|
||||||
|
else False
|
||||||
|
match (x:xs) r =
|
||||||
|
let newr = deriv x r in
|
||||||
|
case newr of
|
||||||
|
Nil -> False
|
||||||
|
_ -> match xs newr
|
||||||
|
-- λ> match "" (Star (Chr 'a'))
|
||||||
|
-- True
|
||||||
|
-- λ> match "aaaaa" (Star (Chr 'a'))
|
||||||
|
-- True
|
||||||
|
-- λ> match "aaaaab" (Star (Chr 'a'))
|
||||||
|
-- False
|
||||||
|
|
||||||
|
-- Couldn't figure out how to make unicode work
|
||||||
|
(/\) = Cat
|
||||||
|
(\/) = Alt
|
||||||
|
-- (@) = Chr
|
||||||
|
|
||||||
|
(|=) :: Eq a => [a] -> Re a -> Bool
|
||||||
|
(|=) = match
|
||||||
|
|
||||||
|
-- lower precedence for smaller numbers
|
||||||
|
-- infixr 7 @
|
||||||
|
infixr 6 /\
|
||||||
|
infixr 5 \/
|
||||||
|
infixr 4 |=
|
||||||
|
|
||||||
|
-- ↑0;(↑1│↑0∗);↑1
|
||||||
|
-- egr1 = Cat (Chr 0) (Cat (Alt (Chr 1) (Chr 2)) (Chr 3))
|
||||||
|
egr1 = (Chr 0) /\ ((Chr 1) \/ (Chr 2)) /\ (Chr 3)
|
||||||
|
-- egr1 = (@ 0) /\ ((Chr 1) \/ (Chr 2)) /\ (Chr 3)
|
||||||
|
-- λ> match [0,2,3] egr1
|
||||||
|
-- True
|
||||||
|
-- λ> match [0,1,3] egr1
|
||||||
|
-- True
|
||||||
|
-- λ> match [0,1,2,3] egr1
|
||||||
|
-- False
|
||||||
|
--
|
||||||
|
-- λ> [0,2,3] |= egr1
|
||||||
|
-- True
|
Loading…
Reference in New Issue