Commit fbf84997 authored by tibbe's avatar tibbe

Add support for emitting debug info

If the compiler (e.g. GHC 7.10) supports outputting OS native debug
info (e.g. DWARF) passing --enable-debug-info[=n] to cabal will
instruct it to do so.
parent f12ad214
......@@ -40,6 +40,10 @@ module Distribution.Simple.Compiler (
OptimisationLevel(..),
flagToOptimisationLevel,
-- * Support for debug info levels
DebugInfoLevel(..),
flagToDebugInfoLevel,
-- * Support for language extensions
Flag,
languageToFlags,
......@@ -193,6 +197,33 @@ flagToOptimisationLevel (Just s) = case reads s of
++ ". Valid values are 0..2"
_ -> error $ "Can't parse optimisation level " ++ s
-- ------------------------------------------------------------
-- * Debug info levels
-- ------------------------------------------------------------
-- | Some compilers support emitting debug info. Some have different
-- levels. For compilers that do not the level is just capped to the
-- level they do support.
--
data DebugInfoLevel = NoDebugInfo
| MinimalDebugInfo
| NormalDebugInfo
| MaximalDebugInfo
deriving (Bounded, Enum, Eq, Generic, Read, Show)
instance Binary DebugInfoLevel
flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel
flagToDebugInfoLevel Nothing = NormalDebugInfo
flagToDebugInfoLevel (Just s) = case reads s of
[(i, "")]
| i >= fromEnum (minBound :: DebugInfoLevel)
&& i <= fromEnum (maxBound :: DebugInfoLevel)
-> toEnum i
| otherwise -> error $ "Bad debug info level: " ++ show i
++ ". Valid values are 0..3"
_ -> error $ "Can't parse debug info level " ++ s
-- ------------------------------------------------------------
-- * Languages and Extensions
-- ------------------------------------------------------------
......
......@@ -660,6 +660,7 @@ configure (pkg_descr0, pbi) cfg
withDynExe = withDynExe_,
withProfExe = withProfExe_,
withOptimization = fromFlag $ configOptimization cfg,
withDebugInfo = fromFlag $ configDebugInfo cfg,
withGHCiLib = fromFlagOrDefault ghciLibByDefault $
configGHCiLib cfg,
splitObjs = split_objs,
......
......@@ -48,6 +48,7 @@ data GhcImplInfo = GhcImplInfo
, alwaysNondecIndent :: Bool -- ^ NondecreasingIndentation is always on
, flagGhciScript :: Bool -- ^ -ghci-script flag supported
, flagPackageConf :: Bool -- ^ use package-conf instead of package-db
, flagDebugInfo :: Bool -- ^ -g flag supported
}
getImplInfo :: Compiler -> GhcImplInfo
......@@ -80,6 +81,7 @@ ghcVersionImplInfo (Version v _) = GhcImplInfo
, alwaysNondecIndent = v < [7,1]
, flagGhciScript = v >= [7,2]
, flagPackageConf = v < [7,5]
, flagDebugInfo = v >= [7,10]
}
ghcjsVersionImplInfo :: Version -> Version -> GhcImplInfo
......@@ -99,6 +101,7 @@ ghcjsVersionImplInfo _ghcjsVer _ghcVer = GhcImplInfo
, alwaysNondecIndent = False
, flagGhciScript = True
, flagPackageConf = False
, flagDebugInfo = False
}
lhcVersionImplInfo :: Version -> GhcImplInfo
......
......@@ -38,7 +38,7 @@ import Distribution.PackageDescription as PD
, hcOptions, usedExtensions, ModuleRenaming, lookupRenaming )
import Distribution.Compat.Exception ( catchExit, catchIO )
import Distribution.Simple.Compiler
( CompilerFlavor(..), Compiler(..), OptimisationLevel(..) )
( CompilerFlavor(..), Compiler(..), DebugInfoLevel(..), OptimisationLevel(..) )
import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup
( toFlag )
......@@ -339,6 +339,11 @@ componentCcGhcOptions verbosity implInfo lbi bi clbi pref filename =
(case withOptimization lbi of
NoOptimisation -> []
_ -> ["-O2"]) ++
(case withDebugInfo lbi of
NoDebugInfo -> []
MinimalDebugInfo -> ["-g1"]
NormalDebugInfo -> ["-g"]
MaximalDebugInfo -> ["-g3"]) ++
PD.ccOptions bi,
ghcOptObjDir = toFlag odir
}
......@@ -372,6 +377,7 @@ componentGhcOptions verbosity lbi bi clbi odir =
ghcOptStubDir = toFlag odir,
ghcOptOutputDir = toFlag odir,
ghcOptOptimisation = toGhcOptimisation (withOptimization lbi),
ghcOptDebugInfo = toGhcDebugInfo (withDebugInfo lbi),
ghcOptExtra = toNubListR $ hcOptions GHC bi,
ghcOptLanguage = toFlag (fromMaybe Haskell98 (defaultLanguage bi)),
-- Unsupported extensions have already been checked by configure
......@@ -383,6 +389,11 @@ componentGhcOptions verbosity lbi bi clbi odir =
toGhcOptimisation NormalOptimisation = toFlag GhcNormalOptimisation
toGhcOptimisation MaximumOptimisation = toFlag GhcMaximumOptimisation
toGhcDebugInfo NoDebugInfo = mempty
toGhcDebugInfo MinimalDebugInfo = toFlag GhcMinimalDebugInfo
toGhcDebugInfo NormalDebugInfo = toFlag GhcNormalDebugInfo
toGhcDebugInfo MaximalDebugInfo = toFlag GhcMaximalDebugInfo
-- | Strip out flags that are not supported in ghci
filterGhciFlags :: [String] -> [String]
filterGhciFlags = filter supported
......
......@@ -73,7 +73,8 @@ import Distribution.Package
( PackageId, Package(..), InstalledPackageId(..), PackageKey
, PackageName )
import Distribution.Simple.Compiler
( Compiler, compilerInfo, PackageDBStack, OptimisationLevel )
( Compiler, compilerInfo, PackageDBStack, DebugInfoLevel
, OptimisationLevel )
import Distribution.Simple.PackageIndex
( InstalledPackageIndex, allPackages )
import Distribution.ModuleName ( ModuleName )
......@@ -139,6 +140,7 @@ data LocalBuildInfo = LocalBuildInfo {
withDynExe :: Bool, -- ^Whether to link executables dynamically
withProfExe :: Bool, -- ^Whether to build executables for profiling.
withOptimization :: OptimisationLevel, -- ^Whether to build with optimization (if available).
withDebugInfo :: DebugInfoLevel, -- ^Whether to emit debug info (if available).
withGHCiLib :: Bool, -- ^Whether to build libs suitable for use with GHCi.
splitObjs :: Bool, -- ^Use -split-objs with GHC, if available
stripExes :: Bool, -- ^Whether to strip executables during install
......
......@@ -2,6 +2,7 @@ module Distribution.Simple.Program.GHC (
GhcOptions(..),
GhcMode(..),
GhcOptimisation(..),
GhcDebugInfo(..),
GhcDynLinkMode(..),
ghcInvocation,
......@@ -152,6 +153,9 @@ data GhcOptions = GhcOptions {
-- | What optimisation level to use; the @ghc -O@ flag.
ghcOptOptimisation :: Flag GhcOptimisation,
-- | What debug info level to use; the @ghc -g@ flag.
ghcOptDebugInfo :: Flag GhcDebugInfo,
-- | Compile in profiling mode; the @ghc -prof@ flag.
ghcOptProfilingMode :: Flag Bool,
......@@ -219,6 +223,12 @@ data GhcOptimisation = GhcNoOptimisation -- ^ @-O0@
| GhcSpecialOptimisation String -- ^ e.g. @-Odph@
deriving (Show, Eq)
data GhcDebugInfo = GhcNoDebugInfo -- ^ @-g0@
| GhcMinimalDebugInfo -- ^ @-g1@
| GhcNormalDebugInfo -- ^ @-g@
| GhcMaximalDebugInfo -- ^ @-g3@
deriving (Show, Eq)
data GhcDynLinkMode = GhcStaticOnly -- ^ @-static@
| GhcDynamicOnly -- ^ @-dynamic@
| GhcStaticAndDynamic -- ^ @-static -dynamic-too@
......@@ -273,6 +283,13 @@ renderGhcOptions comp opts
Just GhcMaximumOptimisation -> ["-O2"]
Just (GhcSpecialOptimisation s) -> ["-O" ++ s] -- eg -Odph
, concat [ case flagToMaybe (ghcOptDebugInfo opts) of
Nothing -> []
Just GhcNoDebugInfo -> ["-g0"]
Just GhcMinimalDebugInfo -> ["-g1"]
Just GhcNormalDebugInfo -> ["-g"]
Just GhcMaximalDebugInfo -> ["-g3"] | flagDebugInfo implInfo ]
, [ "-prof" | flagBool ghcOptProfilingMode ]
, [ "-split-objs" | flagBool ghcOptSplitObjs ]
......@@ -475,6 +492,7 @@ instance Monoid GhcOptions where
ghcOptExtensions = mempty,
ghcOptExtensionMap = mempty,
ghcOptOptimisation = mempty,
ghcOptDebugInfo = mempty,
ghcOptProfilingMode = mempty,
ghcOptSplitObjs = mempty,
ghcOptNumJobs = mempty,
......@@ -527,6 +545,7 @@ instance Monoid GhcOptions where
ghcOptExtensions = combine ghcOptExtensions,
ghcOptExtensionMap = combine ghcOptExtensionMap,
ghcOptOptimisation = combine ghcOptOptimisation,
ghcOptDebugInfo = combine ghcOptDebugInfo,
ghcOptProfilingMode = combine ghcOptProfilingMode,
ghcOptSplitObjs = combine ghcOptSplitObjs,
ghcOptNumJobs = combine ghcOptNumJobs,
......
......@@ -82,6 +82,7 @@ import Distribution.Simple.Command hiding (boolOpt, boolOpt')
import qualified Distribution.Simple.Command as Command
import Distribution.Simple.Compiler
( CompilerFlavor(..), defaultCompilerFlavor, PackageDB(..)
, DebugInfoLevel(..), flagToDebugInfoLevel
, OptimisationLevel(..), flagToOptimisationLevel
, absolutePackageDBPath )
import Distribution.Simple.Utils
......@@ -319,7 +320,8 @@ data ConfigFlags = ConfigFlags {
-- the user via the '--dependency' and '--flags' options.
configFlagError :: Flag String,
-- ^Halt and show an error message indicating an error in flag assignment
configRelocatable :: Flag Bool -- ^ Enable relocatable package built
configRelocatable :: Flag Bool, -- ^ Enable relocatable package built
configDebugInfo :: Flag DebugInfoLevel -- ^ Emit debug info.
}
deriving (Generic, Read, Show)
......@@ -361,7 +363,8 @@ defaultConfigFlags progConf = emptyConfigFlags {
configLibCoverage = NoFlag,
configExactConfiguration = Flag False,
configFlagError = NoFlag,
configRelocatable = Flag False
configRelocatable = Flag False,
configDebugInfo = Flag NoDebugInfo
}
configureCommand :: ProgramConfiguration -> CommandUI ConfigFlags
......@@ -470,6 +473,22 @@ configureOptions showOrParseArgs =
"Build without optimization"
]
,multiOption "debug-info"
configDebugInfo (\v flags -> flags { configDebugInfo = v })
[optArg' "n" (Flag . flagToDebugInfoLevel)
(\f -> case f of
Flag NoDebugInfo -> []
Flag MinimalDebugInfo -> [Just "1"]
Flag NormalDebugInfo -> [Nothing]
Flag MaximalDebugInfo -> [Just "3"]
_ -> [])
"" ["enable-debug-info"]
"Emit debug info (n is 0--3, default is 0)",
noArg (Flag NoDebugInfo) []
["disable-debug-info"]
"Don't emit debug info"
]
,option "" ["library-for-ghci"]
"compile library for use with GHCi"
configGHCiLib (\v flags -> flags { configGHCiLib = v })
......@@ -730,7 +749,8 @@ instance Monoid ConfigFlags where
configExactConfiguration = mempty,
configBenchmarks = mempty,
configFlagError = mempty,
configRelocatable = mempty
configRelocatable = mempty,
configDebugInfo = mempty
}
mappend a b = ConfigFlags {
configPrograms = configPrograms b,
......@@ -771,7 +791,8 @@ instance Monoid ConfigFlags where
configExactConfiguration = combine configExactConfiguration,
configBenchmarks = combine configBenchmarks,
configFlagError = combine configFlagError,
configRelocatable = combine configRelocatable
configRelocatable = combine configRelocatable,
configDebugInfo = combine configDebugInfo
}
where combine field = field a `mappend` field b
......
......@@ -53,7 +53,7 @@ import Distribution.Utils.NubList
( NubList, fromNubList, toNubList)
import Distribution.Simple.Compiler
( OptimisationLevel(..) )
( DebugInfoLevel(..), OptimisationLevel(..) )
import Distribution.Simple.Setup
( ConfigFlags(..), configureOptions, defaultConfigFlags
, HaddockFlags(..), haddockOptions, defaultHaddockFlags
......@@ -261,6 +261,7 @@ instance Monoid SavedConfig where
-- TODO: NubListify
configConfigureArgs = lastNonEmpty configConfigureArgs,
configOptimization = combine configOptimization,
configDebugInfo = combine configDebugInfo,
configProgPrefix = combine configProgPrefix,
configProgSuffix = combine configProgSuffix,
-- Parametrised by (Flag PathTemplate), so safe to use 'mappend'.
......@@ -601,10 +602,11 @@ configFieldDescriptions =
[simpleField "compiler"
(fromFlagOrDefault Disp.empty . fmap Text.disp) (optional Text.parse)
configHcFlavor (\v flags -> flags { configHcFlavor = v })
-- TODO: The following is a temporary fix. The "optimization" field is
-- OptArg, and viewAsFieldDescr fails on that. Instead of a hand-written
-- hackaged parser and printer, we should handle this case properly in
-- the library.
-- TODO: The following is a temporary fix. The "optimization"
-- and "debug-info" fields are OptArg, and viewAsFieldDescr
-- fails on that. Instead of a hand-written hackaged parser
-- and printer, we should handle this case properly in the
-- library.
,liftField configOptimization (\v flags -> flags { configOptimization = v }) $
let name = "optimization" in
FieldDescr name
......@@ -626,6 +628,29 @@ configFieldDescriptions =
lstr = lowercase str
caseWarning = PWarning $
"The '" ++ name ++ "' field is case sensitive, use 'True' or 'False'.")
,liftField configDebugInfo (\v flags -> flags { configDebugInfo = v }) $
let name = "debug-info" in
FieldDescr name
(\f -> case f of
Flag NoDebugInfo -> Disp.text "False"
Flag MinimalDebugInfo -> Disp.text "1"
Flag NormalDebugInfo -> Disp.text "True"
Flag MaximalDebugInfo -> Disp.text "3"
_ -> Disp.empty)
(\line str _ -> case () of
_ | str == "False" -> ParseOk [] (Flag NoDebugInfo)
| str == "True" -> ParseOk [] (Flag NormalDebugInfo)
| str == "0" -> ParseOk [] (Flag NoDebugInfo)
| str == "1" -> ParseOk [] (Flag MinimalDebugInfo)
| str == "2" -> ParseOk [] (Flag NormalDebugInfo)
| str == "3" -> ParseOk [] (Flag MaximalDebugInfo)
| lstr == "false" -> ParseOk [caseWarning] (Flag NoDebugInfo)
| lstr == "true" -> ParseOk [caseWarning] (Flag NormalDebugInfo)
| otherwise -> ParseFailed (NoParse name line)
where
lstr = lowercase str
caseWarning = PWarning $
"The '" ++ name ++ "' field is case sensitive, use 'True' or 'False'.")
]
++ toSavedConfig liftConfigExFlag
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment