{-
    Title: Expression Parser and Evaluator
    Author; Robin Cockett
    Date 10 Jan 2006

    Corrections:
    (1) Maggie Zhang (2nd Feb): end of file in expr does means its use 
    inside parentheses does not work correctly!
    Corrected: added a "dummy" start rule exp which expects end of file 
    but immmediately calls  exp' which does not require end-of-file: this 
    latter is used in the body.  This ensures that the grammar still checks 
    the eof ..
    (2) (6th Feb) Num token patterns (test_num) had a typo! Corrected.
    (3) Mike Glazer (21 Jan): omitted a "show" function in the file reading
        and writing routine. Corrected.
-}

 module Main where
 import Text.ParserCombinators.Parsec
 import IO
 import Exlexer

 -- function for running a parsers
 rn:: GenParser a () b -> [a] ->b
 rn p input
        = case (parse p "" input) of 
            Left err -> error ("parse error at "++(show err))
            Right x -> x

 mytoken test = token (\(pos,tok) -> show tok)     -- showing token
                      (\(pos,tok) -> pos)          -- position of token
                      (\(pos,tok) -> test tok)     -- valid token
 add_token = mytoken test_add where
       test_add ADD = Just ()
       test_add _ = Nothing
 mul_token = mytoken test_mul where
       test_mul MUL = Just ()
       test_mul _ = Nothing
 lpar_token = mytoken test_lpar where
       test_lpar LPAR = Just ()
       test_lpar _ = Nothing
 rpar_token = mytoken test_rpar where
       test_rpar RPAR = Just ()
       test_rpar _ = Nothing
 num_token = mytoken test_num where
       test_num (NUM n) = Just n
       test_num _ = Nothing

 -- output type from parser
 data Exp =  Add Exp Exp
          |  Mul Exp Exp
          |  Num Integer
          deriving (Eq)

 -- display expression in postfix to operate stack machine
 instance Show Exp where
     show (Add e1 e2) = (show e1)++(show e2)++"ADD\n"
     show (Mul e1 e2) = (show e1)++(show e2)++"MUL\n"
     show (Num n) = "PUSH "++(show n)++"\n"

{-  Grammatical analysis using the grammar
          expr -> term expr1
          expr1 -> ADD expr 
              |
          term -> factor term1
          term1 -> MUL term 
              | 
          factor -> '(' expr ')' 
              | NUM
    to produce an expression
 -}

 --   expr -> term expr1
 --   expr1 -> ADD expr |
 expr :: GenParser Tok () Exp
 expr = do e <- expr'
           eof
           return e
 expr' :: GenParser Tok () Exp
 expr' = do t <- term
            e <- expr1
            return (e t)
 expr1 :: GenParser Tok () (Exp -> Exp)
 expr1 = do add_token
            t <- expr2
            return (\x -> t x)
     <|> return (\x -> x)
 expr2 :: GenParser Tok () (Exp -> Exp)
 expr2 = do t <- term
            e <- expr1
            return (\x -> e (Add x t))

 --   term -> factor term1
 --   term1 -> MUL term |      
 term :: GenParser Tok () Exp 
 term = do f <- factor
           t <- term1
           return (t f)

 term1 :: GenParser Tok () (Exp -> Exp)
 term1 = do mul_token
            t <- term2
            return (\x -> t x)
       <|> return (\x -> x)
 term2 :: GenParser Tok () (Exp -> Exp)
 term2 = do f <- factor
            t <- term1
            return (\x -> t (Mul x f))

 --   factor -> LPAR expr PAR | NUM
 factor :: GenParser Tok () Exp
 factor = do lpar_token
             e <- expr'
             rpar_token
             return e
      <|> do n <- num_token
             return (Num n)
      
 postfix = (rn expr . rn lexer)

 -- reading in a source file and outputting a target file
 -- This code was adapted from Paul Hudak's book 
 -- "The Haskell School of Expression"
 getAndOpenFile::String -> IOMode -> IO Handle
 getAndOpenFile prompt mode
    =  do putStr prompt
          name <- getLine
          catch (do handle <- openFile name mode
                    return handle)
                (\error -> do putStrLn ("Cannot open "++ name)
                              print error
                              getAndOpenFile prompt mode)

 main = do fromHandle <- getAndOpenFile "Input file nam:" ReadMode
           toHandle <- getAndOpenFile "Output file name:" WriteMode
           contents <- hGetContents fromHandle
           hPutStr toHandle (show (postfix contents))
           hClose fromHandle
           hClose toHandle
           putStrLn "Done"