From 185623be46dfd9a60e5a021259a6c7778cfb07cd Mon Sep 17 00:00:00 2001 From: tomsmeding Date: Thu, 2 Feb 2017 22:29:41 +0100 Subject: Parse and typecheck casts --- check.hs | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) (limited to 'check.hs') diff --git a/check.hs b/check.hs index a869f18..dbbcfd8 100644 --- a/check.hs +++ b/check.hs @@ -160,6 +160,12 @@ typeCheck (Program decls) = Program <$> mapM (goD topLevelNames) decls else Left $ "Cannot convert type '" ++ pshow argtype ++ "' to '" ++ pshow (snd ft !! i) ++ "' in call of function '" ++ n ++ "'" return $ ExLit (LitCall n rargs) (Just (fst ft)) + goE names (ExCast totype ex) = do + rex <- goE names ex + let fromtype = fromJust (exTypeOf rex) + if canCast fromtype totype + then return $ ExCast totype rex + else Left $ "Cannot cast type '" ++ pshow fromtype ++ "' to '" ++ pshow totype ++ "'" goE names (ExBinOp bo e1 e2 _) = do re1 <- goE names e1 re2 <- goE names e2 @@ -206,6 +212,21 @@ canConvert (TypeUInt _) TypeFloat = True canConvert (TypeUInt _) TypeDouble = True canConvert _ _ = False +canCast :: Type -> Type -> Bool +canCast t1 t2 = any (\f -> f t1 && f t2) [numberGroup, intptrGroup] + where + numberGroup (TypeInt _) = True + numberGroup (TypeUInt _) = True + numberGroup TypeFloat = True + numberGroup TypeDouble = True + numberGroup _ = False + + intptrGroup (TypeInt _) = True + intptrGroup (TypeUInt _) = True + intptrGroup (TypePtr _) = True + intptrGroup (TypeFunc _ _) = True + intptrGroup _ = False + arithBO, compareBO, logicBO, complogBO :: [BinaryOperator] arithBO = [Plus, Minus, Times, Divide, Modulo] compareBO = [Equal, Unequal, Greater, Less, GEqual, LEqual] @@ -373,6 +394,10 @@ mapProgram prog mapper = goP prog goE (ExLit l mt) = do rl <- goL l h_e $ ExLit rl mt + goE (ExCast t e) = do + rt <- goT t + re <- goE e + h_e $ ExCast rt re goE (ExBinOp bo e1 e2 mt) = do rbo <- goBO bo re1 <- goE e1 -- cgit v1.2.3-70-g09d2