RunResult(..),
runStmt,
showModule,
+ isModuleInterpreted,
compileExpr, HValue, dynCompileExpr,
lookupName,
getBreakpointHandler, setBreakpointHandler,
- obtainTerm,
+ obtainTerm, obtainTerm1,
#endif
-- * Abstract syntax elements
instanceDFunId, pprInstance, pprInstanceHdr,
-- ** Types and Kinds
- Type, dropForAlls, splitForAllTys, funResultTy, pprParendType,
+ Type, dropForAlls, splitForAllTys, funResultTy,
+ pprParendType, pprTypeApp,
Kind,
PredType,
ThetaType, pprThetaArrow,
import HscMain ( hscParseIdentifier, hscStmt, hscTcExpr, hscKcType )
import Name ( nameOccName )
import Type ( tidyType )
+import Var ( varName )
import VarEnv ( emptyTidyEnv )
import GHC.Exts ( unsafeCoerce# )
import HsSyn
import Type ( Kind, Type, dropForAlls, PredType, ThetaType,
pprThetaArrow, pprParendType, splitForAllTys,
- funResultTy )
+ pprTypeApp, funResultTy )
import Id ( Id, idType, isImplicitId, isDeadBinder,
isExportedId, isLocalId, isGlobalId,
isRecordSelector, recordSelectorFieldLabel,
isPrimOpId, isFCallId, isClassOpId_maybe,
isDataConWorkId, idDataCon,
isBottomingId )
-import Var ( TyVar, varName )
+import Var ( TyVar )
import TysPrim ( alphaTyVars )
import TyCon ( TyCon, isClassTyCon, isSynTyCon, isNewTyCon,
isPrimTyCon, isFunTyCon, isOpenTyCon, tyConArity,
cleanTempDirs )
import Module
import UniqFM
-import PackageConfig ( PackageId, stringToPackageId )
+import PackageConfig ( PackageId, stringToPackageId, mainPackageId )
import FiniteMap
import Panic
import Digraph
import System.Time ( ClockTime )
import Control.Exception as Exception hiding (handle)
import Data.IORef
-import Data.Traversable ( traverse )
import System.IO
import System.IO.Error ( isDoesNotExistError )
import Prelude hiding (init)
defaultCleanupHandler :: DynFlags -> IO a -> IO a
defaultCleanupHandler dflags inner =
-- make sure we clean up after ourselves
- later (unless (dopt Opt_KeepTmpFiles dflags) $
- do cleanTempFiles dflags
- cleanTempDirs dflags
+ later (do cleanTempFiles dflags
+ cleanTempDirs dflags
)
-- exceptions will be blocked while we clean the temporary files,
-- so there shouldn't be any difficulty if we receive further
case lookupUFM hpt mod_name of
Just mod_info -> return (mi_module (hm_iface mod_info))
_not_a_home_module -> do
- res <- findImportedModule hsc_env mod_name Nothing
+ res <- findImportedModule hsc_env mod_name maybe_pkg
case res of
Found _ m | modulePackageId m /= this_pkg -> return m
| otherwise -> throwDyn (CmdLineError (showSDoc $
foreign import "rts_evalStableIO" {- safe -}
rts_evalStableIO :: StablePtr (IO a) -> Ptr (StablePtr a) -> IO CInt
-- more informative than the C type!
+
+XXX the type of rts_evalStableIO no longer matches the above
+
-}
+
-----------------------------------------------------------------------------
-- show a module and it's source/object filenames
showModule :: Session -> ModSummary -> IO String
-showModule s mod_summary = withSession s $ \hsc_env -> do
+showModule s mod_summary = withSession s $ \hsc_env ->
+ isModuleInterpreted s mod_summary >>= \interpreted ->
+ return (showModMsg (hscTarget(hsc_dflags hsc_env)) interpreted mod_summary)
+
+isModuleInterpreted :: Session -> ModSummary -> IO Bool
+isModuleInterpreted s mod_summary = withSession s $ \hsc_env ->
case lookupUFM (hsc_HPT hsc_env) (ms_mod_name mod_summary) of
Nothing -> panic "missing linkable"
- Just mod_info -> return (showModMsg (hscTarget (hsc_dflags hsc_env)) (not obj_linkable) mod_summary)
+ Just mod_info -> return (not obj_linkable)
where
obj_linkable = isObjectLinkable (expectJust "showModule" (hm_linkable mod_info))
+-----------------------------------------------------------------------------
+-- Breakpoint handlers
+
getBreakpointHandler :: Session -> IO (Maybe (BkptHandler Module))
getBreakpointHandler session = getSessionDynFlags session >>= return . bkptHandler
initDynLinker dflags
extendLinkEnv linkEnv
-type SiteInfo = (String, String, SiteNumber)
-jumpFunction, jumpAutoFunction :: Session -> BkptHandler Module -> Int -> [Opaque]
- -> SiteInfo -> String -> b -> b
-jumpCondFunction :: Session -> BkptHandler Module -> Int -> [Opaque]
- -> SiteInfo -> String -> Bool -> b -> b
-jumpFunctionM :: Session -> BkptHandler a -> Int -> [Opaque] -> BkptLocation a
- -> String -> b -> IO b
+-----------------------------------------------------------------------
+-- Jump functions
-jumpCondFunction _ _ _ _ _ _ False b = b
-jumpCondFunction session handler ptr hValues siteInfo locmsg True b
- = jumpFunction session handler ptr hValues siteInfo locmsg b
+type SiteInfo = (String, SiteNumber)
+jumpFunction, jumpAutoFunction :: Session -> BkptHandler Module -> SiteInfo -> (Int, [Opaque], String) -> b -> b
+jumpCondFunction :: Session -> BkptHandler Module -> SiteInfo -> (Int, [Opaque], String) -> Bool -> b -> b
+jumpFunctionM :: Session -> BkptHandler a -> BkptLocation a -> (Int, [Opaque], String) -> b -> IO b
-jumpFunction session handler ptr hValues siteInfo locmsg b
+jumpCondFunction _ _ _ _ False b = b
+jumpCondFunction session handler site args True b
+ = jumpFunction session handler site args b
+
+jumpFunction session handler siteInfo args b
| site <- mkSite siteInfo
- = unsafePerformIO $ jumpFunctionM session handler ptr hValues site locmsg b
+ = unsafePerformIO $ jumpFunctionM session handler site args b
-jumpFunctionM session handler (I# idsPtr) wrapped_hValues site locmsg b =
+jumpFunctionM session handler site (I# idsPtr, wrapped_hValues, locmsg) b =
do
ids <- deRefStablePtr (castPtrToStablePtr (Ptr (int2Addr# idsPtr)))
- ASSERT (length ids == length wrapped_hValues) return ()
- let hValues = [unsafeCoerce# hv | O hv <- wrapped_hValues]
+ let hValues = unsafeCoerce# b : [unsafeCoerce# hv | O hv <- wrapped_hValues]
handleBreakpoint handler session (zip ids hValues) site locmsg b
-jumpAutoFunction session handler ptr hValues siteInfo locmsg b
+jumpAutoFunction session handler siteInfo args b
| site <- mkSite siteInfo
= unsafePerformIO $ do
break <- isAutoBkptEnabled handler session site
if break
- then jumpFunctionM session handler ptr hValues site locmsg b
+ then jumpFunctionM session handler site args b
else return b
-jumpStepByStepFunction session handler ptr hValues siteInfo locmsg b
+jumpStepByStepFunction session handler siteInfo args b
| site <- mkSite siteInfo
= unsafePerformIO $ do
- jumpFunctionM session handler ptr hValues site locmsg b
+ jumpFunctionM session handler site args b
mkSite :: SiteInfo -> BkptLocation Module
-mkSite (pkgName, modName, sitenum) =
- (mkModule (stringToPackageId pkgName) (mkModuleName modName), sitenum)
+mkSite ( modName, sitenum) =
+ (mkModule mainPackageId (mkModuleName modName), sitenum)
+
+obtainTerm1 :: Session -> Bool -> Maybe Type -> a -> IO Term
+obtainTerm1 sess force mb_ty x = withSession sess $ \hsc_env -> cvObtainTerm hsc_env force mb_ty (unsafeCoerce# x)
obtainTerm :: Session -> Bool -> Id -> IO (Maybe Term)
obtainTerm sess force id = withSession sess $ \hsc_env -> do
projects / ghc-hetmet.git / blobdiff