1 -----------------------------------------------------------
2 -- Daan Leijen (c) 2000, daan@cs.uu.nl
3 -----------------------------------------------------------
6 import Text.ParserCombinators.Parsec
7 import Text.ParserCombinators.Parsec.Expr
8 import Text.ParserCombinators.Parsec.Token
9 import Text.ParserCombinators.Parsec.Language
13 -----------------------------------------------------------
15 -----------------------------------------------------------
16 run :: Show a => Parser a -> String -> IO ()
18 = case (parse p "" input) of
19 Left err -> do{ putStr "parse error at "
25 runLex :: Show a => Parser a -> String -> IO ()
27 = run (do{ whiteSpace lang
34 -----------------------------------------------------------
35 -- Sequence and choice
36 -----------------------------------------------------------
40 openClose :: Parser Char
41 openClose = do{ char '('
46 matching= do{ char '('
55 testOr = do{ char '('; char 'a'; char ')' }
56 <|> do{ char '('; char 'b'; char ')' }
58 testOr1 = do{ char '('
59 ; char 'a' <|> char 'b'
63 testOr2 = try (do{ char '('; char 'a'; char ')' })
64 <|> do{ char '('; char 'b'; char ')' }
69 nesting = do{ char '('
73 ; return (max (n+1) m)
77 word1 :: Parser String
78 word1 = do{ c <- letter
85 -----------------------------------------------------------
87 -----------------------------------------------------------
90 word = many1 (letter <?> "") <?> "word"
92 sentence :: Parser [String]
93 sentence = do{ words <- sepBy1 word separator
94 ; oneOf ".?!" <?> "end of sentence"
98 separator :: Parser ()
99 separator = skipMany1 (space <|> char ',' <?> "")
102 -----------------------------------------------------------
104 -----------------------------------------------------------
105 lang = makeTokenParser
106 (haskellStyle{ reservedNames = ["return","total"]})
109 -----------------------------------------------------------
111 -----------------------------------------------------------
112 expr = buildExpressionParser table factor
115 table = [[op "*" (*) AssocLeft, op "/" div AssocLeft]
116 ,[op "+" (+) AssocLeft, op "-" (-) AssocLeft]
120 = Infix (do{ symbol lang s; return f} <?> "operator") assoc
122 factor = parens lang expr
124 <?> "simple expression"
127 test1 = do{ n <- natural lang
128 ; do{ symbol lang "+"
135 -----------------------------------------------------------
137 -----------------------------------------------------------
139 receipt ::= product* total
140 product ::= "return" price ";"
141 | identifier price ";"
142 total ::= price "total"
143 price ::= natural "." digit digit
146 receipt :: Parser Bool
147 receipt = do{ ps <- many produkt
149 ; return (sum ps == p)
152 produkt = do{ reserved lang "return"
157 <|> do{ identifier lang
164 total = do{ p <- price
165 ; reserved lang "total"
170 price = lexeme lang (
171 do{ ds1 <- many1 digit
173 ; ds2 <- count 2 digit
174 ; return (convert 0 (ds1 ++ ds2))
179 convert n (d:ds) = convert (10*n + digitToInt d) ds