module PulseLambda.Core
( Function(..)
, Primitive
, Value(..)
, boolFromValue
, valueFromBool
, Argument(..)
, Variable(..)
, Scope(..)
, BackTrace(..)
, getValueForVariable
, setValueForVariable
, evaluateFunction
, evaluateNode
, isBoolValue
, isIntValue
, isNaturalValue
, isRealValue
, isLargeIntValue
, isCharValue
, isStringValue
, isListValue
, isFunctionValue
, toBoolValue
, toIntValue
, toNaturalValue
, toLargeIntValue
, toRealValue
, toCharValue
, toStringValue
, toListValue
, toFunctionValue
, notValue
, sumValue
, negateValue
, subtractValue
, multiplyValue
, divideValue
, remainValue
, modulusValue
, powerValue
, factorialValue
) where
import Data.Fixed
import Data.Int
import Data.Word
import Data.Maybe
import PulseLambda.Utils
import PulseLambda.StrictCompare
import PulseLambda.Location
import PulseLambda.Ast
import PulseLambda.Error
import PulseLambda.Debuggable
import Control.Monad

newtype BackTrace = BT { btToList :: [Location]}

data Variable = Variable
    { getVarName :: String
    , getVarValue :: Value
    , isConstant :: Bool
    }

instance Show BackTrace where
    show (BT []) = ""
    show (BT (x:xs)) = show x ++ "\n" ++ show (BT xs)


data Scope
    = EmptyScope
    | Scope { getVars :: [Variable], getParentScope :: Scope }


data Argument
    = Argument { getArgName :: String, getDefault :: Value }
    | VariadicArgument { getArgName :: String }

instance Show Argument where
    show (VariadicArgument str) = str ++ "[]"
    show (Argument str dflt) = str ++ " = " ++ show dflt

instance Debuggable Argument where
    debug (VariadicArgument str) = str ++ "[]"
    debug (Argument str dflt) = str
        ++ ' ': ansiColorRedBright
        ++ '=' : ansiColorReset
        ++ ' ' : debug dflt

data Value
    = NullValue
    | TrueValue
    | FalseValue
    | IntValue { intFromValue :: Int64 }
    | LargeIntValue { integerFromValue :: Integer }
    | NaturalValue { wordFromValue :: Word64 }
    | RealValue { doubleFromValue :: Double }
    | CharValue { charFromValue :: Char }
    | StringValue { stringFromValue :: String }
    | ListValue { listFromValue :: [Value] }
    | FunctionValue { functionFromValue :: Function }

instance Show Value where
    show NullValue = "null"
    show TrueValue = "true"
    show FalseValue = "false"
    show (StringValue str) = str
    show (CharValue char) = [char]
    show (NaturalValue nat) = show nat
    show (IntValue int) = show int
    show (LargeIntValue int) = show int
    show (RealValue real) = show real
    show (FunctionValue func) = show func
    show (ListValue list) = "[" ++ stringifyList list where
        stringifyList [] = "]"
        stringifyList [x] = show x ++ "]"
        stringifyList (x:xs) = show x ++ ", " ++ stringifyList xs

instance Debuggable Value where
    debug NullValue = '(' : ansiColorMagentaBright ++ "null" ++ ansiColorReset ++ ")"
    debug TrueValue =  '(' : ansiColorMagentaBright
        ++ "bool"
        ++ ansiColorReset
        ++ ") "
        ++ ansiColorYellow
        ++ "true"
        ++ ansiColorReset
    debug FalseValue = '(' : ansiColorMagentaBright
        ++ "bool"
        ++ ansiColorReset
        ++ ") "
        ++ ansiColorYellow
        ++ "false"
        ++ ansiColorReset
    debug (NaturalValue x) = '(' : ansiColorMagentaBright
        ++ "natural"
        ++ ansiColorReset
        ++ ") "
        ++ ansiColorYellow
        ++ show x
        ++ ansiColorReset
    debug (IntValue x) = '(' : ansiColorMagentaBright
        ++ "int"
        ++ ansiColorReset
        ++ ") "
        ++ ansiColorYellow
        ++ show x
        ++ ansiColorReset
    debug (LargeIntValue x) = '(' : ansiColorMagentaBright
        ++ "largeInt"
        ++ ansiColorReset
        ++ ") "
        ++ ansiColorYellow
        ++ show x
        ++ ansiColorReset
    debug (RealValue x) = '(' : ansiColorMagentaBright
        ++ "real"
        ++ ansiColorReset
        ++ ") "
        ++ ansiColorYellow
        ++ show x
        ++ ansiColorReset
    debug (CharValue x) = '(' : ansiColorMagentaBright
        ++ "char"
        ++ ansiColorReset
        ++ ") "
        ++ ansiColorGreenBright
        ++ x : ansiColorReset
    debug (StringValue x) = '(' : ansiColorMagentaBright
        ++ "string"
        ++ ansiColorReset
        ++ ' ' : ansiColorYellow
        ++ (show . length) x
        ++ ansiColorReset
        ++ ") "
        ++ ansiColorGreenBright
        ++ x ++ ansiColorReset
    debug (ListValue x) = '(' : ansiColorMagentaBright
        ++ "list"
        ++ ansiColorReset
        ++ ' ' : ansiColorYellow
        ++ (show . length) x
        ++ ansiColorReset
        ++ ") "
        ++ ansiColorGreen
        ++ withList x ++ ansiColorReset
        where
            withList (_x:xs) = "[" ++ debug _x ++ _withList xs
            withList _ = "[]"
            _withList (_x:xs) = ", " ++ debug _x ++ _withList xs
            _withList _ = "]"
    debug (FunctionValue func) = '(' : ansiColorMagentaBright
        ++ "function"
        ++ ansiColorReset
        ++ ") "
        ++ debug func


instance Eq Value where
    NullValue == NullValue = True
    NullValue == FalseValue = True
    NullValue == IntValue x = toIntValue NullValue == IntValue x
    NullValue == LargeIntValue x = toLargeIntValue NullValue == LargeIntValue x
    NullValue == NaturalValue x = toNaturalValue NullValue == NaturalValue x
    NullValue == RealValue x = toRealValue NullValue == RealValue x
    NullValue == ListValue list = null list
    NullValue == StringValue str = null str
    FalseValue == FalseValue = True
    FalseValue == TrueValue = False
    FalseValue == x = FalseValue == toBoolValue x
    TrueValue == TrueValue = True
    TrueValue == x = TrueValue == toBoolValue x
    CharValue a == CharValue b = a == b
    CharValue a == b = CharValue a == toCharValue b
    NaturalValue a == NaturalValue b = a == b
    NaturalValue a == b = NaturalValue a == toNaturalValue b
    IntValue a == IntValue b = a == b
    IntValue a == b = IntValue a == toIntValue b
    LargeIntValue a == LargeIntValue b = a == b
    LargeIntValue a == b = LargeIntValue a == toLargeIntValue b
    RealValue a == RealValue b = a == b
    RealValue a == b = RealValue a == toRealValue b
    StringValue a == StringValue b = a == b
    StringValue a == b = StringValue a == toStringValue b
    ListValue a == ListValue b = a == b
    ListValue a == b = ListValue a == toListValue b
    FunctionValue a == FunctionValue b = a == b
    FunctionValue a == b = FunctionValue a == toFunctionValue b
    _ == _ = False

instance StrictEq Value where
    NullValue ==@ NullValue = True
    FalseValue ==@ FalseValue = True
    TrueValue ==@ TrueValue = True
    NaturalValue a ==@ NaturalValue b = a == b
    IntValue a ==@ IntValue b = a == b
    LargeIntValue a ==@ LargeIntValue b = a == b
    RealValue a ==@ RealValue b = a == b
    CharValue a ==@ CharValue b = a == b
    StringValue a ==@ StringValue b = a == b
    ListValue a ==@ ListValue b = a == b
    FunctionValue a ==@ FunctionValue b = a == b
    _ ==@ _ = False

instance Ord Value where
    NullValue `compare` NullValue = EQ
    NullValue `compare` FalseValue = EQ
    NullValue `compare` IntValue x = toIntValue NullValue `compare` IntValue x
    NullValue `compare` LargeIntValue x = toLargeIntValue NullValue `compare` LargeIntValue x
    NullValue `compare` NaturalValue x = toNaturalValue NullValue `compare` NaturalValue x
    NullValue `compare` RealValue x = toRealValue NullValue `compare` RealValue x
    NullValue `compare` ListValue list = if null list then EQ else LT
    NullValue `compare` StringValue str = if null str then EQ else LT
    FalseValue `compare` FalseValue = EQ
    FalseValue `compare` TrueValue = LT
    FalseValue `compare` x = FalseValue `compare` toBoolValue x
    TrueValue `compare` TrueValue = EQ
    TrueValue `compare` FalseValue = GT
    TrueValue `compare` x = TrueValue `compare` toBoolValue x
    CharValue a `compare` CharValue b = a `compare` b
    CharValue a `compare` b = CharValue a `compare` toCharValue b
    NaturalValue a `compare` NaturalValue b = a `compare` b
    NaturalValue a `compare` b = NaturalValue a `compare` toNaturalValue b
    IntValue a `compare` IntValue b = a `compare` b
    IntValue a `compare` b = IntValue a `compare` toIntValue b
    LargeIntValue a `compare` LargeIntValue b = a `compare` b
    LargeIntValue a `compare` b = LargeIntValue a `compare` toLargeIntValue b
    RealValue a `compare` RealValue b = a `compare` b
    RealValue a `compare` b = RealValue a `compare` toRealValue b
    StringValue a `compare` StringValue b = a `compare` b
    StringValue a `compare` b = StringValue a `compare` toStringValue b
    ListValue a `compare` ListValue b = a `compare` b
    ListValue a `compare` b = ListValue a `compare` toListValue b
    FunctionValue a `compare` FunctionValue b = a `compare` b
    FunctionValue a `compare` b = FunctionValue a `compare` toFunctionValue b

instance StrictOrd Value where
    NullValue <=>@ NullValue = StrictEQ
    FalseValue <=>@ FalseValue = StrictEQ
    FalseValue <=>@ TrueValue = StrictLT
    TrueValue <=>@ TrueValue = StrictEQ
    TrueValue <=>@ FalseValue = StrictGT
    CharValue a <=>@ CharValue b = toStrictOrdering $! a `compare` b
    NaturalValue a <=>@ NaturalValue b = toStrictOrdering $! a `compare` b
    IntValue a <=>@ IntValue b = toStrictOrdering $! a `compare` b
    LargeIntValue a <=>@ LargeIntValue b = toStrictOrdering $! a `compare` b
    RealValue a <=>@ RealValue b = toStrictOrdering $! a `compare` b
    StringValue a <=>@ StringValue b = toStrictOrdering $! a `compare` b
    ListValue a <=>@ ListValue b = toStrictOrdering $! a `compare` b
    FunctionValue a <=>@ FunctionValue b = toStrictOrdering $! a `compare` b
    _ <=>@ _ = StrictNC

type Primitive = BackTrace -> [Value] -> IO Value

data Function
    = Function
        { getArgsDeclare :: [Argument]
        , getBody ::  Node
        , getConstEnv :: Scope
        }
    | PrimitiveFunction
        { primitiveFromFunction :: Primitive
        }

instance Show Function where
    show (PrimitiveFunction _) = "primitive(args[])"
    show (Function args _ _) = "lambda(" ++ showArgs args ++ ")" where
        showArgs [] = ""
        showArgs [x] = show x
        showArgs (x:xs) = show x ++ ", " ++ showArgs xs

instance Debuggable Function where
    debug (PrimitiveFunction _) = ansiColorCyan ++ "primitive" ++ ansiColorReset ++ "(args[])"
    debug (Function args _ _) = ansiColorBlueBright ++ "lambda" ++ ansiColorReset ++ '(' : dbgArgs args ++ ")"
        where
            dbgArgs [] = ""
            dbgArgs [x] = debug x
            dbgArgs (x:xs) = debug x ++ ", " ++ dbgArgs xs

instance Eq Function where
    PrimitiveFunction _ == PrimitiveFunction _ = True
    Function [] _ _ == Function [] _ _ = True
    Function [VariadicArgument _] _ _ == Function [VariadicArgument _] _ _ = True
    Function (_:xs1) b1 env1 == Function (_:xs2) b2 env2 = Function xs1 b1 env1 == Function xs2 b2 env2
    _ == _ = False

instance Ord Function where
    PrimitiveFunction _ `compare` PrimitiveFunction _ = EQ
    Function [] _ _ `compare` PrimitiveFunction _ = LT
    Function [VariadicArgument _] _ _ `compare` PrimitiveFunction _ = EQ
    Function {} `compare` PrimitiveFunction _ = GT
    PrimitiveFunction _ `compare` Function [] _ _  = GT
    PrimitiveFunction _ `compare`  Function [VariadicArgument _] _ _ = EQ
    PrimitiveFunction _ `compare` Function {} = LT
    Function [VariadicArgument _] _ _ `compare` Function [VariadicArgument _] _ _ = EQ
    Function [] _ _ `compare` Function [] _ _ = EQ
    Function [] _ _ `compare` Function (_:_) _ _ = LT
    Function (_:_) _ _ `compare` Function [] _ _ = GT
    Function [VariadicArgument _] _ _ `compare` Function (_:_) _ _ = LT
    Function (_:_) _ _ `compare` Function [VariadicArgument _] _ _ = GT
    Function (_:xs1) b1 env1 `compare` Function (_:xs2) b2 env2 =
        Function xs1 b1 env1 `compare` Function xs2 b2 env2


boolFromValue :: Value -> Bool
boolFromValue TrueValue = True
boolFromValue FalseValue = False

valueFromBool :: Bool -> Value
valueFromBool bool = if bool
    then TrueValue
    else FalseValue

isBoolValue :: Value -> Bool
isBoolValue TrueValue = True
isBoolValue FalseValue = True
isBoolValue _ = False

isIntValue :: Value -> Bool
isIntValue (IntValue _) = True
isIntValue _ = False

isNaturalValue :: Value -> Bool
isNaturalValue (NaturalValue _) = True
isNaturalValue _ = False

isRealValue :: Value -> Bool
isRealValue (RealValue _) = True
isRealValue _ = False

isLargeIntValue :: Value -> Bool
isLargeIntValue (LargeIntValue _) = True
isLargeIntValue _ = False

isCharValue :: Value -> Bool
isCharValue (CharValue _) = True
isCharValue _ = False

isStringValue :: Value -> Bool
isStringValue (StringValue _) = True
isStringValue _ = False

isListValue :: Value -> Bool
isListValue (ListValue _) = True
isListValue _ = False

isFunctionValue :: Value -> Bool
isFunctionValue (FunctionValue _) = True
isFunctionValue _ = False

toBoolValue :: Value -> Value
toBoolValue FalseValue = FalseValue
toBoolValue NullValue = FalseValue
toBoolValue (IntValue 0) = FalseValue
toBoolValue (NaturalValue 0) = FalseValue
toBoolValue (LargeIntValue 0) = FalseValue
toBoolValue (RealValue 0) = FalseValue
toBoolValue (CharValue '\0') = FalseValue
toBoolValue (StringValue "") = FalseValue
toBoolValue (ListValue []) = FalseValue
toBoolValue _ = TrueValue

toNaturalValue :: Value -> Value
toNaturalValue NullValue = NaturalValue 0
toNaturalValue FalseValue = NaturalValue 0
toNaturalValue TrueValue = NaturalValue 1
toNaturalValue (NaturalValue x) = NaturalValue x
toNaturalValue (IntValue x) = (NaturalValue . fromIntegral) x
toNaturalValue (LargeIntValue x) = (NaturalValue . fromInteger) x
toNaturalValue (RealValue x) = (NaturalValue . truncate) x
toNaturalValue (CharValue x) = (NaturalValue . fromIntegral . fromEnum) x
toNaturalValue (StringValue x) =
    let maybeRead = reads x :: [(Word64, String)]
    in NaturalValue (case maybeRead of
        [(val, _)] -> val
        _ -> 0)
toNaturalValue (ListValue x) = (NaturalValue . fromIntegral . length) x
toNaturalValue (FunctionValue f) = (NaturalValue . fromIntegral . countArgs) f

