Merged the type-checking on time-related statements in Rain into the pass that checks types in communications

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])
        

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

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