[project @ 2005-02-14 13:27:52 by simonmar]

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

diff --git a/ghc/compiler/iface/MkIface.lhs b/ghc/compiler/iface/MkIface.lhs
index 8fa008f..354e31e 100644 (file)
--- a/ghc/compiler/iface/MkIface.lhs
+++ b/ghc/compiler/iface/MkIface.lhs
@@ -4,7 +4,7 @@
 
 \begin{code}
 module MkIface ( 
-       showIface,      -- Print the iface in Foo.hi
+       pprModIface, showIface,         -- Print the iface in Foo.hi
 
        mkUsageInfo,    -- Construct the usage info for a module
 
@@ -189,6 +189,7 @@ import HscTypes             ( ModIface(..), TyThing(..),
                          ModGuts(..), ModGuts, IfaceExport,
                          GhciMode(..), HscEnv(..), hscEPS,
                          Dependencies(..), FixItem(..), 
+                         ModSummary(..), msHiFilePath, 
                          mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
                          typeEnvElts, 
                          GenAvailInfo(..), availName, 
@@ -258,16 +259,19 @@ mkIface :: HscEnv
 
 mkIface hsc_env location maybe_old_iface 
        guts@ModGuts{ mg_module = this_mod,
+                     mg_boot   = is_boot,
                      mg_usages = usages,
                      mg_deps   = deps,
                      mg_exports = exports,
+                     mg_rdr_env = rdr_env,
                      mg_fix_env = fix_env,
                      mg_deprecs = src_deprecs,
                      mg_insts = insts, 
                      mg_rules = rules,
                      mg_types = type_env }
   = do { eps <- hscEPS hsc_env
-       ; let   { ext_nm = mkExtNameFn hsc_env eps this_mod
+       ; let   { ext_nm_rhs = mkExtNameFn hsc_env eps this_mod
+               ; ext_nm_lhs = mkLhsNameFn this_mod
                ; local_things = [thing | thing <- typeEnvElts type_env,
                                          not (isWiredInName (getName thing)) ]
                        -- Do not export anything about wired-in things
@@ -280,7 +284,7 @@ mkIface hsc_env location maybe_old_iface
                                                 | thing <- local_things
                                                 , not (mustExposeThing exports thing)]
 
-               ; decls  = [ tyThingToIfaceDecl omit_prags abstract_tcs ext_nm thing 
+               ; decls  = [ tyThingToIfaceDecl omit_prags abstract_tcs ext_nm_rhs thing 
                           | thing <- local_things, wantDeclFor exports abstract_tcs thing ]
                                -- Don't put implicit Ids and class tycons in the interface file
 
@@ -289,13 +293,13 @@ mkIface hsc_env location maybe_old_iface
                ; iface_rules 
                     | omit_prags = []
                     | otherwise  = sortLe le_rule $
-                                   map (coreRuleToIfaceRule this_mod ext_nm) rules
-               ; iface_insts = sortLe le_inst (map dfunToIfaceInst insts)
+                                   map (coreRuleToIfaceRule ext_nm_lhs ext_nm_rhs) rules
+               ; iface_insts = sortLe le_inst (map (dfunToIfaceInst ext_nm_lhs) insts)
 
                ; intermediate_iface = ModIface { 
                        mi_module   = this_mod,
                        mi_package  = HomePackage,
-                       mi_boot     = False,
+                       mi_boot     = is_boot,
                        mi_deps     = deps,
                        mi_usages   = usages,
                        mi_exports  = mkIfaceExports exports,
@@ -303,7 +307,8 @@ mkIface hsc_env location maybe_old_iface
                        mi_rules    = iface_rules,
                        mi_fixities = fixities,
                        mi_deprecs  = deprecs,
-       
+                       mi_globals  = Just rdr_env,
+
                        -- Left out deliberately: filled in by addVersionInfo
                        mi_mod_vers  = initialVersion,
                        mi_exp_vers  = initialVersion,
@@ -340,10 +345,10 @@ mkIface hsc_env location maybe_old_iface
      r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
      i1 `le_inst` i2 = ifDFun     i1 <= ifDFun     i2
 
-     dflags    = hsc_dflags hsc_env
-     ghci_mode = hsc_mode hsc_env
+     dflags              = hsc_dflags hsc_env
+     ghci_mode           = hsc_mode hsc_env
+     omit_prags   = dopt Opt_OmitInterfacePragmas dflags
      hi_file_path = ml_hi_file location
-     omit_prags = dopt Opt_OmitInterfacePragmas dflags
 
                                              
 mustExposeThing :: NameSet -> TyThing -> Bool
@@ -419,6 +424,20 @@ mkExtNameFn hsc_env eps this_mod
         iface = lookupIfaceByModule hpt pit mod `orElse` 
                pprPanic "lookupVers2" (ppr mod <+> ppr occ)
 
+
+---------------------
+-- mkLhsNameFn ignores versioning info altogether
+-- It is used for the LHS of instance decls and rules, where we 
+-- there's no point in recording version info
+mkLhsNameFn :: Module -> Name -> IfaceExtName
+mkLhsNameFn this_mod name      
+  | mod == this_mod = LocalTop occ
+  | otherwise      = ExtPkg mod occ
+  where
+    mod = nameModule name
+    occ        = nameOccName name
+
+
 -----------------------------
 -- Compute version numbers for local decls
 
@@ -799,21 +818,20 @@ mkIfaceExports exports
 
 \begin{code}
 checkOldIface :: HscEnv
-             -> Module
-             -> FilePath               -- Where the interface file is
+             -> ModSummary
              -> Bool                   -- Source unchanged
              -> Maybe ModIface         -- Old interface from compilation manager, if any
              -> IO (RecompileRequired, Maybe ModIface)
 
-checkOldIface hsc_env mod iface_path source_unchanged maybe_iface
+checkOldIface hsc_env mod_summary source_unchanged maybe_iface
   = do { showPass (hsc_dflags hsc_env) 
-                  ("Checking old interface for " ++ moduleUserString mod) ;
+                  ("Checking old interface for " ++ moduleUserString (ms_mod mod_summary)) ;
 
        ; initIfaceCheck hsc_env $
-         check_old_iface mod iface_path source_unchanged maybe_iface
+         check_old_iface mod_summary source_unchanged maybe_iface
      }
 
-check_old_iface this_mod iface_path source_unchanged maybe_iface
+check_old_iface mod_summary source_unchanged maybe_iface
  =     -- CHECK WHETHER THE SOURCE HAS CHANGED
     ifM (not source_unchanged)
        (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
@@ -835,7 +853,10 @@ check_old_iface this_mod iface_path source_unchanged maybe_iface
 
        -- Try and read the old interface for the current module
        -- from the .hi file left from the last time we compiled it
-    readIface this_mod iface_path False                `thenM` \ read_result ->
+    let
+       iface_path = msHiFilePath mod_summary
+    in
+    readIface (ms_mod mod_summary) iface_path False    `thenM` \ read_result ->
     case read_result of {
        Failed err ->   -- Old interface file not found, or garbled; give up
                   traceIf (text "FYI: cannot read old interface file:"
@@ -1016,8 +1037,8 @@ pprModIface :: ModIface -> SDoc
 pprModIface iface
  = vcat [ ptext SLIT("interface")
                <+> ppr_package (mi_package iface)
-               <+> ppr (mi_module iface) <+> ppr (mi_mod_vers iface)
-               <+> pp_sub_vers
+               <+> ppr (mi_module iface) <+> pp_boot 
+               <+> ppr (mi_mod_vers iface) <+> pp_sub_vers
                <+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty)
                <+> int opt_HiVersion
                <+> ptext SLIT("where")
@@ -1031,6 +1052,8 @@ pprModIface iface
        , pprDeprecs (mi_deprecs iface)
        ]
   where
+    pp_boot | mi_boot iface = ptext SLIT("[boot]")
+           | otherwise     = empty
     ppr_package HomePackage = empty
     ppr_package (ExtPackage id) = doubleQuotes (ppr id)