Put full ImportDecls in ModSummary instead of just ModuleNames
authorSimon Marlow <marlowsd@gmail.com>
Tue, 2 Dec 2008 13:37:36 +0000 (13:37 +0000)
committerSimon Marlow <marlowsd@gmail.com>
Tue, 2 Dec 2008 13:37:36 +0000 (13:37 +0000)
... and use it to make ghc -M generate correct cross-package
dependencies when using package-qualified imports (needed for the new
build system).  Since we're already parsing the ImportDecl from the
source file, there seems no good reason not to keep it in the
ModSummary, it might be useful for other things too.

compiler/iface/MkIface.lhs
compiler/main/DriverMkDepend.hs
compiler/main/GHC.hs
compiler/main/HeaderInfo.hs
compiler/main/HscTypes.lhs

index 97449b7..4976e1f 100644 (file)
@@ -67,6 +67,7 @@ import TcType
 import InstEnv
 import FamInstEnv
 import TcRnMonad
+import HsSyn
 import HscTypes
 import Finder
 import DynFlags
@@ -1115,8 +1116,8 @@ checkDependencies hsc_env summary iface
    orM = foldr f (return False)
     where f m rest = do b <- m; if b then return True else rest
 
-   dep_missing (L _ mod) = do
-     find_res <- liftIO $ findImportedModule hsc_env mod Nothing
+   dep_missing (L _ (ImportDecl (L _ mod) pkg _ _ _ _)) = do
+     find_res <- liftIO $ findImportedModule hsc_env mod pkg
      case find_res of
         Found _ mod
           | pkg == this_pkg
