blob: 49d23d71a83fcea3bca5fdfac84ea43ac1fbec91 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
module Parser where
import Control.Applicative
import Control.Monad
import Data.Char
import Equation
newtype Parser a = Parser (String -> Maybe (a, String))
parse :: Parser a -> String -> Maybe (a, String)
parse (Parser p) input = p input
instance Functor Parser where
-- fmap :: (a -> b) -> Parser a -> Parser b
fmap f (Parser p) = Parser new_p
where new_p s = do
(x, s') <- p s
return (f x, s')
instance Applicative Parser where
-- pure :: a -> Parser a
pure x = Parser (\s -> Just (x, s))
-- (<*>) :: Parser (a -> b) -> Parser a -> Parser b
(Parser p1) <*> (Parser p2) = Parser new_p
where new_p s = do
(f, s') <- p1 s
(x, s'') <- p2 s'
return (f x, s'')
instance Alternative Parser where
-- empty :: Parser a
empty = Parser (\_ -> Nothing)
-- (<|>) :: Parser a -> Parser a -> Parser a
(Parser p1) <|> (Parser p2) = Parser new_p
where new_p s = p1 s <|> p2 s
charP :: Char -> Parser Char
charP x = Parser p
where p "" = Nothing
p (c:cs) = if c == x then Just (c, cs)
else Nothing
satisfy :: (Char -> Bool) -> Parser String
satisfy f = Parser (\s -> Just $ span f s)
digitsP :: Parser String
digitsP = satisfy isDigit
spacesP :: Parser String
spacesP = satisfy isSpace
sepBy :: Parser a -> Parser b -> Parser [a]
sepBy x sep = (:) <$> x <*> many (sep *> x)
surround :: Parser a -> Parser b -> Parser b
surround surrounding x = surrounding *> x <* surrounding
-- Equation parsers
-- 1 * X^0 + 2 * X^1 + 1 * 3 * X^2 = 0
intP :: Parser Int
intP = read <$> numStr
where numStr = ((:) <$> charP '-' <*> digitsP) <|> digitsP
termP :: Parser Term
termP = notConstantP <|> constantP
where constantP = (\c -> Term (fromIntegral c) 0) <$> intP
notConstantP = (\coef exp -> Term (fromIntegral coef) exp)
<$> intP <*> (between *> intP)
where between = spacesP *> charP '*' *>
spacesP *> charP 'X' *>
spacesP *> charP '^' *>
spacesP
polynomialP :: Parser Polynomial
polynomialP = sepBy termP (spacesP *> charP '+' *> spacesP)
equationP :: Parser Equation
equationP = (\l r -> Equation l r)
<$> polynomialP
<*> (spacesP *> charP '=' *> spacesP *> polynomialP)
|
