Changed the communication type checking to be part of the type unification framework
This commit is contained in:
Neil Brown
parent
1115364d47
commit
bf07c441ae
|
|
@ -58,7 +58,7 @@ rainPasses = makePassesDep' ((== FrontendRain) . csFrontend)
|
|||
,("Check types in expressions",checkExpressionTypes, namesDone ++ [Prop.noInt, Prop.constantsFolded, Prop.intLiteralsInBounds, Prop.inferredTypesRecorded], [Prop.expressionTypesChecked])
|
||||
-- ,("Check types in assignments", checkAssignmentTypes, typesDone ++ [Prop.expressionTypesChecked], [Prop.processTypesChecked])
|
||||
-- ,("Check types in if/while conditions",checkConditionalTypes, typesDone ++ [Prop.expressionTypesChecked], [Prop.processTypesChecked])
|
||||
,("Check types in input/output",checkCommTypes, typesDone ++ [Prop.expressionTypesChecked], [Prop.processTypesChecked])
|
||||
-- ,("Check types in input/output",checkCommTypes, typesDone ++ [Prop.expressionTypesChecked], [Prop.processTypesChecked])
|
||||
,("Check parameters in process calls", matchParamPass, typesDone, [Prop.processTypesChecked,
|
||||
Prop.functionTypesChecked])
|
||||
|
||||
|
|
|
|||
|
|
@ -90,6 +90,7 @@ performTypeUnification x
|
|||
-- First, we markup all the types in the tree:
|
||||
= do x' <- markConditionalTypes
|
||||
<.< markAssignmentTypes
|
||||
<.< markCommTypes
|
||||
$ x --TODO markup everything else
|
||||
-- Then, we do the unification:
|
||||
prs <- get >>* csUnifyPairs
|
||||
|
|
@ -392,76 +393,34 @@ markConditionalTypes = checkDepthM2 checkWhile checkIf
|
|||
= markUnify exp A.Bool
|
||||
|
||||
-- | Checks the types in inputs and outputs, including inputs in alts
|
||||
checkCommTypes :: Data t => t -> PassM t
|
||||
checkCommTypes = applyDepthM2 checkInputOutput checkAltInput
|
||||
markCommTypes :: Data t => t -> PassM t
|
||||
markCommTypes = checkDepthM2 checkInputOutput checkAltInput
|
||||
where
|
||||
checkInput :: A.Variable -> A.Variable -> Meta -> a -> PassM a
|
||||
checkInput :: A.Variable -> A.Variable -> Meta -> a -> PassM ()
|
||||
checkInput chanVar destVar m p
|
||||
= do chanType <- astTypeOf chanVar
|
||||
destType <- astTypeOf destVar
|
||||
case chanType of
|
||||
A.Chan dir _ innerType ->
|
||||
if (dir == A.DirOutput)
|
||||
then dieP m $ "Tried to input from the writing end of a channel: " ++ show chanVar
|
||||
else
|
||||
if (innerType == destType)
|
||||
then return p
|
||||
else diePC m $ formatCode "Mis-matching types; channel: \"%\" has inner-type: % but destination variable: \"%\" has type: %"
|
||||
chanVar innerType destVar destType
|
||||
_ -> dieP m $ "Tried to input from a variable that is not of type channel: " ++ show chanVar
|
||||
= astTypeOf destVar >>= markUnify chanVar . A.Chan A.DirInput (A.ChanAttributes
|
||||
False False)
|
||||
|
||||
checkWait :: A.InputMode -> PassM ()
|
||||
checkWait (A.InputTimerFor m exp)
|
||||
= do t <- astTypeOf exp
|
||||
when (t /= A.Time) $
|
||||
diePC m $ formatCode "Tried to wait for something that was not of time type: %"
|
||||
t
|
||||
checkWait (A.InputTimerAfter m exp)
|
||||
= do t <- astTypeOf exp
|
||||
when (t /= A.Time) $
|
||||
diePC m $ formatCode "Tried to wait for something that was not of time type: %"
|
||||
t
|
||||
checkWait (A.InputTimerRead m (A.InVariable _ v))
|
||||
= do t <- astTypeOf v
|
||||
when (t /= A.Time) $
|
||||
diePC m $ formatCode "Tried to wait for something that was not of time type: %"
|
||||
t
|
||||
checkWait :: Check A.InputMode
|
||||
checkWait (A.InputTimerFor m exp) = markUnify A.Time exp
|
||||
checkWait (A.InputTimerAfter m exp) = markUnify A.Time exp
|
||||
checkWait (A.InputTimerRead m (A.InVariable _ v)) = markUnify A.Time v
|
||||
checkWait _ = return ()
|
||||
|
||||
checkInputOutput :: A.Process -> PassM A.Process
|
||||
checkInputOutput :: Check A.Process
|
||||
checkInputOutput p@(A.Input m chanVar (A.InputSimple _ [A.InVariable _ destVar]))
|
||||
= checkInput chanVar destVar m p
|
||||
checkInputOutput p@(A.Input _ _ im@(A.InputTimerFor {}))
|
||||
= do checkWait im
|
||||
return p
|
||||
checkInputOutput p@(A.Input _ _ im@(A.InputTimerAfter {}))
|
||||
= do checkWait im
|
||||
return p
|
||||
checkInputOutput p@(A.Input _ _ im@(A.InputTimerRead {}))
|
||||
= do checkWait im
|
||||
return p
|
||||
checkInputOutput (A.Input _ _ im@(A.InputTimerFor {})) = checkWait im
|
||||
checkInputOutput (A.Input _ _ im@(A.InputTimerAfter {})) = checkWait im
|
||||
checkInputOutput (A.Input _ _ im@(A.InputTimerRead {})) = checkWait im
|
||||
checkInputOutput p@(A.Output m chanVar [A.OutExpression m' srcExp])
|
||||
= do chanType <- astTypeOf chanVar
|
||||
srcType <- astTypeOf srcExp
|
||||
case chanType of
|
||||
A.Chan dir _ innerType ->
|
||||
if (dir == A.DirInput)
|
||||
then dieP m $ "Tried to output to the reading end of a channel: " ++ show chanVar
|
||||
else
|
||||
if (innerType == srcType)
|
||||
then return p
|
||||
else do castExp <- coerceType " for writing to channel" innerType srcType srcExp
|
||||
return $ A.Output m chanVar [A.OutExpression m' castExp]
|
||||
_ -> dieP m $ "Tried to output to a variable that is not of type channel: " ++ show chanVar
|
||||
checkInputOutput p = return p
|
||||
= astTypeOf srcExp >>= markUnify chanVar . A.Chan A.DirOutput (A.ChanAttributes
|
||||
False False)
|
||||
checkInputOutput _ = return ()
|
||||
|
||||
checkAltInput :: A.Alternative -> PassM A.Alternative
|
||||
checkAltInput :: Check A.Alternative
|
||||
checkAltInput a@(A.Alternative m _ chanVar (A.InputSimple _ [A.InVariable _ destVar]) body)
|
||||
= checkInput chanVar destVar m a
|
||||
checkAltInput a@(A.Alternative m _ _ im@(A.InputTimerFor {}) _)
|
||||
= do checkWait im
|
||||
return a
|
||||
checkAltInput a@(A.Alternative m _ _ im@(A.InputTimerAfter {}) _)
|
||||
= do checkWait im
|
||||
return a
|
||||
checkAltInput a = return a
|
||||
checkAltInput (A.Alternative m _ _ im@(A.InputTimerFor {}) _) = checkWait im
|
||||
checkAltInput (A.Alternative m _ _ im@(A.InputTimerAfter {}) _) = checkWait im
|
||||
checkAltInput _ = return ()
|
||||
|
|
|
|||
|
|
@ -297,26 +297,26 @@ checkExpressionTest = TestList
|
|||
,passSame 6503 A.Bool $ Dy (Var "t") A.More (Var "t")
|
||||
|
||||
--Now statements:
|
||||
,testPassUntouched 7000 checkCommTypes (getTime $ variable "t")
|
||||
,testPassUntouched 7000 performTypeUnification (getTime $ variable "t")
|
||||
,TestCase $ testPassShouldFail "checkExpressionTest 7001"
|
||||
(checkCommTypes $ getTime $ variable "x") state
|
||||
(performTypeUnification $ getTime $ variable "x") state
|
||||
|
||||
--Wait statements:
|
||||
,testPassUntouched 7100 checkCommTypes (waitFor $ exprVariable "t")
|
||||
,TestCase $ testPassShouldFail "checkExpressionTest 7101" (checkCommTypes $ waitFor $ exprVariable "x") state
|
||||
,testPassUntouched 7102 checkCommTypes (waitFor $ buildExpr $ Dy (Var "t") A.Plus (Var "t"))
|
||||
,testPassUntouched 7100 performTypeUnification (waitFor $ exprVariable "t")
|
||||
,TestCase $ testPassShouldFail "checkExpressionTest 7101" (performTypeUnification $ waitFor $ exprVariable "x") state
|
||||
,testPassUntouched 7102 performTypeUnification (waitFor $ buildExpr $ Dy (Var "t") A.Plus (Var "t"))
|
||||
|
||||
,testPassUntouched 7200 checkCommTypes (waitUntil $ exprVariable "t")
|
||||
,TestCase $ testPassShouldFail "checkExpressionTest 7201" (checkCommTypes $ waitUntil $ exprVariable "x") state
|
||||
,testPassUntouched 7202 checkCommTypes (waitUntil $ buildExpr $ Dy (Var "t") A.Plus (Var "t"))
|
||||
,testPassUntouched 7200 performTypeUnification (waitUntil $ exprVariable "t")
|
||||
,TestCase $ testPassShouldFail "checkExpressionTest 7201" (performTypeUnification $ waitUntil $ exprVariable "x") state
|
||||
,testPassUntouched 7202 performTypeUnification (waitUntil $ buildExpr $ Dy (Var "t") A.Plus (Var "t"))
|
||||
|
||||
,testPassUntouched 7300 checkCommTypes (altWaitFor (exprVariable "t") $ A.Skip m)
|
||||
,TestCase $ testPassShouldFail "checkExpressionTest 7301" (checkCommTypes $ altWaitFor (exprVariable "x") $ A.Skip m) state
|
||||
,testPassUntouched 7302 checkCommTypes (altWaitFor (buildExpr $ Dy (Var "t") A.Plus (Var "t")) $ A.Skip m)
|
||||
,testPassUntouched 7300 performTypeUnification (altWaitFor (exprVariable "t") $ A.Skip m)
|
||||
,TestCase $ testPassShouldFail "checkExpressionTest 7301" (performTypeUnification $ altWaitFor (exprVariable "x") $ A.Skip m) state
|
||||
,testPassUntouched 7302 performTypeUnification (altWaitFor (buildExpr $ Dy (Var "t") A.Plus (Var "t")) $ A.Skip m)
|
||||
|
||||
,testPassUntouched 7400 checkCommTypes (altWaitUntil (exprVariable "t") $ A.Skip m)
|
||||
,TestCase $ testPassShouldFail "checkExpressionTest 7401" (checkCommTypes $ altWaitUntil (exprVariable "x") $ A.Skip m) state
|
||||
,testPassUntouched 7402 checkCommTypes (altWaitUntil (buildExpr $ Dy (Var "t") A.Plus (Var "t")) $ A.Skip m)
|
||||
,testPassUntouched 7400 performTypeUnification (altWaitUntil (exprVariable "t") $ A.Skip m)
|
||||
,TestCase $ testPassShouldFail "checkExpressionTest 7401" (performTypeUnification $ altWaitUntil (exprVariable "x") $ A.Skip m) state
|
||||
,testPassUntouched 7402 performTypeUnification (altWaitUntil (buildExpr $ Dy (Var "t") A.Plus (Var "t")) $ A.Skip m)
|
||||
]
|
||||
where
|
||||
-- The type of a timer should not be checked, because it will only have parsed
|
||||
|
|
@ -384,8 +384,8 @@ checkExpressionTest = TestList
|
|||
testCheckCommTypesIn :: Int -> (A.Direction,A.Type,A.Variable) -> (A.Type,A.Variable) -> Test
|
||||
testCheckCommTypesIn n (chanDir,chanType,chanVar) (destType,destVar)
|
||||
= if (chanType == destType && chanDir /= A.DirOutput)
|
||||
then TestCase $ testPass ("testCheckCommTypesIn " ++ show n) (mkPattern st) (checkCommTypes st) state
|
||||
else TestCase $ testPassShouldFail ("testCheckCommTypesIn " ++ show n) (checkCommTypes st) state
|
||||
then TestCase $ testPass ("testCheckCommTypesIn " ++ show n) (mkPattern st) (performTypeUnification st) state
|
||||
else TestCase $ testPassShouldFail ("testCheckCommTypesIn " ++ show n) (performTypeUnification st) state
|
||||
where
|
||||
st = A.Input m chanVar $ A.InputSimple m [A.InVariable m destVar]
|
||||
|
||||
|
|
@ -394,8 +394,8 @@ checkExpressionTest = TestList
|
|||
testCheckCommTypesInAlt :: Int -> (A.Direction,A.Type,A.Variable) -> (A.Type,A.Variable) -> Test
|
||||
testCheckCommTypesInAlt n (chanDir,chanType,chanVar) (destType,destVar)
|
||||
= if (chanType == destType && chanDir /= A.DirOutput)
|
||||
then TestCase $ testPass ("testCheckCommTypesIn " ++ show n) (mkPattern st) (checkCommTypes st) state
|
||||
else TestCase $ testPassShouldFail ("testCheckCommTypesIn " ++ show n) (checkCommTypes st) state
|
||||
then TestCase $ testPass ("testCheckCommTypesIn " ++ show n) (mkPattern st) (performTypeUnification st) state
|
||||
else TestCase $ testPassShouldFail ("testCheckCommTypesIn " ++ show n) (performTypeUnification st) state
|
||||
where
|
||||
st = A.Alt m True $ A.Only m $ A.Alternative m (A.True m) chanVar (A.InputSimple m [A.InVariable m destVar]) $ A.Skip m
|
||||
|
||||
|
|
@ -420,10 +420,10 @@ checkExpressionTest = TestList
|
|||
testCheckCommTypesOut n (chanDir,chanType,chanVar) (srcType,srcVar)
|
||||
= if (isImplicitConversionRain srcType chanType && chanDir /= A.DirInput)
|
||||
then (if srcType == chanType
|
||||
then TestCase $ testPass ("testCheckCommTypesOut " ++ show n) (mkPattern st) (checkCommTypes st) state
|
||||
else TestCase $ testPass ("testCheckCommTypesOut " ++ show n) stCast (checkCommTypes st) state
|
||||
then TestCase $ testPass ("testCheckCommTypesOut " ++ show n) (mkPattern st) (performTypeUnification st) state
|
||||
else TestCase $ testPass ("testCheckCommTypesOut " ++ show n) stCast (performTypeUnification st) state
|
||||
)
|
||||
else TestCase $ testPassShouldFail ("testCheckCommTypesOut " ++ show n) (checkCommTypes st) state
|
||||
else TestCase $ testPassShouldFail ("testCheckCommTypesOut " ++ show n) (performTypeUnification st) state
|
||||
where
|
||||
st = A.Output m chanVar [A.OutExpression m $ A.ExprVariable m srcVar]
|
||||
stCast = tag3 A.Output DontCare chanVar [tag2 A.OutExpression DontCare $ tag4 A.Conversion DontCare A.DefaultConversion chanType $
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user