diff options
Diffstat (limited to 'check.hs')
| -rw-r--r-- | check.hs | 40 |
1 files changed, 27 insertions, 13 deletions
@@ -141,6 +141,7 @@ typeCheck (Program decls) = Program <$> mapM (goD topLevelNames) decls -- Postcondition: the expression (if any) has a type annotation. goE :: Map.Map Name Type -> Expression -> Error Expression goE _ (ExLit l@(LitInt i) _) = return $ ExLit l $ Just (smallestIntType i) + goE _ (ExLit l@(LitFloat f) _) = return $ ExLit l $ Just (smallestFloatType f) goE _ (ExLit l@(LitString _) _) = return $ ExLit l $ Just (TypePtr (TypeInt 8)) goE names (ExLit l@(LitVar n) _) = maybe (Left $ "Undefined variable '" ++ n ++ "'") (return . ExLit l . Just) (Map.lookup n names) @@ -156,7 +157,7 @@ typeCheck (Program decls) = Program <$> mapM (goD topLevelNames) decls in if canConvert argtype (snd ft !! i) then return a else Left $ "Cannot convert type '" ++ pshow argtype ++ "' to '" ++ pshow (snd ft !! i) - ++ "' in call of function '" ++ pshow n ++ "'" + ++ "' in call of function '" ++ n ++ "'" return $ ExLit (LitCall n rargs) (Just (fst ft)) goE names (ExBinOp bo e1 e2 _) = do re1 <- goE names e1 @@ -196,7 +197,12 @@ canConvert :: Type -> Type -> Bool canConvert x y | x == y = True canConvert (TypeInt f) (TypeInt t) = f <= t canConvert (TypeUInt f) (TypeUInt t) = f <= t +canConvert (TypeUInt 1) (TypeInt _) = True canConvert TypeFloat TypeDouble = True +canConvert (TypeInt _) TypeFloat = True +canConvert (TypeInt _) TypeDouble = True +canConvert (TypeUInt _) TypeFloat = True +canConvert (TypeUInt _) TypeDouble = True canConvert _ _ = False arithBO, compareBO, logicBO, complogBO :: [BinaryOperator] @@ -206,30 +212,32 @@ logicBO = [BoolAnd, BoolOr] complogBO = compareBO ++ logicBO 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 Minus (TypePtr t1) (TypePtr t2) | t1 == t2 = Just $ TypeUInt 1 +resultTypeBO bo (TypePtr t1) (TypePtr t2) | t1 == t2 && bo `elem` complogBO = Just $ TypeUInt 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 (TypeInt _) (TypeInt _) | bo `elem` complogBO = Just $ TypeUInt 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 (TypeUInt _) (TypeUInt _) | bo `elem` complogBO = Just $ TypeUInt 1 -resultTypeBO bo t1 t2 | bo `elem` complogBO && t1 == t2 = Just $ TypeInt 1 +resultTypeBO bo t1 t2 | bo `elem` complogBO && t1 == t2 = Just $ TypeUInt 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 bo TypeFloat (TypeInt s) | s <= 24 = Just $ if bo `elem` arithBO then TypeFloat else TypeUInt 1 +resultTypeBO bo (TypeInt s) TypeFloat | s <= 24 = Just $ if bo `elem` arithBO then TypeFloat else TypeUInt 1 +resultTypeBO bo TypeDouble (TypeInt s) | s <= 53 = Just $ if bo `elem` arithBO then TypeDouble else TypeUInt 1 +resultTypeBO bo (TypeInt s) TypeDouble | s <= 53 = Just $ if bo `elem` arithBO then TypeDouble else TypeUInt 1 +resultTypeBO bo TypeFloat TypeFloat = Just $ if bo `elem` arithBO then TypeFloat else TypeUInt 1 +resultTypeBO bo TypeDouble TypeDouble = Just $ if bo `elem` arithBO then TypeDouble else TypeUInt 1 +resultTypeBO bo TypeFloat TypeDouble = Just $ if bo `elem` arithBO then TypeDouble else TypeUInt 1 +resultTypeBO bo TypeDouble TypeFloat = Just $ if bo `elem` arithBO then TypeDouble else TypeUInt 1 resultTypeBO _ _ _ = Nothing resultTypeUO :: UnaryOperator -> Type -> Maybe Type -resultTypeUO Not _ = Just $ TypeInt 1 +resultTypeUO Not _ = Just $ TypeUInt 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 @@ -238,6 +246,11 @@ resultTypeUO Negate TypeDouble = Just TypeDouble resultTypeUO Dereference t@(TypePtr _) = Just t resultTypeUO _ _ = Nothing +smallestFloatType :: Double -> Type +smallestFloatType d = + let truncfloat = realToFrac (realToFrac d :: Float) :: Double + in if d == truncfloat then TypeFloat else TypeDouble + smallestIntType :: Integer -> Type smallestIntType i | i >= -2^7 && i < 2^7 = TypeInt 8 @@ -391,6 +404,7 @@ mapProgram prog mapper = goP prog goL :: MapperHandler Literal goL l@(LitString _) = h_l l goL l@(LitInt _) = h_l l + goL l@(LitFloat _) = h_l l goL (LitVar n) = goN n >>= (h_l . LitVar) goL (LitCall n a) = do rn <- goN n |