nameIsLocalOrFrom should include interactive modules
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 11 Feb 2015 10:55:10 +0000 (10:55 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Wed, 11 Feb 2015 11:18:24 +0000 (11:18 +0000)
The provoking cause was Trac #10019, but it revealed that nameIsLocalOrFrom
should really include all interactive modules (ones from the 'interactive'
package).  Previously we had some ad-hoc 'isInteractiveModule' tests with
some (but not all) the calls to nameIsLocalOrFrom.

See the new comments with Name.nameIsLocalOrFrom.

compiler/basicTypes/Name.hs
compiler/iface/LoadIface.hs
compiler/rename/RnEnv.hs
compiler/typecheck/TcDeriv.hs
compiler/typecheck/TcRnDriver.hs
testsuite/tests/th/T10019.script [new file with mode: 0644]
testsuite/tests/th/T10019.stdout [new file with mode: 0644]
testsuite/tests/th/all.T

index 3b0da64..ab476db 100644 (file)
@@ -189,7 +189,6 @@ nameSrcSpan name = n_loc  name
 ************************************************************************
 -}
 
-nameIsLocalOrFrom :: Module -> Name -> Bool
 isInternalName    :: Name -> Bool
 isExternalName    :: Name -> Bool
 isSystemName      :: Name -> Bool
@@ -218,9 +217,32 @@ nameModule_maybe (Name { n_sort = External mod})    = Just mod
 nameModule_maybe (Name { n_sort = WiredIn mod _ _}) = Just mod
 nameModule_maybe _                                  = Nothing
 
+nameIsLocalOrFrom :: Module -> Name -> Bool
+-- ^ Returns True if the name is
+--   (a) Internal
+--   (b) External but from the specified module
+--   (c) External but from the 'interactive' package
+--
+-- The key idea is that
+--    False means: the entity is defined in some other module
+--                 you can find the details (type, fixity, instances)
+--                     in some interface file
+--                 those details will be stored in the EPT or HPT
+--
+--    True means:  the entity is defined in this module or earlier in
+--                     the GHCi session
+--                 you can find details (type, fixity, instances) in the
+--                     TcGblEnv or TcLclEnv
+--
+-- The isInteractiveModule part is because successive interactions of a GCHi session
+-- each give rise to a fresh module (Ghci1, Ghci2, etc), but they all come
+-- from the magic 'interactive' package; and all the details are kept in the
+-- TcLclEnv, TcGblEnv, NOT in the HPT or EPT.
+-- See Note [The interactive package] in HscTypes
+
 nameIsLocalOrFrom from name
-  | isExternalName name = from == nameModule name
-  | otherwise           = True
+  | Just mod <- nameModule_maybe name = from == mod || isInteractiveModule mod
+  | otherwise                         = True
 
 isTyVarName :: Name -> Bool
 isTyVarName name = isTvOcc (nameOccName name)
@@ -334,7 +356,8 @@ localiseName n = n { n_sort = Internal }
 -- |Create a localised variant of a name.
 --
 -- If the name is external, encode the original's module name to disambiguate.
---
+-- SPJ says: this looks like a rather odd-looking function; but it seems to
+--           be used only during vectorisation, so I'm not going to worry
 mkLocalisedOccName :: Module -> (Maybe String -> OccName -> OccName) -> Name -> OccName
 mkLocalisedOccName this_mod mk_occ name = mk_occ origin (nameOccName name)
   where
index 51f6bae..169e929 100644 (file)
@@ -320,17 +320,15 @@ loadModuleInterfaces doc mods
     load mod = loadSysInterface (doc <+> parens (ppr mod)) mod
 
 -- | Loads the interface for a given Name.
+-- Should only be called for an imported name;
+-- otherwise loadSysInterface may not find the interface
 loadInterfaceForName :: SDoc -> Name -> TcRn ModIface
 loadInterfaceForName doc name
-  = do {
-    when debugIsOn $ do
-        -- Should not be called with a name from the module being compiled
-        { this_mod <- getModule
-        ; MASSERT2( not (nameIsLocalOrFrom this_mod name), ppr name <+> parens doc )
-        }
-  ; ASSERT2( isExternalName name, ppr name )
-    initIfaceTcRn $ loadSysInterface doc (nameModule name)
-  }
+  = do { when debugIsOn $  -- Check pre-condition
+         do { this_mod <- getModule
+            ; MASSERT2( not (nameIsLocalOrFrom this_mod name), ppr name <+> parens doc ) }
+      ; ASSERT2( isExternalName name, ppr name )
+        initIfaceTcRn $ loadSysInterface doc (nameModule name) }
 
 -- | Loads the interface for a given Module.
 loadInterfaceForModule :: SDoc -> Module -> TcRn ModIface
