{-  Exploring Languages with Interpreters and Functional Programming
    ELI Calculator Language; Evaluator
    Copyright (C) 2017, 2018, 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 AbSynExpr, Environments, and ProcessAST.
            Used similar approach to ImpCore modularization.
            Allow for error returns from eval.
2017-11-04: Repaired bug in setNameBinding
2017-11-05: Modified imported items, improved comments
2018-08-09: Updated for 2018 ELIFP textbook, Expression Language
            renamed ELI Calculator language, file AbSynExpr renamed
            AbSynCalc, EvalExpr renamed EvalCalc
-}

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

-- Haskell libraries

-- ELI Calculator language modules
import Values       ( ValType, Name, defaultVal ) -- more items later
import AbSynCalc    ( Expr(..) ) -- uses ValType, Name
import Environments ( AnEnv, newEnv, toList, getBinding, -- uses Name
                      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 = setBinding 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