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
Shayne Fletcher
Glasgow Haskell Compiler
Commits
099b2606
Commit
099b2606
authored
Sep 10, 2007
by
Simon Marlow
Browse files
refactoring: eliminate DriverPipeline.CompResult and GHC.upsweep_compile
parent
e89cbb88
Changes
2
Hide whitespace changes
Inline
Side-by-side
compiler/main/DriverPipeline.hs
View file @
099b2606
...
...
@@ -23,7 +23,7 @@ module DriverPipeline (
-- Interfaces for the compilation manager (interpreted/batch-mode)
preprocess
,
compile
,
CompResult
(
..
),
compile
,
link
,
)
where
...
...
@@ -93,36 +93,25 @@ preprocess dflags (filename, mb_phase) =
-- NB. No old interface can also mean that the source has changed.
compile
::
HscEnv
->
ModSummary
->
Maybe
Linkable
-- Just linkable <=> source unchanged
->
Maybe
ModIface
-- Old interface, if available
->
Int
->
Int
->
IO
CompResult
data
CompResult
=
CompOK
ModDetails
-- New details
ModIface
-- New iface
(
Maybe
Linkable
)
-- a Maybe, for the same reasons as hm_linkable
|
CompErrs
compile
hsc_env
mod_summary
maybe_old_linkable
old_iface
mod_index
nmods
=
do
let
dflags0
=
ms_hspp_opts
mod_summary
this_mod
=
ms_mod
mod_summary
src_flavour
=
ms_hsc_src
mod_summary
->
ModSummary
-- summary for module being compiled
->
Int
->
Int
-- module N of M
->
Maybe
ModIface
-- old interface, if we have one
->
Maybe
Linkable
-- old linkable, if we have one
->
IO
(
Maybe
HomeModInfo
)
-- the complete HomeModInfo, if successful
compile
hsc_env
summary
mod_index
nmods
mb_old_iface
maybe_old_linkable
=
do
let
dflags0
=
ms_hspp_opts
summary
this_mod
=
ms_mod
summary
src_flavour
=
ms_hsc_src
summary
have_object
|
Just
l
<-
maybe_old_linkable
,
isObjectLinkable
l
=
True
|
otherwise
=
False
-- FIXME: We need to know whether or not we're recompiling the file. Move this to HscMain?
--showPass dflags0 ("Compiling " ++ showModMsg have_object mod_summary)
let
location
=
ms_location
mod_summary
let
location
=
ms_location
summary
let
input_fn
=
expectJust
"compile:hs"
(
ml_hs_file
location
)
let
input_fnpp
=
ms_hspp_file
mod_
summary
let
input_fnpp
=
ms_hspp_file
summary
debugTraceMsg
dflags0
2
(
text
"compile: input file"
<+>
text
input_fnpp
)
...
...
@@ -158,21 +147,23 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
=
do
stub_o
<-
compileStub
dflags'
this_mod
location
return
[
DotO
stub_o
]
handleBatch
(
HscNoRecomp
,
iface
,
details
)
handleBatch
HscNoRecomp
=
ASSERT
(
isJust
maybe_old_linkable
)
return
(
CompOK
details
iface
maybe_old_linkable
)
handleBatch
(
HscRecomp
hasStub
,
iface
,
details
)
return
maybe_old_linkable
handleBatch
(
HscRecomp
hasStub
)
|
isHsBoot
src_flavour
=
do
when
(
isObjectTarget
hsc_lang
)
$
-- interpreted reaches here too
SysTools
.
touch
dflags'
"Touching object file"
object_filename
return
(
CompOK
details
iface
Nothing
)
return
maybe_old_linkable
|
otherwise
=
do
stub_unlinked
<-
getStubLinkable
hasStub
(
hs_unlinked
,
unlinked_time
)
<-
case
hsc_lang
of
HscNothing
->
return
(
[]
,
ms_hs_date
mod_
summary
)
->
return
(
[]
,
ms_hs_date
summary
)
-- We're in --make mode: finish the compilation pipeline.
_other
->
do
runPipeline
StopLn
dflags
(
output_fn
,
Nothing
)
...
...
@@ -184,15 +175,15 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
return
([
DotO
object_filename
],
o_time
)
let
linkable
=
LM
unlinked_time
this_mod
(
hs_unlinked
++
stub_unlinked
)
return
(
CompOK
details
iface
(
Just
linkable
)
)
return
(
Just
linkable
)
handleInterpreted
(
InteractiveNoRecomp
,
iface
,
details
)
handleInterpreted
InteractiveNoRecomp
=
ASSERT
(
isJust
maybe_old_linkable
)
return
(
CompOK
details
iface
maybe_old_linkable
)
handleInterpreted
(
InteractiveRecomp
hasStub
comp_bc
modBreaks
,
iface
,
details
)
return
maybe_old_linkable
handleInterpreted
(
InteractiveRecomp
hasStub
comp_bc
modBreaks
)
=
do
stub_unlinked
<-
getStubLinkable
hasStub
let
hs_unlinked
=
[
BCOs
comp_bc
modBreaks
]
unlinked_time
=
ms_hs_date
mod_
summary
unlinked_time
=
ms_hs_date
summary
-- Why do we use the timestamp of the source file here,
-- rather than the current time? This works better in
-- the case where the local clock is out of sync
...
...
@@ -201,22 +192,31 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
-- be out of date.
let
linkable
=
LM
unlinked_time
this_mod
(
hs_unlinked
++
stub_unlinked
)
return
(
CompOK
details
iface
(
Just
linkable
)
)
return
(
Just
linkable
)
let
runCompiler
compiler
handle
=
do
mbResult
<-
compiler
hsc_env'
mod_summary
source_unchanged
old_iface
let
-- runCompiler :: Compiler result -> (result -> Maybe Linkable)
-- -> IO (Maybe HomeModInfo)
runCompiler
compiler
handle
=
do
mbResult
<-
compiler
hsc_env'
summary
source_unchanged
mb_old_iface
(
Just
(
mod_index
,
nmods
))
case
mbResult
of
Nothing
->
return
CompErrs
Just
result
->
handle
result
Nothing
->
return
Nothing
Just
(
result
,
iface
,
details
)
->
do
linkable
<-
handle
result
return
(
Just
HomeModInfo
{
hm_details
=
details
,
hm_iface
=
iface
,
hm_linkable
=
linkable
})
-- run the compiler
case
hsc_lang
of
HscInterpreted
|
isHsBoot
src_flavour
->
runCompiler
hscCompileNothing
handleBatch
|
otherwise
->
runCompiler
hscCompileInteractive
handleInterpreted
HscNothing
->
runCompiler
hscCompileNothing
handleBatch
_other
->
runCompiler
hscCompileBatch
handleBatch
HscInterpreted
|
isHsBoot
src_flavour
->
runCompiler
hscCompileNothing
handleBatch
|
otherwise
->
runCompiler
hscCompileInteractive
handleInterpreted
HscNothing
->
runCompiler
hscCompileNothing
handleBatch
_other
->
runCompiler
hscCompileBatch
handleBatch
-----------------------------------------------------------------------------
-- stub .h and .c files (for foreign export support)
...
...
compiler/main/GHC.hs
View file @
099b2606
...
...
@@ -1181,12 +1181,10 @@ upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
iface
=
hm_iface
hm_info
compile_it
::
Maybe
Linkable
->
IO
(
Maybe
HomeModInfo
)
compile_it
=
upsweep_compile
hsc_env
summary'
mod_index
nmods
mb_old_iface
compile_it
=
compile
hsc_env
summary'
mod_index
nmods
mb_old_iface
compile_it_discard_iface
=
upsweep_compile
hsc_env
summary'
mod_index
nmods
Nothing
=
compile
hsc_env
summary'
mod_index
nmods
Nothing
in
case
target
of
...
...
@@ -1248,27 +1246,6 @@ upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
compile_it
Nothing
-- Run hsc to compile a module
upsweep_compile
::
HscEnv
->
ModSummary
->
Int
->
Int
->
Maybe
ModIface
->
Maybe
Linkable
->
IO
(
Maybe
HomeModInfo
)
upsweep_compile
hsc_env
summary
mod_index
nmods
mb_old_iface
mb_old_linkable
=
do
compresult
<-
compile
hsc_env
summary
mb_old_linkable
mb_old_iface
mod_index
nmods
case
compresult
of
-- Compilation failed. Compile may still have updated the PCS, tho.
CompErrs
->
return
Nothing
-- Compilation "succeeded", and may or may not have returned a new
-- linkable (depending on whether compilation was actually performed
-- or not).
CompOK
new_details
new_iface
new_linkable
->
do
let
new_info
=
HomeModInfo
{
hm_iface
=
new_iface
,
hm_details
=
new_details
,
hm_linkable
=
new_linkable
}
return
(
Just
new_info
)
-- Filter modules in the HPT
retainInTopLevelEnvs
::
[
ModuleName
]
->
HomePackageTable
->
HomePackageTable
...
...
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