Programming in Haskell Chapter8 Exercises Solutions

Chapter8_Funtional_Parsers.hs

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)