summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-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