Do dependency analysis when kind-checking type declarations
[ghc-hetmet.git] / compiler / rename / RnNames.lhs
index e8490ac..a756c7f 100644 (file)
@@ -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
@@ -446,7 +446,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
@@ -604,7 +604,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 +1064,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 ;
@@ -1458,14 +1456,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")