Skip to content

Instantly share code, notes, and snippets.

@gilesbradshaw
Last active November 28, 2015 02:21
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save gilesbradshaw/50abf77224a343e91d6b to your computer and use it in GitHub Desktop.
Save gilesbradshaw/50abf77224a343e91d6b to your computer and use it in GitHub Desktop.
arithmetic parse (and other stuff) eval "(1+2)*3+4"
-- from hutton
import Control.Applicative -- Otherwise you can't do the Applicative instance.
import Control.Monad (liftM, ap)
import Data.Char
newtype Parser a = P(String -> [(a, String)])
failure :: Parser a
failure = P(\_ -> [])
item :: Parser Char
item = P(\s-> case s of
[] -> []
(x:xs) -> [(x,xs)])
parse :: Parser a -> String -> [(a,String)]
parse (P p) s = p s
instance Functor Parser where
fmap = liftM
instance Applicative Parser where
pure = return
(<*>) = ap
instance Monad Parser where
--(>>=) :: Parser a -> (a -> Parser b) -> Parser b
p >>= f = P(\s -> case parse p s of
[] -> []
[(v, out)] -> parse (f v) out)
--return :: a -> Parser a
return v = P(\s -> [(v,s)])
(+++) :: Parser a -> Parser a -> Parser a
p +++ q = P(\s -> case parse p s of
[] -> parse q s
x -> x)
sat :: (Char -> Bool) -> Parser Char
sat f = do x <- item
if f 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)
manyP :: Parser a -> Parser [a]
manyP p = many1P p +++ return []
many1P :: Parser a -> Parser [a]
many1P p = do v <- p
vs <- manyP p
return (v:vs)
ident :: Parser String
ident = do x <- lower
xs <- manyP alphaNum
return (x:xs)
nat :: Parser Int
nat = do xs <- many1P digit
return (read xs)
space :: Parser ()
space = do manyP (sat isSpace)
return ()
token :: Parser a -> Parser a
token p = do space
x <-p
space
return x
identifier :: Parser String
identifier = token ident
natural :: Parser Int
natural = token nat
symbol :: String -> Parser String
symbol xs = token (string xs)
expr :: Parser Int
expr = do t <- term
do symbol "+"
e <- expr
return (t+e)
+++ return t
term :: Parser Int
term = do f <- factor
do symbol "*"
t <- term
return (f*t)
+++ 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"
int :: Parser Int
int = do symbol "-"
x <- natural
return (-x)
+++ natural
comment :: Parser String
comment = do symbol "--"
xs <- manyP (sat (/='\n'))
item
return xs
pp :: Parser [Int]
pp = do symbol "["
n <- natural
ns <- do manyP(do symbol ","
natural)
symbol "]"
return (n:ns)
p :: Parser (Char,Char)
p = item >>= \v1 ->
item >>= \v2 ->
item >>= \v3 ->
return (v1,v3)
p2 :: Parser (Char, Char)
p2 = do v1 <- item
item
v3 <- item
return (v1,v3)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment