X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgMonad.lhs;h=51c07b213d3174409f7f827d2461c11f3a00c6b4;hb=67bfcb05c487f180f33c62651b28f4136f2b3910;hp=b96db8022eda052492fc12d9da2e2753920fe438;hpb=5f00461a637a25a6facecda2d9b0a2c0a44e9008;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs index b96db80..51c07b2 100644 --- a/compiler/codeGen/CgMonad.lhs +++ b/compiler/codeGen/CgMonad.lhs @@ -8,6 +8,13 @@ See the beginning of the top-level @CodeGen@ module, to see how this monadic stuff fits into the Big Picture. \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module CgMonad ( Code, -- type FCode, -- type @@ -63,6 +70,7 @@ import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds ) import DynFlags import PackageConfig +import BlockId import Cmm import CmmUtils import CLabel @@ -73,9 +81,9 @@ import Id import VarEnv import OrdList import Unique -import Util +import Util() import UniqSupply -import FastString +import FastString() import Outputable import Control.Monad @@ -234,6 +242,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 @@ -704,7 +713,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 @@ -736,9 +746,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 } } @@ -751,6 +761,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 })