path: root/ghc/compiler/rename/Rename1.lhs

%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
%
\section[Rename1]{@Rename1@: gather up imported information}

See the @Rename@ module for a basic description of the renamer.

\begin{code}
#include "HsVersions.h"

module Rename1 (
	rnModule1,

	-- for completeness
	Module, Bag, ProtoNamePat(..), InPat, Maybe,
	PprStyle, Pretty(..), PrettyRep, ProtoName, Name,
	PreludeNameFun(..), PreludeNameFuns(..)
    ) where

IMPORT_Trace		-- ToDo: rm
import Pretty		-- these two too
import Outputable

import AbsSyn
import AbsSynFuns	( getMentionedVars ) -- *** not via AbsSyn ***
import Bag		( Bag, emptyBag, unitBag, snocBag, unionBags, bagToList )
import Errors
import HsPragmas
import FiniteMap
import Maybes		( maybeToBool, catMaybes, Maybe(..) )
--OLD: import NameEnv	( mkStringLookupFn )
import ProtoName	( ProtoName(..), mkPreludeProtoName )
import RenameAuxFuns
import RenameMonad12
import Util
\end{code}


%************************************************************************
%*									*
\subsection{Types and things used herein}
%*									*
%************************************************************************

@AllIntDecls@ is the type returned from processing import statement(s)
in the main module.

\begin{code}
type AllIntDecls = ([ProtoNameFixityDecl], [ProtoNameTyDecl],
		    [ProtoNameClassDecl],  [ProtoNameInstDecl],
		    [ProtoNameSig], Bag FAST_STRING)
\end{code}

The selective-import function @SelectiveImporter@ maps a @ProtoName@
to something which indicates how much of the thing, if anything, is
wanted by the importing module.
\begin{code}
type SelectiveImporter = ProtoName -> Wantedness

data Wantedness
  = Wanted
  | NotWanted
  | WantedWith IE
\end{code}

The @ProtoNames@ supplied to these ``name functions'' are always
@Unks@, unless they are fully-qualified names, which occur only in
interface pragmas (and, therefore, never on the {\em definitions} of
things).  That doesn't happen in @Rename1@!
\begin{code}
type IntNameFun	  = ProtoName -> ProtoName
type IntTCNameFun = ProtoName -> (ProtoName, IntNameFun)
\end{code}

%************************************************************************
%*									*
\subsection{First pass over the entire module}
%*									*
%************************************************************************

This pass flattens out the declarations embedded within the interfaces
which this module imports.  The result is a new module with no
imports, but with more declarations.  The declarations which arose
from the imported interfaces will have @ProtoNames@ with @Imp@
constructors; the declarations in the body of this module are
unaffected, so they will still be @Unk@'s.

We import only the declarations from interfaces which are actually {\em
used}.  This saves time later, because we don't need process the
unused ones.

\begin{code}
rnModule1 :: PreludeNameFuns
	  -> Bool		-- see use below
	  -> ProtoNameModule
	  -> Rn12M (ProtoNameModule, [FAST_STRING])

