\begin{code}
module TcIface (
tcImportDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface,
- tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules, tcIfaceGlobal,
- tcExtCoreBindings
+ tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
+ tcIfaceVectInfo, tcIfaceGlobal, tcExtCoreBindings
) where
#include "HsVersions.h"
import TysWiredIn
import Var ( TyVar )
import qualified Var
+import VarEnv
import Name
import NameEnv
import OccName
tcImportDecl name
| Just thing <- wiredInNameTyThing_maybe name
= do { initIfaceTcRn (loadWiredInHomeIface name)
+ -- See Note [Loading instances] in LoadIface
; return thing }
| otherwise
= do { traceIf (text "tcImportDecl" <+> ppr name)
checkWiredInTyCon :: TyCon -> TcM ()
-- Ensure that the home module of the TyCon (and hence its instances)
--- are loaded. It might not be a wired-in tycon (see the calls in TcUnify),
+-- 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)
; fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
; rules <- tcIfaceRules ignore_prags (mi_rules iface)
+ -- Vectorisation information
+ ; vect_info <- tcIfaceVectInfo (mi_module iface) type_env
+ (mi_vect_info iface)
+
-- Exports
; exports <- ifaceExportNames (mi_exports iface)
, md_insts = insts
, md_fam_insts = fam_insts
, md_rules = rules
+ , md_vect_info = vect_info
, md_exports = exports
, md_modBreaks = emptyModBreaks
}
tcIfaceDecl ignore_prags
(IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
- ifOpenSyn = isOpen, ifSynRhs = rdr_rhs_ty})
+ ifOpenSyn = isOpen, ifSynRhs = rdr_rhs_ty,
+ ifFamInst = mb_family})
= bindIfaceTyVars tv_bndrs $ \ tyvars -> do
{ tc_name <- lookupIfaceTop occ_name
; rhs_tyki <- tcIfaceType rdr_rhs_ty
; let rhs = if isOpen then OpenSynTyCon rhs_tyki Nothing
else SynonymTyCon rhs_tyki
- ; return (ATyCon (buildSynTyCon tc_name tyvars rhs))
+ ; famInst <- case mb_family of
+ Nothing -> return Nothing
+ Just (fam, tys) ->
+ do { famTyCon <- tcIfaceTyCon fam
+ ; insttys <- mapM tcIfaceType tys
+ ; return $ Just (famTyCon, insttys)
+ }
+ ; tycon <- buildSynTyCon tc_name tyvars rhs famInst
+ ; return $ ATyCon tycon
}
tcIfaceDecl ignore_prags
= case if_cons of
IfAbstractTyCon -> return mkAbstractTyConRhs
IfOpenDataTyCon -> return mkOpenDataTyConRhs
- IfOpenNewTyCon -> return mkOpenNewTyConRhs
IfDataTyCon cons -> do { data_cons <- mappM tc_con_decl cons
; return (mkDataTyConRhs data_cons) }
IfNewTyCon con -> do { data_con <- tc_con_decl con
do_item (occ, if_ty) = do { tv <- tcIfaceTyVar (occNameFS occ)
; ty <- tcIfaceType if_ty
; return (tv,ty) }
-\end{code}
+\end{code}
%************************************************************************
%************************************************************************
%* *
+ Vectorisation information
+%* *
+%************************************************************************
+
+\begin{code}
+tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
+tcIfaceVectInfo mod typeEnv (IfaceVectInfo
+ { ifaceVectInfoVar = vars
+ , ifaceVectInfoTyCon = tycons
+ , ifaceVectInfoTyConReuse = tyconsReuse
+ })
+ = do { vVars <- mapM vectVarMapping vars
+ ; tyConRes1 <- mapM vectTyConMapping tycons
+ ; tyConRes2 <- mapM vectTyConReuseMapping tycons
+ ; let (vTyCons, vDataCons, vIsos) = unzip3 (tyConRes1 ++ tyConRes2)
+ ; return $ VectInfo
+ { vectInfoVar = mkVarEnv vVars
+ , vectInfoTyCon = mkNameEnv vTyCons
+ , vectInfoDataCon = mkNameEnv (concat vDataCons)
+ , vectInfoIso = mkNameEnv vIsos
+ }
+ }
+ where
+ vectVarMapping name
+ = do { vName <- lookupOrig mod (mkVectOcc (nameOccName name))
+ ; let { var = lookupVar name
+ ; vVar = lookupVar vName
+ }
+ ; return (var, (var, vVar))
+ }
+ vectTyConMapping name
+ = do { vName <- lookupOrig mod (mkVectTyConOcc (nameOccName name))
+ ; isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name))
+ ; let { tycon = lookupTyCon name
+ ; vTycon = lookupTyCon vName
+ ; isoTycon = lookupVar isoName
+ }
+ ; vDataCons <- mapM vectDataConMapping (tyConDataCons tycon)
+ ; return ((name, (tycon, vTycon)), -- (T, T_v)
+ vDataCons, -- list of (Ci, Ci_v)
+ (name, (tycon, isoTycon))) -- (T, isoT)
+ }
+ vectTyConReuseMapping name
+ = do { isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name))
+ ; let { tycon = lookupTyCon name
+ ; isoTycon = lookupVar isoName
+ ; vDataCons = [ (dataConName dc, (dc, dc))
+ | dc <- tyConDataCons tycon]
+ }
+ ; return ((name, (tycon, tycon)), -- (T, T)
+ vDataCons, -- list of (Ci, Ci)
+ (name, (tycon, isoTycon))) -- (T, isoT)
+ }
+ vectDataConMapping datacon
+ = do { let name = dataConName datacon
+ ; vName <- lookupOrig mod (mkVectDataConOcc (nameOccName name))
+ ; let vDataCon = lookupDataCon vName
+ ; return (name, (datacon, vDataCon))
+ }
+ --
+ lookupVar name = case lookupTypeEnv typeEnv name of
+ Just (AnId var) -> var
+ Just _ ->
+ panic "TcIface.tcIfaceVectInfo: not an id"
+ Nothing ->
+ panic "TcIface.tcIfaceVectInfo: unknown name"
+ lookupTyCon name = case lookupTypeEnv typeEnv name of
+ Just (ATyCon tc) -> tc
+ Just _ ->
+ panic "TcIface.tcIfaceVectInfo: not a tycon"
+ Nothing ->
+ panic "TcIface.tcIfaceVectInfo: unknown name"
+ lookupDataCon name = case lookupTypeEnv typeEnv name of
+ Just (ADataCon dc) -> dc
+ Just _ ->
+ panic "TcIface.tcIfaceVectInfo: not a datacon"
+ Nothing ->
+ panic "TcIface.tcIfaceVectInfo: unknown name"
+\end{code}
+
+%************************************************************************
+%* *
Types
%* *
%************************************************************************
= tcIfaceLclId name `thenM` \ id ->
returnM (Var id)
+tcIfaceExpr (IfaceTick modName tickNo)
+ = tcIfaceTick modName tickNo `thenM` \ id ->
+ returnM (Var id)
+
tcIfaceExpr (IfaceExt gbl)
= tcIfaceExtId gbl `thenM` \ id ->
returnM (Var id)
-- 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
newExtCoreBndr :: IfaceLetBndr -> IfL Id
newExtCoreBndr (IfLetBndr var ty _) -- Ignoring IdInfo for now
= do { mod <- getIfModule
- ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcLoc
+ ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan
; ty' <- tcIfaceType ty
; return (mkLocalId name ty') }