[project @ 2005-10-28 11:35:35 by simonmar]

[ghc-hetmet.git] / ghc / compiler / codeGen / CodeGen.lhs

diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
index 1aa4865..e8d83a5 100644 (file)
--- a/ghc/compiler/codeGen/CodeGen.lhs
+++ b/ghc/compiler/codeGen/CodeGen.lhs
@@ -29,7 +29,7 @@ import CgBindery      ( CgIdInfo, addBindC, addBindsC, getCgIdInfo,
                          cgIdInfoId )
 import CgClosure       ( cgTopRhsClosure )
 import CgCon           ( cgTopRhsCon, cgTyCon )
-import CgUtils         ( cmmRegOffW, emitRODataLits, cmmNeWord, emitRtsCall )
+import CgUtils         ( cmmRegOffW, emitRODataLits, cmmNeWord )
 
 import CLabel
 import Cmm
@@ -39,6 +39,7 @@ import MachOp         ( wordRep, MachHint(..) )
 
 import StgSyn
 import PrelNames       ( gHC_PRIM, rOOT_MAIN, mAIN, pREL_TOP_HANDLER )
+import Packages                ( HomeModules )
 import DynFlags                ( DynFlags(..), DynFlag(..), dopt )
 import StaticFlags     ( opt_SccProfilingOn )
 
@@ -59,6 +60,7 @@ import Outputable
 
 \begin{code}
 codeGen :: DynFlags
+       -> HomeModules
        -> Module
        -> [TyCon]
        -> ForeignStubs
@@ -67,21 +69,21 @@ codeGen :: DynFlags
        -> [(StgBinding,[(Id,[Id])])]   -- Bindings to convert, with SRTs
        -> IO [Cmm]             -- Output
 
-codeGen dflags this_mod data_tycons foreign_stubs imported_mods 
+codeGen dflags hmods this_mod data_tycons foreign_stubs imported_mods 
        cost_centre_info stg_binds
   = do 
   { showPass dflags "CodeGen"
   ; let way = buildTag dflags
-        mb_main_mod = mainModIs dflags
+        main_mod = mainModIs dflags
 
 -- Why?
 --   ; mapM_ (\x -> seq x (return ())) data_tycons
 
-  ; code_stuff <- initC dflags this_mod $ do 
-               { cmm_binds  <- mapM (getCmm . cgTopBinding dflags) stg_binds
+  ; code_stuff <- initC dflags hmods this_mod $ do 
+               { cmm_binds  <- mapM (getCmm . cgTopBinding dflags hmods) stg_binds
                ; cmm_tycons <- mapM cgTyCon data_tycons
-               ; cmm_init   <- getCmm (mkModuleInit dflags way cost_centre_info 
-                                            this_mod mb_main_mod
+               ; cmm_init   <- getCmm (mkModuleInit dflags hmods way cost_centre_info 
+                                            this_mod main_mod
                                             foreign_stubs imported_mods)
                ; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init])
                }
@@ -141,14 +143,15 @@ We initialise the module tree by keeping a work-stack,
 \begin{code}
 mkModuleInit 
        :: DynFlags
+       -> HomeModules
        -> String               -- the "way"
        -> CollectedCCs         -- cost centre info
        -> Module
-       -> Maybe String         -- Just m ==> we have flag: -main-is Foo.baz 
+       -> Module               -- name of the Main module
        -> ForeignStubs
        -> [Module]
        -> Code
-mkModuleInit dflags way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mods
+mkModuleInit dflags hmods way cost_centre_info this_mod main_mod foreign_stubs imported_mods
   = do {       
         if opt_SccProfilingOn
             then do { -- Allocate the static boolean that records if this
@@ -181,18 +184,14 @@ mkModuleInit dflags way cost_centre_info this_mod mb_main_mod foreign_stubs impo
                (emitSimpleProc plain_main_init_lbl jump_to_init)
     }
   where
-    plain_init_lbl = mkPlainModuleInitLabel dflags this_mod
-    real_init_lbl  = mkModuleInitLabel dflags this_mod way
-    plain_main_init_lbl = mkPlainModuleInitLabel dflags rOOT_MAIN
+    plain_init_lbl = mkPlainModuleInitLabel hmods this_mod
+    real_init_lbl  = mkModuleInitLabel hmods this_mod way
+    plain_main_init_lbl = mkPlainModuleInitLabel hmods rOOT_MAIN
 
     jump_to_init = stmtC (CmmJump (mkLblExpr real_init_lbl) [])
 
     mod_reg_val = CmmLoad (mkLblExpr moduleRegdLabel) wordRep
 
-    main_mod = case mb_main_mod of
-                       Just mod_name -> mkModule mod_name
-                       Nothing       -> mAIN
-
     -- Main refers to GHC.TopHandler.runIO, so make sure we call the
     -- init function for GHC.TopHandler.
     extra_imported_mods
@@ -205,7 +204,7 @@ mkModuleInit dflags way cost_centre_info this_mod mb_main_mod foreign_stubs impo
 
                -- Now do local stuff
        ; initCostCentres cost_centre_info
-       ; mapCs (registerModuleImport dflags way) 
+       ; mapCs (registerModuleImport hmods way) 
                (imported_mods++extra_imported_mods)
        } 
 
@@ -215,13 +214,13 @@ mkModuleInit dflags way cost_centre_info this_mod mb_main_mod foreign_stubs impo
                       , CmmJump (CmmLoad (cmmRegOffW spReg (-1)) wordRep) [] ]
 
 -----------------------
