Change loadSrcInterface to return a list of ModIface
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Tue, 4 Nov 2014 10:13:37 +0000 (02:13 -0800)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Thu, 27 Nov 2014 00:51:33 +0000 (16:51 -0800)
Summary:
This change is in preparation to support signature imports, which may pull in
multiple interface files.  At the moment, the list always contains only one
element, but in a later patch it may contain more.

I also adjusted some error reporting code so that it didn't take the full
iface, but just whether or not the iface in question was a boot module.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Test Plan: validate

Reviewers: simonpj, austin

Subscribers: thomie, carter

Differential Revision: https://phabricator.haskell.org/D436

compiler/iface/LoadIface.lhs
compiler/rename/RnEnv.lhs
compiler/rename/RnNames.lhs

index 3b2f7f2..250ef2f 100644 (file)
@@ -78,26 +78,61 @@ import System.FilePath
 %************************************************************************
 
 \begin{code}
+-- Note [Un-ambiguous multiple interfaces]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- When a user writes an import statement, this usually causes a *single*
+-- interface file to be loaded.  However, the game is different when
+-- signatures are being imported.  Suppose in packages p and q we have
+-- signatures:
+--
+--  module A where
+--      foo :: Int
+--
+--  module A where
+--      bar :: Int
+--
+-- If both packages are exposed and I am importing A, I should see a
+-- "unified" signature:
+--
+--  module A where
+--      foo :: Int
+--      bar :: Int
+--
+-- The way we achieve this is having the module lookup for A load and return
+-- multiple interface files, which we will then process as if there were
+-- "multiple" imports:
+--
+--  import "p" A
+--  import "q" A
+--
+-- Doing so does not cause any ambiguity, because any overlapping identifiers
+-- are guaranteed to have the same name if the backing implementations of the
+-- two signatures are the same (a condition which is checked by 'Packages'.)
+
+
 -- | Load the interface corresponding to an @import@ directive in 
 -- source code.  On a failure, fail in the monad with an error message.
+-- See Note [Un-ambiguous multiple interfaces] for why the return type
+-- is @[ModIface]@
 loadSrcInterface :: SDoc
                  -> ModuleName
                  -> IsBootInterface     -- {-# SOURCE #-} ?
                  -> Maybe FastString    -- "package", if any
-                 -> RnM ModIface
+                 -> RnM [ModIface]
 
 loadSrcInterface doc mod want_boot maybe_pkg
   = do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg
        ; case res of
-           Failed err      -> failWithTc err
-           Succeeded iface -> return iface }
+           Failed err       -> failWithTc err
+           Succeeded ifaces -> return ifaces }
 
