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