X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcodeGen%2FCgMonad.lhs;h=8a3b664fc1aa35bcc2980d9d5bb7244ec0a42eaf;hp=1e9a5ba97bd0cac90a0b357a54dc2a3ff518a78c;hb=18691d440f90a3dff4ef538091c886af505e5cf5;hpb=586b595161aaef8710a3fbbebe90f0c14cd9cd77 diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs index 1e9a5ba..8a3b664 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, @@ -47,7 +47,7 @@ module CgMonad ( Sequel(..), -- ToDo: unabstract? -- ideally we wouldn't export these, but some other modules access internal state - getState, setState, getInfoDown, getDynFlags, getThisPackage, + getState, setState, getInfoDown, getDynFlags, getThisPackage, -- more localised access to monad state getStkUsage, setStkUsage, @@ -63,8 +63,8 @@ import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds ) import DynFlags import BlockId -import Cmm -import CmmUtils +import OldCmm +import OldCmmUtils import CLabel import StgSyn (SRT) import SMRep @@ -73,9 +73,7 @@ import Id import VarEnv import OrdList import Unique -import Util() import UniqSupply -import FastString() import Outputable import Control.Monad @@ -169,7 +167,6 @@ block. \begin{code} data Sequel = OnStack -- Continuation is on the stack - | UpdateCode -- Continuation is update | CaseAlts CLabel -- Jump to this; if the continuation is for a vectored @@ -443,6 +440,9 @@ fixC fcode = FCode ( in result ) + +fixC_ :: (a -> FCode a) -> FCode () +fixC_ fcode = fixC fcode >> return () \end{code} %************************************************************************ @@ -709,7 +709,7 @@ labelC id = emitCgStmt (CgLabel id) newLabelC :: FCode BlockId newLabelC = do { u <- newUnique - ; return $ BlockId u } + ; return $ mkBlockId u } checkedAbsC :: CmmStmt -> Code -- Emit code, eliminating no-ops @@ -742,10 +742,11 @@ emitData sect lits data_block = CmmData sect lits emitProc :: CmmInfo -> CLabel -> CmmFormals -> [CmmBasicBlock] -> Code -emitProc info lbl args blocks - = do { let proc_block = CmmProc info lbl args (ListGraph blocks) +emitProc info lbl [] blocks + = do { let proc_block = CmmProc info lbl (ListGraph blocks) ; state <- getState ; setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block } } +emitProc _ _ (_:_) _ = panic "emitProc called with nonempty args" emitSimpleProc :: CLabel -> Code -> Code -- Emit a procedure whose body is the specified code; no info table