index b6f12a7..580f0b9 100644 (file)
@@ -1277,9 +1277,9 @@ lookupFixityRn name
            Nothing ->
 
     do { this_mod <- getModule
-       ; if nameIsLocalOrFrom this_mod name || isInteractiveModule (nameModule name)
-               -- Interactive modules are all in the fixity env,
-               -- and don't have entries in the HPT
+       ; if nameIsLocalOrFrom this_mod name
+               -- Local (and interactive) names are all in the
+               -- fixity env, and don't have entries in the HPT
          then return defaultFixity
          else lookup_imported } } }
   where
index 3d980e2..9073720 100644 (file)
@@ -31,7 +31,7 @@ import TcHsType
 import TcMType
 import TcSimplify
 import LoadIface( loadInterfaceForName )
-import Module( getModule, isInteractiveModule )
+import Module( getModule )
 
 import RnNames( extendGlobalRdrEnvRn )
 import RnBinds
@@ -2101,7 +2101,7 @@ getDataConFixityFun :: TyCon -> TcM (Name -> Fixity)
 -- c.f. RnEnv.lookupFixity, and Trac #9830
 getDataConFixityFun tc
   = do { this_mod <- getModule
-       ; if nameIsLocalOrFrom this_mod name || isInteractiveModule (nameModule name)
+       ; if nameIsLocalOrFrom this_mod name
          then do { fix_env <- getFixityEnv
                  ; return (lookupFixity fix_env) }
          else do { iface <- loadInterfaceForName doc name
index 8f94d6c..c3b16ca 100644 (file)
@@ -1998,18 +1998,24 @@ loadUnqualIfaces hsc_env ictxt
   where
     this_pkg = thisPackage (hsc_dflags hsc_env)
 
-    unqual_mods = [ mod
+    unqual_mods = [ nameModule name
                   | gre <- globalRdrEnvElts (ic_rn_gbl_env ictxt)
                   , let name = gre_name gre
-                  , not (isInternalName name)
-                  , let mod = nameModule name
-                  , not (modulePackageKey mod == this_pkg || isInteractiveModule mod)
-                      -- Don't attempt to load an interface for stuff
-                      -- from the command line, or from the home package
+                  , from_external_package name
                   , isTcOcc (nameOccName name)   -- Types and classes only
                   , unQualOK gre ]               -- In scope unqualified
     doc = ptext (sLit "Need interface for module whose export(s) are in scope unqualified")
 
+    from_external_package name  -- True <=> the Name comes from some other package
+                                --          (not the home package, not the interactive package)
+      | Just mod <- nameModule_maybe name
+      , modulePackageKey mod /= this_pkg    -- Not the home package
+      , not (isInteractiveModule mod)       -- Not the 'interactive' package
+      = True
+      | otherwise
+      = False
+
+
 {-
 ************************************************************************
 *                                                                      *
diff --git a/testsuite/tests/th/T10019.script b/testsuite/tests/th/T10019.script
new file mode 100644 (file)
index 0000000..eef5fe7
--- /dev/null
@@ -0,0 +1,4 @@
+:set -XTemplateHaskell
+import Language.Haskell.TH
+data Option a = Some a | None
+$(reify 'Some >>= stringE . show)
diff --git a/testsuite/tests/th/T10019.stdout b/testsuite/tests/th/T10019.stdout
new file mode 100644 (file)
index 0000000..777ff3b
--- /dev/null
@@ -0,0 +1 @@
+"DataConI Ghci1.Some (ForallT [KindedTV a_1627391548 StarT] [] (AppT (AppT ArrowT (VarT a_1627391548)) (AppT (ConT Ghci1.Option) (VarT a_1627391548)))) Ghci1.Option (Fixity 9 InfixL)"
index e38c54a..641064d 100644 (file)
@@ -357,3 +357,4 @@ test('T8031', normal, compile, ['-v0'])
 test('T8624', normal, run_command, ['$MAKE -s --no-print-directory T8624'])
 test('TH_Lift', normal, compile, ['-v0'])
 test('T10047', normal, ghci_script, ['T10047.script'])
+test('T10019', normal, ghci_script, ['T10019.script'])