X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmm.hs;h=26ace0780f56a494482c106c3e0044a4d72ea9a5;hb=7b0ff1792d699ff02a604163c9ccf4a98a1ca3eb;hp=ae4fa1b623532199ee21a87f73e516d26b91e61a;hpb=31a9d04804d9cacda35695c5397590516b964964;p=ghc-hetmet.git diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs index ae4fa1b..26ace07 100644 --- a/compiler/codeGen/StgCmm.hs +++ b/compiler/codeGen/StgCmm.hs @@ -23,8 +23,9 @@ import StgCmmClosure import StgCmmHpc import StgCmmTicky -import MkZipCfgCmm -import Cmm +import MkGraph +import CmmDecl +import CmmExpr import CmmUtils import CLabel import PprCmm @@ -41,7 +42,6 @@ import IdInfo import Type import DataCon import Name -import OccName import TyCon import Module import ErrUtils @@ -54,7 +54,7 @@ codeGen :: DynFlags -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering. -> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs -> HpcInfo - -> IO [CmmZ] -- Output + -> IO [Cmm] -- Output codeGen dflags this_mod data_tycons imported_mods cost_centre_info stg_binds hpc_info @@ -113,7 +113,7 @@ cgTopBinding dflags (StgRec pairs, _srts) = do { let (bndrs, rhss) = unzip pairs ; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs ; let pairs' = zip bndrs' rhss - ; fixC (\ new_binds -> do + ; fixC_(\ new_binds -> do { addBindsC new_binds ; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' }) ; return () } @@ -288,7 +288,7 @@ For charlike and intlike closures there is a fixed array of static closures predeclared. -} -cgTyCon :: TyCon -> FCode [CmmZ] -- All constructors merged together +cgTyCon :: TyCon -> FCode [Cmm] -- All constructors merged together cgTyCon tycon = do { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon) @@ -305,7 +305,7 @@ cgTyCon tycon ; return (extra ++ constrs) } -cgEnumerationTyCon :: TyCon -> FCode [CmmZ] +cgEnumerationTyCon :: TyCon -> FCode [Cmm] cgEnumerationTyCon tycon | isEnumerationTyCon tycon = do { tbl <- getCmm $ @@ -330,11 +330,12 @@ cgDataCon data_con (dyn_cl_info, arg_things) = layOutDynConstr data_con arg_reps emit_info cl_info ticky_code - = emitClosureAndInfoTable cl_info [] $ mk_code ticky_code + = emitClosureAndInfoTable cl_info NativeDirectCall [] + $ mk_code ticky_code mk_code ticky_code = -- NB: We don't set CC when entering data (WDP 94/06) - do { ticky_code + do { _ <- ticky_code ; ldvEnter (CmmReg nodeReg) ; tickyReturnOldCon (length arg_things) ; emitReturn [cmmOffsetB (CmmReg nodeReg)