Implement expression typechecking for occam.
There's obviously some overlap with the Rain typechecker here. I've tried to cover everything in the AST that could potentially be bound into occam at some point in the future, even if the occam parser doesn't support it yet (so this'll do checks for Concat and mobile allocation, for example).
This commit is contained in:
Adam Sampson
parent
388f2f38a6
commit
6ab4a9923f
|
|
@ -136,6 +136,7 @@ tock_SOURCES_hs += data/TagAST.hs
|
|||
tock_SOURCES_hs += flow/FlowGraph.hs
|
||||
tock_SOURCES_hs += flow/FlowAlgorithms.hs
|
||||
tock_SOURCES_hs += frontends/OccamPasses.hs
|
||||
tock_SOURCES_hs += frontends/OccamTypes.hs
|
||||
tock_SOURCES_hs += frontends/ParseOccam.hs
|
||||
tock_SOURCES_hs += frontends/ParseRain.hs
|
||||
tock_SOURCES_hs += frontends/ParseUtils.hs
|
||||
|
|
@ -166,6 +167,7 @@ tocktest_SOURCES += common/TestHarness.hs
|
|||
tocktest_SOURCES += common/TestUtils.hs
|
||||
tocktest_SOURCES += flow/FlowGraphTest.hs
|
||||
tocktest_SOURCES += frontends/OccamPassesTest.hs
|
||||
tocktest_SOURCES += frontends/OccamTypesTest.hs
|
||||
tocktest_SOURCES += frontends/ParseRainTest.hs
|
||||
tocktest_SOURCES += frontends/PreprocessOccamTest.hs
|
||||
tocktest_SOURCES += frontends/RainPassesTest.hs
|
||||
|
|
|
|||
|
|
@ -30,6 +30,8 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
--
|
||||
-- * "OccamPassesTest"
|
||||
--
|
||||
-- * "OccamTypesTest"
|
||||
--
|
||||
-- * "ParseRainTest"
|
||||
--
|
||||
-- * "PassTest"
|
||||
|
|
@ -59,6 +61,7 @@ import qualified CommonTest (tests)
|
|||
import qualified FlowGraphTest (qcTests)
|
||||
import qualified GenerateCTest (tests)
|
||||
import qualified OccamPassesTest (tests)
|
||||
import qualified OccamTypesTest (tests)
|
||||
import qualified ParseRainTest (tests)
|
||||
import qualified PassTest (tests)
|
||||
import qualified PreprocessOccamTest (tests)
|
||||
|
|
@ -174,6 +177,7 @@ main = do (opts, nonOpts, errs) <- getArgs >>* getOpt RequireOrder options
|
|||
,return FlowGraphTest.qcTests
|
||||
,noqc GenerateCTest.tests
|
||||
,noqc OccamPassesTest.tests
|
||||
,noqc OccamTypesTest.tests
|
||||
,noqc ParseRainTest.tests
|
||||
,noqc PassTest.tests
|
||||
,noqc PreprocessOccamTest.tests
|
||||
|
|
|
|||
|
|
@ -29,6 +29,7 @@ import Errors
|
|||
import EvalConstants
|
||||
import EvalLiterals
|
||||
import Metadata
|
||||
import OccamTypes
|
||||
import Pass
|
||||
import qualified Properties as Prop
|
||||
import ShowCode
|
||||
|
|
@ -46,6 +47,9 @@ occamPasses = makePassesDep' ((== FrontendOccam) . csFrontend)
|
|||
, ("Check mandatory constants", checkConstants,
|
||||
[Prop.constantsFolded, Prop.arrayConstructorTypesDone],
|
||||
[Prop.constantsChecked])
|
||||
, ("Check types", checkTypes,
|
||||
[],
|
||||
[Prop.expressionTypesChecked, Prop.processTypesChecked])
|
||||
, ("Check retyping", checkRetypes,
|
||||
[],
|
||||
[Prop.retypesChecked])
|
||||
|
|
|
|||
407
frontends/OccamTypes.hs
Normal file
407
frontends/OccamTypes.hs
Normal file
|
|
@ -0,0 +1,407 @@
|
|||
{-
|
||||
Tock: a compiler for parallel languages
|
||||
Copyright (C) 2008 University of Kent
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU General Public License as published by the
|
||||
Free Software Foundation, either version 2 of the License, or (at your
|
||||
option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License along
|
||||
with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
-}
|
||||
|
||||
-- | The occam typechecker.
|
||||
module OccamTypes (checkTypes) where
|
||||
|
||||
import Control.Monad.State
|
||||
import Data.Generics
|
||||
|
||||
import qualified AST as A
|
||||
import CompState
|
||||
import Errors
|
||||
import EvalLiterals
|
||||
import Intrinsics
|
||||
import Metadata
|
||||
import Pass
|
||||
import ShowCode
|
||||
import Types
|
||||
|
||||
-- | A successful check.
|
||||
ok :: PassM ()
|
||||
ok = return ()
|
||||
|
||||
--{{{ type checks
|
||||
|
||||
-- | Are two types the same?
|
||||
sameType :: A.Type -> A.Type -> PassM Bool
|
||||
sameType (A.Array (A.Dimension e1 : ds1) t1)
|
||||
(A.Array (A.Dimension e2 : ds2) t2)
|
||||
= do n1 <- evalIntExpression e1
|
||||
n2 <- evalIntExpression e2
|
||||
same <- sameType (A.Array ds1 t1) (A.Array ds2 t2)
|
||||
return $ (n1 == n2) && same
|
||||
sameType (A.Array (A.UnknownDimension : ds1) t1)
|
||||
(A.Array (A.UnknownDimension : ds2) t2)
|
||||
= sameType (A.Array ds1 t1) (A.Array ds2 t2)
|
||||
sameType a b = return $ a == b
|
||||
|
||||
-- | Check that the second dimension can be used in a context where the first
|
||||
-- is expected.
|
||||
isValidDimension :: A.Dimension -> A.Dimension -> PassM Bool
|
||||
isValidDimension A.UnknownDimension A.UnknownDimension = return True
|
||||
isValidDimension A.UnknownDimension (A.Dimension _) = return True
|
||||
isValidDimension (A.Dimension e1) (A.Dimension e2)
|
||||
= do n1 <- evalIntExpression e1
|
||||
n2 <- evalIntExpression e2
|
||||
return $ n1 == n2
|
||||
isValidDimension _ _ = return False
|
||||
|
||||
-- | Check that the second second of dimensions can be used in a context where
|
||||
-- the first is expected.
|
||||
areValidDimensions :: [A.Dimension] -> [A.Dimension] -> PassM Bool
|
||||
areValidDimensions [] [] = return True
|
||||
areValidDimensions (d1:ds1) (d2:ds2)
|
||||
= do valid <- isValidDimension d1 d2
|
||||
if valid
|
||||
then areValidDimensions ds1 ds2
|
||||
else return False
|
||||
areValidDimensions _ _ = return False
|
||||
|
||||
-- | Check that a type we've inferred matches the type we expected.
|
||||
checkType :: Meta -> A.Type -> A.Type -> PassM ()
|
||||
checkType m et rt
|
||||
= case (et, rt) of
|
||||
((A.Array ds t), (A.Array ds' t')) ->
|
||||
do valid <- areValidDimensions ds ds'
|
||||
if valid
|
||||
then checkType m t t'
|
||||
else bad
|
||||
_ ->
|
||||
do same <- sameType rt et
|
||||
when (not same) $ bad
|
||||
where
|
||||
bad :: PassM ()
|
||||
bad = diePC m $ formatCode "Type mismatch: found %, expected %" rt et
|
||||
|
||||
-- | Check that a type is numeric.
|
||||
checkNumeric :: Meta -> A.Type -> PassM ()
|
||||
checkNumeric m rawT
|
||||
= do t <- underlyingType m rawT
|
||||
if isIntegerType t || isRealType t
|
||||
then ok
|
||||
else diePC m $ formatCode "Expected numeric type; found %" t
|
||||
|
||||
-- | Check that a type is integral.
|
||||
checkInteger :: Meta -> A.Type -> PassM ()
|
||||
checkInteger m rawT
|
||||
= do t <- underlyingType m rawT
|
||||
if isIntegerType t
|
||||
then ok
|
||||
else diePC m $ formatCode "Expected integer type; found %" t
|
||||
|
||||
-- | Check that a type is scalar.
|
||||
checkScalar :: Meta -> A.Type -> PassM ()
|
||||
checkScalar m rawT
|
||||
= do t <- underlyingType m rawT
|
||||
if isScalarType t
|
||||
then ok
|
||||
else diePC m $ formatCode "Expected scalar type; found %" t
|
||||
|
||||
-- | Check that a type is an array.
|
||||
-- (This also gets used elsewhere where we *know* the argument isn't an array,
|
||||
-- so that we get a consistent error message.)
|
||||
checkArray :: Meta -> A.Type -> PassM ()
|
||||
checkArray m rawT
|
||||
= do t <- underlyingType m rawT
|
||||
case t of
|
||||
(A.Array _ _) -> ok
|
||||
_ -> diePC m $ formatCode "Expected array type; found %" t
|
||||
|
||||
-- | Check that a type is a list.
|
||||
checkList :: Meta -> A.Type -> PassM ()
|
||||
checkList m rawT
|
||||
= do t <- underlyingType m rawT
|
||||
case t of
|
||||
(A.List _) -> ok
|
||||
_ -> diePC m $ formatCode "Expected list type; found %" t
|
||||
|
||||
-- | Check the type of an expression.
|
||||
checkExpressionType :: Meta -> A.Type -> A.Expression -> PassM ()
|
||||
checkExpressionType m et e = typeOfExpression e >>= checkType m et
|
||||
|
||||
-- | Check that an expression is of integer type.
|
||||
checkExpressionInt :: Meta -> A.Expression -> PassM ()
|
||||
checkExpressionInt m e = checkExpressionType m A.Int e
|
||||
|
||||
-- | Check that an expression is of boolean type.
|
||||
checkExpressionBool :: Meta -> A.Expression -> PassM ()
|
||||
checkExpressionBool m e = checkExpressionType m A.Bool e
|
||||
|
||||
-- | Check the type of a variable.
|
||||
checkVariableType :: Meta -> A.Type -> A.Variable -> PassM ()
|
||||
checkVariableType m et v = typeOfVariable v >>= checkType m et
|
||||
|
||||
-- | Check that two lists of types match (for example, for parallel
|
||||
-- assignment).
|
||||
checkTypeList :: Meta -> [A.Type] -> [A.Type] -> PassM ()
|
||||
checkTypeList m ets rts
|
||||
= sequence_ [checkType m et rt | (et, rt) <- zip ets rts]
|
||||
|
||||
--}}}
|
||||
--{{{ more complex checks
|
||||
|
||||
-- | Check that an array literal's length matches its type.
|
||||
checkArraySize :: Meta -> A.Type -> Int -> PassM ()
|
||||
checkArraySize m rawT want
|
||||
= do t <- underlyingType m rawT
|
||||
case t of
|
||||
A.Array (A.UnknownDimension:_) _ -> ok
|
||||
A.Array (A.Dimension e:_) _ ->
|
||||
do n <- evalIntExpression e
|
||||
when (n /= want) $
|
||||
dieP m $ "Array literal has wrong number of elements: found " ++ show n ++ ", expected " ++ show want
|
||||
_ -> checkArray m t
|
||||
|
||||
-- | Check that a record field name is valid.
|
||||
checkRecordField :: Meta -> A.Type -> A.Name -> PassM ()
|
||||
checkRecordField m t n
|
||||
= do rfs <- recordFields m t
|
||||
let validNames = map fst rfs
|
||||
when (not $ n `elem` validNames) $
|
||||
diePC m $ formatCode "Invalid field name % in record type %" n t
|
||||
|
||||
-- | Check that a subscript is being applied to an appropriate type.
|
||||
checkSubscriptType :: Meta -> A.Subscript -> A.Type -> PassM ()
|
||||
checkSubscriptType m s rawT
|
||||
= do t <- underlyingType m rawT
|
||||
case s of
|
||||
-- A record subscript.
|
||||
A.SubscriptField m n ->
|
||||
checkRecordField m t n
|
||||
-- An array subscript.
|
||||
_ ->
|
||||
case t of
|
||||
A.Array _ _ -> ok
|
||||
_ -> checkArray m t
|
||||
|
||||
-- | Classes of operators.
|
||||
data OpClass = NumericOp | IntegerOp | ShiftOp | BooleanOp | ComparisonOp
|
||||
| ListOp
|
||||
|
||||
-- | Figure out the class of a monadic operator.
|
||||
classifyMOp :: A.MonadicOp -> OpClass
|
||||
classifyMOp A.MonadicSubtr = NumericOp
|
||||
classifyMOp A.MonadicMinus = NumericOp
|
||||
classifyMOp A.MonadicBitNot = IntegerOp
|
||||
classifyMOp A.MonadicNot = BooleanOp
|
||||
|
||||
-- | Figure out the class of a dyadic operator.
|
||||
classifyOp :: A.DyadicOp -> OpClass
|
||||
classifyOp A.Add = NumericOp
|
||||
classifyOp A.Subtr = NumericOp
|
||||
classifyOp A.Mul = NumericOp
|
||||
classifyOp A.Div = NumericOp
|
||||
classifyOp A.Rem = NumericOp
|
||||
classifyOp A.Plus = NumericOp
|
||||
classifyOp A.Minus = NumericOp
|
||||
classifyOp A.Times = NumericOp
|
||||
classifyOp A.BitAnd = IntegerOp
|
||||
classifyOp A.BitOr = IntegerOp
|
||||
classifyOp A.BitXor = IntegerOp
|
||||
classifyOp A.LeftShift = ShiftOp
|
||||
classifyOp A.RightShift = ShiftOp
|
||||
classifyOp A.And = BooleanOp
|
||||
classifyOp A.Or = BooleanOp
|
||||
classifyOp A.Eq = ComparisonOp
|
||||
classifyOp A.NotEq = ComparisonOp
|
||||
classifyOp A.Less = ComparisonOp
|
||||
classifyOp A.More = ComparisonOp
|
||||
classifyOp A.LessEq = ComparisonOp
|
||||
classifyOp A.MoreEq = ComparisonOp
|
||||
classifyOp A.After = ComparisonOp
|
||||
classifyOp A.Concat = ListOp
|
||||
|
||||
-- | Check a monadic operator.
|
||||
checkMonadicOp :: A.MonadicOp -> A.Expression -> PassM ()
|
||||
checkMonadicOp op e
|
||||
= do t <- typeOfExpression e
|
||||
let m = findMeta e
|
||||
case classifyMOp op of
|
||||
NumericOp -> checkNumeric m t
|
||||
IntegerOp -> checkInteger m t
|
||||
BooleanOp -> checkType m A.Bool t
|
||||
|
||||
-- | Check a dyadic operator.
|
||||
checkDyadicOp :: A.DyadicOp -> A.Expression -> A.Expression -> PassM ()
|
||||
checkDyadicOp op l r
|
||||
= do lt <- typeOfExpression l
|
||||
let lm = findMeta l
|
||||
rt <- typeOfExpression r
|
||||
let rm = findMeta r
|
||||
case classifyOp op of
|
||||
NumericOp ->
|
||||
checkNumeric lm lt >> checkNumeric rm rt >> checkType rm lt rt
|
||||
IntegerOp ->
|
||||
checkInteger lm lt >> checkInteger rm rt >> checkType rm lt rt
|
||||
ShiftOp ->
|
||||
checkNumeric lm lt >> checkType rm A.Int rt
|
||||
BooleanOp ->
|
||||
checkType lm A.Bool lt >> checkType rm A.Bool rt
|
||||
ComparisonOp ->
|
||||
checkScalar lm lt >> checkScalar rm rt >> checkType rm lt rt
|
||||
ListOp ->
|
||||
checkList lm lt >> checkList rm rt >> checkType rm lt rt
|
||||
|
||||
-- | Check a function call.
|
||||
checkFunctionCall :: Meta -> A.Name -> [A.Expression] -> Bool -> PassM ()
|
||||
checkFunctionCall m n es singleOnly
|
||||
= do st <- specTypeOfName n
|
||||
case st of
|
||||
A.Function _ _ rs fs _ ->
|
||||
do when (singleOnly && length rs /= 1) $
|
||||
diePC m $ formatCode "Function % used in an expression returns more than one value" n
|
||||
when (length es /= length fs) $
|
||||
diePC m $ formatCode ("Function % called with wrong number of arguments; found " ++ (show $ length es) ++ ", expected " ++ (show $ length fs)) n
|
||||
sequence_ [do rt <- typeOfExpression e
|
||||
checkType (findMeta e) et rt
|
||||
| (e, A.Formal _ et _) <- zip es fs]
|
||||
_ -> diePC m $ formatCode ("% is not a function; it's a " ++ show st) n
|
||||
|
||||
-- | Check an intrinsic function call.
|
||||
checkIntrinsicFunctionCall :: Meta -> String -> [A.Expression] -> Bool
|
||||
-> PassM ()
|
||||
checkIntrinsicFunctionCall m s es singleOnly
|
||||
= case lookup s intrinsicFunctions of
|
||||
Just (rs, tns) ->
|
||||
do when (singleOnly && length rs /= 1) $
|
||||
dieP m $ "Intrinsic function " ++ s ++ " used in an expression returns more than one value"
|
||||
when (length es /= length tns) $
|
||||
dieP m $ "Intrinsic function " ++ s ++ " called with wrong number of arguments; found " ++ (show $ length es) ++ ", expected " ++ (show $ length tns)
|
||||
sequence_ [do rt <- typeOfExpression e
|
||||
checkType (findMeta e) et rt
|
||||
| (e, (et, _)) <- zip es tns]
|
||||
Nothing -> dieP m $ s ++ " is not an intrinsic function"
|
||||
|
||||
-- | Check a mobile allocation.
|
||||
checkAllocMobile :: Meta -> A.Type -> Maybe A.Expression -> PassM ()
|
||||
checkAllocMobile m rawT me
|
||||
= do t <- underlyingType m rawT
|
||||
case t of
|
||||
A.Mobile innerT ->
|
||||
do case innerT of
|
||||
A.Array ds _ -> sequence_ $ map checkFullDimension ds
|
||||
_ -> ok
|
||||
case me of
|
||||
Just e ->
|
||||
do et <- typeOfExpression e
|
||||
checkType (findMeta e) innerT et
|
||||
Nothing -> ok
|
||||
_ -> diePC m $ formatCode "Expected mobile type in allocation; found %" t
|
||||
where
|
||||
checkFullDimension :: A.Dimension -> PassM ()
|
||||
checkFullDimension A.UnknownDimension
|
||||
= dieP m $ "Type in allocation contains unknown dimensions"
|
||||
checkFullDimension _ = ok
|
||||
--}}}
|
||||
|
||||
-- | Check the AST for type consistency.
|
||||
-- This is actually a series of smaller passes that check particular types
|
||||
-- inside the AST, but it doesn't really make sense to split it up.
|
||||
checkTypes :: Data t => t -> PassM t
|
||||
checkTypes t =
|
||||
checkSubscripts t >>=
|
||||
checkLiterals >>=
|
||||
checkVariables >>=
|
||||
checkExpressions
|
||||
|
||||
checkSubscripts :: Data t => t -> PassM t
|
||||
checkSubscripts = checkDepthM doSubscript
|
||||
where
|
||||
doSubscript :: A.Subscript -> PassM ()
|
||||
doSubscript (A.Subscript m _ e) = checkExpressionInt m e
|
||||
doSubscript (A.SubscriptFromFor m e f)
|
||||
= checkExpressionInt m e >> checkExpressionInt m f
|
||||
doSubscript (A.SubscriptFrom m e) = checkExpressionInt m e
|
||||
doSubscript (A.SubscriptFor m e) = checkExpressionInt m e
|
||||
doSubscript _ = ok
|
||||
|
||||
checkLiterals :: Data t => t -> PassM t
|
||||
checkLiterals = checkDepthM doExpression
|
||||
where
|
||||
doExpression :: A.Expression -> PassM ()
|
||||
doExpression (A.Literal m t lr) = doLiteralRepr t lr
|
||||
doExpression _ = ok
|
||||
|
||||
doLiteralRepr :: A.Type -> A.LiteralRepr -> PassM ()
|
||||
doLiteralRepr t (A.ArrayLiteral m aes)
|
||||
= doArrayElem m t (A.ArrayElemArray aes)
|
||||
doLiteralRepr t (A.RecordLiteral m es)
|
||||
= do rfs <- underlyingType m t >>= recordFields m
|
||||
when (length es /= length rfs) $
|
||||
dieP m $ "Record literal has wrong number of fields: found " ++ (show $ length es) ++ ", expected " ++ (show $ length rfs)
|
||||
sequence_ [checkExpressionType (findMeta fe) ft fe
|
||||
| ((_, ft), fe) <- zip rfs es]
|
||||
doLiteralRepr _ _ = ok
|
||||
|
||||
doArrayElem :: Meta -> A.Type -> A.ArrayElem -> PassM ()
|
||||
doArrayElem m t (A.ArrayElemArray aes)
|
||||
= do checkArraySize m t (length aes)
|
||||
t' <- subscriptType (A.Subscript m A.NoCheck undefined) t
|
||||
sequence_ $ map (doArrayElem m t') aes
|
||||
doArrayElem _ t (A.ArrayElemExpr e) = checkExpressionType (findMeta e) t e
|
||||
|
||||
checkVariables :: Data t => t -> PassM t
|
||||
checkVariables = checkDepthM doVariable
|
||||
where
|
||||
doVariable :: A.Variable -> PassM ()
|
||||
doVariable (A.SubscriptedVariable m s v)
|
||||
= do t <- typeOfVariable v
|
||||
checkSubscriptType m s t
|
||||
doVariable (A.DirectedVariable m _ v)
|
||||
= do t <- typeOfVariable v >>= underlyingType m
|
||||
case t of
|
||||
A.Chan _ _ _ -> ok
|
||||
_ -> dieP m $ "Direction applied to non-channel variable"
|
||||
doVariable (A.DerefVariable m v)
|
||||
= do t <- typeOfVariable v >>= underlyingType m
|
||||
case t of
|
||||
A.Mobile _ -> ok
|
||||
_ -> dieP m $ "Dereference applied to non-mobile variable"
|
||||
doVariable _ = ok
|
||||
|
||||
checkExpressions :: Data t => t -> PassM t
|
||||
checkExpressions = checkDepthM doExpression
|
||||
where
|
||||
doExpression :: A.Expression -> PassM ()
|
||||
doExpression (A.Monadic _ op e) = checkMonadicOp op e
|
||||
doExpression (A.Dyadic _ op le re) = checkDyadicOp op le re
|
||||
doExpression (A.MostPos m t) = checkNumeric m t
|
||||
doExpression (A.MostNeg m t) = checkNumeric m t
|
||||
doExpression (A.SizeType m t) = checkArray m t
|
||||
doExpression (A.SizeExpr m e)
|
||||
= do t <- typeOfExpression e
|
||||
checkArray m t
|
||||
doExpression (A.SizeVariable m v)
|
||||
= do t <- typeOfVariable v
|
||||
checkArray m t
|
||||
doExpression (A.Conversion m _ t e)
|
||||
= do et <- typeOfExpression e
|
||||
checkScalar m t >> checkScalar (findMeta e) et
|
||||
doExpression (A.FunctionCall m n es)
|
||||
= checkFunctionCall m n es True
|
||||
doExpression (A.IntrinsicFunctionCall m s es)
|
||||
= checkIntrinsicFunctionCall m s es True
|
||||
doExpression (A.SubscriptedExpr m s e)
|
||||
= do t <- typeOfExpression e
|
||||
checkSubscriptType m s t
|
||||
doExpression (A.OffsetOf m rawT n)
|
||||
= do t <- underlyingType m rawT
|
||||
checkRecordField m t n
|
||||
doExpression (A.AllocMobile m t me) = checkAllocMobile m t me
|
||||
doExpression _ = ok
|
||||
245
frontends/OccamTypesTest.hs
Normal file
245
frontends/OccamTypesTest.hs
Normal file
|
|
@ -0,0 +1,245 @@
|
|||
{-
|
||||
Tock: a compiler for parallel languages
|
||||
Copyright (C) 2008 University of Kent
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU General Public License as published by the
|
||||
Free Software Foundation, either version 2 of the License, or (at your
|
||||
option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but
|
||||
WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License along
|
||||
with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
-}
|
||||
|
||||
-- #ignore-exports
|
||||
|
||||
-- | Tests for 'OccamTypes'.
|
||||
module OccamTypesTest (tests) where
|
||||
|
||||
import Control.Monad.State
|
||||
import Data.Generics
|
||||
import Test.HUnit hiding (State)
|
||||
|
||||
import qualified AST as A
|
||||
import CompState
|
||||
import Metadata
|
||||
import qualified OccamTypes
|
||||
import TestUtils
|
||||
|
||||
m :: Meta
|
||||
m = emptyMeta
|
||||
|
||||
-- | Initial state for the tests.
|
||||
startState :: State CompState ()
|
||||
startState
|
||||
= do defineConst "const" A.Int (intLiteral 2)
|
||||
defineConst "someInt" A.Int (intLiteral 42)
|
||||
defineConst "someByte" A.Byte (byteLiteral 24)
|
||||
defineConst "someInts" (A.Array [A.UnknownDimension] A.Int)
|
||||
(A.Literal m (A.Array [A.UnknownDimension] A.Int)
|
||||
(A.ArrayLiteral m []))
|
||||
defineConst "someBytes" (A.Array [A.UnknownDimension] A.Byte)
|
||||
(A.Literal m (A.Array [A.UnknownDimension] A.Int)
|
||||
(A.ArrayLiteral m []))
|
||||
defineUserDataType "MYINT" A.Int
|
||||
defineUserDataType "MY2INT" (A.Array [dimension 2] A.Int)
|
||||
defineRecordType "COORD2" [("x", A.Int), ("y", A.Int)]
|
||||
defineRecordType "COORD3" [("x", A.Real32), ("y", A.Real32),
|
||||
("z", A.Real32)]
|
||||
defineChannel "chanInt" (A.Chan A.DirUnknown ca A.Int)
|
||||
defineVariable "mobileInt" (A.Mobile A.Int)
|
||||
defineFunction "function0" [A.Int] []
|
||||
defineFunction "function1" [A.Int] [("x", A.Int)]
|
||||
defineFunction "function2" [A.Int] [("x", A.Int), ("y", A.Int)]
|
||||
defineFunction "function22" [A.Int, A.Int]
|
||||
[("x", A.Int), ("y", A.Int)]
|
||||
where
|
||||
ca = A.ChanAttributes False False
|
||||
|
||||
-- | Test the typechecker.
|
||||
testOccamTypes :: Test
|
||||
testOccamTypes = TestList
|
||||
[
|
||||
-- Subscript expressions
|
||||
testOK 0 $ A.Subscript m A.NoCheck intE
|
||||
, testFail 1 $ A.Subscript m A.NoCheck byteE
|
||||
, testOK 2 $ A.SubscriptFromFor m intE intE
|
||||
, testFail 3 $ A.SubscriptFromFor m byteE byteE
|
||||
, testOK 4 $ A.SubscriptFrom m intE
|
||||
, testFail 5 $ A.SubscriptFrom m byteE
|
||||
, testOK 6 $ A.SubscriptFor m intE
|
||||
, testFail 7 $ A.SubscriptFor m byteE
|
||||
|
||||
-- Trivial literals
|
||||
, testOK 20 $ intE
|
||||
, testOK 21 $ byteE
|
||||
|
||||
-- Array literals
|
||||
, testOK 30 $ A.Literal m twoIntsT twoInts
|
||||
, testFail 31 $ A.Literal m threeIntsT twoInts
|
||||
, testFail 32 $ A.Literal m twoBytesT twoInts
|
||||
, testFail 33 $ A.Literal m A.Int twoInts
|
||||
, testFail 34 $ A.Literal m twoTwoIntsT twoInts
|
||||
, testOK 35 $ A.Literal m myTwoIntsT twoInts
|
||||
, testFail 36 $ A.Literal m myIntT twoInts
|
||||
|
||||
-- Record literals
|
||||
, testFail 40 $ A.Literal m coord2T twoInts
|
||||
, testOK 41 $ A.Literal m coord2T coord2
|
||||
, testFail 42 $ A.Literal m coord2T coord3
|
||||
, testOK 43 $ A.Literal m coord3T coord3
|
||||
, testFail 44 $ A.Literal m coord3T coord2
|
||||
, testFail 45 $ A.Literal m A.Int coord2
|
||||
, testFail 46 $ A.Literal m twoIntsT coord2
|
||||
, testFail 47 $ A.Literal m myTwoIntsT coord2
|
||||
|
||||
-- Variables
|
||||
, testOK 50 $ intV
|
||||
, testOK 51 $ bytesV
|
||||
, testOK 52 $ A.DirectedVariable m A.DirInput chanIntV
|
||||
, testFail 53 $ A.DirectedVariable m A.DirInput intV
|
||||
, testOK 54 $ A.DerefVariable m mobileIntV
|
||||
, testFail 55 $ A.DerefVariable m chanIntV
|
||||
|
||||
-- Operators in expressions
|
||||
, testOK 100 $ A.Monadic m A.MonadicSubtr intE
|
||||
, testFail 101 $ A.Monadic m A.MonadicSubtr twoIntsE
|
||||
, testFail 102 $ A.Monadic m A.MonadicSubtr boolE
|
||||
, testFail 103 $ A.Monadic m A.MonadicNot intE
|
||||
, testOK 104 $ A.Monadic m A.MonadicNot boolE
|
||||
, testOK 105 $ A.Dyadic m A.Add intE intE
|
||||
, testFail 106 $ A.Dyadic m A.Add intE byteE
|
||||
, testFail 107 $ A.Dyadic m A.Add byteE intE
|
||||
, testFail 108 $ A.Dyadic m A.Add byteE boolE
|
||||
, testOK 109 $ A.Dyadic m A.LeftShift intE intE
|
||||
, testOK 110 $ A.Dyadic m A.LeftShift byteE intE
|
||||
, testFail 111 $ A.Dyadic m A.LeftShift intE byteE
|
||||
, testOK 112 $ A.Dyadic m A.And boolE boolE
|
||||
, testFail 113 $ A.Dyadic m A.And boolE intE
|
||||
, testFail 114 $ A.Dyadic m A.And intE boolE
|
||||
, testFail 115 $ A.Dyadic m A.Add twoIntsE twoIntsE
|
||||
, testOK 116 $ A.Dyadic m A.Concat listE listE
|
||||
, testFail 117 $ A.Dyadic m A.Concat listE intE
|
||||
, testFail 118 $ A.Dyadic m A.Concat intE listE
|
||||
|
||||
-- Miscellaneous expressions
|
||||
, testOK 150 $ A.MostPos m A.Int
|
||||
, testFail 151 $ A.MostPos m twoIntsT
|
||||
, testOK 152 $ A.MostNeg m A.Int
|
||||
, testFail 153 $ A.MostNeg m twoIntsT
|
||||
, testOK 154 $ A.SizeType m twoIntsT
|
||||
, testFail 155 $ A.SizeType m A.Int
|
||||
, testOK 156 $ A.SizeExpr m twoIntsE
|
||||
, testFail 157 $ A.SizeExpr m intE
|
||||
, testOK 158 $ A.SizeExpr m twoTwoIntsE
|
||||
, testOK 159 $ A.SizeExpr m (sub0E twoTwoIntsE)
|
||||
, testFail 160 $ A.SizeExpr m (sub0E (sub0E twoTwoIntsE))
|
||||
, testFail 161 $ A.SizeExpr m (sub0E intE)
|
||||
, testOK 162 $ A.SizeVariable m intsV
|
||||
, testFail 163 $ A.SizeVariable m byteV
|
||||
, testOK 164 $ A.ExprVariable m intV
|
||||
, testOK 165 $ intE
|
||||
, testOK 166 $ boolLiteral True
|
||||
, testOK 167 $ A.IntrinsicFunctionCall m "SQRT" [realE]
|
||||
, testFail 168 $ A.IntrinsicFunctionCall m "SQRT" [intE]
|
||||
, testFail 169 $ A.IntrinsicFunctionCall m "SQRT" [realE, intE]
|
||||
, testOK 170 $ subxE coord2E
|
||||
, testFail 171 $ subxE twoTwoIntsE
|
||||
, testFail 172 $ subxE intE
|
||||
, testFail 173 $ A.SubscriptedExpr m (A.SubscriptField m function0) coord2E
|
||||
, testOK 174 $ A.OffsetOf m coord2T (simpleName "x")
|
||||
, testFail 175 $ A.OffsetOf m coord2T function0
|
||||
, testFail 176 $ A.OffsetOf m A.Int (simpleName "x")
|
||||
|
||||
-- Conversions
|
||||
, testOK 200 $ A.Conversion m A.Round A.Int realE
|
||||
, testOK 201 $ A.Conversion m A.Round A.Real32 intE
|
||||
, testFail 202 $ A.Conversion m A.Round A.Real32 twoIntsE
|
||||
, testFail 203 $ A.Conversion m A.Round twoIntsT realE
|
||||
|
||||
-- Function calls
|
||||
, testOK 220 $ A.FunctionCall m function0 []
|
||||
, testOK 221 $ A.FunctionCall m function1 [intE]
|
||||
, testOK 222 $ A.FunctionCall m function2 [intE, intE]
|
||||
, testFail 223 $ A.FunctionCall m function22 [intE, intE]
|
||||
, testFail 224 $ A.FunctionCall m function0 [intE]
|
||||
, testFail 225 $ A.FunctionCall m function1 [intE, intE]
|
||||
, testFail 226 $ A.FunctionCall m function2 [intE]
|
||||
, testFail 227 $ A.FunctionCall m function2 [intE, intE, intE]
|
||||
, testFail 228 $ A.FunctionCall m (simpleName "someInt") [intE]
|
||||
, testFail 229 $ A.FunctionCall m function1 [realE]
|
||||
, testFail 230 $ A.FunctionCall m function2 [intE, realE]
|
||||
, testFail 231 $ A.FunctionCall m function2 [twoIntsE, intE]
|
||||
, testOK 232 $ A.FunctionCall m function1 [sub0E twoIntsE]
|
||||
|
||||
-- Mobile allocations
|
||||
, testOK 250 $ A.AllocMobile m (A.Mobile A.Int) (Just intE)
|
||||
, testOK 251 $ A.AllocMobile m (A.Mobile A.Int) Nothing
|
||||
, testFail 252 $ A.AllocMobile m (A.Mobile A.Int) (Just realE)
|
||||
, testFail 253 $ A.AllocMobile m (A.Mobile A.Int) (Just realE)
|
||||
, testOK 254 $ A.AllocMobile m (A.Mobile A.Real32) (Just realE)
|
||||
, testOK 254 $ A.AllocMobile m (A.Mobile twoIntsT) (Just twoIntsE)
|
||||
, testFail 255 $ A.AllocMobile m (A.Mobile unknownIntsT) (Just twoIntsE)
|
||||
, testFail 256 $ A.AllocMobile m (A.Mobile unknownIntsT) Nothing
|
||||
]
|
||||
where
|
||||
testOK :: (Show a, Data a) => Int -> a -> Test
|
||||
testOK n orig
|
||||
= TestCase $ testPass ("testOccamTypes" ++ show n)
|
||||
orig (OccamTypes.checkTypes orig)
|
||||
startState
|
||||
|
||||
testFail :: (Show a, Data a) => Int -> a -> Test
|
||||
testFail n orig
|
||||
= TestCase $ testPassShouldFail ("testOccamTypes" ++ show n)
|
||||
(OccamTypes.checkTypes orig)
|
||||
startState
|
||||
|
||||
intV = variable "someInt"
|
||||
intE = intLiteral 42
|
||||
realE = A.Literal m A.Real32 $ A.RealLiteral m "3.14159"
|
||||
byteV = variable "someByte"
|
||||
byteE = byteLiteral 42
|
||||
intsV = variable "someInts"
|
||||
bytesV = variable "someBytes"
|
||||
boolE = boolLiteral True
|
||||
unknownIntsT = A.Array [A.UnknownDimension] A.Int
|
||||
twoIntsT = A.Array [dimension 2] A.Int
|
||||
twoTwoIntsT = A.Array [dimension 2, dimension 2] A.Int
|
||||
twoBytesT = A.Array [dimension 2] A.Byte
|
||||
threeIntsT = A.Array [dimension 3] A.Int
|
||||
ae = A.ArrayElemExpr intE
|
||||
twoInts = A.ArrayLiteral m [ae, ae]
|
||||
twoIntsE = A.Literal m twoIntsT twoInts
|
||||
twoTwoInts = A.ArrayLiteral m [A.ArrayElemArray [ae, ae],
|
||||
A.ArrayElemArray [ae, ae]]
|
||||
twoTwoIntsE = A.Literal m twoTwoIntsT twoTwoInts
|
||||
myIntT = A.UserDataType (simpleName "MYINT")
|
||||
myTwoIntsT = A.UserDataType (simpleName "MY2INT")
|
||||
coord2T = A.Record (simpleName "COORD2")
|
||||
coord2 = A.RecordLiteral m [intE, intE]
|
||||
coord2E = A.Literal m coord2T coord2
|
||||
coord3T = A.Record (simpleName "COORD3")
|
||||
coord3 = A.RecordLiteral m [realE, realE, realE]
|
||||
chanIntV = variable "chanInt"
|
||||
mobileIntV = variable "mobileInt"
|
||||
sub0 = A.Subscript m A.NoCheck (intLiteral 0)
|
||||
sub0E = A.SubscriptedExpr m sub0
|
||||
subx = A.SubscriptField m (simpleName "x")
|
||||
subxE = A.SubscriptedExpr m subx
|
||||
function0 = simpleName "function0"
|
||||
function1 = simpleName "function1"
|
||||
function2 = simpleName "function2"
|
||||
function22 = simpleName "function22"
|
||||
listT = A.List A.Int
|
||||
listE = A.Literal m listT (A.ListLiteral m [intE, intE, intE])
|
||||
|
||||
tests :: Test
|
||||
tests = TestLabel "OccamTypesTest" $ TestList
|
||||
[ testOccamTypes
|
||||
]
|
||||
Loading…
Reference in New Issue
Block a user