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
62
63
64
65
|
module TypeRules where
import Data.List
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, BOBitAnd, BOBitOr, BOBitXor]
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 (EGet _ _ 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
typeof (AEGet _ _ mt) = mt
|