-registerModuleImport :: DynFlags -> String -> Module -> Code
-registerModuleImport dflags way mod 
+registerModuleImport :: HomeModules -> String -> Module -> Code
+registerModuleImport hmods way mod 
   | mod == gHC_PRIM
   = nopC 
   | otherwise  -- Push the init procedure onto the work stack
   = stmtsC [ CmmAssign spReg (cmmRegOffW spReg (-1))
-          , CmmStore (CmmReg spReg) (mkLblExpr (mkModuleInitLabel dflags mod way)) ]
+          , CmmStore (CmmReg spReg) (mkLblExpr (mkModuleInitLabel hmods mod way)) ]
 \end{code}
 
 
@@ -262,32 +261,32 @@ style, with the increasing static environment being plumbed as a state
 variable.
 
 \begin{code}
-cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code
-cgTopBinding dflags (StgNonRec id rhs, srts)
+cgTopBinding :: DynFlags -> HomeModules -> (StgBinding,[(Id,[Id])]) -> Code
+cgTopBinding dflags hmods (StgNonRec id rhs, srts)
   = do { id' <- maybeExternaliseId dflags id
-       ; mapM_ (mkSRT dflags [id']) srts
+       ; mapM_ (mkSRT hmods [id']) srts
        ; (id,info) <- cgTopRhs id' rhs
        ; addBindC id info      -- Add the *un-externalised* Id to the envt,
                                -- so we find it when we look up occurrences
        }
 
-cgTopBinding dflags (StgRec pairs, srts)
+cgTopBinding dflags hmods (StgRec pairs, srts)
   = do { let (bndrs, rhss) = unzip pairs
        ; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
        ; let pairs' = zip bndrs' rhss
-       ; mapM_ (mkSRT dflags bndrs')  srts
+       ; mapM_ (mkSRT hmods bndrs')  srts
        ; _new_binds <- fixC (\ new_binds -> do 
                { addBindsC new_binds
                ; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
        ; nopC }
 
-mkSRT :: DynFlags -> [Id] -> (Id,[Id]) -> Code
-mkSRT dflags these (id,[])  = nopC
-mkSRT dflags these (id,ids)
+mkSRT :: HomeModules -> [Id] -> (Id,[Id]) -> Code
+mkSRT hmods these (id,[])  = nopC
+mkSRT hmods these (id,ids)
   = do { ids <- mapFCs remap ids
        ; id  <- remap id
        ; emitRODataLits (mkSRTLabel (idName id)) 
-                      (map (CmmLabel . mkClosureLabel dflags . idName) ids)
+                      (map (CmmLabel . mkClosureLabel hmods . idName) ids)
        }
   where
        -- Sigh, better map all the ids against the environment in