X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmLint.hs;h=130dba05f9cec5299afab5eb3326fb43c13cf617;hb=d31dfb32ea936c22628b508c28a36c12e631430a;hp=875876fbdd03dbd2eedea61e5d7bc78e0f5e93ea;hpb=4f6f4a294f00d559b4f024255d11eb1da9bfe036;p=ghc-hetmet.git diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs index 875876f..130dba0 100644 --- a/compiler/cmm/CmmLint.hs +++ b/compiler/cmm/CmmLint.hs @@ -25,10 +25,10 @@ import Control.Monad -- ----------------------------------------------------------------------------- -- Exported entry points: -cmmLint :: Cmm -> Maybe SDoc +cmmLint :: GenCmm d h CmmStmt -> Maybe SDoc cmmLint (Cmm tops) = runCmmLint $ mapM_ lintCmmTop tops -cmmLintTop :: CmmTop -> Maybe SDoc +cmmLintTop :: GenCmmTop d h CmmStmt -> Maybe SDoc cmmLintTop top = runCmmLint $ lintCmmTop top runCmmLint :: CmmLint a -> Maybe SDoc @@ -37,7 +37,7 @@ runCmmLint l = Left err -> Just (ptext SLIT("Cmm lint error:") $$ nest 2 err) Right _ -> Nothing -lintCmmTop (CmmProc _info lbl _args blocks) +lintCmmTop (CmmProc _ lbl _ blocks) = addLintInfo (text "in proc " <> pprCLabel lbl) $ mapM_ lintCmmBlock blocks lintCmmTop _other @@ -117,7 +117,7 @@ lintCmmStmt (CmmStore l r) = do lintCmmExpr l lintCmmExpr r return () -lintCmmStmt (CmmCall _target _res args _vols) = mapM_ (lintCmmExpr.fst) args +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