X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FTcIface.lhs;h=af43f979b4db3e01470d75849dec8828dcde44a1;hb=9ffadf219cbc4f8ec57264786df936a3cee88aec;hp=48ca729f665a2c58086c3e32eb4ea057a6dc438f;hpb=d95ce839533391e7118257537044f01cbb1d6694;p=ghc-hetmet.git diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 48ca729..af43f97 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -19,6 +19,7 @@ import LoadIface import IfaceEnv import BuildTyCl import TcRnMonad +import TcType ( tcSplitSigmaTy ) import Type import TypeRep import HscTypes @@ -53,6 +54,7 @@ import SrcLoc import DynFlags import Util import FastString +import BasicTypes (Arity) import Control.Monad import Data.List @@ -107,8 +109,9 @@ tcImportDecl :: Name -> TcM TyThing -- 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) @@ -117,26 +120,6 @@ tcImportDecl 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 @@ -167,6 +150,83 @@ importDecl name %************************************************************************ %* * + 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 %* * %************************************************************************ @@ -354,11 +414,13 @@ tcIfaceDecl :: Bool -- True <=> discard IdInfo on IfaceId bindings -> 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, @@ -426,7 +488,7 @@ tcIfaceDecl ignore_prags ; 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 @@ -444,19 +506,6 @@ tcIfaceDecl ignore_prags ; 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 @@ -847,6 +896,7 @@ tcIfaceExpr (IfaceCast expr co) = do tcIfaceExpr (IfaceNote note expr) = do expr' <- tcIfaceExpr expr case note of + IfaceInlineMe -> return (Note InlineMe expr') IfaceSCC cc -> return (Note (SCC cc) expr') IfaceCoreNote n -> return (Note (CoreNote n) expr') @@ -925,6 +975,17 @@ do_one (IfaceRec pairs) thing_inside %************************************************************************ \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 @@ -940,39 +1001,43 @@ tcIdInfo ignore_prags name ty info tcPrag info HsNoCafRefs = return (info `setCafInfo` NoCafRefs) tcPrag info (HsArity arity) = return (info `setArityInfo` arity) tcPrag info (HsStrictness str) = return (info `setAllStrictnessInfo` Just str) - tcPrag info (HsInline prag) = return (info `setInlinePragInfo` prag) -- The next two are lazy, so they don't transitively suck stuff in - tcPrag info (HsUnfold if_unf) = do { unf <- tcUnfolding name ty info if_unf - ; return (info `setUnfoldingInfoLazily` unf) } + tcPrag info (HsWorker nm arity) = tcWorkerInfo ty info nm arity + tcPrag info (HsInline inline_prag) = return (info `setInlinePragInfo` inline_prag) + tcPrag info (HsUnfold expr) = do + maybe_expr' <- tcPragExpr name expr + let + -- maybe_expr' doesn't get looked at if the unfolding + -- is never inspected; so the typecheck doesn't even happen + unfold_info = case maybe_expr' of + Nothing -> noUnfolding + Just expr' -> mkTopUnfolding expr' + return (info `setUnfoldingInfoLazily` unfold_info) \end{code} \begin{code} -tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding -tcUnfolding name _ _ (IfCoreUnfold if_expr) - = do { mb_expr <- tcPragExpr name if_expr - ; return (case mb_expr of - Nothing -> NoUnfolding - Just expr -> mkTopUnfolding expr) } - -tcUnfolding name _ _ (IfInlineRule arity if_expr) - = do { mb_expr <- tcPragExpr name if_expr - ; return (case mb_expr of - Nothing -> NoUnfolding - Just expr -> mkInlineRule expr arity) } - -tcUnfolding name ty info (IfWrapper arity wkr) +tcWorkerInfo :: Type -> IdInfo -> Name -> Arity -> IfL IdInfo +tcWorkerInfo ty info wkr arity = do { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr) + + -- We return without testing maybe_wkr_id, but as soon as info is + -- looked at we will test it. That's ok, because its outside the + -- knot; and there seems no big reason to further defer the + -- tcIfaceId lookup. (Contrast with tcPragExpr, where postponing walking + -- over the unfolding until it's actually used does seem worth while.) ; us <- newUniqueSupply + ; return (case mb_wkr_id of - Nothing -> noUnfolding - Just wkr_id -> make_inline_rule wkr_id us) } + Nothing -> info + Just wkr_id -> add_wkr_info us wkr_id info) } where - doc = text "Worker for" <+> ppr name + doc = text "Worker for" <+> ppr wkr + add_wkr_info us wkr_id info + = info `setUnfoldingInfoLazily` mk_unfolding us wkr_id + `setWorkerInfo` HasWorker wkr_id arity - make_inline_rule wkr_id us - = mkWwInlineRule (initUs_ us (mkWrapper ty strict_sig) wkr_id) - arity wkr_id + mk_unfolding us wkr_id = mkTopUnfolding (initUs_ us (mkWrapper ty strict_sig) wkr_id) -- We are relying here on strictness info always appearing -- before worker info, fingers crossed .... @@ -1023,7 +1088,7 @@ tcIfaceGlobal :: Name -> IfL TyThing 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] @@ -1066,22 +1131,6 @@ tcIfaceGlobal name -- 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 @@ -1108,7 +1157,7 @@ tcIfaceTyCon IfaceUbxTupleKindTc = return ubxTupleKindTyCon -- 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