X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FLoadIface.lhs;h=97acc5226ac75bb8154a9fa5c81ce91d4f282e82;hp=1412b0005b288fa9d618eec1cdbee8486eeca144;hb=c5b178be60a5a44abd2f4ddf8c399857678326e2;hpb=703ca1542c8e0983cc9d8eebce6e9f3dd3fd71e2

diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index 1412b00..97acc52 100644
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -31,7 +31,7 @@ import TcRnMonad
 
 import PrelNames
 import PrelInfo
-import PrelRules
+import MkId	( seqId )
 import Rules
 import Annotations
 import InstEnv
@@ -42,7 +42,7 @@ import Module
 import Maybes
 import ErrUtils
 import Finder
-import LazyUniqFM
+import UniqFM
 import StaticFlags
 import Outputable
 import BinIface
@@ -191,19 +191,10 @@ loadInterface doc_str mod from
 			-- if an earlier import had a before we got to real imports.   I think.
 	    _ -> do {
 
-          let { hi_boot_file = case from of
-				ImportByUser usr_boot -> usr_boot
-				ImportBySystem        -> sys_boot
-
-	      ; mb_dep   = lookupUFM (eps_is_boot eps) (moduleName mod)
-	      ; sys_boot = case mb_dep of
-				Just (_, is_boot) -> is_boot
-				Nothing		  -> False
-			-- The boot-ness of the requested interface, 
-	      }		-- based on the dependencies in directly-imported modules
-
 	-- READ THE MODULE IN
-	; read_result <- findAndReadIface doc_str mod hi_boot_file
+	; read_result <- case (wantHiBootFile dflags eps mod from) of
+                           Failed err             -> return (Failed err)
+                           Succeeded hi_boot_file -> findAndReadIface doc_str mod hi_boot_file
 	; case read_result of {
 	    Failed err -> do
 	  	{ let fake_iface = emptyModIface mod
@@ -266,6 +257,7 @@ loadInterface doc_str mod from
                }
 
 	; updateEps_  $ \ eps -> 
+           if elemModuleEnv mod (eps_PIT eps) then eps else
 	    eps { 
 	      eps_PIT          = extendModuleEnv (eps_PIT eps) mod final_iface,
 	      eps_PTE          = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
@@ -296,6 +288,38 @@ loadInterface doc_str mod from
 	; return (Succeeded final_iface)
     }}}}
 
+wantHiBootFile :: DynFlags -> ExternalPackageState -> Module -> WhereFrom
+	       -> MaybeErr Message IsBootInterface
+-- Figure out whether we want Foo.hi or Foo.hi-boot
+wantHiBootFile dflags eps mod from
+  = case from of
+       ImportByUser usr_boot 
+          | usr_boot && not this_package
+          -> Failed (badSourceImport mod)
+          | otherwise -> Succeeded usr_boot
+
+       ImportBySystem
+          | not this_package   -- If the module to be imported is not from this package
+          -> Succeeded False   -- don't look it up in eps_is_boot, because that is keyed
+                               -- on the ModuleName of *home-package* modules only. 
+                               -- We never import boot modules from other packages!
+
+          | otherwise
+          -> case lookupUFM (eps_is_boot eps) (moduleName mod) of
+		Just (_, is_boot) -> Succeeded is_boot
+                Nothing	          -> Succeeded False
+		     -- The boot-ness of the requested interface, 
+	      	     -- based on the dependencies in directly-imported modules
+  where
+    this_package = thisPackage dflags == modulePackageId mod
+
+badSourceImport :: Module -> SDoc
+badSourceImport mod
+  = hang (ptext (sLit "You cannot {-# SOURCE #-} import a module from another package"))
+       2 (ptext (sLit "but") <+> quotes (ppr mod) <+> ptext (sLit "is from package")
+          <+> quotes (ppr (modulePackageId mod)))
+\end{code}
+
 {-
 Used to be used for the loadInterface sanity check on system imports. That has been removed, but I'm leaving this in pending
 review of this decision by SPJ - MCB 10/2008
@@ -307,6 +331,7 @@ badDepMsg mod
 	       ptext (sLit "but is not listed in the dependencies of the interfaces directly imported by the module being compiled")])
 -}
 
+\begin{code}
 -----------------------------------------------------
 --	Loading type/class/value decls
 -- We pass the full Module name here, replete with
@@ -704,14 +729,18 @@ pprFixities fixes = ptext (sLit "fixities") <+> pprWithCommas pprFix fixes
 		    pprFix (occ,fix) = ppr fix <+> ppr occ 
 
 pprVectInfo :: IfaceVectInfo -> SDoc
-pprVectInfo (IfaceVectInfo { ifaceVectInfoVar        = vars
-                           , ifaceVectInfoTyCon      = tycons
-                           , ifaceVectInfoTyConReuse = tyconsReuse
+pprVectInfo (IfaceVectInfo { ifaceVectInfoVar          = vars
+                           , ifaceVectInfoTyCon        = tycons
+                           , ifaceVectInfoTyConReuse   = tyconsReuse
+                           , ifaceVectInfoScalarVars   = scalarVars
+                           , ifaceVectInfoScalarTyCons = scalarTyCons
                            }) = 
   vcat 
   [ ptext (sLit "vectorised variables:") <+> hsep (map ppr vars)
   , ptext (sLit "vectorised tycons:") <+> hsep (map ppr tycons)
   , ptext (sLit "vectorised reused tycons:") <+> hsep (map ppr tyconsReuse)
+  , ptext (sLit "scalar variables:") <+> hsep (map ppr scalarVars)
+  , ptext (sLit "scalar tycons:") <+> hsep (map ppr scalarTyCons)
   ]
 
 instance Outputable Warnings where