mkExportEnv, getModuleContents, tcRnStmt,
tcRnGetInfo, GetInfoResult,
tcRnExpr, tcRnType,
+ tcRnLookupRdrName,
#endif
tcRnModule,
tcTopSrcDecls,
import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
#endif
-import CmdLineOpts ( DynFlag(..), opt_PprStyle_Debug, dopt )
+import DynFlags ( DynFlag(..), DynFlags(..), dopt, GhcMode(..) )
+import StaticFlags ( opt_PprStyle_Debug )
import Packages ( moduleToPackageConfig, mkPackageId, package,
isHomeModule )
-import DriverState ( v_MainModIs, v_MainFunIs )
-import HsSyn ( HsModule(..), HsExtCore(..), HsGroup(..), LHsDecl, SpliceDecl(..), HsBind(..),
+import HsSyn ( HsModule(..), HsExtCore(..), HsGroup(..), LHsDecl,
+ SpliceDecl(..), HsBind(..),
+ emptyGroup, appendGroups,
nlHsApp, nlHsVar, pprLHsBinds )
import RdrHsSyn ( findSplice )
import InstEnv ( extendInstEnvList )
import TcBinds ( tcTopBinds, tcHsBootSigs )
import TcDefaults ( tcDefaults )
-import TcEnv ( tcExtendGlobalValEnv )
+import TcEnv ( tcExtendGlobalValEnv, iDFunId )
import TcRules ( tcRules )
import TcForeign ( tcForeignImports, tcForeignExports )
import TcInstDcls ( tcInstDecls1, tcInstDecls2 )
-import TcIface ( tcExtCoreBindings )
+import TcIface ( tcExtCoreBindings, tcHiBootIface )
import TcSimplify ( tcSimplifyTop )
import TcTyClsDecls ( tcTyAndClassDecls )
-import LoadIface ( loadOrphanModules, loadHiBootInterface )
+import LoadIface ( loadOrphanModules )
import RnNames ( importsFromLocalDecls, rnImports, exportsFromAvail,
reportUnusedNames, reportDeprecations )
import RnEnv ( lookupSrcOcc_maybe )
import ErrUtils ( Messages, mkDumpDoc, showPass )
import Id ( mkExportedLocalId, isLocalId, idName, idType )
import Var ( Var )
-import VarEnv ( varEnvElts )
import Module ( Module, ModuleEnv, mkModule, moduleEnvElts, lookupModuleEnv )
import OccName ( mkVarOcc )
-import Name ( Name, isExternalName, getSrcLoc, getOccName, isWiredInName )
+import Name ( Name, NamedThing(..), isExternalName, getSrcLoc,
+ getOccName, isWiredInName )
import NameSet
import TyCon ( tyConHasGenerics, isSynTyCon, getSynTyConDefn, tyConKind )
import SrcLoc ( srcLocSpan, Located(..), noLoc )
import DriverPhases ( HscSource(..), isHsBoot )
-import HscTypes ( ModGuts(..), HscEnv(..), ExternalPackageState(..),
- GhciMode(..), IsBootInterface, noDependencies,
+import HscTypes ( ModGuts(..), ModDetails(..), emptyModDetails,
+ HscEnv(..), ExternalPackageState(..),
+ IsBootInterface, noDependencies,
Deprecs( NoDeprecs ), plusDeprecs,
ForeignStubs(NoStubs), TyThing(..),
- TypeEnv, lookupTypeEnv, hptInstances, lookupType,
- extendTypeEnvWithIds, typeEnvIds, typeEnvTyCons,
+ TypeEnv, lookupTypeEnv, hptInstances,
+ extendTypeEnvWithIds, typeEnvIds, typeEnvTyCons, typeEnvElts,
emptyFixityEnv
)
import Outputable
#ifdef GHCI
import HsSyn ( HsStmtContext(..), Stmt(..), HsExpr(..), HsBindGroup(..),
LStmt, LHsExpr, LHsType, mkMatchGroup,
- collectStmtsBinders, mkSimpleMatch,
- nlLetStmt, nlExprStmt, nlBindStmt, nlResultStmt, nlVarPat )
+ collectLStmtsBinders, mkSimpleMatch, nlVarPat,
+ placeHolderType, noSyntaxExpr )
import RdrName ( GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..),
Provenance(..), ImportSpec(..),
lookupLocalRdrEnv, extendLocalRdrEnv )
import RnSource ( addTcgDUs )
import TcHsSyn ( mkHsLet, zonkTopLExpr, zonkTopBndrs )
import TcHsType ( kcHsType )
-import TcExpr ( tcCheckRho )
import TcIface ( loadImportedInsts )
import TcMType ( zonkTcType, zonkQuantifiedTyVar )
-import TcUnify ( unifyTyConApp )
-import TcMatches ( tcStmtsAndThen, TcStmtCtxt(..) )
+import TcMatches ( tcStmts, tcDoStmt )
import TcSimplify ( tcSimplifyInteractive, tcSimplifyInfer )
import TcType ( Type, mkForAllTys, mkFunTys, mkTyConApp, tyVarsOfType,
isUnLiftedType, tyClsNamesOfDFunHead )
import TcEnv ( tcLookupTyCon, tcLookupId, tcLookupGlobal )
import RnTypes ( rnLHsType )
-import Inst ( tcStdSyntaxName, tcGetInstEnvs )
+import Inst ( tcGetInstEnvs )
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(..), IfaceType, toIfaceType,
interactiveExtNameFun, isLocalIfaceExtName )
-import IfaceEnv ( lookupOrig )
+import IfaceEnv ( lookupOrig, ifaceExportNames )
import RnEnv ( lookupOccRn, dataTcOccs, lookupFixityRn )
import Id ( Id, isImplicitId, setIdType, globalIdDetails )
import MkId ( unsafeCoerceId )
import Name ( nameOccName )
import OccName ( occNameUserString )
import NameEnv ( delListFromNameEnv )
-import PrelNames ( iNTERACTIVE, ioTyConName, printName, monadNames, itName, returnIOName )
+import PrelNames ( iNTERACTIVE, ioTyConName, printName, itName,
+ bindIOName, thenIOName, returnIOName )
import HscTypes ( InteractiveContext(..), HomeModInfo(..), typeEnvElts, typeEnvClasses,
availNames, availName, ModIface(..), icPrintUnqual,
ModDetails(..), Dependencies(..) )
\begin{code}
tcRnModule :: HscEnv
-> HscSource
+ -> Bool -- True <=> save renamed syntax
-> Located (HsModule RdrName)
-> IO (Messages, Maybe TcGblEnv)
-tcRnModule hsc_env hsc_src (L loc (HsModule maybe_mod export_ies
- import_decls local_decls mod_deprec))
+tcRnModule hsc_env hsc_src save_rn_decls
+ (L loc (HsModule maybe_mod export_ies
+ import_decls local_decls mod_deprec))
= do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
let { this_mod = case maybe_mod of
updGblEnv ( \ gbl ->
gbl { tcg_rdr_env = rdr_env,
tcg_inst_env = extendInstEnvList (tcg_inst_env gbl) home_insts,
- tcg_imports = tcg_imports gbl `plusImportAvails` imports })
+ tcg_imports = tcg_imports gbl `plusImportAvails` imports,
+ tcg_rn_decls = if save_rn_decls then
+ Just emptyGroup
+ else
+ Nothing })
$ do {
traceRn (text "rn1" <+> ppr (imp_dep_mods imports)) ;
-- Typecheck them all together so that
-- any mutually recursive types are done right
- tcg_env <- checkNoErrs (tcTyAndClassDecls [{- no boot names -}] rn_decls) ;
+ tcg_env <- checkNoErrs (tcTyAndClassDecls emptyModDetails rn_decls) ;
-- Make the new type env available to stuff slurped from interface files
setGblEnv tcg_env $ do {
-- We do this now so that the boot_names can be passed
-- to tcTyAndClassDecls, because the boot_names are
-- automatically considered to be loop breakers
- boot_names <- loadHiBootInterface ;
+ mod <- getModule ;
+ boot_iface <- tcHiBootIface mod ;
-- Do all the declarations
- (tc_envs, lie) <- getLIE (tc_rn_src_decls boot_names decls) ;
+ (tc_envs, lie) <- getLIE (tc_rn_src_decls boot_iface decls) ;
-- tcSimplifyTop deals with constant or ambiguous InstIds.
-- How could there be ambiguous ones? They can only arise if a
(bind_ids, binds', fords', rules') <- zonkTopDecls (binds `unionBags` inst_binds)
rules fords ;
- let { final_type_env = extendTypeEnvWithIds type_env bind_ids } ;
+ let { final_type_env = extendTypeEnvWithIds type_env bind_ids
+ ; tcg_env' = tcg_env { tcg_type_env = final_type_env,
+ tcg_binds = binds', tcg_rules = rules',
+ tcg_fords = fords' } } ;
- -- Compre the hi-boot iface (if any) with the real thing
- checkHiBootIface final_type_env boot_names ;
+ -- Compare the hi-boot iface (if any) with the real thing
+ checkHiBootIface tcg_env' boot_iface ;
-- Make the new type env available to stuff slurped from interface files
writeMutVar (tcg_type_env_var tcg_env) final_type_env ;
- return (tcg_env { tcg_type_env = final_type_env,
- tcg_binds = binds', tcg_rules = rules', tcg_fords = fords' })
+ return tcg_env'
}
-tc_rn_src_decls :: [Name] -> [LHsDecl RdrName] -> TcM (TcGblEnv, TcLclEnv)
+tc_rn_src_decls :: ModDetails -> [LHsDecl RdrName] -> TcM (TcGblEnv, TcLclEnv)
-- Loops around dealing with each top level inter-splice group
-- in turn, until it's dealt with the entire module
-tc_rn_src_decls boot_names ds
+tc_rn_src_decls boot_details ds
= do { let { (first_group, group_tail) = findSplice ds } ;
-- If ds is [] we get ([], Nothing)
-- Type check the decls up to, but not including, the first splice
- tc_envs@(tcg_env,tcl_env) <- tcRnGroup boot_names first_group ;
+ tc_envs@(tcg_env,tcl_env) <- tcRnGroup boot_details first_group ;
-- Bale out if errors; for example, error recovery when checking
-- the RHS of 'main' can mean that 'main' is not in the envt for
-- Glue them on the front of the remaining decls and loop
setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $
- tc_rn_src_decls boot_names (spliced_decls ++ rest_ds)
+ tc_rn_src_decls boot_details (spliced_decls ++ rest_ds)
#endif /* GHCI */
}}}
\end{code}
-- Typecheck type/class decls
; traceTc (text "Tc2")
; let tycl_decls = hs_tyclds rn_group
- ; tcg_env <- checkNoErrs (tcTyAndClassDecls [{- no boot_names -}] tycl_decls)
+ ; tcg_env <- checkNoErrs (tcTyAndClassDecls emptyModDetails tycl_decls)
; setGblEnv tcg_env $ do {
-- Typecheck instance decls
-- Typecheck value declarations
; traceTc (text "Tc5")
- ; new_ids <- tcHsBootSigs (hs_valds rn_group)
+ ; val_ids <- tcHsBootSigs (hs_valds rn_group)
-- Wrap up
-- No simplification or zonking to do
; traceTc (text "Tc7a")
; gbl_env <- getGblEnv
- ; let { final_type_env = extendTypeEnvWithIds (tcg_type_env gbl_env) new_ids }
- ; return (gbl_env { tcg_type_env = final_type_env })
+ -- Make the final type-env
+ -- Include the dfun_ids so that their type sigs get
+ -- are written into the interface file
+ ; let { type_env0 = tcg_type_env gbl_env
+ ; type_env1 = extendTypeEnvWithIds type_env0 val_ids
+ ; type_env2 = extendTypeEnvWithIds type_env1 dfun_ids
+ ; dfun_ids = map iDFunId inst_infos }
+ ; return (gbl_env { tcg_type_env = type_env2 })
}}}}
spliceInHsBootErr (SpliceDecl (L loc _), _)
the hi-boot interface as our checklist.
\begin{code}
-checkHiBootIface :: TypeEnv -> [Name] -> TcM ()
+checkHiBootIface :: TcGblEnv -> ModDetails -> TcM ()
-- Compare the hi-boot file for this module (if there is one)
-- with the type environment we've just come up with
-- In the common case where there is no hi-boot file, the list
-- of boot_names is empty.
-checkHiBootIface env boot_names
- = mapM_ (check_one env) boot_names
-
-----------------
-check_one local_env name
- | isWiredInName name -- No checking for wired-in names. In particular, 'error'
- = return () -- is handled by a rather gross hack (see comments in GHC.Err.hs-boot)
- | otherwise
- = do { (eps,hpt) <- getEpsAndHpt
-
- -- Look up the hi-boot one;
- -- it should jolly well be there (else GHC bug)
- ; case lookupType hpt (eps_PTE eps) name of {
- Nothing -> pprPanic "checkHiBootIface" (ppr name) ;
- Just boot_thing ->
-
- -- Look it up in the local type env
- -- It should be there, but it's a programmer error if not
- case lookupTypeEnv local_env name of
- Nothing -> addErrTc (missingBootThing boot_thing)
- Just real_thing -> check_thing boot_thing real_thing
- } }
+checkHiBootIface
+ (TcGblEnv { tcg_insts = local_insts, tcg_type_env = local_type_env })
+ (ModDetails { md_insts = boot_insts, md_types = boot_type_env })
+ = do { mapM_ check_inst boot_insts
+ ; mapM_ check_one (typeEnvElts boot_type_env) }
+ where
+ check_one boot_thing
+ | no_check name
+ = return ()
+ | otherwise
+ = case lookupTypeEnv local_type_env name of
+ Nothing -> addErrTc (missingBootThing boot_thing)
+ Just real_thing -> check_thing boot_thing real_thing
+ where
+ name = getName boot_thing
+
+ no_check name = isWiredInName name -- No checking for wired-in names. In particular,
+ -- 'error' is handled by a rather gross hack
+ -- (see comments in GHC.Err.hs-boot)
+ || name `elem` dfun_names
+ dfun_names = map getName boot_insts
+
+ check_inst inst
+ | null [i | i <- local_insts, idType i `tcEqType` idType inst]
+ = addErrTc (instMisMatch inst)
+ | otherwise
+ = return ()
----------------
check_thing (ATyCon boot_tc) (ATyCon real_tc)
= ppr thing <+> ptext SLIT("is defined in the hs-boot file, but not in the module")
bootMisMatch thing
= ppr thing <+> ptext SLIT("has conflicting definitions in the module and its hs-boot file")
+instMisMatch inst
+ = hang (ptext SLIT("instance") <+> ppr (idType inst))
+ 2 (ptext SLIT("is defined in the hs-boot file, but not in the module"))
\end{code}
monad; it augments it and returns the new TcGblEnv.
\begin{code}
-tcRnGroup :: [Name] -> HsGroup RdrName -> TcM (TcGblEnv, TcLclEnv)
+tcRnGroup :: ModDetails -> HsGroup RdrName -> TcM (TcGblEnv, TcLclEnv)
-- Returns the variables free in the decls, for unused-binding reporting
-tcRnGroup boot_names decls
+tcRnGroup boot_details decls
= do { -- Rename the declarations
(tcg_env, rn_decls) <- rnTopSrcDecls decls ;
setGblEnv tcg_env $ do {
-- Typecheck the declarations
- tcTopSrcDecls boot_names rn_decls
+ tcTopSrcDecls boot_details rn_decls
}}
------------------------------------------------
(tcg_env, rn_decls) <- rnSrcDecls group ;
failIfErrsM ;
+ -- save the renamed syntax, if we want it
+ let { tcg_env'
+ | Just grp <- tcg_rn_decls tcg_env
+ = tcg_env{ tcg_rn_decls = Just (appendGroups grp rn_decls) }
+ | otherwise
+ = tcg_env };
+
-- Dump trace of renaming part
rnDump (ppr rn_decls) ;
- return (tcg_env, rn_decls)
+ return (tcg_env', rn_decls)
}}
------------------------------------------------
-tcTopSrcDecls :: [Name] -> HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
-tcTopSrcDecls boot_names
+tcTopSrcDecls :: ModDetails -> HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
+tcTopSrcDecls boot_details
(HsGroup { hs_tyclds = tycl_decls,
hs_instds = inst_decls,
hs_fords = foreign_decls,
-- The latter come in via tycl_decls
traceTc (text "Tc2") ;
- tcg_env <- checkNoErrs (tcTyAndClassDecls boot_names tycl_decls) ;
+ tcg_env <- checkNoErrs (tcTyAndClassDecls boot_details tycl_decls) ;
-- tcTyAndClassDecls recovers internally, but if anything gave rise to
-- an error we'd better stop now, to avoid a cascade
checkMain
= do { ghci_mode <- getGhciMode ;
tcg_env <- getGblEnv ;
-
- mb_main_mod <- readMutVar v_MainModIs ;
- mb_main_fn <- readMutVar v_MainFunIs ;
- let { main_mod = case mb_main_mod of {
+ dflags <- getDOpts ;
+ let { main_mod = case mainModIs dflags of {
Just mod -> mkModule mod ;
Nothing -> mAIN } ;
- main_fn = case mb_main_fn of {
+ main_fn = case mainFunIs dflags of {
Just fn -> mkRdrUnqual (mkVarOcc (mkFastString fn)) ;
Nothing -> main_RDR_Unqual } } ;
<+> ptext SLIT("is not defined in module") <+> quotes (ppr main_mod)
\end{code}
-
%*********************************************************
%* *
GHCi stuff
setInteractiveContext hsc_env ictxt $ do {
-- Rename; use CmdLineMode because tcRnStmt is only used interactively
- ([rn_stmt], fvs) <- rnStmts DoExpr [rdr_stmt] ;
+ (([rn_stmt], _), fvs) <- rnStmts DoExpr [rdr_stmt] (return ((), emptyFVs)) ;
traceRn (text "tcRnStmt" <+> vcat [ppr rdr_stmt, ppr rn_stmt, ppr fvs]) ;
failIfErrsM ;
\begin{code}
---------------------------
tcUserStmt :: LStmt Name -> TcM ([Id], LHsExpr Id)
-tcUserStmt (L _ (ExprStmt expr _))
+tcUserStmt (L loc (ExprStmt expr _ _))
= newUnique `thenM` \ uniq ->
let
fresh_it = itName uniq
in
tryTcLIE_ (do { -- Try this if the other fails
traceTc (text "tcs 1b") ;
- tc_stmts [
- nlLetStmt [HsBindGroup (unitBag the_bind) [] NonRecursive],
- nlExprStmt (nlHsApp (nlHsVar printName)
- (nlHsVar fresh_it))
- ] })
+ tc_stmts (map (L loc) [
+ LetStmt [HsBindGroup (unitBag the_bind) [] NonRecursive],
+ ExprStmt (nlHsApp (nlHsVar printName) (nlHsVar fresh_it))
+ (HsVar thenIOName) placeHolderType
+ ]) })
(do { -- Try this first
traceTc (text "tcs 1a") ;
- tc_stmts [nlBindStmt (nlVarPat fresh_it) expr] })
+ tc_stmts [L loc (BindStmt (nlVarPat fresh_it) expr
+ (HsVar bindIOName) noSyntaxExpr) ] })
tcUserStmt stmt = tc_stmts [stmt]
---------------------------
+tc_stmts :: [LStmt Name] -> TcM ([Id], LHsExpr Id)
tc_stmts stmts
= do { ioTyCon <- tcLookupTyCon ioTyConName ;
let {
ret_ty = mkListTy unitTy ;
io_ret_ty = mkTyConApp ioTyCon [ret_ty] ;
- names = map unLoc (collectStmtsBinders stmts) ;
-
- stmt_ctxt = SC { sc_what = DoExpr,
- sc_rhs = infer_rhs,
- sc_body = check_body,
- sc_ty = ret_ty } ;
-
- infer_rhs rhs = do { (rhs', rhs_ty) <- tcInferRho rhs
- ; [pat_ty] <- unifyTyConApp ioTyCon rhs_ty
- ; return (rhs', pat_ty) } ;
- check_body body = tcCheckRho body io_ret_ty ;
+ names = map unLoc (collectLStmtsBinders stmts) ;
-- mk_return builds the expression
-- returnIO @ [()] [coerce () x, .., coerce () z]
-- OK, we're ready to typecheck the stmts
traceTc (text "tcs 2") ;
((ids, tc_expr), lie) <- getLIE $ do {
- (ids, tc_stmts) <- tcStmtsAndThen combine stmt_ctxt stmts $
- do {
- -- Look up the names right in the middle,
- -- where they will all be in scope
- ids <- mappM tcLookupId names ;
- ret_id <- tcLookupId returnIOName ; -- return @ IO
- return (ids, [nlResultStmt (mk_return ret_id ids)]) } ;
-
- io_ids <- mappM (tcStdSyntaxName DoOrigin io_ty) monadNames ;
- return (ids, noLoc (HsDo DoExpr tc_stmts io_ids io_ret_ty))
+ (tc_stmts, ids) <- tcStmts DoExpr (tcDoStmt io_ty io_ret_ty) stmts $
+ do {
+ -- Look up the names right in the middle,
+ -- where they will all be in scope
+ ids <- mappM tcLookupId names ;
+ return ids } ;
+
+ ret_id <- tcLookupId returnIOName ; -- return @ IO
+ return (ids, noLoc (HsDo DoExpr tc_stmts (mk_return ret_id ids) io_ret_ty))
} ;
-- Simplify the context right here, so that we fail
return (zonked_ids, zonked_expr)
}
where
- combine stmt (ids, stmts) = (ids, stmt:stmts)
bad_unboxed id = addErr (sep [ptext SLIT("GHCi can't bind a variable of unlifted type:"),
nest 2 (ppr id <+> dcolon <+> ppr (idType id))])
\end{code}
; loadOrphanModules (dep_orphs (mi_deps iface))
-- Load any orphan-module interfaces,
-- so their instances are visible
- ; names <- exportsToAvails (mi_exports iface)
+ ; names <- ifaceExportNames (mi_exports iface)
; let { gres = [ GRE { gre_name = name, gre_prov = vanillaProv mod }
| name <- nameSetToList names ] }
; returnM (mkGlobalRdrEnv gres) }
\begin{code}
getModuleContents
:: HscEnv
- -> InteractiveContext
-> Module -- Module to inspect
-> Bool -- Grab just the exports, or the whole toplev
-> IO (Maybe [IfaceDecl])
-getModuleContents hsc_env ictxt mod exports_only
+getModuleContents hsc_env mod exports_only
= initTcPrintErrors hsc_env iNTERACTIVE (get_mod_contents exports_only)
where
get_mod_contents exports_only
; thing <- tcLookupGlobal main_name
; return (filter_decl (availNames avail) (toIfaceDecl ext_nm thing)) }
- ext_nm = interactiveExtNameFun (icPrintUnqual ictxt)
+ ext_nm = interactiveExtNameFun (icPrintUnqual (hsc_IC hsc_env))
---------------------
filter_decl occs decl@(IfaceClass {ifSigs = sigs})
[(IfaceType,SrcLoc)] -- Instances
)
-tcRnGetInfo :: HscEnv
- -> InteractiveContext
- -> RdrName
- -> IO (Maybe [GetInfoResult])
+tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Maybe [Name])
--- Used to implemnent :info in GHCi
---
--- Look up a RdrName and return all the TyThings it might be
--- A capitalised RdrName is given to us in the DataName namespace,
--- but we want to treat it as *both* a data constructor
--- *and* as a type or class constructor;
--- hence the call to dataTcOccs, and we return up to two results
-tcRnGetInfo hsc_env ictxt rdr_name
+tcRnLookupRdrName hsc_env rdr_name
= initTcPrintErrors hsc_env iNTERACTIVE $
- setInteractiveContext hsc_env ictxt $ do {
+ setInteractiveContext hsc_env (hsc_IC hsc_env) $
+ lookup_rdr_name rdr_name
+
+lookup_rdr_name rdr_name = do {
-- If the identifier is a constructor (begins with an
-- upper-case letter), then we need to consider both
-- constructor and type class identifiers.
do { addMessages (head errs_s) ; failM }
else -- Add deprecation warnings
mapM_ addMessages warns_s ;
-
+
+ return good_names
+ }
+
+
+tcRnGetInfo :: HscEnv
+ -> InteractiveContext
+ -> RdrName
+ -> IO (Maybe [GetInfoResult])
+
+-- Used to implemnent :info in GHCi
+--
+-- Look up a RdrName and return all the TyThings it might be
+-- A capitalised RdrName is given to us in the DataName namespace,
+-- but we want to treat it as *both* a data constructor
+-- *and* as a type or class constructor;
+-- hence the call to dataTcOccs, and we return up to two results
+tcRnGetInfo hsc_env ictxt rdr_name
+ = initTcPrintErrors hsc_env iNTERACTIVE $
+ setInteractiveContext hsc_env ictxt $ do {
+
+ good_names <- lookup_rdr_name rdr_name ;
+
-- And lookup up the entities, avoiding duplicates, which arise
-- because constructors and record selectors are represented by
-- their parent declaration
projects / ghc-hetmet.git / blobdiff