-lintCmmStmt :: CmmStmt -> CmmLint ()
-lintCmmStmt stmt@(CmmAssign reg expr) = do
- erep <- lintCmmExpr expr
- if (erep == cmmRegRep reg)
- then return ()
- else cmmLintAssignErr stmt
-lintCmmStmt (CmmStore l r) = do
- lintCmmExpr l
- lintCmmExpr r
- return ()
-lintCmmStmt (CmmCall _target _res args _ _) = mapM_ (lintCmmExpr.fst) args
-lintCmmStmt (CmmCondBranch e _id) = lintCmmExpr e >> checkCond e >> return ()
-lintCmmStmt (CmmSwitch e _branches) = do
- erep <- lintCmmExpr e
- if (erep == wordRep)
- then return ()
- else cmmLintErr (text "switch scrutinee is not a word: " <> ppr e)
-lintCmmStmt (CmmJump e _args) = lintCmmExpr e >> return ()
-lintCmmStmt _other = return ()
-
+lintCmmStmt :: BlockSet -> CmmStmt -> CmmLint ()
+lintCmmStmt labels = lint
+ where lint (CmmNop) = return ()
+ lint (CmmComment {}) = return ()
+ lint stmt@(CmmAssign reg expr) = do
+ erep <- lintCmmExpr expr
+ let reg_ty = cmmRegType reg
+ if (erep `cmmEqType_ignoring_ptrhood` reg_ty)
+ then return ()
+ else cmmLintAssignErr stmt erep reg_ty
+ lint (CmmStore l r) = do
+ _ <- lintCmmExpr l
+ _ <- lintCmmExpr r
+ return ()
+ lint (CmmCall target _res args _ _) =
+ lintTarget target >> mapM_ (lintCmmExpr . hintlessCmm) args
+ lint (CmmCondBranch e id) = checkTarget id >> lintCmmExpr e >> checkCond e
+ lint (CmmSwitch e branches) = do
+ mapM_ checkTarget $ catMaybes branches
+ erep <- lintCmmExpr e
+ if (erep `cmmEqType_ignoring_ptrhood` bWord)
+ then return ()
+ else cmmLintErr (text "switch scrutinee is not a word: " <> ppr e <>
+ text " :: " <> ppr erep)
+ lint (CmmJump e args) = lintCmmExpr e >> mapM_ (lintCmmExpr . hintlessCmm) args
+ lint (CmmReturn ress) = mapM_ (lintCmmExpr . hintlessCmm) ress
+ lint (CmmBranch id) = checkTarget id
+ checkTarget id = if elemBlockSet id labels then return ()
+ else cmmLintErr (text "Branch to nonexistent id" <+> ppr id)
+
+lintTarget :: CmmCallTarget -> CmmLint ()
+lintTarget (CmmCallee e _) = lintCmmExpr e >> return ()
+lintTarget (CmmPrim {}) = return ()
+
+
+checkCond :: CmmExpr -> CmmLint ()