X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FTidyPgm.lhs;h=b001e1d3b3727df853bfc426565b46420bde2cbf;hp=dc0ea7e1b8f007b4879c414456589b7c061102d9;hb=cdce647711c0f46f5799b24de087622cb77e647f;hpb=b00b5bc04ff36a551552470060064f0b7d84ca30 diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index dc0ea7e..b001e1d 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -21,7 +21,8 @@ import VarSet import Var ( Id, Var ) import Id ( idType, idInfo, idName, idCoreRules, isGlobalId, isExportedId, mkVanillaGlobal, isLocalId, isNaughtyRecordSelector, - idArity, idCafInfo, idUnfolding, isImplicitId, setIdInfo + idArity, idCafInfo, idUnfolding, isImplicitId, setIdInfo, + isTickBoxOp ) import IdInfo {- loads of stuff -} import InstEnv ( Instance, DFunId, instanceDFunId, setInstanceDFunId ) @@ -48,11 +49,12 @@ import Maybes ( orElse, mapCatMaybes ) import ErrUtils ( showPass, dumpIfSet_core ) import PackageConfig ( PackageId ) import UniqSupply ( splitUniqSupply, uniqFromSupply ) -import List ( partition ) -import Maybe ( isJust ) import Outputable -import DATA_IOREF ( IORef, readIORef, writeIORef ) import FastTypes hiding ( fastOr ) + +import Data.List ( partition ) +import Data.Maybe ( isJust ) +import Data.IORef ( IORef, readIORef, writeIORef ) \end{code} @@ -122,7 +124,9 @@ mkBootModDetails hsc_env (ModGuts { mg_module = mod , mg_exports = exports , mg_types = type_env , mg_insts = insts - , mg_fam_insts = fam_insts }) + , mg_fam_insts = fam_insts + , mg_modBreaks = modBreaks + }) = do { let dflags = hsc_dflags hsc_env ; showPass dflags "Tidy [hoot] type env" @@ -136,7 +140,9 @@ mkBootModDetails hsc_env (ModGuts { mg_module = mod , md_insts = insts' , md_fam_insts = fam_insts , md_rules = [] - , md_exports = exports }) + , md_exports = exports + , md_modBreaks = modBreaks + }) } where @@ -238,7 +244,9 @@ tidyProgram hsc_env mg_binds = binds, mg_rules = imp_rules, mg_dir_imps = dir_imps, mg_deps = deps, - mg_foreign = foreign_stubs }) + mg_foreign = foreign_stubs, + mg_hpc_info = hpc_info, + mg_modBreaks = modBreaks }) = do { let dflags = hsc_dflags hsc_env ; showPass dflags "Tidy Core" @@ -289,13 +297,16 @@ tidyProgram hsc_env cg_binds = all_tidy_binds, cg_dir_imps = dir_imps, cg_foreign = foreign_stubs, - cg_dep_pkgs = dep_pkgs deps }, + cg_dep_pkgs = dep_pkgs deps, + cg_hpc_info = hpc_info }, ModDetails { md_types = tidy_type_env, md_rules = tidy_rules, md_insts = tidy_insts, md_fam_insts = fam_insts, - md_exports = exports }) + md_exports = exports, + md_modBreaks = modBreaks }) + } lookup_dfun type_env dfun_id @@ -788,11 +799,13 @@ CAF list to keep track of non-collectable CAFs. \begin{code} hasCafRefs :: PackageId -> VarEnv Var -> Arity -> CoreExpr -> CafInfo hasCafRefs this_pkg p arity expr - | is_caf || mentions_cafs = MayHaveCafRefs + | is_caf || mentions_cafs + = MayHaveCafRefs | otherwise = NoCafRefs where mentions_cafs = isFastTrue (cafRefs p expr) is_caf = not (arity > 0 || rhsIsStatic this_pkg expr) + -- NB. we pass in the arity of the expression, which is expected -- to be calculated by exprArity. This is because exprArity -- knows how much eta expansion is going to be done by