Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

132 lines (106 sloc) 3.5 kb
{-# LANGUAGE RecordWildCards, ViewPatterns, DeriveFunctor, FlexibleInstances #-}
import Control.Applicative
import Control.Monad (MonadPlus(..), guard)
import Control.Monad.Fix (fix)
import Data.Char (isDigit, digitToInt, isSpace)
data Result d a
= Pure a -- we didn't consume anything and can backtrack
| Commit d a -- we consumed input
| Fail String Bool -- we failed with a flag indicating if we have consumed input
deriving Functor
newtype Rat d a = Rat { runRat :: d -> Result d a }
deriving Functor
instance Applicative (Rat d) where
pure a = Rat $ \ _ -> Pure a
Rat mf <*> Rat ma = Rat $ \ d -> case mf d of
Pure f -> fmap f (ma d)
Fail s c -> Fail s c
Commit d' f -> case ma d' of
Pure a -> Commit d' (f a)
Fail s _ -> Fail s True
Commit d'' a -> Commit d'' (f a)
instance Alternative (Rat d) where
Rat ma <|> Rat mb = Rat $ \ d -> case ma d of
Fail _ False -> mb d
x -> x
empty = Rat $ \ _ -> Fail "empty" False
instance Monad (Rat d) where
return a = Rat $ \_ -> Pure a
Rat m >>= k = Rat $ \d -> case m d of
Pure a -> runRat (k a) d
Commit d' a -> case runRat (k a) d' of
Pure b -> Commit d' b
Fail s _ -> Fail s True
commit -> commit
Fail s c -> Fail s c
fail s = Rat $ \ _ -> Fail s False
instance MonadPlus (Rat d) where
mplus = (<|>)
mzero = empty
try :: Rat d a -> Rat d a
try (Rat m) = Rat $ \d -> case m d of
Fail s _ -> Fail s False
x -> x
(</>) :: Rat d a -> Rat d a -> Rat d a
p </> q = try p <|> q
infixl 3 </>
class Stream d where
anyChar :: Rat d Char
instance Stream [Char] where
anyChar = Rat $ \s -> case s of
(x:xs) -> Commit xs x
[] -> Fail "EOF" False
whiteSpace :: Stream d => Rat d ()
whiteSpace = () <$ many (satisfy isSpace)
phrase :: Stream d => Rat d a -> Rat d a
phrase m = whiteSpace *> m <* eof
notFollowedBy :: Rat d a -> Rat d ()
notFollowedBy (Rat m) = Rat $ \d -> case m d of
Fail{} -> Pure ()
_ -> Fail "unexpected" False
eof :: Stream d => Rat d ()
eof = notFollowedBy $ anyChar
satisfy :: Stream d => (Char -> Bool) -> Rat d Char
satisfy p = try $ do
x <- anyChar
x <$ guard (p x)
char :: Stream d => Char -> Rat d Char
char c = satisfy (c ==)
lexeme :: Stream d => Rat d a -> Rat d a
lexeme m = m <* whiteSpace
symbol :: Stream d => Char -> Rat d Char
symbol c = lexeme (char c)
digit :: Stream d => Rat d Int
digit = digitToInt <$> satisfy isDigit
data D = D
{ _add :: Result D Int
, _mult :: Result D Int
, _primary :: Result D Int
, _decimal :: Result D Int
, anyCharD :: Result D Char
}
-- makeRat ''D should output:
add, mult, primary, decimal :: Rat D Int
add = Rat _add
mult = Rat _mult
primary = Rat _primary
decimal = Rat _decimal
dv :: d -> (d -> b) -> b
dv d f = f d
instance Stream D where
anyChar = Rat anyCharD
parse :: String -> D
parse s = fix $ \d -> let
Rat (dv d -> _add) = (+) <$> mult <* symbol '+' <*> add </> mult
Rat (dv d -> _mult) = (*) <$> primary <* symbol '*' <*> mult </> primary
Rat (dv d -> _primary) = symbol '(' *> add <* symbol ')' </> decimal
Rat (dv d -> _decimal) = foldl (\b a -> b * 10 + a) 0 <$> lexeme (some digit)
anyCharD = case s of
(x:xs) -> Commit (parse xs) x
[] -> Fail "EOF" False
in D { .. }
eval :: String -> Int
eval s = case runRat (whiteSpace *> add <* eof) (parse s) of
Pure a -> a
Commit _ a -> a
_ -> error "Parse error"
Jump to Line
Something went wrong with that request. Please try again.