X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgMonad.lhs;h=4f95c9b36a8a8e1d189d6b2b80aa6f42eb242e43;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=003be9701cb8c5bdabc44cdda9e25adbd79cde06;hpb=423d477bfecd490de1449c59325c8776f91d7aac;p=ghc-hetmet.git

diff --git a/ghc/compiler/codeGen/CgMonad.lhs b/ghc/compiler/codeGen/CgMonad.lhs
index 003be97..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.40 2004/08/13 13:06:03 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,
+	getState, setState, getInfoDown, getDynFlags, getHomeModules,
 
 	-- more localised access to monad state	
 	getStkUsage, setStkUsage,
@@ -61,6 +61,8 @@ module CgMonad (
 
 import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds )
 
+import DynFlags		( DynFlags )
+import Packages		( HomeModules )
 import Cmm
 import CmmUtils		( CmmStmts, isNopStmt )
 import CLabel
@@ -75,6 +77,8 @@ import UniqSupply	( UniqSupply, mkSplitUniqSupply, splitUniqSupply, uniqFromSupp
 import FastString
 import Outputable
 
+import Control.Monad	( liftM )
+
 infixr 9 `thenC`	-- Right-associative!
 infixr 9 `thenFC`
 \end{code}
@@ -92,6 +96,8 @@ along.
 \begin{code}
 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
@@ -99,9 +105,11 @@ data CgInfoDownwards	-- information only passed *downwards* by the monad
 	cgd_eob     :: EndOfBlockInfo	-- Info for stuff to do at end of basic block:
   }
 
-initCgInfoDown :: Module -> CgInfoDownwards
-initCgInfoDown mod
-  = MkCgInfoDown {	cgd_mod    = 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",
 			cgd_ticky   = mkTopTickyCtrLabel,
@@ -169,8 +177,8 @@ data Sequel
 
 type SemiTaggingStuff
   = Maybe			-- Maybe[1] we don't have any semi-tagging stuff...
-     ([(ConTagZ, CLabel)],	-- Alternatives
-      CLabel)			-- Default (will be a can't happen RTS label if can't happen)
+     ([(ConTagZ, CmmLit)],	-- Alternatives
+      CmmLit)			-- Default (will be a can't happen RTS label if can't happen)
 
 type ConTagZ = Int	-- A *zero-indexed* contructor tag
 
@@ -275,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.
 
@@ -370,11 +378,11 @@ instance Monad FCode where
 The Abstract~C is not in the environment so as to improve strictness.
 
 \begin{code}
-initC :: Module -> FCode a -> IO a
+initC :: DynFlags -> HomeModules -> Module -> FCode a -> IO a
 
-initC mod (FCode code)
+initC dflags hmods mod (FCode code)
   = do	{ uniqs <- mkSplitUniqSupply 'c'
-	; case code (initCgInfoDown mod) (initCgState uniqs) of
+	; case code (initCgInfoDown dflags hmods mod) (initCgState uniqs) of
 	      (res, _) -> return res
 	}
 
@@ -499,6 +507,12 @@ newUnique = do
 getInfoDown :: FCode CgInfoDownwards
 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 
 
@@ -646,7 +660,7 @@ forkEvalHelp :: EndOfBlockInfo  -- For the body
 		       a)		-- Result of the FCode
 	-- A disturbingly complicated function
 forkEvalHelp body_eob_info env_code body_code
-  = do	{ info_down@(MkCgInfoDown cg_info statics srt ticky _) <- getInfoDown
+  = do	{ info_down <- getInfoDown
 	; us   <- newUniqSupply
 	; state <- getState
 	; let { info_down_for_body = info_down {cgd_eob = body_eob_info}