1 -------------------------------------------------- 2 -- $Log: Parsers.hs,v $ 3 -- Revision 1.1 1996/01/08 20:02:55 partain 4 -- Initial revision 5 -- 6 -- Revision 1.3 1994/03/15 15:34:53 thiemann 7 -- minor revisions 8 -- 9 --Revision 1.2 1993/08/31 12:31:32 thiemann 10 --reflect changes in type FONT 11 -- 12 --Revision 1.1 1993/08/17 12:34:29 thiemann 13 --Initial revision 14 -- 15 -- $Locker: $ 16 -------------------------------------------------- 17 module Parsers where 18 19 infixl 6 `using`, `using2` 20 infixr 7 `alt` 21 infixr 8 `thn`, `xthn`, `thnx` 22 23 type Parser a b = [a] -> [(b, [a])] 24 25 succeed :: beta -> Parser alpha beta 26 succeed value tokens = [(value, tokens)] 27 28 -- the parser 29 -- satisfy p 30 -- accepts the language { token | p(token) } 31 32 satisfy :: (alpha -> Bool) -> Parser alpha alpha 33 satisfy p [] = [] 34 satisfy p (token:tokens) | p token = succeed token tokens 35 | otherwise = [] 36 37 -- the parser 38 -- literal word 39 -- accepts { word } 40 41 literal :: Eq alpha => alpha -> Parser alpha alpha 42 literal token = satisfy (== token) 43 44 -- if p1 and p2 are parsers accepting L1 and L2 then 45 -- then p1 p2 46 -- accepts L1.L2 47 48 thn :: Parser alpha beta -> Parser alpha gamma -> Parser alpha (beta, gamma) 49 thn p1 p2 = 50 concat 51 . map (\ (v1, tokens1) -> map (\ (v2, tokens2) -> ((v1,v2), tokens2)) (p2 tokens1)) 52 . p1 53 54 thnx :: Parser alpha beta -> Parser alpha gamma -> Parser alpha beta 55 thnx p1 p2 = 56 concat 57 . map (\ (v1, tokens1) -> map (\ (v2, tokens2) -> (v1, tokens2)) (p2 tokens1)) 58 . p1 59 60 xthn :: Parser alpha beta -> Parser alpha gamma -> Parser alpha gamma 61 xthn p1 p2 = 62 concat 63 . map (\ (v1, tokens1) -> map (\ (v2, tokens2) -> (v2, tokens2)) (p2 tokens1)) 64 . p1 65 66 67 -- if p1 and p2 are parsers accepting L1 and L2 then 68 -- alt p1 p2 69 -- accepts L1 \cup L2 70 71 alt :: Parser alpha beta -> Parser alpha beta -> Parser alpha beta 72 alt p1 p2 tokens = p1 tokens ++ p2 tokens 73 74 -- if p1 is a parser then 75 -- using p1 f 76 -- is a parser that accepts the same language as p1 77 -- but mangles the semantic value with f 78 79 using :: Parser alpha beta -> (beta -> gamma) -> Parser alpha gamma 80 using p1 f = map (\ (v, tokens) -> (f v, tokens)) . p1 81 82 using2 :: Parser a (b,c) -> (b -> c -> d) -> Parser a d 83 using2 p f = map ( \((v,w), tokens) -> (f v w, tokens)) . p 84 85 -- if p accepts L then plus p accepts L+ 86 87 plus :: Parser alpha beta -> Parser alpha [beta] 88 plus p = (p `thn` rpt p) `using2` (:) 89 90 -- if p accepts L then rpt p accepts L* 91 92 rpt :: Parser alpha beta -> Parser alpha [beta] 93 rpt p = plus p `alt` succeed [] 94 95 -- if p accepts L then opt p accepts L? 96 97 opt :: Parser alpha beta -> Parser alpha [beta] 98 opt p = (p `using` \x -> [x]) `alt` succeed [] 99 100 -- followedBy p1 p2 recognizes L(p1) if followed by a word in L (p2) 101 102 followedBy :: Parser a b -> Parser a c -> Parser a b 103 followedBy p q tks = [(v, rest) | (v, rest) <- p tks, x <- q rest]