1 module ParseLib where 2 3 import Char 4 5 type Parser a = String -> [(a, String)] 6 7 -- Trivial Parser: 8 9 empty :: Parser [a] 10 empty = (\x -> [([], x)]) 11 12 -- Parser Generators: 13 14 character' :: Char -> Parser Char 15 character' c x | null x = [] 16 | c == head x = [(head x, tail x)] 17 | otherwise = [] 18 19 parse_if' :: (Char -> Bool) -> Parser Char 20 parse_if' p x | null x = [] 21 | p (head x) = [(head x, tail x)] 22 | otherwise = [] 23 24 string' :: String -> Parser String 25 string' s x | s == fst split = [split] 26 | otherwise = [] 27 where 28 split = splitAt (length s) x 29 30 parse_while' :: (Char -> Bool) -> Parser String 31 parse_while' p x | null x = [] 32 | p (head x) = [span p x] 33 | otherwise = [] 34 35 -- Elementary Parser Combinators: 36 37 choice :: [Parser r] -> Parser r 38 choice ps x = [r | p <- ps, r <- p x] 39 40 sequence2 :: Parser r1 -> Parser r2 -> Parser (r1, r2) 41 sequence2 p1 p2 x0 = [((r1, r2), x2) | (r1, x1) <- p1 x0, (r2, x2) <- p2 x1] 42 43 sequence3 :: Parser r1 -> Parser r2 -> Parser r3 -> Parser (r1, r2, r3) 44 sequence3 p1 p2 p3 x0 = [((r1, r2, r3), x3) | (r1, x1) <- p1 x0, (r2, x2) <- p2 x1, (r3, x3) <- p3 x2] 45 46 -- Parser Transformers: 47 48 transform :: (a -> b) -> Parser a -> Parser b 49 transform f p s = [(f r, x) | (r, x) <- p s] 50 51 allow_null :: Parser [a] -> Parser [a] 52 allow_null p x | null result = [([], x)] 53 | otherwise = result 54 where 55 result = p x 56 57 forbid_null :: Parser [a] -> Parser [a] 58 forbid_null p = filter (\(r, x) -> (not . null) r) . p 59 60 -- More Parser Combinators: 61 62 cons :: Parser a -> Parser [a] -> Parser [a] 63 cons p ps = transform (\(a, as) -> a : as) (sequence2 p ps) 64 65 repetition0 :: Parser a -> Parser [a] 66 repetition0 p = allow_null (cons p (repetition0 p)) 67 68 repetition1 :: Parser a -> Parser [a] 69 repetition1 p = (cons p (repetition0 p)) 70 71 option :: Parser a -> Parser [a] 72 option p = choice [transform (\a -> [a]) p, empty] 73 74 -- Parser Combinators: 75 76 remove_left :: Parser a -> Parser b -> Parser b 77 remove_left p1 p2 = transform snd (sequence2 p1 p2) 78 79 remove_right :: Parser a -> Parser b -> Parser a 80 remove_right p1 p2 = transform fst (sequence2 p1 p2) 81 82 enclose :: Parser a -> Parser b -> Parser c -> Parser b 83 enclose p1 p2 p3 = transform take_mid (sequence3 p1 p2 p3) 84 where 85 take_mid (a, b, c) = b 86 87 glue :: Parser a -> Parser b -> Parser c -> Parser (a, c) 88 glue p1 p2 p3 = transform drop_mid (sequence3 p1 p2 p3) 89 where 90 drop_mid (a, b, c) = (a, c) 91 92 -- Elementary Parser: 93 94 whitespace :: Parser String 95 whitespace = allow_null (parse_while' isSpace) 96 97 -- More Parser Generators: 98 99 character :: Char -> Parser Char 100 character c = remove_left whitespace (character' c) 101 102 parse_if :: (Char -> Bool) -> Parser Char 103 parse_if p = remove_left whitespace (parse_if' p) 104 105 string :: String -> Parser String 106 string s = remove_left whitespace (string' s) 107 108 parse_while :: (Char -> Bool) -> Parser String 109 parse_while p = remove_left whitespace (parse_while' p) 110 111 -- Final routine: 112 113 parse :: Parser a -> String -> [a] 114 parse parser = map fst . filter (null . snd) . parser