X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fcmm%2FCmmCPS.hs;h=7bfdf8437e054485c7b3f64602f3def17f53ed89;hb=8350c21760d8610b0b2f329095ffb80bb1bc20d9;hp=6a1dc40089aae0363dd6c90365897297a02e06ff;hpb=703ca1542c8e0983cc9d8eebce6e9f3dd3fd71e2;p=ghc-hetmet.git diff --git a/compiler/cmm/CmmCPS.hs b/compiler/cmm/CmmCPS.hs index 6a1dc40..7bfdf84 100644 --- a/compiler/cmm/CmmCPS.hs +++ b/compiler/cmm/CmmCPS.hs @@ -31,7 +31,7 @@ import UniqSupply import UniqSet import Unique -import Monad +import Control.Monad ----------------------------------------------------------------------------- -- |Top level driver for the CPS pass @@ -42,7 +42,7 @@ cmmCPS :: DynFlags -- ^ Dynamic flags: -dcmm-lint -ddump-cps-cmm cmmCPS dflags cmm_with_calls = do { when (dopt Opt_DoCmmLinting dflags) $ do showPass dflags "CmmLint" - case firstJust $ map cmmLint cmm_with_calls of + case firstJusts $ map cmmLint cmm_with_calls of Just err -> do printDump err ghcExit dflags 1 Nothing -> return () @@ -235,6 +235,7 @@ gatherBlocksIntoContinuation live proc_points blocks start = children = (collectNonProcPointTargets proc_points blocks (unitUniqSet start) [start]) `minusUniqSet` (unitUniqSet start) start_block = lookupWithDefaultBEnv blocks unknown_block start children_blocks = map (lookupWithDefaultBEnv blocks unknown_block) (uniqSetToList children) + unknown_block :: a -- Used at more than one type unknown_block = panic "unknown block in gatherBlocksIntoContinuation" body = start_block : children_blocks