Commit 576650d4 authored by simonpj's avatar simonpj

[project @ 2003-10-09 13:11:30 by simonpj]

Oops; forgot to add this entire directory!
parent 34a2e442
This diff is collapsed.
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\begin{code}
module BuildTyCl (
buildSynTyCon, buildAlgTyCon, buildDataCon,
buildClass,
newTyConRhs -- Just a useful little function with no obvious home
) where
#include "HsVersions.h"
import IfaceEnv ( newImplicitBinder )
import TcRnMonad
import Subst ( substTyWith )
import Util ( zipLazy )
import FieldLabel ( allFieldLabelTags, mkFieldLabel, fieldLabelName )
import VarSet
import DataCon ( DataCon, dataConOrigArgTys, mkDataCon, dataConFieldLabels )
import Var ( tyVarKind, TyVar )
import TysWiredIn ( unitTy )
import BasicTypes ( RecFlag, NewOrData( ..), StrictnessMark(..) )
import Name ( Name )
import OccName ( mkDataConWrapperOcc, mkDataConWorkerOcc, mkClassTyConOcc,
mkClassDataConOcc, mkSuperDictSelOcc )
import MkId ( mkDataConIds, mkRecordSelId, mkDictSelId )
import Class ( mkClass, Class( classTyCon), FunDep, DefMeth(..) )
import TyCon ( mkSynTyCon, mkAlgTyCon, visibleDataCons,
tyConDataCons, isNewTyCon, mkClassTyCon, TyCon( tyConTyVars ),
ArgVrcs, DataConDetails( ..), AlgTyConFlavour(..) )
import Type ( mkArrowKinds, liftedTypeKind, tyVarsOfTypes, typeKind,
tyVarsOfPred, splitTyConApp_maybe, mkPredTys, ThetaType, Type )
import Outputable
import List ( nubBy )
\end{code}
\begin{code}
------------------------------------------------------
buildSynTyCon name tvs rhs_ty arg_vrcs
= mkSynTyCon name kind tvs rhs_ty arg_vrcs
where
kind = mkArrowKinds (map tyVarKind tvs) (typeKind rhs_ty)
------------------------------------------------------
buildAlgTyCon :: NewOrData -> Name -> [TyVar] -> ThetaType
-> DataConDetails DataCon
-> ArgVrcs -> RecFlag
-> Bool -- True <=> want generics functions
-> TcRnIf m n TyCon
buildAlgTyCon new_or_data tc_name tvs ctxt cons arg_vrcs is_rec want_generics
= do { let { tycon = mkAlgTyCon tc_name kind tvs ctxt arg_vrcs
cons sel_ids flavour is_rec want_generics
; kind = mkArrowKinds (map tyVarKind tvs) liftedTypeKind
; sel_ids = mkRecordSelectors tycon cons
; flavour = case new_or_data of
NewType -> NewTyCon (mkNewTyConRep tycon)
DataType -> DataTyCon (all_nullary cons)
}
; return tycon }
where
all_nullary (DataCons cons) = all (null . dataConOrigArgTys) cons
all_nullary Unknown = False -- Safe choice for unknown data types
-- NB (null . dataConOrigArgTys). It used to say isNullaryDataCon
-- but that looks at the *representation* arity, and isEnumerationType
-- refers to the *source* code definition
------------------------------------------------------
buildDataCon :: Name
-> [StrictnessMark]
-> [Name] -- Field labels
-> [TyVar] -> ThetaType
-> [TyVar] -> ThetaType
-> [Type] -> TyCon
-> TcRnIf m n DataCon
-- A wrapper for DataCon.mkDataCon that
-- a) makes the worker Id
-- b) makes the wrapper Id if necessary, including
-- allocating its unique (hence monadic)
buildDataCon src_name arg_stricts field_lbl_names
tyvars ctxt ex_tyvars ex_ctxt
arg_tys tycon
= newImplicitBinder src_name mkDataConWrapperOcc `thenM` \ wrap_name ->
newImplicitBinder src_name mkDataConWorkerOcc `thenM` \ work_name ->
-- This last one takes the name of the data constructor in the source
-- code, which (for Haskell source anyway) will be in the SrcDataName name
-- space, and makes it into a "real data constructor name"
let
-- Make the FieldLabels
-- The zipLazy avoids forcing the arg_tys too early
final_lbls = [ mkFieldLabel name tycon ty tag
| ((name, tag), ty) <- (field_lbl_names `zip` allFieldLabelTags)
`zipLazy` arg_tys
]
ctxt' = thinContext arg_tys ctxt
data_con = mkDataCon src_name arg_stricts final_lbls
tyvars ctxt'
ex_tyvars ex_ctxt
arg_tys tycon dc_ids
dc_ids = mkDataConIds wrap_name work_name data_con
in
returnM data_con
-- The context for a data constructor should be limited to
-- the type variables mentioned in the arg_tys
thinContext arg_tys ctxt
= filter in_arg_tys ctxt
where
arg_tyvars = tyVarsOfTypes arg_tys
in_arg_tys pred = not $ isEmptyVarSet $
tyVarsOfPred pred `intersectVarSet` arg_tyvars
------------------------------------------------------
mkRecordSelectors tycon data_cons
= -- We'll check later that fields with the same name
-- from different constructors have the same type.
[ mkRecordSelId tycon field
| field <- nubBy eq_name fields ]
where
fields = [ field | con <- visibleDataCons data_cons,
field <- dataConFieldLabels con ]
eq_name field1 field2 = fieldLabelName field1 == fieldLabelName field2
------------------------------------------------------
newTyConRhs :: TyCon -> Type -- The defn of a newtype, as written by the programmer
newTyConRhs tc = head (dataConOrigArgTys (head (tyConDataCons tc)))
mkNewTyConRep :: TyCon -- The original type constructor
-> Type -- Chosen representation type
-- (guaranteed not to be another newtype)
-- Find the representation type for this newtype TyCon
-- Remember that the representation type is the ultimate representation
-- type, looking through other newtypes.
--
-- The non-recursive newtypes are easy, because they look transparent
-- to splitTyConApp_maybe, but recursive ones really are represented as
-- TyConApps (see TypeRep).
--
-- The trick is to to deal correctly with recursive newtypes
-- such as newtype T = MkT T
mkNewTyConRep tc
| null (tyConDataCons tc) = unitTy
-- External Core programs can have newtypes with no data constructors
| otherwise = go [] tc
where
-- Invariant: tc is a NewTyCon
-- tcs have been seen before
go tcs tc
| tc `elem` tcs = unitTy
| otherwise
= case splitTyConApp_maybe rep_ty of
Nothing -> rep_ty
Just (tc', tys) | not (isNewTyCon tc') -> rep_ty
| otherwise -> go1 (tc:tcs) tc' tys
where
rep_ty = newTyConRhs tc
go1 tcs tc tys = substTyWith (tyConTyVars tc) tys (go tcs tc)
\end{code}
\begin{code}
buildClass :: Name -> [TyVar] -> ThetaType
-> [FunDep TyVar] -- Functional dependencies
-> [(Name, DefMeth, Type)] -- Method info
-> RecFlag -> ArgVrcs -- Info for type constructor
-> TcRnIf m n Class
buildClass class_name tvs sc_theta fds sig_stuff tc_isrec tc_vrcs
= do { tycon_name <- newImplicitBinder class_name mkClassTyConOcc
; datacon_name <- newImplicitBinder class_name mkClassDataConOcc
-- The class name is the 'parent' for this datacon, not its tycon,
-- because one should import the class to get the binding for
-- the datacon
; sc_sel_names <- mapM (newImplicitBinder class_name . mkSuperDictSelOcc)
[1..length sc_theta]
-- We number off the superclass selectors, 1, 2, 3 etc so that we
-- can construct names for the selectors. Thus
-- class (C a, C b) => D a b where ...
-- gives superclass selectors
-- D_sc1, D_sc2
-- (We used to call them D_C, but now we can have two different
-- superclasses both called C!)
; fixM (\ clas -> do { -- Only name generation inside loop
let { op_tys = [ty | (_,_,ty) <- sig_stuff]
; sc_tys = mkPredTys sc_theta
; dict_component_tys = sc_tys ++ op_tys
; sc_sel_ids = [mkDictSelId sc_name clas | sc_name <- sc_sel_names]
; op_items = [ (mkDictSelId op_name clas, dm_info)
| (op_name, dm_info, _) <- sig_stuff ] }
-- Build the selector id and default method id
; dict_con <- buildDataCon datacon_name
(map (const NotMarkedStrict) dict_component_tys)
[{- No labelled fields -}]
tvs [{-No context-}]
[{-No existential tyvars-}] [{-Or context-}]
dict_component_tys
(classTyCon clas)
; let { clas = mkClass class_name tvs fds
sc_theta sc_sel_ids op_items
tycon
; tycon = mkClassTyCon tycon_name clas_kind tvs
tc_vrcs dict_con
clas flavour tc_isrec
-- A class can be recursive, and in the case of newtypes
-- this matters. For example
-- class C a where { op :: C b => a -> b -> Int }
-- Because C has only one operation, it is represented by
-- a newtype, and it should be a *recursive* newtype.
-- [If we don't make it a recursive newtype, we'll expand the
-- newtype like a synonym, but that will lead to an infinite type]
; clas_kind = mkArrowKinds (map tyVarKind tvs) liftedTypeKind
; flavour = case dict_component_tys of
[rep_ty] -> NewTyCon (mkNewTyConRep tycon)
other -> DataTyCon False -- Not an enumeration
}
; return clas
})}
\end{code}
(c) The University of Glasgow 2002
\begin{code}
module IfaceEnv (
newGlobalBinder, newIPName, newImplicitBinder,
lookupIfaceTop, lookupIfaceExt,
lookupOrig, lookupImplicitOrig, lookupIfaceTc,
newIfaceName, newIfaceNames,
extendIfaceIdEnv, extendIfaceTyVarEnv,
tcIfaceGlobal, tcIfaceTyCon, tcIfaceClass, tcIfaceExtId,
tcIfaceTyVar, tcIfaceDataCon, tcIfaceLclId,
-- Name-cache stuff
allocateGlobalBinder, extendOrigNameCache, initNameCache
) where
#include "HsVersions.h"
import {-# SOURCE #-} TcIface( tcImportDecl )
import TcRnMonad
import IfaceType ( IfaceExtName(..), IfaceTyCon(..), ifaceTyConName )
import HscTypes ( NameCache(..), HscEnv(..),
TyThing, tyThingClass, tyThingTyCon,
ExternalPackageState(..), OrigNameCache, lookupType )
import TyCon ( TyCon, tyConName )
import Class ( Class )
import DataCon ( DataCon, dataConWorkId, dataConName )
import Var ( TyVar, Id, varName )
import Name ( Name, nameUnique, nameModule, nameModuleName,
nameOccName, nameSrcLoc,
getOccName, nameParent_maybe,
isWiredInName, nameIsLocalOrFrom, mkIPName,
mkExternalName, mkInternalName )
import NameEnv
import OccName ( OccName, isTupleOcc_maybe, tcName, dataName,
lookupOccEnv, unitOccEnv, extendOccEnv, extendOccEnvList )
import PrelNames ( gHC_PRIM_Name, pREL_TUP_Name )
import TysWiredIn ( intTyCon, boolTyCon, charTyCon, listTyCon, parrTyCon,
tupleTyCon, tupleCon )
import HscTypes ( ExternalPackageState, NameCache, TyThing(..) )
import Module ( Module, ModuleName, moduleName, mkPackageModule,
emptyModuleEnv, lookupModuleEnvByName, extendModuleEnv_C )
import UniqSupply ( UniqSupply, splitUniqSupply, uniqFromSupply, uniqsFromSupply )
import FiniteMap ( emptyFM, lookupFM, addToFM )
import BasicTypes ( IPName(..), mapIPName )
import SrcLoc ( SrcLoc, noSrcLoc )
import Maybes ( orElse )
import Outputable
\end{code}
%*********************************************************
%* *
Allocating new Names in the Name Cache
%* *
%*********************************************************
\begin{code}
newGlobalBinder :: Module -> OccName -> Maybe Name -> SrcLoc -> TcRnIf a b Name
-- Used for source code and interface files, to make the
-- Name for a thing, given its Module and OccName
--
-- The cache may already already have a binding for this thing,
-- because we may have seen an occurrence before, but now is the
-- moment when we know its Module and SrcLoc in their full glory
newGlobalBinder mod occ mb_parent loc
= do { mod `seq` occ `seq` return () -- See notes with lookupOrig_help
; name_supply <- getNameCache
; let (name_supply', name) = allocateGlobalBinder
name_supply mod occ
mb_parent loc
; setNameCache name_supply'
; return name }
allocateGlobalBinder
:: NameCache
-> Module -> OccName -> Maybe Name -> SrcLoc
-> (NameCache, Name)
allocateGlobalBinder name_supply mod occ mb_parent loc
= case lookupOrigNameCache (nsNames name_supply) (moduleName mod) occ of
-- A hit in the cache! We are at the binding site of the name.
-- This is the moment when we know the defining Module and SrcLoc
-- of the Name, so we set these fields in the Name we return.
--
-- This is essential, to get the right Module in a Name.
-- Also: then (bogus) multiple bindings of the same Name
-- get different SrcLocs can can be reported as such.
--
-- Possible other reason: it might be in the cache because we
-- encountered an occurrence before the binding site for an
-- implicitly-imported Name. Perhaps the current SrcLoc is
-- better... but not really: it'll still just say 'imported'
--
-- IMPORTANT: Don't mess with wired-in names.
-- Their wired-in-ness is in their NameSort
-- and their Module is correct.
Just name | isWiredInName name -> (name_supply, name)
| otherwise -> (new_name_supply, name')
where
uniq = nameUnique name
name' = mkExternalName uniq mod occ mb_parent loc
new_cache = extend_name_cache (nsNames name_supply) mod occ name'
new_name_supply = name_supply {nsNames = new_cache}
-- Miss in the cache!
-- Build a completely new Name, and put it in the cache
Nothing -> (new_name_supply, name)
where
(us', us1) = splitUniqSupply (nsUniqs name_supply)
uniq = uniqFromSupply us1
name = mkExternalName uniq mod occ mb_parent loc
new_cache = extend_name_cache (nsNames name_supply) mod occ name
new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
newImplicitBinder :: Name -- Base name
-> (OccName -> OccName) -- Occurrence name modifier
-> TcRnIf m n Name -- Implicit name
-- Called in BuildTyCl to allocate the implicit binders of type/class decls
-- For source type/class decls, this is the first occurrence
-- For iface ones, the LoadIface has alrady allocated a suitable name in the cache
--
-- An *implicit* name has the base-name as parent
newImplicitBinder base_name mk_sys_occ
= newGlobalBinder (nameModule base_name)
(mk_sys_occ (nameOccName base_name))
(Just parent_name)
(nameSrcLoc base_name)
where
parent_name = case nameParent_maybe base_name of
Just parent_name -> parent_name
Nothing -> base_name
lookupOrig :: ModuleName -> OccName -> TcRnIf a b Name
-- This one starts with a ModuleName, not a Module, because
-- we may be simply looking at an occurrence M.x in an interface file.
-- We may enounter this well before finding the binding site for M.x
--
-- So, even if we get a miss in the original-name cache, we
-- make a new External Name.
-- We fake up
-- Module to AnotherPackage
-- SrcLoc to noSrcLoc
-- They'll be overwritten, in due course, by LoadIface.loadDecl.
lookupOrig mod_name occ = lookupOrig_help mod_name occ Nothing
lookupImplicitOrig :: Name -> OccName -> TcRnIf m n Name
-- Same as lookupOrig, but install (Just parent) as the
-- parent Name. This is used when looking at the exports
-- of an interface:
-- Suppose module M exports type A.T, and constructor A.MkT
-- Then, we know that A.MkT is an implicit name of A.T,
-- even though we aren't at the binding site of A.T
-- And it's important, because we may simply re-export A.T
-- without ever sucking in the declaration itself.
lookupImplicitOrig name occ
= lookupOrig_help (nameModuleName name) occ (Just name)
lookupOrig_help :: ModuleName -> OccName -> Maybe Name -> TcRnIf a b Name
-- Local helper, not exported
lookupOrig_help mod_name occ mb_parent
= do { -- First ensure that mod_name and occ are evaluated
-- If not, chaos can ensue:
-- we read the name-cache
-- then pull on mod (say)
-- which does some stuff that modifies the name cache
-- This did happen, with tycon_mod in TcIface.tcIfaceAlt (DataAlt..)
mod `seq` occ `seq` return ()
; name_supply <- getNameCache
; case lookupOrigNameCache (nsNames name_supply) mod_name occ of {
Just name -> returnM name ;
Nothing -> do
{ let { (us', us1) = splitUniqSupply (nsUniqs name_supply)
; uniq = uniqFromSupply us1
; name = mkExternalName uniq tmp_mod occ mb_parent noSrcLoc
; new_cache = extend_name_cache (nsNames name_supply) tmp_mod occ name
; new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
; tmp_mod = mkPackageModule mod_name
-- Guess at the package-ness for now, becuase we don't know whether
-- this imported module is from the home package or not.
-- If we ever need it, we'll open its interface, and update the cache
-- with a better name (newGlobalBinder)
}
; setNameCache new_name_supply
; return name }
}}
newIPName :: IPName OccName -> TcRnIf m n (IPName Name)
newIPName occ_name_ip
= getNameCache `thenM` \ name_supply ->
let
ipcache = nsIPs name_supply
in
case lookupFM ipcache key of
Just name_ip -> returnM name_ip
Nothing -> setNameCache new_ns `thenM_`
returnM name_ip
where
(us', us1) = splitUniqSupply (nsUniqs name_supply)
uniq = uniqFromSupply us1
name_ip = mapIPName (mkIPName uniq) occ_name_ip
new_ipcache = addToFM ipcache key name_ip
new_ns = name_supply {nsUniqs = us', nsIPs = new_ipcache}
where
key = occ_name_ip -- Ensures that ?x and %x get distinct Names
\end{code}
Local helper functions (not exported)
\begin{code}
lookupOrigNameCache :: OrigNameCache -> ModuleName -> OccName -> Maybe Name
lookupOrigNameCache nc mod_name occ
| mod_name == pREL_TUP_Name || mod_name == gHC_PRIM_Name, -- Boxed tuples from one,
Just tup_info <- isTupleOcc_maybe occ -- unboxed from the other
= -- Special case for tuples; there are too many
-- of them to pre-populate the original-name cache
Just (mk_tup_name tup_info)
where
mk_tup_name (ns, boxity, arity)
| ns == tcName = tyConName (tupleTyCon boxity arity)
| ns == dataName = dataConName (tupleCon boxity arity)
| otherwise = varName (dataConWorkId (tupleCon boxity arity))
lookupOrigNameCache nc mod_name occ -- The normal case
= case lookupModuleEnvByName nc mod_name of
Nothing -> Nothing
Just occ_env -> lookupOccEnv occ_env occ
extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache
extendOrigNameCache nc name
= extend_name_cache nc (nameModule name) (nameOccName name) name
extend_name_cache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
extend_name_cache nc mod occ name
= extendModuleEnv_C combine nc mod (unitOccEnv occ name)
where
combine occ_env _ = extendOccEnv occ_env occ name
getNameCache :: TcRnIf a b NameCache
getNameCache = do { HscEnv { hsc_NC = nc_var } <- getTopEnv;
readMutVar nc_var }
setNameCache :: NameCache -> TcRnIf a b ()
setNameCache nc = do { HscEnv { hsc_NC = nc_var } <- getTopEnv;
writeMutVar nc_var nc }
\end{code}
\begin{code}
initNameCache :: UniqSupply -> [Name] -> NameCache
initNameCache us names
= NameCache { nsUniqs = us,
nsNames = initOrigNames names,
nsIPs = emptyFM }
initOrigNames :: [Name] -> OrigNameCache
initOrigNames names = foldl extendOrigNameCache emptyModuleEnv names
\end{code}
%************************************************************************
%* *
Getting from Names to TyThings
%* *
%************************************************************************
\begin{code}
tcIfaceGlobal :: Name -> IfM a TyThing
tcIfaceGlobal name
= do { eps <- getEps
; hpt <- getHpt
; case lookupType hpt (eps_PTE eps) name of {
Just thing -> return thing ;
Nothing ->
setLclEnv () $ do
{ env <- getGblEnv
; case if_rec_types env of
Just (mod, get_type_env)
| nameIsLocalOrFrom mod name
-> do -- It's defined in the module being compiled
{ type_env <- get_type_env
; case lookupNameEnv type_env name of
Just thing -> return thing
Nothing -> pprPanic "tcIfaceGlobal (local): not found:"
(ppr name $$ ppr type_env) }
other -> tcImportDecl name -- It's imported; go get it
}}}
tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
tcIfaceTyCon IfaceIntTc = return intTyCon
tcIfaceTyCon IfaceBoolTc = return boolTyCon
tcIfaceTyCon IfaceCharTc = return charTyCon
tcIfaceTyCon IfaceListTc = return listTyCon
tcIfaceTyCon IfacePArrTc = return parrTyCon
tcIfaceTyCon (IfaceTupTc bx ar) = return (tupleTyCon bx ar)
tcIfaceTyCon (IfaceTc ext_nm) = do { name <- lookupIfaceExt ext_nm
; thing <- tcIfaceGlobal name
; return (tyThingTyCon thing) }
tcIfaceClass :: IfaceExtName -> IfL Class
tcIfaceClass rdr_name = do { name <- lookupIfaceExt rdr_name
; thing <- tcIfaceGlobal name
; return (tyThingClass thing) }
tcIfaceDataCon :: IfaceExtName -> IfL DataCon
tcIfaceDataCon gbl = do { name <- lookupIfaceExt gbl
; thing <- tcIfaceGlobal name
; case thing of
ADataCon dc -> return dc
other -> pprPanic "tcIfaceExtDC" (ppr gbl $$ ppr name$$ ppr thing) }
tcIfaceExtId :: IfaceExtName -> IfL Id
tcIfaceExtId gbl = do { name <- lookupIfaceExt gbl
; thing <- tcIfaceGlobal name
; case thing of
AnId id -> return id
other -> pprPanic "tcIfaceExtId" (ppr gbl $$ ppr name$$ ppr thing) }
------------------------------------------
tcIfaceLclId :: OccName -> IfL Id
tcIfaceLclId occ
= do { lcl <- getLclEnv
; return (lookupOccEnv (if_id_env lcl) occ
`orElse`
pprPanic "tcIfaceLclId" (ppr occ)) }
tcIfaceTyVar :: OccName -> IfL TyVar
tcIfaceTyVar occ
= do { lcl <- getLclEnv
; return (lookupOccEnv (if_tv_env lcl) occ
`orElse`
pprPanic "tcIfaceTyVar" (ppr occ)) }
extendIfaceIdEnv :: [Id] -> IfL a -> IfL a
extendIfaceIdEnv ids thing_inside
= do { env <- getLclEnv
; let { id_env' = extendOccEnvList (if_id_env env) pairs
; pairs = [(getOccName id, id) | id <- ids] }
; setLclEnv (env { if_id_env = id_env' }) thing_inside }
extendIfaceTyVarEnv :: [TyVar] -> IfL a -> IfL a
extendIfaceTyVarEnv tyvars thing_inside
= do { env <- getLclEnv
; let { tv_env' = extendOccEnvList (if_tv_env env) pairs
; pairs = [(getOccName tv, tv) | tv <- tyvars] }
; setLclEnv (env { if_tv_env = tv_env' }) thing_inside }
\end{code}
%************************************************************************
%* *
Getting from RdrNames to Names
%* *
%************************************************************************
IfaceDecls etc are populated with RdrNames. The RdrNames may either be
Orig or Unqual when the interface is read from a file
Exact when the interface is kept by GHCi, and is now
being re-linked with the type environment
At an occurrence site, to convert the RdrName to Name:
Unqual look up in LocalRdrEnv
Orig look up in OrigNameCache
Exact return the Name
At a binding site, to bind the RdrName
Unqual we extend the LocalRdrEnv
Orig or Unqual we don't extend the LocalRdrEnv (no need)
First, we deal with the RdrName -> Name mapping
\begin{code}
lookupIfaceTc :: IfaceTyCon -> IfL Name
lookupIfaceTc (IfaceTc ext) = lookupIfaceExt ext
lookupIfaceTc other_tc = return (ifaceTyConName other_tc)
lookupIfaceExt :: IfaceExtName -> IfL Name
lookupIfaceExt (ExtPkg mod occ) = lookupOrig mod occ
lookupIfaceExt (HomePkg mod occ _) = lookupOrig mod occ
lookupIfaceExt (LocalTop occ) = lookupIfaceTop occ
lookupIfaceExt (LocalTopSub occ _) = lookupIfaceTop occ
lookupIfaceTop :: OccName -> IfL Name
-- Look up a top-level name from the current Iface module
lookupIfaceTop occ
= do { env <- getLclEnv; lookupOrig (if_mod env) occ }
newIfaceName :: OccName -> IfL Name
newIfaceName occ
= do { uniq <- newUnique
; return (mkInternalName uniq occ noSrcLoc) }
newIfaceNames :: [OccName] -> IfL [Name]
newIfaceNames occs
= do { uniqs <- newUniqueSupply
; return [ mkInternalName uniq occ noSrcLoc
| (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] }
\end{code}
This diff is collapsed.
%
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
This module defines intereace types and binders
\begin{code}
module IfaceType (
IfaceType(..), IfaceKind(..), IfacePredType(..), IfaceTyCon(..),
IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr,
IfaceExtName(..), mkIfaceExtName, ifaceTyConName,
-- Conversion from Type -> IfaceType
toIfaceType, toIfaceKind, toIfacePred, toIfaceContext,
toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs,