X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmLint.hs;h=f36df5970e2eec55a151340c710be03e5210e831;hb=526c3af1dc98987b6949f4df73c0debccf9875bd;hp=e376e56d474a992de7400324f007b50a5c89e759;hpb=d76b6a05ab36066e8aeb67d58e25992d1ef83a8a;p=ghc-hetmet.git diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs index e376e56..f36df59 100644 --- a/compiler/cmm/CmmLint.hs +++ b/compiler/cmm/CmmLint.hs @@ -17,8 +17,6 @@ module CmmLint ( cmmLint, cmmLintTop ) where -#include "HsVersions.h" - import Cmm import CLabel import MachOp @@ -27,6 +25,7 @@ import Outputable import PprCmm import Unique import Constants +import FastString import Control.Monad @@ -42,7 +41,7 @@ cmmLintTop top = runCmmLint $ lintCmmTop top runCmmLint :: CmmLint a -> Maybe SDoc runCmmLint l = case unCL l of - Left err -> Just (ptext SLIT("Cmm lint error:") $$ nest 2 err) + Left err -> Just (ptext (sLit "Cmm lint error:") $$ nest 2 err) Right _ -> Nothing lintCmmTop :: (GenCmmTop h i (ListGraph CmmStmt)) -> CmmLint () @@ -137,7 +136,7 @@ lintCmmStmt labels = lint lintCmmExpr r return () lint (CmmCall target _res args _ _) = - lintTarget target >> mapM_ (lintCmmExpr . hintlessCmm) args + lintTarget target >> mapM_ (lintCmmExpr . kindlessCmm) args lint (CmmCondBranch e id) = checkTarget id >> lintCmmExpr e >> checkCond e lint (CmmSwitch e branches) = do mapM_ checkTarget $ catMaybes branches @@ -145,8 +144,8 @@ lintCmmStmt labels = lint 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 (CmmJump e args) = lintCmmExpr e >> mapM_ (lintCmmExpr . kindlessCmm) args + lint (CmmReturn ress) = mapM_ (lintCmmExpr . kindlessCmm) ress lint (CmmBranch id) = checkTarget id checkTarget id = if elemBlockSet id labels then return () else cmmLintErr (text "Branch to nonexistent id" <+> ppr id)