From 18766724e350e926e85d10002ebf2a70d375f440 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sat, 31 Jul 2010 11:55:06 +0000 Subject: [PATCH] Expose the functions haddock needs even when haddock is disabled; #3558 --- compiler/main/GHC.hs | 13 +++++++++++-- compiler/main/InteractiveEval.hs | 9 --------- compiler/typecheck/TcRnDriver.lhs | 24 +++++++++++++++--------- 3 files changed, 26 insertions(+), 20 deletions(-) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index ae2dedf..5dfa76c 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -111,13 +111,13 @@ module GHC ( showModule, isModuleInterpreted, InteractiveEval.compileExpr, HValue, dynCompileExpr, - lookupName, GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType, modInfoModBreaks, ModBreaks(..), BreakIndex, BreakInfo(breakInfo_number, breakInfo_module), BreakArray, setBreakOn, setBreakOff, getBreak, #endif + lookupName, -- * Abstract syntax elements @@ -243,9 +243,9 @@ import Linker ( HValue ) import ByteCodeInstr import BreakArray import InteractiveEval -import TcRnDriver #endif +import TcRnDriver import TcIface import TcRnTypes hiding (LIE) import TcRnMonad ( initIfaceCheck ) @@ -2723,3 +2723,12 @@ obtainTermFromId bound force id = liftIO $ InteractiveEval.obtainTermFromId hsc_env bound force id #endif + +-- | Returns the 'TyThing' for a 'Name'. The 'Name' may refer to any +-- entity known to GHC, including 'Name's defined using 'runStmt'. +lookupName :: GhcMonad m => Name -> m (Maybe TyThing) +lookupName name = withSession $ \hsc_env -> do + mb_tything <- ioMsg $ tcRnLookupName hsc_env name + return mb_tything + -- XXX: calls panic in some circumstances; is that ok? + diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index 9afd1ac..3f932dc 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -29,7 +29,6 @@ module InteractiveEval ( showModule, isModuleInterpreted, compileExpr, dynCompileExpr, - lookupName, Term(..), obtainTermFromId, obtainTermFromVal, reconstructType, skolemiseSubst, skolemiseTy #endif @@ -933,14 +932,6 @@ parseName str = withSession $ \hsc_env -> do (L _ rdr_name) <- hscParseIdentifier (hsc_dflags hsc_env) str ioMsgMaybe $ tcRnLookupRdrName hsc_env rdr_name --- | Returns the 'TyThing' for a 'Name'. The 'Name' may refer to any --- entity known to GHC, including 'Name's defined using 'runStmt'. -lookupName :: GhcMonad m => Name -> m (Maybe TyThing) -lookupName name = withSession $ \hsc_env -> do - mb_tything <- ioMsg $ tcRnLookupName hsc_env name - return mb_tything - -- XXX: calls panic in some circumstances; is that ok? - -- ----------------------------------------------------------------------------- -- Getting the type of an expression diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 8638d9f..c4b3517 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -9,10 +9,10 @@ module TcRnDriver ( #ifdef GHCI tcRnStmt, tcRnExpr, tcRnType, tcRnLookupRdrName, - tcRnLookupName, - tcRnGetInfo, getModuleExports, #endif + tcRnLookupName, + tcRnGetInfo, tcRnModule, tcTopSrcDecls, tcRnExtCore @@ -72,6 +72,7 @@ import Outputable import DataCon import Type import Class +import TcType import Data.List ( sortBy ) #ifdef GHCI @@ -84,7 +85,6 @@ import IfaceEnv import MkId import BasicTypes import TidyPgm ( globaliseAndTidyId ) -import TcType ( isUnitTy, isTauTy, tyClsNamesOfDFunHead ) import TysWiredIn ( unitTy, mkListTy ) #endif @@ -1018,7 +1018,6 @@ get two defns for 'main' in the interface file! %********************************************************* \begin{code} -#ifdef GHCI setInteractiveContext :: HscEnv -> InteractiveContext -> TcRn a -> TcRn a setInteractiveContext hsc_env icxt thing_inside = let -- Initialise the tcg_inst_env with instances from all home modules. @@ -1049,6 +1048,7 @@ setInteractiveContext hsc_env icxt thing_inside \begin{code} +#ifdef GHCI tcRnStmt :: HscEnv -> InteractiveContext -> LStmt RdrName @@ -1404,6 +1404,7 @@ lookup_rdr_name rdr_name = do { return good_names } +#endif tcRnLookupName :: HscEnv -> Name -> IO (Messages, Maybe TyThing) tcRnLookupName hsc_env name @@ -1424,8 +1425,8 @@ tcRnLookupName' name = do _ -> panic "tcRnLookupName'" tcRnGetInfo :: HscEnv - -> Name - -> IO (Messages, Maybe (TyThing, Fixity, [Instance])) + -> Name + -> IO (Messages, Maybe (TyThing, Fixity, [Instance])) -- Used to implement :info in GHCi -- @@ -1435,8 +1436,14 @@ tcRnGetInfo :: HscEnv -- *and* as a type or class constructor; -- hence the call to dataTcOccs, and we return up to two results tcRnGetInfo hsc_env name - = initTcPrintErrors hsc_env iNTERACTIVE $ - let ictxt = hsc_IC hsc_env in + = initTcPrintErrors hsc_env iNTERACTIVE $ + tcRnGetInfo' hsc_env name + +tcRnGetInfo' :: HscEnv + -> Name + -> TcRn (TyThing, Fixity, [Instance]) +tcRnGetInfo' hsc_env name + = let ictxt = hsc_IC hsc_env in setInteractiveContext hsc_env ictxt $ do -- Load the interface for all unqualified types and classes @@ -1485,7 +1492,6 @@ loadUnqualIfaces ictxt isTcOcc (nameOccName name), -- Types and classes only unQualOK gre ] -- In scope unqualified doc = ptext (sLit "Need interface for module whose export(s) are in scope unqualified") -#endif /* GHCI */ \end{code} %************************************************************************ -- 1.7.10.4