<commit_before>%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[RnNames]{Extracting imported and top-level names in scope}

\begin{code}
module RnNames (
	rnImports, importsFromLocalDecls, 
	getLocalDeclBinders, extendRdrEnvRn,
	reportUnusedNames, reportDeprecations, 
	mkModDeps, exportsFromAvail
    ) where

#include "HsVersions.h"

import DynFlags		( DynFlag(..), GhcMode(..) )
import HsSyn		( IE(..), ieName, ImportDecl(..), LImportDecl,
			  ForeignDecl(..), HsGroup(..), HsBindGroup(..), 
			  Sig(..), collectGroupBinders, tyClDeclNames 
			)
import RnEnv
import IfaceEnv		( ifaceExportNames )
import LoadIface	( loadSrcInterface )
import TcRnMonad

import FiniteMap
import PrelNames	( pRELUDE, isUnboundName, main_RDR_Unqual )
import Module		( Module, moduleUserString, unitModuleEnv, 
			  lookupModuleEnv, moduleEnvElts, foldModuleEnv )
import Name		( Name, nameSrcLoc, nameOccName, nameModule, isWiredInName,
			  nameParent, nameParent_maybe, isExternalName,
			  isBuiltInSyntax )
import NameSet
import NameEnv
import OccName		( srcDataName, isTcOcc, occNameFlavour, OccEnv, 
			  mkOccEnv, lookupOccEnv, emptyOccEnv, extendOccEnv )
import HscTypes		( GenAvailInfo(..), AvailInfo,
			  HomePackageTable, PackageIfaceTable, 
			  unQualInScope, 
			  Deprecs(..), ModIface(..), Dependencies(..), 
			  lookupIface, ExternalPackageState(..)
			)
import Packages		( PackageIdH(..) )
import RdrName		( RdrName, rdrNameOcc, setRdrNameSpace, 
		  	  GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..), 
			  emptyGlobalRdrEnv, plusGlobalRdrEnv, globalRdrEnvElts,
			  extendGlobalRdrEnv, lookupGlobalRdrEnv, unQualOK, lookupGRE_Name,
			  Provenance(..), ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), 
			  importSpecLoc, importSpecModule, isLocalGRE, pprNameProvenance )
import Outputable
import Maybes		( isNothing, catMaybes, mapCatMaybes, seqMaybe, orElse )
import SrcLoc		( Located(..), mkGeneralSrcSpan,
			  unLoc, noLoc, srcLocSpan, SrcSpan )
import BasicTypes	( DeprecTxt )
import DriverPhases	( isHsBoot )
import Util		( notNull )
import List		( partition )
import IO		( openFile, IOMode(..) )
\end{code}



%************************************************************************
%*									*
		rnImports
%*									*
%************************************************************************

\begin{code}
rnImports :: [LImportDecl RdrName]
	  -> RnM (GlobalRdrEnv, ImportAvails)

rnImports imports
  = do	{	-- PROCESS IMPORT DECLS
		-- Do the non {- SOURCE -} ones first, so that we get a helpful
		-- warning for {- SOURCE -} ones that are unnecessary
	  this_mod <- getModule
	; implicit_prelude <- doptM Opt_ImplicitPrelude
	; let
	    all_imports	       = mk_prel_imports this_mod implicit_prelude ++ imports
	    (source, ordinary) = partition is_source_import all_imports
	    is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot

	    get_imports = importsFromImportDecl this_mod

	; stuff1 <- mappM get_imports ordinary
	; stuff2 <- mappM get_imports source

		-- COMBINE RESULTS
	; let
	    (imp_gbl_envs, imp_avails) = unzip (stuff1 ++ stuff2)
	    gbl_env :: GlobalRdrEnv
	    gbl_env = foldr plusGlobalRdrEnv emptyGlobalRdrEnv imp_gbl_envs

	    all_avails :: ImportAvails
	    all_avails = foldr plusImportAvails emptyImportAvails imp_avails

		-- ALL DONE
	; return (gbl_env, all_avails) }
  where
	-- 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.
    mk_prel_imports this_mod implicit_prelude
	|  this_mod == pRELUDE
	|| explicit_prelude_import
	|| not implicit_prelude
	= []

	| otherwise = [preludeImportDecl]

    explicit_prelude_import
      = notNull [ () | L _ (ImportDecl mod _ _ _ _) <- imports, 
		       unLoc mod == pRELUDE ]

preludeImportDecl
  = L loc $
	ImportDecl (L loc pRELUDE)
	       False {- Not a boot interface -}
	       False	{- Not qualified -}
	       Nothing	{- No "as" -}
	       Nothing	{- No import list -}
  where
    loc = mkGeneralSrcSpan FSLIT("Implicit import declaration")
\end{code}
	
\begin{code}
importsFromImportDecl :: Module
		      -> LImportDecl RdrName
		      -> RnM (GlobalRdrEnv, ImportAvails)

