1+ -- | Parsing
2+ -- Examples to illustrate how to write parsers using parsing combinators
3+ -- Functional Programming course 2018.
4+ -- Thomas Hallgren
5+
6+ {-
7+ This started as a skeleton, the definitions were filled in
8+ during the lecture.
9+ -}
10+ module ParsingExamples where
11+ import Data.Char (isDigit )
12+ import Parsing hiding (chain ,digit )
13+ import Control.Monad (forever )
14+
15+ --------------------------------------------------------------------------------
16+ -- * A first example
17+ -- Writing a recursive decent parser directly
18+ -- Using functions of type String -> Maybe (a,String)
19+
20+ {- BNF:
21+ digit = "0".."9".
22+ number = digit{digit}.
23+ addition = number "+" number.
24+ -}
25+
26+ type ParserFun a = String -> Maybe a , String
27+
28+ num :: ParserFun Integer
29+ num s = case span isDigit s of
30+ (d: ds, rest) -> Just (read (d: ds), rest) -- Only use read if we know it succeeds (not empty and not characters)
31+ _ -> Nothing
32+
33+ number_v1 :: String -> Maybe Integer String
34+ number_v1 s = case span isDigit s of
35+ (" " -> Nothing
36+ (ds,r) -> Just (read ds,r)
37+
38+
39+ addition0 :: ParserFun Integer
40+ addition0 s = case num s of
41+ Just (n, ' +' : r) -> case num r of
42+ Just (m, r') -> Just (n+ m, r')
43+ _ -> Nothing
44+ _ -> Nothing
45+
46+
47+ addition_v1 :: String -> Maybe Integer String
48+ addition_v1 s = case number_v1 s of
49+ Just (n1,' +' : r1) -> case number_v1 r1 of
50+ Just (n2,r2) -> Just (n1+ n2,r2)
51+ _ -> Nothing
52+ _ -> Nothing
53+
54+
55+ {- A small extension to the BNF
56+ multiplication ::= number "*" number.
57+ calculation ::= addition | multiplication.
58+ -}
59+
60+ multiplication_v1 :: String -> Maybe Integer String
61+ multiplication_v1 s = case number_v1 s of
62+ Just (n1,' *' : r1) -> case number_v1 r1 of
63+ Just (n2,r2) -> Just (n1* n2,r2)
64+ _ -> Nothing
65+ _ -> Nothing
66+
67+
68+ calculation_v1 :: String -> Maybe Integer String
69+ calculation_v1 s = case addition_v1 s of
70+ Nothing -> multiplication_v1 s
71+ result -> result
72+
73+
74+ --------------------------------------------------------------------------------
75+ -- * Rewriting our first example using parsing combinators
76+
77+ -- | Parse a digit (also available in the Parsing module)
78+ digit :: Parser Char
79+ digit = sat isDigit
80+
81+ -- | Parse a number
82+ number :: Parser Integer
83+ number = read <$> oneOrMore digit
84+ -- do ds <- oneOrMore digit
85+ -- return (read ds)
86+
87+ -- | Parse two numbers, separated by +, and add them
88+ addition :: Parser Integer
89+ {-
90+ addition = do n1 <- number
91+ char '+'
92+ n2 <- number
93+ return (n1+n2) -}
94+
95+
96+ {-
97+ addition = do n1 <- number
98+ char '+'
99+ n2 <- number
100+ return (n1+n2)
101+ -}
102+ addition = operator ' +' (+)
103+
104+ -- | Parse two numbers, separated by *, and multiply them
105+ multiplication :: Parser Integer
106+ {-
107+ multiplication =do n1 <- number
108+ char '*'
109+ n2 <- number
110+ return (n1*n2)
111+ -}
112+ multiplication = operator ' *' (*)
113+
114+ operator c op = do n1 <- number
115+ char c
116+ n2 <- number
117+ return (n1 `op` n2)
118+
119+
120+ calculation :: Parser Integer
121+ calculation = addition <|> multiplication
122+
123+ --------------------------------------------------------------------------------
124+ -- * An expression parser (version 1)
125+
126+ data Expr = Num Integer
127+ | Add Expr Expr
128+ | Mul Expr Expr
129+ deriving (Eq ,Show )
130+
131+ eval :: Expr -> Integer
132+ eval (Num n) = n
133+ eval (Add a b) = eval a + eval b
134+ eval (Mul a b) = eval a * eval b
135+
136+ {- EBNF:
137+ expr ::= term {"+" term}.
138+ term ::= factor {"*" factor}.
139+ factor ::= number | "(" expr ")".
140+ -}
141+ {-
142+ expr, term, factor :: Parser Expr
143+
144+ expr = do t <- term
145+ ts <- zeroOrMore (do char '+'; term)
146+ return (foldl1 Add (t:ts))
147+
148+ term = do f <- factor
149+ fs <- zeroOrMore (do char '*'; factor)
150+ return (foldl1 Mul (f:fs))
151+
152+ factor = -- Num <$> number
153+ do n <- number
154+ return (Num n)
155+ <|>
156+ do char '('
157+ e <- expr
158+ char ')'
159+ return e
160+ -}
161+ --------------------------------------------------------------------------------
162+ -- * A more elegant expression parser
163+
164+
165+ expr , term , factor :: Parser Expr
166+ expr = leftAssoc Add term (char ' +'
167+ term = leftAssoc Mul factor (char ' *'
168+ factor = (Num <$> number) <|> (char ' (' *> expr <* char ' )'
169+
170+
171+
172+ -- | Parse a list of items with separators
173+ -- (also available in the Parsing module)
174+ chain :: Parser item -> Parser sep -> Parser [item ]
175+ chain item sep = do i <- item
176+ is <- zeroOrMore (do sep; item)
177+ return (i: is)
178+
179+ leftAssoc :: (t -> t -> t ) -> Parser t -> Parser sep -> Parser t
180+ leftAssoc op item sep = do is <- chain item sep
181+ return (foldl1 op is)
182+
183+ rightAssoc op item sep = undefined -- exercise
184+
185+ --------------------------------------------------------------------------------
186+ -- * The simple calculator example
187+
188+ main = do putStrLn " Welcome to the simple calculator!"
189+ forever readEvalPrint
190+
191+ readEvalPrint = do putStr " Expression? "
192+ s <- getLine
193+ case parse expr s of
194+ Just (e," " -> do putStr " Value: "
195+ print (eval e)
196+ _ -> putStrLn " Syntax error!"
197+
198+
199+
200+
201+
202+
203+
204+
205+
206+
207+
208+
209+
210+ --------------------------------------------------------------------------------
211+ -- * More examples
212+
213+ -- ** Data types with infix operatos
214+ infixl 6 :+
215+ infixl 7 :*
216+
217+ data Expr2 = C Integer
218+ | Expr2 :+ Expr2
219+ | Expr2 :* Expr2
220+ deriving (Show ,Read ) -- gives us almost what we want
221+
222+ ex1 = C 2
223+ ex2 = ex1 :+ ex1
224+ ex3 = C 1 :+ C 2 :* C 3
225+ ex4 = (C 1 :+ C 2 ) :* C 3
226+
227+
228+ -- | Parse a specific sequence of characters
229+ string :: String -> Parser String
230+ string " " = return " "
231+ string (c: s) = do c' <- char c
232+ s' <- string s
233+ return (c': s')
0 commit comments