X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcodeGen%2FCgMonad.lhs;h=1e9a5ba97bd0cac90a0b357a54dc2a3ff518a78c;hp=6a26e668f1941f395c378c4e51c4498d7a289953;hb=0d4d93a38a2aff950bcd12ebb46a2582d68f5de4;hpb=cd437edc8792e5dbcfaa6a6b9948364e9d9d08f3 diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs index 6a26e66..1e9a5ba 100644 --- a/compiler/codeGen/CgMonad.lhs +++ b/compiler/codeGen/CgMonad.lhs @@ -8,13 +8,6 @@ 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 @@ -69,7 +62,7 @@ module CgMonad ( import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds ) import DynFlags -import PackageConfig +import BlockId import Cmm import CmmUtils import CLabel @@ -165,6 +158,7 @@ data EndOfBlockInfo -- by a case alternative. Sequel +initEobInfo :: EndOfBlockInfo initEobInfo = EndOfBlockInfo 0 OnStack \end{code} @@ -252,12 +246,14 @@ flattenCgStmts id stmts = where (fork_block, fork_blocks) = flatten (fromOL stmts) where (block,blocks) = flatten ss +isJump :: CmmStmt -> Bool isJump (CmmJump _ _) = True isJump (CmmBranch _) = True isJump (CmmSwitch _ _) = True isJump (CmmReturn _) = True isJump _ = False +isOrdinaryStmt :: CgStmt -> Bool isOrdinaryStmt (CgStmt _) = True isOrdinaryStmt _ = False \end{code} @@ -398,7 +394,7 @@ initC dflags mod (FCode code) } returnFC :: a -> FCode a -returnFC val = FCode (\info_down state -> (val, state)) +returnFC val = FCode (\_ state -> (val, state)) \end{code} \begin{code} @@ -458,10 +454,10 @@ fixC fcode = FCode ( \begin{code} getState :: FCode CgState -getState = FCode $ \info_down state -> (state,state) +getState = FCode $ \_ state -> (state,state) setState :: CgState -> FCode () -setState state = FCode $ \info_down _ -> ((),state) +setState state = FCode $ \_ _ -> ((),state) getStkUsage :: FCode StackUsage getStkUsage = do @@ -703,7 +699,7 @@ nopC = return () whenC :: Bool -> Code -> Code whenC True code = code -whenC False code = nopC +whenC False _ = nopC stmtC :: CmmStmt -> Code stmtC stmt = emitCgStmt (CgStmt stmt) @@ -745,7 +741,7 @@ emitData sect lits where data_block = CmmData sect lits -emitProc :: CmmInfo -> CLabel -> CmmFormalsWithoutKinds -> [CmmBasicBlock] -> Code +emitProc :: CmmInfo -> CLabel -> CmmFormals -> [CmmBasicBlock] -> Code emitProc info lbl args blocks = do { let proc_block = CmmProc info lbl args (ListGraph blocks) ; state <- getState @@ -766,7 +762,8 @@ getCmm code = do { state1 <- getState ; ((), state2) <- withState code (state1 { cgs_tops = nilOL }) ; setState $ state2 { cgs_tops = cgs_tops state1 } - ; return (Cmm (fromOL (cgs_tops state2))) } + ; return (Cmm (fromOL (cgs_tops state2))) + } -- ---------------------------------------------------------------------------- -- CgStmts