Refactor (again) the handling of default methods

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

diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 7d367c7..9fcfd28 100644 (file)
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -21,6 +21,7 @@ import IfaceEnv               ( ifaceExportNames )
 import LoadIface       ( loadSrcInterface, loadSysInterface )
 import TcRnMonad hiding (LIE)
 
+import HeaderInfo       ( mkPrelImports )
 import PrelNames
 import Module
 import Name
@@ -60,7 +61,7 @@ rnImports imports
          -- warning for {- SOURCE -} ones that are unnecessary
     = do this_mod <- getModule
          implicit_prelude <- doptM Opt_ImplicitPrelude
-         let prel_imports      = mkPrelImports this_mod implicit_prelude imports
+         let prel_imports      = mkPrelImports (moduleName this_mod) implicit_prelude imports
              (source, ordinary) = partition is_source_import imports
              is_source_import (L _ (ImportDecl _ _ is_boot _ _ _)) = is_boot
 
@@ -84,36 +85,6 @@ rnImports imports
                    imp_avails1 `plusImportAvails` imp_avails2,
                   hpc_usage1 || hpc_usage2)
 
-mkPrelImports :: Module -> Bool -> [LImportDecl RdrName] -> [LImportDecl RdrName]
--- Consruct the implicit declaration "import Prelude" (or not)
---
--- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
--- because the former doesn't even look at Prelude.hi for instance 
--- declarations, whereas the latter does.
-mkPrelImports this_mod implicit_prelude import_decls
-  | this_mod == pRELUDE
-   || explicit_prelude_import
-   || not implicit_prelude
-  = []
-  | otherwise = [preludeImportDecl]
-  where
-      explicit_prelude_import
-       = notNull [ () | L _ (ImportDecl mod Nothing _ _ _ _) <- import_decls, 
-                  unLoc mod == pRELUDE_NAME ]
-
-      preludeImportDecl :: LImportDecl RdrName
-      preludeImportDecl
-        = L loc $
-         ImportDecl (L loc pRELUDE_NAME)
-               Nothing {- no specific package -}
-              False {- Not a boot interface -}
-              False    {- Not qualified -}
-              Nothing  {- No "as" -}
-              Nothing  {- No import list -}
-
-      loc = mkGeneralSrcSpan (fsLit "Implicit import declaration")         
-
-
 rnImportDecl  :: Module
              -> LImportDecl RdrName
              -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails,AnyHpcUsage)
@@ -423,8 +394,7 @@ get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
   = do {   -- separate out the family instance declarations
           let (tyinst_decls1, tycl_decls_noinsts) 
                            = partition (isFamInstDecl . unLoc) tycl_decls
-              tyinst_decls = tyinst_decls1 ++ 
-                             concatMap (instDeclATs . unLoc) inst_decls 
+              tyinst_decls = tyinst_decls1 ++ instDeclATs inst_decls
 
             -- process all type/class decls except family instances
         ; tc_names  <- mapM new_tc tycl_decls_noinsts
@@ -440,7 +410,6 @@ get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
        ; val_names <- mapM new_simple val_bndrs
        ; return (val_names ++ tc_names ++ ti_names) }
   where
-    mod        = tcg_mod gbl_env
     is_hs_boot = isHsBoot (tcg_src gbl_env) ;
 
     for_hs_bndrs :: [Located RdrName]
@@ -454,23 +423,23 @@ get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
 
     new_simple :: Located RdrName -> RnM (GenAvailInfo Name)
     new_simple rdr_name = do
-        nm <- newTopSrcBinder mod rdr_name
+        nm <- newTopSrcBinder rdr_name
         return (Avail nm)
 
     new_tc tc_decl              -- NOT for type/data instances
-       = do { main_name <- newTopSrcBinder mod main_rdr
-            ; sub_names <- mapM (newTopSrcBinder mod) sub_rdrs
+       = do { main_name <- newTopSrcBinder main_rdr
+            ; sub_names <- mapM newTopSrcBinder sub_rdrs
             ; return (AvailTC main_name (main_name : sub_names)) }
       where
-       (main_rdr : sub_rdrs) = tyClDeclNames (unLoc tc_decl)
+       (main_rdr : sub_rdrs) = hsTyClDeclBinders tc_decl
 
     new_ti tc_name_env ti_decl  -- ONLY for type/data instances
        = do { main_name <- lookupFamInstDeclBndr tc_name_env main_rdr
-            ; sub_names <- mapM (newTopSrcBinder mod) sub_rdrs
+            ; sub_names <- mapM newTopSrcBinder sub_rdrs
             ; return (AvailTC main_name sub_names) }
                        -- main_name is not bound here!
       where
-       (main_rdr : sub_rdrs) = tyClDeclNames (unLoc ti_decl)
+       (main_rdr : sub_rdrs) = hsTyClDeclBinders ti_decl
 
 get_local_binders _ g = pprPanic "get_local_binders" (ppr g)
 \end{code}