aboutsummaryrefslogtreecommitdiff
path: root/TypeRules.hs
blob: a3e76780796ff4b367d2c845a0be6570ae5700b0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
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