toIntValue :: Value -> Value
toIntValue NullValue = IntValue 0
toIntValue FalseValue = IntValue 0
toIntValue TrueValue = IntValue 1
toIntValue (NaturalValue x) = (IntValue . fromIntegral) x
toIntValue (IntValue x) = IntValue x
toIntValue (LargeIntValue x) = (IntValue . fromInteger) x
toIntValue (RealValue x) = (IntValue . truncate) x
toIntValue (CharValue x) = (IntValue . fromIntEnum) x
toIntValue (StringValue x) =
    let maybeRead = reads x :: [(Int64, String)]
    in IntValue (case maybeRead of
        [(val, _)] -> val
        _ -> 0)
toIntValue (ListValue x) = (IntValue . fromIntegral . length) x
toIntValue (FunctionValue f) = (IntValue . fromIntegral . countArgs) f

toLargeIntValue :: Value -> Value
toLargeIntValue NullValue = LargeIntValue 0
toLargeIntValue FalseValue = LargeIntValue 0
toLargeIntValue TrueValue = LargeIntValue 1
toLargeIntValue (NaturalValue x) = (LargeIntValue . toInteger) x
toLargeIntValue (IntValue x) = (LargeIntValue . toInteger) x
toLargeIntValue (LargeIntValue x) = LargeIntValue x
toLargeIntValue (RealValue x) = (LargeIntValue . truncate) x
toLargeIntValue (CharValue x) = (LargeIntValue . toInteger . fromEnum) x
toLargeIntValue (StringValue x) =
    let maybeRead = reads x :: [(Integer, String)]
    in LargeIntValue (case maybeRead of
        [(val, _)] -> val
        _ -> 0)
toLargeIntValue (ListValue x) = (LargeIntValue . toInteger . length) x
toLargeIntValue (FunctionValue f) = (LargeIntValue . fromIntegral . countArgs) f

toRealValue :: Value -> Value
toRealValue NullValue = RealValue 0
toRealValue FalseValue = RealValue 0
toRealValue TrueValue = RealValue 1
toRealValue (NaturalValue x) = (RealValue . fromIntegral) x
toRealValue (IntValue x) = (RealValue . fromIntegral) x
toRealValue (LargeIntValue x) = (RealValue . fromIntegral) x
toRealValue (RealValue x) = RealValue x
toRealValue (CharValue x) = (RealValue . fromIntegral . fromEnum) x
toRealValue (StringValue x) =
    let maybeRead = reads x :: [(Double, String)]
    in RealValue (case maybeRead of
        [(val, _)] -> val
        _ -> 0.0)
toRealValue (ListValue x) = (RealValue . fromIntegral . length) x
toRealValue (FunctionValue f) = (RealValue . fromIntegral . countArgs) f

toCharValue :: Value -> Value
toCharValue NullValue = CharValue '\0'
toCharValue FalseValue = CharValue '\0'
toCharValue TrueValue = CharValue '\1'
toCharValue (NaturalValue x) = (CharValue . integralToCharEnum) x
toCharValue (IntValue x) = (CharValue .integralToCharEnum) x
toCharValue (LargeIntValue x) = (CharValue . integralToCharEnum) x
toCharValue (RealValue x) = (CharValue . realToCharEnum) x
toCharValue (CharValue x) = CharValue x
toCharValue (StringValue []) = CharValue $ integralToCharEnum 0
toCharValue (StringValue (x:_)) = CharValue x
toCharValue (ListValue x) = (CharValue . integralToCharEnum . length) x
toCharValue (FunctionValue f) = (CharValue . integralToCharEnum . countArgs) f

toStringValue :: Value -> Value
toStringValue = StringValue . show

toListValue :: Value -> Value
toListValue (ListValue xs) = ListValue xs
toListValue NullValue = ListValue []
toListValue x = ListValue [x]

toFunctionValue :: Value -> Value
toFunctionValue (FunctionValue f) = FunctionValue f
toFunctionValue x = (FunctionValue . PrimitiveFunction) (\ _ _ -> return x)

countArgs :: Function -> Int
countArgs (PrimitiveFunction _) = 0
countArgs (Function (VariadicArgument _:_) _ _) = 0
countArgs (Function [] _ _) = 0
countArgs (Function (_:xs) body env) = 1 + countArgs (Function xs body env)

notValue :: Value -> Value
notValue TrueValue = FalseValue
notValue FalseValue = TrueValue
notValue val = (notValue . toBoolValue) val

negateValue :: Value -> Value
negateValue (NaturalValue x) = NaturalValue (-x)
negateValue (IntValue x) = IntValue (-x)
negateValue (LargeIntValue x) = LargeIntValue (-x)
negateValue (RealValue x) = RealValue (-x)
negateValue (CharValue x) = (CharValue . integralToCharEnum) (- fromEnum x)
negateValue (StringValue x) = StringValue $! map (charFromValue . toCharValue . negateValue . CharValue) x
negateValue (ListValue x) = ListValue $! map negateValue x
negateValue x = IntValue $! - (intFromValue . toIntValue) x

sumValue :: Value -> Value -> Value
sumValue (NaturalValue x) (IntValue y) = IntValue
    $! (intFromValue . toIntValue . NaturalValue) x + y
sumValue (NaturalValue x) (LargeIntValue y) = LargeIntValue
    $! (integerFromValue . toLargeIntValue . NaturalValue) x + y
sumValue (NaturalValue x) (RealValue y) = RealValue
    $! (doubleFromValue . toRealValue . NaturalValue) x + y
sumValue (NaturalValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . sumValue (NaturalValue x) . CharValue) y
sumValue (NaturalValue x) (ListValue y) = ListValue $! map (sumValue $! NaturalValue x) y
sumValue (NaturalValue x) y = NaturalValue $! x + (wordFromValue . toNaturalValue) y
sumValue (IntValue x) (LargeIntValue y) = LargeIntValue
    $! (integerFromValue . toLargeIntValue . IntValue) x + y
sumValue (IntValue x) (RealValue y) = RealValue
    $! (doubleFromValue . toRealValue . IntValue) x + y
sumValue (IntValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . sumValue (IntValue x) . CharValue) y
sumValue (IntValue x) (ListValue y) = ListValue $! map (sumValue $! IntValue x) y
sumValue (IntValue x) y = IntValue $! x + (intFromValue . toIntValue) y
sumValue (LargeIntValue x) (RealValue y) = RealValue
    $! (doubleFromValue . toRealValue . LargeIntValue) x + y
sumValue (LargeIntValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . sumValue (LargeIntValue x) . CharValue) y
sumValue (LargeIntValue x) (ListValue y) = ListValue $! map (sumValue $! LargeIntValue x) y
sumValue (LargeIntValue x) y = LargeIntValue $! x + (integerFromValue . toLargeIntValue) y
sumValue (RealValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . sumValue (RealValue x) . CharValue) y
sumValue (RealValue x) (ListValue y) = ListValue $! map (sumValue $! RealValue x) y
sumValue (RealValue x) y = RealValue $! x + (doubleFromValue . toRealValue) y
sumValue (CharValue x) (NaturalValue y) = (CharValue . integralToCharEnum) $! fromIntEnum x + y
sumValue (CharValue x) (IntValue y) = (CharValue . integralToCharEnum) $! fromIntEnum x + y
sumValue (CharValue x) (LargeIntValue y) = (CharValue . integralToCharEnum) $! fromIntEnum x + y
sumValue (CharValue x) (RealValue y) = (CharValue . realToCharEnum) $! fromIntEnum x + y
sumValue (CharValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . sumValue (CharValue x) . CharValue) y
sumValue (CharValue x) (ListValue y) = ListValue $! map (sumValue $! CharValue x) y
sumValue (CharValue x) y = (CharValue . integralToCharEnum)
    $! fromEnum x + (fromEnum . charFromValue . toCharValue) y
sumValue (ListValue x) NullValue = ListValue x
sumValue (ListValue x) FalseValue = ListValue x
sumValue (ListValue x) (ListValue y) = ListValue $! zipWithFill sumValue id id x y
sumValue (ListValue x) (StringValue y) = ListValue $! zipWithFill
    (\ val char -> sumValue val $! CharValue char) id CharValue x y
sumValue (ListValue x) y = ListValue $! map (`sumValue` y) x
sumValue (StringValue x) NullValue = StringValue x
sumValue (StringValue x) FalseValue = StringValue x
sumValue (StringValue x) (ListValue y) = StringValue $! zipWithFill (\ ch val ->
    (charFromValue . toCharValue . sumValue (CharValue ch)) val)
    id (charFromValue . toCharValue) x y
