summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authortomsmeding <tom.smeding@gmail.com>2017-01-27 10:53:01 +0100
committertomsmeding <tom.smeding@gmail.com>2017-01-27 10:53:01 +0100
commit2d68c697c480986089af1050b859b953d0f7fa82 (patch)
tree91eb493784b18582fab898c2e4ef44a12ff7de5c
parenta1b82ce182f8fbeb19826aefe4d1fb179063a2f8 (diff)
typeCompatible -> resultType
-rw-r--r--check.hs68
1 files changed, 34 insertions, 34 deletions
diff --git a/check.hs b/check.hs
index 5f7dd12..fd94f0d 100644
--- a/check.hs
+++ b/check.hs
@@ -149,12 +149,12 @@ typeCheck (Program decls) = Program <$> mapM (goD topLevelNames) decls
maybe (Left $ "Cannot use operator '" ++ pshow bo ++ "' with argument types '"
++ pshow (fromJust $ exTypeOf re1) ++ "' and '" ++ pshow (fromJust $ exTypeOf re2) ++ "'")
(return . ExBinOp bo re1 re2 . Just)
- $ typeCompatibleBO bo (fromJust $ exTypeOf re1) (fromJust $ exTypeOf re2)
+ $ resultTypeBO bo (fromJust $ exTypeOf re1) (fromJust $ exTypeOf re2)
goE names (ExUnOp uo e _) = do
re <- goE names e
maybe (Left $ "Cannot use operator '" ++ pshow uo ++ "' with argument type '" ++ pshow (fromJust $ exTypeOf re))
(return . ExUnOp uo re . Just)
- $ typeCompatibleUO uo (fromJust $ exTypeOf re)
+ $ resultTypeUO uo (fromJust $ exTypeOf re)
bundleVarDecls :: Program -> Error Program
@@ -190,38 +190,38 @@ compareBO = [Equal, Unequal, Greater, Less, GEqual, LEqual]
logicBO = [BoolAnd, BoolOr]
complogBO = compareBO ++ logicBO
-typeCompatibleBO :: BinaryOperator -> Type -> Type -> Maybe Type
-typeCompatibleBO Minus (TypePtr t1) (TypePtr t2) | t1 == t2 = Just $ TypeInt 1
-typeCompatibleBO bo (TypePtr t1) (TypePtr t2) | t1 == t2 && bo `elem` complogBO = Just $ TypeInt 1
-typeCompatibleBO _ (TypePtr _) _ = Nothing
-typeCompatibleBO _ _ (TypePtr _) = Nothing
-
-typeCompatibleBO bo (TypeInt s1) (TypeInt s2) | bo `elem` arithBO = Just $ TypeInt (max s1 s2)
-typeCompatibleBO bo (TypeInt _) (TypeInt _) | bo `elem` complogBO = Just $ TypeInt 1
-
-typeCompatibleBO bo (TypeUInt s1) (TypeUInt s2) | bo `elem` arithBO = Just $ TypeUInt (max s1 s2)
-typeCompatibleBO bo (TypeUInt _) (TypeUInt _) | bo `elem` complogBO = Just $ TypeInt 1
-
-typeCompatibleBO bo t1 t2 | bo `elem` complogBO && t1 == t2 = Just $ TypeInt 1
-
-typeCompatibleBO bo TypeFloat (TypeInt s) | s <= 24 = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
-typeCompatibleBO bo (TypeInt s) TypeFloat | s <= 24 = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
-typeCompatibleBO bo TypeDouble (TypeInt s) | s <= 53 = Just $ if bo `elem` arithBO then TypeDouble else TypeInt 1
-typeCompatibleBO bo (TypeInt s) TypeDouble | s <= 53 = Just $ if bo `elem` arithBO then TypeDouble else TypeInt 1
-typeCompatibleBO bo TypeFloat TypeDouble = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
-typeCompatibleBO bo TypeDouble TypeFloat = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
-
-typeCompatibleBO _ _ _ = Nothing
-
-typeCompatibleUO :: UnaryOperator -> Type -> Maybe Type
-typeCompatibleUO Not _ = Just $ TypeInt 1
-typeCompatibleUO Address t = Just $ TypePtr t
-typeCompatibleUO uo t@(TypeInt _) | uo `elem` [Negate, Invert] = Just t
-typeCompatibleUO uo t@(TypeUInt _) | uo `elem` [Negate, Invert] = Just t
-typeCompatibleUO Negate TypeFloat = Just TypeFloat
-typeCompatibleUO Negate TypeDouble = Just TypeDouble
-typeCompatibleUO Dereference t@(TypePtr _) = Just t
-typeCompatibleUO _ _ = Nothing
+resultTypeBO :: BinaryOperator -> Type -> Type -> Maybe Type
+resultTypeBO Minus (TypePtr t1) (TypePtr t2) | t1 == t2 = Just $ TypeInt 1
+resultTypeBO bo (TypePtr t1) (TypePtr t2) | t1 == t2 && bo `elem` complogBO = Just $ TypeInt 1
+resultTypeBO _ (TypePtr _) _ = Nothing
+resultTypeBO _ _ (TypePtr _) = Nothing
+
+resultTypeBO bo (TypeInt s1) (TypeInt s2) | bo `elem` arithBO = Just $ TypeInt (max s1 s2)
+resultTypeBO bo (TypeInt _) (TypeInt _) | bo `elem` complogBO = Just $ TypeInt 1
+
+resultTypeBO bo (TypeUInt s1) (TypeUInt s2) | bo `elem` arithBO = Just $ TypeUInt (max s1 s2)
+resultTypeBO bo (TypeUInt _) (TypeUInt _) | bo `elem` complogBO = Just $ TypeInt 1
+
+resultTypeBO bo t1 t2 | bo `elem` complogBO && t1 == t2 = Just $ TypeInt 1
+
+resultTypeBO bo TypeFloat (TypeInt s) | s <= 24 = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
+resultTypeBO bo (TypeInt s) TypeFloat | s <= 24 = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
+resultTypeBO bo TypeDouble (TypeInt s) | s <= 53 = Just $ if bo `elem` arithBO then TypeDouble else TypeInt 1
+resultTypeBO bo (TypeInt s) TypeDouble | s <= 53 = Just $ if bo `elem` arithBO then TypeDouble else TypeInt 1
+resultTypeBO bo TypeFloat TypeDouble = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
+resultTypeBO bo TypeDouble TypeFloat = Just $ if bo `elem` arithBO then TypeFloat else TypeInt 1
+
+resultTypeBO _ _ _ = Nothing
+
+resultTypeUO :: UnaryOperator -> Type -> Maybe Type
+resultTypeUO Not _ = Just $ TypeInt 1
+resultTypeUO Address t = Just $ TypePtr t
+resultTypeUO uo t@(TypeInt _) | uo `elem` [Negate, Invert] = Just t
+resultTypeUO uo t@(TypeUInt _) | uo `elem` [Negate, Invert] = Just t
+resultTypeUO Negate TypeFloat = Just TypeFloat
+resultTypeUO Negate TypeDouble = Just TypeDouble
+resultTypeUO Dereference t@(TypePtr _) = Just t
+resultTypeUO _ _ = Nothing
smallestIntType :: Integer -> Type
smallestIntType i