summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNiklas Hambüchen <mail@nh2.me>2013-08-20 18:44:24 +0900
committerAustin Seipp <aseipp@pobox.com>2013-08-22 16:25:01 -0500
commit16ae2f0c3ff45e0c78b90ae0761a0f86c70188bd (patch)
treeac47d21843369e0698728d115108f0888bc83dfe
parent4389cbd5084db9030696482fc88159f5e6acb033 (diff)
downloadhaskell-16ae2f0c3ff45e0c78b90ae0761a0f86c70188bd.tar.gz
MkIface: Be consistent with do notation
Signed-off-by: Austin Seipp <aseipp@pobox.com>
-rw-r--r--compiler/iface/MkIface.lhs240
1 files changed, 122 insertions, 118 deletions
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 3781ebda4b..5819964f2e 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -252,104 +252,104 @@ mkIface_ hsc_env maybe_old_fingerprint
-- put exactly the info into the TypeEnv that we want
-- to expose in the interface
- = do { usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files
-
- ; let { entities = typeEnvElts type_env ;
- decls = [ tyThingToIfaceDecl entity
- | entity <- entities,
- let name = getName entity,
- not (isImplicitTyThing entity),
- -- No implicit Ids and class tycons in the interface file
- not (isWiredInName name),
- -- Nor wired-in things; the compiler knows about them anyhow
- nameIsLocalOrFrom this_mod name ]
- -- Sigh: see Note [Root-main Id] in TcRnDriver
-
- ; fixities = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
- ; warns = src_warns
- ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
- ; iface_insts = map instanceToIfaceInst insts
- ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
- ; iface_vect_info = flattenVectInfo vect_info
- ; trust_info = setSafeMode safe_mode
-
- ; intermediate_iface = ModIface {
- mi_module = this_mod,
- mi_boot = is_boot,
- mi_deps = deps,
- mi_usages = usages,
- mi_exports = mkIfaceExports exports,
-
- -- Sort these lexicographically, so that
- -- the result is stable across compilations
- mi_insts = sortBy cmp_inst iface_insts,
- mi_fam_insts = sortBy cmp_fam_inst iface_fam_insts,
- mi_rules = sortBy cmp_rule iface_rules,
-
- mi_vect_info = iface_vect_info,
-
- mi_fixities = fixities,
- mi_warns = warns,
- mi_anns = mkIfaceAnnotations anns,
- mi_globals = maybeGlobalRdrEnv rdr_env,
-
- -- Left out deliberately: filled in by addFingerprints
- mi_iface_hash = fingerprint0,
- mi_mod_hash = fingerprint0,
- mi_flag_hash = fingerprint0,
- mi_exp_hash = fingerprint0,
- mi_used_th = used_th,
- mi_orphan_hash = fingerprint0,
- mi_orphan = False, -- Always set by addFingerprints, but
- -- it's a strict field, so we can't omit it.
- mi_finsts = False, -- Ditto
- mi_decls = deliberatelyOmitted "decls",
- mi_hash_fn = deliberatelyOmitted "hash_fn",
- mi_hpc = isHpcUsed hpc_info,
- mi_trust = trust_info,
- mi_trust_pkg = pkg_trust_req,
-
- -- And build the cached values
- mi_warn_fn = mkIfaceWarnCache warns,
- mi_fix_fn = mkIfaceFixCache fixities }
- }
- ; (new_iface, no_change_at_all)
- <- {-# SCC "versioninfo" #-}
- addFingerprints hsc_env maybe_old_fingerprint
- intermediate_iface decls
-
- -- Warn about orphans
- ; let warn_orphs = wopt Opt_WarnOrphans dflags
- warn_auto_orphs = wopt Opt_WarnAutoOrphans dflags
- orph_warnings --- Laziness means no work done unless -fwarn-orphans
- | warn_orphs || warn_auto_orphs = rule_warns `unionBags` inst_warns
- | otherwise = emptyBag
- errs_and_warns = (orph_warnings, emptyBag)
- unqual = mkPrintUnqualified dflags rdr_env
- inst_warns = listToBag [ instOrphWarn dflags unqual d
- | (d,i) <- insts `zip` iface_insts
- , isNothing (ifInstOrph i) ]
- rule_warns = listToBag [ ruleOrphWarn dflags unqual this_mod r
- | r <- iface_rules
- , isNothing (ifRuleOrph r)
- , if ifRuleAuto r then warn_auto_orphs
- else warn_orphs ]
-
- ; if errorsFound dflags errs_and_warns
- then return ( errs_and_warns, Nothing )
- else do {
-
- -- Debug printing
- ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
- (pprModIface new_iface)
-
- -- bug #1617: on reload we weren't updating the PrintUnqualified
- -- correctly. This stems from the fact that the interface had
- -- not changed, so addFingerprints returns the old ModIface
- -- with the old GlobalRdrEnv (mi_globals).
- ; let final_iface = new_iface{ mi_globals = maybeGlobalRdrEnv rdr_env }
-
- ; return (errs_and_warns, Just (final_iface, no_change_at_all)) }}
+ = do
+ usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files
+
+ let entities = typeEnvElts type_env
+ decls = [ tyThingToIfaceDecl entity
+ | entity <- entities,
+ let name = getName entity,
+ not (isImplicitTyThing entity),
+ -- No implicit Ids and class tycons in the interface file
+ not (isWiredInName name),
+ -- Nor wired-in things; the compiler knows about them anyhow
+ nameIsLocalOrFrom this_mod name ]
+ -- Sigh: see Note [Root-main Id] in TcRnDriver
+
+ fixities = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
+ warns = src_warns
+ iface_rules = map (coreRuleToIfaceRule this_mod) rules
+ iface_insts = map instanceToIfaceInst insts
+ iface_fam_insts = map famInstToIfaceFamInst fam_insts
+ iface_vect_info = flattenVectInfo vect_info
+ trust_info = setSafeMode safe_mode
+
+ intermediate_iface = ModIface {
+ mi_module = this_mod,
+ mi_boot = is_boot,
+ mi_deps = deps,
+ mi_usages = usages,
+ mi_exports = mkIfaceExports exports,
+
+ -- Sort these lexicographically, so that
+ -- the result is stable across compilations
+ mi_insts = sortBy cmp_inst iface_insts,
+ mi_fam_insts = sortBy cmp_fam_inst iface_fam_insts,
+ mi_rules = sortBy cmp_rule iface_rules,
+
+ mi_vect_info = iface_vect_info,
+
+ mi_fixities = fixities,
+ mi_warns = warns,
+ mi_anns = mkIfaceAnnotations anns,
+ mi_globals = maybeGlobalRdrEnv rdr_env,
+
+ -- Left out deliberately: filled in by addFingerprints
+ mi_iface_hash = fingerprint0,
+ mi_mod_hash = fingerprint0,
+ mi_flag_hash = fingerprint0,
+ mi_exp_hash = fingerprint0,
+ mi_used_th = used_th,
+ mi_orphan_hash = fingerprint0,
+ mi_orphan = False, -- Always set by addFingerprints, but
+ -- it's a strict field, so we can't omit it.
+ mi_finsts = False, -- Ditto
+ mi_decls = deliberatelyOmitted "decls",
+ mi_hash_fn = deliberatelyOmitted "hash_fn",
+ mi_hpc = isHpcUsed hpc_info,
+ mi_trust = trust_info,
+ mi_trust_pkg = pkg_trust_req,
+
+ -- And build the cached values
+ mi_warn_fn = mkIfaceWarnCache warns,
+ mi_fix_fn = mkIfaceFixCache fixities }
+
+ (new_iface, no_change_at_all)
+ <- {-# SCC "versioninfo" #-}
+ addFingerprints hsc_env maybe_old_fingerprint
+ intermediate_iface decls
+
+ -- Warn about orphans
+ let warn_orphs = wopt Opt_WarnOrphans dflags
+ warn_auto_orphs = wopt Opt_WarnAutoOrphans dflags
+ orph_warnings --- Laziness means no work done unless -fwarn-orphans
+ | warn_orphs || warn_auto_orphs = rule_warns `unionBags` inst_warns
+ | otherwise = emptyBag
+ errs_and_warns = (orph_warnings, emptyBag)
+ unqual = mkPrintUnqualified dflags rdr_env
+ inst_warns = listToBag [ instOrphWarn dflags unqual d
+ | (d,i) <- insts `zip` iface_insts
+ , isNothing (ifInstOrph i) ]
+ rule_warns = listToBag [ ruleOrphWarn dflags unqual this_mod r
+ | r <- iface_rules
+ , isNothing (ifRuleOrph r)
+ , if ifRuleAuto r then warn_auto_orphs
+ else warn_orphs ]
+
+ if errorsFound dflags errs_and_warns
+ then return ( errs_and_warns, Nothing )
+ else do
+ -- Debug printing
+ dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
+ (pprModIface new_iface)
+
+ -- bug #1617: on reload we weren't updating the PrintUnqualified
+ -- correctly. This stems from the fact that the interface had
+ -- not changed, so addFingerprints returns the old ModIface
+ -- with the old GlobalRdrEnv (mi_globals).
+ let final_iface = new_iface{ mi_globals = maybeGlobalRdrEnv rdr_env }
+
+ return (errs_and_warns, Just (final_iface, no_change_at_all))
where
cmp_rule = comparing ifRuleName
-- Compare these lexicographically by OccName, *not* by unique,
@@ -813,8 +813,9 @@ lookupOccEnvL env k = lookupOccEnv env k `orElse` []
-- fingerprints of external Names that it refers to.
putNameLiterally :: BinHandle -> Name -> IO ()
putNameLiterally bh name = ASSERT( isExternalName name )
- do { put_ bh $! nameModule name
- ; put_ bh $! nameOccName name }
+ do
+ put_ bh $! nameModule name
+ put_ bh $! nameOccName name
{-
-- for testing: use the md5sum command to generate fingerprints and
@@ -880,15 +881,16 @@ mkOrphMap get_key decls
\begin{code}
mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath] -> IO [Usage]
mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files
- = do { eps <- hscEPS hsc_env
- ; mtimes <- mapM getModificationUTCTime dependent_files
- ; let mod_usages = mk_mod_usage_info (eps_PIT eps) hsc_env this_mod
- dir_imp_mods used_names
- ; let usages = mod_usages ++ map to_file_usage (zip dependent_files mtimes)
- ; usages `seqList` return usages }
- -- seq the list of Usages returned: occasionally these
- -- don't get evaluated for a while and we can end up hanging on to
- -- the entire collection of Ifaces.
+ = do
+ eps <- hscEPS hsc_env
+ mtimes <- mapM getModificationUTCTime dependent_files
+ let mod_usages = mk_mod_usage_info (eps_PIT eps) hsc_env this_mod
+ dir_imp_mods used_names
+ let usages = mod_usages ++ map to_file_usage (zip dependent_files mtimes)
+ usages `seqList` return usages
+ -- seq the list of Usages returned: occasionally these
+ -- don't get evaluated for a while and we can end up hanging on to
+ -- the entire collection of Ifaces.
where
to_file_usage (f, mtime) = UsageFile { usg_file_path = f, usg_mtime = mtime }
@@ -1324,19 +1326,21 @@ checkModUsage this_pkg UsageHomeModule{
-- CHECK MODULE
recompile <- checkModuleFingerprint reason old_mod_hash new_mod_hash
- if not (recompileRequired recompile) then return UpToDate else do
+ if not (recompileRequired recompile)
+ then return UpToDate
+ else do
-- CHECK EXPORT LIST
- checkMaybeHash reason maybe_old_export_hash new_export_hash
- (ptext (sLit " Export list changed")) $ do
+ checkMaybeHash reason maybe_old_export_hash new_export_hash
+ (ptext (sLit " Export list changed")) $ do
-- CHECK ITEMS ONE BY ONE
- recompile <- checkList [ checkEntityUsage reason new_decl_hash u
- | u <- old_decl_hash]
- if recompileRequired recompile
- then return recompile -- This one failed, so just bail out now
- else up_to_date (ptext (sLit " Great! The bits I use are up to date"))
-
+ recompile <- checkList [ checkEntityUsage reason new_decl_hash u
+ | u <- old_decl_hash]
+ if recompileRequired recompile
+ then return recompile -- This one failed, so just bail out now
+ else up_to_date (ptext (sLit " Great! The bits I use are up to date"))
+
checkModUsage _this_pkg UsageFile{ usg_file_path = file,
usg_mtime = old_mtime } =