module TcRnDriver (
#ifdef GHCI
mkExportEnv, getModuleContents, tcRnStmt,
- tcRnGetInfo, tcRnExpr, tcRnType,
+ tcRnGetInfo, GetInfoResult,
+ tcRnExpr, tcRnType,
#endif
tcRnModule,
tcTopSrcDecls,
import TcEnv ( tcLookupTyCon, tcLookupId, tcLookupGlobal )
import RnTypes ( rnLHsType )
import Inst ( tcStdSyntaxName, tcGetInstEnvs )
-import InstEnv ( classInstances, instEnvElts )
+import InstEnv ( DFunId, classInstances, instEnvElts )
import RnExpr ( rnStmts, rnLExpr )
import RnNames ( exportsToAvails )
import LoadIface ( loadSrcInterface, ifaceInstGates )
import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..),
IfaceExtName(..), IfaceConDecls(..), IfaceInst(..),
tyThingToIfaceDecl, dfunToIfaceInst )
-import IfaceType ( IfaceTyCon(..), interactiveExtNameFun, isLocalIfaceExtName )
+import IfaceType ( IfaceTyCon(..), IfaceType, toIfaceType,
+ interactiveExtNameFun, isLocalIfaceExtName )
import IfaceEnv ( lookupOrig )
import RnEnv ( lookupOccRn, dataTcOccs, lookupFixityRn )
import Id ( Id, isImplicitId, setIdType, globalIdDetails )
import Kind ( Kind )
import Var ( globaliseId )
import Name ( nameOccName )
+import OccName ( occNameUserString )
import NameEnv ( delListFromNameEnv )
import PrelNames ( iNTERACTIVE, ioTyConName, printName, monadNames, itName, returnIOName )
import HscTypes ( InteractiveContext(..), HomeModInfo(..), typeEnvElts, typeEnvClasses,
\end{code}
\begin{code}
+type GetInfoResult = (String, IfaceDecl, Fixity, SrcLoc,
+ [(IfaceType,SrcLoc)] -- Instances
+ )
+
tcRnGetInfo :: HscEnv
-> InteractiveContext
-> RdrName
- -> IO (Maybe [(IfaceDecl,
- Fixity, SrcLoc,
- [(IfaceInst, SrcLoc)])])
+ -> IO (Maybe [GetInfoResult])
+
-- Used to implemnent :info in GHCi
--
-- Look up a RdrName and return all the TyThings it might be
-- their parent declaration
let { do_one name = do { thing <- tcLookupGlobal name
; fixity <- lookupFixityRn name
- ; insts <- lookupInsts ext_nm thing
- ; return (toIfaceDecl ext_nm thing, fixity,
- getSrcLoc thing, insts) } } ;
+ ; dfuns <- lookupInsts ext_nm thing
+ ; return (str, toIfaceDecl ext_nm thing, fixity,
+ getSrcLoc thing,
+ [(toIfaceType ext_nm (idType dfun), getSrcLoc dfun) | dfun <- dfuns]
+ ) }
+ where
+ -- str is the the naked occurrence name
+ -- after stripping off qualification and parens (+)
+ str = occNameUserString (nameOccName name)
+ } ;
+
-- For the SrcLoc, the 'thing' has better info than
-- the 'name' because getting the former forced the
-- declaration to be loaded into the cache
return (fst (removeDups cmp results))
}
where
- cmp (d1,_,_,_) (d2,_,_,_) = ifName d1 `compare` ifName d2
+ cmp (_,d1,_,_,_) (_,d2,_,_,_) = ifName d1 `compare` ifName d2
ext_nm = interactiveExtNameFun (icPrintUnqual ictxt)
-lookupInsts :: (Name -> IfaceExtName) -> TyThing -> TcM [(IfaceInst, SrcLoc)]
+lookupInsts :: (Name -> IfaceExtName) -> TyThing -> TcM [DFunId]
-- Filter the instances by the ones whose tycons (or clases resp)
-- are in scope unqualified. Otherwise we list a whole lot too many!
lookupInsts ext_nm (AClass cls)
= do { loadImportedInsts cls [] -- [] means load all instances for cls
; inst_envs <- tcGetInstEnvs
- ; return [ (inst, getSrcLoc dfun)
+ ; return [ dfun
| (_,_,dfun) <- classInstances inst_envs cls
- , let inst = dfunToIfaceInst ext_nm dfun
- (_, tycons) = ifaceInstGates (ifInstHead inst)
+ , let (_, tycons) = ifaceInstGates (ifInstHead (dfunToIfaceInst ext_nm dfun))
+ -- Rather an indirect/inefficient test, but there we go
, all print_tycon_unqual tycons ] }
where
print_tycon_unqual (IfaceTc nm) = isLocalIfaceExtName nm
; mapM_ (\c -> loadImportedInsts c [])
(typeEnvClasses (eps_PTE eps))
; (pkg_ie, home_ie) <- tcGetInstEnvs -- Search all
- ; return [ (inst, getSrcLoc dfun)
+ ; return [ dfun
| (_, _, dfun) <- instEnvElts home_ie ++ instEnvElts pkg_ie
, relevant dfun
- , let inst = dfunToIfaceInst ext_nm dfun
- (cls, _) = ifaceInstGates (ifInstHead inst)
+ , let (cls, _) = ifaceInstGates (ifInstHead (dfunToIfaceInst ext_nm dfun))
, isLocalIfaceExtName cls ] }
where
relevant df = tc_name `elemNameSet` tyClsNamesOfDFunHead (idType df)