Add ASSERTs to all calls of nameModule

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

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
-        mod  = nameModule name
+        mod  = ASSERT( isExternalName name ) nameModule name
 \end{code}
 
 \begin{code}

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 (Exact n)    ns = Orig (nameModule n)
+setRdrNameSpace (Exact n)    ns = ASSERT( isExternalName n ) 
+		       	          Orig (nameModule n)
 				       (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
-  = 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
@@ -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
-	  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, 

compiler/deSugar/DsMeta.hs

@@ -28,6 +28,8 @@ module DsMeta( dsBracket,
 	       quoteExpName, quotePatName
 	        ) where
 
+#include "HsVersions.h"
+
 import {-# SOURCE #-}	DsExpr ( dsExpr )
 
 import MatchLit
@@ -949,7 +951,7 @@ globalVar name
 	; 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

compiler/ghci/ByteCodeLink.lhs

@@ -265,7 +265,7 @@ nameToCLabel n suffix
         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)))

compiler/ghci/InteractiveUI.hs

@@ -1088,7 +1088,8 @@ checkModule m = do
 	   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)
@@ -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 
-                (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.
@@ -1896,7 +1898,7 @@ wantNameFromInterpretedModule noCanDo str and_then =
    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"
@@ -2068,7 +2070,8 @@ breakSwitch (arg1:rest)
         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)
@@ -2215,7 +2218,8 @@ list2 [arg] = 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

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
-  let mod = nameModule name
+  let mod = ASSERT2( isExternalName name, ppr name ) nameModule name
   put_ bh (modulePackageId mod, moduleName mod, nameOccName name)
 
 

compiler/iface/IfaceEnv.lhs

@@ -212,7 +212,8 @@ lookupOrigNameCache nc mod occ	-- The normal case
 
 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

compiler/iface/LoadIface.lhs

@@ -120,7 +120,8 @@ loadInterfaceForName doc name
         { 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,

compiler/iface/MkIface.lhs

@@ -370,7 +370,7 @@ mkHashFun
 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)
@@ -411,8 +411,9 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
 	       , let out = localOccs $ freeNamesDeclABI abi
                ]
 
+       name_module n = ASSERT( isExternalName n ) nameModule n
        localOccs = map (getUnique . getParent . getOccName) 
-                        . filter ((== this_mod) . nameModule)
+                        . filter ((== this_mod) . name_module)
                         . 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
-          = 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" 
@@ -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 ()
-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 
@@ -927,10 +929,12 @@ mkIfaceExports exports
 	--     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)
-      = 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)
@@ -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
-    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

compiler/iface/TcIface.lhs

@@ -127,7 +127,8 @@ checkWiredInTyCon tc
   = 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
@@ -144,7 +145,8 @@ importDecl name
     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
@@ -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
-	; unless (mod == nameModule name)
+	; ASSERT2( isExternalName name, ppr name ) 
+	  unless (mod == nameModule name)
 		 (loadWiredInHomeIface name) }
 
 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon

compiler/main/HscTypes.lhs

@@ -105,7 +105,7 @@ import {-# SOURCE #-}  InteractiveEval ( Resume )
 #endif
 
 import RdrName
-import Name		( Name, NamedThing, getName, nameOccName, nameModule )
+import Name
 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
-	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)
@@ -1330,7 +1330,7 @@ lookupType dflags hpt 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

compiler/prelude/TysWiredIn.lhs

@@ -56,6 +56,8 @@ module TysWiredIn (
 	parrTyCon_RDR, parrTyConName
     ) where
 
+#include "HsVersions.h"
+
 import {-# SOURCE #-} MkId( mkDataConIds )
 
 -- friends:
@@ -66,8 +68,7 @@ import TysPrim
 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 )
@@ -254,7 +255,8 @@ pcDataConWithFixity declared_infix dc_name tyvars arg_tys tycon
 		(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

compiler/rename/RnNames.lhs

@@ -1006,7 +1006,7 @@ finishWarnings dflags mod_warn tcg_env
 		      (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
@@ -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
-  = 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
@@ -1032,7 +1032,8 @@ lookupImpDeprec dflags hpt pit gre
 
 	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]
@@ -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
-	  n_mod = nameModule n
+	  n_mod = ASSERT( isExternalName n ) nameModule n
 \end{code}
 
 

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
-	       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

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
-    mod     = nameModule name
+    mod     = ASSERT( isExternalName name ) nameModule name
     pkg_str = packageIdString (modulePackageId mod)
     mod_str = moduleNameString (moduleName mod)
     occ_str = occNameString occ

compiler/types/Generics.lhs

@@ -398,7 +398,7 @@ mkGenericNames tycon
   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}