Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
jberryman
GHC
Commits
76c2a7cf
Commit
76c2a7cf
authored
Oct 26, 2000
by
simonmar
Browse files
[project @ 2000-10-26 14:38:42 by simonmar]
Simon's stuff
parent
d893f380
Changes
5
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/main/DriverPipeline.hs
View file @
76c2a7cf
-----------------------------------------------------------------------------
-- $Id: DriverPipeline.hs,v 1.
6
2000/10/2
5
14:
42:32 sewardj
Exp $
-- $Id: DriverPipeline.hs,v 1.
7
2000/10/2
6
14:
38:42 simonmar
Exp $
--
-- GHC Driver
--
...
...
@@ -29,18 +29,17 @@ import DriverUtil
import
DriverMkDepend
import
DriverPhases
import
DriverFlags
import
HscMain
import
Finder
import
TmpFiles
import
HscTypes
import
UniqFM
import
Outputable
import
Module
import
ErrUtils
import
CmdLineOpts
import
Config
import
Util
import
Panic
import
Posix
import
Directory
import
System
import
IOExts
...
...
@@ -149,10 +148,8 @@ genPipeline todo stop_flag filename
cish
=
cish_suffix
suffix
-- for a .hc file, or if the -C flag is given, we need to force lang to HscC
real_lang
|
suffix
==
"hc"
=
HscC
|
todo
==
StopBefore
HCc
&&
haskellish
=
HscC
|
otherwise
=
lang
real_lang
|
suffix
==
"hc"
=
HscC
|
otherwise
=
lang
let
----------- ----- ---- --- -- -- - - -
...
...
@@ -302,8 +299,6 @@ run_phase Unlit _basename _suff input_fn output_fn
run_phase
Cpp
_basename
_suff
input_fn
output_fn
=
do
src_opts
<-
getOptionsFromSource
input_fn
-- ToDo: this is *wrong* if we're processing more than one file:
-- the OPTIONS will persist through the subsequent compilations.
_
<-
processArgs
dynamic_flags
src_opts
[]
do_cpp
<-
readState
cpp_flag
...
...
@@ -395,7 +390,7 @@ run_phase MkDependHS basename suff input_fn _output_fn = do
-----------------------------------------------------------------------------
-- Hsc phase
run_phase
Hsc
basename
suff
input_fn
output_fn
run_phase
Hsc
basename
suff
input_fn
output_fn
=
do
-- we add the current directory (i.e. the directory in which
...
...
@@ -441,44 +436,54 @@ run_phase Hsc basename suff input_fn output_fn
-- build a bogus ModSummary to pass to hscMain.
let
summary
=
ModSummary
{
ms_location
=
error
"no loc"
,
ms_ppsource
=
Just
(
loc
,
error
"no fingerprint"
),
ms_ppsource
=
Just
(
input_fn
,
error
"no fingerprint"
),
ms_imports
=
error
"no imports"
}
-- get the DynFlags
dyn_flags
<-
readIORef
v_DynFlags
-- run the compiler!
result
<-
hscMain
dyn_flags
mod_summary
Nothing
{-no iface-}
output_fn
emptyUFM
emptyPCS
pcs
<-
initPersistentCompilerState
result
<-
hscMain
dyn_flags
{
hscOutName
=
output_fn
}
(
error
"no Finder!"
)
summary
Nothing
-- no iface
emptyModuleEnv
-- HomeSymbolTable
emptyModuleEnv
-- HomeIfaceTable
emptyModuleEnv
-- PackageIfaceTable
pcs
case
result
of
{
HscErrs
pcs
errs
warns
->
do
{
printErrorsAndWarnings
errs
warns
throwDyn
(
PhaseFailed
"hsc"
(
ExitFailure
1
))
};
HscOK
details
maybe_iface
maybe_stub_h
maybe_stub_c
pcs
warns
->
do
pprBagOfWarnings
warns
HscFail
pcs
->
throwDyn
(
PhaseFailed
"hsc"
(
ExitFailure
1
));
-- get the module name
HscOK
details
maybe_iface
maybe_stub_h
maybe_stub_c
_maybe_interpreted_code
pcs
->
do
-- generate the interface file
case
iface
of
case
maybe_
iface
of
Nothing
->
-- compilation not required
do
run_something
"Touching object file"
(
"touch "
++
o_file
)
return
False
Just
iface
->
do
-- discover the filename for the .hi file in a roundabout way
let
mod
=
md_id
details
locn
<-
mkHomeModule
mod
basename
input_fn
let
hifile
=
hi_file
locn
-- write out the interface file here...
return
()
let
mod
=
moduleString
(
mi_module
iface
)
ohi
<-
readIORef
output_hi
hifile
<-
case
ohi
of
Just
fn
->
fn
Nothing
->
do
hisuf
<-
readIORef
hi_suf
return
(
current_dir
++
'/'
mod
++
'.'
:
hisuf
)
-- write out the interface...
if_hdl
<-
openFile
hifile
WriteMode
printForIface
if_hdl
(
pprIface
iface
)
hClose
if_hdl
-- deal with stubs
maybe_stub_o
<-
dealWithStubs
basename
maybe_stub_h
maybe_stub_c
case
stub_o
of
case
maybe_
stub_o
of
Nothing
->
return
()
Just
stub_o
->
add
ld_inputs
stub_o
...
...
@@ -531,7 +536,7 @@ run_phase cc_phase _basename _suff input_fn output_fn
verb
<-
is_verbose
o2
<-
readIORef
opt
_minus_o2_for_C
o2
<-
readIORef
v
_minus_o2_for_C
let
opt_flag
|
o2
=
"-O2"
|
otherwise
=
"-O"
...
...
@@ -720,7 +725,7 @@ preprocess filename =
compile
::
Finder
-- to find modules
->
ModSummary
-- summary, including source
->
Maybe
ModI
F
ace
-- old interface, if available
->
Maybe
ModI
f
ace
-- old interface, if available
->
HomeSymbolTable
-- for home module ModDetails
->
PersistentCompilerState
-- persistent compiler state
->
IO
CompResult
...
...
@@ -757,13 +762,13 @@ compile finder summary old_iface hst pcs = do
HscAsm
->
newTempName
(
phaseInputExt
As
)
HscC
->
newTempName
(
phaseInputExt
HCc
)
HscJava
->
newTempName
"java"
-- ToDo
HscInterprete
r
->
return
(
error
"no output file"
)
HscInterprete
d
->
return
(
error
"no output file"
)
-- run the compiler
hsc_result
<-
hscMain
dyn_flags
summary
old_iface
output_fn
hst
pcs
case
hsc_result
of
{
Hsc
Errs
pcs
errs
warns
->
return
(
CompErrs
pcs
errs
warns
);
Hsc
Fail
pcs
->
return
(
CompErrs
pcs
);
HscOK
details
maybe_iface
maybe_stub_h
maybe_stub_c
maybe_interpreted_code
pcs
warns
->
do
...
...
@@ -784,7 +789,7 @@ compile finder summary old_iface hst pcs = do
-- in interpreted mode, just return the compiled code
-- as our "unlinked" object.
HscInterprete
r
->
HscInterprete
d
->
case
maybe_interpreted_code
of
Just
code
->
return
(
Trees
code
)
Nothing
->
panic
"compile: no interpreted code"
...
...
ghc/compiler/main/Finder.lhs
View file @
76c2a7cf
...
...
@@ -118,12 +118,12 @@ mkHomeModuleLocn mod_name basename source_fn = do
ohi <- readIORef output_hi
hisuf <- readIORef hi_suf
let hifile = case ohi of
Nothing -> basename ++ hisuf
Nothing -> basename ++
'.':
hisuf
Just fn -> fn
-- figure out the .o file name. It also lives in the same dir
-- as the source, but can be overriden by a -odir flag.
o_file <- odir_ify (basename ++ '.':phaseInputExt Ln)
o_file <- odir_ify (basename ++ '.':phaseInputExt Ln)
>>= osuf_ify
return (Just (mkHomeModule mod_name,
ModuleLocation{
...
...
ghc/compiler/main/HscMain.lhs
View file @
76c2a7cf
...
...
@@ -4,7 +4,8 @@
\section[GHC_Main]{Main driver for Glasgow Haskell compiler}
\begin{code}
module HscMain ( hscMain ) where
module HscMain ( HscResult(..), hscMain,
initPersistentCompilerState ) where
#include "HsVersions.h"
...
...
ghc/compiler/main/Main.hs
View file @
76c2a7cf
{-# OPTIONS -W -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
-- $Id: Main.hs,v 1.
8
2000/10/2
4
1
6:08:16
simonmar Exp $
-- $Id: Main.hs,v 1.
9
2000/10/2
6
1
4:38:42
simonmar Exp $
--
-- GHC Driver program
--
...
...
@@ -94,7 +94,6 @@ main =
-- install signal handlers
main_thread
<-
myThreadId
#
ifndef
mingw32_TARGET_OS
let
sig_handler
=
Catch
(
throwTo
main_thread
(
DynException
(
toDyn
Interrupted
)))
...
...
@@ -149,6 +148,10 @@ main =
(
flags2
,
mode
,
stop_flag
)
<-
getGhcMode
argv'
writeIORef
v_GhcMode
mode
-- force lang to "C" if the -C flag was given
case
mode
of
StopBefore
HCc
->
writeIORef
hsc_lang
HscC
_
->
return
()
-- process all the other arguments, and get the source files
non_static
<-
processArgs
static_flags
flags2
[]
...
...
@@ -160,6 +163,14 @@ main =
static_opts
<-
buildStaticHscOpts
writeIORef
static_hsc_opts
static_opts
-- warnings
warn_level
<-
readIORef
warning_opt
let
warn_opts
=
case
warn_level
of
W_default
->
standardWarnings
W_
->
minusWOpts
W_all
->
minusWallOpts
W_not
->
[]
-- build the default DynFlags (these may be adjusted on a per
-- module basis by OPTIONS pragmas and settings in the interpreter).
...
...
@@ -174,14 +185,6 @@ main =
-- leave out hscOutName for now
flags
=
[]
}
-- warnings
warn_level
<-
readIORef
warning_opt
let
warn_opts
=
case
warn_level
of
W_default
->
standardWarnings
W_
->
minusWOpts
W_all
->
minusWallOpts
W_not
->
[]
-- the rest of the arguments are "dynamic"
srcs
<-
processArgs
dynamic_flags
non_static
[]
-- save the "initial DynFlags" away
...
...
ghc/compiler/main/MkIface.lhs
View file @
76c2a7cf
...
...
@@ -5,7 +5,8 @@
\begin{code}
module MkIface (
mkModDetails, mkModDetailsFromIface, completeIface, writeIface
mkModDetails, mkModDetailsFromIface, completeIface,
writeIface, pprIface
) where
#include "HsVersions.h"
...
...
@@ -266,7 +267,7 @@ ifaceTyCls (AnId id)
%* *
%************************************************************************
\begin{code}
\begin{code}
ifaceInstance :: DFunId -> RenamedInstDecl
ifaceInstance dfun_id
= InstDecl (toHsType tidy_ty) EmptyMonoBinds [] (Just (getName dfun_id)) noSrcLoc
...
...
@@ -621,6 +622,7 @@ writeIface finder (Just mod_iface)
where
mod_name = moduleName (mi_module mod_iface)
pprIface :: ModIface -> SDoc
pprIface iface
= vcat [ ptext SLIT("__interface")
<+> doubleQuotes (ptext opt_InPackage)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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