Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
bec0737c
Commit
bec0737c
authored
Jun 21, 2012
by
Vitaly Bragilevsky
Committed by
pcapriotti
Jun 25, 2012
Browse files
Implemented feature request on reconfigurable pretty-printing in GHCi (
#5461
)
parent
66c41963
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/main/DynFlags.hs
View file @
bec0737c
...
...
@@ -80,6 +80,8 @@ module DynFlags (
setPackageName
,
doingTickyProfiling
,
setInteractivePrintName
,
-- Name -> DynFlags -> DynFlags
-- ** Parsing DynFlags
parseDynamicFlagsCmdLine
,
parseDynamicFilePragma
,
...
...
@@ -109,6 +111,7 @@ module DynFlags (
#
include
"HsVersions.h"
import
Platform
import
Name
import
Module
import
PackageConfig
import
PrelNames
(
mAIN
)
...
...
@@ -626,7 +629,10 @@ data DynFlags = DynFlags {
-- | what kind of {-# SCC #-} to add automatically
profAuto
::
ProfAuto
,
llvmVersion
::
IORef
(
Int
)
llvmVersion
::
IORef
(
Int
),
interactivePrint
::
Maybe
String
,
interactivePrintName
::
Maybe
Name
}
class
HasDynFlags
m
where
...
...
@@ -983,7 +989,9 @@ defaultDynFlags mySettings =
pprCols
=
100
,
traceLevel
=
1
,
profAuto
=
NoProfAuto
,
llvmVersion
=
panic
"defaultDynFlags: No llvmVersion"
llvmVersion
=
panic
"defaultDynFlags: No llvmVersion"
,
interactivePrint
=
Nothing
,
interactivePrintName
=
Nothing
}
-- Do not use tracingDynFlags!
...
...
@@ -1245,7 +1253,8 @@ setObjectDir, setHiDir, setStubDir, setDumpDir, setOutputDir,
setDylibInstallName
,
setObjectSuf
,
setHiSuf
,
setHcSuf
,
parseDynLibLoaderMode
,
setPgmP
,
addOptl
,
addOptP
,
addCmdlineFramework
,
addHaddockOpts
,
addGhciScript
addCmdlineFramework
,
addHaddockOpts
,
addGhciScript
,
setInteractivePrint
::
String
->
DynFlags
->
DynFlags
setOutputFile
,
setOutputHi
,
setDumpPrefixForce
::
Maybe
String
->
DynFlags
->
DynFlags
...
...
@@ -1319,6 +1328,11 @@ addHaddockOpts f d = d{ haddockOptions = Just f}
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
...
...
@@ -1610,7 +1624,7 @@ dynamic_flags = [
,
Flag
"haddock-opts"
(
hasArg
addHaddockOpts
)
,
Flag
"hpcdir"
(
SepArg
setOptHpcDir
)
,
Flag
"ghci-script"
(
hasArg
addGhciScript
)
,
Flag
"interactive-print"
(
hasArg
setInteractivePrint
)
------- recompilation checker --------------------------------------
,
Flag
"recomp"
(
NoArg
(
do
unSetDynFlag
Opt_ForceRecomp
deprecate
"Use -fno-force-recomp instead"
))
...
...
compiler/typecheck/TcRnDriver.lhs
View file @
bec0737c
...
...
@@ -1325,6 +1325,7 @@ 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
; let fresh_it = itName uniq loc
...
...
@@ -1345,7 +1346,8 @@ tcUserStmt (L loc (ExprStmt expr _ _ _))
(HsVar bindIOName) noSyntaxExpr
-- [; print it]
print_it = L loc $ ExprStmt (nlHsApp (nlHsVar printName) (nlHsVar fresh_it))
interPrintName = maybe printName id (interactivePrintName dynFlags)
print_it = L loc $ ExprStmt (nlHsApp (nlHsVar interPrintName) (nlHsVar fresh_it))
(HsVar thenIOName) noSyntaxExpr placeHolderType
-- The plans are:
...
...
ghc/InteractiveUI.hs
View file @
bec0737c
...
...
@@ -450,6 +450,8 @@ runGHCi paths maybe_exprs = do
when
(
isJust
maybe_exprs
&&
failed
ok
)
$
liftIO
(
exitWith
(
ExitFailure
1
))
installInteractivePrint
(
interactivePrint
dflags
)
(
isJust
maybe_exprs
)
-- if verbosity is greater than 0, or we are connected to a
-- terminal, display the prompt in the interactive loop.
is_tty
<-
liftIO
(
hIsTerminalDevice
stdin
)
...
...
@@ -607,6 +609,18 @@ queryQueue = do
c
:
cs
->
do
setGHCiState
st
{
cmdqueue
=
cs
}
return
(
Just
c
)
-- Reconfigurable pretty-printing Ticket #5461
installInteractivePrint
::
Maybe
String
->
Bool
->
GHCi
()
installInteractivePrint
Nothing
_
=
return
()
installInteractivePrint
(
Just
ipFun
)
exprmode
=
do
ok
<-
trySuccess
$
do
(
name
:
_
)
<-
GHC
.
parseName
ipFun
dflags
<-
getDynFlags
GHC
.
setInteractiveDynFlags
(
setInteractivePrintName
name
dflags
)
return
Succeeded
when
(
failed
ok
&&
exprmode
)
$
liftIO
(
exitWith
(
ExitFailure
1
))
-- | The main read-eval-print loop
runCommands
::
InputT
GHCi
(
Maybe
String
)
->
InputT
GHCi
()
runCommands
=
runCommands'
handler
...
...
@@ -1975,6 +1989,7 @@ newDynFlags interactive_only minus_opts = do
packageFlags
idflags1
/=
packageFlags
idflags0
)
$
do
liftIO
$
hPutStrLn
stderr
"cannot set package flags with :seti; use :set"
GHC
.
setInteractiveDynFlags
idflags1
installInteractivePrint
(
interactivePrint
idflags1
)
False
dflags0
<-
getDynFlags
when
(
not
interactive_only
)
$
do
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment