[project @ 2003-11-06 17:09:50 by simonpj]

[ghc-hetmet.git] / ghc / compiler / iface / LoadIface.lhs

diff --git a/ghc/compiler/iface/LoadIface.lhs b/ghc/compiler/iface/LoadIface.lhs
index bbdc6b2..74f41b0 100644 (file)
--- a/ghc/compiler/iface/LoadIface.lhs
+++ b/ghc/compiler/iface/LoadIface.lhs
@@ -29,7 +29,7 @@ import HscTypes               ( HscEnv(..), ModIface(..), emptyModIface,
                          lookupIfaceByModName, emptyPackageIfaceTable,
                          IsBootInterface, mkIfaceFixCache, 
                          Pool(..), DeclPool, InstPool, 
-                         RulePool, Gated, addRuleToPool
+                         RulePool, addRuleToPool, RulePoolContents
                         )
 
 import BasicTypes      ( Version, Fixity(..), FixityDirection(..) )
@@ -171,14 +171,13 @@ loadInterface doc_str mod_name from
                -> returnM (Right iface) ;      -- Already loaded
                        -- The (src_imp == mi_boot iface) test checks that the already-loaded
                        -- interface isn't a boot iface.  This can conceivably happen,
-                       -- if an earlier import had a 
-                       -- before we got to real imports.   I think.
+                       -- if an earlier import had a before we got to real imports.   I think.
            other -> do
 
        { if_gbl_env <- getGblEnv
        ; let { hi_boot_file = case from of
                                ImportByUser usr_boot -> usr_boot
-                               ImportBySystem  -> sys_boot
+                               ImportBySystem        -> sys_boot
 
              ; mb_dep   = lookupModuleEnvByName (if_is_boot if_gbl_env) mod_name
              ; sys_boot = case mb_dep of
@@ -209,7 +208,7 @@ loadInterface doc_str mod_name from
        WARN(   case from of { ImportBySystem -> True; other -> False } &&
                not (isJust mb_dep) && 
                isHomeModule mod,
-               ppr mod )
+               ppr mod $$ ppr mb_dep)
 
        initIfaceLcl (moduleName mod) $ do
        --      Load the new ModIface into the External Package State
@@ -281,8 +280,9 @@ loadDecl ignore_prags mod decls_map (_version, decl)
     mk_new_bndr mb_parent occ = newGlobalBinder mod occ mb_parent loc
     loc = importedSrcLoc (moduleUserString mod)
 
-zapIdInfo decl@(IfaceId { ifIdInfo = HasInfo _ }) = decl { ifIdInfo = DiscardedInfo }
-zapIdInfo decl                                           = decl
+zapIdInfo decl@(IfaceId {ifIdInfo = HasInfo _}) = decl { ifIdInfo = DiscardedInfo }
+zapIdInfo decl                                         = decl
+       -- Don't alter "NoInfo", just "HasInfo"
 
 -----------------
 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
@@ -307,8 +307,8 @@ ifaceDeclSubBndrs (IfaceData {ifCons = DataCons cons})
 ifaceDeclSubBndrs other = []
 
 conDeclBndrs (IfaceConDecl con_occ _ _ _ _ fields)
-  = [con_occ, mkDataConWrapperOcc con_occ, mkDataConWorkerOcc con_occ]
-    ++ fields
+  = fields ++ 
+    [con_occ, mkDataConWrapperOcc con_occ, mkDataConWorkerOcc con_occ]
 
 
 -----------------------------------------------------
@@ -370,7 +370,7 @@ loadRules mod pool@(Pool rule_pool n_in n_out) rules
        { new_pool <- foldlM (loadRule (moduleName mod)) rule_pool rules
        ; returnM (Pool new_pool (n_in + length rules) n_out) } }
 
-loadRule :: ModuleName -> NameEnv [Gated IfaceRule] -> IfaceRule -> IfL (NameEnv [Gated IfaceRule])
+loadRule :: ModuleName -> RulePoolContents -> IfaceRule -> IfL RulePoolContents
 -- "Gate" the rule simply by a crude notion of the free vars of
 -- the LHS.  It can be crude, because having too few free vars is safe.
 loadRule mod_name pool decl@(IfaceRule {ifRuleHead = fn, ifRuleArgs = args})
@@ -589,9 +589,9 @@ initExternalPackageState
       eps_PTE        = emptyTypeEnv,
       eps_inst_env   = emptyInstEnv,
       eps_rule_base  = emptyRuleBase,
-      eps_decls      = emptyPool,
-      eps_insts      = emptyPool,
-      eps_rules = foldr add emptyPool builtinRules
+      eps_decls      = emptyPool emptyNameEnv,
+      eps_insts      = emptyPool emptyNameEnv,
+      eps_rules      = foldr add (emptyPool []) builtinRules
     }
   where
        -- Initialise the EPS rule pool with the built-in rules
@@ -639,7 +639,7 @@ ifaceStats eps
 
     Pool _ n_decls_in n_decls_out = eps_decls eps
     Pool _ n_insts_in n_insts_out = eps_insts eps
-    Pool _ n_rules_in n_rules_out  = eps_rules eps
+    Pool _ n_rules_in n_rules_out = eps_rules eps
     
     stats = vcat 
        [int n_mods <+> text "interfaces read",