Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Tobias Decking
GHC
Commits
f1dfce1c
Commit
f1dfce1c
authored
Dec 19, 2016
by
Tamar Christina
Browse files
Revert "Allow use of the external interpreter in stage1."
This reverts commit
52ba9470
.
parent
bb74bc79
Changes
33
Hide whitespace changes
Inline
Side-by-side
compiler/deSugar/Coverage.hs
View file @
f1dfce1c
...
...
@@ -7,14 +7,12 @@
module
Coverage
(
addTicksToBinds
,
hpcInitCode
)
where
#
ifdef
GHCI
import
qualified
GHCi
import
GHCi.RemoteTypes
import
Data.Array
import
ByteCodeTypes
#
if
MIN_VERSION_base
(
4
,
9
,
0
)
import
GHC.Stack.CCS
#
else
import
GHC.Stack
as
GHC.Stack.CCS
#
endif
import
Type
import
HsSyn
...
...
@@ -131,6 +129,9 @@ guessSourceFile binds orig_file =
mkModBreaks
::
HscEnv
->
Module
->
Int
->
[
MixEntry_
]
->
IO
ModBreaks
#
ifndef
GHCI
mkModBreaks
_hsc_env
_mod
_count
_entries
=
return
emptyModBreaks
#
else
mkModBreaks
hsc_env
mod
count
entries
|
HscInterpreted
<-
hscTarget
(
hsc_dflags
hsc_env
)
=
do
breakArray
<-
GHCi
.
newBreakArray
hsc_env
(
length
entries
)
...
...
@@ -164,6 +165,7 @@ mkCCSArray hsc_env modul count entries = do
mk_one
(
srcspan
,
decl_path
,
_
,
_
)
=
(
name
,
src
)
where
name
=
concat
(
intersperse
"."
decl_path
)
src
=
showSDoc
dflags
(
ppr
srcspan
)
#
endif
writeMixEntries
...
...
compiler/ghc.cabal.in
View file @
f1dfce1c
...
...
@@ -64,7 +64,6 @@ Library
transformers == 0.5.*,
ghc-boot == @ProjectVersionMunged@,
ghc-boot-th == @ProjectVersionMunged@,
ghci == @ProjectVersionMunged@,
hoopl >= 3.10.2 && < 3.11
if os(windows)
...
...
@@ -74,6 +73,9 @@ Library
Build-Depends: terminfo == 0.4.*
Build-Depends: unix == 2.7.*
if flag(ghci)
Build-Depends: ghci == @ProjectVersionMunged@
GHC-Options: -Wall -fno-warn-name-shadowing
if flag(ghci)
...
...
@@ -603,6 +605,16 @@ Library
Dwarf
Dwarf.Types
Dwarf.Constants
if !flag(stage1)
-- ghc:Serialized moved to ghc-boot:GHC.Serialized. So for
-- compatibility with GHC 7.10 and earlier, we reexport it
-- under the old name.
reexported-modules:
ghc-boot:GHC.Serialized as Serialized
if flag(ghci)
Exposed-Modules:
Convert
ByteCodeTypes
ByteCodeAsm
...
...
@@ -615,10 +627,3 @@ Library
RtClosureInspect
DebuggerUtils
GHCi
if !flag(stage1)
-- ghc:Serialized moved to ghc-boot:GHC.Serialized. So for
-- compatibility with GHC 7.10 and earlier, we reexport it
-- under the old name.
reexported-modules:
ghc-boot:GHC.Serialized as Serialized
compiler/ghci/ByteCodeGen.hs
View file @
f1dfce1c
...
...
@@ -66,11 +66,7 @@ import qualified Data.Map as Map
import
qualified
Data.IntMap
as
IntMap
import
qualified
FiniteMap
as
Map
import
Data.Ord
#
if
MIN_VERSION_base
(
4
,
9
,
0
)
import
GHC.Stack.CCS
#
else
import
GHC.Stack
as
GHC.Stack.CCS
#
endif
-- -----------------------------------------------------------------------------
-- Generating byte code for a complete module
...
...
compiler/ghci/ByteCodeInstr.hs
View file @
f1dfce1c
...
...
@@ -30,11 +30,7 @@ import PrimOp
import
SMRep
import
Data.Word
#
if
MIN_VERSION_base
(
4
,
9
,
0
)
import
GHC.Stack.CCS
(
CostCentre
)
#
else
import
GHC.Stack
(
CostCentre
)
#
endif
-- ----------------------------------------------------------------------------
-- Bytecode instructions
...
...
compiler/ghci/ByteCodeTypes.hs
View file @
f1dfce1c
{-# LANGUAGE
CPP,
MagicHash, RecordWildCards, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash, RecordWildCards, GeneralizedNewtypeDeriving #-}
--
-- (c) The University of Glasgow 2002-2006
--
...
...
@@ -34,11 +34,7 @@ import Data.Array.Base ( UArray(..) )
import
Data.ByteString
(
ByteString
)
import
Data.IntMap
(
IntMap
)
import
qualified
Data.IntMap
as
IntMap
#
if
MIN_VERSION_base
(
4
,
9
,
0
)
import
GHC.Stack.CCS
#
else
import
GHC.Stack
as
GHC.Stack.CCS
#
endif
-- -----------------------------------------------------------------------------
-- Compiled Byte Code
...
...
compiler/ghci/GHCi.hs
View file @
f1dfce1c
...
...
@@ -46,9 +46,7 @@ module GHCi
)
where
import
GHCi.Message
#
ifdef
GHCI
import
GHCi.Run
#
endif
import
GHCi.RemoteTypes
import
GHCi.ResolvedBCO
import
GHCi.BreakArray
(
BreakArray
)
...
...
@@ -73,11 +71,7 @@ import Data.ByteString (ByteString)
import
qualified
Data.ByteString.Lazy
as
LB
import
Data.IORef
import
Foreign
hiding
(
void
)
#
if
MIN_VERSION_base
(
4
,
9
,
0
)
import
GHC.Stack.CCS
(
CostCentre
,
CostCentreStack
)
#
else
import
GHC.Stack
(
CostCentre
,
CostCentreStack
)
#
endif
import
System.Exit
import
Data.Maybe
import
GHC.IO.Handle.Types
(
Handle
)
...
...
@@ -154,12 +148,6 @@ Other Notes on Remote GHCi
* Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs
-}
#
ifndef
GHCI
needExtInt
::
IO
a
needExtInt
=
throwIO
(
InstallationError
"this operation requires -fexternal-interpreter"
)
#
endif
-- | Run a command in the interpreter's context. With
-- @-fexternal-interpreter@, the command is serialized and sent to an
-- external iserv process, and the response is deserialized (hence the
...
...
@@ -172,11 +160,8 @@ iservCmd hsc_env@HscEnv{..} msg
uninterruptibleMask_
$
do
-- Note [uninterruptibleMask_]
iservCall
iserv
msg
|
otherwise
=
-- Just run it directly
#
ifdef
GHCI
run
msg
#
else
needExtInt
#
endif
-- Note [uninterruptibleMask_ and iservCmd]
--
...
...
@@ -372,11 +357,7 @@ lookupSymbol hsc_env@HscEnv{..} str
writeIORef
iservLookupSymbolCache
$!
addToUFM
cache
str
p
return
(
Just
p
)
|
otherwise
=
#
ifdef
GHCI
fmap
fromRemotePtr
<$>
run
(
LookupSymbol
(
unpackFS
str
))
#
else
needExtInt
#
endif
lookupClosure
::
HscEnv
->
String
->
IO
(
Maybe
HValueRef
)
lookupClosure
hsc_env
str
=
...
...
@@ -622,14 +603,8 @@ wormholeRef dflags r
|
gopt
Opt_ExternalInterpreter
dflags
=
throwIO
(
InstallationError
"this operation requires -fno-external-interpreter"
)
#
ifdef
GHCI
|
otherwise
=
localRef
r
#
else
|
otherwise
=
throwIO
(
InstallationError
"can't wormhole a value in a stage1 compiler"
)
#
endif
-- -----------------------------------------------------------------------------
-- Misc utils
...
...
compiler/ghci/Linker.hs
View file @
f1dfce1c
...
...
@@ -709,16 +709,6 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
adjust_ul
_
(
DotA
fp
)
=
panic
(
"adjust_ul DotA "
++
show
fp
)
adjust_ul
_
(
DotDLL
fp
)
=
panic
(
"adjust_ul DotDLL "
++
show
fp
)
adjust_ul
_
l
@
(
BCOs
{})
=
return
l
#
if
!
MIN_VERSION_filepath
(
1
,
4
,
1
)
stripExtension
::
String
->
FilePath
->
Maybe
FilePath
stripExtension
[]
path
=
Just
path
stripExtension
ext
@
(
x
:
_
)
path
=
stripSuffix
dotExt
path
where
dotExt
=
if
isExtSeparator
x
then
ext
else
'.'
:
ext
stripSuffix
::
Eq
a
=>
[
a
]
->
[
a
]
->
Maybe
[
a
]
stripSuffix
xs
ys
=
fmap
reverse
$
stripPrefix
(
reverse
xs
)
(
reverse
ys
)
#
endif
{- **********************************************************************
...
...
compiler/hsSyn/HsExpr.hs
View file @
f1dfce1c
...
...
@@ -48,8 +48,10 @@ import Data.Data hiding (Fixity(..))
import
qualified
Data.Data
as
Data
(
Fixity
(
..
))
import
Data.Maybe
(
isNothing
)
#
ifdef
GHCI
import
GHCi.RemoteTypes
(
ForeignRef
)
import
qualified
Language.Haskell.TH
as
TH
(
Q
)
#
endif
{-
************************************************************************
...
...
@@ -2045,13 +2047,24 @@ isTypedSplice _ = False -- Quasi-quotes are untyped splices
-- See Note [Delaying modFinalizers in untyped splices] in RnSplice. For how
-- this is used.
--
#
ifdef
GHCI
newtype
ThModFinalizers
=
ThModFinalizers
[
ForeignRef
(
TH
.
Q
()
)]
#
else
data
ThModFinalizers
=
ThModFinalizers
#
endif
-- A Data instance which ignores the argument of 'ThModFinalizers'.
#
ifdef
GHCI
instance
Data
ThModFinalizers
where
gunfold
_
z
_
=
z
$
ThModFinalizers
[]
toConstr
a
=
mkConstr
(
dataTypeOf
a
)
"ThModFinalizers"
[]
Data
.
Prefix
dataTypeOf
a
=
mkDataType
"HsExpr.ThModFinalizers"
[
toConstr
a
]
#
else
instance
Data
ThModFinalizers
where
gunfold
_
z
_
=
z
ThModFinalizers
toConstr
a
=
mkConstr
(
dataTypeOf
a
)
"ThModFinalizers"
[]
Data
.
Prefix
dataTypeOf
a
=
mkDataType
"HsExpr.ThModFinalizers"
[
toConstr
a
]
#
endif
-- | Haskell Spliced Thing
--
...
...
compiler/main/DriverPipeline.hs
View file @
f1dfce1c
...
...
@@ -2054,7 +2054,11 @@ doCpp dflags raw input_fn output_fn = do
backend_defs
<-
getBackendDefs
dflags
#
ifdef
GHCI
let
th_defs
=
[
"-D__GLASGOW_HASKELL_TH__"
]
#
else
let
th_defs
=
[
"-D__GLASGOW_HASKELL_TH__=0"
]
#
endif
-- Default CPP defines in Haskell source
ghcVersionH
<-
getGhcVersionPathName
dflags
let
hsSourceCppOpts
=
[
"-include"
,
ghcVersionH
]
...
...
compiler/main/DynFlags.hs
View file @
f1dfce1c
...
...
@@ -124,7 +124,9 @@ module DynFlags (
-- * Compiler configuration suitable for display to the user
compilerInfo
,
#
ifdef
GHCI
rtsIsProfiled
,
#
endif
dynamicGhc
,
#
include
"
GHCConstantsHaskellExports
.
hs
"
...
...
@@ -3611,6 +3613,12 @@ supportedExtensions :: [String]
supportedExtensions
=
concatMap
toFlagSpecNamePair
xFlags
where
toFlagSpecNamePair
flg
#
ifndef
GHCI
-- make sure that `ghc --supported-extensions` omits
-- "TemplateHaskell" when it's known to be unsupported. See also
-- GHC #11102 for rationale
|
flagSpecFlag
flg
==
LangExt
.
TemplateHaskell
=
[
noName
]
#
endif
|
otherwise
=
[
name
,
noName
]
where
noName
=
"No"
++
name
...
...
@@ -4147,6 +4155,7 @@ foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt
rtsIsProfiled
::
Bool
rtsIsProfiled
=
unsafeDupablePerformIO
rtsIsProfiledIO
/=
0
#
ifdef
GHCI
-- Consult the RTS to find whether GHC itself has been built with
-- dynamic linking. This can't be statically known at compile-time,
-- because we build both the static and dynamic versions together with
...
...
@@ -4155,6 +4164,10 @@ foreign import ccall unsafe "rts_isDynamic" rtsIsDynamicIO :: IO CInt
dynamicGhc
::
Bool
dynamicGhc
=
unsafeDupablePerformIO
rtsIsDynamicIO
/=
0
#
else
dynamicGhc
::
Bool
dynamicGhc
=
False
#
endif
setWarnSafe
::
Bool
->
DynP
()
setWarnSafe
True
=
getCurLoc
>>=
\
l
->
upd
(
\
d
->
d
{
warnSafeOnLoc
=
l
})
...
...
@@ -4187,8 +4200,24 @@ setIncoherentInsts True = do
upd
(
\
d
->
d
{
incoherentOnLoc
=
l
})
checkTemplateHaskellOk
::
TurnOnFlag
->
DynP
()
#
ifdef
GHCI
checkTemplateHaskellOk
_turn_on
=
getCurLoc
>>=
\
l
->
upd
(
\
d
->
d
{
thOnLoc
=
l
})
#
else
-- In stage 1, Template Haskell is simply illegal, except with -M
-- We don't bleat with -M because there's no problem with TH there,
-- and in fact GHC's build system does ghc -M of the DPH libraries
-- with a stage1 compiler
checkTemplateHaskellOk
turn_on
|
turn_on
=
do
dfs
<-
liftEwM
getCmdLineState
case
ghcMode
dfs
of
MkDepend
->
return
()
_
->
addErr
msg
|
otherwise
=
return
()
where
msg
=
"Template Haskell requires GHC with interpreter support
\n
"
++
"Perhaps you are using a stage-1 compiler?"
#
endif
{- **********************************************************************
%* *
...
...
compiler/main/GHC.hs
View file @
f1dfce1c
...
...
@@ -91,6 +91,7 @@ module GHC (
-- * Interactive evaluation
#
ifdef
GHCI
-- ** Executing statements
execStmt
,
ExecOptions
(
..
),
execOptions
,
ExecResult
(
..
),
resumeExec
,
...
...
@@ -102,10 +103,11 @@ module GHC (
parseImportDecl
,
setContext
,
getContext
,
setGHCiMonad
,
getGHCiMonad
,
#
endif
-- ** Inspecting the current context
getBindings
,
getInsts
,
getPrintUnqual
,
findModule
,
lookupModule
,
#
ifdef
GHCI
isModuleTrusted
,
moduleTrustReqs
,
getNamesInScope
,
getRdrNamesInScope
,
...
...
@@ -121,8 +123,9 @@ module GHC (
-- ** Looking up a Name
parseName
,
#
endif
lookupName
,
#
ifdef
GHCI
-- ** Compiling expressions
HValue
,
parseExpr
,
compileParsedExpr
,
InteractiveEval
.
compileExpr
,
dynCompileExpr
,
...
...
@@ -151,6 +154,7 @@ module GHC (
RunResult
(
..
),
runStmt
,
runStmtWithLocation
,
resume
,
#
endif
-- * Abstract syntax elements
...
...
@@ -286,12 +290,14 @@ module GHC (
#
include
"HsVersions.h"
#
ifdef
GHCI
import
ByteCodeTypes
import
InteractiveEval
import
InteractiveEvalTypes
import
TcRnDriver
(
runTcInteractive
)
import
GHCi
import
GHCi.RemoteTypes
#
endif
import
PprTyThing
(
pprFamInst
)
import
HscMain
...
...
@@ -463,7 +469,9 @@ withCleanupSession ghc = ghc `gfinally` cleanup
liftIO
$
do
cleanTempFiles
dflags
cleanTempDirs
dflags
#
ifdef
GHCI
stopIServ
hsc_env
-- shut down the IServ
#
endif
-- exceptions will be blocked while we clean the temporary files,
-- so there shouldn't be any difficulty if we receive further
-- signals.
...
...
@@ -881,8 +889,10 @@ typecheckModule pmod = do
minf_rdr_env
=
Just
(
tcg_rdr_env
tc_gbl_env
),
minf_instances
=
fixSafeInstances
safe
$
md_insts
details
,
minf_iface
=
Nothing
,
minf_safe
=
safe
,
minf_modBreaks
=
emptyModBreaks
minf_safe
=
safe
#
ifdef
GHCI
,
minf_modBreaks
=
emptyModBreaks
#
endif
}}
-- | Desugar a typechecked module.
...
...
@@ -1070,8 +1080,10 @@ data ModuleInfo = ModuleInfo {
minf_rdr_env
::
Maybe
GlobalRdrEnv
,
-- Nothing for a compiled/package mod
minf_instances
::
[
ClsInst
],
minf_iface
::
Maybe
ModIface
,
minf_safe
::
SafeHaskellMode
,
minf_modBreaks
::
ModBreaks
minf_safe
::
SafeHaskellMode
#
ifdef
GHCI
,
minf_modBreaks
::
ModBreaks
#
endif
}
-- We don't want HomeModInfo here, because a ModuleInfo applies
-- to package modules too.
...
...
@@ -1094,6 +1106,7 @@ getModuleInfo mdl = withSession $ \hsc_env -> do
-- exist... hence the isHomeModule test here. (ToDo: reinstate)
getPackageModuleInfo
::
HscEnv
->
Module
->
IO
(
Maybe
ModuleInfo
)
#
ifdef
GHCI
getPackageModuleInfo
hsc_env
mdl
=
do
eps
<-
hscEPS
hsc_env
iface
<-
hscGetModuleInterface
hsc_env
mdl
...
...
@@ -1112,6 +1125,11 @@ getPackageModuleInfo hsc_env mdl
minf_safe
=
getSafeMode
$
mi_trust
iface
,
minf_modBreaks
=
emptyModBreaks
}))
#
else
-- bogusly different for non-GHCI (ToDo)
getPackageModuleInfo
_hsc_env
_mdl
=
do
return
Nothing
#
endif
getHomeModuleInfo
::
HscEnv
->
Module
->
IO
(
Maybe
ModuleInfo
)
getHomeModuleInfo
hsc_env
mdl
=
...
...
@@ -1127,7 +1145,9 @@ getHomeModuleInfo hsc_env mdl =
minf_instances
=
md_insts
details
,
minf_iface
=
Just
iface
,
minf_safe
=
getSafeMode
$
mi_trust
iface
#
ifdef
GHCI
,
minf_modBreaks
=
getModBreaks
hmi
#
endif
}))
-- | The list of top-level entities defined in a module
...
...
@@ -1176,8 +1196,10 @@ modInfoIface = minf_iface
modInfoSafe
::
ModuleInfo
->
SafeHaskellMode
modInfoSafe
=
minf_safe
#
ifdef
GHCI
modInfoModBreaks
::
ModuleInfo
->
ModBreaks
modInfoModBreaks
=
minf_modBreaks
#
endif
isDictonaryId
::
Id
->
Bool
isDictonaryId
id
...
...
@@ -1197,9 +1219,11 @@ findGlobalAnns deserialize target = withSession $ \hsc_env -> do
ann_env
<-
liftIO
$
prepareAnnotations
hsc_env
Nothing
return
(
findAnns
deserialize
ann_env
target
)
#
ifdef
GHCI
-- | get the GlobalRdrEnv for a session
getGRE
::
GhcMonad
m
=>
m
GlobalRdrEnv
getGRE
=
withSession
$
\
hsc_env
->
return
$
ic_rn_gbl_env
(
hsc_IC
hsc_env
)
#
endif
-- -----------------------------------------------------------------------------
...
...
@@ -1398,6 +1422,7 @@ lookupLoadedHomeModule mod_name = withSession $ \hsc_env ->
Just
mod_info
->
return
(
Just
(
mi_module
(
hm_iface
mod_info
)))
_not_a_home_module
->
return
Nothing
#
ifdef
GHCI
-- | Check that a module is safe to import (according to Safe Haskell).
--
-- We return True to indicate the import is safe and False otherwise
...
...
@@ -1439,6 +1464,7 @@ obtainTermFromId :: GhcMonad m => Int -> Bool -> Id -> m Term
obtainTermFromId
bound
force
id
=
withSession
$
\
hsc_env
->
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'.
...
...
compiler/main/GhcMake.hs
View file @
f1dfce1c
...
...
@@ -31,7 +31,9 @@ module GhcMake(
#
include
"HsVersions.h"
#
ifdef
GHCI
import
qualified
Linker
(
unload
)
#
endif
import
DriverPhases
import
DriverPipeline
...
...
@@ -561,7 +563,13 @@ findPartiallyCompletedCycles modsDone theGraph
unload
::
HscEnv
->
[
Linkable
]
->
IO
()
unload
hsc_env
stable_linkables
-- Unload everthing *except* 'stable_linkables'
=
case
ghcLink
(
hsc_dflags
hsc_env
)
of
#
ifdef
GHCI
LinkInMemory
->
Linker
.
unload
hsc_env
stable_linkables
#
else
LinkInMemory
->
panic
"unload: no interpreter"
-- urgh. avoid warnings:
hsc_env
stable_linkables
#
endif
_other
->
return
()
-- -----------------------------------------------------------------------------
...
...
compiler/main/Hooks.hs
View file @
f1dfce1c
...
...
@@ -15,14 +15,18 @@ module Hooks ( Hooks
,
tcForeignImportsHook
,
tcForeignExportsHook
,
hscFrontendHook
#
ifdef
GHCI
,
hscCompileCoreExprHook
#
endif
,
ghcPrimIfaceHook
,
runPhaseHook
,
runMetaHook
,
linkHook
,
runRnSpliceHook
#
ifdef
GHCI
,
getValueSafelyHook
,
createIservProcessHook
#
endif
)
where
import
DynFlags
...
...
@@ -38,10 +42,12 @@ import TcRnTypes
import
Bag
import
RdrName
import
CoreSyn
#
ifdef
GHCI
import
GHCi.RemoteTypes
import
SrcLoc
import
Type
import
System.Process
#
endif
import
BasicTypes
import
Data.Maybe
...
...
@@ -64,14 +70,18 @@ emptyHooks = Hooks
,
tcForeignImportsHook
=
Nothing
,
tcForeignExportsHook
=
Nothing
,
hscFrontendHook
=
Nothing
#
ifdef
GHCI
,
hscCompileCoreExprHook
=
Nothing
#
endif
,
ghcPrimIfaceHook
=
Nothing
,
runPhaseHook
=
Nothing
,
runMetaHook
=
Nothing
,
linkHook
=
Nothing
,
runRnSpliceHook
=
Nothing
#
ifdef
GHCI
,
getValueSafelyHook
=
Nothing
,
createIservProcessHook
=
Nothing
#
endif
}
data
Hooks
=
Hooks
...
...
@@ -79,14 +89,18 @@ data Hooks = Hooks
,
tcForeignImportsHook
::
Maybe
([
LForeignDecl
Name
]
->
TcM
([
Id
],
[
LForeignDecl
Id
],
Bag
GlobalRdrElt
))
,
tcForeignExportsHook
::
Maybe
([
LForeignDecl
Name
]
->
TcM
(
LHsBinds
TcId
,
[
LForeignDecl
TcId
],
Bag
GlobalRdrElt
))
,
hscFrontendHook
::
Maybe
(
ModSummary
->
Hsc
FrontendResult
)
#
ifdef
GHCI
,
hscCompileCoreExprHook
::
Maybe
(
HscEnv
->
SrcSpan
->
CoreExpr
->
IO
ForeignHValue
)
#
endif
,
ghcPrimIfaceHook
::
Maybe
ModIface
,
runPhaseHook
::
Maybe
(
PhasePlus
->
FilePath
->
DynFlags
->
CompPipeline
(
PhasePlus
,
FilePath
))
,
runMetaHook
::
Maybe
(
MetaHook
TcM
)
,
linkHook
::
Maybe
(
GhcLink
->
DynFlags
->
Bool
->
HomePackageTable
->
IO
SuccessFlag
)
,
runRnSpliceHook
::
Maybe
(
HsSplice
Name
->
RnM
(
HsSplice
Name
))
#
ifdef
GHCI
,
getValueSafelyHook
::
Maybe
(
HscEnv
->
Name
->
Type
->
IO
(
Maybe
HValue
))
,
createIservProcessHook
::
Maybe
(
CreateProcess
->
IO
ProcessHandle
)
#
endif
}
getHooked
::
(
Functor
f
,
HasDynFlags
f
)
=>
(
Hooks
->
Maybe
a
)
->
a
->
f
a
...
...
compiler/main/HscMain.hs
View file @
f1dfce1c
...
...
@@ -59,6 +59,7 @@ module HscMain
,
hscParseIdentifier
,
hscTcRcLookupName
,
hscTcRnGetInfo
#
ifdef
GHCI
,
hscIsGHCiMonad
,
hscGetModuleInterface
,
hscRnImportDecls
...
...
@@ -70,6 +71,7 @@ module HscMain
,
hscCompileCoreExpr
-- * Low-level exports for hooks
,
hscCompileCoreExpr'
#
endif
-- We want to make sure that we export enough to be able to redefine
-- hscFileFrontEnd in client code
,
hscParse'
,
hscSimplify'
,
hscDesugar'
,
tcRnModule'
...
...
@@ -81,6 +83,7 @@ module HscMain
,
showModuleIndex
)
where
#
ifdef
GHCI
import
Id
import
GHCi.RemoteTypes
(
ForeignHValue
)
import
ByteCodeGen
(
byteCodeGen
,
coreExprToBCOs
)
...
...
@@ -93,6 +96,7 @@ import VarEnv ( emptyTidyEnv )
import
Panic
import
ConLike
import
Control.Concurrent
#
endif
import
Module
import
Packages
...
...
@@ -174,7 +178,9 @@ newHscEnv dflags = do
us
<-
mkSplitUniqSupply
'r'
nc_var
<-
newIORef
(
initNameCache
us
knownKeyNames
)
fc_var
<-
newIORef
emptyInstalledModuleEnv
#
ifdef
GHCI
iserv_mvar
<-
newMVar
Nothing
#
endif
return
HscEnv
{
hsc_dflags
=
dflags
,
hsc_targets
=
[]
,
hsc_mod_graph
=
[]
...
...
@@ -184,7 +190,9 @@ newHscEnv dflags = do
,
hsc_NC
=
nc_var
,
hsc_FC
=
fc_var
,
hsc_type_env_var
=
Nothing
#
ifdef
GHCI
,
hsc_iserv
=
iserv_mvar
#
endif
}
-- -----------------------------------------------------------------------------
...
...
@@ -254,11 +262,13 @@ ioMsgMaybe' ioA = do
-- -----------------------------------------------------------------------------
-- | Lookup things in the compiler's environment
#
ifdef
GHCI
hscTcRnLookupRdrName
::
HscEnv
->
Located
RdrName
->
IO
[
Name
]
hscTcRnLookupRdrName
hsc_env0
rdr_name
=
runInteractiveHsc
hsc_env0
$
do
{
hsc_env
<-
getHscEnv
;
ioMsgMaybe
$
tcRnLookupRdrName
hsc_env
rdr_name
}
#
endif