X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=07c75684970a93380f64b97c3738bbed0a4e7941;hb=fc85319dfd71f7a642c1858fcdfa4b3d2a10acda;hp=7aacf9574bbc7ad86c98184d9f77cc9e82d6c175;hpb=8102af4eac807ae4956a79b27f03fd890f8294c6;p=ghc-hetmet.git

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 7aacf95..07c7568 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -14,6 +14,7 @@ module HscTypes (
 
 	ModDetails(..),	emptyModDetails,
 	ModGuts(..), CoreModule(..), CgGuts(..), ModImports(..), ForeignStubs(..),
+        ImportedMods,
 
 	ModSummary(..), ms_mod_name, showModMsg, isBootSummary,
 	msHsFilePath, msHiFilePath, msObjFilePath, 
@@ -95,7 +96,7 @@ import Type
 
 import Class		( Class, classSelIds, classATs, classTyCon )
 import TyCon
-import DataCon		( DataCon, dataConImplicitIds )
+import DataCon		( DataCon, dataConImplicitIds, dataConWrapId )
 import PrelNames	( gHC_PRIM )
 import Packages hiding ( Version(..) )
 import DynFlags		( DynFlags(..), isOneShot, HscTarget (..) )
@@ -105,19 +106,21 @@ import BasicTypes	( Version, initialVersion, IPName,
 import IfaceSyn
 import FiniteMap	( FiniteMap )
 import CoreSyn		( CoreRule )
-import Maybes		( orElse, expectJust, catMaybes, seqMaybe )
+import Maybes		( orElse, expectJust, catMaybes )
 import Outputable
 import BreakArray
 import SrcLoc		( SrcSpan, Located )
-import UniqFM		( lookupUFM, eltsUFM, emptyUFM )
+import LazyUniqFM		( lookupUFM, eltsUFM, emptyUFM )
 import UniqSupply	( UniqSupply )
 import FastString	( FastString )
 import StringBuffer	( StringBuffer )
 
+import System.FilePath
 import System.Time	( ClockTime )
 import Data.IORef
 import Data.Array       ( Array, array )
 import Data.List
+import Control.Monad    ( mplus )
 \end{code}
 
 
@@ -275,7 +278,7 @@ lookupIfaceByModule dflags hpt pit mod
 	-- in the HPT.  If it's not from the home package it's wrong to look
 	-- in the HPT, because the HPT is indexed by *ModuleName* not Module
     fmap hm_iface (lookupUFM hpt (moduleName mod)) 
-    `seqMaybe` lookupModuleEnv pit mod
+    `mplus` lookupModuleEnv pit mod
 
   | otherwise = lookupModuleEnv pit mod		-- Look in PIT only 
 
@@ -283,7 +286,7 @@ lookupIfaceByModule dflags hpt pit mod
 -- (a) In OneShot mode, even home-package modules accumulate in the PIT
 -- (b) Even in Batch (--make) mode, there is *one* case where a home-package
 --     module is in the PIT, namely GHC.Prim when compiling the base package.
--- We could eliminate (b) if we wanted, by making GHC.Prim belong to a packake
+-- We could eliminate (b) if we wanted, by making GHC.Prim belong to a package
 -- of its own, but it doesn't seem worth the bother.
 \end{code}
 
@@ -509,6 +512,8 @@ emptyModDetails = ModDetails { md_types = emptyTypeEnv,
 -- being compiled right now.  Once it is compiled, a ModIface and 
 -- ModDetails are extracted and the ModGuts is dicarded.
 
+type ImportedMods = ModuleEnv (Module, [(ModuleName, Bool, SrcSpan)])
+
 data ModGuts
   = ModGuts {
         mg_module    :: !Module,
@@ -516,9 +521,9 @@ data ModGuts
 	mg_exports   :: ![AvailInfo],	 -- What it exports
 	mg_deps	     :: !Dependencies,	 -- What is below it, directly or
 					 --   otherwise 
-	mg_dir_imps  :: ![Module],	 -- Directly-imported modules; used to
+	mg_dir_imps  :: !ImportedMods,	 -- Directly-imported modules; used to
 					 --	generate initialisation code
-	mg_usages    :: ![Usage],	 -- Version info for what it needed
+	mg_used_names:: !NameSet,	 -- What it needed (used in mkIface)
 
         mg_rdr_env   :: !GlobalRdrEnv,	 -- Top-level lexical environment
 
@@ -557,7 +562,9 @@ data CoreModule
       -- Type environment for types declared in this module
       cm_types    :: !TypeEnv,
       -- Declarations
-      cm_binds    :: [CoreBind]
+      cm_binds    :: [CoreBind],
+      -- Imports
+      cm_imports  :: ![Module]
     }
 
 instance Outputable CoreModule where
@@ -956,8 +963,9 @@ tyThingDataCon (ADataCon dc) = dc
 tyThingDataCon other	     = pprPanic "tyThingDataCon" (pprTyThing other)
 
 tyThingId :: TyThing -> Id
-tyThingId (AnId id) = id
-tyThingId other     = pprPanic "tyThingId" (pprTyThing other)
+tyThingId (AnId id)     = id
+tyThingId (ADataCon dc) = dataConWrapId dc
+tyThingId other         = pprPanic "tyThingId" (pprTyThing other)
 \end{code}
 
 %************************************************************************
@@ -1336,14 +1344,15 @@ instance Outputable ModSummary where
 
 showModMsg :: HscTarget -> Bool -> ModSummary -> String
 showModMsg target recomp mod_summary
-  = showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
-	            char '(', text (msHsFilePath mod_summary) <> comma,
-		    case target of
-                      HscInterpreted | recomp 
-                                 -> text "interpreted"
-                      HscNothing -> text "nothing"
-                      _other     -> text (msObjFilePath mod_summary),
-		    char ')'])
+  = showSDoc $
+        hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
+              char '(', text (normalise $ msHsFilePath mod_summary) <> comma,
+              case target of
+                  HscInterpreted | recomp 
+                             -> text "interpreted"
+                  HscNothing -> text "nothing"
+                  _          -> text (normalise $ msObjFilePath mod_summary),
+              char ')']
  where 
     mod     = moduleName (ms_mod mod_summary)
     mod_str = showSDoc (ppr mod) ++ hscSourceString (ms_hsc_src mod_summary)
@@ -1478,7 +1487,9 @@ data Unlinked
    | BCOs CompiledByteCode ModBreaks
 
 #ifndef GHCI
-data CompiledByteCode
+data CompiledByteCode = CompiledByteCodeUndefined
+_unused :: CompiledByteCode
+_unused = CompiledByteCodeUndefined
 #endif
 
 instance Outputable Unlinked where