Skip to content
GitLab
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
b25d7090
Commit
b25d7090
authored
Dec 05, 2012
by
ian@well-typed.com
Browse files
Add the beginnings of support for building vanilla and dynamic at the same time
parent
71b5ca5a
Changes
2
Hide whitespace changes
Inline
Side-by-side
compiler/iface/LoadIface.lhs
View file @
b25d7090
...
...
@@ -61,6 +61,8 @@ import FastString
import Fingerprint
import Control.Monad
import Data.IORef
import System.FilePath
\end{code}
...
...
@@ -515,7 +517,9 @@ findAndReadIface doc_str mod hi_boot_file
if thisPackage dflags == modulePackageId mod &&
not (isOneShot (ghcMode dflags))
then return (Failed (homeModError mod loc))
else read_file file_path
else do r <- read_file file_path
checkBuildDynamicToo r
return r
err -> do
traceIf (ptext (sLit "...not found"))
dflags <- getDynFlags
...
...
@@ -532,6 +536,21 @@ findAndReadIface doc_str mod hi_boot_file
| otherwise ->
return (Succeeded (iface, file_path))
-- Don't forget to fill in the package name...
checkBuildDynamicToo (Succeeded (iface, filePath)) = do
dflags <- getDynFlags
when (gopt Opt_BuildDynamicToo dflags) $ do
let ref = canGenerateDynamicToo dflags
b <- liftIO $ readIORef ref
when b $ do
let dynFilePath = replaceExtension filePath (dynHiSuf dflags)
r <- read_file dynFilePath
case r of
Succeeded (dynIface, _)
| mi_mod_hash iface == mi_mod_hash dynIface ->
return ()
_ ->
liftIO $ writeIORef ref False
checkBuildDynamicToo _ = return ()
\end{code}
@readIface@ tries just the one file.
...
...
compiler/main/DynFlags.hs
View file @
b25d7090
...
...
@@ -371,6 +371,8 @@ data GeneralFlag
|
Opt_KeepRawTokenStream
|
Opt_KeepLlvmFiles
|
Opt_BuildDynamicToo
-- safe haskell flags
|
Opt_DistrustAllPackages
|
Opt_PackageTrust
...
...
@@ -576,6 +578,10 @@ data DynFlags = DynFlags {
hcSuf
::
String
,
hiSuf
::
String
,
canGenerateDynamicToo
::
IORef
Bool
,
dynObjectSuf
::
String
,
dynHiSuf
::
String
,
outputFile
::
Maybe
String
,
outputHi
::
Maybe
String
,
dynLibLoader
::
DynLibLoader
,
...
...
@@ -1108,6 +1114,7 @@ wayOptP _ WayNDP = []
-- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value
initDynFlags
::
DynFlags
->
IO
DynFlags
initDynFlags
dflags
=
do
refCanGenerateDynamicToo
<-
newIORef
False
refFilesToClean
<-
newIORef
[]
refDirsToClean
<-
newIORef
Map
.
empty
refFilesToNotIntermediateClean
<-
newIORef
[]
...
...
@@ -1115,6 +1122,7 @@ initDynFlags dflags = do
refLlvmVersion
<-
newIORef
28
wrapperNum
<-
newIORef
0
return
dflags
{
canGenerateDynamicToo
=
refCanGenerateDynamicToo
,
filesToClean
=
refFilesToClean
,
dirsToClean
=
refDirsToClean
,
filesToNotIntermediateClean
=
refFilesToNotIntermediateClean
,
...
...
@@ -1165,6 +1173,10 @@ defaultDynFlags mySettings =
hcSuf
=
phaseInputExt
HCc
,
hiSuf
=
"hi"
,
canGenerateDynamicToo
=
panic
"defaultDynFlags: No canGenerateDynamicToo"
,
dynObjectSuf
=
"dyn_"
++
phaseInputExt
StopLn
,
dynHiSuf
=
"dyn_hi"
,
pluginModNames
=
[]
,
pluginModNameOpts
=
[]
,
...
...
@@ -1533,6 +1545,7 @@ getVerbFlags dflags
|
otherwise
=
[]
setObjectDir
,
setHiDir
,
setStubDir
,
setDumpDir
,
setOutputDir
,
setDynObjectSuf
,
setDynHiSuf
,
setDylibInstallName
,
setObjectSuf
,
setHiSuf
,
setHcSuf
,
parseDynLibLoaderMode
,
setPgmP
,
addOptl
,
addOptc
,
addOptP
,
...
...
@@ -1552,9 +1565,11 @@ setDumpDir f d = d{ dumpDir = Just f}
setOutputDir
f
=
setObjectDir
f
.
setHiDir
f
.
setStubDir
f
.
setDumpDir
f
setDylibInstallName
f
d
=
d
{
dylibInstallName
=
Just
f
}
setObjectSuf
f
d
=
d
{
objectSuf
=
f
}
setHiSuf
f
d
=
d
{
hiSuf
=
f
}
setHcSuf
f
d
=
d
{
hcSuf
=
f
}
setObjectSuf
f
d
=
d
{
objectSuf
=
f
}
setDynObjectSuf
f
d
=
d
{
dynObjectSuf
=
f
}
setHiSuf
f
d
=
d
{
hiSuf
=
f
}
setDynHiSuf
f
d
=
d
{
dynHiSuf
=
f
}
setHcSuf
f
d
=
d
{
hcSuf
=
f
}
setOutputFile
f
d
=
d
{
outputFile
=
f
}
setOutputHi
f
d
=
d
{
outputHi
=
f
}
...
...
@@ -1934,8 +1949,10 @@ dynamic_flags = [
,
Flag
"o"
(
sepArg
(
setOutputFile
.
Just
))
,
Flag
"ohi"
(
hasArg
(
setOutputHi
.
Just
))
,
Flag
"osuf"
(
hasArg
setObjectSuf
)
,
Flag
"dynosuf"
(
hasArg
setDynObjectSuf
)
,
Flag
"hcsuf"
(
hasArg
setHcSuf
)
,
Flag
"hisuf"
(
hasArg
setHiSuf
)
,
Flag
"dynhisuf"
(
hasArg
setDynHiSuf
)
,
Flag
"hidir"
(
hasArg
setHiDir
)
,
Flag
"tmpdir"
(
hasArg
setTmpDir
)
,
Flag
"stubdir"
(
hasArg
setStubDir
)
...
...
@@ -1943,6 +1960,8 @@ dynamic_flags = [
,
Flag
"outputdir"
(
hasArg
setOutputDir
)
,
Flag
"ddump-file-prefix"
(
hasArg
(
setDumpPrefixForce
.
Just
))
,
Flag
"dynamic-too"
(
NoArg
(
setGeneralFlag
Opt_BuildDynamicToo
))
------- Keeping temporary files -------------------------------------
-- These can be singular (think ghc -c) or plural (think ghc --make)
,
Flag
"keep-hc-file"
(
NoArg
(
setGeneralFlag
Opt_KeepHcFiles
))
...
...
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