%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgMonad.lhs,v 1.43 2004/12/08 14:32:31 simonpj Exp $
+% $Id: CgMonad.lhs,v 1.45 2005/06/21 10:44:41 simonmar Exp $
%
\section[CgMonad]{The code generation monad}
Sequel(..), -- ToDo: unabstract?
-- ideally we wouldn't export these, but some other modules access internal state
- getState, setState, getInfoDown, getDynFlags,
+ getState, setState, getInfoDown, getDynFlags, getHomeModules,
-- more localised access to monad state
getStkUsage, setStkUsage,
import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds )
-import CmdLineOpts ( DynFlags )
+import DynFlags ( DynFlags )
+import Packages ( HomeModules )
import Cmm
import CmmUtils ( CmmStmts, isNopStmt )
import CLabel
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 -> Module -> CgInfoDownwards
-initCgInfoDown dflags mod
+initCgInfoDown :: DynFlags -> HomeModules -> Module -> CgInfoDownwards
+initCgInfoDown dflags hmods mod
= MkCgInfoDown { cgd_dflags = dflags,
+ cgd_hmods = hmods,
cgd_mod = mod,
cgd_statics = emptyVarEnv,
cgd_srt = error "initC: srt",
The Abstract~C is not in the environment so as to improve strictness.
\begin{code}
-initC :: DynFlags -> Module -> FCode a -> IO a
+initC :: DynFlags -> HomeModules -> Module -> FCode a -> IO a
-initC dflags mod (FCode code)
+initC dflags hmods mod (FCode code)
= do { uniqs <- mkSplitUniqSupply 'c'
- ; case code (initCgInfoDown dflags mod) (initCgState uniqs) of
+ ; case code (initCgInfoDown dflags hmods mod) (initCgState uniqs) of
(res, _) -> return res
}
getDynFlags :: FCode DynFlags
getDynFlags = liftM cgd_dflags getInfoDown
+getHomeModules :: FCode HomeModules
+getHomeModules = liftM cgd_hmods getInfoDown
+
withInfoDown :: FCode a -> CgInfoDownwards -> FCode a
withInfoDown (FCode fcode) info_down = FCode $ \_ state -> fcode info_down state