calc-0.1: Parser.hs

module Parser(lexer,parser,Token(..),Exp(..)) where
import Data.Maybe
import Char

data Token = TInt Int
           | TOpenP
           | TCloseP
           | TAdd
           | TMinus
           | TDiv
           | TMul
 deriving (Show,Eq)

data Exp = EInt Int
         | Add
         | Multiply
         | Divide
         | Minus
         | Open
         | Close
 deriving (Show,Eq)

ops :: [(Exp,Int)]
ops = zip [Open,Minus,Add,Divide,Multiply] [0,1,1,2,2]

lexer :: String -> [Token]
lexer []       = []
lexer ('*':xs) = TMul    : lexer xs
lexer ('+':xs) = TAdd    : lexer xs
lexer ('/':xs) = TDiv    : lexer xs
lexer ('-':xs) = TMinus  : lexer xs
lexer ('(':xs) = TOpenP  : lexer xs
lexer (')':xs) = TCloseP : lexer xs
lexer a@(x:xs) 
    | isSpace x = lexer xs
    | isDigit x = lexN a

lexN cs = TInt (read n :: Int) : lexer r
    where 
      (n,r) = span isDigit cs

parser :: [Token] -> [Exp]
parser = parser' [] []

parser' :: [Exp] -> [Exp] -> [Token] -> [Exp]
parser' output opstack [] = output ++ opstack
parser' output opstack (x:xs)
    | TAdd      == x = addStack Add output opstack
    | TMul      == x = addStack Multiply output opstack
    | TDiv      == x = addStack Divide output opstack
    | TMinus    == x = addStack Minus output opstack
    | TOpenP    == x = parser' output (Open:opstack) xs
    | TCloseP   == x = let (y,z) = span (/=Open) opstack
                           out'  = output ++ y in
                       if null z then error "Mismatched parenthesis"
                        else parser' out' (tail z) xs
    | otherwise      = let (TInt y) = x in parser' (output ++ [EInt y]) opstack xs
      where
        addStack v out opst = let (Just y)     = lookup v ops -- get precedence
                                  (out',opst') = f y out opst 
                              in parser' out' (v:opst') xs
        f n o st = let (a,b) = span (\c -> n <= (fromJust $ lookup c ops)) st
                   in (o++a,b)