diff --git a/frontends/RainPasses.hs b/frontends/RainPasses.hs index ae2a9f0..3514014 100644 --- a/frontends/RainPasses.hs +++ b/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, diff --git a/frontends/RainTypes.hs b/frontends/RainTypes.hs index abbede2..0095b24 100644 --- a/frontends/RainTypes.hs +++ b/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 diff --git a/frontends/RainTypesTest.hs b/frontends/RainTypesTest.hs index 0a22c9b..a4eef32 100644 --- a/frontends/RainTypesTest.hs +++ b/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