Changed the communication type checking to be part of the type unification framework

frontends/RainPasses.hs

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

frontends/RainTypes.hs

@@ -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
+markCommTypes :: Data t => t -> PassM t
-checkCommTypes = applyDepthM2 checkInputOutput checkAltInput
+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
+      = astTypeOf destVar >>= markUnify chanVar . A.Chan A.DirInput (A.ChanAttributes
-           destType <- astTypeOf destVar
+        False False)
-           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
 
-    checkWait :: A.InputMode -> PassM ()
+    checkWait :: Check A.InputMode
-    checkWait (A.InputTimerFor m exp)
+    checkWait (A.InputTimerFor m exp) = markUnify A.Time exp
-      = do t <- astTypeOf exp
+    checkWait (A.InputTimerAfter m exp) = markUnify A.Time exp
-           when (t /= A.Time) $
+    checkWait (A.InputTimerRead m (A.InVariable _ v)) = markUnify A.Time v
-             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 _ = 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 {}))
+    checkInputOutput (A.Input _ _ im@(A.InputTimerFor {})) = checkWait im
-      = do checkWait im
+    checkInputOutput (A.Input _ _ im@(A.InputTimerAfter {})) = checkWait im
-           return p
+    checkInputOutput (A.Input _ _ im@(A.InputTimerRead {})) = checkWait im
-    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 <- astTypeOf chanVar
+      = astTypeOf srcExp >>= markUnify chanVar . A.Chan A.DirOutput (A.ChanAttributes
-           srcType <- astTypeOf srcExp
+        False False)
-           case chanType of
+    checkInputOutput _ = return ()
-             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
 
-    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 {}) _)
+    checkAltInput (A.Alternative m _ _ im@(A.InputTimerFor {}) _) = checkWait im
-      = do checkWait im
+    checkAltInput (A.Alternative m _ _ im@(A.InputTimerAfter {}) _) = checkWait im
-           return a
+    checkAltInput _ = return ()
-    checkAltInput a@(A.Alternative m _ _ im@(A.InputTimerAfter {}) _)
-      = do checkWait im
-           return a
-    checkAltInput a = return a

frontends/RainTypesTest.hs

@@ -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")
+  ,testPassUntouched 7100 performTypeUnification (waitFor $ exprVariable "t")
-  ,TestCase $ testPassShouldFail "checkExpressionTest 7101" (checkCommTypes $ waitFor $ exprVariable "x") state
+  ,TestCase $ testPassShouldFail "checkExpressionTest 7101" (performTypeUnification $ waitFor $ exprVariable "x") state
-  ,testPassUntouched 7102 checkCommTypes (waitFor $ buildExpr $ Dy (Var "t") A.Plus (Var "t"))
+  ,testPassUntouched 7102 performTypeUnification (waitFor $ buildExpr $ Dy (Var "t") A.Plus (Var "t"))
 
-  ,testPassUntouched 7200 checkCommTypes (waitUntil $ exprVariable "t")
+  ,testPassUntouched 7200 performTypeUnification (waitUntil $ exprVariable "t")
-  ,TestCase $ testPassShouldFail "checkExpressionTest 7201" (checkCommTypes $ waitUntil $ exprVariable "x") state
+  ,TestCase $ testPassShouldFail "checkExpressionTest 7201" (performTypeUnification $ waitUntil $ exprVariable "x") state
-  ,testPassUntouched 7202 checkCommTypes (waitUntil $ buildExpr $ Dy (Var "t") A.Plus (Var "t"))
+  ,testPassUntouched 7202 performTypeUnification (waitUntil $ buildExpr $ Dy (Var "t") A.Plus (Var "t"))
   
-  ,testPassUntouched 7300 checkCommTypes (altWaitFor (exprVariable "t") $ A.Skip m)
+  ,testPassUntouched 7300 performTypeUnification (altWaitFor (exprVariable "t") $ A.Skip m)
-  ,TestCase $ testPassShouldFail "checkExpressionTest 7301" (checkCommTypes $ altWaitFor (exprVariable "x") $ A.Skip m) state
+  ,TestCase $ testPassShouldFail "checkExpressionTest 7301" (performTypeUnification $ altWaitFor (exprVariable "x") $ A.Skip m) state
-  ,testPassUntouched 7302 checkCommTypes (altWaitFor (buildExpr $ Dy (Var "t") A.Plus (Var "t")) $ A.Skip m)
+  ,testPassUntouched 7302 performTypeUnification (altWaitFor (buildExpr $ Dy (Var "t") A.Plus (Var "t")) $ A.Skip m)
 
-  ,testPassUntouched 7400 checkCommTypes (altWaitUntil (exprVariable "t") $ A.Skip m)
+  ,testPassUntouched 7400 performTypeUnification (altWaitUntil (exprVariable "t") $ A.Skip m)
-  ,TestCase $ testPassShouldFail "checkExpressionTest 7401" (checkCommTypes $ altWaitUntil (exprVariable "x") $ A.Skip m) state
+  ,TestCase $ testPassShouldFail "checkExpressionTest 7401" (performTypeUnification $ altWaitUntil (exprVariable "x") $ A.Skip m) state
-  ,testPassUntouched 7402 checkCommTypes (altWaitUntil (buildExpr $ Dy (Var "t") A.Plus (Var "t")) $ A.Skip m)  
+  ,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
+        then TestCase $ testPass ("testCheckCommTypesIn " ++ show n) (mkPattern st) (performTypeUnification st) state
-        else TestCase $ testPassShouldFail ("testCheckCommTypesIn " ++ show n) (checkCommTypes 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
+        then TestCase $ testPass ("testCheckCommTypesIn " ++ show n) (mkPattern st) (performTypeUnification st) state
-        else TestCase $ testPassShouldFail ("testCheckCommTypesIn " ++ show n) (checkCommTypes 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
+                then TestCase $ testPass ("testCheckCommTypesOut " ++ show n) (mkPattern st) (performTypeUnification st) state
-                else TestCase $ testPass ("testCheckCommTypesOut " ++ show n) stCast (checkCommTypes 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 $