sumValue (StringValue x) (StringValue y) = StringValue $! zipWithFill (\ chX chY ->
    (charFromValue . toCharValue . sumValue (CharValue chX)) (CharValue chY)) id id x y
sumValue (StringValue x) y = StringValue $! map (\ char ->
    (charFromValue . toCharValue . sumValue (CharValue char)) y) x
sumValue NullValue y = y
sumValue FalseValue y = y
sumValue x (NaturalValue y) = NaturalValue $! (wordFromValue . toNaturalValue) x + y
sumValue x (IntValue y) = IntValue $! (intFromValue . toIntValue) x + y
sumValue x (LargeIntValue y) = LargeIntValue $! (integerFromValue . toLargeIntValue) x + y
sumValue x (RealValue y) = RealValue $! (doubleFromValue . toRealValue) x + y
sumValue x (CharValue y) = (CharValue . integralToCharEnum) $! intFromValue (toIntValue x) + fromIntEnum y
sumValue x (StringValue y) = StringValue
    $! map ((charFromValue . toCharValue . sumValue x) . CharValue) y
sumValue x (ListValue y) = ListValue $! map (sumValue x) y
sumValue x y = sumValue (toIntValue x) (toIntValue y)


subtractValue :: Value -> Value -> Value
subtractValue (NaturalValue x) (IntValue y) = IntValue
    $! (intFromValue . toIntValue . NaturalValue) x - y
subtractValue (NaturalValue x) (LargeIntValue y) = LargeIntValue
    $! (integerFromValue . toLargeIntValue . NaturalValue) x - y
subtractValue (NaturalValue x) (RealValue y) = RealValue
    $! (doubleFromValue . toRealValue . NaturalValue) x - y
subtractValue (NaturalValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . subtractValue (NaturalValue x) . CharValue) y
subtractValue (NaturalValue x) (ListValue y) = ListValue $! map (subtractValue $! NaturalValue x) y
subtractValue (NaturalValue x) y = NaturalValue $! x - (wordFromValue . toNaturalValue) y
subtractValue (IntValue x) (LargeIntValue y) = LargeIntValue
    $! (integerFromValue . toLargeIntValue . IntValue) x - y
subtractValue (IntValue x) (RealValue y) = RealValue
    $! (doubleFromValue . toRealValue . IntValue) x - y
subtractValue (IntValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . subtractValue (IntValue x) . CharValue) y
subtractValue (IntValue x) (ListValue y) = ListValue $! map (subtractValue $! IntValue x) y
subtractValue (IntValue x) y = IntValue $! x - (intFromValue . toIntValue) y
subtractValue (LargeIntValue x) (RealValue y) = RealValue
    $! (doubleFromValue . toRealValue . LargeIntValue) x - y
subtractValue (LargeIntValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . subtractValue (LargeIntValue x) . CharValue) y
subtractValue (LargeIntValue x) (ListValue y) = ListValue $! map (subtractValue $! LargeIntValue x) y
subtractValue (LargeIntValue x) y = LargeIntValue $! x - (integerFromValue . toLargeIntValue) y
subtractValue (RealValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . subtractValue (RealValue x) . CharValue) y
subtractValue (RealValue x) (ListValue y) = ListValue $! map (subtractValue $! RealValue x) y
subtractValue (RealValue x) y = RealValue $! x - (doubleFromValue . toRealValue) y
subtractValue (CharValue x) (NaturalValue y) = (CharValue . integralToCharEnum) $! fromIntEnum x - y
subtractValue (CharValue x) (IntValue y) = (CharValue . integralToCharEnum) $! fromIntEnum x - y
subtractValue (CharValue x) (LargeIntValue y) = (CharValue . integralToCharEnum) $! fromIntEnum x - y
subtractValue (CharValue x) (RealValue y) = (CharValue . realToCharEnum) $! fromIntEnum x - y
subtractValue (CharValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . subtractValue (CharValue x) . CharValue) y
subtractValue (CharValue x) (ListValue y) = ListValue $! map (subtractValue $! CharValue x) y
subtractValue (CharValue x) y = (CharValue . integralToCharEnum)
    $! fromEnum x - (fromEnum . charFromValue . toCharValue) y
subtractValue (ListValue x) NullValue = ListValue x
subtractValue (ListValue x) FalseValue = ListValue x
subtractValue (ListValue x) (ListValue y) = ListValue $! zipWithFill subtractValue id id x y
subtractValue (ListValue x) (StringValue y) = ListValue $! zipWithFill
    (\ val char -> subtractValue val $! CharValue char) id CharValue x y
subtractValue (ListValue x) y = ListValue $! map (`subtractValue` y) x
subtractValue (StringValue x) NullValue = StringValue x
subtractValue (StringValue x) FalseValue = StringValue x
subtractValue (StringValue x) (ListValue y) = StringValue $! zipWithFill (\ ch val ->
    (charFromValue . toCharValue . subtractValue (CharValue ch)) val)
    id (charFromValue . toCharValue) x y
subtractValue (StringValue x) (StringValue y) = StringValue $! zipWithFill (\ chX chY ->
    (charFromValue . toCharValue . subtractValue (CharValue chX)) (CharValue chY)) id id x y
subtractValue (StringValue x) y = StringValue $! map (\ char ->
    (charFromValue . toCharValue . subtractValue (CharValue char)) y) x
subtractValue NullValue y = negateValue y
subtractValue FalseValue y = negateValue y
subtractValue x (NaturalValue y) = NaturalValue $! (wordFromValue . toNaturalValue) x - y
subtractValue x (IntValue y) = IntValue $! (intFromValue . toIntValue) x - y
subtractValue x (LargeIntValue y) = LargeIntValue $! (integerFromValue . toLargeIntValue) x - y
subtractValue x (RealValue y) = RealValue $! (doubleFromValue . toRealValue) x - y
subtractValue x (CharValue y) = (CharValue . integralToCharEnum) $! intFromValue (toIntValue x) - fromIntEnum y
subtractValue x (StringValue y) = StringValue
    $! map ((charFromValue . toCharValue . subtractValue x) . CharValue) y
subtractValue x (ListValue y) = ListValue $! map (subtractValue x) y
subtractValue x y = subtractValue (toIntValue x) (toIntValue y)

multiplyValue :: Value -> Value -> Value
multiplyValue (NaturalValue x) (IntValue y) = IntValue
    $! (intFromValue . toIntValue . NaturalValue) x * y
multiplyValue (NaturalValue x) (LargeIntValue y) = LargeIntValue
    $! (integerFromValue . toLargeIntValue . NaturalValue) x * y
multiplyValue (NaturalValue x) (RealValue y) = RealValue
    $! (doubleFromValue . toRealValue . NaturalValue) x * y
multiplyValue (NaturalValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . multiplyValue (NaturalValue x) . CharValue) y
multiplyValue (NaturalValue x) (ListValue y) = ListValue $! map (multiplyValue $! NaturalValue x) y
multiplyValue (NaturalValue x) y = NaturalValue $! x * (wordFromValue . toNaturalValue) y
multiplyValue (IntValue x) (LargeIntValue y) = LargeIntValue
    $! (integerFromValue . toLargeIntValue . IntValue) x * y
multiplyValue (IntValue x) (RealValue y) = RealValue
    $! (doubleFromValue . toRealValue . IntValue) x * y
multiplyValue (IntValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . multiplyValue (IntValue x) . CharValue) y
multiplyValue (IntValue x) (ListValue y) = ListValue $! map (multiplyValue $! IntValue x) y
multiplyValue (IntValue x) y = IntValue $! x * (intFromValue . toIntValue) y
multiplyValue (LargeIntValue x) (RealValue y) = RealValue
    $! (doubleFromValue . toRealValue . LargeIntValue) x * y
