diff --git a/frontends/RainTypes.hs b/frontends/RainTypes.hs index 9c54aca..9f95076 100644 --- a/frontends/RainTypes.hs +++ b/frontends/RainTypes.hs @@ -100,12 +100,14 @@ checkExpressionTypes = everywhereASTM checkExpression = do tlhs <- typeOfExpression lhs trhs <- typeOfExpression rhs if (tlhs == trhs) - then return e + then (if validOp op tlhs then return e else dieP m $ "Operator: \"" ++ show op ++ "\" is not valid on type: \"" ++ show tlhs) else if (isIntegerType tlhs && isIntegerType trhs) then case (leastGeneralSharedTypeRain [tlhs,trhs]) of Nothing -> dieP m $ "Cannot find a suitable type to convert expression to, types are: " ++ show tlhs ++ " and " ++ show trhs - Just t -> return $ A.Dyadic m op (convert t tlhs lhs) (convert t trhs rhs) - else return e --TODO + Just t -> if validOp op t then return $ A.Dyadic m op (convert t tlhs lhs) (convert t trhs rhs) else dieP m $ + "Operator: \"" ++ show op ++ "\" is not valid on type: \"" ++ show tlhs + else --The operators are not equal, and are not integers. Therefore this must be an error: + dieP m $ "Mis-matched types; no operator applies to types: " ++ show tlhs ++ " and " ++ show trhs checkExpression e@(A.Monadic m op rhs) = do trhs <- typeOfExpression rhs if (op == A.MonadicMinus) @@ -115,7 +117,12 @@ checkExpressionTypes = everywhereASTM checkExpression A.UInt32 -> return $ A.Monadic m op $ convert A.Int64 trhs rhs A.UInt64 -> dieP m $ "Cannot apply unary minus to type: " ++ show trhs ++ " because there is no type large enough to safely contain the result" _ -> if (isIntegerType trhs) then return e else dieP m $ "Trying to apply unary minus to non-integer type: " ++ show trhs - else return e + else if (op == A.MonadicNot) + then + case trhs of + A.Bool -> return e + _ -> dieP m $ "Cannot apply unary not to non-boolean type: " ++ show trhs + else dieP m $ "Invalid Rain operator: \"" ++ show op ++ "\"" checkExpression e = return e convert :: A.Type -> A.Type -> A.Expression -> A.Expression @@ -123,4 +130,21 @@ checkExpressionTypes = everywhereASTM checkExpression then e else A.Conversion (findMeta e) A.DefaultConversion dest e - + validOp :: A.DyadicOp -> A.Type -> Bool + validOp A.Plus t = isIntegerType t + validOp A.Minus t = isIntegerType t + validOp A.Times t = isIntegerType t + validOp A.Div t = isIntegerType t + validOp A.Rem t = isIntegerType t + validOp A.Eq _ = True + validOp A.NotEq _ = True + validOp A.Less t = haveOrder t + validOp A.LessEq t = haveOrder t + validOp A.More t = haveOrder t + validOp A.MoreEq t = haveOrder t + validOp A.And A.Bool = True + validOp A.Or A.Bool = True + validOp _ _ = False + + haveOrder :: A.Type -> Bool + haveOrder = isIntegerType diff --git a/frontends/RainTypesTest.hs b/frontends/RainTypesTest.hs index 412b0d5..e37691e 100644 --- a/frontends/RainTypesTest.hs +++ b/frontends/RainTypesTest.hs @@ -89,26 +89,52 @@ annotateIntTest = TestList checkExpressionTest :: Test checkExpressionTest = TestList [ + --Already same types: passSame 0 A.Int64 $ Dy (Var "x") A.Plus (Var "x") ,passSame 1 A.Byte $ Dy (Var "xu8") A.Plus (Var "xu8") + --Upcasting: ,pass 100 A.Int64 (Dy (Var "x") A.Plus (Cast A.Int64 $ Var "xu8")) (Dy (Var "x") A.Plus (Var "xu8")) ,pass 101 A.Int32 (Dy (Cast A.Int32 $ Var "x16") A.Plus (Cast A.Int32 $ Var "xu16")) (Dy (Var "x16") A.Plus (Var "xu16")) + --Upcasting a cast: ,pass 200 A.Int64 (Dy (Var "x") A.Plus (Cast A.Int64 $ Cast A.Int32 $ Var "xu8")) (Dy (Var "x") A.Plus (Cast A.Int32 $ Var "xu8")) + --Impossible conversions: ,fail 300 $ Dy (Var "x") A.Plus (Var "xu64") + --Integer literals: ,pass 400 A.Int16 (Dy (Var "x16") A.Plus (Cast A.Int16 $ int A.Int8 100)) (Dy (Var "x16") A.Plus (int A.Int8 100)) ,pass 401 A.Int16 (Dy (Cast A.Int16 $ Var "x8") A.Plus (int A.Int16 200)) (Dy (Var "x8") A.Plus (int A.Int16 200)) --This fails because you are trying to add a signed constant to an unsigned integer that cannot be expanded: ,fail 402 $ Dy (Var "xu64") A.Plus (int A.Int64 0) + --Monadic integer operations: ,passSame 500 A.Int32 (Mon A.MonadicMinus (Var "x32")) ,pass 501 A.Int32 (Mon A.MonadicMinus (Cast A.Int32 $ Var "xu16")) (Mon A.MonadicMinus (Var "xu16")) ,fail 502 $ Mon A.MonadicMinus (Var "xu64") ,pass 503 A.Int64 (Dy (Var "x") A.Plus (Cast A.Int64 $ Mon A.MonadicMinus (Var "x32"))) (Dy (Var "x") A.Plus (Mon A.MonadicMinus (Var "x32"))) + --Mis-matched types (integer/boolean): + ,fail 600 $ Dy (Var "b") A.Plus (Var "x") + ,fail 601 $ Mon A.MonadicMinus (Var "b") + ,fail 602 $ Dy (Var "x") A.Or (Var "x") + ,fail 603 $ Dy (Var "x") A.Eq (Var "b") + ,fail 604 $ Dy (Var "b") A.Plus (Var "b") + ,fail 605 $ Dy (Var "b") A.Less (Var "b") + + --Booleans (easy!) + ,passSame 1000 A.Bool $ Mon A.MonadicNot (Var "b") + ,passSame 1001 A.Bool $ Dy (Var "b") A.Or (Var "b") + ,passSame 1002 A.Bool $ Dy (Var "b") A.And (Mon A.MonadicNot $ Var "b") + + --Comparison (same types): + ,passSame 1100 A.Bool $ Dy (Var "b") A.Eq (Var "b") + ,passSame 1101 A.Bool $ Dy (Var "x") A.Eq (Var "x") + ,passSame 1102 A.Bool $ Dy (Var "xu8") A.NotEq (Var "xu8") + ,passSame 1103 A.Bool $ Dy (Var "x") A.Less (Var "x") + ,passSame 1104 A.Bool $ Dy (Dy (Var "x") A.Eq (Var "x")) A.And (Dy (Var "xu8") A.NotEq (Var "xu8")) + ] where passSame :: Int -> A.Type -> ExprHelper -> Test