importsFromImportDecl this_mod
	(L loc (ImportDecl loc_imp_mod_name want_boot qual_only as_mod imp_details))
  = 
    setSrcSpan loc $

	-- If there's an error in loadInterface, (e.g. interface
	-- file not found) we get lots of spurious errors from 'filterImports'
    let
	imp_mod_name = unLoc loc_imp_mod_name
	doc = ppr imp_mod_name <+> ptext SLIT("is directly imported")
    in
    loadSrcInterface doc imp_mod_name want_boot	`thenM` \ iface ->

	-- 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 )

	-- Issue a user warning for a redundant {- SOURCE -} import
	-- NB that we arrange to read all the ordinary imports before 
	-- any of the {- SOURCE -} imports
    warnIf (want_boot && not (mi_boot iface))
	   (warnRedundantSourceImport imp_mod_name)	`thenM_`

    let
	imp_mod	= mi_module iface
	deprecs	= mi_deprecs iface
	is_orph	= mi_orphan iface 
	deps 	= mi_deps iface

	filtered_exports = filter not_this_mod (mi_exports iface)
	not_this_mod (mod,_) = mod /= this_mod
	-- If the module exports anything defined in this module, just ignore it.
	-- Reason: otherwise it looks as if there are two local definition sites
	-- for the thing, and an error gets reported.  Easiest thing is just to
	-- filter them out up front. This situation only arises if a module
	-- imports itself, or another module that imported it.  (Necessarily,
	-- this invoves a loop.)  
	--
	-- Tiresome consequence: if you say
	--	module A where
	--	   import B( AType )
	--	   type AType = ...
	--
	--	module B( AType ) where
	--	   import {-# SOURCE #-} A( AType )
	--
	-- then you'll get a 'B does not export AType' message.  Oh well.

	qual_mod_name = case as_mod of
			  Nothing  	    -> imp_mod_name
			  Just another_name -> another_name
	imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,  
		  		  is_dloc = loc, is_as = qual_mod_name }
    in
	-- Get the total imports, and filter them according to the import list
    ifaceExportNames filtered_exports		`thenM` \ total_avails ->
    filterImports iface imp_spec
		  imp_details total_avails	`thenM` \ (avail_env, gbl_env) ->

    getDOpts `thenM` \ dflags ->

    let
	-- Compute new transitive dependencies

 	orphans | is_orph   = ASSERT( not (imp_mod_name `elem` dep_orphs deps) )
			      imp_mod_name : dep_orphs deps
		| otherwise = dep_orphs deps

	(dependent_mods, dependent_pkgs) 
	   = case mi_package iface of
		HomePackage ->
	    	-- Imported module is from the home package
		-- Take its dependent modules and add imp_mod itself
		-- Take its dependent packages unchanged
		--
		-- NB: (dep_mods deps) might include a hi-boot file
		-- for the module being compiled, CM. Do *not* filter
		-- this out (as we used to), because when we've
		-- finished dealing with the direct imports we want to
		-- know if any of them depended on CM.hi-boot, in
		-- which case we should do the hi-boot consistency
		-- check.  See LoadIface.loadHiBootInterface
		  ((imp_mod_name, want_boot) : dep_mods deps, dep_pkgs deps)

		ExtPackage pkg ->
 	   	-- Imported module is from another package
		-- Dump the dependent modules
		-- Add the package imp_mod comes from to the dependent packages
	         ASSERT2( not (pkg `elem` dep_pkgs deps), ppr pkg <+> ppr (dep_pkgs deps) )
	         ([], pkg : dep_pkgs deps)

	import_all = case imp_details of
			Just (is_hiding, ls)	 -- Imports are spec'd explicitly
			  | not is_hiding -> Just (not (null ls))
			_ -> Nothing		-- Everything is imported, 
						-- (or almost everything [hiding])

	-- unqual_avails is the Avails that are visible in *unqualified* form
	-- We need to know this so we know what to export when we see
	--	module M ( module P ) where ...
	-- Then we must export whatever came from P unqualified.
	imports   = ImportAvails { 
			imp_env      = unitModuleEnv qual_mod_name avail_env,
			imp_mods     = unitModuleEnv imp_mod (imp_mod, import_all, loc),
			imp_orphs    = orphans,
			imp_dep_mods = mkModDeps dependent_mods,
			imp_dep_pkgs = dependent_pkgs }

    in
	-- Complain if we import a deprecated module
    ifOptM Opt_WarnDeprecations	(
       case deprecs of	
	  DeprecAll txt -> addWarn (moduleDeprec imp_mod_name txt)
	  other	        -> returnM ()
    )							`thenM_`

    returnM (gbl_env, imports)

warnRedundantSourceImport mod_name
  = ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
          <+> quotes (ppr mod_name)
\end{code}


%************************************************************************
%*									*
		importsFromLocalDecls
%*									*
%************************************************************************

From the top-level declarations of this module produce
  	* the lexical environment
	* the ImportAvails
created by its bindings.  
	
Complain about duplicate bindings

\begin{code}
importsFromLocalDecls :: HsGroup RdrName -> RnM TcGblEnv
importsFromLocalDecls group
  = do	{ gbl_env  <- getGblEnv

	; names <- getLocalDeclBinders gbl_env group

	; implicit_prelude <- doptM Opt_ImplicitPrelude
	; let {
	    -- Optimisation: filter out names for built-in syntax
	    -- They just clutter up the environment (esp tuples), and the parser
	    -- will generate Exact RdrNames for them, so the cluttered
	    -- envt is no use.  To avoid doing this filter all the time,
	    -- we use -fno-implicit-prelude as a clue that the filter is
	    -- worth while.  Really, it's only useful for GHC.Base and GHC.Tuple.
	    --
	    -- It's worth doing because it makes the environment smaller for
	    -- every module that imports the Prelude
	    --
	    -- Note: don't filter the gbl_env (hence all_names, not filered_all_names
	    -- in defn of gres above).      Stupid reason: when parsing 
	    -- data type decls, the constructors start as Exact tycon-names,
	    -- and then get turned into data con names by zapping the name space;
	    -- but that stops them being Exact, so they get looked up.  
	    -- Ditto in fixity decls; e.g. 	infix 5 :
	    -- Sigh. It doesn't matter because it only affects the Data.Tuple really.
	    -- The important thing is to trim down the exports.
	      filtered_names 
	        | implicit_prelude = names
	        | otherwise	   = filter (not . isBuiltInSyntax) names ;

	    ; this_mod = tcg_mod gbl_env
	    ; imports = emptyImportAvails {
			  imp_env = unitModuleEnv this_mod $
				  mkNameSet filtered_names
		        }
	    }

	; rdr_env' <- extendRdrEnvRn this_mod (tcg_rdr_env gbl_env) names

	; returnM (gbl_env { tcg_rdr_env = rdr_env',
			     tcg_imports = imports `plusImportAvails` tcg_imports gbl_env }) 
	}

