content: module ErrorChecking where
  
  import Prelude hiding (LT, GT, EQ, id)
  import FirstClassFunctions hiding (evaluate)
  import Operators
  
  --BEGIN:Hand5
  data Checked a = Good a | Error String
    deriving Show
  --END:Hand5
  
  --BEGIN:Hand8
  evaluate :: Exp -> Env -> Checked Value
  evaluate (Literal v) env = Good v
  --END:Hand8 BEGIN:Hand11
  evaluate (Variable x) env =
    case lookup x env of
      Nothing -> Error ("Variable " ++ x ++ " undefined")
      Just v  -> Good v
  --END:Hand11 BEGIN:Hand15
  evaluate (Unary op a) env =
    case evaluate a env of
      Error msg -> Error msg
      Good av ->   checked_unary op av
  evaluate (Binary op a b) env =
    case evaluate a env of
      Error msg -> Error msg
      Good av ->
        case evaluate b env of
          Error msg -> Error msg
          Good bv ->
            checked_binary op av bv
  --END:Hand15
  
  --BEGIN:Hand17
  checked_unary :: UnaryOp -> Value -> Checked Value
  checked_unary Not (BoolV b) = Good (BoolV (not b))
  checked_unary Neg (IntV i)  = Good (IntV (-i))
  checked_unary op   v         = 
      Error ("Unary " ++ show op 
        ++ " called with invalid argument " ++ show v)
  
  checked_binary :: BinaryOp -> Value -> Value -> Checked Value
  checked_binary Add (IntV a)  (IntV b)  = Good (IntV (a + b))
  checked_binary Sub (IntV a)  (IntV b)  = Good (IntV (a - b))
  checked_binary Mul (IntV a)  (IntV b)  = Good (IntV (a * b))
  checked_binary Div _         (IntV 0)  = Error "Divide by zero"
  checked_binary Div (IntV a)  (IntV b)  = Good (IntV (a `div` b))
  checked_binary And (BoolV a) (BoolV b) = Good (BoolV (a && b))
  checked_binary Or  (BoolV a) (BoolV b) = Good (BoolV (a || b))
  checked_binary LT  (IntV a)  (IntV b)  = Good (BoolV (a < b))
  checked_binary LE  (IntV a)  (IntV b)  = Good (BoolV (a <= b))
  checked_binary GE  (IntV a)  (IntV b)  = Good (BoolV (a >= b))
  checked_binary GT  (IntV a)  (IntV b)  = Good (BoolV (a > b))
  checked_binary EQ  a         b         = Good (BoolV (a == b))
  checked_binary op  a         b         = 
      Error ("Binary " ++ show op ++ 
             " called with invalid arguments " 
             ++ show a ++ ", " ++ show b)
  --END:Hand17
  
  