multiplyValue (LargeIntValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . multiplyValue (LargeIntValue x) . CharValue) y
multiplyValue (LargeIntValue x) (ListValue y) = ListValue $! map (multiplyValue $! LargeIntValue x) y
multiplyValue (LargeIntValue x) y = LargeIntValue $! x * (integerFromValue . toLargeIntValue) y
multiplyValue (RealValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . multiplyValue (RealValue x) . CharValue) y
multiplyValue (RealValue x) (ListValue y) = ListValue $! map (multiplyValue $! RealValue x) y
multiplyValue (RealValue x) y = RealValue $! x * (doubleFromValue . toRealValue) y
multiplyValue (CharValue x) (NaturalValue y) = (CharValue . integralToCharEnum) $! fromIntEnum x * y
multiplyValue (CharValue x) (IntValue y) = (CharValue . integralToCharEnum) $! fromIntEnum x * y
multiplyValue (CharValue x) (LargeIntValue y) = (CharValue . integralToCharEnum) $! fromIntEnum x * y
multiplyValue (CharValue x) (RealValue y) = (CharValue . realToCharEnum) $! fromIntEnum x * y
multiplyValue (CharValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . multiplyValue (CharValue x) . CharValue) y
multiplyValue (CharValue x) (ListValue y) = ListValue $! map (multiplyValue $! CharValue x) y
multiplyValue (CharValue x) y = (CharValue . integralToCharEnum)
    $! fromEnum x * (fromEnum . charFromValue . toCharValue) y
multiplyValue (ListValue x) NullValue = ListValue x
multiplyValue (ListValue x) FalseValue = ListValue x
multiplyValue (ListValue x) (ListValue y) = ListValue $! zipWithFill multiplyValue id id x y
multiplyValue (ListValue x) (StringValue y) = ListValue $! zipWithFill
    (\ val char -> multiplyValue val $! CharValue char) id CharValue x y
multiplyValue (ListValue x) y = ListValue $! map (`multiplyValue` y) x
multiplyValue (StringValue x) NullValue = StringValue x
multiplyValue (StringValue x) FalseValue = StringValue x
multiplyValue (StringValue x) (ListValue y) = StringValue $! zipWithFill (\ ch val ->
    (charFromValue . toCharValue . multiplyValue (CharValue ch)) val)
    id (charFromValue . toCharValue) x y
multiplyValue (StringValue x) (StringValue y) = StringValue $! zipWithFill (\ chX chY ->
    (charFromValue . toCharValue . multiplyValue (CharValue chX)) (CharValue chY)) id id x y
multiplyValue (StringValue x) y = StringValue $! map (\ char ->
    (charFromValue . toCharValue . multiplyValue (CharValue char)) y) x
multiplyValue x (NaturalValue y) = NaturalValue $! (wordFromValue . toNaturalValue) x * y
multiplyValue x (IntValue y) = IntValue $! (intFromValue . toIntValue) x * y
multiplyValue x (LargeIntValue y) = LargeIntValue $! (integerFromValue . toLargeIntValue) x * y
multiplyValue x (RealValue y) = RealValue $! (doubleFromValue . toRealValue) x * y
multiplyValue x (CharValue y) = (CharValue . integralToCharEnum) $! intFromValue (toIntValue x) * fromIntEnum y
multiplyValue x (StringValue y) = StringValue
    $! map ((charFromValue . toCharValue . multiplyValue x) . CharValue) y
multiplyValue x (ListValue y) = ListValue $! map (multiplyValue x) y
multiplyValue x y = multiplyValue (toIntValue x) (toIntValue y)


divideValue :: Value -> Value -> Value
divideValue (NaturalValue x) (IntValue y) = if y == 0
    then NullValue
    else IntValue $! (intFromValue . toIntValue . NaturalValue) x `div` y
divideValue (NaturalValue x) (LargeIntValue y) = if y == 0
    then NullValue
    else LargeIntValue $! (integerFromValue . toLargeIntValue . NaturalValue) x `div` y
divideValue (NaturalValue x) (RealValue y) = RealValue $! (doubleFromValue . toRealValue . NaturalValue) x / y
divideValue (NaturalValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . divideValue (NaturalValue x) . CharValue) y
divideValue (NaturalValue x) (ListValue y) = ListValue $! map (divideValue $! NaturalValue x) y
divideValue (NaturalValue x) y = if valY == 0
    then NullValue
    else NaturalValue $! x `div` valY
    where valY = (wordFromValue . toNaturalValue) y
divideValue (IntValue x) (LargeIntValue y) = if y == 0
    then NullValue
    else LargeIntValue $! (integerFromValue . toLargeIntValue . IntValue) x `div` y
divideValue (IntValue x) (RealValue y) = RealValue $! (doubleFromValue . toRealValue . IntValue) x / y
divideValue (IntValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . divideValue (IntValue x) . CharValue) y
divideValue (IntValue x) (ListValue y) = ListValue $! map (divideValue $! IntValue x) y
divideValue (IntValue x) y = if valY == 0
    then NullValue
    else IntValue $! x `div` valY
    where valY = (intFromValue . toIntValue) y
divideValue (LargeIntValue x) (RealValue y) = RealValue $! (doubleFromValue . toRealValue . LargeIntValue) x / y
divideValue (LargeIntValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . divideValue (LargeIntValue x) . CharValue) y
divideValue (LargeIntValue x) (ListValue y) = ListValue $! map (divideValue $! LargeIntValue x) y
divideValue (LargeIntValue x) y = if valY == 0
    then NullValue
    else LargeIntValue $! x `div`  valY
    where valY = (integerFromValue . toLargeIntValue) y
divideValue (RealValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . divideValue (RealValue x) . CharValue) y
divideValue (RealValue x) (ListValue y) = ListValue $! map (divideValue $! RealValue x) y
divideValue (RealValue x) y = RealValue $! x / (doubleFromValue . toRealValue) y
divideValue (CharValue x) (NaturalValue y) = if y == 0
    then NullValue
    else (CharValue . integralToCharEnum) $! fromIntEnum x `div` y
divideValue (CharValue x) (IntValue y) = if y == 0
    then NullValue
    else (CharValue . integralToCharEnum) $! fromIntEnum x `div` y
divideValue (CharValue x) (LargeIntValue y) = if y == 0
    then NullValue
    else (CharValue . integralToCharEnum) $! fromIntEnum x `div` y
divideValue (CharValue x) (RealValue y) = (CharValue . realToCharEnum) $! fromIntEnum x / y
divideValue (CharValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . divideValue (CharValue x) . CharValue) y
divideValue (CharValue x) (ListValue y) = ListValue $! map (divideValue $! CharValue x) y
divideValue (CharValue x) y = if valY == 0
    then NullValue
    else (CharValue . integralToCharEnum) $! fromEnum x `div` valY
    where valY = (fromEnum . charFromValue . toCharValue) y
divideValue (ListValue x) NullValue = ListValue x
divideValue (ListValue x) FalseValue = ListValue x
divideValue (ListValue x) (ListValue y) = ListValue $! zipWithFill divideValue id id x y
divideValue (ListValue x) (StringValue y) = ListValue $! zipWithFill
    (\ val char -> divideValue val $! CharValue char) id CharValue x y
divideValue (ListValue x) y = ListValue $! map (`divideValue` y) x
divideValue (StringValue x) NullValue = StringValue x
divideValue (StringValue x) FalseValue = StringValue x
divideValue (StringValue x) (ListValue y) = StringValue $! zipWithFill (\ ch val ->
    (charFromValue . toCharValue . divideValue (CharValue ch)) val)
    id (charFromValue . toCharValue) x y
divideValue (StringValue x) (StringValue y) = StringValue $! zipWithFill (\ chX chY ->
    (charFromValue . toCharValue . divideValue (CharValue chX)) (CharValue chY)) id id x y
divideValue (StringValue x) y = StringValue $! map (\ char ->
    (charFromValue . toCharValue . divideValue (CharValue char)) y) x
divideValue x (NaturalValue y) = if y == 0
    then NullValue
    else NaturalValue $! (wordFromValue . toNaturalValue) x `div` y
divideValue x (IntValue y) = if y == 0
    then NullValue
    else IntValue $! (intFromValue . toIntValue) x `div` y
divideValue x (LargeIntValue y) = if y == 0
    then NullValue
    else LargeIntValue $! (integerFromValue . toLargeIntValue) x `div` y
divideValue x (RealValue y) = RealValue $! (doubleFromValue . toRealValue) x / y
divideValue x (CharValue y) = if valY == 0
    then NullValue
    else (CharValue . integralToCharEnum) $! intFromValue (toIntValue x) `div` valY
    where valY = fromIntEnum y
divideValue x (StringValue y) = StringValue
    $! map ((charFromValue . toCharValue . divideValue x) . CharValue) y
divideValue x (ListValue y) = ListValue $! map (divideValue x) y
divideValue x y = divideValue (toIntValue x) (toIntValue y)


