Rain: added more type-checker tests and made them pass
This commit is contained in:
Neil Brown
parent
eeacaf1de4
commit
15ce5fee06
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user