GhcLink(..), isNoLink,
PackageFlag(..),
Option(..),
+ fFlags, xFlags,
-- Configuration of the core-to-core and stg-to-stg phases
CoreToDo(..),
#include "HsVersions.h"
-import Module ( Module, mkModuleName, mkModule, ModLocation )
+import Module
import PackageConfig
import PrelNames ( mAIN )
#ifdef i386_TARGET_ARCH
import Util ( split )
#endif
-import Data.Char ( isUpper )
+import Data.Char
import System.IO ( hPutStrLn, stderr )
-- -----------------------------------------------------------------------------
| Opt_D_dump_hi_diffs
| Opt_D_dump_minimal_imports
| Opt_D_dump_mod_cycles
+ | Opt_D_dump_view_pattern_commoning
| Opt_D_faststring_stats
| Opt_DumpToFile -- ^ Append dump output to files instead of stdout.
| Opt_DoCoreLinting
| Opt_DisambiguateRecordFields
| Opt_RecordWildCards
| Opt_RecordPuns
+ | Opt_ViewPatterns
| Opt_GADTs
| Opt_RelaxedPolyRec
| Opt_StandaloneDeriving
| Opt_OmitInterfacePragmas
| Opt_DoLambdaEtaExpansion
| Opt_IgnoreAsserts
- | Opt_IgnoreBreakpoints
| Opt_DoEtaReduction
| Opt_CaseMerge
| Opt_UnboxStrictFields
| Opt_HideAllPackages
| Opt_PrintBindResult
| Opt_Haddock
+ | Opt_HaddockOptions
| Opt_Hpc_No_Auto
| Opt_BreakOnException
| Opt_BreakOnError
-- Package state
-- NB. do not modify this field, it is calculated by
-- Packages.initPackages and Packages.updatePackages.
- pkgDatabase :: Maybe (UniqFM InstalledPackageInfo),
+ pkgDatabase :: Maybe (UniqFM PackageConfig),
pkgState :: PackageState,
-- hsc dynamic flags
flags :: [DynFlag],
-- message output
- log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO ()
+ log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),
+
+ haddockOptions :: Maybe String
}
data HscTarget
packageFlags = [],
pkgDatabase = Nothing,
pkgState = panic "no package state yet: call GHC.setSessionDynFlags",
- flags = [
- Opt_ReadUserPackageConf,
-
- Opt_MonoPatBinds, -- Experimentally, I'm making this non-standard
- -- behaviour the default, to see if anyone notices
- -- SLPJ July 06
+ haddockOptions = Nothing,
+ flags = [
+ Opt_ReadUserPackageConf,
- Opt_ImplicitPrelude,
- Opt_MonomorphismRestriction,
+ Opt_MonoPatBinds, -- Experimentally, I'm making this non-standard
+ -- behaviour the default, to see if anyone notices
+ -- SLPJ July 06
+
+ Opt_ImplicitPrelude,
+ Opt_MonomorphismRestriction,
+
+ Opt_DoAsmMangling,
- Opt_DoAsmMangling,
-
Opt_GenManifest,
- Opt_EmbedManifest,
-
- -- on by default:
- Opt_PrintBindResult ]
- ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
- -- The default -O0 options
- ++ standardWarnings,
-
+ Opt_EmbedManifest
+ ]
+ ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
+ -- The default -O0 options
+ ++ standardWarnings,
+
log_action = \severity srcSpan style msg ->
case severity of
SevInfo -> hPutStrLn stderr (show (msg style))
addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d}
+addHaddockOpts f d = d{ haddockOptions = Just f}
+
-- -----------------------------------------------------------------------------
-- Command-line options
allFlags = map ('-':) $
[ name | (name, optkind) <- dynamic_flags, ok optkind ] ++
map ("fno-"++) flags ++
- map ("f"++) flags
+ map ("f"++) flags ++
+ map ("X"++) xs ++
+ map ("XNo"++) xs
where ok (PrefixPred _ _) = False
ok _ = True
flags = map fst fFlags
+ xs = map fst xFlags
dynamic_flags :: [(String, OptKind DynP)]
dynamic_flags = [
, ( "no-hs-main" , NoArg (setDynFlag Opt_NoHsMain))
, ( "main-is" , SepArg setMainIs )
, ( "haddock" , NoArg (setDynFlag Opt_Haddock) )
+ , ( "haddock-opts" , HasArg (upd . addHaddockOpts))
, ( "hpcdir" , SepArg setOptHpcDir )
------- recompilation checker (DEPRECATED, use -fforce-recomp) -----
, ( "ddump-vect", setDumpFlag Opt_D_dump_vect)
, ( "ddump-hpc", setDumpFlag Opt_D_dump_hpc)
, ( "ddump-mod-cycles", setDumpFlag Opt_D_dump_mod_cycles)
+ , ( "ddump-view-pattern-commoning", setDumpFlag Opt_D_dump_view_pattern_commoning)
, ( "ddump-to-file", setDumpFlag Opt_DumpToFile)
, ( "ddump-hi-diffs", NoArg (setDynFlag Opt_D_dump_hi_diffs))
, ( "dcore-lint", NoArg (setDynFlag Opt_DoCoreLinting))
( "omit-interface-pragmas", Opt_OmitInterfacePragmas ),
( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion ),
( "ignore-asserts", Opt_IgnoreAsserts ),
- ( "ignore-breakpoints", Opt_IgnoreBreakpoints),
( "do-eta-reduction", Opt_DoEtaReduction ),
( "case-merge", Opt_CaseMerge ),
( "unbox-strict-fields", Opt_UnboxStrictFields ),
( "DisambiguateRecordFields", Opt_DisambiguateRecordFields ),
( "OverloadedStrings", Opt_OverloadedStrings ),
( "GADTs", Opt_GADTs ),
+ ( "ViewPatterns", Opt_ViewPatterns),
( "TypeFamilies", Opt_TypeFamilies ),
( "BangPatterns", Opt_BangPatterns ),
-- On by default:
setMainIs :: String -> DynP ()
setMainIs arg
- | not (null main_fn) -- The arg looked like "Foo.baz"
+ | not (null main_fn) && isLower (head main_fn)
+ -- The arg looked like "Foo.Bar.baz"
= upd $ \d -> d{ mainFunIs = Just main_fn,
- mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
+ mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
- | isUpper (head main_mod) -- The arg looked like "Foo"
- = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
+ | isUpper (head arg) -- The arg looked like "Foo" or "Foo.Bar"
+ = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName arg) }
| otherwise -- The arg looked like "baz"
- = upd $ \d -> d{ mainFunIs = Just main_mod }
+ = upd $ \d -> d{ mainFunIs = Just arg }
where
(main_mod, main_fn) = splitLongestPrefix arg (== '.')