Skip to content
Newer
Older
100644 132 lines (106 sloc) 3.42 KB
6430cec @ekmett updated for comonad.com article
authored Sep 23, 2011
1 {-# LANGUAGE RecordWildCards, ViewPatterns, DeriveFunctor, FlexibleInstances #-}
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
2 import Control.Applicative
3 import Control.Monad (MonadPlus(..), guard)
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
4 import Control.Monad.Fix (fix)
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
5 import Data.Char (isDigit, digitToInt, isSpace)
6
7 data Result d a
8 = Pure a -- we didn't consume anything and can backtrack
9 | Commit d a -- we consumed input
10 | Fail String Bool -- we failed with a flag indicating if we have consumed input
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
11 deriving Functor
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
12
13 newtype Rat d a = Rat { runRat :: d -> Result d a }
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
14 deriving Functor
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
15
16 instance Applicative (Rat d) where
17 pure a = Rat $ \ _ -> Pure a
18 Rat mf <*> Rat ma = Rat $ \ d -> case mf d of
19 Pure f -> fmap f (ma d)
20 Fail s c -> Fail s c
21 Commit d' f -> case ma d' of
22 Pure a -> Commit d' (f a)
23 Fail s _ -> Fail s True
24 Commit d'' a -> Commit d'' (f a)
25
26 instance Alternative (Rat d) where
27 Rat ma <|> Rat mb = Rat $ \ d -> case ma d of
28 Fail _ False -> mb d
29 x -> x
30 empty = Rat $ \ _ -> Fail "empty" False
31
32 instance Monad (Rat d) where
33 return a = Rat $ \_ -> Pure a
34 Rat m >>= k = Rat $ \d -> case m d of
35 Pure a -> runRat (k a) d
36 Commit d' a -> case runRat (k a) d' of
37 Pure b -> Commit d' b
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
38 Fail s _ -> Fail s True
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
39 commit -> commit
40 Fail s c -> Fail s c
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
41 fail s = Rat $ \ _ -> Fail s False
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
42
43 instance MonadPlus (Rat d) where
44 mplus = (<|>)
45 mzero = empty
46
47 try :: Rat d a -> Rat d a
48 try (Rat m) = Rat $ \d -> case m d of
49 Fail s _ -> Fail s False
50 x -> x
51
52 (</>) :: Rat d a -> Rat d a -> Rat d a
53 p </> q = try p <|> q
54 infixl 3 </>
55
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
56 class Stream d where
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
57 anyChar :: Rat d Char
58
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
59 instance Stream [Char] where
60 anyChar = Rat $ \s -> case s of
61 (x:xs) -> Commit xs x
62 [] -> Fail "EOF" False
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
63
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
64 whiteSpace :: Stream d => Rat d ()
65 whiteSpace = () <$ many (satisfy isSpace)
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
66
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
67 phrase :: Stream d => Rat d a -> Rat d a
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
68 phrase m = whiteSpace *> m <* eof
69
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
70 notFollowedBy :: Rat d a -> Rat d ()
71 notFollowedBy (Rat m) = Rat $ \d -> case m d of
72 Fail{} -> Pure ()
73 _ -> Fail "unexpected" False
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
74
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
75 eof :: Stream d => Rat d ()
76 eof = notFollowedBy $ anyChar
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
77
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
78 satisfy :: Stream d => (Char -> Bool) -> Rat d Char
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
79 satisfy p = try $ do
80 x <- anyChar
81 x <$ guard (p x)
82
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
83 char :: Stream d => Char -> Rat d Char
84 char c = satisfy (c ==)
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
85
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
86 lexeme :: Stream d => Rat d a -> Rat d a
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
87 lexeme m = m <* whiteSpace
88
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
89 symbol :: Stream d => Char -> Rat d Char
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
90 symbol c = lexeme (char c)
91
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
92 digit :: Stream d => Rat d Int
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
93 digit = digitToInt <$> satisfy isDigit
94
95 data D = D
96 { _add :: Result D Int
97 , _mult :: Result D Int
98 , _primary :: Result D Int
99 , _decimal :: Result D Int
100 , anyCharD :: Result D Char
101 }
102
103 -- makeRat ''D should output:
104 add, mult, primary, decimal :: Rat D Int
105 add = Rat _add
106 mult = Rat _mult
107 primary = Rat _primary
108 decimal = Rat _decimal
109
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
110 dv :: d -> (d -> b) -> b
111 dv d f = f d
112
113 instance Stream D where
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
114 anyChar = Rat anyCharD
6430cec @ekmett updated for comonad.com article
authored Sep 24, 2011
115
116 parse :: String -> D
117 parse s = fix $ \d -> let
118 Rat (dv d -> _add) = (+) <$> mult <* symbol '+' <*> add </> mult
119 Rat (dv d -> _mult) = (*) <$> primary <* symbol '*' <*> mult </> primary
120 Rat (dv d -> _primary) = symbol '(' *> add <* symbol ')' </> decimal
121 Rat (dv d -> _decimal) = foldl (\b a -> b * 10 + a) 0 <$> lexeme (some digit)
122 anyCharD = case s of
123 (x:xs) -> Commit (parse xs) x
124 [] -> Fail "EOF" False
125 in D { .. }
317f792 @ekmett added a work in progress packrat implementation for reference
authored Sep 23, 2011
126
127 eval :: String -> Int
128 eval s = case runRat (whiteSpace *> add <* eof) (parse s) of
129 Pure a -> a
130 Commit _ a -> a
131 _ -> error "Parse error"
Something went wrong with that request. Please try again.