\begin{code}
module TcIface (
tcImportDecl, typecheckIface,
- tcIfaceKind, loadImportedInsts, loadImportedRules,
+ loadImportedInsts, loadImportedRules,
tcExtCoreBindings
) where
#include "HsVersions.h"
newIfaceName, newIfaceNames )
import BuildTyCl ( buildSynTyCon, buildAlgTyCon, buildDataCon, buildClass )
import TcRnMonad
-import Type ( Kind, openTypeKind, liftedTypeKind,
- unliftedTypeKind, mkArrowKind, splitTyConApp,
+import Type ( liftedTypeKind, splitTyConApp,
mkTyVarTys, mkGenTyConApp, mkTyVarTys, ThetaType, pprClassPred )
import TypeRep ( Type(..), PredType(..) )
import TyCon ( TyCon, tyConName )
import TysWiredIn ( tupleCon )
import Var ( TyVar, mkTyVar, tyVarKind )
import Name ( Name, NamedThing(..), nameModuleName, nameModule, nameOccName,
- isWiredInName, wiredInNameTyThing_maybe, nameParent )
+ isWiredInName, wiredInNameTyThing_maybe, nameParent, nameParent_maybe )
import NameEnv
import OccName ( OccName )
import Module ( Module, ModuleName, moduleName )
selectDecl :: ExternalPackageState -> Name -> (ExternalPackageState, Maybe IfaceDecl)
-- Use nameParent to get the parent name of the thing
selectDecl eps@(EPS { eps_decls = Pool decls_map n_in n_out}) name
- = case lookupNameEnv decls_map main_name of
+ = case lookupNameEnv decls_map name of {
+ -- This first lookup will usually fail for subordinate names, because
+ -- the relevant decl is the parent decl.
+ -- But, if we export a data type decl abstractly, its selectors
+ -- get separate type signatures in the interface file
+ Just decl -> let
+ decls' = delFromNameEnv decls_map name
+ in
+ (eps {eps_decls = Pool decls' n_in (n_out+1)}, Just decl) ;
+
+ Nothing ->
+ case nameParent_maybe name of {
+ Nothing -> (eps, Nothing ) ; -- No "parent"
+ Just main_name -> -- Has a parent; try that
+
+ case lookupNameEnv decls_map main_name of {
+ Just decl -> let
+ decls' = delFromNameEnv decls_map main_name
+ in
+ (eps {eps_decls = Pool decls' n_in (n_out+1)}, Just decl) ;
Nothing -> (eps, Nothing)
- Just decl -> (eps {eps_decls = Pool decls' n_in (n_out+1)}, Just decl)
- where
- main_name = nameParent name
- decls' = delFromNameEnv decls_map main_name
+ }}}
\end{code}
%************************************************************************
-- Reverses the gated decls, but that doesn't matter
choose2 (gis, decls) (gates, decl)
- | any (`elem` tycons) gates = (gis, decl:decls)
- | otherwise = ((gates,decl) : gis, decls)
+ | null gates -- Happens when we have 'instance T a where ...'
+ || any (`elem` tycons) gates = (gis, decl:decls)
+ | otherwise = ((gates,decl) : gis, decls)
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
-tcIfaceKind :: IfaceKind -> Kind
-tcIfaceKind IfaceOpenTypeKind = openTypeKind
-tcIfaceKind IfaceLiftedTypeKind = liftedTypeKind
-tcIfaceKind IfaceUnliftedTypeKind = unliftedTypeKind
-tcIfaceKind (IfaceFunKind k1 k2) = mkArrowKind (tcIfaceKind k1) (tcIfaceKind k2)
-
------------------------------------------
tcIfaceType :: IfaceType -> IfL Type
tcIfaceType (IfaceTyVar n) = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
tcIfaceType (IfaceAppTy t1 t2) = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
where
(occs,kinds) = unzip bndrs
-mk_iface_tyvar name kind = mkTyVar name (tcIfaceKind kind)
+mk_iface_tyvar name kind = mkTyVar name kind
\end{code}