%
+% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgMonad.lhs,v 1.45 2005/06/21 10:44:41 simonmar Exp $
-%
\section[CgMonad]{The code generation monad}
See the beginning of the top-level @CodeGen@ module, to see how this
getHpUsage, setHpUsage,
heapHWM,
- moduleName,
+ getModuleName,
Sequel(..), -- ToDo: unabstract?
-- ideally we wouldn't export these, but some other modules access internal state
- getState, setState, getInfoDown, getDynFlags, getHomeModules,
+ getState, setState, getInfoDown, getDynFlags, getThisPackage,
-- more localised access to monad state
getStkUsage, setStkUsage,
import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds )
-import DynFlags ( DynFlags )
-import Packages ( HomeModules )
+import DynFlags
+import PackageConfig
import Cmm
-import CmmUtils ( CmmStmts, isNopStmt )
+import CmmUtils
import CLabel
-import SMRep ( WordOff )
-import Module ( Module )
-import Id ( Id )
+import SMRep
+import Module
+import Id
import VarEnv
import OrdList
-import Unique ( Unique )
-import Util ( mapAccumL )
-import UniqSupply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply, uniqFromSupply )
+import Unique
+import Util
+import UniqSupply
import FastString
import Outputable
-import Control.Monad ( liftM )
+import Control.Monad
infixr 9 `thenC` -- Right-associative!
infixr 9 `thenFC`
data CgInfoDownwards -- information only passed *downwards* by the monad
= MkCgInfoDown {
cgd_dflags :: DynFlags,
- cgd_hmods :: HomeModules, -- Packages we depend on
cgd_mod :: Module, -- Module being compiled
cgd_statics :: CgBindings, -- [Id -> info] : static environment
cgd_srt :: CLabel, -- label of the current SRT
cgd_eob :: EndOfBlockInfo -- Info for stuff to do at end of basic block:
}
-initCgInfoDown :: DynFlags -> HomeModules -> Module -> CgInfoDownwards
-initCgInfoDown dflags hmods mod
+initCgInfoDown :: DynFlags -> Module -> CgInfoDownwards
+initCgInfoDown dflags mod
= MkCgInfoDown { cgd_dflags = dflags,
- cgd_hmods = hmods,
cgd_mod = mod,
cgd_statics = emptyVarEnv,
cgd_srt = error "initC: srt",
-- case this might be the label of a return vector
SemiTaggingStuff
Id -- The case binder, only used to see if it's dead
- Bool -- True <=> polymorphic, push a SEQ frame too
type SemiTaggingStuff
= Maybe -- Maybe[1] we don't have any semi-tagging stuff...
isJump (CmmJump _ _) = True
isJump (CmmBranch _) = True
+isJump (CmmSwitch _ _) = True
isJump _ = False
isOrdinaryStmt (CgStmt _) = True
The Abstract~C is not in the environment so as to improve strictness.
\begin{code}
-initC :: DynFlags -> HomeModules -> Module -> FCode a -> IO a
+initC :: DynFlags -> Module -> FCode a -> IO a
-initC dflags hmods mod (FCode code)
+initC dflags mod (FCode code)
= do { uniqs <- mkSplitUniqSupply 'c'
- ; case code (initCgInfoDown dflags hmods mod) (initCgState uniqs) of
+ ; case code (initCgInfoDown dflags mod) (initCgState uniqs) of
(res, _) -> return res
}
getDynFlags :: FCode DynFlags
getDynFlags = liftM cgd_dflags getInfoDown
-getHomeModules :: FCode HomeModules
-getHomeModules = liftM cgd_hmods getInfoDown
+getThisPackage :: FCode PackageId
+getThisPackage = liftM thisPackage getDynFlags
withInfoDown :: FCode a -> CgInfoDownwards -> FCode a
withInfoDown (FCode fcode) info_down = FCode $ \_ state -> fcode info_down state
where
data_block = CmmData sect lits
-emitProc :: [CmmLit] -> CLabel -> [LocalReg] -> [CmmBasicBlock] -> Code
+emitProc :: [CmmLit] -> CLabel -> CmmFormals -> [CmmBasicBlock] -> Code
emitProc lits lbl args blocks
= do { let proc_block = CmmProc (map CmmStaticLit lits) lbl args blocks
; state <- getState
-- ----------------------------------------------------------------------------
-- Get the current module name
-moduleName :: FCode Module
-moduleName = do { info <- getInfoDown; return (cgd_mod info) }
+getModuleName :: FCode Module
+getModuleName = do { info <- getInfoDown; return (cgd_mod info) }
-- ----------------------------------------------------------------------------
-- Get/set the end-of-block info