Add ASSERTs to all calls of nameModule

nameModule fails on an InternalName.  These ASSERTS tell you
which call failed.

diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
index e7ffb58..5a67ffe 100644 (file)
--- a/compiler/basicTypes/DataCon.lhs
+++ b/compiler/basicTypes/DataCon.lhs
@@ -800,7 +800,7 @@ dataConIdentity dc = bytesFS (packageIdFS (modulePackageId mod)) ++
                   fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++
                   fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
   where name = dataConName dc
                   fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++
                   fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
   where name = dataConName dc

-        mod  = nameModule name
+        mod  = ASSERT( isExternalName name ) nameModule name

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs
index 5baebbc..6b28786 100644 (file)
--- a/compiler/basicTypes/RdrName.lhs
+++ b/compiler/basicTypes/RdrName.lhs
@@ -143,7 +143,8 @@ setRdrNameSpace :: RdrName -> NameSpace -> RdrName
 setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
 setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
 setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
 setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
 setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
 setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)

-setRdrNameSpace (Exact n)    ns = Orig (nameModule n)
+setRdrNameSpace (Exact n)    ns = ASSERT( isExternalName n ) 
+                                 Orig (nameModule n)

                                       (setOccNameSpace ns (nameOccName n))
 \end{code}
 
                                       (setOccNameSpace ns (nameOccName n))
 \end{code}
 

@@ -163,7 +164,8 @@ mkOrig mod occ = Orig mod occ
 -- is derived from that of it's parent using the supplied function
 mkDerivedRdrName :: Name -> (OccName -> OccName) -> RdrName
 mkDerivedRdrName parent mk_occ
 -- is derived from that of it's parent using the supplied function
 mkDerivedRdrName :: Name -> (OccName -> OccName) -> RdrName
 mkDerivedRdrName parent mk_occ

-  = mkOrig (nameModule parent) (mk_occ (nameOccName parent))
+  = ASSERT2( isExternalName parent, ppr parent )
+    mkOrig (nameModule parent) (mk_occ (nameOccName parent))

 
 ---------------
        -- These two are used when parsing source files
 
 ---------------
        -- These two are used when parsing source files

@@ -556,7 +558,7 @@ hideSomeUnquals rdr_env occs
     qual_gre gre@(GRE { gre_name = name, gre_prov = LocalDef })
        = gre { gre_prov = Imported [imp_spec] }
        where   -- Local defs get transfomed to (fake) imported things
     qual_gre gre@(GRE { gre_name = name, gre_prov = LocalDef })
        = gre { gre_prov = Imported [imp_spec] }
        where   -- Local defs get transfomed to (fake) imported things

