diff options
Diffstat (limited to 'compiler/codeGen')
-rw-r--r-- | compiler/codeGen/CgCon.lhs | 2 | ||||
-rw-r--r-- | compiler/codeGen/CgHeapery.lhs | 2 | ||||
-rw-r--r-- | compiler/codeGen/CgLetNoEscape.lhs | 2 | ||||
-rw-r--r-- | compiler/codeGen/CgMonad.lhs | 5 | ||||
-rw-r--r-- | compiler/codeGen/CgStackery.lhs | 12 | ||||
-rw-r--r-- | compiler/codeGen/StgCmm.hs | 4 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmExpr.hs | 4 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmMonad.hs | 4 |
8 files changed, 19 insertions, 16 deletions
diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs index 0fb90b0d77..532965c084 100644 --- a/compiler/codeGen/CgCon.lhs +++ b/compiler/codeGen/CgCon.lhs @@ -439,7 +439,7 @@ cgDataCon data_con = do { code_blks <- getCgStmts the_code ; emitClosureCodeAndInfoTable cl_info [] code_blks } where - the_code = do { ticky_code + the_code = do { _ <- ticky_code ; ldvEnter (CmmReg nodeReg) ; body_code } diff --git a/compiler/codeGen/CgHeapery.lhs b/compiler/codeGen/CgHeapery.lhs index df3720cd2d..42d26662b9 100644 --- a/compiler/codeGen/CgHeapery.lhs +++ b/compiler/codeGen/CgHeapery.lhs @@ -78,7 +78,7 @@ initHeapUsage :: (VirtualHpOffset -> Code) -> Code initHeapUsage fcode = do { orig_hp_usage <- getHpUsage ; setHpUsage initHpUsage - ; fixC (\heap_usage2 -> do + ; fixC_(\heap_usage2 -> do { fcode (heapHWM heap_usage2) ; getHpUsage }) ; setHpUsage orig_hp_usage } diff --git a/compiler/codeGen/CgLetNoEscape.lhs b/compiler/codeGen/CgLetNoEscape.lhs index f501be5941..14f5fb8269 100644 --- a/compiler/codeGen/CgLetNoEscape.lhs +++ b/compiler/codeGen/CgLetNoEscape.lhs @@ -168,7 +168,7 @@ cgLetNoEscapeClosure -- Ignore the label that comes back from -- mkRetDirectTarget. It must be conjured up elswhere - ; emitReturnTarget (idName bndr) abs_c + ; _ <- emitReturnTarget (idName bndr) abs_c ; return () }) ; returnFC (bndr, letNoEscapeIdInfo bndr vSp lf_info) } diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs index 1e9a5ba97b..af6b1ed311 100644 --- a/compiler/codeGen/CgMonad.lhs +++ b/compiler/codeGen/CgMonad.lhs @@ -13,7 +13,7 @@ module CgMonad ( FCode, -- type initC, thenC, thenFC, listCs, listFCs, mapCs, mapFCs, - returnFC, fixC, checkedAbsC, + returnFC, fixC, fixC_, checkedAbsC, stmtC, stmtsC, labelC, emitStmts, nopC, whenC, newLabelC, newUnique, newUniqSupply, @@ -443,6 +443,9 @@ fixC fcode = FCode ( in result ) + +fixC_ :: (a -> FCode a) -> FCode () +fixC_ fcode = fixC fcode >> return () \end{code} %************************************************************************ diff --git a/compiler/codeGen/CgStackery.lhs b/compiler/codeGen/CgStackery.lhs index bcb59ce032..6683de4c8b 100644 --- a/compiler/codeGen/CgStackery.lhs +++ b/compiler/codeGen/CgStackery.lhs @@ -198,25 +198,23 @@ allocPrimStack rep Allocate a chunk ON TOP OF the stack. \begin{code} -allocStackTop :: WordOff -> FCode VirtualSpOffset +allocStackTop :: WordOff -> FCode () allocStackTop size = do { stk_usg <- getStkUsage ; let push_virt_sp = virtSp stk_usg + size ; setStkUsage (stk_usg { virtSp = push_virt_sp, - hwSp = hwSp stk_usg `max` push_virt_sp }) - ; return push_virt_sp } + hwSp = hwSp stk_usg `max` push_virt_sp }) } \end{code} Pop some words from the current top of stack. This is used for de-allocating the return address in a case alternative. \begin{code} -deAllocStackTop :: WordOff -> FCode VirtualSpOffset +deAllocStackTop :: WordOff -> FCode () deAllocStackTop size = do { stk_usg <- getStkUsage ; let pop_virt_sp = virtSp stk_usg - size - ; setStkUsage (stk_usg { virtSp = pop_virt_sp }) - ; return pop_virt_sp } + ; setStkUsage (stk_usg { virtSp = pop_virt_sp }) } \end{code} \begin{code} @@ -231,7 +229,7 @@ A knot-tying beast. \begin{code} getFinalStackHW :: (VirtualSpOffset -> Code) -> Code getFinalStackHW fcode - = do { fixC (\hw_sp -> do + = do { fixC_ (\hw_sp -> do { fcode hw_sp ; stk_usg <- getStkUsage ; return (hwSp stk_usg) }) diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs index ae4fa1b623..ee1983c34b 100644 --- a/compiler/codeGen/StgCmm.hs +++ b/compiler/codeGen/StgCmm.hs @@ -113,7 +113,7 @@ cgTopBinding dflags (StgRec pairs, _srts) = do { let (bndrs, rhss) = unzip pairs ; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs ; let pairs' = zip bndrs' rhss - ; fixC (\ new_binds -> do + ; fixC_(\ new_binds -> do { addBindsC new_binds ; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' }) ; return () } @@ -334,7 +334,7 @@ cgDataCon data_con mk_code ticky_code = -- NB: We don't set CC when entering data (WDP 94/06) - do { ticky_code + do { _ <- ticky_code ; ldvEnter (CmmReg nodeReg) ; tickyReturnOldCon (length arg_things) ; emitReturn [cmmOffsetB (CmmReg nodeReg) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 96b9e316c4..2a0716ed24 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -296,7 +296,7 @@ cgCase scrut bndr srt alt_type alts ; restoreCurrentCostCentre mb_cc -- JD: We need Note: [Better Alt Heap Checks] - ; bindArgsToRegs ret_bndrs + ; _ <- bindArgsToRegs ret_bndrs ; cgAlts gc_plan (NonVoid bndr) alt_type alts } ----------------- @@ -408,7 +408,7 @@ cgAltRhss gc_plan bndr alts cg_alt (con, bndrs, _uses, rhs) = getCodeR $ maybeAltHeapCheck gc_plan $ - do { bindConArgs con base_reg bndrs + do { _ <- bindConArgs con base_reg bndrs ; cgExpr rhs ; return con } diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs index 550c42de60..dbcb540751 100644 --- a/compiler/codeGen/StgCmmMonad.hs +++ b/compiler/codeGen/StgCmmMonad.hs @@ -10,7 +10,7 @@ module StgCmmMonad ( FCode, -- type initC, thenC, thenFC, listCs, listFCs, mapCs, mapFCs, - returnFC, fixC, nopC, whenC, + returnFC, fixC, fixC_, nopC, whenC, newUnique, newUniqSupply, emit, emitData, emitProc, emitProcWithConvention, emitSimpleProc, @@ -149,6 +149,8 @@ fixC fcode = FCode ( result ) +fixC_ :: (a -> FCode a) -> FCode () +fixC_ fcode = fixC fcode >> return () -------------------------------------------------------- -- The code generator environment |