--- | Like 'loadSrcInterface', but returns a 'MaybeErr'.
+-- | Like 'loadSrcInterface', but returns a 'MaybeErr'.  See also
+-- Note [Un-ambiguous multiple interfaces]
 loadSrcInterface_maybe :: SDoc
                        -> ModuleName
                        -> IsBootInterface     -- {-# SOURCE #-} ?
                        -> Maybe FastString    -- "package", if any
-                       -> RnM (MaybeErr MsgDoc ModIface)
+                       -> RnM (MaybeErr MsgDoc [ModIface])
 
 loadSrcInterface_maybe doc mod want_boot maybe_pkg
   -- We must first find which Module this import refers to.  This involves
@@ -106,9 +141,12 @@ loadSrcInterface_maybe doc mod want_boot maybe_pkg
   -- interface; it will call the Finder again, but the ModLocation will be
   -- cached from the first search.
   = do { hsc_env <- getTopEnv
+       -- ToDo: findImportedModule should return a list of interfaces
        ; res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
        ; case res of
-           Found _ mod -> initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
+           Found _ mod -> fmap (fmap (:[]))
+                        . initIfaceTcRn
+                        $ loadInterface doc mod (ImportByUser want_boot)
            err         -> return (Failed (cannotFindInterface (hsc_dflags hsc_env) mod err)) }
 
 -- | Load interface directly for a fully qualified 'Module'.  (This is a fairly
index 28f54c8..7e096c0 100644 (file)
@@ -957,12 +957,13 @@ lookupQualifiedNameGHCi dflags is_ghci rdr_name
     -- and respect hiddenness of modules/packages, hence loadSrcInterface.
     do { res <- loadSrcInterface_maybe doc mod False Nothing
        ; case res of
-           Succeeded iface
+           Succeeded ifaces
              | (n:ns) <- [ name
-                         | avail <- mi_exports iface
+                         | iface <- ifaces
+                         , avail <- mi_exports iface
                          , name  <- availNames avail
                          , nameOccName name == occ ]
-             -> ASSERT(null ns) return (Just n)
+             -> ASSERT(all (==n) ns) return (Just n)
 
            _ -> -- Either we couldn't load the interface, or
                 -- we could but we didn't find the name in it
index c3e8c70..eaa629a 100644 (file)
@@ -192,11 +192,15 @@ rnImportDecl this_mod
            | otherwise  -> whenWOptM Opt_WarnMissingImportList $
                            addWarn (missingImportListWarn imp_mod_name)
 
-    iface <- loadSrcInterface doc imp_mod_name want_boot mb_pkg
+    ifaces <- loadSrcInterface doc imp_mod_name want_boot mb_pkg
 
     -- Compiler sanity check: if the import didn't say
     -- {-# SOURCE #-} we should not get a hi-boot file
-    WARN( not want_boot && mi_boot iface, ppr imp_mod_name ) do
+    WARN( not want_boot && any mi_boot ifaces, ppr imp_mod_name ) do
+
+    -- Another sanity check: we should not get multiple interfaces
+    -- if we're looking for an hi-boot file
+    WARN( want_boot && length ifaces /= 1, ppr imp_mod_name ) do
 
     -- Issue a user warning for a redundant {- SOURCE -} import
     -- NB that we arrange to read all the ordinary imports before
@@ -207,7 +211,7 @@ rnImportDecl this_mod
     -- the non-boot module depends on the compilation order, which
     -- is not deterministic.  The hs-boot test can show this up.
     dflags <- getDynFlags
-    warnIf (want_boot && not (mi_boot iface) && isOneShot (ghcMode dflags))
+    warnIf (want_boot && any (not.mi_boot) ifaces && isOneShot (ghcMode dflags))
            (warnRedundantSourceImport imp_mod_name)
     when (mod_safe && not (safeImportsOn dflags)) $
         addErrAt loc (ptext (sLit "safe import can't be used as Safe Haskell isn't on!")
@@ -220,7 +224,7 @@ rnImportDecl this_mod
                                   is_dloc = loc, is_as = qual_mod_name }
 
     -- filter the imports according to the import declaration
-    (new_imp_details, gres) <- filterImports iface imp_spec imp_details
+    (new_imp_details, gres) <- filterImports ifaces imp_spec imp_details
 
     let gbl_env = mkGlobalRdrEnv (filterOut from_this_mod gres)
         from_this_mod gre = nameModule (gre_name gre) == this_mod
@@ -236,13 +240,17 @@ rnImportDecl this_mod
                     || (implicit && safeImplicitImpsReq dflags)
 
     let imports
-          = (calculateAvails dflags iface mod_safe' want_boot) {
+          = foldr plusImportAvails emptyImportAvails (map
+             (\iface ->
+              (calculateAvails dflags iface mod_safe' want_boot) {
                 imp_mods = unitModuleEnv (mi_module iface)
-                            [(qual_mod_name, import_all, loc, mod_safe')] }
+                            [(qual_mod_name, import_all, loc, mod_safe')] })
+             ifaces)
 
     -- Complain if we import a deprecated module
     whenWOptM Opt_WarnWarningsDeprecations (
-       case (mi_warns iface) of
+      forM_ ifaces $ \iface ->
+       case mi_warns iface of
           WarnAll txt -> addWarn $ moduleWarn imp_mod_name txt
           _           -> return ()
      )
@@ -250,7 +258,7 @@ rnImportDecl this_mod
     let new_imp_decl = L loc (decl { ideclSafe = mod_safe'
                                    , ideclHiding = new_imp_details })
 
-    return (new_imp_decl, gbl_env, imports, mi_hpc iface)
+    return (new_imp_decl, gbl_env, imports, any mi_hpc ifaces)
 
 -- | Calculate the 'ImportAvails' induced by an import of a particular
 -- interface, but without 'imp_mods'.
@@ -614,18 +622,18 @@ although we never look up data constructors.
 
 \begin{code}
 filterImports
-    :: ModIface
+    :: [ModIface]
     -> ImpDeclSpec                     -- The span for the entire import decl
     -> Maybe (Bool, Located [LIE RdrName])    -- Import spec; True => hiding
     -> RnM (Maybe (Bool, Located [LIE Name]), -- Import spec w/ Names
             [GlobalRdrElt])                   -- Same again, but in GRE form
 filterImports iface decl_spec Nothing
-  = return (Nothing, gresFromAvails prov (mi_exports iface))
+  = return (Nothing, gresFromAvails prov (concatMap mi_exports iface))
   where
     prov = Imported [ImpSpec { is_decl = decl_spec, is_item = ImpAll }]
 
 
-filterImports iface decl_spec (Just (want_hiding, L l import_items))
+filterImports ifaces decl_spec (Just (want_hiding, L l import_items))
   = do  -- check for errors, convert RdrNames to Names
         items1 <- mapM lookup_lie import_items
 
@@ -644,7 +652,7 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
 
         return (Just (want_hiding, L l (map fst items2)), gres)
   where
-    all_avails = mi_exports iface
+    all_avails = concatMap mi_exports ifaces
 
         -- See Note [Dealing with imports]
     imp_occ_env :: OccEnv (Name,        -- the name
@@ -693,7 +701,8 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
               Succeeded a -> return (Just a)
 
             lookup_err_msg err = case err of
-              BadImport -> badImportItemErr iface decl_spec ieRdr all_avails
+              BadImport -> badImportItemErr (any mi_boot ifaces) decl_spec
+                                            ieRdr all_avails
               IllegalImport -> illegalImportItemErr
               QualImportError rdr -> qualImportItemErr rdr
 
@@ -1536,13 +1545,13 @@ printMinimalImports imports_w_usage
       = do { let ImportDecl { ideclName    = L _ mod_name
                             , ideclSource  = is_boot
                             , ideclPkgQual = mb_pkg } = decl
-           ; iface <- loadSrcInterface doc mod_name is_boot mb_pkg
-           ; let lies = map (L l) (concatMap (to_ie iface) used)
+           ; ifaces <- loadSrcInterface doc mod_name is_boot mb_pkg
+           ; let lies = map (L l) (concatMap (to_ie ifaces) used)
            ; return (L l (decl { ideclHiding = Just (False, L l lies) })) }
       where
         doc = text "Compute minimal imports for" <+> ppr decl
 
-    to_ie :: ModIface -> AvailInfo -> [IE Name]
+    to_ie :: [ModIface] -> AvailInfo -> [IE Name]
     -- The main trick here is that if we're importing all the constructors
     -- we want to say "T(..)", but if we're importing only a subset we want
     -- to say "T(A,B,C)".  So we have to find out what the module exports.
@@ -1550,8 +1559,9 @@ printMinimalImports imports_w_usage
        = [IEVar (noLoc n)]
     to_ie _ (AvailTC n [m])
        | n==m = [IEThingAbs n]
-    to_ie iface (AvailTC n ns)
-      = case [xs | AvailTC x xs <- mi_exports iface
+    to_ie ifaces (AvailTC n ns)
+      = case [xs | iface <- ifaces
+                 , AvailTC x xs <- mi_exports iface
                  , x == n
                  , x `elem` xs    -- Note [Partial export]
                  ] of
@@ -1595,16 +1605,20 @@ qualImportItemErr rdr
   = hang (ptext (sLit "Illegal qualified name in import item:"))
        2 (ppr rdr)
 
-badImportItemErrStd :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
-badImportItemErrStd iface decl_spec ie
+badImportItemErrStd :: IsBootInterface -> ImpDeclSpec -> IE RdrName -> SDoc
+badImportItemErrStd is_boot decl_spec ie
   = sep [ptext (sLit "Module"), quotes (ppr (is_mod decl_spec)), source_import,
          ptext (sLit "does not export"), quotes (ppr ie)]
   where
-    source_import | mi_boot iface = ptext (sLit "(hi-boot interface)")
+    source_import | is_boot       = ptext (sLit "(hi-boot interface)")
                   | otherwise     = Outputable.empty
 
-badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
-badImportItemErrDataCon dataType iface decl_spec ie
+badImportItemErrDataCon :: OccName
+                        -> IsBootInterface
+                        -> ImpDeclSpec
+                        -> IE RdrName
+                        -> SDoc
+badImportItemErrDataCon dataType is_boot decl_spec ie
   = vcat [ ptext (sLit "In module")
              <+> quotes (ppr (is_mod decl_spec))
              <+> source_import <> colon
@@ -1623,15 +1637,19 @@ badImportItemErrDataCon dataType iface decl_spec ie
   where
     datacon_occ = rdrNameOcc $ ieName ie
     datacon = parenSymOcc datacon_occ (ppr datacon_occ)
-    source_import | mi_boot iface = ptext (sLit "(hi-boot interface)")
+    source_import | is_boot       = ptext (sLit "(hi-boot interface)")
                   | otherwise     = Outputable.empty
     parens_sp d = parens (space <> d <> space)  -- T( f,g )
 
-badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> [AvailInfo] -> SDoc
-badImportItemErr iface decl_spec ie avails
+badImportItemErr :: IsBootInterface
+                 -> ImpDeclSpec
+                 -> IE RdrName
+                 -> [AvailInfo]
+                 -> SDoc
+badImportItemErr is_boot decl_spec ie avails
   = case find checkIfDataCon avails of
-      Just con -> badImportItemErrDataCon (availOccName con) iface decl_spec ie
-      Nothing  -> badImportItemErrStd iface decl_spec ie
+     Just con -> badImportItemErrDataCon (availOccName con) is_boot decl_spec ie
+     Nothing  -> badImportItemErrStd is_boot decl_spec ie
   where
     checkIfDataCon (AvailTC _ ns) =
       case find (\n -> importedFS == nameOccNameFS n) ns of