Created
September 4, 2016 21:45
-
-
Save anonymous/ba392ebf009cd95e43be303f3bb79bc8 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import MParserCore | |
import Parser | |
import Data.Char | |
data Expr = Lit Int | Add Expr Expr | Mul Expr Expr deriving (Read, Show) | |
expr :: Parser Expr | |
expr = liftP Add term (char '+' +++ expr) ||| term | |
term :: Parser Expr | |
term = do f <- factor | |
char '*' | |
t <- term | |
return (Mul f t) | |
||| factor | |
factor :: Parser Expr | |
factor = mapP Lit nat | |
||| char '(' +++ expr ++> \e -> char ')' +++ yield e | |
nat :: Parser Int | |
nat = mapP (foldl (\n d -> 10 * n + d) 0) (many1 (mapP digitToInt digit)) | |
eval :: Expr -> Int | |
eval (Lit n) = n | |
eval (Add e1 e2) = eval e1 + eval e2 | |
eval (Mul e1 e2) = eval e1 * eval e2 | |
calc :: String -> Int | |
calc s = eval (parse expr s) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module MParserCore (Parser, parse, item, (|||), failure, (++>), yield) where | |
import qualified ParserCore | |
import Control.Applicative | |
newtype Parser a = P {unP :: ParserCore.Parser a} | |
parse :: Parser a -> String -> a | |
parse = ParserCore.parse . unP | |
item :: Parser Char | |
item = P ParserCore.item | |
infixr 3 ||| | |
(|||) :: Parser a -> Parser a -> Parser a | |
(P p) ||| (P q) = P (p ParserCore.||| q) | |
failure :: Parser a | |
failure = P ParserCore.failure | |
infixr 4 ++> | |
(++>) :: Parser a -> (a -> Parser b) -> Parser b | |
(P p) ++> f = P (p ParserCore.++> (unP . f)) | |
yield :: a -> Parser a | |
yield = P . ParserCore.yield | |
instance Functor Parser where | |
fmap f p = p ++> \x -> yield (f x) | |
instance Applicative Parser where | |
pure = yield | |
p <*> q = p ++> \x -> fmap x q | |
instance Monad Parser where | |
return = yield | |
(>>=) = (++>) | |
fail _ = failure |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Parser where | |
import MParserCore | |
import Data.Char | |
mapP :: (a -> b) -> Parser a -> Parser b | |
mapP = fmap | |
liftP :: (a -> b -> c) -> Parser a -> Parser b -> Parser c | |
liftP f p q = p ++> \x -> q ++> \y -> yield (f x y) | |
infixr 4 +++ | |
(+++) :: Parser a -> Parser b -> Parser b | |
p +++ q = p ++> const q | |
sat :: (Char -> Bool) -> Parser Char | |
sat p = item ++> \x -> if p x then yield x else failure | |
digit :: Parser Char | |
digit = sat isDigit | |
lower :: Parser Char | |
lower = sat isLower | |
upper :: Parser Char | |
upper = sat isUpper | |
letter :: Parser Char | |
letter = sat isAlpha | |
alphanum :: Parser Char | |
alphanum = sat isAlphaNum | |
char :: Char -> Parser () | |
char x = sat (== x) +++ yield () | |
many :: Parser a -> Parser [a] | |
many p = many1 p ||| yield [] | |
many1 :: Parser a -> Parser [a] | |
many1 p = liftP (:) p (many p) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment