Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
5427df8f
Commit
5427df8f
authored
Jan 11, 2013
by
tibbe
Browse files
Merge branch 'master' of
https://github.com/ghc/ghc
parents
bab8dc79
acb0cd94
Changes
14
Hide whitespace changes
Inline
Side-by-side
compiler/main/DriverPhases.hs
View file @
5427df8f
...
...
@@ -35,6 +35,7 @@ module DriverPhases (
#
include
"HsVersions.h"
import
{-#
SOURCE
#-
}
DynFlags
import
Outputable
import
Platform
import
System.FilePath
...
...
@@ -131,33 +132,39 @@ eqPhase _ _ = False
-- Partial ordering on phases: we want to know which phases will occur before
-- which others. This is used for sanity checking, to ensure that the
-- pipeline will stop at some point (see DriverPipeline.runPipeline).
happensBefore
::
Phase
->
Phase
->
Bool
StopLn
`
happensBefore
`
_
=
False
x
`
happensBefore
`
y
=
after_x
`
eqPhase
`
y
||
after_x
`
happensBefore
`
y
where
after_x
=
nextPhase
x
happensBefore
::
DynFlags
->
Phase
->
Phase
->
Bool
happensBefore
dflags
p1
p2
=
p1
`
happensBefore'
`
p2
where
StopLn
`
happensBefore'
`
_
=
False
x
`
happensBefore'
`
y
=
after_x
`
eqPhase
`
y
||
after_x
`
happensBefore'
`
y
where
after_x
=
nextPhase
dflags
x
nextPhase
::
Phase
->
Phase
-- A conservative approximation to the next phase, used in happensBefore
nextPhase
(
Unlit
sf
)
=
Cpp
sf
nextPhase
(
Cpp
sf
)
=
HsPp
sf
nextPhase
(
HsPp
sf
)
=
Hsc
sf
nextPhase
(
Hsc
_
)
=
HCc
nextPhase
Splitter
=
SplitAs
nextPhase
LlvmOpt
=
LlvmLlc
nextPhase
LlvmLlc
=
LlvmMangle
nextPhase
LlvmMangle
=
As
nextPhase
SplitAs
=
MergeStub
nextPhase
As
=
MergeStub
nextPhase
Ccpp
=
As
nextPhase
Cc
=
As
nextPhase
Cobjc
=
As
nextPhase
Cobjcpp
=
As
nextPhase
CmmCpp
=
Cmm
nextPhase
Cmm
=
HCc
nextPhase
HCc
=
As
nextPhase
MergeStub
=
StopLn
nextPhase
StopLn
=
panic
"nextPhase: nothing after StopLn"
nextPhase
::
DynFlags
->
Phase
->
Phase
nextPhase
dflags
p
-- A conservative approximation to the next phase, used in happensBefore
=
case
p
of
Unlit
sf
->
Cpp
sf
Cpp
sf
->
HsPp
sf
HsPp
sf
->
Hsc
sf
Hsc
_
->
maybeHCc
Splitter
->
SplitAs
LlvmOpt
->
LlvmLlc
LlvmLlc
->
LlvmMangle
LlvmMangle
->
As
SplitAs
->
MergeStub
As
->
MergeStub
Ccpp
->
As
Cc
->
As
Cobjc
->
As
Cobjcpp
->
As
CmmCpp
->
Cmm
Cmm
->
maybeHCc
HCc
->
As
MergeStub
->
StopLn
StopLn
->
panic
"nextPhase: nothing after StopLn"
where
maybeHCc
=
if
platformUnregisterised
(
targetPlatform
dflags
)
then
HCc
else
As
-- the first compilation phase for a given file is determined
-- by its suffix.
...
...
compiler/main/DriverPipeline.hs
View file @
5427df8f
...
...
@@ -503,70 +503,96 @@ runPipeline
->
IO
(
DynFlags
,
FilePath
)
-- ^ (final flags, output filename)
runPipeline
stop_phase
hsc_env0
(
input_fn
,
mb_phase
)
mb_basename
output
maybe_loc
maybe_stub_o
=
do
r
<-
runPipeline'
stop_phase
hsc_env0
(
input_fn
,
mb_phase
)
mb_basename
output
maybe_loc
maybe_stub_o
let
dflags
=
extractDynFlags
hsc_env0
whenCannotGenerateDynamicToo
dflags
$
do
=
do
let
dflags0
=
hsc_dflags
hsc_env0
-- Decide where dump files should go based on the pipeline output
dflags
=
dflags0
{
dumpPrefix
=
Just
(
basename
++
"."
)
}
hsc_env
=
hsc_env0
{
hsc_dflags
=
dflags
}
(
input_basename
,
suffix
)
=
splitExtension
input_fn
suffix'
=
drop
1
suffix
-- strip off the .
basename
|
Just
b
<-
mb_basename
=
b
|
otherwise
=
input_basename
-- If we were given a -x flag, then use that phase to start from
start_phase
=
fromMaybe
(
startPhase
suffix'
)
mb_phase
isHaskell
(
Unlit
_
)
=
True
isHaskell
(
Cpp
_
)
=
True
isHaskell
(
HsPp
_
)
=
True
isHaskell
(
Hsc
_
)
=
True
isHaskell
_
=
False
isHaskellishFile
=
isHaskell
start_phase
env
=
PipeEnv
{
pe_isHaskellishFile
=
isHaskellishFile
,
stop_phase
,
src_basename
=
basename
,
src_suffix
=
suffix'
,
output_spec
=
output
}
-- We want to catch cases of "you can't get there from here" before
-- we start the pipeline, because otherwise it will just run off the
-- end.
--
-- There is a partial ordering on phases, where A < B iff A occurs
-- before B in a normal compilation pipeline.
let
happensBefore'
=
happensBefore
dflags
when
(
not
(
start_phase
`
happensBefore'
`
stop_phase
))
$
throwGhcException
(
UsageError
(
"cannot compile this file to desired target: "
++
input_fn
))
debugTraceMsg
dflags
4
(
text
"Running the pipeline"
)
r
<-
runPipeline'
start_phase
stop_phase
hsc_env
env
input_fn
output
maybe_loc
maybe_stub_o
-- If we are compiling a Haskell module, and doing
-- -dynamic-too, but couldn't do the -dynamic-too fast
-- path, then rerun the pipeline for the dyn way
let
dflags
=
extractDynFlags
hsc_env
when
isHaskellishFile
$
whenCannotGenerateDynamicToo
dflags
$
do
debugTraceMsg
dflags
4
(
text
"Running the pipeline again for -dynamic-too"
)
let
dflags'
=
doDynamicToo
dflags
hsc_env1
<-
newHscEnv
dflags'
_
<-
runPipeline'
stop_phase
hsc_env1
(
input_fn
,
mb_phase
)
mb_basename
output
maybe_loc
maybe_stub_o
-- TODO: This should use -dyno
output'
=
case
output
of
SpecificFile
fn
->
SpecificFile
(
replaceExtension
fn
(
objectSuf
dflags'
))
Persistent
->
Persistent
Temporary
->
Temporary
hsc_env'
<-
newHscEnv
dflags'
_
<-
runPipeline'
start_phase
stop_phase
hsc_env'
env
input_fn
output'
maybe_loc
maybe_stub_o
return
()
return
r
runPipeline'
::
Phase
-- ^ When to stop
::
Phase
-- ^ When to start
->
Phase
-- ^ When to stop
->
HscEnv
-- ^ Compilation environment
->
(
FilePath
,
Maybe
Phase
)
-- ^ Input filename (and maybe -x suffix)
->
Maybe
FilePath
-- ^ original basename (if different from ^^^)
->
PipeEnv
->
FilePath
-- ^ Input filename
->
PipelineOutput
-- ^ Output filename
->
Maybe
ModLocation
-- ^ A ModLocation, if this is a Haskell module
->
Maybe
FilePath
-- ^ stub object, if we have one
->
IO
(
DynFlags
,
FilePath
)
-- ^ (final flags, output filename)
runPipeline'
stop_phase
hsc_env
0
(
input_fn
,
mb_phase
)
mb_basename
output
maybe_loc
maybe_stub_o
->
IO
(
DynFlags
,
FilePath
)
-- ^ (final flags, output filename)
runPipeline'
start_phase
stop_phase
hsc_env
env
input_fn
output
maybe_loc
maybe_stub_o
=
do
let
dflags0
=
hsc_dflags
hsc_env0
(
input_basename
,
suffix
)
=
splitExtension
input_fn
suffix'
=
drop
1
suffix
-- strip off the .
basename
|
Just
b
<-
mb_basename
=
b
|
otherwise
=
input_basename
-- Decide where dump files should go based on the pipeline output
dflags
=
dflags0
{
dumpPrefix
=
Just
(
basename
++
"."
)
}
hsc_env
=
hsc_env0
{
hsc_dflags
=
dflags
}
-- If we were given a -x flag, then use that phase to start from
start_phase
=
fromMaybe
(
startPhase
suffix'
)
mb_phase
-- We want to catch cases of "you can't get there from here" before
-- we start the pipeline, because otherwise it will just run off the
-- end.
--
-- There is a partial ordering on phases, where A < B iff A occurs
-- before B in a normal compilation pipeline.
when
(
not
(
start_phase
`
happensBefore
`
stop_phase
))
$
throwGhcException
(
UsageError
(
"cannot compile this file to desired target: "
++
input_fn
))
-- this is a function which will be used to calculate output file names
-- as we go along (we partially apply it to some of its inputs here)
let
get_output_fn
=
getOutputFilename
stop_phase
output
basename
let
get_output_fn
=
getOutputFilename
stop_phase
output
(
src_
basename
env
)
-- Execute the pipeline...
let
env
=
PipeEnv
{
stop_phase
,
src_basename
=
basename
,
src_suffix
=
suffix'
,
output_spec
=
output
}
state
=
PipeState
{
hsc_env
,
maybe_loc
,
maybe_stub_o
=
maybe_stub_o
}
let
state
=
PipeState
{
hsc_env
,
maybe_loc
,
maybe_stub_o
=
maybe_stub_o
}
(
state'
,
output_fn
)
<-
unP
(
pipeLoop
start_phase
input_fn
)
env
state
let
PipeState
{
hsc_env
=
hsc_env'
,
maybe_loc
}
=
state'
dflags
'
=
hsc_dflags
hsc_env'
dflags
=
hsc_dflags
hsc_env'
-- Sometimes, a compilation phase doesn't actually generate any output
-- (eg. the CPP phase when -fcpp is not turned on). If we end on this
...
...
@@ -575,20 +601,21 @@ runPipeline' stop_phase hsc_env0 (input_fn, mb_phase)
-- further compilation stages can tell what the original filename was.
case
output
of
Temporary
->
return
(
dflags
'
,
output_fn
)
_
other
->
do
final_fn
<-
get_output_fn
dflags
'
stop_phase
maybe_loc
return
(
dflags
,
output_fn
)
_
->
do
final_fn
<-
get_output_fn
dflags
stop_phase
maybe_loc
when
(
final_fn
/=
output_fn
)
$
do
let
msg
=
(
"Copying `"
++
output_fn
++
"' to `"
++
final_fn
++
"'"
)
line_prag
=
Just
(
"{-# LINE 1
\"
"
++
input_fn
++
"
\"
#-}
\n
"
)
copyWithHeader
dflags
msg
line_prag
output_fn
final_fn
return
(
dflags
'
,
final_fn
)
return
(
dflags
,
final_fn
)
-- -----------------------------------------------------------------------------
-- The pipeline uses a monad to carry around various bits of information
-- PipeEnv: invariant information passed down
data
PipeEnv
=
PipeEnv
{
pe_isHaskellishFile
::
Bool
,
stop_phase
::
Phase
,
-- ^ Stop just before this phase
src_basename
::
String
,
-- ^ basename of original input source
src_suffix
::
String
,
-- ^ its extension
...
...
@@ -656,12 +683,13 @@ phaseOutputFilename next_phase = do
pipeLoop
::
Phase
->
FilePath
->
CompPipeline
FilePath
pipeLoop
phase
input_fn
=
do
PipeEnv
{
stop_phase
}
<-
getPipeEnv
PipeState
{
hsc_env
}
<-
getPipeState
dflags
<-
getDynFlags
let
happensBefore'
=
happensBefore
dflags
case
()
of
_
|
phase
`
eqPhase
`
stop_phase
-- All done
->
return
input_fn
|
not
(
phase
`
happensBefore
`
stop_phase
)
|
not
(
phase
`
happensBefore
'
`
stop_phase
)
-- Something has gone wrong. We'll try to cover all the cases when
-- this could happen, so if we reach here it is a panic.
-- eg. it might happen if the -C flag is used on a source file that
...
...
@@ -670,9 +698,8 @@ pipeLoop phase input_fn = do
" but I wanted to stop at phase "
++
show
stop_phase
)
|
otherwise
->
do
liftIO
$
debugTraceMsg
(
hsc_
dflags
hsc_env
)
4
->
do
liftIO
$
debugTraceMsg
dflags
4
(
ptext
(
sLit
"Running phase"
)
<+>
ppr
phase
)
dflags
<-
getDynFlags
(
next_phase
,
output_fn
)
<-
runPhase
phase
input_fn
dflags
pipeLoop
next_phase
output_fn
...
...
compiler/main/DynFlags.hs
View file @
5427df8f
...
...
@@ -594,6 +594,7 @@ data DynFlags = DynFlags {
dynHiSuf
::
String
,
outputFile
::
Maybe
String
,
dynOutputFile
::
Maybe
String
,
outputHi
::
Maybe
String
,
dynLibLoader
::
DynLibLoader
,
...
...
@@ -1148,6 +1149,7 @@ doDynamicToo :: DynFlags -> DynFlags
doDynamicToo
dflags0
=
let
dflags1
=
unSetGeneralFlag'
Opt_Static
dflags0
dflags2
=
addWay'
WayDyn
dflags1
dflags3
=
dflags2
{
outputFile
=
dynOutputFile
dflags2
,
hiSuf
=
dynHiSuf
dflags2
,
objectSuf
=
dynObjectSuf
dflags2
}
...
...
@@ -1226,6 +1228,7 @@ defaultDynFlags mySettings =
pluginModNameOpts
=
[]
,
outputFile
=
Nothing
,
dynOutputFile
=
Nothing
,
outputHi
=
Nothing
,
dynLibLoader
=
SystemDependent
,
dumpPrefix
=
Nothing
,
...
...
@@ -1598,7 +1601,7 @@ setObjectDir, setHiDir, setStubDir, setDumpDir, setOutputDir,
addCmdlineFramework
,
addHaddockOpts
,
addGhciScript
,
setInteractivePrint
::
String
->
DynFlags
->
DynFlags
setOutputFile
,
setOutputHi
,
setDumpPrefixForce
setOutputFile
,
setDynOutputFile
,
setOutputHi
,
setDumpPrefixForce
::
Maybe
String
->
DynFlags
->
DynFlags
setObjectDir
f
d
=
d
{
objectDir
=
Just
f
}
...
...
@@ -1618,6 +1621,7 @@ setDynHiSuf f d = d{ dynHiSuf = f}
setHcSuf
f
d
=
d
{
hcSuf
=
f
}
setOutputFile
f
d
=
d
{
outputFile
=
f
}
setDynOutputFile
f
d
=
d
{
dynOutputFile
=
f
}
setOutputHi
f
d
=
d
{
outputHi
=
f
}
addPluginModuleName
::
String
->
DynFlags
->
DynFlags
...
...
@@ -1800,11 +1804,31 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
throwGhcException
(
CmdLineError
(
"combination not supported: "
++
intercalate
"/"
(
map
wayDesc
theWays
)))
let
(
dflags4
,
consistency_warnings
)
=
makeDynFlagsConsistent
dflags3
-- TODO: This is an ugly hack. Do something better.
-- -fPIC affects the CMM code we generate, so if
-- we are in -dynamic-too mode we need -fPIC to be on during the
-- shared part of the compilation.
let
doingDynamicToo
=
gopt
Opt_BuildDynamicToo
dflags3
platform
=
targetPlatform
dflags3
dflags4
=
if
doingDynamicToo
then
foldr
setGeneralFlag'
dflags3
(
wayGeneralFlags
platform
WayDyn
)
else
dflags3
liftIO
$
setUnsafeGlobalDynFlags
dflags4
{-
TODO: This test doesn't quite work: We don't want to give an error
when e.g. compiling a C file, only when compiling Haskell files.
when doingDynamicToo $
unless (isJust (outputFile dflags4) == isJust (dynOutputFile dflags4)) $
throwGhcException $ CmdLineError
"With -dynamic-too, must give -dyno iff giving -o"
-}
return
(
dflags4
,
leftover
,
consistency_warnings
++
sh_warns
++
warns
)
let
(
dflags5
,
consistency_warnings
)
=
makeDynFlagsConsistent
dflags4
liftIO
$
setUnsafeGlobalDynFlags
dflags5
return
(
dflags5
,
leftover
,
consistency_warnings
++
sh_warns
++
warns
)
updateWays
::
DynFlags
->
DynFlags
updateWays
dflags
...
...
@@ -1996,6 +2020,7 @@ dynamic_flags = [
------- Output Redirection ------------------------------------------
,
Flag
"odir"
(
hasArg
setObjectDir
)
,
Flag
"o"
(
sepArg
(
setOutputFile
.
Just
))
,
Flag
"dyno"
(
sepArg
(
setDynOutputFile
.
Just
))
,
Flag
"ohi"
(
hasArg
(
setOutputHi
.
Just
))
,
Flag
"osuf"
(
hasArg
setObjectSuf
)
,
Flag
"dynosuf"
(
hasArg
setDynObjectSuf
)
...
...
compiler/main/GhcMake.hs
View file @
5427df8f
...
...
@@ -709,9 +709,9 @@ upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
prevailing_target
=
hscTarget
(
hsc_dflags
hsc_env
)
local_target
=
hscTarget
dflags
-- If OPTIONS_GHC contains -fasm or -f
via-C
, be careful that
-- If OPTIONS_GHC contains -fasm or -f
llvm
, be careful that
-- we don't do anything dodgy: these should only work to change
-- from -f
via-C
to -fasm and vice-versa, otherwise we could
-- from -f
llvm
to -fasm and vice-versa, otherwise we could
-- end up trying to link object code to byte code.
target
=
if
prevailing_target
/=
local_target
&&
(
not
(
isObjectTarget
prevailing_target
)
...
...
compiler/nativeGen/SPARC/Base.hs
View file @
5427df8f
-- | Bits and pieces on the bottom of the module dependency tree.
-- Also import the required constants, so we know what we're using.
--
-- In the interests of cross-compilation, we want to free ourselves
-- from the autoconf generated modules like main/Constants
-- Also import the required constants, so we know what we're using.
--
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
-- In the interests of cross-compilation, we want to free ourselves
-- from the autoconf generated modules like main/Constants
module
SPARC.Base
(
wordLength
,
wordLengthInBits
,
spillAreaLength
,
spillSlotSize
,
extraStackArgsHere
,
fits13Bits
,
is32BitInteger
,
largeOffsetError
wordLength
,
wordLengthInBits
,
spillAreaLength
,
spillSlotSize
,
extraStackArgsHere
,
fits13Bits
,
is32BitInteger
,
largeOffsetError
)
where
...
...
@@ -36,13 +29,13 @@ wordLength :: Int
wordLength
=
4
wordLengthInBits
::
Int
wordLengthInBits
=
wordLength
*
8
wordLengthInBits
=
wordLength
*
8
-- Size of the available spill area
spillAreaLength
::
DynFlags
->
Int
spillAreaLength
=
rESERVED_C_STACK_BYTES
=
rESERVED_C_STACK_BYTES
-- | We need 8 bytes because our largest registers are 64 bit.
spillSlotSize
::
Int
...
...
@@ -50,7 +43,7 @@ spillSlotSize = 8
-- | We (allegedly) put the first six C-call arguments in registers;
--
where do we start putting the rest of them?
--
where do we start putting the rest of them?
extraStackArgsHere
::
Int
extraStackArgsHere
=
23
...
...
@@ -61,22 +54,22 @@ fits13Bits :: Integral a => a -> Bool
fits13Bits
x
=
x
>=
-
4096
&&
x
<
4096
-- | Check whether an integer will fit in 32 bits.
--
A CmmInt is intended to be truncated to the appropriate
--
number of bits, so here we truncate it to Int64. This is
--
important because e.g. -1 as a CmmInt might be either
--
-1 or 18446744073709551615.
--
A CmmInt is intended to be truncated to the appropriate
--
number of bits, so here we truncate it to Int64. This is
--
important because e.g. -1 as a CmmInt might be either
--
-1 or 18446744073709551615.
--
is32BitInteger
::
Integer
->
Bool
is32BitInteger
i
=
i64
<=
0x7fffffff
&&
i64
>=
-
0x80000000
where
i64
=
fromIntegral
i
::
Int64
is32BitInteger
i
=
i64
<=
0x7fffffff
&&
i64
>=
-
0x80000000
where
i64
=
fromIntegral
i
::
Int64
-- | Sadness.
largeOffsetError
::
(
Integral
a
,
Show
a
)
=>
a
->
b
largeOffsetError
i
=
panic
(
"ERROR: SPARC native-code generator cannot handle large offset ("
++
show
i
++
");
\n
probably because of large constant data structures;"
++
"
\n
workaround: use -f
via-C
on this module.
\n
"
)
++
show
i
++
");
\n
probably because of large constant data structures;"
++
"
\n
workaround: use -f
llvm
on this module.
\n
"
)
compiler/typecheck/TcForeign.lhs
View file @
5427df8f
...
...
@@ -255,7 +255,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety mh (CFunction ta
dflags <- getDynFlags
check (xopt Opt_GHCForeignImportPrim dflags)
(text "Use -XGHCForeignImportPrim to allow `foreign import prim'.")
checkCg
(
checkCOrAsmOrLlvmOr
DotNetOr
Interp
)
checkCg checkCOrAsmOrLlvmOrInterp
checkCTarget target
check (playSafe safety)
(text "The safe/unsafe annotation should not be used with `foreign import prim'.")
...
...
@@ -264,7 +264,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety mh (CFunction ta
checkForeignRes nonIOok checkSafe (isFFIPrimResultTy dflags) res_ty
return idecl
| otherwise = do -- Normal foreign import
checkCg checkCOrAsmOrLlvmOr
DotNetOr
Interp
checkCg checkCOrAsmOrLlvmOrInterp
cconv' <- checkCConv cconv
checkCTarget target
dflags <- getDynFlags
...
...
@@ -283,7 +283,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety mh (CFunction ta
-- that the C identifier is valid for C
checkCTarget :: CCallTarget -> TcM ()
checkCTarget (StaticTarget str _ _) = do
checkCg checkCOrAsmOrLlvmOr
DotNetOr
Interp
checkCg checkCOrAsmOrLlvmOrInterp
check (isCLabelString str) (badCName str)
checkCTarget DynamicTarget = panic "checkCTarget DynamicTarget"
...
...
@@ -427,7 +427,7 @@ checkCOrAsmOrLlvm HscC = Nothing
checkCOrAsmOrLlvm HscAsm = Nothing
checkCOrAsmOrLlvm HscLlvm = Nothing
checkCOrAsmOrLlvm _
= Just (text "requires
via-C
, llvm (-fllvm) or native code generation (-f
via-C
)")
= Just (text "requires
unregisterised
, llvm (-fllvm) or native code generation (-f
asm
)")
checkCOrAsmOrLlvmOrInterp :: HscTarget -> Maybe SDoc
checkCOrAsmOrLlvmOrInterp HscC = Nothing
...
...
@@ -435,15 +435,7 @@ checkCOrAsmOrLlvmOrInterp HscAsm = Nothing
checkCOrAsmOrLlvmOrInterp HscLlvm = Nothing
checkCOrAsmOrLlvmOrInterp HscInterpreted = Nothing
checkCOrAsmOrLlvmOrInterp _
= Just (text "requires interpreted, C, Llvm or native code generation")
checkCOrAsmOrLlvmOrDotNetOrInterp :: HscTarget -> Maybe SDoc
checkCOrAsmOrLlvmOrDotNetOrInterp HscC = Nothing
checkCOrAsmOrLlvmOrDotNetOrInterp HscAsm = Nothing
checkCOrAsmOrLlvmOrDotNetOrInterp HscLlvm = Nothing
checkCOrAsmOrLlvmOrDotNetOrInterp HscInterpreted = Nothing
checkCOrAsmOrLlvmOrDotNetOrInterp _
= Just (text "requires interpreted, C, Llvm or native code generation")
= Just (text "requires interpreted, unregisterised, llvm or native code generation")
checkCg :: (HscTarget -> Maybe SDoc) -> TcM ()
checkCg check = do
...
...
ghc/Main.hs
View file @
5427df8f
...
...
@@ -545,7 +545,7 @@ mode_flags =
addFlag
"-no-link"
f
))
,
Flag
"M"
(
PassFlag
(
setMode
doMkDependHSMode
))
,
Flag
"E"
(
PassFlag
(
setMode
(
stopBeforeMode
anyHsc
)))
,
Flag
"C"
(
PassFlag
set
GenerateC
)
,
Flag
"C"
(
PassFlag
(
set
Mode
(
stopBeforeMode
HCc
))
)
,
Flag
"S"
(
PassFlag
(
setMode
(
stopBeforeMode
As
)))
,
Flag
"-make"
(
PassFlag
(
setMode
doMakeMode
))
,
Flag
"-interactive"
(
PassFlag
(
setMode
doInteractiveMode
))
...
...
@@ -553,14 +553,6 @@ mode_flags =
,
Flag
"e"
(
SepArg
(
\
s
->
setMode
(
doEvalMode
s
)
"-e"
))
]
setGenerateC
::
String
->
EwM
ModeM
()
setGenerateC
f
=
do
-- TODO: We used to warn and ignore when
-- unregisterised, but we no longer know whether
-- we are unregisterised at this point. Should
-- we check later on?
setMode
(
stopBeforeMode
HCc
)
f
addFlag
"-fvia-C"
f
setMode
::
Mode
->
String
->
EwM
ModeM
()
setMode
newMode
newFlag
=
liftEwM
$
do
(
mModeFlag
,
errs
,
flags'
)
<-
getCmdLineState
...
...
bytestring
@
aaf84424
Subproject commit
6bd69fe27af33e878e38f4c579983f6a23120a87
Subproject commit
aaf84424aee2bac53b5121115b95ae47bcce17a2
terminfo
@
116d3ee6
Subproject commit
579d2c324e69856ff8d1ea8b5036e30c920e1973
Subproject commit
116d3ee6840d52bab69c880d775ae290a20d64bc
mk/config.mk.in
View file @
5427df8f
...
...
@@ -233,6 +233,8 @@ include $(TOP)/mk/install.mk
# portable as possible.
BeConservative
=
NO
ExtraMakefileSanityChecks
=
NO
#
# Building various ways?
# (right now, empty if not).
...
...
rules/build-package-way.mk
View file @
5427df8f
...
...
@@ -17,8 +17,6 @@ $(call profStart, build-package-way($1,$2,$3))
$(call
distdir-way-opts,$1,$2,$3,$4)
$(call
hs-suffix-rules,$1,$2,$3)
$$(foreach
dir,$$($1_$2_HS_SRC_DIRS),\
$$(eval
$$(call
hs-suffix-rules-srcdir,$1,$2,$3,$$(dir))))
$(call
hs-objs,$1,$2,$3)
...
...
rules/build-prog.mk
View file @
5427df8f
...
...
@@ -155,8 +155,6 @@ endif
endif
$(call
hs-suffix-rules,$1,$2,$$($1_$2_PROGRAM_WAY))
$$(foreach
dir,$$($1_$2_HS_SRC_DIRS),\
$$(eval
$$(call
hs-suffix-rules-srcdir,$1,$2,$$($1_$2_PROGRAM_WAY),$$(dir))))
$(call
c-objs,$1,$2,$$($1_$2_PROGRAM_WAY))
$(call
hs-objs,$1,$2,$$($1_$2_PROGRAM_WAY))
...
...
rules/hi-rule.mk
View file @
5427df8f
...
...
@@ -32,11 +32,13 @@
# exit 1; \
# fi
#
# This version adds a useful sanity check, and is a good solution on
# platforms other than Windows. But on Windows it is expensive, as
# spawning a shell takes a while (about 0.3s). We'd like to avoid the
# shell if necessary. This also hides the message "nothing to be done
# for 'all'", since make thinks it has actually done something.
# This version adds a useful sanity check, and is a good solution,
# except that it means spawning a shell. This can be expensive,
# especially on Windows where spawning a shell takes about 0.3s.
# We'd like to avoid the shell if necessary. This also hides the
# message "nothing to be done for 'all'", since make thinks it has
# actually done something. Therefore we only use this version
# if ExtraMakefileSanityChecks is enabled.
#
# %.hi : %.o
#
...
...
@@ -61,6 +63,13 @@
# the ';' at the end signifies an "empty command" (see the GNU make
# documentation). An empty command is enough to get GNU make to think
# it has updated %.hi, but without actually spawning a shell to do so.
#
# However, given that rule, make thinks that it can make .hi files
# for any object file, even if the object file was created from e.g.
# a C source file. We therefore also add a dependency on the .hs/.lhs
# source file, which means we finally end up with rules like:
#
# a/%.hi : a/%.o b/%.hs ;
define
hi-rule
# $1 = source directory, $2 = object directory, $3 = way
...
...
@@ -72,7 +81,7 @@ $(call hi-rule-helper,$2/%.$$($3_way_)hi-boot : $2/%.$$($3_way_)o-boot $1/%.lhs)
endef
ifeq
"$(
TargetOS_CPP)" "mingw32
"
ifeq
"$(
ExtraMakefileSanityChecks)" "NO
"
define
hi-rule-helper
# $1 = rule header
$1
;
...
...
rules/hs-suffix-rules.mk
View file @
5427df8f
...
...
@@ -34,5 +34,8 @@ $(call hi-rule,$1/$2/build/autogen,$1/$2/build,$3)
endif
endif
$$(foreach
dir,$$($1_$2_HS_SRC_DIRS),\