module EvalNoMonad
where

import Text.ParserCombinators.Parsec (runParser)
import Parser
import Data.Map as Map

data Value
  = VInt Integer
  | VBool Bool
  deriving Show

-- naiver nicht-monadischer interpreter
eval :: Exp -> Value
eval expr = case expr of
  Sum a b -> intOp (+) (eval a) (eval b)
  Diff a b -> intOp (-) (eval a) (eval b)
  Prod a b -> intOp (*) (eval a) (eval b)
  Quot a b -> intOp div (eval a) (eval b)
  Neg a    -> VInt $ case eval a of
     VInt x -> negate x
     _      -> throwTypeError
  Equal a b -> compareInts (==) a b
  NEqual a b -> compareInts (/=) a b
--  Ident a b -> ???
  Const a -> VInt a
  where
    intOp :: (Integer -> Integer -> Integer) -> Value -> Value -> Value
    intOp fkt (VInt a) (VInt b) = VInt $ fkt a b
    intOp _ _ _ = throwTypeError
    -- compackter: analog zu compareInts
    --  intOp :: (Integer -> Integer) -> Exp -> Exp -> Value

    compareInts :: (Integer -> Integer -> Bool) -> Exp -> Exp -> Value
    compareInts fkt a b = case (eval a, eval b) of
      (VInt va, VInt vb) -> VBool $ fkt va vb
      _ -> throwTypeError


throwTypeError :: a
throwTypeError = error "typeError"

test1 :: String -> Value
test1 src = case runParser parseExp () "testInput" src of
  Right expr -> eval expr
  Left err -> error $ show err


{-
Fuer Identifier brauch man ein Envirionment.
Wenn man das Envirionment manuell als Argument hinzufuegt muss
man den gesamten Interpreter umschreiben !
Mit Monaden kann man ein Envirioment hinzufuegen ohne alles umzuschreiben !
(Siehe Beispiel im anderen Modul)
-}

-- naives hinzufuegen des Envirionment:
type Env = Map String Value

initialEnv :: Env
initialEnv = Map.fromList [("x",VInt 1),("y",VInt 2),("z",VBool True)]

evalEnv :: Env -> Exp -> Value
evalEnv env expr = case expr of
  Sum a b -> intOp (+) (evalEnv env a) (evalEnv env b)
  Diff a b -> intOp (-) (evalEnv env a) (evalEnv env b)
  Prod a b -> intOp (*) (evalEnv env a) (evalEnv env b)
  Quot a b -> intOp div (evalEnv env a) (evalEnv env b)
  Neg a    -> VInt $ case evalEnv env a of
     VInt x -> negate x
     _      -> throwTypeError
  Equal a b -> compareInts env (==) a b
  NEqual a b -> compareInts env (/=) a b
-- die einzige Stelle in der env benutze wird ! 
  Ident i  -> case Map.lookup i env of
     Just v -> v
     Nothing -> error $ "undefined identifier" ++ show i
  Const a -> VInt a
  where
    intOp :: (Integer -> Integer -> Integer) -> Value -> Value -> Value
    intOp fkt (VInt a) (VInt b) = VInt $ fkt a b
    intOp _ _ _ = throwTypeError

    compareInts :: Env -> (Integer -> Integer -> Bool) -> Exp -> Exp -> Value
    compareInts env fkt a b = case (evalEnv env a, evalEnv env b) of
      (VInt va, VInt vb) -> VBool $ fkt va vb
      _ -> throwTypeError

test2 :: String -> Value
test2 src = case runParser parseExp () "testInput" src of
  Right expr -> evalEnv initialEnv expr
  Left err -> error $ show err