module TypeRules where

import AST


canCoerce :: Type -> Type -> Bool
canCoerce t1 t2 | t1 == t2 = True
canCoerce (TArr t1 (Just _)) (TArr t2 Nothing) | t1 == t2 = True
canCoerce _ _ = False

canCast :: Type -> Type -> Bool
canCast t1 t2 | canCoerce t1 t2 = True
canCast t1 t2 | isIntegralType t1 && isIntegralType t2 = True
canCast _ _ = False

isBasicType :: Type -> Bool
isBasicType = isIntegralType

isIntegralType :: Type -> Bool
isIntegralType TInt = True
isIntegralType TChar = True
isIntegralType _ = False

isSimpleArithBO :: BinaryOp -> Bool
isSimpleArithBO = flip elem [BOAdd, BOSub, BOMul, BODiv, BOMod]

isBoolBO :: BinaryOp -> Bool
isBoolBO = flip elem [BOAnd, BOOr]

isCompareBO :: BinaryOp -> Bool
isCompareBO = flip elem [BOEq, BONeq, BOGt, BOLt, BOGeq, BOLeq]

retTypeBO :: BinaryOp -> Type -> Type -> Maybe Type
retTypeBO bo TInt TInt | isSimpleArithBO bo = Just TInt
retTypeBO bo TChar TChar | isSimpleArithBO bo = Just TChar
retTypeBO bo TInt TInt | isBoolBO bo = Just TInt
retTypeBO bo TInt TInt | isCompareBO bo = Just TInt
retTypeBO bo TChar TChar | isCompareBO bo = Just TInt
retTypeBO _ _ _ = Nothing
-- retTypeBO bo t1 t2 = error $ "retTypeBO " ++ show bo ++ " " ++ show t1 ++ " " ++ show t2

retTypeUO :: UnaryOp -> Type -> Maybe Type
retTypeUO UONot TInt = Just TInt
retTypeUO UONeg TInt = Just TInt
retTypeUO UONeg TChar = Just TChar
retTypeUO _ _ = Nothing

class TypeOf a where
    typeof :: a -> Maybe Type

instance TypeOf Expression where
    typeof (EBin _ _ _ mt) = mt
    typeof (EUn _ _ mt) = mt
    typeof (ELit _ mt) = mt
    typeof (ESubscript _ _ mt) = mt
    typeof (ECast t _) = Just t
    typeof (ENew t _) = Just $ TArr t Nothing

instance TypeOf AsExpression where
    typeof (AEVar _ mt) = mt
    typeof (AESubscript _ _ mt) = mt