module DeltaRE
where

import Prelude hiding (seq)

data RE a = Zero                -- {}
          | Unit                -- {ε}
          | Dot                 -- whole Alphabet
          | Sym   a             -- {a}
          | Star  (RE a)        -- r*
          | Plus  (RE a)        -- r+
          | Seq   (RE a) (RE a) -- r1 . r2
          | Union (RE a) (RE a) -- r1 | r2
          | Isect (RE a) (RE a) -- r1 & r2
          | Diff  (RE a) (RE a) -- r1 - r2
            deriving (Eq, Ord, Read, Show)

type Regex = RE Char

-- ------------------------------------------------------------

nullable              :: RE a -> Bool

nullable Zero           = False
nullable Unit           = True
nullable Dot            = False
nullable (Sym _x)       = False
nullable (Star _r)      = True
nullable (Plus r)       = nullable r
nullable (Seq r1 r2)    = nullable r1
                          &&
                          nullable r2
nullable (Union r1 r2)  = nullable r1
                          ||
                          nullable r2
nullable (Isect r1 r2)  = nullable r1
                          &&
                          nullable r2
nullable (Diff r1 r2)   = nullable r1
                          &&
                          not (nullable r2)

-- ------------------------------------------------------------

delta :: Eq a => RE a -> a -> RE a

delta Zero _a   = Zero

delta Unit _a   = Zero

delta Dot  _a   = Unit

delta (Sym x) a
  | a == x      = Unit
  | otherwise   = Zero

delta (Star r) a
    = Seq
      (delta r a)
      (Star r)

delta (Plus r) a
    = delta (Seq r (Star r)) a

delta (Seq r1 r2) a
  | nullable r1 = Union dr1 dr2
  | otherwise   = dr1
    where
    dr1 = Seq (delta r1 a) r2
    dr2 = delta r2 a

delta (Union r1 r2) a
    = Union
      (delta r1 a)
      (delta r2 a)

delta (Isect r1 r2) a
    = Isect
      (delta r1 a)
      (delta r2 a)

delta (Diff r1 r2) a
    = Diff
      (delta r1 a)
      (delta r2 a)

-- ------------------------------------------------------------

delta' :: Eq a => RE a -> [a]-> RE a

delta' re []    = re
delta' re (a:w) = delta' (delta re a) w


match :: Eq a => RE a -> [a]-> Bool

match re w = nullable (delta' re w)

-- ------------------------------------------------------------
--
-- readable output

showR :: Regex -> String
showR = showRegex 6

prio    :: RE a -> Int
prio Zero       = 0
prio Unit       = 0
prio Dot        = 0
prio (Sym _)    = 0
prio (Star _)   = 1
prio (Plus _)   = 1
prio (Seq _ _)  = 2
prio (Isect _ _)= 3
prio (Diff _ _) = 4
prio (Union _ _)= 5

showRegex       :: Int -> Regex -> String
showRegex p r
    = par $ (showRegex' r)
    where
    pr  = prio r
    par s
        | pr > p        = "(" ++ s ++ ")"
        | otherwise     = s
    showRegex' Zero     = "{}"
    showRegex' Unit     = "()"
    showRegex' Dot      = "."
    showRegex' (Sym a)
        | a `elem` "\\(){}.*+|&-"  = '\\' : [a]
        | otherwise                = [a]
    showRegex' (Star r1)     = showRegex pr r1 ++ "*"
    showRegex' (Plus r1)     = showRegex pr r1 ++ "+"
    showRegex' (Seq r1 r2)   = showRegex pr r1
                               ++ showRegex pr r2
    showRegex' (Union r1 r2) = showRegex pr r1 ++ "|"
                               ++ showRegex pr r2
    showRegex' (Isect r1 r2) = showRegex pr r1 ++ "&"
                               ++ showRegex pr r2
    showRegex' (Diff  r1 r2) = showRegex pr r1 ++ "-"
                               ++ showRegex pr r2

-- ------------------------------------------------------------