Rain: added a pass for checking the types in GetTime processes

frontends/RainPasses.hs

@@ -50,6 +50,7 @@ rainPasses =
        ,("Check types in assignments",checkAssignmentTypes) --depends on uniquifyAndResolveVars, recordInfNameTypes, checkExpressionTypes
        ,("Check types in if/while conditions",checkConditionalTypes) --depends on uniquifyAndResolveVars, recordInfNameTypes, checkExpressionTypes
        ,("Check types in input/output",checkCommTypes) --depends on uniquifyAndResolveVars, recordInfNameTypes, checkExpressionTypes
+       ,("Check types in now statements",checkGetTimeTypes) --depends on uniquifyAndResolveVars, recordInfNameTypes
        
        ,("Find and tag the main function",findMain) --depends on uniquifyAndResolveVars
        ,("Check parameters in process calls",matchParamPass) --depends on uniquifyAndResolveVars and recordInfNameTypes and checkExpressionTypes

frontends/RainTypes.hs

@@ -301,3 +301,15 @@ checkCommTypes = everywhereASTM checkInputOutput
                              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
+
+-- | Checks the types in now statements:
+checkGetTimeTypes :: Data t => t -> PassM t
+checkGetTimeTypes = everywhereASTM checkGetTime
+  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 = return p

frontends/RainTypesTest.hs

@@ -27,6 +27,7 @@ import qualified AST as A
 import CompState
 import Control.Monad.State
 import Control.Monad.Error
+import Data.Generics
 import Types
 import Pass
 import Errors
@@ -227,8 +228,14 @@ checkExpressionTest = TestList
   ,passSame 6502 A.Bool $ Dy (Var "t") A.Less (Var "t")
   ,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
  ]
  where
+  testPassUntouched :: Data t => Int -> (t -> PassM t) -> t -> Test
+  testPassUntouched n passFunc src = TestCase $ testPass ("checkExpressionTest " ++ show n) (mkPattern src) (passFunc src) state
+ 
   passAssign :: Int -> String -> ExprHelper -> ExprHelper -> Test
   passAssign n lhs exp src = TestCase $ testPassWithCheck ("checkExpressionTest " ++ show n) 
     (tag3 A.Assign DontCare [variablePattern lhs] $ tag2 A.ExpressionList DontCare [buildExprPattern exp])