From 9fa9dd773fc10a89b05d1456cfe55b79c5bd608c Mon Sep 17 00:00:00 2001
From: Simon Marlow <marlowsd@gmail.com>
Date: Wed, 15 Feb 2012 10:01:21 +0000
Subject: [PATCH] fix #5534 (ghci -fobject-code strangeness)
---
compiler/deSugar/Desugar.lhs | 4 ++--
compiler/iface/MkIface.lhs | 15 +++++++++++++--
compiler/main/DynFlags.hs | 12 ++++++++++++
3 files changed, 27 insertions(+), 4 deletions(-)
diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs
index cb482eaf89c5..99f4d53873e2 100644
--- a/compiler/deSugar/Desugar.lhs
+++ b/compiler/deSugar/Desugar.lhs
@@ -300,8 +300,8 @@ addExportFlagsAndRules target exports keep_alive rules prs
-- isExternalName separates the user-defined top-level names from those
-- introduced by the type checker.
is_exported :: Name -> Bool
- is_exported | target == HscInterpreted = isExternalName
- | otherwise = (`elemNameSet` exports)
+ is_exported | targetRetainsAllBindings target = isExternalName
+ | otherwise = (`elemNameSet` exports)
\end{code}
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 9904042fe0c4..31bcb7a41fb4 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -287,7 +287,7 @@ mkIface_ hsc_env maybe_old_fingerprint
mi_fixities = fixities,
mi_warns = warns,
mi_anns = mkIfaceAnnotations anns,
- mi_globals = Just rdr_env,
+ mi_globals = maybeGlobalRdrEnv rdr_env,
-- Left out deliberately: filled in by addFingerprints
mi_iface_hash = fingerprint0,
@@ -344,7 +344,7 @@ mkIface_ hsc_env maybe_old_fingerprint
-- 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 = Just rdr_env }
+ ; let final_iface = new_iface{ mi_globals = maybeGlobalRdrEnv rdr_env }
; return (errs_and_warns, Just (final_iface, no_change_at_all)) }}
where
@@ -359,6 +359,17 @@ mkIface_ hsc_env maybe_old_fingerprint
dflags = hsc_dflags hsc_env
+ -- We only fill in mi_globals if the module was compiled to byte
+ -- code. Otherwise, the compiler may not have retained all the
+ -- top-level bindings and they won't be in the TypeEnv (see
+ -- Desugar.addExportFlagsAndRules). The mi_globals field is used
+ -- by GHCi to decide whether the module has its full top-level
+ -- scope available.
+ maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe GlobalRdrEnv
+ maybeGlobalRdrEnv rdr_env
+ | targetRetainsAllBindings (hscTarget dflags) = Just rdr_env
+ | otherwise = Nothing
+
deliberatelyOmitted :: String -> a
deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 5af8a8afd6ed..438c56b5ed6d 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -32,6 +32,7 @@ module DynFlags (
HasDynFlags(..), ContainsDynFlags(..),
RtsOptsEnabled(..),
HscTarget(..), isObjectTarget, defaultObjectTarget,
+ targetRetainsAllBindings,
GhcMode(..), isOneShot,
GhcLink(..), isNoLink,
PackageFlag(..),
@@ -753,6 +754,17 @@ isObjectTarget HscAsm = True
isObjectTarget HscLlvm = True
isObjectTarget _ = False
+-- | Does this target retain *all* top-level bindings for a module,
+-- rather than just the exported bindings, in the TypeEnv and compiled
+-- code (if any)? In interpreted mode we do this, so that GHCi can
+-- call functions inside a module. In HscNothing mode we also do it,
+-- so that Haddock can get access to the GlobalRdrEnv for a module
+-- after typechecking it.
+targetRetainsAllBindings :: HscTarget -> Bool
+targetRetainsAllBindings HscInterpreted = True
+targetRetainsAllBindings HscNothing = True
+targetRetainsAllBindings _ = False
+
-- | The 'GhcMode' tells us whether we're doing multi-module
-- compilation (controlled via the "GHC" API) or one-shot
-- (single-module) compilation. This makes a difference primarily to
--
GitLab