-         mod = moduleName (nameModule name)
+         mod = ASSERT2( isExternalName name, ppr name) moduleName (nameModule name)

          imp_spec = ImpSpec { is_item = ImpAll, is_decl = decl_spec }
          decl_spec = ImpDeclSpec { is_mod = mod, is_as = mod, 
                                    is_qual = True, 
          imp_spec = ImpSpec { is_item = ImpAll, is_decl = decl_spec }
          decl_spec = ImpDeclSpec { is_mod = mod, is_as = mod, 
                                    is_qual = True, 

diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 3659498..554a945 100644 (file)
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -28,6 +28,8 @@ module DsMeta( dsBracket,
               quoteExpName, quotePatName
                ) where
 
               quoteExpName, quotePatName
                ) where
 

+#include "HsVersions.h"
+

 import {-# SOURCE #-}  DsExpr ( dsExpr )
 
 import MatchLit
 import {-# SOURCE #-}  DsExpr ( dsExpr )
 
 import MatchLit

@@ -949,7 +951,7 @@ globalVar name
        ; MkC uni <- coreIntLit (getKey (getUnique name))
        ; rep2 mkNameLName [occ,uni] }
   where
        ; MkC uni <- coreIntLit (getKey (getUnique name))
        ; rep2 mkNameLName [occ,uni] }
   where

-      mod = nameModule name
+      mod = ASSERT( isExternalName name) nameModule name

       name_mod = moduleNameString (moduleName mod)
       name_pkg = packageIdString (modulePackageId mod)
       name_occ = nameOccName name
       name_mod = moduleNameString (moduleName mod)
       name_pkg = packageIdString (modulePackageId mod)
       name_occ = nameOccName name

diff --git a/compiler/ghci/ByteCodeLink.lhs b/compiler/ghci/ByteCodeLink.lhs
index 54dff1d..fabd5d1 100644 (file)
--- a/compiler/ghci/ByteCodeLink.lhs
+++ b/compiler/ghci/ByteCodeLink.lhs
@@ -265,7 +265,7 @@ nameToCLabel n suffix
         else qual_name
   where
         pkgid = modulePackageId mod
         else qual_name
   where
         pkgid = modulePackageId mod

-        mod = nameModule n
+        mod = ASSERT( isExternalName n ) nameModule n

         package_part = unpackFS (zEncodeFS (packageIdFS (modulePackageId mod)))
         module_part  = unpackFS (zEncodeFS (moduleNameFS (moduleName mod)))
         occ_part     = unpackFS (zEncodeFS (occNameFS (nameOccName n)))
         package_part = unpackFS (zEncodeFS (packageIdFS (modulePackageId mod)))
         module_part  = unpackFS (zEncodeFS (moduleNameFS (moduleName mod)))
         occ_part     = unpackFS (zEncodeFS (occNameFS (nameOccName n)))

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index e0dd5cc..b1baecd 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -1088,7 +1088,8 @@ checkModule m = do
           case GHC.moduleInfo r of
             cm | Just scope <- GHC.modInfoTopLevelScope cm ->
                let
           case GHC.moduleInfo r of
             cm | Just scope <- GHC.modInfoTopLevelScope cm ->
                let

-                   (local,global) = partition ((== modl) . GHC.moduleName . GHC.nameModule) scope
+                   (local,global) = ASSERT( all isExternalName scope )
+                                    partition ((== modl) . GHC.moduleName . GHC.nameModule) scope

                in
                        (text "global names: " <+> ppr global) $$
                        (text "local  names: " <+> ppr local)
                in
                        (text "global names: " <+> ppr global) $$
                        (text "local  names: " <+> ppr local)

@@ -1275,7 +1276,8 @@ browseModule bang modl exports_only = do
                 -- We would like to improve this; see #1799.
             sorted_names = loc_sort local ++ occ_sort external
                 where 
                 -- We would like to improve this; see #1799.
             sorted_names = loc_sort local ++ occ_sort external
                 where 

-                (local,external) = partition ((==modl) . nameModule) names
+                (local,external) = ASSERT( all isExternalName names )
+                                  partition ((==modl) . nameModule) names

                 occ_sort = sortBy (compare `on` nameOccName) 
                 -- try to sort by src location.  If the first name in
                 -- our list has a good source location, then they all should.
                 occ_sort = sortBy (compare `on` nameOccName) 
                 -- try to sort by src location.  If the first name in
                 -- our list has a good source location, then they all should.

@@ -1896,7 +1898,7 @@ wantNameFromInterpretedModule noCanDo str and_then =
    case names of
       []    -> return ()
       (n:_) -> do
    case names of
       []    -> return ()
       (n:_) -> do

-            let modl = GHC.nameModule n
+            let modl = ASSERT( isExternalName n ) GHC.nameModule n

             if not (GHC.isExternalName n)
                then noCanDo n $ ppr n <>
                                 text " is not defined in an interpreted module"
             if not (GHC.isExternalName n)
                then noCanDo n $ ppr n <>
                                 text " is not defined in an interpreted module"

@@ -2068,7 +2070,8 @@ breakSwitch (arg1:rest)
         wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
         let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
         if GHC.isGoodSrcLoc loc
         wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
         let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
         if GHC.isGoodSrcLoc loc

-               then findBreakAndSet (GHC.nameModule name) $ 
+               then ASSERT( isExternalName name ) 
+                   findBreakAndSet (GHC.nameModule name) $ 

                          findBreakByCoord (Just (GHC.srcLocFile loc))
                                           (GHC.srcLocLine loc, 
                                            GHC.srcLocCol loc)
                          findBreakByCoord (Just (GHC.srcLocFile loc))
                                           (GHC.srcLocLine loc, 
                                            GHC.srcLocCol loc)

@@ -2215,7 +2218,8 @@ list2 [arg] = do
         let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
         if GHC.isGoodSrcLoc loc
                then do
         let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
         if GHC.isGoodSrcLoc loc
                then do

-                  tickArray <- getTickArray (GHC.nameModule name)
+                  tickArray <- ASSERT( isExternalName name )
+                              getTickArray (GHC.nameModule name)

                   let mb_span = findBreakByCoord (Just (GHC.srcLocFile loc))
                                         (GHC.srcLocLine loc, GHC.srcLocCol loc)
                                         tickArray
                   let mb_span = findBreakByCoord (Just (GHC.srcLocFile loc))
                                         (GHC.srcLocLine loc, GHC.srcLocCol loc)
                                         tickArray

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index c155fb2..58c8373 100644 (file)
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -263,7 +263,7 @@ fromOnDiskName _ nc (pid, mod_name, occ) =
 
 serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
 serialiseName bh name _ = do
 
 serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
 serialiseName bh name _ = do

-  let mod = nameModule name
+  let mod = ASSERT2( isExternalName name, ppr name ) nameModule name

   put_ bh (modulePackageId mod, moduleName mod, nameOccName name)
 
 
   put_ bh (modulePackageId mod, moduleName mod, nameOccName name)
 
 

diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs
index 5dcab1e..20d7327 100644 (file)
--- a/compiler/iface/IfaceEnv.lhs
+++ b/compiler/iface/IfaceEnv.lhs
@@ -212,7 +212,8 @@ lookupOrigNameCache nc mod occ      -- The normal case
 
 extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache
 extendOrigNameCache nc name 
 
 extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache
 extendOrigNameCache nc name 

-  = extendNameCache nc (nameModule name) (nameOccName name) name
+  = ASSERT2( isExternalName name, ppr name ) 
+    extendNameCache nc (nameModule name) (nameOccName name) name

 
 extendNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
 extendNameCache nc mod occ name
 
 extendNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
 extendNameCache nc mod occ name

diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index d7089f1..50fa933 100644 (file)
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -120,7 +120,8 @@ loadInterfaceForName doc name
         { this_mod <- getModule
         ; MASSERT2( not (nameIsLocalOrFrom this_mod name), ppr name <+> parens doc )
         }
         { this_mod <- getModule
         ; MASSERT2( not (nameIsLocalOrFrom this_mod name), ppr name <+> parens doc )
         }

-  ; initIfaceTcRn $ loadSysInterface doc (nameModule name)
+  ; ASSERT2( isExternalName name, ppr name ) 
+    initIfaceTcRn $ loadSysInterface doc (nameModule name)

   }
 
 -- | An 'IfM' function to load the home interface for a wired-in thing,
   }
 
 -- | An 'IfM' function to load the home interface for a wired-in thing,

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 1346a9a..2aa614c 100644 (file)
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -370,7 +370,7 @@ mkHashFun
 mkHashFun hsc_env eps
   = \name -> 
       let 
 mkHashFun hsc_env eps
   = \name -> 
       let 

-        mod = nameModule name
+        mod = ASSERT2( isExternalName name, ppr name ) nameModule name

         occ = nameOccName name
         iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse` 
                    pprPanic "lookupVers2" (ppr mod <+> ppr occ)
         occ = nameOccName name
         iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse` 
                    pprPanic "lookupVers2" (ppr mod <+> ppr occ)

@@ -411,8 +411,9 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
               , let out = localOccs $ freeNamesDeclABI abi
                ]
 
               , let out = localOccs $ freeNamesDeclABI abi
                ]
 

+       name_module n = ASSERT( isExternalName n ) nameModule n

        localOccs = map (getUnique . getParent . getOccName) 
        localOccs = map (getUnique . getParent . getOccName) 

-                        . filter ((== this_mod) . nameModule)
+                        . filter ((== this_mod) . name_module)

                         . nameSetToList
           where getParent occ = lookupOccEnv parent_map occ `orElse` occ
 
                         . nameSetToList
           where getParent occ = lookupOccEnv parent_map occ `orElse` occ
 

@@ -442,7 +443,8 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
           | isWiredInName name  =  putNameLiterally bh name 
            -- wired-in names don't have fingerprints
           | otherwise
           | isWiredInName name  =  putNameLiterally bh name 
            -- wired-in names don't have fingerprints
           | otherwise

