Programming in Haskell Chapter8 Exercises Solutions
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 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