extendRdrEnvRn :: Module -> GlobalRdrEnv -> [Name] -> RnM GlobalRdrEnv
-- Add the new locally-bound names one by one, checking for duplicates as
-- we do so.  Remember that in Template Haskell the duplicates
-- might *already be* in the GlobalRdrEnv from higher up the module
extendRdrEnvRn mod rdr_env names
  = foldlM add_local rdr_env names
  where
    add_local rdr_env name
	| gres <- lookupGlobalRdrEnv rdr_env (nameOccName name)
	, (dup_gre:_) <- filter isLocalGRE gres	-- Check for existing *local* defns
	= do { addDupDeclErr (gre_name dup_gre) name
	     ; return rdr_env }
	| otherwise
	= return (extendGlobalRdrEnv rdr_env new_gre)
	where
	  new_gre = GRE {gre_name = name, gre_prov = prov}

    prov = LocalDef mod
\end{code}

@getLocalDeclBinders@ returns the names for an @HsDecl@.  It's
used for source code.

	*** See "THE NAMING STORY" in HsDecls ****

\begin{code}
getLocalDeclBinders :: TcGblEnv -> HsGroup RdrName -> RnM [Name]
getLocalDeclBinders gbl_env (HsGroup {hs_valds = val_decls, 
				      hs_tyclds = tycl_decls, 
				      hs_fords = foreign_decls })
  = do	{ tc_names_s <- mappM new_tc tycl_decls
	; val_names  <- mappM new_simple val_bndrs
	; return (foldr (++) val_names tc_names_s) }
  where
    mod        = tcg_mod gbl_env
    is_hs_boot = isHsBoot (tcg_src gbl_env) ;
    val_bndrs | is_hs_boot = sig_hs_bndrs
	      | otherwise  = for_hs_bndrs ++ val_hs_bndrs
	-- In a hs-boot file, the value binders come from the
	--  *signatures*, and there should be no foreign binders 

    new_simple rdr_name = newTopSrcBinder mod Nothing rdr_name

    sig_hs_bndrs = [nm | HsBindGroup _ lsigs _  <- val_decls, 
			 L _ (Sig nm _) <- lsigs]
    val_hs_bndrs = collectGroupBinders val_decls
    for_hs_bndrs = [nm | L _ (ForeignImport nm _ _ _) <- foreign_decls]

    new_tc tc_decl 
	= do { main_name <- newTopSrcBinder mod Nothing main_rdr
	     ; sub_names <- mappM (newTopSrcBinder mod (Just main_name)) sub_rdrs
	     ; return (main_name : sub_names) }
	where
	  (main_rdr : sub_rdrs) = tyClDeclNames (unLoc tc_decl)
\end{code}


%************************************************************************
%*									*
\subsection{Filtering imports}
%*									*
%************************************************************************

@filterImports@ takes the @ExportEnv@ telling what the imported module makes
available, and filters it through the import spec (if any).

\begin{code}
filterImports :: ModIface
	      -> ImpDeclSpec			-- The span for the entire import decl
	      -> Maybe (Bool, [Located (IE RdrName)])	-- Import spec; True => hiding
	      -> NameSet			-- What's available
	      -> RnM (NameSet,			-- What's imported (qualified or unqualified)
		      GlobalRdrEnv)		-- Same again, but in GRE form

	-- Complains if import spec mentions things that the module doesn't export
        -- Warns/informs if import spec contains duplicates.
			
mkGenericRdrEnv decl_spec names
  = mkGlobalRdrEnv [ GRE { gre_name = name, gre_prov = Imported [imp_spec] }
		   | name <- nameSetToList names ]
  where
    imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }

filterImports iface decl_spec Nothing all_names
  = returnM (all_names, mkGenericRdrEnv decl_spec all_names)