-          = let hash | nameModule name /= this_mod =  global_hash_fn name
+          = ASSERT( isExternalName name )
+           let hash | nameModule name /= this_mod =  global_hash_fn name

                      | otherwise = 
                         snd (lookupOccEnv local_env (getOccName name)
                            `orElse` pprPanic "urk! lookup local fingerprint" 
                      | otherwise = 
                         snd (lookupOccEnv local_env (getOccName name)
                            `orElse` pprPanic "urk! lookup local fingerprint" 

@@ -698,9 +700,9 @@ lookupOccEnvL env k = lookupOccEnv env k `orElse` []
 -- used when we want to fingerprint a structure without depending on the
 -- fingerprints of external Names that it refers to.
 putNameLiterally :: BinHandle -> Name -> IO ()
 -- used when we want to fingerprint a structure without depending on the
 -- fingerprints of external Names that it refers to.
 putNameLiterally :: BinHandle -> Name -> IO ()

-putNameLiterally bh name = do
-  put_ bh $! nameModule name
-  put_ bh $! nameOccName name
+putNameLiterally bh name = ASSERT( isExternalName name ) 
+  do { put_ bh $! nameModule name
+     ; put_ bh $! nameOccName name }

 
 computeFingerprint :: Binary a
                    => DynFlags 
 
 computeFingerprint :: Binary a
                    => DynFlags 

@@ -927,10 +929,12 @@ mkIfaceExports exports
        --     else the plusFM will simply discard one!  They
        --     should have been combined by now.
     add env (Avail n)
        --     else the plusFM will simply discard one!  They
        --     should have been combined by now.
     add env (Avail n)

-      = add_one env (nameModule n) (Avail (nameOccName n))
+      = ASSERT( isExternalName n ) 
+        add_one env (nameModule n) (Avail (nameOccName n))

 
     add env (AvailTC tc ns)
 
     add env (AvailTC tc ns)

-      = foldl add_for_mod env mods
+      = ASSERT( all isExternalName ns ) 
+       foldl add_for_mod env mods

       where
        tc_occ = nameOccName tc
        mods   = nub (map nameModule ns)
       where
        tc_occ = nameOccName tc
        mods   = nub (map nameModule ns)

@@ -1368,7 +1372,7 @@ instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
     do_rough (Just n) = Just (toIfaceTyCon_name n)
 
     dfun_name = idName dfun_id
     do_rough (Just n) = Just (toIfaceTyCon_name n)
 
     dfun_name = idName dfun_id

-    mod       = nameModule dfun_name
+    mod       = ASSERT( isExternalName dfun_name ) nameModule dfun_name

     is_local name = nameIsLocalOrFrom mod name
 
        -- Compute orphanhood.  See Note [Orphans] in IfaceSyn
     is_local name = nameIsLocalOrFrom mod name
 
        -- Compute orphanhood.  See Note [Orphans] in IfaceSyn

diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 32735a4..d9072f8 100644 (file)
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -127,7 +127,8 @@ checkWiredInTyCon tc
   = return ()
   | otherwise
   = do { mod <- getModule
   = return ()
   | otherwise
   = do { mod <- getModule

-       ; unless (mod == nameModule tc_name)
+       ; ASSERT( isExternalName tc_name ) 
+         unless (mod == nameModule tc_name)

                 (initIfaceTcRn (loadWiredInHomeIface tc_name))
                -- Don't look for (non-existent) Float.hi when
                -- compiling Float.lhs, which mentions Float of course
                 (initIfaceTcRn (loadWiredInHomeIface tc_name))
                -- Don't look for (non-existent) Float.hi when
                -- compiling Float.lhs, which mentions Float of course

@@ -144,7 +145,8 @@ importDecl name
     do { traceIf nd_doc
 
        -- Load the interface, which should populate the PTE
     do { traceIf nd_doc
 
        -- Load the interface, which should populate the PTE

-       ; mb_iface <- loadInterface nd_doc (nameModule name) ImportBySystem
+       ; mb_iface <- ASSERT2( isExternalName name, ppr name ) 
+                     loadInterface nd_doc (nameModule name) ImportBySystem

        ; case mb_iface of {
                Failed err_msg  -> return (Failed err_msg) ;
                Succeeded _ -> do
        ; case mb_iface of {
                Failed err_msg  -> return (Failed err_msg) ;
                Succeeded _ -> do

@@ -1047,7 +1049,8 @@ ifCheckWiredInThing name
                -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in
                -- the HPT, so without the test we'll demand-load it into the PIT!
                -- C.f. the same test in checkWiredInTyCon above
                -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in
                -- the HPT, so without the test we'll demand-load it into the PIT!
                -- C.f. the same test in checkWiredInTyCon above

-       ; unless (mod == nameModule name)
+       ; ASSERT2( isExternalName name, ppr name ) 
+         unless (mod == nameModule name)

                 (loadWiredInHomeIface name) }
 
 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
                 (loadWiredInHomeIface name) }
 
 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 6d43ea8..83dda3f 100644 (file)
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -105,7 +105,7 @@ import {-# SOURCE #-}  InteractiveEval ( Resume )
 #endif
 
 import RdrName
 #endif
 
 import RdrName

-import Name            ( Name, NamedThing, getName, nameOccName, nameModule )
+import Name

 import NameEnv
 import NameSet 
 import OccName         ( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv, 
 import NameEnv
 import NameSet 
 import OccName         ( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv, 

@@ -1160,7 +1160,7 @@ mkPrintUnqualified dflags env = (qual_name, qual_mod)
 
        | otherwise = panic "mkPrintUnqualified"
       where
 
        | otherwise = panic "mkPrintUnqualified"
       where

-       right_name gre = nameModule (gre_name gre) == mod
+       right_name gre = nameModule_maybe (gre_name gre) == Just mod

 
         unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env
         qual_gres   = filter right_name (lookupGlobalRdrEnv env occ)
 
         unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env
         qual_gres   = filter right_name (lookupGlobalRdrEnv env occ)

@@ -1330,7 +1330,7 @@ lookupType dflags hpt pte name
        lookupNameEnv (md_types (hm_details hm)) name
   | otherwise
   = lookupNameEnv pte name
        lookupNameEnv (md_types (hm_details hm)) name
   | otherwise
   = lookupNameEnv pte name

-  where mod = nameModule name
+  where mod = ASSERT( isExternalName name ) nameModule name

        this_pkg = thisPackage dflags
 
 -- | As 'lookupType', but with a marginally easier-to-use interface
        this_pkg = thisPackage dflags
 
 -- | As 'lookupType', but with a marginally easier-to-use interface

diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index 3e49d5e..b2f5b3f 100644 (file)
--- a/compiler/prelude/TysWiredIn.lhs
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -56,6 +56,8 @@ module TysWiredIn (
        parrTyCon_RDR, parrTyConName
     ) where
 
        parrTyCon_RDR, parrTyConName
     ) where
 

+#include "HsVersions.h"
+

 import {-# SOURCE #-} MkId( mkDataConIds )
 
 -- friends:
 import {-# SOURCE #-} MkId( mkDataConIds )
 
 -- friends:

@@ -66,8 +68,7 @@ import TysPrim
 import Constants       ( mAX_TUPLE_SIZE )
 import Module          ( Module )
 import RdrName
 import Constants       ( mAX_TUPLE_SIZE )
 import Module          ( Module )
 import RdrName

-import Name            ( Name, BuiltInSyntax(..), nameUnique, nameOccName, 
-                         nameModule, mkWiredInName )
+import Name

 import OccName         ( mkTcOccFS, mkDataOccFS, mkTupleOcc, mkDataConWorkerOcc,
                          tcName, dataName )
 import DataCon         ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity )
 import OccName         ( mkTcOccFS, mkDataOccFS, mkTupleOcc, mkDataConWorkerOcc,
                          tcName, dataName )
 import DataCon         ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity )

@@ -254,7 +255,8 @@ pcDataConWithFixity declared_infix dc_name tyvars arg_tys tycon
                (mkDataConIds bogus_wrap_name wrk_name data_con)
                
 
                (mkDataConIds bogus_wrap_name wrk_name data_con)
                
 

-    modu      = nameModule dc_name
+    modu     = ASSERT( isExternalName dc_name ) 
+              nameModule dc_name

     wrk_occ  = mkDataConWorkerOcc (nameOccName dc_name)
     wrk_key  = incrUnique (nameUnique dc_name)
     wrk_name = mkWiredInName modu wrk_occ wrk_key
     wrk_occ  = mkDataConWorkerOcc (nameOccName dc_name)
     wrk_key  = incrUnique (nameUnique dc_name)
     wrk_name = mkWiredInName modu wrk_occ wrk_key

diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index f29b06f..68286b7 100644 (file)
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -1006,7 +1006,7 @@ finishWarnings dflags mod_warn tcg_env
                      (parens imp_msg) <> colon,
                      (ppr deprec_txt) ])
        where
                      (parens imp_msg) <> colon,
                      (ppr deprec_txt) ])
        where

-         name_mod = nameModule name
+         name_mod = ASSERT2( isExternalName name, ppr name ) nameModule name

          imp_mod  = importSpecModule imp_spec
          imp_msg  = ptext (sLit "imported from") <+> ppr imp_mod <> extra
          extra | imp_mod == moduleName name_mod = empty
          imp_mod  = importSpecModule imp_spec
          imp_msg  = ptext (sLit "imported from") <+> ppr imp_mod <> extra
          extra | imp_mod == moduleName name_mod = empty

@@ -1024,7 +1024,7 @@ lookupImpDeprec :: DynFlags -> HomePackageTable -> PackageIfaceTable
                -> GlobalRdrElt -> Maybe WarningTxt
 -- The name is definitely imported, so look in HPT, PIT
 lookupImpDeprec dflags hpt pit gre
                -> GlobalRdrElt -> Maybe WarningTxt
 -- The name is definitely imported, so look in HPT, PIT
 lookupImpDeprec dflags hpt pit gre

-  = case lookupIfaceByModule dflags hpt pit (nameModule name) of
+  = case lookupIfaceByModule dflags hpt pit mod of

        Just iface -> mi_warn_fn iface name `mplus`     -- Bleat if the thing, *or
                      case gre_par gre of       
                        ParentIs p -> mi_warn_fn iface p        -- its parent*, is warn'd
        Just iface -> mi_warn_fn iface name `mplus`     -- Bleat if the thing, *or
                      case gre_par gre of       
                        ParentIs p -> mi_warn_fn iface p        -- its parent*, is warn'd

@@ -1032,7 +1032,8 @@ lookupImpDeprec dflags hpt pit gre
 
        Nothing -> Nothing      -- See Note [Used names with interface not loaded]
   where
 
        Nothing -> Nothing      -- See Note [Used names with interface not loaded]
   where

-       name = gre_name gre
+    name = gre_name gre
+    mod = ASSERT2( isExternalName name, ppr name ) nameModule name

 \end{code}
 
 Note [Used names with interface not loaded]
 \end{code}
 
 Note [Used names with interface not loaded]

@@ -1343,7 +1344,7 @@ printMinimalImports imps
        where
          all_used avail_occs = all (`elem` map nameOccName ns) avail_occs
          doc = text "Compute minimal imports from" <+> ppr n
        where
          all_used avail_occs = all (`elem` map nameOccName ns) avail_occs
          doc = text "Compute minimal imports from" <+> ppr n

-         n_mod = nameModule n
+         n_mod = ASSERT( isExternalName n ) nameModule n

 \end{code}
 
 
 \end{code}
 
 

diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index 47629db..b5eeff0 100644 (file)
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -859,7 +859,8 @@ record_dfun_usage :: Id -> TcRn ()
 record_dfun_usage dfun_id 
   = do { hsc_env <- getTopEnv
        ; let  dfun_name = idName dfun_id
 record_dfun_usage dfun_id 
   = do { hsc_env <- getTopEnv
        ; let  dfun_name = idName dfun_id

-              dfun_mod  = nameModule dfun_name
+              dfun_mod  = ASSERT( isExternalName dfun_name ) 
+                          nameModule dfun_name

        ; if isInternalName dfun_name ||    -- Internal name => defined in this module
             modulePackageId dfun_mod /= thisPackage (hsc_dflags hsc_env)
          then return () -- internal, or in another package
        ; if isInternalName dfun_name ||    -- Internal name => defined in this module
             modulePackageId dfun_mod /= thisPackage (hsc_dflags hsc_env)
          then return () -- internal, or in another package

diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index 55e0975..7139fa8 100644 (file)
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -940,7 +940,7 @@ reifyName thing
        -- have free variables, we may need to generate NameL's for them.
   where
     name    = getName thing
        -- have free variables, we may need to generate NameL's for them.
   where
     name    = getName thing

-    mod     = nameModule name
+    mod     = ASSERT( isExternalName name ) nameModule name

     pkg_str = packageIdString (modulePackageId mod)
     mod_str = moduleNameString (moduleName mod)
     occ_str = occNameString occ
     pkg_str = packageIdString (modulePackageId mod)
     mod_str = moduleNameString (moduleName mod)
     occ_str = occNameString occ

diff --git a/compiler/types/Generics.lhs b/compiler/types/Generics.lhs
index c0fb4fc..01632d3 100644 (file)
--- a/compiler/types/Generics.lhs
+++ b/compiler/types/Generics.lhs
@@ -398,7 +398,7 @@ mkGenericNames tycon
   where
     tc_name  = tyConName tycon
     tc_occ   = nameOccName tc_name
   where
     tc_name  = tyConName tycon
     tc_occ   = nameOccName tc_name

-    tc_mod   = nameModule tc_name
+    tc_mod   = ASSERT( isExternalName tc_name ) nameModule tc_name

     from_RDR = mkOrig tc_mod (mkGenOcc1 tc_occ)
     to_RDR   = mkOrig tc_mod (mkGenOcc2 tc_occ)
 \end{code}
     from_RDR = mkOrig tc_mod (mkGenOcc1 tc_occ)
     to_RDR   = mkOrig tc_mod (mkGenOcc2 tc_occ)
 \end{code}