index 5b63392..adfcbbd 100644 (file)
@@ -17,6 +17,7 @@ module DriverMkDepend (
 
 import qualified GHC
 import GHC              ( ModSummary(..), GhcMonad )
+import HsSyn            ( ImportDecl(..) )
 import PrelNames
 import DynFlags
 import Util
@@ -186,8 +187,8 @@ processDeps dflags hsc_env excl_mods hdl (AcyclicSCC node)
               obj_file  = msObjFilePath node
               obj_files = insertSuffixes obj_file extra_suffixes
 
-              do_imp is_boot imp_mod
-                = do { mb_hi <- findDependency hsc_env src_file imp_mod
+              do_imp is_boot pkg_qual imp_mod
+                = do { mb_hi <- findDependency hsc_env pkg_qual imp_mod
                                                is_boot include_pkg_deps
                      ; case mb_hi of {
                            Nothing      -> return () ;
@@ -207,29 +208,30 @@ processDeps dflags hsc_env excl_mods hdl (AcyclicSCC node)
 
                 -- Emit a dependency for each import
 
-        -- SOURCE imports
-        ; mapM_ (do_imp True)
-                (filter (`notElem` excl_mods) (map unLoc (ms_srcimps node)))
+        ; let do_imps is_boot idecls = sequence_
+                    [ do_imp is_boot (ideclPkgQual i) mod
+                    | L _ i <- idecls,
+                      let mod = unLoc (ideclName i),
+                      mod `notElem` excl_mods ]
 
-        -- regular imports
-        ; mapM_ (do_imp False)
-                (filter (`notElem` excl_mods) (map unLoc (ms_imps node)))
+        ; do_imps True  (ms_srcimps node)
+        ; do_imps False (ms_imps node)
 
         ; when (dopt Opt_ImplicitPrelude (ms_hspp_opts node)) $
-            do_imp False pRELUDE_NAME
+            do_imp False Nothing pRELUDE_NAME
         }
 
 
 findDependency  :: HscEnv
-                -> FilePath             -- Importing module: used only for error msg
+                -> Maybe FastString     -- package qualifier, if any
                 -> ModuleName           -- Imported module
                 -> IsBootInterface      -- Source import
                 -> Bool                 -- Record dependency on package modules
                 -> IO (Maybe FilePath)  -- Interface file file
-findDependency hsc_env _ imp is_boot include_pkg_deps
+findDependency hsc_env pkg imp is_boot include_pkg_deps
   = do  {       -- Find the module; this will be fast because
                 -- we've done it once during downsweep
-          r <- findImportedModule hsc_env imp Nothing
+          r <- findImportedModule hsc_env imp pkg
         ; case r of
             Found loc _
                 -- Home package: just depend on the .hi or hi-boot file
@@ -359,7 +361,7 @@ pprCycle summaries = pp_group (CyclicSCC summaries)
           pp_ms loop_breaker $$ vcat (map pp_group groups)
         where
           (boot_only, others) = partition is_boot_only mss
-          is_boot_only ms = not (any in_group (ms_imps ms))
+          is_boot_only ms = not (any in_group (map (ideclName.unLoc) (ms_imps ms)))
           in_group (L _ m) = m `elem` group_mods
           group_mods = map (moduleName . ms_mod) mss
 
@@ -368,8 +370,8 @@ pprCycle summaries = pp_group (CyclicSCC summaries)
           groups = GHC.topSortModuleGraph True all_others Nothing
 
     pp_ms summary = text mod_str <> text (take (20 - length mod_str) (repeat ' '))
-                       <+> (pp_imps empty (ms_imps summary) $$
-                            pp_imps (ptext (sLit "{-# SOURCE #-}")) (ms_srcimps summary))
+                       <+> (pp_imps empty (map (ideclName.unLoc) (ms_imps summary)) $$
+                            pp_imps (ptext (sLit "{-# SOURCE #-}")) (map (ideclName.unLoc) (ms_srcimps summary)))
         where
           mod_str = moduleNameString (moduleName (ms_mod summary))
 
index 3f72101..48f6501 100644 (file)
@@ -1333,7 +1333,7 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
        scc_mods = map ms_mod_name scc
        home_module m   = m `elem` all_home_mods && m `notElem` scc_mods
 
-        scc_allimps = nub (filter home_module (concatMap ms_allimps scc))
+        scc_allimps = nub (filter home_module (concatMap ms_home_allimps scc))
            -- all imports outside the current SCC, but in the home pkg
        
        stable_obj_imps = map (`elem` stable_obj) scc_allimps
@@ -1370,9 +1370,6 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
                        linkableTime l >= ms_hs_date ms
                _other  -> False
 
-ms_allimps :: ModSummary -> [ModuleName]
-ms_allimps ms = map unLoc (ms_srcimps ms ++ ms_imps ms)
-
 -- -----------------------------------------------------------------------------
 
 -- | Prune the HomePackageTable
@@ -1816,8 +1813,8 @@ moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, l
             | (s, key) <- numbered_summaries
              -- Drop the hi-boot ones if told to do so
             , not (isBootSummary s && drop_hs_boot_nodes)
-            , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_srcimps s)) ++
-                             out_edge_keys HsSrcFile   (map unLoc (ms_imps s)) ++
+            , let out_keys = out_edge_keys hs_boot_key (map unLoc (ms_home_srcimps s)) ++
+                             out_edge_keys HsSrcFile   (map unLoc (ms_home_imps s)) ++
                              (-- see [boot-edges] below
                               if drop_hs_boot_nodes || ms_hsc_src s == HsBootFile 
                               then [] 
@@ -1864,8 +1861,8 @@ warnUnnecessarySourceImports sccs =
   logWarnings (listToBag (concatMap (check.flattenSCC) sccs))
   where check ms =
           let mods_in_this_cycle = map ms_mod_name ms in
-          [ warn i | m <- ms, i <- ms_srcimps m,
-                       unLoc i `notElem`  mods_in_this_cycle ]
+          [ warn i | m <- ms, i <- ms_home_srcimps m,
+                     unLoc i `notElem`  mods_in_this_cycle ]
 
        warn :: Located ModuleName -> WarnMsg
        warn (L loc mod) = 
@@ -1987,8 +1984,20 @@ msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)]
 -- Remember, this pass isn't doing the topological sort.  It's
 -- just gathering the list of all relevant ModSummaries
 msDeps s = 
-    concat [ [(m,True), (m,False)] | m <- ms_srcimps s ] 
-        ++ [ (m,False) | m <- ms_imps s ] 
+    concat [ [(m,True), (m,False)] | m <- ms_home_srcimps s ] 
+        ++ [ (m,False) | m <- ms_home_imps s ] 
+
+home_imps :: [Located (ImportDecl RdrName)] -> [Located ModuleName]
+home_imps imps = [ ideclName i |  L _ i <- imps, isNothing (ideclPkgQual i) ]
+
+ms_home_allimps :: ModSummary -> [ModuleName]
+ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)
+
+ms_home_srcimps :: ModSummary -> [Located ModuleName]
+ms_home_srcimps = home_imps . ms_srcimps
+
+ms_home_imps :: ModSummary -> [Located ModuleName]
+ms_home_imps = home_imps . ms_imps
 
 -----------------------------------------------------------------------------
 -- Summarising modules
