X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgMonad.lhs;h=6a26e668f1941f395c378c4e51c4498d7a289953;hb=235edf36cc202bb21c00d0e5e05ebf076fb0542e;hp=f0b180ddc50e0b339ba1884173eb127e5bb3164d;hpb=7fc749a43b4b6b85d234fa95d4928648259584f4;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs index f0b180d..6a26e66 100644 --- a/compiler/codeGen/CgMonad.lhs +++ b/compiler/codeGen/CgMonad.lhs @@ -80,9 +80,9 @@ import Id import VarEnv import OrdList import Unique -import Util +import Util() import UniqSupply -import FastString +import FastString() import Outputable import Control.Monad @@ -241,6 +241,7 @@ flattenCgStmts id stmts = where (block,blocks) = flatten stmts (CgFork fork_id stmts : ss) -> flatten (CgFork fork_id stmts : CgStmt stmt : ss) + (CgStmt {} : _) -> panic "CgStmt not seen as ordinary" flatten (s:ss) = case s of @@ -711,7 +712,8 @@ labelC :: BlockId -> Code labelC id = emitCgStmt (CgLabel id) newLabelC :: FCode BlockId -newLabelC = do { id <- newUnique; return (BlockId id) } +newLabelC = do { u <- newUnique + ; return $ BlockId u } checkedAbsC :: CmmStmt -> Code -- Emit code, eliminating no-ops @@ -743,9 +745,9 @@ emitData sect lits where data_block = CmmData sect lits -emitProc :: CmmInfo -> CLabel -> CmmFormals -> [CmmBasicBlock] -> Code +emitProc :: CmmInfo -> CLabel -> CmmFormalsWithoutKinds -> [CmmBasicBlock] -> Code emitProc info lbl args blocks - = do { let proc_block = CmmProc info lbl args blocks + = do { let proc_block = CmmProc info lbl args (ListGraph blocks) ; state <- getState ; setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block } } @@ -758,6 +760,8 @@ emitSimpleProc lbl code getCmm :: Code -> FCode Cmm -- Get all the CmmTops (there should be no stmts) +-- Return a single Cmm which may be split from other Cmms by +-- object splitting (at a later stage) getCmm code = do { state1 <- getState ; ((), state2) <- withState code (state1 { cgs_tops = nilOL })