From 2d68c697c480986089af1050b859b953d0f7fa82 Mon Sep 17 00:00:00 2001 From: tomsmeding Date: Fri, 27 Jan 2017 10:53:01 +0100 Subject: typeCompatible -> resultType --- check.hs | 68 ++++++++++++++++++++++++++++++++-------------------------------- 1 file 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 -- cgit v1.2.3-70-g09d2