Instance for wired-in tycons wibble
\begin{code}
module LoadIface (
\begin{code}
module LoadIface (
- loadHomeInterface, loadInterface, loadDecls,
+ loadHomeInterface, loadInterface, loadWiredInHomeIface,
loadSrcInterface, loadOrphanModules,
findAndReadIface, readIface, -- Used when reading the module's old interface
loadSrcInterface, loadOrphanModules,
findAndReadIface, readIface, -- Used when reading the module's old interface
- ifaceStats, discardDeclPrags,
+ loadDecls, ifaceStats, discardDeclPrags,
initExternalPackageState
) where
initExternalPackageState
) where
import DynFlags ( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ),
isOneShot )
import IfaceSyn ( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..),
import DynFlags ( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ),
isOneShot )
import IfaceSyn ( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..),
- IfaceConDecls(..), IfaceExpr(..), IfaceIdInfo(..),
- IfaceType(..), IfaceExtName )
+ IfaceConDecls(..), IfaceIdInfo(..) )
import IfaceEnv ( newGlobalBinder )
import HscTypes ( ModIface(..), TyThing, emptyModIface, EpsStats(..),
addEpsInStats, ExternalPackageState(..),
import IfaceEnv ( newGlobalBinder )
import HscTypes ( ModIface(..), TyThing, emptyModIface, EpsStats(..),
addEpsInStats, ExternalPackageState(..),
import Rules ( extendRuleBaseList, mkRuleBase )
import InstEnv ( emptyInstEnv, extendInstEnvList )
import Name ( Name {-instance NamedThing-}, getOccName,
import Rules ( extendRuleBaseList, mkRuleBase )
import InstEnv ( emptyInstEnv, extendInstEnvList )
import Name ( Name {-instance NamedThing-}, getOccName,
- nameModule, isInternalName )
+ nameModule, isInternalName, isWiredInName )
import NameEnv
import MkId ( seqId )
import Module ( Module, ModLocation(ml_hi_file), emptyModuleEnv,
import NameEnv
import MkId ( seqId )
import Module ( Module, ModLocation(ml_hi_file), emptyModuleEnv,
initIfaceTcRn $ loadSysInterface doc (nameModule name)
---------------
initIfaceTcRn $ loadSysInterface doc (nameModule name)
---------------
+loadWiredInHomeIface :: Name -> IfM lcl ()
+-- A IfM function to load the home interface for a wired-in thing,
+-- so that we're sure that we see its instance declarations and rules
+loadWiredInHomeIface name
+ = ASSERT( isWiredInName name )
+ do { loadSysInterface doc (nameModule name); return () }
+ where
+ doc = ptext SLIT("Need home interface for wired-in thing") <+> ppr name
+
+---------------
loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
-- A wrapper for loadInterface that Throws an exception if it fails
loadSysInterface doc mod_name
loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
-- A wrapper for loadInterface that Throws an exception if it fails
loadSysInterface doc mod_name
#include "HsVersions.h"
import IfaceSyn
#include "HsVersions.h"
import IfaceSyn
-import LoadIface ( loadInterface, loadHomeInterface, loadDecls, findAndReadIface )
+import LoadIface ( loadInterface, loadWiredInHomeIface,
+ loadDecls, findAndReadIface )
import IfaceEnv ( lookupIfaceTop, lookupIfaceExt, newGlobalBinder,
extendIfaceIdEnv, extendIfaceTyVarEnv, newIPName,
tcIfaceTyVar, tcIfaceLclId, lookupIfaceTc,
import IfaceEnv ( lookupIfaceTop, lookupIfaceExt, newGlobalBinder,
extendIfaceIdEnv, extendIfaceTyVarEnv, newIPName,
tcIfaceTyVar, tcIfaceLclId, lookupIfaceTc,
-- Entry point for *source-code* uses of importDecl
tcImportDecl name
| Just thing <- wiredInNameTyThing_maybe name
-- Entry point for *source-code* uses of importDecl
tcImportDecl name
| Just thing <- wiredInNameTyThing_maybe name
- = do { checkWiredInName name; return thing }
+ = do { initIfaceTcRn (loadWiredInHomeIface name)
+ ; return thing }
| otherwise
= do { traceIf (text "tcLookupGlobal" <+> ppr name)
; mb_thing <- initIfaceTcRn (importDecl name)
| otherwise
= do { traceIf (text "tcLookupGlobal" <+> ppr name)
; mb_thing <- initIfaceTcRn (importDecl name)
Failed err -> failWithTc err }
checkWiredInTyCon :: TyCon -> TcM ()
Failed err -> failWithTc err }
checkWiredInTyCon :: TyCon -> TcM ()
--- Ensure its instances are loaded
--- It might not be a wired-in tycon (see the calls in TcUnify)
+-- 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),
+-- in which case this is a no-op.
- | not (isWiredInName tc_name) = return ()
- | otherwise = checkWiredInName tc_name
- where
- tc_name = tyConName tc
-
-checkWiredInName :: Name -> TcM ()
--- We "check" a wired-in name solely to check that its
--- interface file is loaded, so that we're sure that we see
--- its instance declarations and rules
-checkWiredInName name
- = ASSERT( isWiredInName name )
- do { mod <- getModule
- ; if nameIsLocalOrFrom mod name then
+ | not (isWiredInName tc_name)
+ = return ()
+ | otherwise
+ = do { mod <- getModule
+ ; if nameIsLocalOrFrom mod tc_name then
-- Don't look for (non-existent) Float.hi when
-- compiling Float.lhs, which mentions Float of course
return ()
else -- A bit yukky to call initIfaceTcRn here
-- Don't look for (non-existent) Float.hi when
-- compiling Float.lhs, which mentions Float of course
return ()
else -- A bit yukky to call initIfaceTcRn here
- do { loadHomeInterface doc name; return () }
+ initIfaceTcRn (loadWiredInHomeIface tc_name)
- doc = ptext SLIT("Need home interface for wired-in thing") <+> ppr name
importDecl :: Name -> IfM lcl (MaybeErr Message TyThing)
-- Get the TyThing for this Name from an interface file
importDecl :: Name -> IfM lcl (MaybeErr Message TyThing)
-- Get the TyThing for this Name from an interface file
tcIfaceGlobal :: Name -> IfL TyThing
tcIfaceGlobal name
| Just thing <- wiredInNameTyThing_maybe name
tcIfaceGlobal :: Name -> IfL TyThing
tcIfaceGlobal name
| Just thing <- wiredInNameTyThing_maybe name
+ = do { loadWiredInHomeIface name; return thing }
+ -- Even though we are in an interface file, we want to make
+ -- sure its instances are loaded (imagine f :: Double -> Double)
+ -- and its RULES are loaded too
| otherwise
= do { (eps,hpt) <- getEpsAndHpt
; case lookupType hpt (eps_PTE eps) name of {
| otherwise
= do { (eps,hpt) <- getEpsAndHpt
; case lookupType hpt (eps_PTE eps) name of {