module TcIface (
tcImportDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface,
tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
- tcIfaceVectInfo, tcIfaceGlobal, tcExtCoreBindings
+ tcIfaceVectInfo, tcIfaceAnnotations, tcIfaceGlobal, tcExtCoreBindings
) where
#include "HsVersions.h"
import IfaceEnv
import BuildTyCl
import TcRnMonad
+import TcType ( tcSplitSigmaTy )
import Type
import TypeRep
import HscTypes
+import Annotations
import InstEnv
import FamInstEnv
import CoreSyn
-- Entry point for *source-code* uses of importDecl
tcImportDecl name
| Just thing <- wiredInNameTyThing_maybe name
- = do { initIfaceTcRn (loadWiredInHomeIface name)
- -- See Note [Loading instances] in LoadIface
+ = do { when (needWiredInHomeIface thing)
+ (initIfaceTcRn (loadWiredInHomeIface name))
+ -- See Note [Loading instances for wired-in things]
; return thing }
| otherwise
= do { traceIf (text "tcImportDecl" <+> ppr name)
Succeeded thing -> return thing
Failed err -> failWithTc err }
-checkWiredInTyCon :: TyCon -> TcM ()
--- Ensure that the home module of the TyCon (and hence its instances)
--- are loaded. See See Note [Loading instances] in LoadIface
--- It might not be a wired-in tycon (see the calls in TcUnify),
--- in which case this is a no-op.
-checkWiredInTyCon tc
- | not (isWiredInName tc_name)
- = return ()
- | otherwise
- = do { mod <- getModule
- ; ASSERT( isExternalName tc_name )
- unless (mod == nameModule tc_name)
- (initIfaceTcRn (loadWiredInHomeIface tc_name))
- -- Don't look for (non-existent) Float.hi when
- -- compiling Float.lhs, which mentions Float of course
- -- A bit yukky to call initIfaceTcRn here
- }
- where
- tc_name = tyConName tc
-
importDecl :: Name -> IfM lcl (MaybeErr Message TyThing)
-- Get the TyThing for this Name from an interface file
-- It's not a wired-in thing -- the caller caught that
%************************************************************************
%* *
+ Checks for wired-in things
+%* *
+%************************************************************************
+
+Note [Loading instances for wired-in things]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We need to make sure that we have at least *read* the interface files
+for any module with an instance decl or RULE that we might want.
+
+* If the instance decl is an orphan, we have a whole separate mechanism
+ (loadOprhanModules)
+
+* If the instance decl not an orphan, then the act of looking at the
+ TyCon or Class will force in the defining module for the
+ TyCon/Class, and hence the instance decl
+
+* BUT, if the TyCon is a wired-in TyCon, we don't really need its interface;
+ but we must make sure we read its interface in case it has instances or
+ rules. That is what LoadIface.loadWiredInHomeInterface does. It's called
+ from TcIface.{tcImportDecl, checkWiredInTyCon, ifCheckWiredInThing}
+
+* HOWEVER, only do this for TyCons. There are no wired-in Classes. There
+ are some wired-in Ids, but we don't want to load their interfaces. For
+ example, Control.Exception.Base.recSelError is wired in, but that module
+ is compiled late in the base library, and we don't want to force it to
+ load before it's been compiled!
+
+All of this is done by the type checker. The renamer plays no role.
+(It used to, but no longer.)
+
+
+\begin{code}
+checkWiredInTyCon :: TyCon -> TcM ()
+-- Ensure that the home module of the TyCon (and hence its instances)
+-- are loaded. See Note [Loading instances for wired-in things]
+-- It might not be a wired-in tycon (see the calls in TcUnify),
+-- in which case this is a no-op.
+checkWiredInTyCon tc
+ | not (isWiredInName tc_name)
+ = return ()
+ | otherwise
+ = do { mod <- getModule
+ ; ASSERT( isExternalName tc_name )
+ when (mod /= nameModule tc_name)
+ (initIfaceTcRn (loadWiredInHomeIface tc_name))
+ -- Don't look for (non-existent) Float.hi when
+ -- compiling Float.lhs, which mentions Float of course
+ -- A bit yukky to call initIfaceTcRn here
+ }
+ where
+ tc_name = tyConName tc
+
+ifCheckWiredInThing :: TyThing -> IfL ()
+-- Even though we are in an interface file, we want to make
+-- sure the instances of a wired-in thing are loaded (imagine f :: Double -> Double)
+-- Ditto want to ensure that RULES are loaded too
+-- See Note [Loading instances for wired-in things]
+ifCheckWiredInThing thing
+ = do { mod <- getIfModule
+ -- Check whether we are typechecking the interface for this
+ -- very module. E.g when compiling the base library in --make mode
+ -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in
+ -- the HPT, so without the test we'll demand-load it into the PIT!
+ -- C.f. the same test in checkWiredInTyCon above
+ ; let name = getName thing
+ ; ASSERT2( isExternalName name, ppr name )
+ when (needWiredInHomeIface thing && mod /= nameModule name)
+ (loadWiredInHomeIface name) }
+
+needWiredInHomeIface :: TyThing -> Bool
+-- Only for TyCons; see Note [Loading instances for wired-in things]
+needWiredInHomeIface (ATyCon {}) = True
+needWiredInHomeIface _ = False
+\end{code}
+
+%************************************************************************
+%* *
Type-checking a complete interface
%* *
%************************************************************************
; let type_env = mkNameEnv names_w_things
; writeMutVar tc_env_var type_env
- -- Now do those rules and instances
+ -- Now do those rules, instances and annotations
; insts <- mapM tcIfaceInst (mi_insts iface)
; fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
; rules <- tcIfaceRules ignore_prags (mi_rules iface)
+ ; anns <- tcIfaceAnnotations (mi_anns iface)
-- Vectorisation information
; vect_info <- tcIfaceVectInfo (mi_module iface) type_env
, md_insts = insts
, md_fam_insts = fam_insts
, md_rules = rules
+ , md_anns = anns
, md_vect_info = vect_info
, md_exports = exports
}
-> IfaceDecl
-> IfL TyThing
-tcIfaceDecl ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type, ifIdInfo = info})
+tcIfaceDecl ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type,
+ ifIdDetails = details, ifIdInfo = info})
= do { name <- lookupIfaceTop occ_name
; ty <- tcIfaceType iface_type
+ ; details <- tcIdDetails ty details
; info <- tcIdInfo ignore_prags name ty info
- ; return (AnId (mkVanillaGlobalWithInfo name ty info)) }
+ ; return (AnId (mkGlobalId details name ty info)) }
tcIfaceDecl _ (IfaceData {ifName = occ_name,
ifTyVars = tv_bndrs,
ifRec = is_rec,
ifGeneric = want_generic,
ifFamInst = mb_family })
- = do { tc_name <- lookupIfaceTop occ_name
- ; bindIfaceTyVars tv_bndrs $ \ tyvars -> do
-
- { tycon <- fixM ( \ tycon -> do
+ = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
+ { tc_name <- lookupIfaceTop occ_name
+ ; tycon <- fixM ( \ tycon -> do
{ stupid_theta <- tcIfaceCtxt ctxt
- ; famInst <-
- case mb_family of
- Nothing -> return Nothing
- Just (fam, tys) ->
- do { famTyCon <- tcIfaceTyCon fam
- ; insttys <- mapM tcIfaceType tys
- ; return $ Just (famTyCon, insttys)
- }
+ ; mb_fam_inst <- tcFamInst mb_family
; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
; buildAlgTyCon tc_name tyvars stupid_theta
- cons is_rec want_generic gadt_syn famInst
+ cons is_rec want_generic gadt_syn mb_fam_inst
})
- ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
- ; return (ATyCon tycon)
- }}
+ ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
+ ; return (ATyCon tycon) }
tcIfaceDecl _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
ifSynRhs = mb_rhs_ty,
ifSynKind = kind, ifFamInst = mb_family})
- = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
+ = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
{ tc_name <- lookupIfaceTop occ_name
; rhs_kind <- tcIfaceType kind -- Note [Synonym kind loop]
; ~(rhs, fam) <- forkM (mk_doc tc_name) $
do { rhs <- tc_syn_rhs rhs_kind mb_rhs_ty
- ; fam <- tc_syn_fam mb_family
+ ; fam <- tcFamInst mb_family
; return (rhs, fam) }
; tycon <- buildSynTyCon tc_name tyvars rhs rhs_kind fam
; return $ ATyCon tycon
tc_syn_rhs kind Nothing = return (OpenSynTyCon kind Nothing)
tc_syn_rhs _ (Just ty) = do { rhs_ty <- tcIfaceType ty
; return (SynonymTyCon rhs_ty) }
- tc_syn_fam Nothing
- = return Nothing
- tc_syn_fam (Just (fam, tys))
- = do { famTyCon <- tcIfaceTyCon fam
- ; insttys <- mapM tcIfaceType tys
- ; return $ Just (famTyCon, insttys) }
tcIfaceDecl ignore_prags
(IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name,
; sigs <- mapM tc_sig rdr_sigs
; fds <- mapM tc_fd rdr_fds
; ats' <- mapM (tcIfaceDecl ignore_prags) rdr_ats
- ; let ats = zipWith setTyThingPoss ats' (map ifTyVars rdr_ats)
+ ; let ats = map (setAssocFamilyPermutation tyvars) ats'
; cls <- buildClass ignore_prags cls_name tyvars ctxt fds ats sigs tc_isrec
; return (AClass cls) }
where
; tvs2' <- mapM tcIfaceTyVar tvs2
; return (tvs1', tvs2') }
- -- For each AT argument compute the position of the corresponding class
- -- parameter in the class head. This will later serve as a permutation
- -- vector when checking the validity of instance declarations.
- setTyThingPoss (ATyCon tycon) atTyVars =
- let classTyVars = map fst tv_bndrs
- poss = catMaybes
- . map ((`elemIndex` classTyVars) . fst)
- $ atTyVars
- -- There will be no Nothing, as we already passed renaming
- in
- ATyCon (setTyConArgPoss tycon poss)
- setTyThingPoss _ _ = panic "TcIface.setTyThingPoss"
-
tcIfaceDecl _ (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
= do { name <- lookupIfaceTop rdr_name
; return (ATyCon (mkForeignTyCon name ext_name
liftedTypeKind 0)) }
+tcFamInst :: Maybe (IfaceTyCon, [IfaceType]) -> IfL (Maybe (TyCon, [Type]))
+tcFamInst Nothing = return Nothing
+tcFamInst (Just (fam, tys)) = do { famTyCon <- tcIfaceTyCon fam
+ ; insttys <- mapM tcIfaceType tys
+ ; return $ Just (famTyCon, insttys) }
+
tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
tcIfaceDataCons tycon_name tycon _ if_cons
= case if_cons of
; arg_tys <- forkM (mk_doc name) (mapM tcIfaceType args)
; lbl_names <- mapM lookupIfaceTop field_lbls
+ -- Remember, tycon is the representation tycon
+ ; let orig_res_ty = mkFamilyTyConApp tycon
+ (substTyVars (mkTopTvSubst eq_spec) univ_tyvars)
+
; buildDataCon name is_infix {- Not infix -}
stricts lbl_names
univ_tyvars ex_tyvars
eq_spec theta
- arg_tys tycon
+ arg_tys orig_res_ty tycon
}
mk_doc con_name = ptext (sLit "Constructor") <+> ppr con_name
%************************************************************************
%* *
+ Annotations
+%* *
+%************************************************************************
+
+\begin{code}
+tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation]
+tcIfaceAnnotations = mapM tcIfaceAnnotation
+
+tcIfaceAnnotation :: IfaceAnnotation -> IfL Annotation
+tcIfaceAnnotation (IfaceAnnotation target serialized) = do
+ target' <- tcIfaceAnnTarget target
+ return $ Annotation {
+ ann_target = target',
+ ann_value = serialized
+ }
+
+tcIfaceAnnTarget :: IfaceAnnTarget -> IfL (AnnTarget Name)
+tcIfaceAnnTarget (NamedTarget occ) = do
+ name <- lookupIfaceTop occ
+ return $ NamedTarget name
+tcIfaceAnnTarget (ModuleTarget mod) = do
+ return $ ModuleTarget mod
+
+\end{code}
+
+
+%************************************************************************
+%* *
Vectorisation information
%* *
%************************************************************************
%************************************************************************
\begin{code}
+tcIdDetails :: Type -> IfaceIdDetails -> IfL IdDetails
+tcIdDetails _ IfVanillaId = return VanillaId
+tcIdDetails _ IfDFunId = return DFunId
+tcIdDetails ty (IfRecSelId naughty)
+ = return (RecSelId { sel_tycon = tc, sel_naughty = naughty })
+ where
+ (_, _, tau) = tcSplitSigmaTy ty
+ tc = tyConAppTyCon (funArgTy tau)
+ -- A bit fragile. Relies on the selector type looking like
+ -- forall abc. (stupid-context) => T a b c -> blah
+
tcIdInfo :: Bool -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
tcIdInfo ignore_prags name ty info
| ignore_prags = return vanillaIdInfo
tcIfaceGlobal name
| Just thing <- wiredInNameTyThing_maybe name
-- Wired-in things include TyCons, DataCons, and Ids
- = do { ifCheckWiredInThing name; return thing }
+ = do { ifCheckWiredInThing thing; return thing }
| otherwise
= do { env <- getGblEnv
; case if_rec_types env of { -- Note [Tying the knot]
-- Because if M.hs also has M.hs-boot, M.T will *already be* in the HPT, but in its
-- emasculated form (e.g. lacking data constructors).
-ifCheckWiredInThing :: Name -> IfL ()
--- Even though we are in an interface file, we want to make
--- sure the instances of a wired-in thing are loaded (imagine f :: Double -> Double)
--- Ditto want to ensure that RULES are loaded too
--- See Note [Loading instances] in LoadIface
-ifCheckWiredInThing name
- = do { mod <- getIfModule
- -- Check whether we are typechecking the interface for this
- -- very module. E.g when compiling the base library in --make mode
- -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in
- -- the HPT, so without the test we'll demand-load it into the PIT!
- -- C.f. the same test in checkWiredInTyCon above
- ; ASSERT2( isExternalName name, ppr name )
- unless (mod == nameModule name)
- (loadWiredInHomeIface name) }
-
tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
tcIfaceTyCon IfaceIntTc = tcWiredInTyCon intTyCon
tcIfaceTyCon IfaceBoolTc = tcWiredInTyCon boolTyCon
-- sure the instances and RULES of this tycon are loaded
-- Imagine: f :: Double -> Double
tcWiredInTyCon :: TyCon -> IfL TyCon
-tcWiredInTyCon tc = do { ifCheckWiredInThing (tyConName tc)
+tcWiredInTyCon tc = do { ifCheckWiredInThing (ATyCon tc)
; return tc }
tcIfaceClass :: Name -> IfL Class
bindIfaceBndrs bs $ \ bs' ->
thing_inside (b':bs')
+
-----------------------
tcIfaceLetBndr :: IfaceLetBndr -> IfL Id
tcIfaceLetBndr (IfLetBndr fs ty info)
return (Var.mkCoVar name kind)
else
return (Var.mkTyVar name kind) }
-\end{code}
+
+bindIfaceTyVars_AT :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
+-- Used for type variable in nested associated data/type declarations
+-- where some of the type variables are already in scope
+-- class C a where { data T a b }
+-- Here 'a' is in scope when we look at the 'data T'
+bindIfaceTyVars_AT [] thing_inside
+ = thing_inside []
+bindIfaceTyVars_AT (b@(tv_occ,_) : bs) thing_inside
+ = bindIfaceTyVars_AT bs $ \ bs' ->
+ do { mb_tv <- lookupIfaceTyVar tv_occ
+ ; case mb_tv of
+ Just b' -> thing_inside (b':bs')
+ Nothing -> bindIfaceTyVar b $ \ b' ->
+ thing_inside (b':bs') }
+\end{code}