Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tree: a0384b4321
Fetching contributors…

Cannot retrieve contributors at this time

173 lines (131 sloc) 5.333 kB
{-Functional parsing library from chapter 8 of Programming in Haskell,-}
{-Graham Hutton, Cambridge University Press, 2007.-}
module Parsing where
import Char
import Monad
infixr 5 +++
{-The monad of parsers-}
{----------------------}
newtype Parser a = P (String -> [(a,String)])
instance Monad Parser where
return v = P (\inp -> [(v,inp)])
p >>= f = P (\inp -> case parse p inp of
[] -> []
[(v,out)] -> parse (f v) out)
instance MonadPlus Parser where
mzero = P (\inp -> [])
p `mplus` q = P (\inp -> case parse p inp of
[] -> parse q inp
[(v,out)] -> [(v,out)])
{-Basic parsers-}
{---------------}
failure :: Parser a
failure = mzero
item :: Parser Char
item = P (\inp -> case inp of
[] -> []
(x:xs) -> [(x,xs)])
parse :: Parser a -> String -> [(a,String)]
parse (P p) inp = p inp
{-Choice-}
{--------}
(+++) :: Parser a -> Parser a -> Parser a
p +++ q = p `mplus` q
{-Derived primitives-}
{--------------------}
sat :: (Char -> Bool) -> Parser Char
sat p = do x <- item
if p x then return 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
char x = sat (== x)
string :: String -> Parser String
string [] = return []
string (x:xs) = do char x
string xs
return (x:xs)
many :: Parser a -> Parser [a]
many p = many1 p +++ return []
many1 :: Parser a -> Parser [a]
many1 p = do v <- p
vs <- many p
return (v:vs)
ident :: Parser String
ident = do x <- lower
xs <- many alphanum
return (x:xs)
nat :: Parser Int
nat = do xs <- many1 digit
return (read xs)
int :: Parser Int
int = do char '-'
n <- nat
return (-n)
+++ nat
space :: Parser ()
space = do many (sat isSpace)
return ()
comment :: Parser String
comment = do string "--"
xs <- many (sat (/= '\n'))
return xs
{-Ignoring spacing-}
{------------------}
token :: Parser a -> Parser a
token p = do space
v <- p
space
return v
identifier :: Parser String
identifier = token ident
natural :: Parser Int
natural = token nat
integer :: Parser Int
integer = token int
symbol :: String -> Parser String
symbol xs = token (string xs)
-- Evaluator
expr :: Parser Int
expr = do t <- term
(do symbol "+"
e <- expr
return (t + e)
+++ (do symbol "-"
e <- expr
return (t - e))
+++ return t)
term :: Parser Int
term = do f <- expTerm
(do symbol "*"
t <- term
return (f * t)
+++ (do symbol "/"
t <- term
return (f `div` t))
+++ return f)
expTerm :: Parser Int
expTerm = do f <- factor
(do symbol "^"
f2 <- expTerm
return (f ^ f2)
+++ return f)
factor :: Parser Int
factor = do symbol "("
e <- expr
symbol ")"
return e
+++ natural
eval :: String -> Int
eval xs = case parse expr xs of
[(n,[])] -> n
[(_, out)] -> error("unused input " ++ out)
[] -> error "invalid input"
Jump to Line
Something went wrong with that request. Please try again.