Added assignments to the new type unification system for Rain

frontends/RainPasses.hs

@@ -44,19 +44,19 @@ rainPasses = makePassesDep' ((== FrontendRain) . csFrontend)
        ,("Uniquify variable declarations, record declared types and resolve variable names",
            uniquifyAndResolveVars, [Prop.noInt], namesDone)
             
-       ,("Fold all constant expressions", constantFoldPass, [Prop.noInt] ++ namesDone, [Prop.constantsFolded, Prop.constantsChecked])
+--       ,("Fold all constant expressions", constantFoldPass, [Prop.noInt] ++ namesDone, [Prop.constantsFolded, Prop.constantsChecked])
        ,("Type Checking", performTypeUnification, [Prop.noInt] ++ namesDone,
          typesDone)
        
-       ,("Annotate integer literal types", annotateIntLiteralTypes, [Prop.noInt] ++ namesDone, [Prop.intLiteralsInBounds])
-       ,("Annotate list literal and range types", annotateListLiteralTypes,
-         namesDone ++ [Prop.noInt, Prop.intLiteralsInBounds], [Prop.listsGivenType])         
+--       ,("Annotate integer literal types", annotateIntLiteralTypes, [Prop.noInt] ++ namesDone, [Prop.intLiteralsInBounds])
+--       ,("Annotate list literal and range types", annotateListLiteralTypes,
+--         namesDone ++ [Prop.noInt, Prop.intLiteralsInBounds], [Prop.listsGivenType])         
        
        ,("Record inferred name types in dictionary", recordInfNameTypes,
          namesDone ++ [Prop.intLiteralsInBounds, Prop.listsGivenType], [Prop.inferredTypesRecorded])
        
        ,("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 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 parameters in process calls", matchParamPass, typesDone, [Prop.processTypesChecked,

frontends/RainTypes.hs

@@ -88,7 +88,9 @@ markUnify x y
 performTypeUnification :: Data t => t -> PassM t
 performTypeUnification x
        -- First, we markup all the types in the tree:
-  = do x' <- markConditionalTypes x --TODO markup everything else
+  = do x' <- markConditionalTypes
+             <.< markAssignmentTypes
+             $ x --TODO markup everything else
        -- Then, we do the unification:
        prs <- get >>* csUnifyPairs
        res <- liftIO $ mapM (uncurry unifyType) prs
@@ -364,22 +366,17 @@ checkExpressionTypes = applyDepthM checkExpression
     haveOrder t = (isIntegerType t) || (t == A.Time)
 
 -- | Checks the types in assignments
-checkAssignmentTypes :: Data t => t -> PassM t
-checkAssignmentTypes = applyDepthM checkAssignment
+markAssignmentTypes :: Data t => t -> PassM t
+markAssignmentTypes = checkDepthM checkAssignment
   where
-    checkAssignment :: A.Process -> PassM A.Process
-    checkAssignment ass@(A.Assign m [v] (A.ExpressionList m' [e]))
-      = do trhs <- astTypeOf e
-           tlhs <- astTypeOf v
-           am <- abbrevModeOfVariable v
+    checkAssignment :: Check A.Process
+    checkAssignment (A.Assign m [v] (A.ExpressionList _ [e]))
+      = do am <- abbrevModeOfVariable v
            when (am == A.ValAbbrev) $
              diePC m $ formatCode "Cannot assign to a constant variable: %" v
-           if (tlhs == trhs)
-             then return ass
-             else do rhs' <- coerceType " in assignment" tlhs trhs e
-                     return $ A.Assign m [v] (A.ExpressionList m' [rhs'])
+           markUnify v e
     checkAssignment (A.Assign m _ _) = dieInternal (Just m,"Rain checker found occam-style assignment")
-    checkAssignment st = return st
+    checkAssignment st = return ()
 
 -- | Checks the types in if and while conditionals
 markConditionalTypes :: Data t => t -> PassM t

frontends/RainTypesTest.hs

@@ -235,13 +235,13 @@ checkExpressionTest = TestList
   ,passAssignSame 3006 "x8" $ int A.Int8 0
   ,passAssignSame 3007 "b" EHTrue
 
-  ,passAssign 3100 "x" (Cast A.Int64 $ Var "xu8") (Var "xu8")
+--  ,passAssign 3100 "x" (Cast A.Int64 $ Var "xu8") (Var "xu8")
   ,failAssign 3101 "xu8" (Var "x")
   ,failAssign 3102 "x" (Var "b")
   ,failAssign 3103 "b" (Var "x")
   ,failAssign 3104 "x8" (Var "xu8")
   ,failAssign 3105 "xu8" (Var "x8")
-  ,passAssign 3106 "x" (Cast A.Int64 $ int A.Int8 0) (int A.Int8 0)
+--  ,passAssign 3106 "x" (Cast A.Int64 $ int A.Int8 0) (int A.Int8 0)
 
   -- Assignment with constants:
   ,failAssign 3200 "X" (Var "x")
@@ -338,19 +338,19 @@ checkExpressionTest = TestList
   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])
-    (checkAssignmentTypes $ src')
+    (performTypeUnification $ src')
     state refeed
     where
       src' = A.Assign m [variable lhs] $ A.ExpressionList m [buildExpr src]
     
       refeed :: A.Process -> Assertion
-      refeed changed = if (src' /= changed) then testPass ("checkExpressionTest refeed " ++ show n) (mkPattern changed) (checkAssignmentTypes changed) state else return ()
+      refeed changed = if (src' /= changed) then testPass ("checkExpressionTest refeed " ++ show n) (mkPattern changed) (performTypeUnification changed) state else return ()
   
   passAssignSame :: Int -> String -> ExprHelper -> Test
   passAssignSame n s e = passAssign n s e e
   
   failAssign :: Int -> String -> ExprHelper -> Test
-  failAssign n lhs src = TestCase $ testPassShouldFail ("checkExpressionTest " ++ show n) (checkAssignmentTypes $ A.Assign m [variable lhs] $ A.ExpressionList m [buildExpr src]) state
+  failAssign n lhs src = TestCase $ testPassShouldFail ("checkExpressionTest " ++ show n) (performTypeUnification $ A.Assign m [variable lhs] $ A.ExpressionList m [buildExpr src]) state
   
   passWhileIfSame :: Int -> ExprHelper -> Test
   passWhileIfSame n e = passWhileIf n e e