remainValue :: Value -> Value -> Value
remainValue (NaturalValue x) (IntValue y) = if y == 0
    then NullValue
    else IntValue $! (intFromValue . toIntValue . NaturalValue) x `rem` y
remainValue (NaturalValue x) (LargeIntValue y) = if y == 0
    then NullValue
    else LargeIntValue $! (integerFromValue . toLargeIntValue . NaturalValue) x `rem` y
remainValue (NaturalValue x) (RealValue y) = RealValue $! (doubleFromValue . toRealValue . NaturalValue) x `rem'` y
remainValue (NaturalValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . remainValue (NaturalValue x) . CharValue) y
remainValue (NaturalValue x) (ListValue y) = ListValue $! map (remainValue $! NaturalValue x) y
remainValue (NaturalValue x) y = if valY == 0
    then NullValue
    else NaturalValue $! x `rem` valY
    where valY = (wordFromValue . toNaturalValue) y
remainValue (IntValue x) (LargeIntValue y) = if y == 0
    then NullValue
    else LargeIntValue $! (integerFromValue . toLargeIntValue . IntValue) x `rem` y
remainValue (IntValue x) (RealValue y) = RealValue $! (doubleFromValue . toRealValue . IntValue) x `rem'` y
remainValue (IntValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . remainValue (IntValue x) . CharValue) y
remainValue (IntValue x) (ListValue y) = ListValue $! map (remainValue $! IntValue x) y
remainValue (IntValue x) y = if valY == 0
    then NullValue
    else IntValue $! x `rem` valY
    where valY = (intFromValue . toIntValue) y
remainValue (LargeIntValue x) (RealValue y) = RealValue $! (doubleFromValue . toRealValue . LargeIntValue) x `rem'` y
remainValue (LargeIntValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . remainValue (LargeIntValue x) . CharValue) y
remainValue (LargeIntValue x) (ListValue y) = ListValue $! map (remainValue $! LargeIntValue x) y
remainValue (LargeIntValue x) y = if valY == 0
    then NullValue
    else LargeIntValue $! x `rem`  valY
    where valY = (integerFromValue . toLargeIntValue) y
remainValue (RealValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . remainValue (RealValue x) . CharValue) y
remainValue (RealValue x) (ListValue y) = ListValue $! map (remainValue $! RealValue x) y
remainValue (RealValue x) y = RealValue $! x `rem'` (doubleFromValue . toRealValue) y
remainValue (CharValue x) (NaturalValue y) = if y == 0
    then NullValue
    else (CharValue . integralToCharEnum) $! fromIntEnum x `rem` y
remainValue (CharValue x) (IntValue y) = if y == 0
    then NullValue
    else (CharValue . integralToCharEnum) $! fromIntEnum x `rem` y
remainValue (CharValue x) (LargeIntValue y) = if y == 0
    then NullValue
    else (CharValue . integralToCharEnum) $! fromIntEnum x `rem` y
remainValue (CharValue x) (RealValue y) = (CharValue . realToCharEnum) $! fromIntEnum x `rem'` y
remainValue (CharValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . remainValue (CharValue x) . CharValue) y
remainValue (CharValue x) (ListValue y) = ListValue $! map (remainValue $! CharValue x) y
remainValue (CharValue x) y = if valY == 0
    then NullValue
    else (CharValue . integralToCharEnum) $! fromEnum x `rem` valY
    where valY = (fromEnum . charFromValue . toCharValue) y
remainValue (ListValue x) NullValue = ListValue x
remainValue (ListValue x) FalseValue = ListValue x
remainValue (ListValue x) (ListValue y) = ListValue $! zipWithFill remainValue id id x y
remainValue (ListValue x) (StringValue y) = ListValue $! zipWithFill
    (\ val char -> remainValue val $! CharValue char) id CharValue x y
remainValue (ListValue x) y = ListValue $! map (`remainValue` y) x
remainValue (StringValue x) NullValue = StringValue x
remainValue (StringValue x) FalseValue = StringValue x
remainValue (StringValue x) (ListValue y) = StringValue $! zipWithFill (\ ch val ->
    (charFromValue . toCharValue . remainValue (CharValue ch)) val)
    id (charFromValue . toCharValue) x y
remainValue (StringValue x) (StringValue y) = StringValue $! zipWithFill (\ chX chY ->
    (charFromValue . toCharValue . remainValue (CharValue chX)) (CharValue chY)) id id x y
remainValue (StringValue x) y = StringValue $! map (\ char ->
    (charFromValue . toCharValue . remainValue (CharValue char)) y) x
remainValue x (NaturalValue y) = if y == 0
    then NullValue
    else NaturalValue $! (wordFromValue . toNaturalValue) x `rem` y
remainValue x (IntValue y) = if y == 0
    then NullValue
    else IntValue $! (intFromValue . toIntValue) x `rem` y
remainValue x (LargeIntValue y) = if y == 0
    then NullValue
    else LargeIntValue $! (integerFromValue . toLargeIntValue) x `rem` y
remainValue x (RealValue y) = RealValue $! (doubleFromValue . toRealValue) x `rem'` y
remainValue x (CharValue y) = if valY == 0
    then NullValue
    else (CharValue . integralToCharEnum) $! intFromValue (toIntValue x) `rem` valY
    where valY = fromIntEnum y
remainValue x (StringValue y) = StringValue
    $! map ((charFromValue . toCharValue . remainValue x) . CharValue) y
remainValue x (ListValue y) = ListValue $! map (remainValue x) y
remainValue x y = remainValue (toIntValue x) (toIntValue y)

modulusValue :: Value -> Value -> Value
modulusValue (NaturalValue x) (IntValue y) = if y == 0
    then NullValue
    else IntValue $! (intFromValue . toIntValue . NaturalValue) x `mod` y
modulusValue (NaturalValue x) (LargeIntValue y) = if y == 0
    then NullValue
    else LargeIntValue $! (integerFromValue . toLargeIntValue . NaturalValue) x `mod` y
modulusValue (NaturalValue x) (RealValue y) = RealValue $! (doubleFromValue . toRealValue . NaturalValue) x `mod'` y
modulusValue (NaturalValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . modulusValue (NaturalValue x) . CharValue) y
modulusValue (NaturalValue x) (ListValue y) = ListValue $! map (modulusValue $! NaturalValue x) y
modulusValue (NaturalValue x) y = if valY == 0
    then NullValue
    else NaturalValue $! x `mod` valY
    where valY = (wordFromValue . toNaturalValue) y
modulusValue (IntValue x) (LargeIntValue y) = if y == 0
    then NullValue
    else LargeIntValue $! (integerFromValue . toLargeIntValue . IntValue) x `mod` y
modulusValue (IntValue x) (RealValue y) = RealValue $! (doubleFromValue . toRealValue . IntValue) x `mod'` y
modulusValue (IntValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . modulusValue (IntValue x) . CharValue) y
modulusValue (IntValue x) (ListValue y) = ListValue $! map (modulusValue $! IntValue x) y
modulusValue (IntValue x) y = if valY == 0
    then NullValue
    else IntValue $! x `mod` valY
    where valY = (intFromValue . toIntValue) y
modulusValue (LargeIntValue x) (RealValue y) = RealValue $! (doubleFromValue . toRealValue . LargeIntValue) x `mod'` y
modulusValue (LargeIntValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . modulusValue (LargeIntValue x) . CharValue) y
modulusValue (LargeIntValue x) (ListValue y) = ListValue $! map (modulusValue $! LargeIntValue x) y
modulusValue (LargeIntValue x) y = if valY == 0
    then NullValue
    else LargeIntValue $! x `mod`  valY
    where valY = (integerFromValue . toLargeIntValue) y
modulusValue (RealValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . modulusValue (RealValue x) . CharValue) y
modulusValue (RealValue x) (ListValue y) = ListValue $! map (modulusValue $! RealValue x) y
modulusValue (RealValue x) y = RealValue $! x `mod'` (doubleFromValue . toRealValue) y
modulusValue (CharValue x) (NaturalValue y) = if y == 0
    then NullValue
    else (CharValue . integralToCharEnum) $! fromIntEnum x `mod` y
modulusValue (CharValue x) (IntValue y) = if y == 0
    then NullValue
    else (CharValue . integralToCharEnum) $! fromIntEnum x `mod` y
modulusValue (CharValue x) (LargeIntValue y) = if y == 0
    then NullValue
    else (CharValue . integralToCharEnum) $! fromIntEnum x `mod` y