index d79c3ee..9184909 100644 (file)
@@ -15,6 +15,7 @@ module HeaderInfo ( getImports
 
 #include "HsVersions.h"
 
+import RdrName
 import HscTypes
 import Parser          ( parseHeader )
 import Lexer
@@ -51,7 +52,7 @@ getImports :: GhcMonad m =>
                            --   reporting parse error locations.
            -> FilePath     -- ^ The original source filename (used for locations
                            --   in the function result)
-           -> m ([Located ModuleName], [Located ModuleName], Located ModuleName)
+           -> m ([Located (ImportDecl RdrName)], [Located (ImportDecl RdrName)], Located ModuleName)
               -- ^ The source imports, normal imports, and the module name.
 getImports dflags buf filename source_filename = do
   let loc  = mkSrcLoc (mkFastString filename) 1 0
@@ -68,29 +69,16 @@ getImports dflags buf filename source_filename = do
              let
                 main_loc = mkSrcLoc (mkFastString source_filename) 1 0
                mod = mb_mod `orElse` L (srcLocSpan main_loc) mAIN_NAME
-                imps' = filter isHomeImp (map unLoc imps)
-               (src_idecls, ord_idecls) = partition isSourceIdecl imps'
-               source_imps   = map getImpMod src_idecls
-               ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc) 
-                                       (map getImpMod ord_idecls)
+               (src_idecls, ord_idecls) = partition (ideclSource.unLoc) imps
+               ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc . ideclName . unLoc) 
+                                       ord_idecls
                     -- GHC.Prim doesn't exist physically, so don't go looking for it.
              in
-             return (source_imps, ordinary_imps, mod)
+             return (src_idecls, ordinary_imps, mod)
   
 parseError :: GhcMonad m => SrcSpan -> Message -> m a
 parseError span err = throwOneError $ mkPlainErrMsg span err
 
--- we aren't interested in package imports here, filter them out
-isHomeImp :: ImportDecl name -> Bool
-isHomeImp (ImportDecl _ (Just p) _ _ _ _) = p == fsLit "this"
-isHomeImp (ImportDecl _ Nothing  _ _ _ _) = True
-
-isSourceIdecl :: ImportDecl name -> Bool
-isSourceIdecl (ImportDecl _ _ s _ _ _) = s
-
-getImpMod :: ImportDecl name -> Located ModuleName
-getImpMod (ImportDecl located_mod _ _ _ _ _) = located_mod
-
 --------------------------------------------------------------
 -- Get options
 --------------------------------------------------------------
index e79acf4..9197df5 100644 (file)
@@ -111,6 +111,7 @@ import ByteCodeAsm  ( CompiledByteCode )
 import {-# SOURCE #-}  InteractiveEval ( Resume )
 #endif
 
+import HsSyn
 import RdrName
 import Name
 import NameEnv
@@ -1873,8 +1874,8 @@ data ModSummary
         ms_location  :: ModLocation,           -- ^ Location of the various files belonging to the module
         ms_hs_date   :: ClockTime,             -- ^ Timestamp of source file
        ms_obj_date  :: Maybe ClockTime,        -- ^ Timestamp of object, if we have one
-        ms_srcimps   :: [Located ModuleName],  -- ^ Source imports of the module
-        ms_imps      :: [Located ModuleName],  -- ^ Non-source imports of the module
+        ms_srcimps   :: [Located (ImportDecl RdrName)],        -- ^ Source imports of the module
+        ms_imps      :: [Located (ImportDecl RdrName)],        -- ^ Non-source imports of the module
         ms_hspp_file :: FilePath,              -- ^ Filename of preprocessed source file
         ms_hspp_opts :: DynFlags,               -- ^ Cached flags from @OPTIONS@, @INCLUDE@
                                                 -- and @LANGUAGE@ pragmas in the modules source code