diff --git a/frontends/RainPasses.hs b/frontends/RainPasses.hs index 7c84766..fe2b869 100644 --- a/frontends/RainPasses.hs +++ b/frontends/RainPasses.hs @@ -56,7 +56,6 @@ rainPasses = makePassesDep' ((== FrontendRain) . csFrontend) ,("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 now statements",checkGetTimeTypes, typesDone, [Prop.processTypesChecked]) ,("Check parameters in process calls", matchParamPass, typesDone, [Prop.processTypesChecked, Prop.functionTypesChecked]) diff --git a/frontends/RainTypes.hs b/frontends/RainTypes.hs index afc43b6..14a33a9 100644 --- a/frontends/RainTypes.hs +++ b/frontends/RainTypes.hs @@ -355,9 +355,36 @@ checkCommTypes = applyDepthM2 checkInputOutput checkAltInput chanVar innerType destVar destType _ -> dieP m $ "Tried to input from a variable that is not of type channel: " ++ show chanVar + checkWait :: A.InputMode -> PassM () + checkWait (A.InputTimerFor m exp) + = do t <- typeOfExpression 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 <- typeOfExpression 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 <- typeOfVariable v + when (t /= A.Time) $ + diePC m $ formatCode "Tried to wait for something that was not of time type: %" + t + checkWait _ = return () + checkInputOutput :: A.Process -> PassM 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 p@(A.Output m chanVar [A.OutExpression m' srcExp]) = do chanType <- typeOfVariable chanVar srcType <- typeOfExpression srcExp @@ -376,29 +403,10 @@ checkCommTypes = applyDepthM2 checkInputOutput checkAltInput checkAltInput :: A.Alternative -> PassM 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 - --- | Checks the types in now and wait statements, and wait guards: -checkGetTimeTypes :: Data t => t -> PassM t -checkGetTimeTypes = applyDepthM2 checkGetTime checkTimeGuards - where - checkGetTime :: A.Process -> PassM A.Process - checkGetTime p@(A.GetTime m v) - = do t <- typeOfVariable v - case t of - A.Time -> return p - _ -> diePC m $ formatCode "Cannot store time in variable of type \"%\"" t - checkGetTime p@(A.Wait m _ e) - = do t <- typeOfExpression e - case t of - A.Time -> return p - _ -> diePC m $ formatCode "Cannot wait with an expression of non-time type: \"%\"" t - checkGetTime p = return p - - checkTimeGuards :: A.Alternative -> PassM A.Alternative - checkTimeGuards g@(A.AlternativeWait m _ e _) - = do t <- typeOfExpression e - case t of - A.Time -> return g - _ -> diePC m $ formatCode "Cannot wait with an expression of non-time type: \"%\"" t - checkTimeGuards g = return g diff --git a/frontends/RainTypesTest.hs b/frontends/RainTypesTest.hs index b8cc615..c266daa 100644 --- a/frontends/RainTypesTest.hs +++ b/frontends/RainTypesTest.hs @@ -292,27 +292,41 @@ checkExpressionTest = TestList ,passSame 6503 A.Bool $ Dy (Var "t") A.More (Var "t") --Now statements: - ,testPassUntouched 7000 checkGetTimeTypes (A.GetTime m $ variable "t") - ,TestCase $ testPassShouldFail "checkExpressionTest 7001" (checkGetTimeTypes $ A.GetTime m $ variable "x") state + ,testPassUntouched 7000 checkCommTypes (getTime $ variable "t") + ,TestCase $ testPassShouldFail "checkExpressionTest 7001" + (checkCommTypes $ getTime $ variable "x") state --Wait statements: - ,testPassUntouched 7100 checkGetTimeTypes (A.Wait m A.WaitFor $ exprVariable "t") - ,TestCase $ testPassShouldFail "checkExpressionTest 7101" (checkGetTimeTypes $ A.Wait m A.WaitFor $ exprVariable "x") state - ,testPassUntouched 7102 checkGetTimeTypes (A.Wait m A.WaitFor $ buildExpr $ Dy (Var "t") A.Plus (Var "t")) + ,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 7200 checkGetTimeTypes (A.Wait m A.WaitUntil $ exprVariable "t") - ,TestCase $ testPassShouldFail "checkExpressionTest 7201" (checkGetTimeTypes $ A.Wait m A.WaitUntil $ exprVariable "x") state - ,testPassUntouched 7202 checkGetTimeTypes (A.Wait m A.WaitUntil $ 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 7300 checkGetTimeTypes (A.AlternativeWait m A.WaitFor (exprVariable "t") $ A.Skip m) - ,TestCase $ testPassShouldFail "checkExpressionTest 7301" (checkGetTimeTypes $ A.AlternativeWait m A.WaitFor (exprVariable "x") $ A.Skip m) state - ,testPassUntouched 7302 checkGetTimeTypes (A.AlternativeWait m A.WaitFor (buildExpr $ Dy (Var "t") A.Plus (Var "t")) $ A.Skip m) + ,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 7400 checkGetTimeTypes (A.AlternativeWait m A.WaitUntil (exprVariable "t") $ A.Skip m) - ,TestCase $ testPassShouldFail "checkExpressionTest 7401" (checkGetTimeTypes $ A.AlternativeWait m A.WaitUntil (exprVariable "x") $ A.Skip m) state - ,testPassUntouched 7402 checkGetTimeTypes (A.AlternativeWait m A.WaitUntil (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) ] where + -- The type of a timer should not be checked, because it will only have parsed + -- if it used the special name anyway + tim = variable "tim" + getTime :: A.Variable -> A.Process + getTime = A.Input m tim . A.InputTimerRead m . A.InVariable m + waitFor, waitUntil :: A.Expression -> A.Process + waitFor = A.Input m tim . A.InputTimerFor m + waitUntil = A.Input m tim . A.InputTimerAfter m + altWaitFor, altWaitUntil :: A.Expression -> A.Process -> A.Alternative + altWaitFor e body = A.Alternative m tim (A.InputTimerFor m e) body + altWaitUntil e body = A.Alternative m tim (A.InputTimerAfter m e) body + + testPassUntouched :: Data t => Int -> (t -> PassM t) -> t -> Test testPassUntouched n passFunc src = TestCase $ testPass ("checkExpressionTest " ++ show n) (mkPattern src) (passFunc src) state