filterImports iface decl_spec (Just (want_hiding, import_items)) all_names
  = mappM (addLocM get_item) import_items 	`thenM` \ gres_s ->
    let
	gres = concat gres_s
	specified_names = mkNameSet (map gre_name gres)
    in
    if not want_hiding then
      return (specified_names, mkGlobalRdrEnv gres)
    else
    let
	keep n = not (n `elemNameSet` specified_names)
	pruned_avails = filterNameSet keep all_names
    in
    return (pruned_avails, mkGenericRdrEnv decl_spec pruned_avails)

  where
    occ_env :: OccEnv Name	-- Maps OccName to corresponding Name
    occ_env = mkOccEnv [(nameOccName n, n) | n <- nameSetToList all_names]
	-- This env will have entries for data constructors too,
	-- they won't make any difference because naked entities like T
	-- in an import list map to TcOccs, not VarOccs.

    sub_env :: NameEnv [Name]
    sub_env = mkSubNameEnv all_names

    bale_out item = addErr (badImportItemErr iface decl_spec item)  `thenM_`
		    returnM []

    succeed_with :: Bool -> [Name] -> RnM [GlobalRdrElt]
    succeed_with all_explicit names
      = do { loc <- getSrcSpanM
	   ; returnM (map (mk_gre loc) names) }
      where
	mk_gre loc name = GRE { gre_name = name, 
				gre_prov = Imported [imp_spec] }
	  where
	    imp_spec  = ImpSpec { is_decl = decl_spec, is_item = item_spec }
	    item_spec = ImpSome { is_explicit = explicit, is_iloc = loc }
	    explicit  = all_explicit || isNothing (nameParent_maybe name)

    get_item :: IE RdrName -> RnM [GlobalRdrElt]
	-- Empty result for a bad item.
	-- Singleton result is typical case.
	-- Can have two when we are hiding, and mention C which might be
	--	both a class and a data constructor.  
    get_item item@(IEModuleContents _) 
      = bale_out item

    get_item item@(IEThingAll tc)
      = case check_item item of
	  []    -> bale_out item

	  [n]   -> -- This occurs when you import T(..), but
			-- only export T abstractly.  The single [n]
			-- in the AvailTC is the type or class itself
			ifOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn tc)) `thenM_`
		     	succeed_with False [n]

	  names -> succeed_with False names

    get_item item@(IEThingAbs n)
      | want_hiding	-- hiding( C ) 
			-- Here the 'C' can be a data constructor 
			--  *or* a type/class, or even both
      = case concat [check_item item, check_item (IEVar data_n)] of
	  []    -> bale_out item
	  names -> succeed_with True names
      where
	data_n = setRdrNameSpace n srcDataName

    get_item item
      = case check_item item of
	  []    -> bale_out item
	  names -> succeed_with True names

    check_item :: IE RdrName -> [Name]
    check_item item 
	= case lookupOccEnv occ_env (rdrNameOcc (ieName item)) of
	    Nothing   -> []
	    Just name -> filterAvail item name sub_env
\end{code}


%************************************************************************
%*									*
\subsection{Export list processing}
%*									*
%************************************************************************

Processing the export list.

You might think that we should record things that appear in the export
list as ``occurrences'' (using @addOccurrenceName@), but you'd be
wrong.  We do check (here) that they are in scope, but there is no
need to slurp in their actual declaration (which is what
@addOccurrenceName@ forces).

Indeed, doing so would big trouble when compiling @PrelBase@, because
it re-exports @GHC@, which includes @takeMVar#@, whose type includes
@ConcBase.StateAndSynchVar#@, and so on...

\begin{code}
type ExportAccum	-- The type of the accumulating parameter of
			-- the main worker function in exportsFromAvail
     = ([Module], 		-- 'module M's seen so far
	ExportOccMap,		-- Tracks exported occurrence names
	NameSet)		-- The accumulated exported stuff
emptyExportAccum = ([], emptyOccEnv, emptyNameSet) 

type ExportOccMap = OccEnv (Name, IE RdrName)
	-- Tracks what a particular exported OccName
	--   in an export list refers to, and which item
	--   it came from.  It's illegal to export two distinct things
	--   that have the same occurrence name


exportsFromAvail :: Bool  -- False => no 'module M(..) where' header at all
		 -> Maybe [Located (IE RdrName)] -- Nothing => no explicit export list
		 -> RnM NameSet
	-- Complains if two distinct exports have same OccName
        -- Warns about identical exports.
	-- Complains about exports items not in scope

exportsFromAvail explicit_mod exports
 = do { TcGblEnv { tcg_rdr_env = rdr_env, 
		   tcg_imports = imports } <- getGblEnv ;

	-- If the module header is omitted altogether, then behave
	-- as if the user had written "module Main(main) where..."
	-- EXCEPT in interactive mode, when we behave as if he had
	-- written "module Main where ..."
	-- Reason: don't want to complain about 'main' not in scope
	--	   in interactive mode
	ghci_mode <- getGhciMode ;
	let { real_exports 
		| explicit_mod   	   = exports
		| ghci_mode == Interactive = Nothing
		| otherwise 		   = Just [noLoc (IEVar main_RDR_Unqual)] } ;
	exports_from_avail real_exports rdr_env imports }


exports_from_avail Nothing rdr_env imports
 =  	-- Export all locally-defined things
	-- We do this by filtering the global RdrEnv,
	-- keeping only things that are locally-defined
   return (mkNameSet [ gre_name gre 
		     | gre <- globalRdrEnvElts rdr_env,
		       isLocalGRE gre ])

exports_from_avail (Just items) rdr_env (ImportAvails { imp_env = imp_env }) 
  = foldlM do_litem emptyExportAccum items    `thenM` \ (_, _, exports) ->
    returnM exports
  where
    sub_env :: NameEnv [Name]	-- Classify each name by its parent
    sub_env = mkSubNameEnv (foldModuleEnv unionNameSets emptyNameSet imp_env)

    do_litem :: ExportAccum -> Located (IE RdrName) -> RnM ExportAccum
    do_litem acc = addLocM (exports_from_item acc)

    exports_from_item :: ExportAccum -> IE RdrName -> RnM ExportAccum<commit_msg>[project @ 2005-05-23 13:00:46 by simonpj] rename exportsFromAvail<commit_after>%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[RnNames]{Extracting imported and top-level names in scope}

\begin{code}
module RnNames (
	rnImports, importsFromLocalDecls, 
	rnExports,
	getLocalDeclBinders, extendRdrEnvRn,
	reportUnusedNames, reportDeprecations, 
	mkModDeps
    ) where

#include "HsVersions.h"

import DynFlags		( DynFlag(..), GhcMode(..) )
import HsSyn		( IE(..), ieName, ImportDecl(..), LImportDecl,
			  ForeignDecl(..), HsGroup(..), HsBindGroup(..), 
			  Sig(..), collectGroupBinders, tyClDeclNames 
			)
import RnEnv
import IfaceEnv		( ifaceExportNames )
import LoadIface	( loadSrcInterface )
import TcRnMonad

import FiniteMap
import PrelNames	( pRELUDE, isUnboundName, main_RDR_Unqual )
import Module		( Module, moduleUserString, unitModuleEnv, 
			  lookupModuleEnv, moduleEnvElts, foldModuleEnv )
import Name		( Name, nameSrcLoc, nameOccName, nameModule, isWiredInName,
			  nameParent, nameParent_maybe, isExternalName,
			  isBuiltInSyntax )
import NameSet
import NameEnv
import OccName		( srcDataName, isTcOcc, occNameFlavour, OccEnv, 
			  mkOccEnv, lookupOccEnv, emptyOccEnv, extendOccEnv )
import HscTypes		( GenAvailInfo(..), AvailInfo,
			  HomePackageTable, PackageIfaceTable, 
			  unQualInScope, 
			  Deprecs(..), ModIface(..), Dependencies(..), 
			  lookupIface, ExternalPackageState(..)
			)
import Packages		( PackageIdH(..) )
import RdrName		( RdrName, rdrNameOcc, setRdrNameSpace, 
		  	  GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..), 
			  emptyGlobalRdrEnv, plusGlobalRdrEnv, globalRdrEnvElts,
			  extendGlobalRdrEnv, lookupGlobalRdrEnv, unQualOK, lookupGRE_Name,
			  Provenance(..), ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), 
			  importSpecLoc, importSpecModule, isLocalGRE, pprNameProvenance )
import Outputable
import Maybes		( isNothing, catMaybes, mapCatMaybes, seqMaybe, orElse )
import SrcLoc		( Located(..), mkGeneralSrcSpan,
			  unLoc, noLoc, srcLocSpan, SrcSpan )
import BasicTypes	( DeprecTxt )
import DriverPhases	( isHsBoot )
import Util		( notNull )
import List		( partition )
import IO		( openFile, IOMode(..) )
\end{code}



%************************************************************************
%*									*
		rnImports
%*									*
%************************************************************************

\begin{code}
rnImports :: [LImportDecl RdrName]
	  -> RnM (GlobalRdrEnv, ImportAvails)

rnImports imports
  = do	{	-- PROCESS IMPORT DECLS
		-- Do the non {- SOURCE -} ones first, so that we get a helpful
		-- warning for {- SOURCE -} ones that are unnecessary
	  this_mod <- getModule
	; implicit_prelude <- doptM Opt_ImplicitPrelude
	; let
	    all_imports	       = mk_prel_imports this_mod implicit_prelude ++ imports
	    (source, ordinary) = partition is_source_import all_imports
	    is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot

	    get_imports = importsFromImportDecl this_mod

	; stuff1 <- mappM get_imports ordinary
	; stuff2 <- mappM get_imports source

		-- COMBINE RESULTS
	; let
	    (imp_gbl_envs, imp_avails) = unzip (stuff1 ++ stuff2)
	    gbl_env :: GlobalRdrEnv
	    gbl_env = foldr plusGlobalRdrEnv emptyGlobalRdrEnv imp_gbl_envs

	    all_avails :: ImportAvails
	    all_avails = foldr plusImportAvails emptyImportAvails imp_avails

		-- ALL DONE
	; return (gbl_env, all_avails) }
  where
	-- 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.
    mk_prel_imports this_mod implicit_prelude
	|  this_mod == pRELUDE
	|| explicit_prelude_import
	|| not implicit_prelude
	= []

	| otherwise = [preludeImportDecl]

    explicit_prelude_import
      = notNull [ () | L _ (ImportDecl mod _ _ _ _) <- imports, 
		       unLoc mod == pRELUDE ]

preludeImportDecl
  = L loc $
	ImportDecl (L loc pRELUDE)
	       False {- Not a boot interface -}
	       False	{- Not qualified -}
	       Nothing	{- No "as" -}
	       Nothing	{- No import list -}
  where
    loc = mkGeneralSrcSpan FSLIT("Implicit import declaration")
\end{code}
	
\begin{code}
importsFromImportDecl :: Module
		      -> LImportDecl RdrName
		      -> RnM (GlobalRdrEnv, ImportAvails)

importsFromImportDecl this_mod
	(L loc (ImportDecl loc_imp_mod_name want_boot qual_only as_mod imp_details))
  = 
    setSrcSpan loc $

	-- If there's an error in loadInterface, (e.g. interface
	-- file not found) we get lots of spurious errors from 'filterImports'
    let
	imp_mod_name = unLoc loc_imp_mod_name
	doc = ppr imp_mod_name <+> ptext SLIT("is directly imported")
    in
    loadSrcInterface doc imp_mod_name want_boot	`thenM` \ iface ->

	-- 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 )

	-- Issue a user warning for a redundant {- SOURCE -} import
	-- NB that we arrange to read all the ordinary imports before 
	-- any of the {- SOURCE -} imports
    warnIf (want_boot && not (mi_boot iface))
	   (warnRedundantSourceImport imp_mod_name)	`thenM_`

    let
	imp_mod	= mi_module iface
	deprecs	= mi_deprecs iface
	is_orph	= mi_orphan iface 
	deps 	= mi_deps iface

	filtered_exports = filter not_this_mod (mi_exports iface)
	not_this_mod (mod,_) = mod /= this_mod
	-- If the module exports anything defined in this module, just ignore it.
	-- Reason: otherwise it looks as if there are two local definition sites
	-- for the thing, and an error gets reported.  Easiest thing is just to
	-- filter them out up front. This situation only arises if a module
	-- imports itself, or another module that imported it.  (Necessarily,
	-- this invoves a loop.)  
	--
	-- Tiresome consequence: if you say
	--	module A where
	--	   import B( AType )
	--	   type AType = ...
	--
	--	module B( AType ) where
	--	   import {-# SOURCE #-} A( AType )
	--
	-- then you'll get a 'B does not export AType' message.  Oh well.

	qual_mod_name = case as_mod of
			  Nothing  	    -> imp_mod_name
			  Just another_name -> another_name
	imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,  
		  		  is_dloc = loc, is_as = qual_mod_name }
    in
	-- Get the total imports, and filter them according to the import list
    ifaceExportNames filtered_exports		`thenM` \ total_avails ->
    filterImports iface imp_spec
		  imp_details total_avails	`thenM` \ (avail_env, gbl_env) ->

    getDOpts `thenM` \ dflags ->

    let
	-- Compute new transitive dependencies

 	orphans | is_orph   = ASSERT( not (imp_mod_name `elem` dep_orphs deps) )
			      imp_mod_name : dep_orphs deps
		| otherwise = dep_orphs deps

	(dependent_mods, dependent_pkgs) 
	   = case mi_package iface of
		HomePackage ->
	    	-- Imported module is from the home package
		-- Take its dependent modules and add imp_mod itself
		-- Take its dependent packages unchanged
		--
		-- NB: (dep_mods deps) might include a hi-boot file
		-- for the module being compiled, CM. Do *not* filter
		-- this out (as we used to), because when we've
		-- finished dealing with the direct imports we want to
		-- know if any of them depended on CM.hi-boot, in
		-- which case we should do the hi-boot consistency
		-- check.  See LoadIface.loadHiBootInterface
		  ((imp_mod_name, want_boot) : dep_mods deps, dep_pkgs deps)

		ExtPackage pkg ->
 	   	-- Imported module is from another package
		-- Dump the dependent modules
		-- Add the package imp_mod comes from to the dependent packages
	         ASSERT2( not (pkg `elem` dep_pkgs deps), ppr pkg <+> ppr (dep_pkgs deps) )
	         ([], pkg : dep_pkgs deps)

	import_all = case imp_details of
			Just (is_hiding, ls)	 -- Imports are spec'd explicitly
			  | not is_hiding -> Just (not (null ls))
			_ -> Nothing		-- Everything is imported, 
						-- (or almost everything [hiding])

	-- unqual_avails is the Avails that are visible in *unqualified* form
	-- We need to know this so we know what to export when we see
	--	module M ( module P ) where ...
	-- Then we must export whatever came from P unqualified.
	imports   = ImportAvails { 
			imp_env      = unitModuleEnv qual_mod_name avail_env,
			imp_mods     = unitModuleEnv imp_mod (imp_mod, import_all, loc),
			imp_orphs    = orphans,
			imp_dep_mods = mkModDeps dependent_mods,
			imp_dep_pkgs = dependent_pkgs }

    in
	-- Complain if we import a deprecated module
    ifOptM Opt_WarnDeprecations	(
       case deprecs of	
	  DeprecAll txt -> addWarn (moduleDeprec imp_mod_name txt)
	  other	        -> returnM ()
    )							`thenM_`

    returnM (gbl_env, imports)

warnRedundantSourceImport mod_name
  = ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
          <+> quotes (ppr mod_name)
\end{code}


%************************************************************************
%*									*
		importsFromLocalDecls
%*									*
%************************************************************************

From the top-level declarations of this module produce
  	* the lexical environment
	* the ImportAvails
created by its bindings.  
	
Complain about duplicate bindings

\begin{code}
importsFromLocalDecls :: HsGroup RdrName -> RnM TcGblEnv
importsFromLocalDecls group
  = do	{ gbl_env  <- getGblEnv

	; names <- getLocalDeclBinders gbl_env group

	; implicit_prelude <- doptM Opt_ImplicitPrelude
	; let {
	    -- Optimisation: filter out names for built-in syntax
	    -- They just clutter up the environment (esp tuples), and the parser
	    -- will generate Exact RdrNames for them, so the cluttered
	    -- envt is no use.  To avoid doing this filter all the time,
	    -- we use -fno-implicit-prelude as a clue that the filter is
	    -- worth while.  Really, it's only useful for GHC.Base and GHC.Tuple.
	    --
	    -- It's worth doing because it makes the environment smaller for
	    -- every module that imports the Prelude
	    --
	    -- Note: don't filter the gbl_env (hence all_names, not filered_all_names
	    -- in defn of gres above).      Stupid reason: when parsing 
	    -- data type decls, the constructors start as Exact tycon-names,
	    -- and then get turned into data con names by zapping the name space;
	    -- but that stops them being Exact, so they get looked up.  
	    -- Ditto in fixity decls; e.g. 	infix 5 :
	    -- Sigh. It doesn't matter because it only affects the Data.Tuple really.
	    -- The important thing is to trim down the exports.
	      filtered_names 
	        | implicit_prelude = names
	        | otherwise	   = filter (not . isBuiltInSyntax) names ;

	    ; this_mod = tcg_mod gbl_env
	    ; imports = emptyImportAvails {
			  imp_env = unitModuleEnv this_mod $
				  mkNameSet filtered_names
		        }
	    }

	; rdr_env' <- extendRdrEnvRn this_mod (tcg_rdr_env gbl_env) names

	; returnM (gbl_env { tcg_rdr_env = rdr_env',
			     tcg_imports = imports `plusImportAvails` tcg_imports gbl_env }) 
	}

extendRdrEnvRn :: Module -> GlobalRdrEnv -> [Name] -> RnM GlobalRdrEnv
-- Add the new locally-bound names one by one, checking for duplicates as
-- we do so.  Remember that in Template Haskell the duplicates
-- might *already be* in the GlobalRdrEnv from higher up the module
extendRdrEnvRn mod rdr_env names
  = foldlM add_local rdr_env names
  where
    add_local rdr_env name
	| gres <- lookupGlobalRdrEnv rdr_env (nameOccName name)
	, (dup_gre:_) <- filter isLocalGRE gres	-- Check for existing *local* defns
	= do { addDupDeclErr (gre_name dup_gre) name
	     ; return rdr_env }
	| otherwise
	= return (extendGlobalRdrEnv rdr_env new_gre)
	where
	  new_gre = GRE {gre_name = name, gre_prov = prov}

    prov = LocalDef mod
\end{code}

@getLocalDeclBinders@ returns the names for an @HsDecl@.  It's
used for source code.

	*** See "THE NAMING STORY" in HsDecls ****

\begin{code}
getLocalDeclBinders :: TcGblEnv -> HsGroup RdrName -> RnM [Name]
getLocalDeclBinders gbl_env (HsGroup {hs_valds = val_decls, 
				      hs_tyclds = tycl_decls, 
				      hs_fords = foreign_decls })
  = do	{ tc_names_s <- mappM new_tc tycl_decls
	; val_names  <- mappM new_simple val_bndrs
	; return (foldr (++) val_names tc_names_s) }
  where
    mod        = tcg_mod gbl_env
    is_hs_boot = isHsBoot (tcg_src gbl_env) ;
    val_bndrs | is_hs_boot = sig_hs_bndrs
	      | otherwise  = for_hs_bndrs ++ val_hs_bndrs
	-- In a hs-boot file, the value binders come from the
	--  *signatures*, and there should be no foreign binders 

    new_simple rdr_name = newTopSrcBinder mod Nothing rdr_name

    sig_hs_bndrs = [nm | HsBindGroup _ lsigs _  <- val_decls, 
			 L _ (Sig nm _) <- lsigs]
    val_hs_bndrs = collectGroupBinders val_decls
    for_hs_bndrs = [nm | L _ (ForeignImport nm _ _ _) <- foreign_decls]

    new_tc tc_decl 
	= do { main_name <- newTopSrcBinder mod Nothing main_rdr
	     ; sub_names <- mappM (newTopSrcBinder mod (Just main_name)) sub_rdrs
	     ; return (main_name : sub_names) }
	where
	  (main_rdr : sub_rdrs) = tyClDeclNames (unLoc tc_decl)
\end{code}


%************************************************************************
%*									*
\subsection{Filtering imports}
%*									*
%************************************************************************

@filterImports@ takes the @ExportEnv@ telling what the imported module makes
available, and filters it through the import spec (if any).

\begin{code}
filterImports :: ModIface
	      -> ImpDeclSpec			-- The span for the entire import decl
	      -> Maybe (Bool, [Located (IE RdrName)])	-- Import spec; True => hiding
	      -> NameSet			-- What's available
	      -> RnM (NameSet,			-- What's imported (qualified or unqualified)
		      GlobalRdrEnv)		-- Same again, but in GRE form

	-- Complains if import spec mentions things that the module doesn't export
        -- Warns/informs if import spec contains duplicates.
			
mkGenericRdrEnv decl_spec names
  = mkGlobalRdrEnv [ GRE { gre_name = name, gre_prov = Imported [imp_spec] }
		   | name <- nameSetToList names ]
  where
    imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }

filterImports iface decl_spec Nothing all_names
  = returnM (all_names, mkGenericRdrEnv decl_spec all_names)

