Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Programming in Haskell Chapter8 Exercises Solutions
import Prelude hiding(return, (>>=), (>>))
import Data.Char
type Parser a = String -> [(a, String)]
return :: a -> Parser a
return v = \inp -> [(v, inp)]
failure :: Parser a
failure = \inp -> []
item :: Parser Char
item = \inp -> case inp of
[] -> []
(x: xs) -> [(x, xs)]
parse :: Parser a -> String -> [(a, String)]
parse p inp = p inp
(>>=) :: Parser a -> (a -> Parser b) -> Parser b
p >>= f = \inp -> case parse p inp of
[] -> []
[(v, out)] -> parse (f v) out
myp :: Parser (Char, Char)
myp = item >>= \x ->
item >>= \y ->
return (x, y)
p :: Parser (Char, Char)
p = item >>= \x ->
item >>= \_ ->
item >>= \y ->
return (x, y)
(+++) :: Parser a -> Parser a -> Parser a
p +++ q = \inp -> case parse p inp of
[] -> parse q inp
[(v, out)] -> [(v, out)]
sat :: (Char -> Bool) -> Parser Char
sat p = item >>= \x ->
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) = char x >>= \_ ->
string xs >>= \_ ->
return (x: xs)
many :: Parser a -> Parser [a]
many p = many1 p +++ return []
many1 :: Parser a -> Parser [a]
many1 p = p >>= \v ->
many p >>= \vs ->
return (v: vs)
ident :: Parser String
ident = lower >>= \x ->
many alphanum >>= \xs ->
return (x: xs)
nat :: Parser Int
nat = many1 digit >>= \xs ->
return (read xs)
-- why read? turn char into int?
space :: Parser ()
space = many (sat isSpace) >>= \_ ->
return ()
token :: Parser a -> Parser a
token p = space >>= \_ ->
p >>= \v ->
space >>= \_ ->
return v
identifier :: Parser String
identifier = token ident
natural :: Parser Int
natural = token nat
symbol :: String -> Parser String
symbol xs = token (string xs)
p2 :: Parser [Int]
p2 = symbol "[" >>= \_ ->
natural >>= \n ->
many (symbol "," >>= \_ -> natural) >>= \ns ->
symbol "]" >>= \_ ->
return (n: ns)
-- arithmetic expressions extended later
-- -----------------exercise solution
-- 1
int :: Parser Int
int = natural +++
(symbol "-" >>= \_ ->
natural >>= \x ->
return (-x))
-- *Main> parse int "123da"
-- [(123,"da")]
-- *Main> parse int "sdada"
-- []
-- *Main> parse int "-213sdada"
-- [(-213,"sdada")]
-- 2
comment :: Parser ()
comment = symbol "--" >>= \_ ->
many (sat (/= '\n')) >>= \_ ->
many (char '\n') >>= \_ ->
return () -- why return ()?
-- *Main> parse comment "foo"
-- []
-- *Main> parse comment "--foo"
-- [((),"")]
-- *Main> parse comment "--foo\nbar"
-- [((),"bar")]
-- 6 & 7
-- new gramma rules:
-- expr ::= term (+ expr | - expr | <E>)
-- term ::= power (* term | / term | <E>)
-- power ::= factor (^ power | <E>)
-- factor ::= (expr) | nat
-- nat ::= 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9
-- !! WRONG:
-- (symbol "-" >>= \_ ->
-- expr >>= \e ->
-- return (ex - e))
-- (symbol "/" >>= \_ ->
-- term >>= \t ->
-- return (f `div` t))
expr :: Parser Int
expr = term >>= \t ->
(symbol "+" >>= \_ ->
expr >>= \e ->
return (t + e))
+++
(many (symbol "-" >>= \_ ->
term >>= \n ->
return n) >>= \ss ->
return (foldl (-) t ss))
+++
return t
term :: Parser Int
term = power >>= \p ->
(symbol "*" >>= \_ ->
term >>= \t ->
return (p * t))
+++
(many (symbol "/" >>= \_ ->
power >>= \t ->
return t) >>= \ss ->
return (foldl div p ss))
+++
return p
power :: Parser Int
power = factor >>= \f ->
(symbol "^" >>= \_ ->
power >>= \p ->
return (f ^ p))
+++ return f
factor :: Parser Int
factor = (symbol "(" >>= \_ ->
expr >>= \e ->
symbol ")" >>= \_ ->
return e)
+++ natural
eval :: String -> Int
eval xs = case parse expr xs of
[(n, [])] -> n
[(_, out)] -> error("unused input " ++ out)
[] -> error "invalid input"
-- *Main> eval "2^3"
-- 8
-- *Main> eval "2*3 ^ 4"
-- 1296
-- *Main> eval "2 ^ 3 * 4"
-- 4096
-- *Main> eval "2 + 2^ 2"
-- 6
-- *Main> eval "2^2^2"
-- 16
-- *Main> eval "8-2-2-2"
-- 2
-- *Main> eval "16 /2/2/2"
-- 2
-- 8
-- expr' ::= expr' - nat | nat
-- nat ::= 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9
expr' :: Parser Int
expr' = natural >>= \n ->
many (symbol "-" >>= \_ -> natural) >>= \ns ->
return (foldl (-) n ns)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.