#include "HsVersions.h"
import IfaceSyn
-import LoadIface ( loadHomeInterface, loadInterface, predInstGates, discardDeclPrags )
+import LoadIface ( loadHomeInterface, loadInterface, predInstGates,
+ discardDeclPrags, loadDecls )
import IfaceEnv ( lookupIfaceTop, lookupIfaceExt, newGlobalBinder, lookupOrig,
extendIfaceIdEnv, extendIfaceTyVarEnv, newIPName,
tcIfaceTyVar, tcIfaceLclId,
mkAbstractTyConRhs, mkDataTyConRhs, mkNewTyConRhs )
import TcRnMonad
import Type ( liftedTypeKind, splitTyConApp,
- mkTyVarTys, mkGenTyConApp, mkTyVarTys, ThetaType, pprClassPred )
+ mkTyVarTys, mkGenTyConApp, ThetaType, pprClassPred )
import TypeRep ( Type(..), PredType(..) )
import TyCon ( TyCon, tyConName )
import HscTypes ( ExternalPackageState(..), EpsStats(..), PackageInstEnv,
-- Get the TyThing for this Name from an interface file
importDecl name
| Just thing <- wiredInNameTyThing_maybe name
- -- This case only happens for tuples, because we pre-populate the eps_PTE
- -- with other wired-in things. We can't do that for tuples because we
+ -- This case definitely happens for tuples, because we
-- don't know how many of them we'll find
+ -- It also now happens for all other wired in things. We used
+ -- to pre-populate the eps_PTE with other wired-in things, but
+ -- we don't seem to do that any more. I guess it keeps the PTE smaller?
= do { updateEps_ (\ eps -> eps { eps_PTE = extendTypeEnv (eps_PTE eps) thing })
; return (Succeeded thing) }
-- It's not actually *wrong* to do so, but in fact GHCi is unable
-- to handle unboxed tuples, so it must not see unfoldings.
ignore_prags <- doptM Opt_IgnoreInterfacePragmas
- ; let { decls | ignore_prags = map (discardDeclPrags . snd) (mi_decls iface)
- | otherwise = map snd (mi_decls iface)
- ; rules | ignore_prags = []
- | otherwise = mi_rules iface
- ; dfuns = mi_insts iface
- ; mod = mi_module iface
- }
- -- Typecheck the decls
- ; names <- mappM (lookupOrig mod . ifName) decls
- ; ty_things <- fixM (\ rec_ty_things -> do
- { writeMutVar tc_env_var (mkNameEnv (names `zipLazy` rec_ty_things))
- -- This only makes available the "main" things,
- -- but that's enough for the strictly-checked part
- ; mapM tcIfaceDecl decls })
-
- -- Now augment the type envt with all the implicit things
- -- These will be needed when type-checking the unfoldings for
- -- the IfaceIds, but this is done lazily, so writing the thing
- -- now is sufficient
- ; let { add_implicits main_thing = main_thing : implicitTyThings main_thing
- ; type_env = mkTypeEnv (concatMap add_implicits ty_things) }
+
+ -- Load & typecheck the decls
+ ; decl_things <- loadDecls ignore_prags (mi_decls iface)
+
+ ; let type_env = mkNameEnv decl_things
; writeMutVar tc_env_var type_env
-- Now do those rules and instances
+ ; let { rules | ignore_prags = []
+ | otherwise = mi_rules iface
+ ; dfuns = mi_insts iface
+ }
; dfuns <- mapM tcIfaceInst dfuns
; rules <- mapM tcIfaceRule rules
; returnM (IdCoreRule fn (isOrphNm fn_rdr) core_rule) }
isOrphNm :: IfaceExtName -> Bool
-isOrphNm (LocalTop _) = False
-isOrphNm (LocalTopSub _ _) = False
-isOrphNm other = True
+-- An orphan name comes from somewhere other than this module,
+-- so it has a non-local name
+isOrphNm name = not (isLocalIfaceExtName name)
\end{code}
Nothing -> do
{ env <- getGblEnv
- ; case if_rec_types env of
+ ; case if_rec_types env of {
Just (mod, get_type_env)
| nameIsLocalOrFrom mod name
-> do -- It's defined in the module being compiled
Nothing -> pprPanic "tcIfaceGlobal (local): not found:"
(ppr name $$ ppr type_env) }
- other -> do
+ ; other -> do
{ mb_thing <- importDecl name -- It's imported; go get it
; case mb_thing of
Failed err -> failIfM err
Succeeded thing -> return thing
- }}}}
+ }}}}}
tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
tcIfaceTyCon IfaceIntTc = return intTyCon