Mercurial > 12ws.info2

annotate exercises/src/AdditionParser2.hs @ 30:8bf7ca2663d2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Advanced AdditionParser
author Markus Kaiser <markus.kaiser@in.tum.de>
date Sat, 12 Jan 2013 14:36:43 +0000
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
30
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
1 module AdditionParser2 where
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
2
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
3 import Data.Char
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
4 import Parser
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
5
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
6 data Token = Num Int | Plus | Times | LeftPar | RightPar deriving (Show, Eq)
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
7
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
8 -- Scanner (Lexer)
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
9 digitS :: Parser Char Int
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
10 digitS = one isDigit >>> digitToInt
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
11
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
12 numberS :: Parser Char Int
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
13 numberS = list1 (one isDigit) >>> (\n -> read n :: Int)
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
14
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
15 additionS :: Parser Char [Token]
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
16 additionS = list (spaces *** token >>> snd) *** spaces >>> fst
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
17 where
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
18 spaces = list $ item ' '
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
19 token = item '(' >>> const LeftPar |||
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
20 item ')' >>> const RightPar |||
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
21 item '+' >>> const Plus |||
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
22 item '*' >>> const Times |||
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
23 numberS >>> Num
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
24
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
25 -- Parser
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
26 additionP :: Parser Token Int
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
27 additionP = additionP1 *** optional (item Plus *** additionP >>> snd) >>> ints
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
28 where
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
29 ints (x, Just y) = x + y
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
30 ints (x, _) = x
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
31
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
32 additionP1 :: Parser Token Int
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
33 additionP1 = additionP2 *** optional (item Times *** additionP1 >>> snd) >>> ints
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
34 where
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
35 ints (x, Just y) = x * y
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
36 ints (x, _) = x
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
37
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
38 additionP2 :: Parser Token Int
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
39 additionP2 =
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
40 one isNum >>> int |||
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
41 enclose LeftPar RightPar additionP
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
42 where
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
43 isNum (Num _) = True
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
44 isNum (_) = False
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
45 int (Num n) = n
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
46
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
47 -- Composition
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
48 additionSP :: String -> Maybe (Int, [Token])
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
49 additionSP xs = case additionS xs of
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
50 Just (ys, []) -> additionP ys
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
51 _ -> Nothing
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
52
8bf7ca2663d2 Advanced AdditionParser
Markus Kaiser <markus.kaiser@in.tum.de>
parents:
diff changeset
53 test = additionSP "2*4+10+(2+2)*2"