1 module Main where 2 3 import Parsers 4 import System -- 1.3 (partain) 5 import IO--1.3 6 7 infixr 8 +.+ , +.. , ..+ 8 infixl 7 <<< , <<* 9 infixr 6 ||| 10 11 (+.+) = thn 12 (..+) = xthn 13 (+..) = thnx 14 (|||) = alt 15 (<<<) = using 16 (<<*) = using2 17 lit :: Eq a => a -> Parser a a 18 lit = literal 19 star = rpt 20 anyC = satisfy (const True) 21 butC cs = satisfy (not.(`elem` cs)) 22 noC "" = [("","")] 23 noC _ = [] 24 25 26 27 main = getArgs >>= \ args -> parse_args args 28 29 parse_args :: [String] -> IO () 30 parse_args (regexp: files) = 31 let acc = acceptor (fst(head(nnRegexp regexp))) 32 acc' = unlines . filter acc . lines 33 in 34 getContents >>= \ inp -> 35 putStr (acc' inp) 36 parse_args _ = 37 getProgName >>= \progName -> 38 hPutStr stderr ("Usage: " ++ progName ++ " regexp\n") 39 40 41 42 43 44 45 46 47 data NFANode 48 = NFAChar Char NFANode 49 | NFAAny NFANode 50 | NFAEps [NFANode] 51 | NFAEnd NFANode 52 | NFAFinal 53 | NFATable [(Char, NFANode)] [NFANode] [NFANode] Bool 54 55 56 57 58 59 60 61 62 63 64 65 66 nfaChar = NFAChar 67 nfaAny = NFAAny 68 -- nfaEps = NFAEps 69 nfaEps = mkTable [] [] [] False . epsClosure 70 nfaEnd = NFAEnd 71 nfaFinal= NFAFinal 72 73 74 75 76 mkTable pairs anys ends final [] = NFATable pairs anys ends final 77 mkTable pairs anys ends final (NFAChar c n:ns) = mkTable ((c,n):pairs) anys ends final ns 78 mkTable pairs anys ends final (NFAAny n:ns) = mkTable pairs (n:anys) ends final ns 79 mkTable pairs anys ends final (NFATable pairs' anys' ends' final':ns) = mkTable (pairs'++pairs) (anys'++anys) (ends'++ends) (final' || final) ns 80 mkTable pairs anys ends final (NFAEnd n:ns) = mkTable pairs anys (n:ends) final ns 81 mkTable pairs anys ends final (NFAFinal:ns) = mkTable pairs anys ends True ns 82 mkTable _ _ _ _ _ = error "illegal argument to mkTable" 83 84 type NFAproducer = NFANode -> NFANode 85 86 87 88 89 nnAtom :: Parser Char NFAproducer 90 nnAtom = 91 lit '\\' ..+ lit '(' ..+ nnRegexp +.. lit '\\' +.. lit ')' 92 ||| lit '\\' ..+ butC "|()" <<< nfaChar 93 ||| lit '.' <<< const NFAAny 94 ||| butC "\\.$" <<< nfaChar 95 ||| lit '$' `followedBy` anyC <<< nfaChar 96 97 nnExtAtom :: Parser Char NFAproducer 98 nnExtAtom = 99 nnAtom +.+ opt (lit '*' <<< const (\ at final -> 100 let at_init = at (nfaEps [final, at_init]) 101 in nfaEps [at_init, final]) 102 ||| lit '+' <<< const (\ at final -> 103 let at_init = at (nfaEps [final, at_init]) 104 in nfaEps [at_init]) 105 ||| lit '?' <<< const (\ at final -> 106 let at_init = at (nfaEps [final]) 107 in nfaEps [final, at_init])) 108 <<< helper 109 where 110 helper (ea, []) = ea 111 helper (ea, [f]) = f ea 112 113 nnFactor :: Parser Char NFAproducer 114 nnFactor = 115 plus nnExtAtom <<< foldr (.) id 116 117 nnRegexp :: Parser Char NFAproducer 118 nnRegexp = 119 nnFactor +.+ star (lit '\\' ..+ lit '|' ..+ nnFactor) +.+ opt (lit '$') 120 <<< helper 121 where 122 helper (ef, (efs, [])) = foldl combine ef efs 123 helper (ef, (efs, _ )) = foldl combine ef efs . nfaEnd 124 combine f1 f2 final = nfaEps [f1 final, f2 final] 125 126 127 128 129 130 nfaStep states c = {- epsClosure -} (concat (map step states)) 131 where 132 step (NFAChar c' n') | c == c' = [n'] 133 step (NFAAny n') = [n'] 134 step (NFATable pairs anys ends finals) = [ n' | (c',n') <- pairs, c == c' ] ++ anys 135 step _ = [] 136 137 138 139 epsClosure [] = [] 140 epsClosure (NFAEps ns:ns') = epsClosure (ns++ns') 141 epsClosure (n:ns) = n:epsClosure ns 142 143 acceptor :: NFAproducer -> String -> Bool 144 acceptor nfa str = nfaRun ( {- epsClosure -} [nfa nfaFinal]) str 145 146 147 148 nfaRun :: [NFANode] -> String -> Bool 149 nfaRun ns (c:cs) = nfaRun (nfaStep ns c) cs 150 nfaRun ns [] = not (null ( {- epsClosure -} (concat (map step ns)))) 151 where 152 step (NFAEnd n') = [n'] 153 step (NFAFinal) = [NFAFinal] 154 step (NFATable pairs anys ends True) = [NFAFinal] 155 step (NFATable pairs anys ends finals) = ends 156 step _ = [] 157