Add hook to fam inst consistency check to GHCi/--make
[ghc.git] / compiler / typecheck / TcRnDriver.lhs
index 144d0d0..9c9c71f 100644 (file)
@@ -12,6 +12,7 @@ module TcRnDriver (
        tcRnLookupName,
        tcRnGetInfo,
        getModuleExports, 
+        tcRnRecoverDataCon,
 #endif
        tcRnModule, 
        tcTopSrcDecls,
@@ -69,8 +70,11 @@ import TyCon
 import SrcLoc
 import HscTypes
 import Outputable
+import Breakpoints
 
 #ifdef GHCI
+import Linker
+import DataCon
 import TcHsType
 import TcMType
 import TcMatches
@@ -306,7 +310,8 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
                                mg_fix_env   = emptyFixityEnv,
                                mg_deprecs   = NoDeprecs,
                                mg_foreign   = NoStubs,
-                               mg_hpc_info = noHpcInfo
+                               mg_hpc_info  = noHpcInfo,
+                                mg_dbg_sites = noDbgSites
                    } } ;
 
    tcCoreDump mod_guts ;
@@ -1087,19 +1092,32 @@ tcRnType hsc_env ictxt rdr_type
 -- could not be found.
 getModuleExports :: HscEnv -> Module -> IO (Messages, Maybe [AvailInfo])
 getModuleExports hsc_env mod
-  = initTc hsc_env HsSrcFile iNTERACTIVE (tcGetModuleExports mod)
-
-tcGetModuleExports :: Module -> TcM [AvailInfo]
-tcGetModuleExports mod = do
-  let doc = ptext SLIT("context for compiling statements")
-  iface <- initIfaceTcRn $ loadSysInterface doc mod
-  loadOrphanModules (dep_orphs (mi_deps iface)) False 
-               -- Load any orphan-module interfaces,
-               -- so their instances are visible
-  loadOrphanModules (dep_finsts (mi_deps iface)) True
-               -- Load any family instance-module interfaces,
-               -- so all family instances are visible
-  ifaceExportNames (mi_exports iface)
+  = let
+      ic        = hsc_IC hsc_env
+      checkMods = ic_toplev_scope ic ++ ic_exports ic
+    in
+    initTc hsc_env HsSrcFile iNTERACTIVE (tcGetModuleExports mod checkMods)
+
+-- Get the export avail info and also load all orphan and family-instance
+-- modules.  Finally, check that the family instances of all modules in the
+-- interactive context are consistent (these modules are in the second
+-- argument).
+tcGetModuleExports :: Module -> [Module] -> TcM [AvailInfo]
+tcGetModuleExports mod directlyImpMods
+  = do { let doc = ptext SLIT("context for compiling statements")
+       ; iface <- initIfaceTcRn $ loadSysInterface doc mod
+
+               -- Load any orphan-module and family instance-module
+               -- interfaces, so their instances are visible.
+       ; loadOrphanModules (dep_orphs (mi_deps iface)) False 
+       ; loadOrphanModules (dep_finsts (mi_deps iface)) True
+
+                -- Check that the family instances of all directly loaded
+                -- modules are consistent.
+       ; checkFamInstConsistency (dep_finsts (mi_deps iface)) directlyImpMods
+
+       ; ifaceExportNames (mi_exports iface)
+       }
 
 tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Maybe [Name])
 tcRnLookupRdrName hsc_env rdr_name 
@@ -1136,6 +1154,12 @@ lookup_rdr_name rdr_name = do {
     return good_names
  }
 
+tcRnRecoverDataCon :: HscEnv -> a -> IO (Maybe DataCon) 
+tcRnRecoverDataCon hsc_env a
+  = initTcPrintErrors hsc_env iNTERACTIVE $ 
+    setInteractiveContext hsc_env (hsc_IC hsc_env) $
+     do name    <- recoverDataCon a
+        tcLookupDataCon name
 
 tcRnLookupName :: HscEnv -> Name -> IO (Maybe TyThing)
 tcRnLookupName hsc_env name
@@ -1171,7 +1195,6 @@ tcRnGetInfo hsc_env name
     ispecs <- lookupInsts (icPrintUnqual ictxt) thing
     return (thing, fixity, ispecs)
 
-
 lookupInsts :: PrintUnqualified -> TyThing -> TcM [Instance]
 -- Filter the instances by the ones whose tycons (or clases resp) 
 -- are in scope unqualified.  Otherwise we list a whole lot too many!