[project @ 2000-02-25 14:55:31 by panne]
[ghc-hetmet.git] / ghc / compiler / rename / RnIfaces.lhs
index 2e10d79..52b2a56 100644 (file)
@@ -24,11 +24,11 @@ import HsSyn                ( HsDecl(..), TyClDecl(..), InstDecl(..), IfaceSig(..),
                          HsType(..), ConDecl(..), IE(..), ConDetails(..), Sig(..),
                          ForeignDecl(..), ForKind(..), isDynamic,
                          FixitySig(..), RuleDecl(..),
-                         isClassOpSig
+                         isClassOpSig, Deprecation(..)
                        )
 import BasicTypes      ( Version, NewOrData(..), defaultFixity )
 import RdrHsSyn                ( RdrNameHsDecl, RdrNameInstDecl, RdrNameTyClDecl, RdrNameRuleDecl,
-                         extractHsTyRdrNames
+                         extractHsTyRdrNames, RdrNameDeprecation
                        )
 import RnEnv           ( mkImportedGlobalName, newImportedBinder, mkImportedGlobalFromRdrName,
                          lookupOccRn, lookupImplicitOccRn,
@@ -37,10 +37,10 @@ import RnEnv                ( mkImportedGlobalName, newImportedBinder, mkImportedGlobalFromRdr
                          FreeVars, emptyFVs
                        )
 import RnMonad
-import RnHsSyn          ( RenamedHsDecl )
+import RnHsSyn          ( RenamedHsDecl, RenamedDeprecation )
 import ParseIface      ( parseIface, IfaceStuff(..) )
 
-import FiniteMap       ( FiniteMap, sizeFM, emptyFM, delFromFM,
+import FiniteMap       ( FiniteMap, sizeFM, emptyFM, delFromFM, listToFM,
                          lookupFM, addToFM, addToFM_C, addListToFM, 
                          fmToList, elemFM, foldFM
                        )
@@ -58,7 +58,7 @@ import NameSet
 import Var             ( Id )
 import SrcLoc          ( mkSrcLoc, SrcLoc )
 import PrelMods                ( pREL_GHC )
-import PrelInfo                ( cCallishTyKeys, thinAirModules )
+import PrelInfo                ( cCallishTyKeys )
 import Bag
 import Maybes          ( MaybeErr(..), maybeToBool, orElse )
 import ListSetOps      ( unionLists )
@@ -148,11 +148,16 @@ loadInterface doc_str mod_name from
     let
        rd_decls = pi_decls iface
     in
-    foldlRn (loadDecl mod)          (iDecls ifaces) rd_decls           `thenRn` \ new_decls ->
-    foldlRn (loadInstDecl mod)      (iInsts ifaces) (pi_insts iface)   `thenRn` \ new_insts ->
-    foldlRn (loadRule mod)          (iRules ifaces) (pi_rules iface)   `thenRn` \ new_rules -> 
-    foldlRn (loadFixDecl mod_name)   (iFixes ifaces) rd_decls                  `thenRn` \ new_fixities ->
-    mapRn   (loadExport this_mod_nm) (pi_exports iface)                        `thenRn` \ avails_s ->
+    foldlRn (loadDecl mod)           (iDecls ifaces) rd_decls                  `thenRn` \ new_decls ->
+    foldlRn (loadInstDecl mod)       (iInsts ifaces) (pi_insts iface)          `thenRn` \ new_insts ->
+    (if opt_IgnoreIfacePragmas
+       then returnRn emptyBag
+       else foldlRn (loadRule mod)   (iRules ifaces) (pi_rules iface))         `thenRn` \ new_rules ->
+    (if opt_IgnoreIfacePragmas
+       then returnRn emptyNameEnv
+       else foldlRn (loadDeprec mod) (iDeprecs ifaces) (pi_deprecs iface))     `thenRn` \ new_deprecs ->
+    foldlRn (loadFixDecl mod_name)    (iFixes ifaces) rd_decls                 `thenRn` \ new_fixities ->
+    mapRn   (loadExport this_mod_nm)  (pi_exports iface)                       `thenRn` \ avails_s ->
     let
        -- For an explicit user import, add to mod_map info about
        -- the things the imported module depends on, extracted
@@ -168,8 +173,9 @@ loadInterface doc_str mod_name from
        new_ifaces = ifaces { iImpModInfo = mod_map2,
                              iDecls      = new_decls,
                              iFixes      = new_fixities,
+                             iInsts      = new_insts,
                              iRules      = new_rules,
-                             iInsts      = new_insts }
+                             iDeprecs    = new_deprecs }
     in
     setIfacesRn new_ifaces             `thenRn_`
     returnRn (mod, new_ifaces)
@@ -334,6 +340,17 @@ loadRule mod rules decl@(IfaceRuleDecl var body src_loc)
   = setModuleRn (moduleName mod) $
     mkImportedGlobalFromRdrName var            `thenRn` \ var_name ->
     returnRn ((unitNameSet var_name, (mod, RuleD decl)) `consBag` rules)
+
+-- SUP: TEMPORARY HACK, ignoring module deprecations and constructors for now
+loadDeprec :: Module -> DeprecationEnv -> RdrNameDeprecation -> RnM d DeprecationEnv
+loadDeprec mod deprec_env (Deprecation (IEModuleContents _) txt)
+  = traceRn (text "module deprecation not yet implemented:" <+> ppr mod <> colon <+> ppr txt) `thenRn_`
+    returnRn deprec_env
+loadDeprec mod deprec_env (Deprecation (IEVar rdr_name) txt)
+  = setModuleRn (moduleName mod) $
+    mkImportedGlobalFromRdrName rdr_name `thenRn` \ name ->
+    traceRn (text "loaded deprecation for" <+> ppr name <> colon <+> ppr txt) `thenRn_`
+    returnRn (addToNameEnv deprec_env name txt)
 \end{code}
 
 
@@ -367,6 +384,15 @@ checkUpToDate mod_name
 
 checkModUsage [] = returnRn True               -- Yes!  Everything is up to date!
 
+checkModUsage ((mod_name, old_mod_vers, _, Specifically []) : rest)
+       -- If CurrentModule.hi contains 
+       --      import Foo :: ;
+       -- then that simply records that Foo lies below CurrentModule in the
+       -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
+       -- In this case we don't even want to open Foo's interface.
+  = traceRn (ptext SLIT("Nothing used from:") <+> ppr mod_name)        `thenRn_`
+    checkModUsage rest -- This one's ok, so check the rest
+
 checkModUsage ((mod_name, old_mod_vers, _, whats_imported) : rest)
   = loadInterface doc_str mod_name ImportBySystem      `thenRn` \ (mod, ifaces) ->
     let
@@ -421,7 +447,7 @@ checkEntityUsage mod decls ((occ_name,old_vers) : rest)
     case lookupNameEnv decls name of
 
        Nothing       ->        -- We used it before, but it ain't there now
-                         putDocRn (sep [ptext SLIT("No longer exported:"), ppr name])
+                         traceRn (sep [ptext SLIT("No longer exported:"), ppr name])
                          `thenRn_` returnRn False
 
        Just (new_vers,_,_,_)   -- It's there, but is it up to date?
@@ -431,7 +457,7 @@ checkEntityUsage mod decls ((occ_name,old_vers) : rest)
 
                | otherwise
                        -- Out of date, so bale out
-               -> putDocRn (sep [ptext SLIT("Out of date:"), ppr name])  `thenRn_`
+               -> traceRn (sep [ptext SLIT("Out of date:"), ppr name])  `thenRn_`
                   returnRn False
 \end{code}
 
@@ -577,7 +603,9 @@ ppr_brief_inst_decl (mod, InstD (InstDecl inst_ty _ _ _ _))
        other              -> ppr inst_ty
 
 getImportedRules :: RnMG [(Module,RdrNameHsDecl)]
-getImportedRules
+getImportedRules 
+  | opt_IgnoreIfacePragmas = returnRn []
+  | otherwise
   = getIfacesRn        `thenRn` \ ifaces ->
     let
        gates              = iSlurp ifaces      -- Anything at all that's been slurped
@@ -611,6 +639,13 @@ lookupFixity name
        Nothing                  -> returnRn defaultFixity
 
   | otherwise  -- Imported
+      -- For imported names, we have to get their fixities by doing a loadHomeInterface,
+      -- and consulting the Ifaces that comes back from that, because the interface
+      -- file for the Name might not have been loaded yet.  Why not?  Suppose you import module A,
+      -- which exports a function 'f', which is defined in module B.  Then B isn't loaded
+      -- right away (after all, it's possible that nothing from B will be used).
+      -- When we come across a use of 'f', we need to know its fixity, and it's then,
+      -- and only then, that we load B.hi.  That is what's happening here.
   = loadHomeInterface doc name         `thenRn` \ ifaces ->
     case lookupNameEnv (iFixes ifaces) name of
        Just (FixitySig _ fix _) -> returnRn fix 
@@ -626,13 +661,13 @@ lookupFixity name
 %*                                                     *
 %*********************************************************
 
-getImportVersions figures out
-what the ``usage information'' for this moudule is;
-that is, what it must record in its interface file as the things it uses.
-It records:
+getImportVersions figures out what the ``usage information'' for this
+moudule is; that is, what it must record in its interface file as the
+things it uses.  It records:
+
 \begin{itemize}
-\item anything reachable from its body code
-\item any module exported with a @module Foo@.
+\item  anything reachable from its body code
+\item  any module exported with a @module Foo@.
 \end{itemize}
 %
 Why the latter?  Because if @Foo@ changes then this module's export list
@@ -646,92 +681,118 @@ What about this?
          import B( f )         |         f = h 3
          g = ...               |         h = ...
 \end{verbatim}
-Should we record @B.f@ in @A@'s usages?  In fact we don't.  Certainly, if
-anything about @B.f@ changes than anyone who imports @A@ should be recompiled;
-they'll get an early exit if they don't use @B.f@.  However, even if @B.f@
-doesn't change at all, @B.h@ may do so, and this change may not be reflected
-in @f@'s version number.  So there are two things going on when compiling module @A@:
+
+Should we record @B.f@ in @A@'s usages?  In fact we don't.  Certainly,
+if anything about @B.f@ changes than anyone who imports @A@ should be
+recompiled; they'll get an early exit if they don't use @B.f@.
+However, even if @B.f@ doesn't change at all, @B.h@ may do so, and
+this change may not be reflected in @f@'s version number.  So there
+are two things going on when compiling module @A@:
+
 \begin{enumerate}
-\item Are @A.o@ and @A.hi@ correct?  Then we can bale out early.
-\item Should modules that import @A@ be recompiled?
+\item  Are @A.o@ and @A.hi@ correct?  Then we can bale out early.
+\item  Should modules that import @A@ be recompiled?
 \end{enumerate}
+
 For (1) it is slightly harmful to record @B.f@ in @A@'s usages,
-because a change in @B.f@'s version will provoke full recompilation of @A@,
-producing an identical @A.o@,
-and @A.hi@ differing only in its usage-version of @B.f@
-(and this usage-version info isn't used by any importer).
-
-For (2), because of the tricky @B.h@ question above,
-we ensure that @A.hi@ is touched
-(even if identical to its previous version)
-if A's recompilation was triggered by an imported @.hi@ file date change.
+because a change in @B.f@'s version will provoke full recompilation of
+@A@, producing an identical @A.o@, and @A.hi@ differing only in its
+usage-version of @B.f@ (and this usage-version info isn't used by any
+importer).
+
+For (2), because of the tricky @B.h@ question above, we ensure that
+@A.hi@ is touched (even if identical to its previous version) if A's
+recompilation was triggered by an imported @.hi@ file date change.
 Given that, there's no need to record @B.f@ in @A@'s usages.
 
-On the other hand, if @A@ exports @module B@,
-then we {\em do} count @module B@ among @A@'s usages,
-because we must recompile @A@ to ensure that @A.hi@ changes appropriately.
+On the other hand, if @A@ exports @module B@, then we {\em do} count
+@module B@ among @A@'s usages, because we must recompile @A@ to ensure
+that @A.hi@ changes appropriately.
+
+HOWEVER, we *do* record the usage
+       import B <n> :: ;
+in A.hi, to record the fact that A does import B.  This is used to decide
+to look to look for B.hi rather than B.hi-boot when compiling a module that
+imports A.  This line says that A imports B, but uses nothing in it.
+So we'll get an early bale-out when compiling A if B's version changes.
 
 \begin{code}
 getImportVersions :: ModuleName                        -- Name of this module
-                 -> Maybe [IE any]             -- Export list for this module
+                 -> ExportEnv                  -- Info about exports 
                  -> RnMG (VersionInfo Name)    -- Version info for these names
 
-getImportVersions this_mod exports
+getImportVersions this_mod (ExportEnv export_avails _ export_all_mods)
   = getIfacesRn                                        `thenRn` \ ifaces ->
     let
        mod_map   = iImpModInfo ifaces
        imp_names = iVSlurp     ifaces
 
        -- mv_map groups together all the things imported from a particular module.
-       mv_map1, mv_map2 :: FiniteMap ModuleName (WhatsImported Name)
-
-               -- mv_map1 records all the modules that have a "module M"
-               -- in this module's export list with an "Everything" 
-       mv_map1 = foldr add_mod emptyFM export_mods
-
-               -- mv_map2 adds the version numbers of things exported individually
-       mv_map2 = foldr add_mv mv_map1 imp_names
+       mv_map :: FiniteMap ModuleName [(Name,Version)]
+       mv_map = foldr add_mv emptyFM imp_names
 
        -- Build the result list by adding info for each module.
-       -- For (a) library modules
-       --     (b) source-imported modules
-       -- we do something special.  We don't want to record detailed usage information.
-       -- Indeed we don't want to record them at all unless they contain orphans,
-       -- which we must never lose track of.
-       mk_version_info mod_name (version, has_orphans, cts) so_far
-          | lib_or_source_imported && not has_orphans
-          = so_far     -- Don't record any usage info for this module
+       -- For (a) a library module, we don't record it at all unless it contains orphans
+       --         (We must never lose track of orphans.)
+       -- 
+       --     (b) a source-imported module, don't record the dependency at all
+       --      
+       -- (b) may seem a bit strange.  The idea is that the usages in a .hi file records
+       -- *all* the module's dependencies other than the loop-breakers.  We use
+       -- this info in findAndReadInterface to decide whether to look for a .hi file or
+       -- a .hi-boot file.  
+       --
+       -- This means we won't track version changes, or orphans, from .hi-boot files.
+       -- The former is potentially rather bad news.  It could be fixed by recording
+       -- whether something is a boot file along with the usage info for it, but 
+       -- I can't be bothered just now.
+
+       mk_version_info mod_name (version, has_orphans, contents) so_far
+          = let
+               go_for_it exports = (mod_name, version, has_orphans, exports) : so_far
+            in 
+            case contents of
+               Nothing ->      -- We didn't even open the interface
+                       -- This happens when a module, Foo, that we explicitly imported has 
+                       -- 'import Baz' in its interface file, recording that Baz is below
+                       -- Foo in the module dependency hierarchy.  We want to propagate this
+                       -- information.  The Nothing says that we didn't even open the interface
+                       -- file but we must still propagate the dependeny info.
+                  go_for_it (Specifically [])
+
+               Just (mod, boot_import, _)              -- We did open the interface
+                  |  boot_import                       -- Don't record any usage info for this module
+                  || (is_lib_module && not has_orphans)
+                  -> so_far            
           
-          | lib_or_source_imported     -- Has orphans; record the module but not
-                                       -- detailed version information for the imports
-          = (mod_name, version, has_orphans, Specifically []) : so_far
-
-          | otherwise 
-          = (mod_name, version, has_orphans, whats_imported) : so_far
-          where
-            whats_imported = case lookupFM mv_map2 mod_name of
-                               Just wi -> wi
-                               Nothing -> Specifically []
-
-            lib_or_source_imported = case cts of
-                                       Just (mod, boot_import, _) -> isLibModule mod || boot_import
-                                       Nothing                    -> False
+                  |  is_lib_module                     -- Record the module but not detailed
+                  || mod_name `elem` export_all_mods   -- version information for the imports
+                  -> go_for_it Everything
+
+                  |  otherwise
+                  -> case lookupFM mv_map mod_name of
+                       Just whats_imported -> go_for_it (Specifically whats_imported)
+                       Nothing             -> go_for_it (Specifically [])
+                                               -- This happens if you have
+                                               --      import Foo
+                                               -- but don't actually *use* anything from Foo
+                                               -- In which case record an empty dependency list
+                  where
+                    is_lib_module     = isLibModule mod
+            
     in
+       -- A module shouldn't load its own interface
+       -- This seems like a convenient place to check
+    WARN( maybeToBool (lookupFM mod_map this_mod), 
+         ptext SLIT("Wierd:") <+> ppr this_mod <+> ptext SLIT("loads its own interface") )
+
     returnRn (foldFM mk_version_info [] mod_map)
   where
-     export_mods = case exports of
-                       Nothing -> []
-                       Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]
-
      add_mv v@(name, version) mv_map
-      = addToFM_C add_item mv_map mod (Specifically [v]) 
-       where
+      = addToFM_C add_item mv_map mod [v] 
+      where
         mod = moduleName (nameModule name)
-
-         add_item Everything        _ = Everything
-         add_item (Specifically xs) _ = Specifically (v:xs)
-
-     add_mod mod mv_map = addToFM mv_map mod Everything
+         add_item vs _ = (v:vs)
 \end{code}
 
 \begin{code}
@@ -783,7 +844,7 @@ getDeclBinders new_name (TyClD (TySynonym tycon _ _ src_loc))
   = new_name tycon src_loc             `thenRn` \ tycon_name ->
     returnRn (Just (AvailTC tycon_name [tycon_name]))
 
-getDeclBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ _ _ _ src_loc))
+getDeclBinders new_name (TyClD (ClassDecl _ cname _ _ sigs _ _ _ _ _ src_loc))
   = new_name cname src_loc                     `thenRn` \ class_name ->
 
        -- Record the names for the class ops
