The GHC Commentary - The Glorious Renamer

The renamer sits between the parser and the typechecker. However, its operation is quite tightly interwoven with the typechecker. This is partially due to support for Template Haskell, where spliced code has to be renamed and type checked. In particular, top-level splices lead to multiple rounds of renaming and type checking.

The main externally used functions of the renamer are provided by the module rename/RnSource.lhs. In particular, we have

rnSrcDecls  :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
rnSplice    :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)

All of which execute in the renamer monad RnM. The first function, rnSrcDecls renames a binding group; the second, rnTyClDecls renames a list of (toplevel) type and class declarations; and the third, rnSplice renames a Template Haskell splice. As the types indicate, the main task of the renamer is to convert converts all the RdrNames to Names, which includes a number of well-formedness checks (no duplicate declarations, all names are in scope, and so on). In addition, the renamer performs other, not strictly name-related, well-formedness checks, which includes checking that the appropriate flags have been supplied whenever language extensions are used in the source.

RdrNames

A RdrName.RdrName is pretty much just a string (for an unqualified name like "f") or a pair of strings (for a qualified name like "M.f"):

data RdrName 
  = Unqual OccName
	-- Used for ordinary, unqualified occurrences 

  | Qual Module OccName
	-- A qualified name written by the user in 
	--  *source* code.  The module isn't necessarily 
	-- the module where the thing is defined; 
	-- just the one from which it is imported

  | Orig Module OccName
	-- An original name; the module is the *defining* module.
	-- This is used when GHC generates code that will be fed
	-- into the renamer (e.g. from deriving clauses), but where
	-- we want to say "Use Prelude.map dammit".  
 
  | Exact Name
	-- We know exactly the Name. This is used 
	--  (a) when the parser parses built-in syntax like "[]" 
	--	and "(,)", but wants a RdrName from it
	--  (b) when converting names to the RdrNames in IfaceTypes
	--	Here an Exact RdrName always contains an External Name
	--	(Internal Names are converted to simple Unquals)
	--  (c) by Template Haskell, when TH has generated a unique name

The OccName type is described in The truth about names.

The Renamer Monad

Due to the tight integration of the renamer with the typechecker, both use the same monad in recent versions of GHC. So, we have

type RnM  a = TcRn a		-- Historical
type TcM  a = TcRn a		-- Historical

with the combined monad defined as

type TcRn a       = TcRnIf TcGblEnv TcLclEnv a
type TcRnIf a b c = IOEnv (Env a b) c

data Env gbl lcl	-- Changes as we move into an expression
  = Env {
	env_top	 :: HscEnv,	-- Top-level stuff that never changes
				-- Includes all info about imported things

	env_us   :: TcRef UniqSupply,	-- Unique supply for local varibles

	env_gbl  :: gbl,	-- Info about things defined at the top level
				-- of the module being compiled

	env_lcl  :: lcl		-- Nested stuff; changes as we go into 
				-- an expression
    }

the details of the global environment type TcGblEnv and local environment type TcLclEnv are also defined in the module typecheck/TcRnTypes.lhs. The monad IOEnv is defined in utils/IOEnv.hs and extends the vanilla IO monad with an additional state parameter env that is treated as in a reader monad. (Side effecting operations, such as updating the unique supply, are done with TcRefs, which are simply a synonym for IORefs.)

Name Space Management

As anticipated by the variants Orig and Exact of RdrName some names should not change during renaming, whereas others need to be turned into unique names. In this context, the two functions RnEnv.newTopSrcBinder and RnEnv.newLocals are important:

newTopSrcBinder :: Module -> Maybe Name -> Located RdrName -> RnM Name
newLocalsRn     :: [Located RdrName] -> RnM [Name]

The two functions introduces new toplevel and new local names, respectively, where the first two arguments to newTopSrcBinder determine the currently compiled module and the parent construct of the newly defined name. Both functions create new names only for RdrNames that are neither exact nor original.

Introduction of Toplevel Names: Global RdrName Environment

A global RdrName environment RdrName.GlobalRdrEnv is a map from OccNames to lists of qualified names. More precisely, the latter are Names with an associated Provenance:

data Provenance
  = LocalDef		-- Defined locally
	Module

  | Imported 		-- Imported
	[ImportSpec]	-- INVARIANT: non-empty
	Bool		-- True iff the thing was named *explicitly* 
			-- in *any* of the import specs rather than being 
			-- imported as part of a group; 
	-- e.g.
	--	import B
	--	import C( T(..) )
	-- Here, everything imported by B, and the constructors of T
	-- are not named explicitly; only T is named explicitly.
	-- This info is used when warning of unused names.

The part of the global RdrName environment for a module that contains the local definitions is created by the function RnNames.importsFromLocalDecls, which also computes a data structure recording all imported declarations in the form of a value of type TcRnTypes.ImportAvails.

The function importsFromLocalDecls, in turn, makes use of RnNames.getLocalDeclBinders :: Module -> HsGroup RdrName -> RnM [AvailInfo] to extract all declared names from a binding group, where HscTypes.AvailInfo is essentially a collection of Names; i.e., getLocalDeclBinders, on the fly, generates Names from the RdrNames of all top-level binders of the module represented by the HsGroup RdrName argument.

It is important to note that all this happens before the renamer actually descends into the toplevel bindings of a module. In other words, before TcRnDriver.rnTopSrcDecls performs the renaming of a module by way of RnSource.rnSrcDecls, it uses importsFromLocalDecls to set up the global RdrName environment, which contains Names for all imported and all locally defined toplevel binders. Hence, when the helpers of rnSrcDecls come across the defining occurences of a toplevel RdrName, they don't rename it by generating a new name, but they simply look up its name in the global RdrName environment.

Rebindable syntax

In Haskell when one writes "3" one gets "fromInteger 3", where "fromInteger" comes from the Prelude (regardless of whether the Prelude is in scope). If you want to completely redefine numbers, that becomes inconvenient. So GHC lets you say "-fno-implicit-prelude"; in that case, the "fromInteger" comes from whatever is in scope. (This is documented in the User Guide.)

This feature is implemented as follows (I always forget).

Last modified: Wed May 4 17:16:15 EST 2005