Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 80 lines (64 sloc) 2.662 kb
cb3b0dd @ekmett added parsec packrat example for blog post
authored
1 {-# LANGUAGE RecordWildCards, ViewPatterns, FlexibleInstances, MultiParamTypeClasses #-}
2
3 import Text.Parsec
4 import qualified Text.Parsec.Token as T
5 import Text.Parsec.Token (GenLanguageDef(..), GenTokenParser(TokenParser))
6 import Text.Parsec.Pos (initialPos, updatePosChar)
7 import Data.Functor.Identity (Identity(..))
8 import Control.Applicative hiding ((<|>))
9 import Control.Monad.Fix (fix)
10
11 (</>) :: Monad m => ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
12 p </> q = try p <|> q
13 infixl 3 </>
14
15 type Result d a = Consumed (Reply d () a)
16
17 womp :: d -> SourcePos -> ParsecT d () Identity a -> Result d a
18 womp d pos p = fmap runIdentity . runIdentity $ runParsecT p (State d pos ())
19
20 rat :: Monad m => (d -> Result d a) -> ParsecT d u m a
21 rat f = mkPT $ \s0 -> return $ return . patch s0 <$> f (stateInput s0) where
22 patch (State _ _ u) (Ok a (State s p _) err) = Ok a (State s p u) err
23 patch _ (Error e) = Error e
24
25 myLanguageDef :: Monad m => T.GenLanguageDef D u m
26 myLanguageDef = T.LanguageDef
27 { commentStart = "{-"
28 , commentEnd = "-}"
29 , commentLine = "--"
30 , nestedComments = True
31 , identStart = letter <|> char '_'
32 , identLetter = alphaNum <|> oneOf "_'"
33 , opStart = opLetter myLanguageDef
34 , opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~"
35 , reservedOpNames = []
36 , reservedNames = []
37 , caseSensitive = True
38 }
39
40 TokenParser {..} = T.makeTokenParser myLanguageDef
41
42 -- * Building a packrat parser with parsec
43
44 -- I used to bullseye womp rats in my T-16 back home.
45
46 data D = D
47 { _add :: Result D Integer
48 , _mult :: Result D Integer
49 , _primary :: Result D Integer
50 , _dec :: Result D Integer
51 , _uncons :: Maybe (Char, D)
52 }
53
54 instance Monad m => Stream D m Char where
55 uncons = return . _uncons
56
57 add, mult, primary, dec :: Parsec D u Integer
58 add = rat _add
59 mult = rat _mult
60 primary = rat _primary
61 dec = rat _dec
62
63 prep :: SourceName -> String -> D
64 prep n = go (initialPos n) where
65 go p s = fix $ \d -> let
66 (womp d p -> _add) = (+) <$> mult <* reservedOp "+" <*> add </> mult <?> "summand"
67 (womp d p -> _mult) = (*) <$> primary <* reservedOp "*" <*> mult </> primary <?> "factor"
68 (womp d p -> _primary) = parens add </> dec <?> "number"
69 (womp d p -> _dec) = natural
70 _uncons = case s of
71 (x:xs) -> Just (x, go (updatePosChar p x) xs)
72 [] -> Nothing
73 in D { .. }
74
75 runD :: Parsec D u a -> u -> SourceName -> String -> Either ParseError a
76 runD p u fn s = runParser p u fn (prep fn s)
77
78 eval :: String -> Integer
79 eval s = either (error . show) id $ runD (whiteSpace *> add <* eof) () "-" s
Something went wrong with that request. Please try again.