\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
; 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
- -- !!!TODO: read mb_family info from iface and pass as last argument
- ; tycon <- buildSynTyCon tc_name tyvars rhs Nothing
+ ; 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
}
= 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
%************************************************************************
%* *
+ Vectorisation information
+%* *
+%************************************************************************
+
+\begin{code}
+tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
+tcIfaceVectInfo mod typeEnv (IfaceVectInfo names)
+ = do { ccVars <- mapM ccMapping names
+ ; return $ VectInfo (mkVarEnv ccVars)
+ }
+ where
+ ccMapping name
+ = do { ccName <- lookupOrig mod (mkCloOcc (nameOccName name))
+ ; let { var = lookup name
+ ; ccVar = lookup ccName
+ }
+ ; return (var, (var, ccVar))
+ }
+ lookup name = case lookupTypeEnv typeEnv name of
+ Just (AnId var) -> var
+ Just _ ->
+ panic "TcIface.tcIfaceVectInfo: wrong TyThing"
+ Nothing ->
+ panic "TcIface.tcIfaceVectInfo: unknown name"
+\end{code}
+
+%************************************************************************
+%* *
Types
%* *
%************************************************************************
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') }