{-  CSci 450: Organization of Programming Languages
    Expression Language, Evaluator
    Fall 2017 
    H. Conrad Cunningham

1234567890123456789012345678901234567890123456789012345678901234567890

2017-04-03: Version based partly on previous work in Scala & Lua
2017-04-07: Updated with type aliases to match case study document
2017-05-23: Updated to match Prefix Parser V5
2017-06-02: Modified to include underscore as first char of
            identifier
2017-08-14: Prototype based on previous ExprLang and ImpCore work
2017-09-19: Separated out AbSynEval, Environments, and ProcessAST.
            Used similar approach to ImpCore modularization.
            Allow for error returns from eval.
2017-11-02: Extended with main function from Chapter
-}

module EvalExpr
    ( ValType, Name, Expr(..), Env, EvalErr, eval, lastVal,
      newEnviron, showEnviron, getNameBinding, hasNameBinding,
      newNameBinding, setNameBinding
    )
where

-- Haskell libraries

-- Expression Language modules
import Values       ( ValType, Name, defaultVal )
import AbSynExpr    ( Expr(..) )
import Environments ( AnEnv, Name, newEnv, toList, getBinding,
                      hasBinding, newBinding, setBinding, bindList )

-- Data types
type EvalErr = String
type Env     = AnEnv ValType


{-  Functions to create and update the environment used by the
    evaluator module and its clients. They use the generic
    functionality provided by the Environment module.
-}

-- Variable lastVal holds the value of the most recent previous
-- expression. 
lastVal :: Name
lastVal = "it"

-- Create a new environment with only lastVal set to default value
newEnviron :: Env
newEnviron = newBinding lastVal defaultVal newEnv

-- Get the current binding of a name wrappted in a Maybe
getNameBinding :: Name -> Env -> Maybe ValType
getNameBinding n env = getBinding n env

-- Is the name currently bound to a value in the environment?
hasNameBinding :: Name -> Env -> Bool
hasNameBinding n env = hasBinding n env

-- Create new variable n with the initial value v,
-- assuming the variable does not previously exist.
newNameBinding :: Name -> ValType -> Env -> Env
newNameBinding n v env = newBinding n v env

-- Set existing variable n to a new value v, assuming the variable
-- exists.
setNameBinding :: Name -> ValType -> Env -> Env
setNameBinding n v env = setNameBinding n v env


{-  Function "showEnviron" takes an environment and returns a string of
    its contents suitable for display.
-}

showEnviron:: Env -> String
showEnviron env =
    concatMap
        (\(n,v) -> n ++ "\t" ++ show v ++ "\n")
        (toList env)


-- Evaluate an expression tree
eval :: Expr -> Env -> Either EvalErr ValType

eval (Val v) _   = Right v

eval (Var n) env = 
    case getBinding n env of
        Nothing -> Left ("Undefined variable " ++ n)
        Just i  -> Right i

eval (Add l r) env =
    case (eval l env, eval r env) of
        (Right lv, Right rv) -> Right (lv + rv)
        (Left le,  Left re ) -> Left (le ++ "\n" ++ re)
        (x@(Left le),  _   ) -> x
        (_,     y@(Left le)) -> y

eval (Sub l r) env = 
    case (eval l env, eval r env) of
        (Right lv, Right rv) -> Right (lv - rv)
        (Left le,  Left re ) -> Left (le ++ "\n" ++ re)
        (x@(Left le),  _   ) -> x
        (_,     y@(Left le)) -> y

eval (Mul l r) env = 
    case (eval l env, eval r env) of
        (Right lv, Right rv) -> Right (lv * rv)
        (Left le,  Left re ) -> Left (le ++ "\n" ++ re)
        (x@(Left le),  _   ) -> x
        (_,     y@(Left le)) -> y

eval (Div l r) env =
    case (eval l env, eval r env) of
        (Right _,  Right 0 ) -> Left "Division by 0"
        (Right lv, Right rv) -> Right (lv `div` rv)
        (Left le,  Left re ) -> Left (le ++ "\n" ++ re)
        (x@(Left le),  _   ) -> x
        (_,     y@(Left le)) -> y

-- simple main function
main =
    do
        let env = [("x",5), ("y",7),("z",1)]
        let exp1 = Val 3          -- 3 
        let exp2 = Var "x"        -- x 
        let exp3 = Add (Val 1) (Val 2)    -- 1+2 
        let exp4 = Add (Var "x") (Val 3)  -- x + 3 
        let exp5 = Mul (Add (Var "x") (Var "y")) 
                       (Add (Val 2) (Var "z")) -- (x + y) * (2 + z) 
        putStrLn ("Expression: " ++ show exp1) 
        putStrLn ("Evaluation with x=5, y=7, z=1:  " 
                  ++ show (eval exp1 env))
        putStrLn ("Expression: " ++ show exp2) 
        putStrLn ("Evaluation with x=5, y=7, z=1:  "
                  ++ show (eval exp2 env))
        putStrLn ("Expression: " ++ show exp3) 
        putStrLn ("Evaluation with x=5, y=7, z=1:  "
                  ++ show (eval exp3 env))
        putStrLn ("Expression: " ++ show exp4) 
        putStrLn ("Evaluation with x=5, y=7, z=1:  "
                  ++ show (eval exp4 env))
        putStrLn ("Expression: " ++ show exp5) 
        putStrLn ("Evaluation with x=5, y=7, z=1:  "
                  ++ show (eval exp5 env))