diff options
| -rw-r--r-- | check.hs | 68 |
1 files changed, 34 insertions, 34 deletions
@@ -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 |