-- Demonstrates an expression parser and evaluator.
-- Uses the parser-building toolbox in ParserX.hs
-- by Scot Drysdale on 11/2/07

import ParserX

-- The following is the BNF grammar for parsing expressions, incorporating
-- correct precedence.

-- expr     = term [{'+' | '-'} term]...
-- term     = factor [{'*' | '/' } factor]...
-- factor   = number | variable | '(' expr ')'
-- number   = digits | digits '.' digits
-- variable = letter [letter | digit]...
-- digits   = digit [digit]...

-- Minor modfication of SOE expression in chap. 7 
data Expr = Const String 
          | Var String 
          | Expr :+ Expr       
          | Expr :- Expr
          | Expr :* Expr 
          | Expr :/ Expr
          deriving Show

-- Parses a single digit
digit :: Parser Char
digit = char ? isDigit

-- Parses a maximal sequence of digits.  Must be at least one.
parseDigits :: Parser String
parseDigits = takeRepeatParse digit

-- Parses a legal variable name
variable  :: Parser Expr
variable = elimSpacesAround (letter #: takeWhileParse (letter ! digit)) >-> Var

-- Parses a number, eliminating whitespace on both sides
number  :: Parser Expr
number = elimSpacesAround (parseDigits #++ (lit '.' #: parseDigits)
                         ! parseDigits) >-> Const
                           
-- Parses a factor
factor :: Parser Expr
factor = number ! variable ! elimSpacesAround ( lit '(' -# expr #- lit ')' )

-- Parses an series of the same precedence function, associating left
-- Passed a parser the desired expression type and a parser that parses the operations
parseSeries :: Parser Expr -> Parser (Expr -> Expr -> Expr) -> Parser Expr
parseSeries m opParser = elimSpacesAround (m # takeWhileParse (opParser # m) 
                                            >-> convertPairList)

-- Coverts a list of (operation, Expr) pairs into an expression
convertPairList  :: (Expr, [((Expr -> Expr -> Expr), Expr)]) -> Expr
convertPairList (first, exprList) = foldl (\l (op, r) -> l `op` r) first exprList

-- Parses a term
term :: Parser Expr
term = parseSeries factor (lit '*' >-> const (:*) ! lit '/' >-> const (:/))

-- Parses an expression
expr :: Parser Expr
expr = parseSeries term (lit '+' >-> const (:+) ! lit '-' >-> const (:-))




-- Evaluates an Expr, given an association list of variable bindings
-- Modification of evaluate from SOE

eval :: Expr -> [(String, Float)] -> Float
eval expr aList = evaluate expr
  where
    evaluate :: Expr -> Float

    evaluate (Const x)  = read x
    evaluate (Var name) = case lookup name aList of
                            Nothing -> error ("Unassigned variable " ++ name)
                            (Just x) -> x
    evaluate (e1 :+ e2) = evaluate e1 + evaluate e2
    evaluate (e1 :- e2) = evaluate e1 - evaluate e2
    evaluate (e1 :* e2) = evaluate e1 * evaluate e2
    evaluate (e1 :/ e2) = evaluate e1 / evaluate e2

-- Examples

e1  = "x + 5*y*factor2 - x/2 + (x - factor2 + 10.25)*(y - 2)"
(Just (ex1, "")) = expr e1
v1  = eval ex1 [("x",4), ("y", 6), ("factor2", 2)]