+-- No warnings for unaligned arithmetic with the node register,
+-- which is used to extract fields from tagged constructor closures.
+notNodeReg (CmmReg reg) | reg == nodeReg = False
+notNodeReg _ = True
+
+lintCmmStmt :: BlockSet -> CmmStmt -> CmmLint ()
+lintCmmStmt labels = lint
+ where lint (CmmNop) = return ()
+ lint (CmmComment {}) = return ()
+ lint stmt@(CmmAssign reg expr) = do
+ erep <- lintCmmExpr expr
+ if (erep == cmmRegRep reg)
+ then return ()
+ else cmmLintAssignErr stmt
+ 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 == wordRep)
+ then return ()
+ else cmmLintErr (text "switch scrutinee is not a word: " <> ppr e)
+ 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 ()