Commit 0753cf09 authored by pcapriotti's avatar pcapriotti

New version of the patch for #5461.

parent 550f8b5d
......@@ -80,8 +80,6 @@ module DynFlags (
setPackageName,
doingTickyProfiling,
setInteractivePrintName, -- Name -> DynFlags -> DynFlags
-- ** Parsing DynFlags
parseDynamicFlagsCmdLine,
parseDynamicFilePragma,
......@@ -111,7 +109,6 @@ module DynFlags (
#include "HsVersions.h"
import Platform
import Name
import Module
import PackageConfig
import PrelNames ( mAIN )
......@@ -629,10 +626,9 @@ data DynFlags = DynFlags {
-- | what kind of {-# SCC #-} to add automatically
profAuto :: ProfAuto,
llvmVersion :: IORef (Int),
interactivePrint :: Maybe String,
interactivePrintName :: Maybe Name
llvmVersion :: IORef (Int)
}
class HasDynFlags m where
......@@ -990,8 +986,7 @@ defaultDynFlags mySettings =
traceLevel = 1,
profAuto = NoProfAuto,
llvmVersion = panic "defaultDynFlags: No llvmVersion",
interactivePrint = Nothing,
interactivePrintName = Nothing
interactivePrint = Nothing
}
-- Do not use tracingDynFlags!
......@@ -1330,9 +1325,6 @@ addGhciScript f d = d{ ghciScripts = f : ghciScripts d}
setInteractivePrint f d = d{ interactivePrint = Just f}
setInteractivePrintName :: Name -> DynFlags -> DynFlags
setInteractivePrintName f d = d{ interactivePrintName = Just f}
-- -----------------------------------------------------------------------------
-- Command-line options
......
......@@ -44,6 +44,7 @@ module HscTypes (
InteractiveContext(..), emptyInteractiveContext,
icPrintUnqual, icInScopeTTs, icPlusGblRdrEnv,
extendInteractiveContext, substInteractiveContext,
setInteractivePrintName,
InteractiveImport(..),
mkPrintUnqualified, pprModulePrefix,
......@@ -136,7 +137,7 @@ import Annotations
import Class
import TyCon
import DataCon
import PrelNames ( gHC_PRIM, ioTyConName )
import PrelNames ( gHC_PRIM, ioTyConName, printName )
import Packages hiding ( Version(..) )
import DynFlags
import DriverPhases
......@@ -943,6 +944,10 @@ data InteractiveContext
ic_fix_env :: FixityEnv,
-- ^ Fixities declared in let statements
ic_int_print :: Name,
-- ^ The function that is used for printing results
-- of expressions in ghci and -e mode.
#ifdef GHCI
ic_resume :: [Resume],
......@@ -986,6 +991,8 @@ emptyInteractiveContext dflags
ic_sys_vars = [],
ic_instances = ([],[]),
ic_fix_env = emptyNameEnv,
-- System.IO.print by default
ic_int_print = printName,
#ifdef GHCI
ic_resume = [],
#endif
......@@ -1020,6 +1027,9 @@ extendInteractiveContext ictxt new_tythings
new_names = [ nameOccName (getName id) | AnId id <- new_tythings ]
setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext
setInteractivePrintName ic n = ic{ic_int_print = n}
-- ToDo: should not add Ids to the gbl env here
-- | Add TyThings to the GlobalRdrEnv, earlier ones in the list shadowing
......@@ -1090,7 +1100,7 @@ exposed (say P2), so we use M.T for that, and P1:M.T for the other one.
This is handled by the qual_mod component of PrintUnqualified, inside
the (ppr mod) of case (3), in Name.pprModulePrefix
\begin{code}
\begin{code}
-- | Creates some functions that work out the best ways to format
-- names for the user according to a set of heuristics
mkPrintUnqualified :: DynFlags -> GlobalRdrEnv -> PrintUnqualified
......
......@@ -1325,9 +1325,9 @@ tcUserStmt :: LStmt RdrName -> TcM (PlanResult, FixityEnv)
tcUserStmt (L loc (ExprStmt expr _ _ _))
= do { (rn_expr, fvs) <- checkNoErrs (rnLExpr expr)
-- Don't try to typecheck if the renamer fails!
; dynFlags <- getDynFlags
; ghciStep <- getGhciStepIO
; uniq <- newUnique
; interPrintName <- getInteractivePrintName
; let fresh_it = itName uniq loc
matches = [mkMatch [] rn_expr emptyLocalBinds]
-- [it = expr]
......@@ -1346,7 +1346,6 @@ tcUserStmt (L loc (ExprStmt expr _ _ _))
(HsVar bindIOName) noSyntaxExpr
-- [; print it]
interPrintName = maybe printName id (interactivePrintName dynFlags)
print_it = L loc $ ExprStmt (nlHsApp (nlHsVar interPrintName) (nlHsVar fresh_it))
(HsVar thenIOName) noSyntaxExpr placeHolderType
......
......@@ -493,6 +493,9 @@ getIsGHCi = do { mod <- getModule; return (mod == iNTERACTIVE) }
getGHCiMonad :: TcRn Name
getGHCiMonad = do { hsc <- getTopEnv; return (ic_monad $ hsc_IC hsc) }
getInteractivePrintName :: TcRn Name
getInteractivePrintName = do { hsc <- getTopEnv; return (ic_int_print $ hsc_IC hsc) }
tcIsHsBoot :: TcRn Bool
tcIsHsBoot = do { env <- getGblEnv; return (isHsBoot (tcg_src env)) }
......
......@@ -21,12 +21,14 @@ import Debugger
-- The GHC interface
import DynFlags
import GhcMonad ( modifySession )
import qualified GHC
import GHC ( LoadHowMuch(..), Target(..), TargetId(..), InteractiveImport(..),
TyThing(..), Phase, BreakIndex, Resume, SingleStep, Ghc,
handleSourceError )
import HsImpExp
import HscTypes ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, dep_pkgs )
import HscTypes ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, dep_pkgs, hsc_IC,
setInteractivePrintName )
import Module
import Name
import Packages ( trusted, getPackageDetails, exposed, exposedModules, pkgIdMap )
......@@ -615,8 +617,8 @@ installInteractivePrint Nothing _ = return ()
installInteractivePrint (Just ipFun) exprmode = do
ok <- trySuccess $ do
(name:_) <- GHC.parseName ipFun
dflags <- getDynFlags
GHC.setInteractiveDynFlags (setInteractivePrintName name dflags)
modifySession (\he -> let new_ic = setInteractivePrintName (hsc_IC he) name
in he{hsc_IC = new_ic})
return Succeeded
when (failed ok && exprmode) $ liftIO (exitWith (ExitFailure 1))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment