<commit_before>%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[RnEnv]{Environment manipulation for the renamer monad}

\begin{code}
module RnEnv where		-- Export everything

#include "HsVersions.h"

import CmdLineOpts	( opt_WarnNameShadowing, opt_WarnUnusedMatches,
			  opt_WarnUnusedBinds, opt_WarnUnusedImports )
import HsSyn
import RdrHsSyn		( RdrNameIE )
import RnHsSyn		( RenamedHsType )
import RdrName		( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual,
			  mkRdrUnqual, qualifyRdrName
			)
import HsTypes		( getTyVarName, replaceTyVarName )

import RnMonad
import Name		( Name, Provenance(..), ExportFlag(..), NamedThing(..),
			  ImportReason(..), getSrcLoc, 
			  mkLocalName, mkImportedLocalName, mkGlobalName, mkUnboundName,
			  mkIPName, isSystemName, isWiredInName,
			  nameOccName, setNameModule, nameModule,
			  pprOccName, isLocallyDefined, nameUnique, nameOccName,
                          occNameUserString,
			  setNameProvenance, getNameProvenance, pprNameProvenance
			)
import NameSet
import OccName		( OccName,
			  mkDFunOcc, occNameUserString, occNameString,
			  occNameFlavour
			)
import TysWiredIn	( tupleTyCon, unboxedTupleTyCon, listTyCon )
import Type		( funTyCon )
import Module		( ModuleName, mkThisModule, moduleName, mkVanillaModule )
import TyCon		( TyCon )
import FiniteMap
import Unique		( Unique, Uniquable(..) )
import UniqFM           ( emptyUFM, listToUFM, plusUFM_C )
import UniqSupply
import SrcLoc		( SrcLoc, noSrcLoc )
import Outputable
import Util		( removeDups, equivClasses, thenCmp )
import List		( nub )
import Maybes		( mapMaybe )
\end{code}



%*********************************************************
%*							*
\subsection{Making new names}
%*							*
%*********************************************************

\begin{code}
newLocalTopBinder :: Module -> OccName 
	       -> (Name -> ExportFlag) -> SrcLoc
	       -> RnM d Name
newLocalTopBinder mod occ rec_exp_fn loc
  = newTopBinder mod occ (\name -> setNameProvenance name (LocalDef loc (rec_exp_fn name)))
	-- We must set the provenance of the thing in the cache
	-- correctly, particularly whether or not it is locally defined.
	--
	-- Since newLocalTopBinder is used only
	-- at binding occurrences, we may as well get the provenance
	-- dead right first time; hence the rec_exp_fn passed in

newImportedBinder :: Module -> RdrName -> RnM d Name
newImportedBinder mod rdr_name
  = ASSERT2( isUnqual rdr_name, ppr rdr_name )
    newTopBinder mod (rdrNameOcc rdr_name) (\name -> name)
	-- Provenance is already implicitImportProvenance

implicitImportProvenance = NonLocalDef ImplicitImport False

newTopBinder :: Module -> OccName -> (Name -> Name) -> RnM d Name
newTopBinder mod occ set_prov
  = 	-- First check the cache
    getNameSupplyRn		`thenRn` \ (us, inst_ns, cache, ipcache) ->
    let 
	key          = (moduleName mod, occ)
    in
    case lookupFM cache key of

	-- A hit in the cache! 
	-- Set the Module of the thing, and set its provenance (hack pending 
	-- 	spj update)
	--
	-- It also means that if there are two defns for the same thing
	-- in a module, then each gets a separate SrcLoc
	--
	-- There's a complication for wired-in names.  We don't want to
	-- forget that they are wired in even when compiling that module
	-- (else we spit out redundant defns into the interface file)
	-- So for them we just set the provenance

	Just name -> let 
			new_name  = set_prov (setNameModule name mod)
			new_cache = addToFM cache key new_name
		     in
		     setNameSupplyRn (us, inst_ns, new_cache, ipcache)	`thenRn_`
		     returnRn new_name
		     
	-- Miss in the cache!
	-- Build a completely new Name, and put it in the cache
	Nothing -> let
			(us', us1) = splitUniqSupply us
			uniq   	   = uniqFromSupply us1
			new_name   = set_prov (mkGlobalName uniq mod occ implicitImportProvenance)
			new_cache  = addToFM cache key new_name
		   in
		   setNameSupplyRn (us', inst_ns, new_cache, ipcache)	`thenRn_`
		   returnRn new_name


mkImportedGlobalName :: ModuleName -> OccName -> RnM d Name
  -- Used for *occurrences*.  We make a place-holder Name, really just
  -- to agree on its unique, which gets overwritten when we read in
  -- the binding occurence later (newImportedBinder)
  -- The place-holder Name doesn't have the right Provenance, and its
  -- Module won't have the right Package either
  --
  -- This means that a renamed program may have incorrect info
  -- on implicitly-imported occurrences, but the correct info on the 
  -- *binding* declaration. It's the type checker that propagates the 
  -- correct information to all the occurrences.
  -- Since implicitly-imported names never occur in error messages,
  -- it doesn't matter that we get the correct info in place till later,
  -- (but since it affects DLL-ery it does matter that we get it right
  --  in the end).
mkImportedGlobalName mod_name occ
  = getNameSupplyRn		`thenRn` \ (us, inst_ns, cache, ipcache) ->
    let
	key = (mod_name, occ)
    in
    case lookupFM cache key of
	Just name -> returnRn name
	Nothing   -> setNameSupplyRn (us', inst_ns, new_cache, ipcache)	`thenRn_`
		     returnRn name
		  where
		     (us', us1) = splitUniqSupply us
		     uniq   	= uniqFromSupply us1
		     mod        = mkVanillaModule mod_name
		     name       = mkGlobalName uniq mod occ implicitImportProvenance
		     new_cache  = addToFM cache key name

updateProvenances :: [Name] -> RnM d ()
updateProvenances names
  = getNameSupplyRn		`thenRn` \ (us, inst_ns, cache, ipcache) ->
    setNameSupplyRn (us, inst_ns, update cache names, ipcache)
  where
    update cache [] 	      = cache
    update cache (name:names) = WARN( not (key `elemFM` cache), ppr name )
				update (addToFM cache key name) names
 			      where
				key = (moduleName (nameModule name), nameOccName name)


mkImportedGlobalFromRdrName :: RdrName -> RnM d Name 
mkImportedGlobalFromRdrName rdr_name
  | isQual rdr_name
  = mkImportedGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)

  | otherwise
  =	-- An Unqual is allowed; interface files contain 
	-- unqualified names for locally-defined things, such as
	-- constructors of a data type.
    getModuleRn 			`thenRn ` \ mod_name ->
    mkImportedGlobalName mod_name (rdrNameOcc rdr_name)


getIPName rdr_name
  = getNameSupplyRn		`thenRn` \ (us, inst_ns, cache, ipcache) ->
    case lookupFM ipcache key of
	Just name -> returnRn name
	Nothing   -> setNameSupplyRn (us', inst_ns, cache, new_ipcache)	`thenRn_`
		     returnRn name
		  where
		     (us', us1)  = splitUniqSupply us
		     uniq   	 = uniqFromSupply us1<commit_msg>[project @ 2000-05-09 13:15:37 by simonpj] Get package names right.  Again.<commit_after>%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[RnEnv]{Environment manipulation for the renamer monad}

\begin{code}
module RnEnv where		-- Export everything

#include "HsVersions.h"

import CmdLineOpts	( opt_WarnNameShadowing, opt_WarnUnusedMatches,
			  opt_WarnUnusedBinds, opt_WarnUnusedImports )
import HsSyn
import RdrHsSyn		( RdrNameIE )
import RnHsSyn		( RenamedHsType )
import RdrName		( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual,
			  mkRdrUnqual, qualifyRdrName
			)
import HsTypes		( getTyVarName, replaceTyVarName )

import RnMonad
import Name		( Name, Provenance(..), ExportFlag(..), NamedThing(..),
			  ImportReason(..), getSrcLoc, 
			  mkLocalName, mkImportedLocalName, mkGlobalName, mkUnboundName,
			  mkIPName, isSystemName, isWiredInName,
			  nameOccName, setNameModule, nameModule,
			  pprOccName, isLocallyDefined, nameUnique, nameOccName,
                          occNameUserString,
			  setNameProvenance, getNameProvenance, pprNameProvenance
			)
import NameSet
import OccName		( OccName,
			  mkDFunOcc, occNameUserString, occNameString,
			  occNameFlavour
			)
import TysWiredIn	( tupleTyCon, unboxedTupleTyCon, listTyCon )
import Type		( funTyCon )
import Module		( ModuleName, mkThisModule, moduleName, mkVanillaModule )
import TyCon		( TyCon )
import FiniteMap
import Unique		( Unique, Uniquable(..) )
import UniqFM           ( emptyUFM, listToUFM, plusUFM_C )
import UniqSupply
import SrcLoc		( SrcLoc, noSrcLoc )
import Outputable
import Util		( removeDups, equivClasses, thenCmp )
import List		( nub )
import Maybes		( mapMaybe )
\end{code}



%*********************************************************
%*							*
\subsection{Making new names}
%*							*
%*********************************************************

\begin{code}
newLocalTopBinder :: Module -> OccName 
	       -> (Name -> ExportFlag) -> SrcLoc
	       -> RnM d Name
newLocalTopBinder mod occ rec_exp_fn loc
  = newTopBinder mod occ (\name -> setNameProvenance name (LocalDef loc (rec_exp_fn name)))
	-- We must set the provenance of the thing in the cache
	-- correctly, particularly whether or not it is locally defined.
	--
	-- Since newLocalTopBinder is used only
	-- at binding occurrences, we may as well get the provenance
	-- dead right first time; hence the rec_exp_fn passed in

newImportedBinder :: Module -> RdrName -> RnM d Name
newImportedBinder mod rdr_name
  = ASSERT2( isUnqual rdr_name, ppr rdr_name )
    newTopBinder mod (rdrNameOcc rdr_name) (\name -> name)
	-- Provenance is already implicitImportProvenance

implicitImportProvenance = NonLocalDef ImplicitImport False

newTopBinder :: Module -> OccName -> (Name -> Name) -> RnM d Name
newTopBinder mod occ set_prov
  = 	-- First check the cache
    getNameSupplyRn		`thenRn` \ (us, inst_ns, cache, ipcache) ->
    let 
	key          = (moduleName mod, occ)
    in
    case lookupFM cache key of

	-- A hit in the cache! 
	-- Set the Module of the thing, and set its provenance (hack pending 
	-- 	spj update)
	--
	-- It also means that if there are two defns for the same thing
	-- in a module, then each gets a separate SrcLoc
	--
	-- There's a complication for wired-in names.  We don't want to
	-- forget that they are wired in even when compiling that module
	-- (else we spit out redundant defns into the interface file)
	-- So for them we just set the provenance

	Just name -> let 
			new_name  = set_prov (setNameModule name mod)
			new_cache = addToFM cache key new_name
		     in
		     setNameSupplyRn (us, inst_ns, new_cache, ipcache)	`thenRn_`
		     returnRn new_name
		     
	-- Miss in the cache!
	-- Build a completely new Name, and put it in the cache
	Nothing -> let
			(us', us1) = splitUniqSupply us
			uniq   	   = uniqFromSupply us1
			new_name   = set_prov (mkGlobalName uniq mod occ implicitImportProvenance)
			new_cache  = addToFM cache key new_name
		   in
		   setNameSupplyRn (us', inst_ns, new_cache, ipcache)	`thenRn_`
		   returnRn new_name


mkImportedGlobalName :: ModuleName -> OccName -> RnM d Name
  -- Used for *occurrences*.  We make a place-holder Name, really just
  -- to agree on its unique, which gets overwritten when we read in
  -- the binding occurence later (newImportedBinder)
  -- The place-holder Name doesn't have the right Provenance, and its
  -- Module won't have the right Package either
  --
  -- This means that a renamed program may have incorrect info
  -- on implicitly-imported occurrences, but the correct info on the 
  -- *binding* declaration. It's the type checker that propagates the 
  -- correct information to all the occurrences.
  -- Since implicitly-imported names never occur in error messages,
  -- it doesn't matter that we get the correct info in place till later,
  -- (but since it affects DLL-ery it does matter that we get it right
  --  in the end).
mkImportedGlobalName mod_name occ
  = getNameSupplyRn		`thenRn` \ (us, inst_ns, cache, ipcache) ->
    let
	key = (mod_name, occ)
    in
    case lookupFM cache key of
	Just name -> returnRn name
	Nothing   -> setNameSupplyRn (us', inst_ns, new_cache, ipcache)	`thenRn_`
		     returnRn name
		  where
		     (us', us1) = splitUniqSupply us
		     uniq   	= uniqFromSupply us1
		     mod        = mkVanillaModule mod_name
		     name       = mkGlobalName uniq mod occ implicitImportProvenance
		     new_cache  = addToFM cache key name

updateProvenances :: [Name] -> RnM d ()
-- Update the provenances of everything that is in scope.
-- We must be careful not to disturb the Module package info
-- already in the cache.  Why not?  Consider
--   module A		module M( f )
--	import M( f )	  import N( f)
--	import N
-- So f is defined in N, and M re-exports it.
-- When processing module A:
--	1. We read M.hi first, and make a vanilla name N.f 
--	   (without reading N.hi). The package info says <THIS> 
--	   for lack of anything better.  
--	2. Now we read N, which update the cache to record 
--	   the correct package for N.f.
--	3. Finally we update provenances (once we've read all imports).
-- Step 3 must not destroy package info recorded in Step 2.

updateProvenances names
  = getNameSupplyRn		`thenRn` \ (us, inst_ns, cache, ipcache) ->
    setNameSupplyRn (us, inst_ns, foldr update cache names, ipcache)
  where
    update name cache = addToFM_C update_prov cache key name
		      where
		   	key = (moduleName (nameModule name), nameOccName name)

    update_prov name_in_cache name_with_prov
	= setNameProvenance name_in_cache (getNameProvenance name_with_prov)
			


mkImportedGlobalFromRdrName :: RdrName -> RnM d Name 
mkImportedGlobalFromRdrName rdr_name
  | isQual rdr_name
  = mkImportedGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)

  | otherwise
  =	-- An Unqual is allowed; interface files contain 
	-- unqualified names for locally-defined things, such as
	-- constructors of a data type.
    getModuleRn 			`thenRn ` \ mod_name ->
    mkImportedGlobalName mod_name (rdrNameOcc rdr_name)


getIPName rdr_name
  = getNameSupplyRn		`thenRn` \ (us, inst_ns, cache, ipcache) ->
    case lookupFM ipcache key of
	Just name -> returnRn name
	Nothing   -> setNameSupplyRn (us', inst_ns, cache, new_ipcache)	`thenRn_`
		     returnRn name
		  where
		     (us', us1)  = splitUniqSupply us
		     uniq   	 = uniqFromSupply us1
{'fraction_non_alphanumeric': 0.09305148896665, 'fraction_numerical': 0.003499250160679854, 'mean_word_length': 3.293071735131821, 'pattern_counts': {'":': 0, '<': 4, '<?xml version=': 0, '>': 60, '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': '7460667', 'n_tokens_mistral': 4910, 'n_tokens_neox': 4540, 'n_words': 1540}