Refactor SrcLoc and SrcSpan

[ghc-hetmet.git] / compiler / rename / RnNames.lhs

diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index e8490ac..3867e17 100644 (file)
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -18,7 +18,7 @@ import HsSyn
 import TcEnv            ( isBrackStage )
 import RnEnv
 import RnHsDoc          ( rnHsDoc )
-import IfaceEnv         ( ifaceExportNames )
+import IfaceEnv                ( ifaceExportNames )
 import LoadIface        ( loadSrcInterface )
 import TcRnMonad
 
@@ -37,7 +37,7 @@ import ErrUtils
 import Util
 import FastString
 import ListSetOps
-import Data.List        ( partition, (\\), delete )
+import Data.List        ( partition, (\\), delete, find )
 import qualified Data.Set as Set
 import System.IO
 import Control.Monad
@@ -112,8 +112,9 @@ rnImportDecl this_mod implicit_prelude
        -- (Opt_WarnMissingImportList also checks for T(..) items
        --  but that is done in checkDodgyImport below)
     case imp_details of
-        Just (False, _)       -> return ()
+        Just (False, _)       -> return ()     -- Explicit import list
         _  | implicit_prelude -> return ()
+           | qual_only       -> return ()
            | otherwise        -> ifDOptM Opt_WarnMissingImportList $
                                  addWarn (missingImportListWarn imp_mod_name)
 
@@ -446,7 +447,7 @@ get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
                                     hs_fords  = foreign_decls })
   = do  { -- separate out the family instance declarations
           let (tyinst_decls1, tycl_decls_noinsts)
-                           = partition (isFamInstDecl . unLoc) tycl_decls
+                           = partition (isFamInstDecl . unLoc) (concat tycl_decls)
               tyinst_decls = tyinst_decls1 ++ instDeclATs inst_decls
 
           -- process all type/class decls except family instances
@@ -586,6 +587,7 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
                 = ifDOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn n))
                 -- NB. use the RdrName for reporting the warning
                | IEThingAll {} <- ieRdr
+               , not (is_qual decl_spec)
                 = ifDOptM Opt_WarnMissingImportList $
                   addWarn (missingImportListItem ieRdr)
             checkDodgyImport _
@@ -604,7 +606,7 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
     lookup_ie :: Bool -> IE RdrName -> MaybeErr Message [(IE Name,AvailInfo)]
     lookup_ie opt_typeFamilies ie
       = let bad_ie :: MaybeErr Message a
-            bad_ie = Failed (badImportItemErr iface decl_spec ie)
+            bad_ie = Failed (badImportItemErr iface decl_spec ie all_avails)
 
             lookup_name rdr
               | isQual rdr = Failed (qualImportItemErr rdr)
@@ -1064,12 +1066,10 @@ check_occs ie occs names
             | name == name'   -- Duplicate export
             -- But we don't want to warn if the same thing is exported
             -- by two different module exports. See ticket #4478.
-            -> if diffModules ie ie'
-                 then return occs
-                 else do
-                   { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
-                     warnIf warn_dup_exports (dupExportWarn name_occ ie ie') ;
-                     return occs }
+            -> do unless (diffModules ie ie') $ do
+                      warn_dup_exports <- doptM Opt_WarnDuplicateExports
+                      warnIf warn_dup_exports (dupExportWarn name_occ ie ie')
+                  return occs
 
             | otherwise    -- Same occ name but different names: an error
             ->  do { global_env <- getGlobalRdrEnv ;
@@ -1256,7 +1256,9 @@ warnUnusedImportDecls gbl_env
        ; ifDOptM Opt_D_dump_minimal_imports $
          printMinimalImports usage }
   where
-    explicit_import (L loc _) = isGoodSrcSpan loc
+    explicit_import (L loc _) = case loc of
+                                UnhelpfulSpan _ -> False
+                                RealSrcSpan _ -> True
         -- Filter out the implicit Prelude import
         -- which we do not want to bleat about
 \end{code}
@@ -1458,14 +1460,51 @@ qualImportItemErr rdr
   = hang (ptext (sLit "Illegal qualified name in import item:"))
        2 (ppr rdr)
 
-badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
-badImportItemErr iface decl_spec ie
+badImportItemErrStd :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
+badImportItemErrStd iface 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)")
                   | otherwise     = empty
 
+badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
+badImportItemErrDataCon dataType iface decl_spec ie
+  = vcat [ ptext (sLit "In module")
+             <+> quotes (ppr (is_mod decl_spec))
+             <+> source_import <> colon
+         , nest 2 $ quotes datacon
+             <+> ptext (sLit "is a data constructor of")
+             <+> quotes (ppr dataType)
+         , ptext (sLit "To import it use")
+         , nest 2 $ quotes (ptext (sLit "import")
+             <+> ppr (is_mod decl_spec)
+             <+> parens (ppr dataType <+> parens datacon))
+         , ptext (sLit "or")
+         , nest 2 $ quotes (ptext (sLit "import")
+             <+> ppr (is_mod decl_spec)
+             <+> parens (ppr dataType <+> parens (ptext $ sLit "..")))
+         ]
+  where
+    datacon = ppr . rdrNameOcc $ ieName ie
+    source_import | mi_boot iface = ptext (sLit "(hi-boot interface)")
+                  | otherwise     = empty
+
+badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> [AvailInfo] -> SDoc
+badImportItemErr iface decl_spec ie avails
+  = case find checkIfDataCon avails of
+      Just con -> badImportItemErrDataCon (availOccName con) iface decl_spec ie
+      Nothing  -> badImportItemErrStd iface decl_spec ie
+  where
+    checkIfDataCon (AvailTC _ ns) =
+      case find (\n -> importedFS == nameOccNameFS n) ns of
+        Just n  -> isDataConName n
+        Nothing -> False
+    checkIfDataCon _ = False
+    availOccName = nameOccName . availName
+    nameOccNameFS = occNameFS . nameOccName
+    importedFS = occNameFS . rdrNameOcc $ ieName ie
+
 illegalImportItemErr :: SDoc
 illegalImportItemErr = ptext (sLit "Illegal import item")