rnModule1 pnf@(v_pnf, tc_pnf)
	use_mentioned_vars_heuristic
	(Module mod_name exports imports fixes
		ty_decls absty_sigs class_decls inst_decls specinst_sigs
		defaults binds _ src_loc)

  =	-- slurp through the *body* of the module, collecting names of
	-- mentioned *variables*, 3+ letters long & not prelude names.
	-- Note: we *do* have to pick up top-level binders,
	-- so we can check for conflicts with imported guys!
    let
{- OLD:MENTIONED-}
	(uses_Mdotdot_in_exports, mentioned_vars)
	  = getMentionedVars v_pnf exports fixes class_decls inst_decls binds

	-- Using the collected "mentioned" variables, create an
	-- "is-mentioned" function (:: FAST_STRING -> Bool), which gives
	-- True if something is mentioned is in the list collected.
	-- For more details, see under @selectAll@, notably the
	-- handling of short (< 3 chars) names.

	-- Note: this "is_mentioned" game doesn't work if the export
	-- list includes any M.. constructs (because that mentions
	-- variables *implicitly*, basically).  getMentionedVars tells
	-- us this, and we act accordingly.

	is_mentioned_maybe
	  = lookupFM {-OLD: mkStringLookupFn-} (listToFM
		[ (x, panic "is_mentioned_fn")
		| x <- mentioned_vars ++ needed_for_deriving ]
		)
		-- OLD: False{-not-sorted-}
	  where
	    needed_for_deriving	-- is this a HACK or what?
	      = [ SLIT("&&"),
		  SLIT("."),
		  SLIT("lex"),
		  SLIT("map"),
		  SLIT("not"),
		  SLIT("readParen"),
		  SLIT("showParen"),
		  SLIT("showSpace__"),
		  SLIT("showString")
		]

	is_mentioned_fn
	  = if use_mentioned_vars_heuristic
	    && not (uses_Mdotdot_in_exports)
	    then \ x -> maybeToBool (is_mentioned_maybe x)
	    else \ x -> True
{- OLD:MENTIONED-}
--O:M	is_mentioned_fn = \ x -> True -- ToDo: delete altogether
    in
	-- OK, now do the business:
    doImportedIfaces pnf is_mentioned_fn imports
		 `thenRn12`  \ (int_fixes, int_ty_decls,
				int_class_decls, int_inst_decls,
				int_sigs, import_names) ->
    let
	inst_decls' = doRevoltingInstDecls tc_nf inst_decls
    in
    returnRn12
	 ((Module mod_name
		exports imports -- passed along mostly for later checking
		(int_fixes	  ++ fixes)
		(int_ty_decls	  ++ ty_decls)
		absty_sigs
		(int_class_decls ++ class_decls)
		(int_inst_decls  ++ inst_decls')
		specinst_sigs
		defaults
		binds
		int_sigs
		src_loc),
	  bagToList import_names)
  where
    -- This function just spots prelude names
    tc_nf pname@(Unk s) = case (tc_pnf s) of
			   Nothing   -> pname
			   Just name -> Prel name

    tc_nf other_pname	= panic "In tc_nf passed to doRevoltingInstDecls"
	-- The only place where Imps occur is on Ids in unfoldings;
	-- this function is only used on type-things.
\end{code}

Instance declarations in the module itself are treated in a horribly
special way.  Because their class name and type constructor will be
compared against imported ones in the second pass (to eliminate
duplicate instance decls) we need to make Prelude classes and tycons
appear as such.  (For class and type decls, the module can't be
declaring a prelude class or tycon, so Prel and Unk things can just
compare non-equal.)  This is a HACK.

\begin{code}
doRevoltingInstDecls :: IntNameFun -> [ProtoNameInstDecl] -> [ProtoNameInstDecl]

doRevoltingInstDecls tc_nf decls
  = map revolt_me decls
  where
    revolt_me (InstDecl context cname ty binds True modname imod uprags pragma src_loc)
      = InstDecl
	    context			-- Context unchanged
	    (tc_nf cname)		-- Look up the class
	    (doIfaceMonoType1 tc_nf ty)	-- Ditto the type
	    binds			-- Binds unchanged
	    True
	    modname
	    imod
	    uprags
	    pragma
	    src_loc
\end{code}

%************************************************************************
%*									*
\subsection{Process a module's imported interfaces}
%*									*
%************************************************************************

@doImportedIfaces@ processes the entire set of interfaces imported by the
module being renamed.

\begin{code}
doImportedIfaces :: PreludeNameFuns
	      -> (FAST_STRING -> Bool)
	      -> [ProtoNameImportedInterface]
	      -> Rn12M AllIntDecls

doImportedIfaces pnfs is_mentioned_fn []
  = returnRn12 ( [{-fixities-}],  [{-tydecls-}], [{-clasdecls-}],
		 [{-instdecls-}], [{-sigs-}], emptyBag )

doImportedIfaces pnfs is_mentioned_fn (iface:ifaces)
  = doOneIface  pnfs is_mentioned_fn iface
			 `thenRn12` \ (ifixes1, itd1, icd1, iid1, isd1, names1) ->

    doImportedIfaces pnfs is_mentioned_fn ifaces
			 `thenRn12` \ (ifixes2, itd2, icd2, iid2, isd2, names2) ->

    returnRn12 (ifixes1 ++ ifixes2,
		itd1 ++ itd2,
		icd1 ++ icd2,
		iid1 ++ iid2,
		isd1 ++ isd2,
		names1 `unionBags` names2)
\end{code}

\begin{code}
doOneIface pnfs is_mentioned_fn (ImportAll int renamings)
  = let
	renaming_fn = mkRenamingFun renamings
	-- if there are any renamings, then we don't use
	-- the "is_mentioned_fn" hack; possibly dangerous (paranoia reigns)
	revised_is_mentioned_fn
	  = if null renamings
	    then is_mentioned_fn
	    else (\ x -> True) -- pretend everything is mentioned
    in
--  pprTrace "ImportAll:mod_rns:" (ppr PprDebug renamings) (
    doIface1 renaming_fn pnfs (selectAll renaming_fn revised_is_mentioned_fn) int
--  )

doOneIface pnfs unused_is_mentioned_fn (ImportSome int ie_list renamings)
  = --pprTrace "ImportSome:mod_rns:" (ppr PprDebug renamings) (
    doIface1 (mkRenamingFun renamings) pnfs si_fun int
    --)
  where
    -- the `selective import' function should not be applied
    -- to the Imps that occur on Ids in unfoldings.

    si_fun (Unk str) = check_ie str ie_list
    si_fun other     = panic "si_fun in doOneIface"

    check_ie name [] = NotWanted
    check_ie name (ie:ies)
      = case ie of
	      IEVar n		  | name == n -> Wanted
	      IEThingAbs n	  | name == n -> WantedWith ie
	      IEThingAll n	  | name == n -> WantedWith ie
	      IEConWithCons n ns  | name == n -> WantedWith ie
	      IEClsWithOps n ns	  | name == n -> WantedWith ie
	      IEModuleContents _	      -> panic "Module.. in import list?"
	      other			      -> check_ie name ies

doOneIface pnfs unused_is_mentioned_fn (ImportButHide int ie_list renamings)
  = --pprTrace "ImportButHide:mod_rns:" (ppr PprDebug renamings) (
    doIface1 (mkRenamingFun renamings) pnfs si_fun int
    --)
  where
    -- see comment above:

    si_fun (Unk str) | str `elemFM` entity_info = NotWanted
		     | otherwise		= Wanted

    entity_info = fst (getIEStrings ie_list)
\end{code}

@selectAll@ ``normally'' creates an @SelectiveImporter@ that declares
everything from an interface to be @Wanted@.  We may, however, pass
in a more discriminating @is_mentioned_fn@ (returns @True@ if the
named entity is mentioned in the body of the module in question), which
can be used to trim off junk from an interface.

For @selectAll@ to say something is @NotWanted@, it must be a
variable, it must not be in the collected-up list of mentioned
variables (checked with @is_mentioned_fn@), and it must be three chars
or longer.

And, of course, we mustn't forget to take account of renaming!

ADR Question: What's so magical about names longer than 3 characters?
Why would we want to keep long names which aren't mentioned when we're
quite happy to throw away short names that aren't mentioned?

\begin{code}
selectAll :: (FAST_STRING -> FAST_STRING) -> (FAST_STRING -> Bool) -> SelectiveImporter

selectAll renaming_fn is_mentioned_fn (Unk str) -- gotta be an Unk
  = let
	rn_str = renaming_fn str
    in
    if (isAvarid rn_str)
    && (not (is_mentioned_fn rn_str))
    && (_UNPK_ rn_str `lengthExceeds` 2)
    then NotWanted
    else Wanted
\end{code}


%************************************************************************
%*									*
\subsection{First pass over a particular interface}
%*									*
%************************************************************************


@doIface1@ handles a specific interface. First it looks at the
interface imports, creating a bag that maps local names back to their
original names, from which it makes a function that does the same. It
then uses this function to create a triple of bags for the interface
type, class and value declarations, in which local names have been
mapped back into original names.

Notice that @mkLocalNameFun@ makes two different functions. The first
is the name function for the interface. This takes a local name and
provides an original name for any name in the interface by using
either of:
\begin{itemize}
\item
the original name produced by the renaming function;
\item
the local name in the interface and the interface name.
\end{itemize}

The function @doIfaceImports1@ receives two association lists which will
be described at its definition.

\begin{code}
doIface1 :: (FAST_STRING -> FAST_STRING)    -- Renamings in import stmt of module
       -> PreludeNameFuns
       -> SelectiveImporter
       -> ProtoNameInterface
       -> Rn12M AllIntDecls

doIface1 mod_rn_fn (v_pnf, tc_pnf) sifun
       (MkInterface i_name import_decls fix_decls ty_decls class_decls
		    inst_decls sig_decls anns)

  = doIfaceImports1 mod_rn_fn i_name import_decls	`thenRn12` \ (v_bag, tc_bag) ->
    do_body (v_bag, tc_bag)
  where
    do_body (v_bag, tc_bag)
      = report_all_errors			`thenRn12` \ _ ->

	doIfaceTyDecls1 sifun full_tc_nf ty_decls	`thenRn12` \ ty_decls' ->

	doIfaceClassDecls1 sifun full_tc_nf class_decls  `thenRn12` \ class_decls' ->

	let sig_decls'	= doIfaceSigs1 sifun v_nf tc_nf sig_decls
	    fix_decls'	= doIfaceFixes1 sifun v_nf fix_decls
	    inst_decls'	= doIfaceInstDecls1 sifun tc_nf inst_decls
	in
	returnRn12 (fix_decls', ty_decls', class_decls', inst_decls', sig_decls', unitBag i_name)
      where
	v_dups  :: [[(FAST_STRING, ProtoName)]]
	tc_dups :: [[(FAST_STRING, (ProtoName, IntNameFun))]]

	(imp_v_nf, v_dups)   = mkNameFun {-OLD:v_pnf-}  v_bag
	(imp_tc_nf, tc_dups) = mkNameFun {-OLD:tc_pnf-} tc_bag

	v_nf :: IntNameFun
	v_nf (Unk s) = case v_pnf s of
			 Just n	 -> mkPreludeProtoName n
			 Nothing -> case imp_v_nf s of
				      Just n  -> n
				      Nothing -> Imp i_name s [i_name] (mod_rn_fn s)

	prel_con_or_op_nf  :: FAST_STRING{-module name-}-> IntNameFun
		 -- Used for (..)'d parts of prelude datatype/class decls;
		 -- OLD:? For `data' types, we happen to know everything;
		 -- OLD:? For class decls, we *don't* know what the class-ops are.
	prel_con_or_op_nf m (Unk s)
	  = case v_pnf s of
	      Just n  -> mkPreludeProtoName n
	      Nothing -> Imp m s [m] (mod_rn_fn s)
			 -- Strictly speaking, should be *no renaming* here, folks

	local_con_or_op_nf :: IntNameFun	
		-- used for non-prelude constructors/ops
	local_con_or_op_nf (Unk s) = Imp i_name s [i_name] (mod_rn_fn s)

	full_tc_nf :: IntTCNameFun
	full_tc_nf (Unk s)
	  = case tc_pnf s of
	      Just n  -> (mkPreludeProtoName n,
			  let
			      mod = fst (getOrigName n)
			  in
			  prel_con_or_op_nf mod)

	      Nothing -> case imp_tc_nf s of
			  Just pair -> pair
			  Nothing   -> (Imp i_name s [i_name] (mod_rn_fn s),
				        local_con_or_op_nf)

	tc_nf = fst . full_tc_nf

        -- ADR: commented out next new lines because I don't believe
        -- ADR: the check is useful or required by the Standard. (It
        -- ADR: also messes up the interpreter.)

	tc_errs = [] -- map (map (fst . snd)) tc_dups
		  -- Ugh! Just keep the dup'd protonames
	v_errs	= [] -- map (map snd) v_dups
		  -- Ditto

	report_all_errors
	  = mapRn12 (addErrRn12 . duplicateImportsInInterfaceErr (_UNPK_ i_name))
		    (tc_errs ++ v_errs)
\end{code}


%************************************************************************
%*									*
\subsection{doIfaceImports1}
%*									*
%************************************************************************

@ImportNameBags@ is a pair of bags (one for values, one for types and
classes) which specify the new names brought into scope by some
import declarations in an interface.

\begin{code}
type ImportNameBags = (Bag (FAST_STRING, ProtoName),
		       Bag (FAST_STRING, (ProtoName, IntNameFun))
		      )
\end{code}

\begin{code}
doIfaceImports1
	:: (FAST_STRING -> FAST_STRING)	-- Renamings in import stmt of module
	-> FAST_STRING			-- name of module whose interface we're doing
	-> [IfaceImportDecl]
	-> Rn12M ImportNameBags

doIfaceImports1 _ _  [] = returnRn12 (emptyBag, emptyBag)

doIfaceImports1 mod_rn_fn int_mod_name (imp_decl1 : rest)
  = do_decl				 imp_decl1  `thenRn12` \ (vb1, tcb1) ->
    doIfaceImports1 mod_rn_fn int_mod_name rest	    `thenRn12` \ (vb2, tcb2) ->
--  pprTrace "vbags/tcbags:" (ppr PprDebug (vb1 `unionBags` vb2, [(s,p) | (s,(p,_)) <- bagToList (tcb1 `unionBags` tcb2)])) (
    returnRn12 (vb1 `unionBags` vb2, tcb1 `unionBags` tcb2)
--  )
  where
    do_decl (IfaceImportDecl orig_mod_name imports renamings src_loc)
      =		-- Look at the renamings to get a suitable renaming function
	doRenamings mod_rn_fn int_mod_name orig_mod_name renamings	
				    `thenRn12` \ (orig_to_pn, local_to_pn) ->

	    -- Now deal with one import at a time, combining results.
	returnRn12 (
	  foldl (doIfaceImport1 orig_to_pn local_to_pn)
		(emptyBag, emptyBag)
		imports
	)
\end{code}

@doIfaceImport1@ takes a list of imports and the pair of renaming functions,
returning a bag which maps local names to original names.

\begin{code}
doIfaceImport1 :: ( FAST_STRING	    -- Original local name
		 -> (FAST_STRING,   -- Local name in this interface
		     ProtoName)	    -- Its full protoname
		)		    
				    
	     -> IntNameFun	    -- Local name to ProtoName; use for
				    --   constructors and class ops
				    
	     -> ImportNameBags	    -- Accumulator
	     -> IE		    -- An item in the import list
	     -> ImportNameBags

doIfaceImport1 orig_to_pn local_to_pn (v_bag, tc_bag) (IEVar orig_name)
  = (v_bag `snocBag` (orig_to_pn orig_name), tc_bag)

doIfaceImport1 orig_to_pn local_to_pn acc (IEThingAbs orig_name)
  = int_import1_help orig_to_pn local_to_pn acc orig_name

doIfaceImport1 orig_to_pn local_to_pn acc (IEThingAll orig_name)
  = int_import1_help orig_to_pn local_to_pn acc orig_name

doIfaceImport1 orig_to_pn local_to_pn (v_bag, tc_bag) other
  = panic "Rename1: strange import decl"

-- Little help guy...

int_import1_help orig_to_pn local_to_pn (v_bag, tc_bag) orig_name
  = case (orig_to_pn orig_name) of { (str, o_name) ->
    (v_bag, tc_bag `snocBag` (str, (o_name, local_to_pn)))
    }
\end{code}


The renaming-processing code.  It returns two name-functions. The
first maps the {\em original} name for an entity onto a @ProtoName@
--- it is used when running over the list of things to be imported.
The second maps the {\em local} name for a constructor or class op
back to its original name --- it is used when scanning the RHS of
a @data@ or @class@ decl.

It can produce errors, if there is a domain clash on the renamings.

\begin{code}
--pprTrace
--instance Outputable _PackedString where
--    ppr sty s = ppStr (_UNPK_ s)

doRenamings :: (FAST_STRING -> FAST_STRING) -- Renamings in import stmt of module
	    -> FAST_STRING	-- Name of the module whose interface we're working on
	    -> FAST_STRING	-- Original-name module for these renamings
	    -> [Renaming]	-- Renamings
	    -> Rn12M
		((FAST_STRING	     -- Original local name to...
		    -> (FAST_STRING, -- ... Local name in this interface
		        ProtoName)   -- ... Its full protoname
		 ),	
		 IntNameFun)	     -- Use for constructors, class ops

doRenamings mod_rn_fn int_mod orig_mod []
  = returnRn12 (
      \ s ->
	let
	    result = (s, Imp orig_mod s [int_mod] (mod_rn_fn s))
	in
--	pprTrace "name1a:" (ppCat [ppr PprDebug s, ppr PprDebug result]) (
	result
--	)
	,

      \ (Unk s) ->
	let
	    result = Imp orig_mod s [int_mod] (mod_rn_fn s)
	in
--	pprTrace "name2a:" (ppCat [ppr PprDebug s, ppr PprDebug result]) (
	result
--	)
    )

doRenamings mod_rn_fn int_mod orig_mod renamings
  = let
	local_rn_fn = mkRenamingFun renamings
    in
    --pprTrace "local_rns:" (ppr PprDebug renamings) (
    returnRn12 (
      \ s ->
	let
	    local_name = local_rn_fn s
	    result
	      = (local_name, Imp orig_mod s [int_mod] (mod_rn_fn local_name))
	in
--	pprTrace "name1:" (ppCat [ppr PprDebug s, ppr PprDebug result]) (
	result
--	)
	,

      \ (Unk s) ->
	let
	    result
	      = Imp orig_mod s [int_mod] (mod_rn_fn (local_rn_fn s))
	in
--	pprTrace "name2:" (ppCat [ppr PprDebug s, ppr PprDebug result]) (
	result
--	)
    )
    --)
\end{code}

\begin{code}
mkRenamingFun :: [Renaming] -> FAST_STRING -> FAST_STRING

mkRenamingFun []	= \ s -> s
mkRenamingFun renamings 
  = let
	rn_fn = lookupFM (listToFM -- OLD: mkStringLookupFn
		  [ (old, new) | MkRenaming old new <- renamings ]
		  ) -- OLD: False {-not-sorted-}
    in
    \s -> case rn_fn s of
	    Nothing -> s
	    Just s' -> s'
\end{code}


%************************************************************************
%*									*
\subsection{Type declarations}
%*									*
%************************************************************************

@doIfaceTyDecls1@ uses the `name function' to map local tycon names into
original names, calling @doConDecls1@ to do the same for the
constructors. @doTyDecls1@ is used to do both module and interface
type declarations.

\begin{code}
doIfaceTyDecls1 :: SelectiveImporter
	      -> IntTCNameFun
	      -> [ProtoNameTyDecl]
	      -> Rn12M [ProtoNameTyDecl]

doIfaceTyDecls1 sifun full_tc_nf ty_decls
  = mapRn12 do_decl ty_decls `thenRn12` \ decls_maybe ->
    returnRn12 (catMaybes decls_maybe)
  where
    do_decl (TyData context tycon tyvars condecls derivs (DataPragmas hidden_cons specs) src_loc)
      = let
	    full_thing = returnRn12 (Just ty_decl')
	in
		-- GHC doesn't allow derivings in interfaces
	(if null derivs
	 then returnRn12 ()
	 else addErrRn12 (derivingInIfaceErr tycon derivs src_loc)
	) `thenRn12` \ _ ->

	case (sifun tycon) of
	  NotWanted			-> returnRn12 Nothing
	  Wanted			-> full_thing
	  WantedWith (IEThingAll _)	-> full_thing
	  WantedWith (IEThingAbs _)	-> returnRn12 (Just abs_ty_decl')
	  WantedWith ie@(IEConWithCons _ _) -> full_thing

	  WantedWith really_weird_ie -> -- probably a typo in the pgm
	    addErrRn12 (weirdImportExportConstraintErr
			tycon really_weird_ie src_loc) `thenRn12` \ _ ->
	    full_thing
      where
	(tycon_name, constr_nf) = full_tc_nf tycon
	tc_nf	    		= fst . full_tc_nf

	condecls'   = map (do_condecl constr_nf tc_nf) condecls
	hidden_cons' = map (do_condecl constr_nf tc_nf) hidden_cons

	pragmas' invent_hidden
    	  = DataPragmas (if null hidden_cons && invent_hidden
			 then condecls' -- if importing abstractly but condecls were
			                -- exported we add them to the data pragma
			 else hidden_cons')
			specs {- ToDo: do_specs -}

	context'    = doIfaceContext1 tc_nf context
	deriv'	    = map tc_nf derivs -- rename derived classes

	ty_decl'    = TyData context' tycon_name tyvars condecls' deriv' (pragmas' False) src_loc
	abs_ty_decl'= TyData context' tycon_name tyvars []	  deriv' (pragmas' True) src_loc

    do_decl (TySynonym tycon tyvars monoty pragmas src_loc)
      = let
	    full_thing = returnRn12 (Just ty_decl')
	in
	case (sifun tycon) of
	  NotWanted		    -> returnRn12 Nothing
	  Wanted		    -> full_thing
	  WantedWith (IEThingAll _) -> full_thing

	  WantedWith weird_ie	    -> full_thing
      where
	(tycon_name,_) = full_tc_nf tycon
	tc_nf	= fst . full_tc_nf
	monoty'	= doIfaceMonoType1 tc_nf monoty
	ty_decl' = TySynonym tycon_name tyvars monoty' pragmas src_loc

    -- one name fun for the data constructor, another for the type:

    do_condecl c_nf tc_nf (ConDecl name tys src_loc)
      = ConDecl (c_nf name) (doIfaceMonoTypes1 tc_nf tys) src_loc
\end{code}

%************************************************************************
%*									*
\subsection{Class declarations}
%*									*
%************************************************************************

@doIfaceClassDecls1@ uses the `name function' to map local class names into
original names, calling @doIfaceClassOp1@ to do the same for the
class operations. @doClassDecls1@ is used to process both module and
interface class declarations.

\begin{code}
doIfaceClassDecls1 ::  SelectiveImporter
		 -> IntTCNameFun
		 -> [ProtoNameClassDecl]
		 -> Rn12M [ProtoNameClassDecl]

doIfaceClassDecls1 sifun full_tc_nf clas_decls
  = mapRn12 do_decl clas_decls `thenRn12` \ decls_maybe ->
    returnRn12 (catMaybes decls_maybe)
  where
    do_decl (ClassDecl ctxt cname tyvar sigs bs@EmptyMonoBinds prags locn)
				     -- No defaults in interface
      = let
	    full_thing = returnRn12 (Just class_decl')
	in
        case (sifun cname) of
	  NotWanted			-> returnRn12 Nothing
	  Wanted			-> full_thing
	  WantedWith (IEThingAll _)	-> full_thing
--???	  WantedWith (IEThingAbs _)	-> returnRn12 (Just abs_class_decl')
	  WantedWith (IEClsWithOps _ _) -> full_thing
	  -- ToDo: add checking of IEClassWithOps
	  WantedWith really_weird_ie	-> -- probably a typo in the pgm
	    addErrRn12 (weirdImportExportConstraintErr
			cname really_weird_ie locn) `thenRn12` \ _ ->
	    full_thing
      where
	(clas, op_nf) = full_tc_nf cname
	tc_nf = fst . full_tc_nf

	sigs' = map (doIfaceClassOp1 op_nf tc_nf) sigs
	ctxt' = doIfaceContext1 tc_nf ctxt

	class_decl'     = ClassDecl ctxt' clas tyvar sigs' bs prags locn
	abs_class_decl' = ClassDecl ctxt' clas tyvar []    bs prags locn
\end{code}

\begin{code}
doIfaceClassOp1 :: IntNameFun	-- Use this for the class ops
	      -> IntNameFun	-- Use this for the types
	      -> ProtoNameClassOpSig
	      -> ProtoNameClassOpSig

doIfaceClassOp1 op_nf tc_nf (ClassOpSig v ty pragma src_loc)
  = ClassOpSig (op_nf v) (doIfacePolyType1 tc_nf ty) pragma src_loc
\end{code}

%************************************************************************
%*									*
\subsection{Instance declarations}
%*									*
%************************************************************************

We select the instance decl if either the class or the type constructor
are selected.

\begin{code}
doIfaceInstDecls1 :: SelectiveImporter
	        -> IntNameFun
		-> [ProtoNameInstDecl]
		-> [ProtoNameInstDecl]

doIfaceInstDecls1 si tc_nf inst_decls
  = catMaybes (map do_decl inst_decls)
  where
    do_decl (InstDecl context cname ty EmptyMonoBinds False modname imod uprags pragmas src_loc)
      = case (si cname, tycon_reqd) of
	  (NotWanted, NotWanted) -> Nothing
	  _			 -> Just inst_decl'
     where
       context' = doIfaceContext1	 tc_nf context
       ty'	= doIfaceMonoType1 tc_nf ty

       inst_decl' = InstDecl context' (tc_nf cname) ty' EmptyMonoBinds False modname imod uprags pragmas src_loc

       tycon_reqd
	 = case getNonPrelOuterTyCon ty of
	     Nothing -> NotWanted    -- Type doesn't have a user-defined tycon
				     -- at its outermost level
	     Just tycon -> si tycon  -- It does, so look up in the si-fun
\end{code}

%************************************************************************
%*									*
\subsection{Signature declarations}
%*									*
%************************************************************************

@doIfaceSigs1@ uses the name function to create a bag that
maps local names into original names.

NB: Can't have user-pragmas & other weird things in interfaces.

\begin{code}
doIfaceSigs1 :: SelectiveImporter -> IntNameFun -> IntNameFun
	   -> [ProtoNameSig]
	   -> [ProtoNameSig]

doIfaceSigs1 si v_nf tc_nf sigs
  = catMaybes (map do_sig sigs)
  where
    do_sig (Sig v ty pragma src_loc)
      = case (si v) of
	  NotWanted -> Nothing
	  Wanted    -> Just (Sig (v_nf v) (doIfacePolyType1 tc_nf ty) pragma src_loc)
	  -- WantedWith doesn't make sense
\end{code}


%************************************************************************
%*									*
\subsection{Fixity declarations}
%*									*
%************************************************************************

\begin{code}
doIfaceFixes1 :: SelectiveImporter -> IntNameFun
	    -> [ProtoNameFixityDecl]
	    -> [ProtoNameFixityDecl]

doIfaceFixes1 si vnf fixities
  = catMaybes (map do_fixity fixities)
  where
    do_fixity (InfixL name i) = do_one InfixL name i
    do_fixity (InfixR name i) = do_one InfixR name i
    do_fixity (InfixN name i) = do_one InfixN name i

    do_one con name i
      = case si name of
	  Wanted    -> Just (con (vnf name) i)
	  NotWanted -> Nothing
\end{code}


%************************************************************************
%*									*
\subsection{doContext, MonoTypes, MonoType, Polytype}
%*									*
%************************************************************************

\begin{code}
doIfacePolyType1 :: IntNameFun -> ProtoNamePolyType -> ProtoNamePolyType

doIfacePolyType1 tc_nf (UnoverloadedTy ty)
  = UnoverloadedTy (doIfaceMonoType1 tc_nf ty)

doIfacePolyType1 tc_nf (OverloadedTy ctxt ty)
  = OverloadedTy (doIfaceContext1 tc_nf ctxt) (doIfaceMonoType1 tc_nf ty)
\end{code}

\begin{code}
doIfaceContext1 :: IntNameFun -> ProtoNameContext -> ProtoNameContext
doIfaceContext1 tc_nf  context = [(tc_nf clas, tyvar) | (clas,tyvar) <- context]
\end{code}


\begin{code}
doIfaceMonoTypes1 :: IntNameFun -> [ProtoNameMonoType] -> [ProtoNameMonoType]
doIfaceMonoTypes1 tc_nf tys = map (doIfaceMonoType1 tc_nf) tys
\end{code}


\begin{code}
doIfaceMonoType1 :: IntNameFun -> ProtoNameMonoType -> ProtoNameMonoType

doIfaceMonoType1 tc_nf (MonoTyVar tyvar) = MonoTyVar tyvar

doIfaceMonoType1 tc_nf (ListMonoTy ty)
  = ListMonoTy (doIfaceMonoType1 tc_nf ty)

doIfaceMonoType1 tc_nf (FunMonoTy ty1 ty2)
  = FunMonoTy (doIfaceMonoType1 tc_nf ty1) (doIfaceMonoType1 tc_nf ty2)

doIfaceMonoType1 tc_nf (TupleMonoTy tys)
  = TupleMonoTy (map (doIfacePolyType1 tc_nf) tys)

doIfaceMonoType1 tc_nf (MonoTyCon name tys)
  = MonoTyCon (tc_nf name) (doIfaceMonoTypes1 tc_nf tys)

#ifdef DPH
doIfaceMonoType1 tc_nf (MonoTyProc tys ty)
  = MonoTyProc (doIfaceMonoTypes1 tc_nf tys) (doIfaceMonoType1 tc_nf ty)

doIfaceMonoType1 tc_nf (MonoTyPod ty)
  = MonoTyPod (doIfaceMonoType1 tc_nf ty)
#endif {- Data Parallel Haskell -}
\end{code}