X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgMonad.lhs;h=4f95c9b36a8a8e1d189d6b2b80aa6f42eb242e43;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=d9d0801a03fe7bef0df2c718cb826f656d0e7bda;hpb=ef5b4b146aa172d8ac10f39b5eb3d7a0f948d8f1;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/CgMonad.lhs b/ghc/compiler/codeGen/CgMonad.lhs index d9d0801..4f95c9b 100644 --- a/ghc/compiler/codeGen/CgMonad.lhs +++ b/ghc/compiler/codeGen/CgMonad.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgMonad.lhs,v 1.42 2004/11/26 16:20:10 simonmar Exp $ +% $Id: CgMonad.lhs,v 1.45 2005/06/21 10:44:41 simonmar Exp $ % \section[CgMonad]{The code generation monad} @@ -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, + getState, setState, getInfoDown, getDynFlags, getHomeModules, -- more localised access to monad state getStkUsage, setStkUsage, @@ -61,7 +61,8 @@ module CgMonad ( import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds ) -import CmdLineOpts ( DynFlags ) +import DynFlags ( DynFlags ) +import Packages ( HomeModules ) import Cmm import CmmUtils ( CmmStmts, isNopStmt ) import CLabel @@ -96,6 +97,7 @@ along. 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 @@ -103,9 +105,10 @@ data CgInfoDownwards -- information only passed *downwards* by the monad 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", @@ -280,7 +283,7 @@ data StackUsage hwSp :: VirtualSpOffset } -- Highest value ever taken by virtSp --- INVARAINT: The environment contains no Stable references to +-- INVARIANT: The environment contains no Stable references to -- stack slots below (lower offset) frameSp -- It can contain volatile references to this area though. @@ -375,11 +378,11 @@ instance Monad FCode where 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 } @@ -507,6 +510,9 @@ getInfoDown = FCode $ \info_down state -> (info_down,state) 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