filterImports iface decl_spec (Just (want_hiding, import_items)) all_names
  = mappM (addLocM get_item) import_items 	`thenM` \ gres_s ->
    let
	gres = concat gres_s
	specified_names = mkNameSet (map gre_name gres)
    in
    if not want_hiding then
      return (specified_names, mkGlobalRdrEnv gres)
    else
    let
	keep n = not (n `elemNameSet` specified_names)
	pruned_avails = filterNameSet keep all_names
    in
    return (pruned_avails, mkGenericRdrEnv decl_spec pruned_avails)

  where
    occ_env :: OccEnv Name	-- Maps OccName to corresponding Name
    occ_env = mkOccEnv [(nameOccName n, n) | n <- nameSetToList all_names]
	-- This env will have entries for data constructors too,
	-- they won't make any difference because naked entities like T
	-- in an import list map to TcOccs, not VarOccs.

    sub_env :: NameEnv [Name]
    sub_env = mkSubNameEnv all_names

    bale_out item = addErr (badImportItemErr iface decl_spec item)  `thenM_`
		    returnM []

    succeed_with :: Bool -> [Name] -> RnM [GlobalRdrElt]
    succeed_with all_explicit names
      = do { loc <- getSrcSpanM
	   ; returnM (map (mk_gre loc) names) }
      where
	mk_gre loc name = GRE { gre_name = name, 
				gre_prov = Imported [imp_spec] }
	  where
	    imp_spec  = ImpSpec { is_decl = decl_spec, is_item = item_spec }
	    item_spec = ImpSome { is_explicit = explicit, is_iloc = loc }
	    explicit  = all_explicit || isNothing (nameParent_maybe name)

    get_item :: IE RdrName -> RnM [GlobalRdrElt]
	-- Empty result for a bad item.
	-- Singleton result is typical case.
	-- Can have two when we are hiding, and mention C which might be
	--	both a class and a data constructor.  
    get_item item@(IEModuleContents _) 
      = bale_out item

    get_item item@(IEThingAll tc)
      = case check_item item of
	  []    -> bale_out item

	  [n]   -> -- This occurs when you import T(..), but
			-- only export T abstractly.  The single [n]
			-- in the AvailTC is the type or class itself
			ifOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn tc)) `thenM_`
		     	succeed_with False [n]

	  names -> succeed_with False names

    get_item item@(IEThingAbs n)
      | want_hiding	-- hiding( C ) 
			-- Here the 'C' can be a data constructor 
			--  *or* a type/class, or even both
      = case concat [check_item item, check_item (IEVar data_n)] of
	  []    -> bale_out item
	  names -> succeed_with True names
      where
	data_n = setRdrNameSpace n srcDataName

    get_item item
      = case check_item item of
	  []    -> bale_out item
	  names -> succeed_with True names

    check_item :: IE RdrName -> [Name]
    check_item item 
	= case lookupOccEnv occ_env (rdrNameOcc (ieName item)) of
	    Nothing   -> []
	    Just name -> filterAvail item name sub_env
\end{code}


%************************************************************************
%*									*
\subsection{Export list processing}
%*									*
%************************************************************************

Processing the export list.

You might think that we should record things that appear in the export
list as ``occurrences'' (using @addOccurrenceName@), but you'd be
wrong.  We do check (here) that they are in scope, but there is no
need to slurp in their actual declaration (which is what
@addOccurrenceName@ forces).

Indeed, doing so would big trouble when compiling @PrelBase@, because
it re-exports @GHC@, which includes @takeMVar#@, whose type includes
@ConcBase.StateAndSynchVar#@, and so on...

\begin{code}
type ExportAccum	-- The type of the accumulating parameter of
			-- the main worker function in rnExports
     = ([Module], 		-- 'module M's seen so far
	ExportOccMap,		-- Tracks exported occurrence names
	NameSet)		-- The accumulated exported stuff
emptyExportAccum = ([], emptyOccEnv, emptyNameSet) 

type ExportOccMap = OccEnv (Name, IE RdrName)
	-- Tracks what a particular exported OccName
	--   in an export list refers to, and which item
	--   it came from.  It's illegal to export two distinct things
	--   that have the same occurrence name


rnExports :: Bool  -- False => no 'module M(..) where' header at all
	  -> Maybe [Located (IE RdrName)] -- Nothing => no explicit export list
	  -> RnM NameSet
	-- Complains if two distinct exports have same OccName
        -- Warns about identical exports.
	-- Complains about exports items not in scope

rnExports explicit_mod exports
 = do { TcGblEnv { tcg_rdr_env = rdr_env, 
		   tcg_imports = imports } <- getGblEnv ;

	-- If the module header is omitted altogether, then behave
	-- as if the user had written "module Main(main) where..."
	-- EXCEPT in interactive mode, when we behave as if he had
	-- written "module Main where ..."
	-- Reason: don't want to complain about 'main' not in scope
	--	   in interactive mode
	ghci_mode <- getGhciMode ;
	let { real_exports 
		| explicit_mod   	   = exports
		| ghci_mode == Interactive = Nothing
		| otherwise 		   = Just [noLoc (IEVar main_RDR_Unqual)] } ;
		-- ToDo: the 'noLoc' here is unhelpful if 'main' turns out to be out of scope
	exports_from_avail real_exports rdr_env imports }


exports_from_avail Nothing rdr_env imports
 =  	-- Export all locally-defined things
	-- We do this by filtering the global RdrEnv,
	-- keeping only things that are locally-defined
   return (mkNameSet [ gre_name gre 
		     | gre <- globalRdrEnvElts rdr_env,
		       isLocalGRE gre ])

exports_from_avail (Just items) rdr_env (ImportAvails { imp_env = imp_env }) 
  = foldlM do_litem emptyExportAccum items    `thenM` \ (_, _, exports) ->
    returnM exports
  where
    sub_env :: NameEnv [Name]	-- Classify each name by its parent
    sub_env = mkSubNameEnv (foldModuleEnv unionNameSets emptyNameSet imp_env)

    do_litem :: ExportAccum -> Located (IE RdrName) -> RnM ExportAccum
    do_litem acc = addLocM (exports_from_item acc)

    exports_from_item :: ExportAccum -> IE RdrName -> RnM ExportAccum
{'fraction_non_alphanumeric': 0.11115543808906397, 'fraction_numerical': 0.0010472248541365382, 'mean_word_length': 3.2142481874540296, 'pattern_counts': {'":': 0, '<': 57, '<?xml version=': 0, '>': 107, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3806732', 'n_tokens_mistral': 14146, 'n_tokens_neox': 12960, 'n_words': 4170}