modulusValue (CharValue x) (RealValue y) = (CharValue . realToCharEnum) $! fromIntEnum x `mod'` y
modulusValue (CharValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . modulusValue (CharValue x) . CharValue) y
modulusValue (CharValue x) (ListValue y) = ListValue $! map (modulusValue $! CharValue x) y
modulusValue (CharValue x) y = if valY == 0
    then NullValue
    else (CharValue . integralToCharEnum) $! fromEnum x `mod` valY
    where valY = (fromEnum . charFromValue . toCharValue) y
modulusValue (ListValue x) NullValue = ListValue x
modulusValue (ListValue x) FalseValue = ListValue x
modulusValue (ListValue x) (ListValue y) = ListValue $! zipWithFill modulusValue id id x y
modulusValue (ListValue x) (StringValue y) = ListValue $! zipWithFill
    (\ val char -> modulusValue val $! CharValue char) id CharValue x y
modulusValue (ListValue x) y = ListValue $! map (`modulusValue` y) x
modulusValue (StringValue x) NullValue = StringValue x
modulusValue (StringValue x) FalseValue = StringValue x
modulusValue (StringValue x) (ListValue y) = StringValue $! zipWithFill (\ ch val ->
    (charFromValue . toCharValue . modulusValue (CharValue ch)) val)
    id (charFromValue . toCharValue) x y
modulusValue (StringValue x) (StringValue y) = StringValue $! zipWithFill (\ chX chY ->
    (charFromValue . toCharValue . modulusValue (CharValue chX)) (CharValue chY)) id id x y
modulusValue (StringValue x) y = StringValue $! map (\ char ->
    (charFromValue . toCharValue . modulusValue (CharValue char)) y) x
modulusValue x (NaturalValue y) = if y == 0
    then NullValue
    else NaturalValue $! (wordFromValue . toNaturalValue) x `mod` y
modulusValue x (IntValue y) = if y == 0
    then NullValue
    else IntValue $! (intFromValue . toIntValue) x `mod` y
modulusValue x (LargeIntValue y) = if y == 0
    then NullValue
    else LargeIntValue $! (integerFromValue . toLargeIntValue) x `mod` y
modulusValue x (RealValue y) = RealValue $! (doubleFromValue . toRealValue) x `mod'` y
modulusValue x (CharValue y) = if valY == 0
    then NullValue
    else (CharValue . integralToCharEnum) $! intFromValue (toIntValue x) `mod` valY
    where valY = fromIntEnum y
modulusValue x (StringValue y) = StringValue
    $! map ((charFromValue . toCharValue . modulusValue x) . CharValue) y
modulusValue x (ListValue y) = ListValue $! map (modulusValue x) y
modulusValue x y = modulusValue (toIntValue x) (toIntValue y)

powerValue :: Value -> Value -> Value
powerValue (NaturalValue x) (IntValue y) = IntValue
    $! (intFromValue . toIntValue . NaturalValue) x ^ y
powerValue (NaturalValue x) (LargeIntValue y) = LargeIntValue
    $! (integerFromValue . toLargeIntValue . NaturalValue) x ^ y
powerValue (NaturalValue x) (RealValue y) = RealValue
    $! (doubleFromValue . toRealValue . NaturalValue) x ** y
powerValue (NaturalValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . powerValue (NaturalValue x) . CharValue) y
powerValue (NaturalValue x) (ListValue y) = ListValue $! map (powerValue $! NaturalValue x) y
powerValue (NaturalValue x) y = NaturalValue $! x ^ (wordFromValue . toNaturalValue) y
powerValue (IntValue x) (LargeIntValue y) = LargeIntValue
    $! (integerFromValue . toLargeIntValue . IntValue) x ^ y
powerValue (IntValue x) (RealValue y) = RealValue
    $! (doubleFromValue . toRealValue . IntValue) x ** y
powerValue (IntValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . powerValue (IntValue x) . CharValue) y
powerValue (IntValue x) (ListValue y) = ListValue $! map (powerValue $! IntValue x) y
powerValue (IntValue x) y = IntValue $! x ^ (intFromValue . toIntValue) y
powerValue (LargeIntValue x) (RealValue y) = RealValue
    $! (doubleFromValue . toRealValue . LargeIntValue) x ** y
powerValue (LargeIntValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . powerValue (LargeIntValue x) . CharValue) y
powerValue (LargeIntValue x) (ListValue y) = ListValue $! map (powerValue $! LargeIntValue x) y
powerValue (LargeIntValue x) y = LargeIntValue $! x ^ (integerFromValue . toLargeIntValue) y
powerValue (RealValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . powerValue (RealValue x) . CharValue) y
powerValue (RealValue x) (ListValue y) = ListValue $! map (powerValue $! RealValue x) y
powerValue (RealValue x) y = RealValue $! x ** (doubleFromValue . toRealValue) y
powerValue (CharValue x) (NaturalValue y) = (CharValue . integralToCharEnum) $! fromIntEnum x ^ y
powerValue (CharValue x) (IntValue y) = (CharValue . integralToCharEnum) $! fromIntEnum x ^ y
powerValue (CharValue x) (LargeIntValue y) = (CharValue . integralToCharEnum) $! fromIntEnum x ^ y
powerValue (CharValue x) (RealValue y) = (CharValue . realToCharEnum) $! fromIntEnum x ** y
powerValue (CharValue x) (StringValue y) = StringValue $! map
    (charFromValue . toCharValue . powerValue (CharValue x) . CharValue) y
powerValue (CharValue x) (ListValue y) = ListValue $! map (powerValue $! CharValue x) y
powerValue (CharValue x) y = (CharValue . integralToCharEnum)
    $! fromEnum x ^ (fromEnum . charFromValue . toCharValue) y
powerValue (ListValue x) NullValue = ListValue x
powerValue (ListValue x) FalseValue = ListValue x
powerValue (ListValue x) (ListValue y) = ListValue $! zipWithFill powerValue id id x y
powerValue (ListValue x) (StringValue y) = ListValue $! zipWithFill
    (\ val char -> powerValue val $! CharValue char) id CharValue x y
powerValue (ListValue x) y = ListValue $! map (`powerValue` y) x
powerValue (StringValue x) NullValue = StringValue x
powerValue (StringValue x) FalseValue = StringValue x
powerValue (StringValue x) (ListValue y) = StringValue $! zipWithFill (\ ch val ->
    (charFromValue . toCharValue . powerValue (CharValue ch)) val)
    id (charFromValue . toCharValue) x y
powerValue (StringValue x) (StringValue y) = StringValue $! zipWithFill (\ chX chY ->
    (charFromValue . toCharValue . powerValue (CharValue chX)) (CharValue chY)) id id x y
powerValue (StringValue x) y = StringValue $! map (\ char ->
    (charFromValue . toCharValue . powerValue (CharValue char)) y) x
powerValue NullValue y = y
powerValue FalseValue y = y
powerValue x (NaturalValue y) = NaturalValue $! (wordFromValue . toNaturalValue) x ^ y
powerValue x (IntValue y) = IntValue $! (intFromValue . toIntValue) x ^ y
powerValue x (LargeIntValue y) = LargeIntValue $! (integerFromValue . toLargeIntValue) x ^ y
powerValue x (RealValue y) = RealValue $! (doubleFromValue . toRealValue) x ** y
powerValue x (CharValue y) = (CharValue . integralToCharEnum) $! intFromValue (toIntValue x) ^ fromIntEnum y
powerValue x (StringValue y) = StringValue
    $! map ((charFromValue . toCharValue . powerValue x) . CharValue) y
powerValue x (ListValue y) = ListValue $! map (powerValue x) y
powerValue x y = powerValue (toIntValue x) (toIntValue y)

factorialValue :: Value -> Value
factorialValue (NaturalValue x) = (LargeIntValue . factorial) $! fromIntegral x
factorialValue (IntValue x) = if x < 0
    then NullValue
    else (LargeIntValue . factorial) $! fromIntegral x
factorialValue (LargeIntValue x) = if x < 0
    then NullValue
    else (LargeIntValue . factorial) x
factorialValue (RealValue x) = if intX < 0
    then NullValue
    else (LargeIntValue . factorial) intX
    where intX = truncate x
factorialValue x = factorialValue $! toIntValue x


