%
+% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-\section[TcIfaceSig]{Type checking of type signatures in interface files}
+
+Type checking of type signatures in interface files
\begin{code}
module TcIface (
#include "HsVersions.h"
import IfaceSyn
-import LoadIface ( loadInterface, loadWiredInHomeIface, findAndReadIface, loadDecls )
-import IfaceEnv ( lookupIfaceTop, newGlobalBinder,
- extendIfaceIdEnv, extendIfaceTyVarEnv, newIPName,
- tcIfaceTyVar, tcIfaceLclId,
- newIfaceName, newIfaceNames, ifaceExportNames )
-import BuildTyCl ( buildSynTyCon, buildAlgTyCon, buildDataCon,
- buildClass,
- mkAbstractTyConRhs, mkOpenDataTyConRhs,
- mkOpenNewTyConRhs, mkDataTyConRhs, mkNewTyConRhs )
+import LoadIface
+import IfaceEnv
+import BuildTyCl
import TcRnMonad
-import Type ( liftedTypeKind, splitTyConApp, mkTyConApp,
- liftedTypeKindTyCon, unliftedTypeKindTyCon,
- openTypeKindTyCon, argTypeKindTyCon,
- ubxTupleKindTyCon, ThetaType )
-import TypeRep ( Type(..), PredType(..) )
-import TyCon ( TyCon, tyConName, SynTyConRhs(..), setTyConArgPoss )
-import HscTypes ( ExternalPackageState(..),
- TyThing(..), tyThingClass, tyThingTyCon,
- ModIface(..), ModDetails(..), HomeModInfo(..),
- emptyModDetails, lookupTypeEnv, lookupType,
- typeEnvIds )
-import InstEnv ( Instance(..), mkImportedInstance )
-import FamInstEnv ( FamInst(..), mkImportedFamInst )
+import Type
+import TypeRep
+import HscTypes
+import InstEnv
+import FamInstEnv
import CoreSyn
-import CoreUtils ( exprType, dataConRepFSInstPat )
+import CoreUtils
import CoreUnfold
-import CoreLint ( lintUnfolding )
-import WorkWrap ( mkWrapper )
-import Id ( Id, mkVanillaGlobal, mkLocalId )
-import MkId ( mkFCallId )
-import IdInfo ( IdInfo, CafInfo(..), WorkerInfo(..),
- setUnfoldingInfoLazily, setAllStrictnessInfo, setWorkerInfo,
- setArityInfo, setInlinePragInfo, setCafInfo,
- vanillaIdInfo, newStrictnessInfo )
-import Class ( Class )
-import TyCon ( tyConDataCons, isTupleTyCon, mkForeignTyCon )
-import DataCon ( DataCon, dataConWorkId )
-import TysWiredIn ( tupleCon, tupleTyCon, listTyCon, intTyCon, boolTyCon, charTyCon, parrTyCon )
-import Var ( TyVar, mkTyVar )
-import Name ( Name, nameModule, nameIsLocalOrFrom, isWiredInName,
- nameOccName, wiredInNameTyThing_maybe )
+import CoreLint
+import WorkWrap
+import Id
+import MkId
+import IdInfo
+import Class
+import TyCon
+import DataCon
+import TysWiredIn
+import Var ( TyVar )
+import qualified Var
+import Name
import NameEnv
-import OccName ( OccName, mkVarOccFS, mkTyVarOcc, occNameSpace,
- pprNameSpace, occNameFS )
-import Module ( Module, moduleName )
-import UniqFM ( lookupUFM )
-import UniqSupply ( initUs_, uniqsFromSupply )
+import NameSet
+import OccName
+import Module
+import UniqFM
+import UniqSupply
import Outputable
-import ErrUtils ( Message )
-import Maybes ( MaybeErr(..) )
-import SrcLoc ( noSrcLoc )
-import Util ( zipWithEqual )
-import DynFlags ( DynFlag(..), isOneShot )
-import Control.Monad ( unless )
-
-import List ( elemIndex)
-import Maybe ( catMaybes )
+import ErrUtils
+import Maybes
+import SrcLoc
+import DynFlags
+import Control.Monad
+
+import Data.List
+import Data.Maybe
\end{code}
This module takes
; fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
; rules <- tcIfaceRules ignore_prags (mi_rules iface)
+ -- Vectorisation information
+ ; let vect_info = VectInfo
+ (mkNameSet (ifaceVectInfoCCVar (mi_vect_info iface)))
+
-- Exports
; exports <- ifaceExportNames (mi_exports iface)
, md_insts = insts
, md_fam_insts = fam_insts
, md_rules = rules
- , md_exports = exports
+ , md_vect_info = vect_info
+ , md_exports = exports
+ , md_modBreaks = emptyModBreaks
}
}
\end{code}
%************************************************************************
\begin{code}
-tcHiBootIface :: Module -> TcRn ModDetails
+tcHiBootIface :: HscSource -> Module -> TcRn ModDetails
-- Load the hi-boot iface for the module being compiled,
-- if it indeed exists in the transitive closure of imports
-- Return the ModDetails, empty if no hi-boot iface
-tcHiBootIface mod
+tcHiBootIface hsc_src mod
+ | isHsBoot hsc_src -- Already compiling a hs-boot file
+ = return emptyModDetails
+ | otherwise
= do { traceIf (text "loadHiBootInterface" <+> ppr mod)
; mode <- getGhcMode
= bindIfaceTyVars tv_bndrs $ \ tyvars -> do
{ tc_name <- lookupIfaceTop occ_name
; rhs_tyki <- tcIfaceType rdr_rhs_ty
- ; let rhs = if isOpen then OpenSynTyCon rhs_tyki
+ ; let rhs = if isOpen then OpenSynTyCon rhs_tyki Nothing
else SynonymTyCon rhs_tyki
- ; return (ATyCon (buildSynTyCon tc_name tyvars rhs))
+ -- !!!TODO: read mb_family info from iface and pass as last argument
+ ; tycon <- buildSynTyCon tc_name tyvars rhs Nothing
+ ; return $ ATyCon tycon
}
tcIfaceDecl ignore_prags
= do { op_name <- lookupIfaceTop occ
; op_ty <- forkM (mk_doc op_name rdr_ty) (tcIfaceType rdr_ty)
-- Must be done lazily for just the same reason as the
- -- context of a data decl: the type sig might mention the
- -- class being defined
+ -- type of a data con; to avoid sucking in types that
+ -- it mentions unless it's necessray to do so
; return (op_name, dm, op_ty) }
mk_doc op_name op_ty = ptext SLIT("Class op") <+> sep [ppr op_name, ppr op_ty]
ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
ifConArgTys = args, ifConFields = field_lbls,
ifConStricts = stricts})
- = bindIfaceTyVars univ_tvs $ \ univ_tyvars -> do
- bindIfaceTyVars ex_tvs $ \ ex_tyvars -> do
+ = bindIfaceTyVars univ_tvs $ \ univ_tyvars -> do
+ bindIfaceTyVars ex_tvs $ \ ex_tyvars -> do
{ name <- lookupIfaceTop occ
; eq_spec <- tcIfaceEqSpec spec
; theta <- tcIfaceCtxt ctxt -- Laziness seems not worth the bother here
= do { dfun <- forkM (ptext SLIT("Dict fun") <+> ppr dfun_occ) $
tcIfaceExtId dfun_occ
; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
- ; return (mkImportedInstance cls mb_tcs' orph dfun oflag) }
+ ; return (mkImportedInstance cls mb_tcs' dfun oflag) }
tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon,
; return (bndrs', args', rhs') }
; let mb_tcs = map ifTopFreeName args
; lcl <- getLclEnv
- ; let this_module = if_mod lcl
; returnM (Rule { ru_name = name, ru_fn = fn, ru_act = act,
ru_bndrs = bndrs', ru_args = args',
- ru_rhs = rhs', ru_orph = orph,
+ ru_rhs = rhs',
ru_rough = mb_tcs,
- ru_local = nameModule fn == this_module }) }
+ ru_local = False }) } -- An imported RULE is never for a local Id
+ -- or, even if it is (module loop, perhaps)
+ -- we'll just leave it in the non-local set
where
-- This function *must* mirror exactly what Rules.topFreeName does
-- We could have stored the ru_rough field in the iface file
returnM (Case scrut' case_bndr' ty' alts')
tcIfaceExpr (IfaceLet (IfaceNonRec bndr rhs) body)
- = tcIfaceExpr rhs `thenM` \ rhs' ->
- bindIfaceId bndr $ \ bndr' ->
- tcIfaceExpr body `thenM` \ body' ->
- returnM (Let (NonRec bndr' rhs') body')
+ = do { rhs' <- tcIfaceExpr rhs
+ ; id <- tcIfaceLetBndr bndr
+ ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body)
+ ; return (Let (NonRec id rhs') body') }
tcIfaceExpr (IfaceLet (IfaceRec pairs) body)
- = bindIfaceIds bndrs $ \ bndrs' ->
- mappM tcIfaceExpr rhss `thenM` \ rhss' ->
- tcIfaceExpr body `thenM` \ body' ->
- returnM (Let (Rec (bndrs' `zip` rhss')) body')
+ = do { ids <- mapM tcIfaceLetBndr bndrs
+ ; extendIfaceIdEnv ids $ do
+ { rhss' <- mapM tcIfaceExpr rhss
+ ; body' <- tcIfaceExpr body
+ ; return (Let (Rec (ids `zip` rhss')) body') } }
where
(bndrs, rhss) = unzip pairs
\begin{code}
bindIfaceBndr :: IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
-bindIfaceBndr (IfaceIdBndr bndr) thing_inside
- = bindIfaceId bndr thing_inside
+bindIfaceBndr (IfaceIdBndr (fs, ty)) thing_inside
+ = do { name <- newIfaceName (mkVarOccFS fs)
+ ; ty' <- tcIfaceType ty
+ ; let id = mkLocalId name ty'
+ ; extendIfaceIdEnv [id] (thing_inside id) }
bindIfaceBndr (IfaceTvBndr bndr) thing_inside
= bindIfaceTyVar bndr thing_inside
thing_inside (b':bs')
-----------------------
-bindIfaceId :: IfaceIdBndr -> (Id -> IfL a) -> IfL a
-bindIfaceId (occ, ty) thing_inside
- = do { name <- newIfaceName (mkVarOccFS occ)
+tcIfaceLetBndr (IfLetBndr fs ty info)
+ = do { name <- newIfaceName (mkVarOccFS fs)
; ty' <- tcIfaceType ty
- ; let { id = mkLocalId name ty' }
- ; extendIfaceIdEnv [id] (thing_inside id) }
-
-bindIfaceIds :: [IfaceIdBndr] -> ([Id] -> IfL a) -> IfL a
-bindIfaceIds bndrs thing_inside
- = do { names <- newIfaceNames (map mkVarOccFS occs)
- ; tys' <- mappM tcIfaceType tys
- ; let { ids = zipWithEqual "tcCoreValBndr" mkLocalId names tys' }
- ; extendIfaceIdEnv ids (thing_inside ids) }
+ ; case info of
+ NoInfo -> return (mkLocalId name ty')
+ HasInfo i -> return (mkLocalIdWithInfo name ty' (tc_info i)) }
where
- (occs,tys) = unzip bndrs
-
+ -- Similar to tcIdInfo, but much simpler
+ tc_info [] = vanillaIdInfo
+ tc_info (HsInline p : i) = tc_info i `setInlinePragInfo` p
+ tc_info (HsArity a : i) = tc_info i `setArityInfo` a
+ tc_info (HsStrictness s : i) = tc_info i `setAllStrictnessInfo` Just s
+ tc_info (other : i) = pprTrace "tcIfaceLetBndr: discarding unexpected IdInfo"
+ (ppr other) (tc_info i)
-----------------------
-newExtCoreBndr :: IfaceIdBndr -> IfL Id
-newExtCoreBndr (var, ty)
+newExtCoreBndr :: IfaceLetBndr -> IfL Id
+newExtCoreBndr (IfLetBndr var ty _) -- Ignoring IdInfo for now
= do { mod <- getIfModule
; name <- newGlobalBinder mod (mkVarOccFS var) noSrcLoc
; ty' <- tcIfaceType ty
bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
bindIfaceTyVars bndrs thing_inside
= do { names <- newIfaceNames (map mkTyVarOcc occs)
- ; tyvars <- zipWithM mk_iface_tyvar names kinds
+ ; tyvars <- TcRnMonad.zipWithM mk_iface_tyvar names kinds
; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
where
(occs,kinds) = unzip bndrs
mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
-mk_iface_tyvar name ifKind = do { kind <- tcIfaceType ifKind
- ; return (mkTyVar name kind)
- }
+mk_iface_tyvar name ifKind
+ = do { kind <- tcIfaceType ifKind
+ ; if isCoercionKind kind then
+ return (Var.mkCoVar name kind)
+ else
+ return (Var.mkTyVar name kind) }
\end{code}