X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FLoadIface.lhs;h=50fa9335820af94e17b20cb87e390b402b589ef6;hp=ec41e75401351b69b4cfd97346061474ee2688e8;hb=66579ff945831c5fc9a17c58c722ff01f2268d76;hpb=c97ae5d4900e5807fe0c8a198a3cad326f2d19c3

diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index ec41e75..50fa933 100644
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -51,6 +51,7 @@ import BinIface
 import Panic
 import Util
 import FastString
+import Fingerprint
 
 import Control.Monad
 import Data.List
@@ -69,15 +70,20 @@ import Data.Maybe
 \begin{code}
 -- | Load the interface corresponding to an @import@ directive in 
 -- source code.  On a failure, fail in the monad with an error message.
-loadSrcInterface :: SDoc -> ModuleName -> IsBootInterface -> RnM ModIface
-loadSrcInterface doc mod want_boot  = do 	
+loadSrcInterface :: SDoc
+                 -> ModuleName
+                 -> IsBootInterface     -- {-# SOURCE #-} ?
+                 -> Maybe FastString    -- "package", if any
+                 -> RnM ModIface
+
+loadSrcInterface doc mod want_boot maybe_pkg  = do
   -- We must first find which Module this import refers to.  This involves
   -- calling the Finder, which as a side effect will search the filesystem
   -- and create a ModLocation.  If successful, loadIface will read the
   -- interface; it will call the Finder again, but the ModLocation will be
   -- cached from the first search.
   hsc_env <- getTopEnv
-  res <- liftIO $ findImportedModule hsc_env mod Nothing
+  res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
   case res of
     Found _ mod -> do
       mb_iface <- initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
@@ -114,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,
@@ -323,7 +330,7 @@ addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
 addDeclsToPTE pte things = extendNameEnvList pte things
 
 loadDecls :: Bool
-	  -> [(Version, IfaceDecl)]
+	  -> [(Fingerprint, IfaceDecl)]
 	  -> IfL [(Name,TyThing)]
 loadDecls ignore_prags ver_decls
    = do { mod <- getIfModule
@@ -333,7 +340,7 @@ loadDecls ignore_prags ver_decls
 
 loadDecl :: Bool		    -- Don't load pragmas into the decl pool
 	 -> Module
-	  -> (Version, IfaceDecl)
+	  -> (Fingerprint, IfaceDecl)
 	  -> IfL [(Name,TyThing)]   -- The list can be poked eagerly, but the
 				    -- TyThings are forkM'd thunks
 loadDecl ignore_prags mod (_version, decl)
@@ -407,7 +414,7 @@ loadDecl ignore_prags mod (_version, decl)
         -- All a bit too finely-balanced for my liking.
 
         -- This mini-env and lookup function mediates between the
-        -- *Name*s n and the map from *OccName*s to the implicit TyThings
+        --'Name's n and the map from 'OccName's to the implicit TyThings
 	; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
 	      lookup n = case lookupOccEnv mini_env (getOccName n) of
 			   Just thing -> thing
@@ -616,13 +623,16 @@ pprModIface :: ModIface -> SDoc
 -- Show a ModIface
 pprModIface iface
  = vcat [ ptext (sLit "interface")
-		<+> ppr (mi_module iface) <+> pp_boot 
-		<+> ppr (mi_mod_vers iface) <+> pp_sub_vers
+		<+> ppr (mi_module iface) <+> pp_boot
 		<+> (if mi_orphan iface then ptext (sLit "[orphan module]") else empty)
 		<+> (if mi_finsts iface then ptext (sLit "[family instance module]") else empty)
 		<+> (if mi_hpc    iface then ptext (sLit "[hpc]") else empty)
 		<+> integer opt_HiVersion
-		<+> ptext (sLit "where")
+        , nest 2 (text "interface hash:" <+> ppr (mi_iface_hash iface))
+        , nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash iface))
+        , nest 2 (text "export-list hash:" <+> ppr (mi_exp_hash iface))
+        , nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash iface))
+        , nest 2 (ptext (sLit "where"))
 	, vcat (map pprExport (mi_exports iface))
 	, pprDeps (mi_deps iface)
 	, vcat (map pprUsage (mi_usages iface))
@@ -632,17 +642,11 @@ pprModIface iface
 	, vcat (map ppr (mi_fam_insts iface))
 	, vcat (map ppr (mi_rules iface))
         , pprVectInfo (mi_vect_info iface)
-	, pprDeprecs (mi_deprecs iface)
+	, ppr (mi_warns iface)
  	]
   where
     pp_boot | mi_boot iface = ptext (sLit "[boot]")
 	    | otherwise     = empty
-
-    exp_vers  = mi_exp_vers iface
-    rule_vers = mi_rule_vers iface
-
-    pp_sub_vers | exp_vers == initialVersion && rule_vers == initialVersion = empty
-		| otherwise = brackets (ppr exp_vers <+> ppr rule_vers)
 \end{code}
 
 When printing export lists, we print like this:
@@ -666,16 +670,16 @@ pprExport (mod, items)
     pp_export names = braces (hsep (map ppr names))
 
 pprUsage :: Usage -> SDoc
-pprUsage usage
-  = hsep [ptext (sLit "import"), ppr (usg_name usage), 
-	  int (usg_mod usage), 
-	  pp_export_version (usg_exports usage),
-	  int (usg_rules usage),
-	  pp_versions (usg_entities usage) ]
-  where
-    pp_versions nvs = hsep [ ppr n <+> int v | (n,v) <- nvs ]
-    pp_export_version Nothing  = empty
-    pp_export_version (Just v) = int v
+pprUsage usage@UsagePackageModule{}
+  = hsep [ptext (sLit "import"), ppr (usg_mod usage), 
+	  ppr (usg_mod_hash usage)]
+pprUsage usage@UsageHomeModule{}
+  = hsep [ptext (sLit "import"), ppr (usg_mod_name usage), 
+	  ppr (usg_mod_hash usage)] $$
+    nest 2 (
+	maybe empty (\v -> text "exports: " <> ppr v) (usg_exports usage) $$
+        vcat [ ppr n <+> ppr v | (n,v) <- usg_entities usage ]
+        )
 
 pprDeps :: Dependencies -> SDoc
 pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
@@ -690,13 +694,9 @@ pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
     ppr_boot True  = text "[boot]"
     ppr_boot False = empty
 
-pprIfaceDecl :: (Version, IfaceDecl) -> SDoc
+pprIfaceDecl :: (Fingerprint, IfaceDecl) -> SDoc
 pprIfaceDecl (ver, decl)
-  = ppr_vers ver <+> ppr decl
-  where
-	-- Print the version for the decl
-    ppr_vers v | v == initialVersion = empty
-	       | otherwise	     = int v
+  = ppr ver $$ nest 2 (ppr decl)
 
 pprFixities :: [(OccName, Fixity)] -> SDoc
 pprFixities []    = empty
@@ -715,12 +715,15 @@ pprVectInfo (IfaceVectInfo { ifaceVectInfoVar        = vars
   , ptext (sLit "vectorised reused tycons:") <+> hsep (map ppr tyconsReuse)
   ]
 
-pprDeprecs :: Deprecations -> SDoc
-pprDeprecs NoDeprecs	    = empty
-pprDeprecs (DeprecAll txt)  = ptext (sLit "Deprecate all") <+> doubleQuotes (ftext txt)
-pprDeprecs (DeprecSome prs) = ptext (sLit "Deprecate") <+> vcat (map pprDeprec prs)
-			    where
-			      pprDeprec (name, txt) = ppr name <+> doubleQuotes (ftext txt)
+instance Outputable Warnings where
+    ppr = pprWarns
+
+pprWarns :: Warnings -> SDoc
+pprWarns NoWarnings	    = empty
+pprWarns (WarnAll txt)  = ptext (sLit "Warn all") <+> ppr txt
+pprWarns (WarnSome prs) = ptext (sLit "Warnings")
+                        <+> vcat (map pprWarning prs)
+    where pprWarning (name, txt) = ppr name <+> ppr txt
 \end{code}