getValueForVariable :: Scope -> String -> Value
getValueForVariable (Scope [] EmptyScope) _ = NullValue
getValueForVariable (Scope [] par) name = getValueForVariable par name
getValueForVariable (Scope (Variable vname value _:vars) par) name = if name == vname
    then value
    else getValueForVariable (Scope vars par) name

setValueForVariable :: Scope -> Variable -> (Scope, Value)
setValueForVariable (Scope [] parent) (Variable name value constant) =
    (Scope [Variable name value constant] parent, value)
setValueForVariable (Scope (Variable vname vvalue vcons:xs) parent) (Variable name value constant) =
    if name == vname
        then if vcons
            then (Scope (Variable vname vvalue vcons:xs) parent, vvalue)
            else (Scope (Variable name value constant:xs) parent, value)
        else
            let (Scope vars newParent, foundVal) =
                    setValueForVariable (Scope xs parent) (Variable name value constant)
            in (Scope (Variable vname vvalue vcons:vars) newParent, foundVal)

evaluateFunction :: BackTrace -> Function -> [Value] -> IO Value
evaluateFunction trace (PrimitiveFunction f) args = f trace args
evaluateFunction trace (Function declaredArgs node env) args = do
    let
        setScope scope [] _ = scope
        setScope scope (VariadicArgument name:_) arguments =
            let (newScope, _) = setValueForVariable scope $! Variable name (ListValue arguments) False
            in newScope
        setScope scope (Argument name _:remArgs) (x:xs) =
            let (newScope,_) = setValueForVariable scope $! Variable name x False
            in setScope newScope remArgs xs
        setScope scope (Argument name def:remArgs) [] =
            let (newScope, _) =  setValueForVariable scope $! Variable name def False
            in setScope newScope remArgs []
        setLocalConsts scope [] = scope
        setLocalConsts scope (x:xs) =
            let (newScope, _) = setValueForVariable scope x
            in setLocalConsts newScope xs
        finalScope = setLocalConsts (setScope (Scope [] env) declaredArgs args)
            [ Variable "arguments" (ListValue args) False
            , Variable "self" (FunctionValue $! Function declaredArgs node env) False
            ]
    evaluated <- evaluateNode trace node finalScope
    let (_, result) = evaluated
    return result

evaluateNode :: BackTrace -> Node -> Scope -> IO (Scope, Value)
evaluateNode _ (Node _ NullLiteral) scope = return (scope, NullValue)
evaluateNode _ (Node _ (VarMention var)) scope = return (scope, getValueForVariable scope var)
evaluateNode trace (Node _ (ConstantDeclare var val)) scope = do
    evaluatedTuple <- evaluateNode trace val scope
    let (newScope, evaluated) = evaluatedTuple
    return $! setValueForVariable newScope $! Variable var evaluated True
evaluateNode trace (Node _ (Assign var val)) scope = do
    evaluatedTuple <- evaluateNode trace val scope
    let (newScope, evaluated) = evaluatedTuple
    return $! setValueForVariable newScope $! Variable var evaluated False
evaluateNode _ (Node _ (SetOfExp [])) scope = return (scope, NullValue)
evaluateNode trace (Node _ (SetOfExp [x])) scope = evaluateNode trace x scope
evaluateNode trace (Node loc (SetOfExp (x:xs))) scope = do
    result <- evaluateNode trace x scope
    let (newScope, _) = result
    evaluateNode trace (Node loc (SetOfExp xs)) newScope
evaluateNode _ (Node _ (FunctionCall (Node _ (VarMention "#and")) [])) scope = return (scope, NullValue)
evaluateNode (BT trace) (Node loc (FunctionCall (Node _ (VarMention "#and")) [x])) scope =
    evaluateNode (BT (loc:trace)) x scope
evaluateNode (BT trace) (Node loc (FunctionCall (Node calleeLoc (VarMention "#and")) (x:xs))) scope = do
    evaldArg <- evaluateNode (BT trace) x scope
    let (newScope, argValue) = evaldArg
    if (boolFromValue . toBoolValue) argValue
        then evaluateNode (BT (loc:trace))
            (Node loc $! FunctionCall (Node calleeLoc $! VarMention "#and") xs)
            newScope
        else return (newScope, argValue)
evaluateNode _ (Node _ (FunctionCall (Node _ (VarMention "#or")) [])) scope = return (scope, NullValue)
evaluateNode (BT trace) (Node loc (FunctionCall (Node _ (VarMention "#or")) [x])) scope =
    evaluateNode (BT (loc:trace)) x scope
evaluateNode (BT trace) (Node loc (FunctionCall (Node calleeLoc (VarMention "#or")) (x:xs))) scope = do
    evaldArg <- evaluateNode (BT trace) x scope
    let (newScope, argValue) = evaldArg
    if (not . boolFromValue . toBoolValue) argValue
        then evaluateNode (BT (loc:trace))
            (Node loc $! FunctionCall (Node calleeLoc $! VarMention "#or") xs)
            newScope
        else return (newScope, argValue)
evaluateNode (BT trace) (Node loc (FunctionCall callee args)) scope = do
    let evaluateArgs [] middleScope = return (middleScope, [])
        evaluateArgs (x:xs) middleScope = do
            evald <- evaluateNode (BT trace) x middleScope
            let (newMiddleScope, val) = evald
            next <- evaluateArgs xs newMiddleScope
            let (newerMiddleScope, vals) = next
            return (newerMiddleScope, val:vals)
    argsResult <- evaluateArgs args scope
    let (middleScope, evaldArgs) = argsResult
    calleeResult <- evaluateNode (BT (loc:trace)) callee middleScope
    let (finalScope, function) = calleeResult
    unless (isFunctionValue function)
        $ throwParsingError loc $ "Tried to call a non-function: " ++ show function
    rtrnVal <- evaluateFunction (BT (loc:trace)) (functionFromValue function)  evaldArgs
    return (finalScope, rtrnVal)
evaluateNode trace (Node _ (Condition cond thn els)) scope = do
    evaldCond <- evaluateNode trace cond scope
    let (newScope, condResult) = evaldCond
    if (boolFromValue . toBoolValue) condResult
        then evaluateNode trace thn newScope
        else evaluateNode trace els newScope
evaluateNode _ (Node _ (IntLiteral int)) scope = return (scope, IntValue int)
evaluateNode _ (Node _ (NaturalLiteral int)) scope = return (scope, NaturalValue int)
evaluateNode _ (Node _ (LargeIntLiteral int)) scope = return (scope, LargeIntValue int)
evaluateNode _ (Node _ (RealLiteral dbl)) scope = return (scope, RealValue dbl)
evaluateNode _ (Node _ (CharLiteral char)) scope = return (scope, CharValue char)
evaluateNode _ (Node _ (StringLiteral str)) scope = return (scope, StringValue str)
evaluateNode _ (Node _ (ListLiteral [])) scope = return (scope, ListValue [])
evaluateNode trace (Node loc (ListLiteral (x:xs))) scope = do
    evaldItem <- evaluateNode trace x scope
    let (newScope, item) = evaldItem
    remaining <- evaluateNode trace (Node loc $! ListLiteral xs) newScope
    let (finalScope, ListValue remList) = remaining
    return (finalScope, ListValue $! item:remList)
evaluateNode trace (Node _ (FunctionLiteral args body)) scope = do
    let evalArg (Node _ (VariadicArgDeclare name)) middleScope = return (middleScope, VariadicArgument name)
        evalArg (Node _ (ArgDeclare name def)) middleScope = do
            evaldDef <- evaluateNode trace def middleScope
            let (newScope, defVal) = evaldDef
            return (newScope, Argument name defVal)
        evalArgs [] middleScope = return (middleScope, [])
        evalArgs (x:xs) middleScope = do
            evaldArg <- evalArg x middleScope
            let (newScope, arg) = evaldArg
            remaining <- evalArgs xs newScope
            let (finalScope, remArgs) = remaining
            return (finalScope, arg:remArgs)
        getConstantEnv EmptyScope = EmptyScope
        getConstantEnv (Scope vars parent) = Scope (filter isConstant vars) $! getConstantEnv parent
    evaldArgs <- evalArgs args scope
    let (newScope, arguments) = evaldArgs
    return (newScope, FunctionValue $! Function arguments body $! getConstantEnv newScope)
evaluateNode _ (Node loc expr) _ = throwParsingError loc $ "Malformed AST node: " ++ show expr

