From 4e635d84bac1304f44850ba9e7c221a2fb968bce Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Wed, 19 Sep 2007 11:36:55 +0000
Subject: [PATCH] Rain: added a pass for checking the types in GetTime
 processes

---
 frontends/RainPasses.hs    |  1 +
 frontends/RainTypes.hs     | 12 ++++++++++++
 frontends/RainTypesTest.hs |  7 +++++++
 3 files changed, 20 insertions(+)

diff --git a/frontends/RainPasses.hs b/frontends/RainPasses.hs
index 5c5d119..0b9b430 100644
--- a/frontends/RainPasses.hs
+++ b/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
diff --git a/frontends/RainTypes.hs b/frontends/RainTypes.hs
index b51bc68..2b80644 100644
--- a/frontends/RainTypes.hs
+++ b/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
diff --git a/frontends/RainTypesTest.hs b/frontends/RainTypesTest.hs
index 643d5b9..eb94ff4 100644
--- a/frontends/RainTypesTest.hs
+++ b/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])