----------------------                                                    -- 001
-- Regular Expressions                                                    -- 002
----------------------                                                    -- 003
                                                                          -- 004
data RE = REEmpty                                                         -- 005
        | REEpsilon                                                       -- 006
        | REChar Char                                                     -- 007
        | REAny                                                           -- 008
        | RESeq RE RE                                                     -- 009
        | REOr RE RE                                                      -- 010
        | REKleene RE                                                     -- 011
                                                                          -- 012
                                                                          -- 013
eval :: RE -> String -> Bool                                              -- 014
                                                                          -- 015
eval REEmpty _ = False                                                    -- 016
                                                                          -- 017
eval REEpsilon s = null s                                                 -- 018
                                                                          -- 019
eval (REChar c) s = (s == [c])                                            -- 020
                                                                          -- 021
eval REAny s = case s of                                                  -- 022
                 [_] -> True                                              -- 023
                 _   -> False                                             -- 024
                                                                          -- 025
eval (REOr e e') s = eval e s || eval e' s                                -- 026
                                                                          -- 027
eval (RESeq e e') s = exists [0..length s] p                              -- 028
  where p i = eval e (take i s) && eval e' (drop i s)                     -- 029
                                                                          -- 030
eval es@(REKleene e) s = null s || exists [1..length s] p                 -- 031
  where p i = eval e (take i s) && eval es (drop i s)                     -- 032
                                                                          -- 033
                                                                          -- 034
exists ::  [a] -> (a -> Bool)-> Bool                                      -- 035
exists [] p = False                                                       -- 036
exists (x:xs) p = p x || exists xs p                                      -- 037
                                                                          -- 038
                                                                          -- 039
----------------------------------------------                            -- 040
-- example: e1 = (b*)a                                                    -- 041
e1 = RESeq (REKleene (REChar 'b')) (REChar 'a')                           -- 042
                                                                          -- 043
                                                                          -- 044
-- [+-]?[01]+                                                             -- 045
e2 =                                                                      -- 046
  let signal = REOr (REChar '+') (REChar '-')                             -- 047
      zeroone = REOr (REChar '0') (REChar '1') in                         -- 048
    RESeq (REOr REEpsilon signal) (RESeq zeroone (REKleene zeroone))      -- 049
                                                                          -- 050
main = print(eval  e1 "bbbbba")                                           -- 051
                                                                          -- 052