@@ -852,7 +913,7 @@ and the dict fun of an instance decl, because both of these have
 bindings of their own elsewhere.
 
 \begin{code}
-getDeclSysBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ tname dname snames src_loc))
+getDeclSysBinders new_name (TyClD (ClassDecl _ cname _ _ sigs _ _ tname dname snames src_loc))
   = new_name dname src_loc                             `thenRn` \ datacon_name ->
     new_name tname src_loc                             `thenRn` \ tycon_name ->
     sequenceRn [new_name n src_loc | n <- snames]      `thenRn` \ scsel_names ->
@@ -934,12 +995,18 @@ readIface the_mod file_path
                                context = [],
                                glasgow_exts = 1#,
                                loc = mkSrcLoc (mkFastString file_path) 1 } of
-                 PFailed err                    -> failWithRn Nothing err 
                  POk _  (PIface mod_nm iface) ->
                    warnCheckRn (mod_nm == moduleName the_mod)
                                (hiModuleNameMismatchWarn the_mod mod_nm) `thenRn_`
                    returnRn (Just (the_mod, iface))
 
+                 PFailed err   -> failWithRn Nothing err 
+                 other         -> failWithRn Nothing (ptext SLIT("Unrecognisable interface file"))
+                               -- This last case can happen if the interface file is (say) empty
+                               -- in which case the parser thinks it looks like an IdInfo or
+                               -- something like that.  Just an artefact of the fact that the
+                               -- parser is used for several purposes at once.
+
         Left err
          | isDoesNotExistError err -> returnRn Nothing
          | otherwise               -> failWithRn Nothing (cannaeReadFile file_path err)