programming haskell 8

8.hs

import Prelude hiding (return, (>>=))
import Data.Char 

-- 8.2

type Parser a = String -> [(a, String)]

-- 8.3 
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

first_third :: Parser (Char, Char)
first_third = item >>= \v1 -> 
              item >>= \_ ->
              item >>= \v3 ->
              return (v1, v3)

(+++) :: 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)    >>= \v1 ->
                (string xs) >>= \v2 ->
                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)

space :: Parser ()
space = many (sat isSpace) >>= \v -> 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)

ignore_space :: Parser [Int]
ignore_space = symbol "[" >>= \_ ->
               natural    >>= \n  ->
               many (symbol "," >>= \x  -> natural) 
                          >>= \ns ->
               symbol "]" >>= \_ ->
               return (n:ns)

{-
expr :: Parser Int
expr = term >>= (\t ->
          (symbol "+" >>= \_ ->
           expr       >>= \e  ->
           return (t + e))
          +++ return t)

term :: Parser Int
term = factor >>= (\f ->
          (symbol "*" >>= \_ ->
           term       >>= \t  ->
           return (f * t))
          +++ 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"


-- ex 8.10 - 1

int :: Parser Int
int = symbol "-" +++ symbol "" >>= \x ->
      (many1 digit) >>= \y ->
      return (read (x ++ y))
      
-- ex 8.10 - 2
-- comment :: Parser ()
comment = (symbol "--") >>= (\_ ->
          many (sat (\x -> (not (x == '\n')))) >>= (\_ ->
          item >>= (\_ ->
          return ())))


-- ex 8.10 - 6
{-
expr :: Parser Int
expr = term >>= (\t ->
          (symbol "+" >>= \_ ->
           expr       >>= \e  ->
           return (t + e))
          +++
          (symbol "-" >>= \_ ->
           expr       >>= \e ->
           return (t - e))
          +++ return t)

term :: Parser Int
term = factor >>= (\f ->
          (symbol "*" >>= \_ ->
           term       >>= \t ->
           return (f * t))
          +++
          (symbol "/" >>= \_ ->
           term       >>= \t ->
           return (f `div` t))
          +++ return f)
          

factor :: Parser Int
factor = (symbol "(" >>= \_ ->
          expr       >>= \e ->
          symbol ")" >>= \_ ->
          return e)
         +++ natural
--}

-- ex 8.10 - 7
expr :: Parser Int
expr = term >>= (\t ->
          (symbol "+" >>= \_ ->
           expr       >>= \e  ->
           return (t + e))
          +++
          (symbol "-" >>= \_ ->
           expr       >>= \e ->
           return (t - e))
          +++ return t)

term :: Parser Int
term = exponential >>= (\f ->
          (symbol "*" >>= \_ ->
           term       >>= \t ->
           return (f * t))
          +++
          (symbol "/" >>= \_ ->
           term       >>= \t ->
           return (f `div` t))
          +++ return f)

exponential :: Parser Int
exponential = factor >>= (\f ->
              (symbol "^" >>= \_ ->
               factor     >>= \t ->
               return (f ^ t))
              +++ return f)

factor :: Parser Int
factor = (symbol "(" >>= \_ ->
          expr       >>= \e ->
          symbol ")" >>= \_ ->
          return e)
         +++ natural

-- ex 8.10 - 8