X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=bf456c97af75ef7600f3b05576e50be16eba9c73;hp=70229643366010f477654b08a77685293bbbdf5e;hb=6a05ec5ef5373f61b7f9f5bdc344483417fa801b;hpb=b3a0711bf88db2894261e3666b689b40371ddc48 diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 7022964..bf456c9 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1,5 +1,12 @@ {-# OPTIONS -fno-warn-missing-fields #-} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + ----------------------------------------------------------------------------- -- -- Dynamic flags @@ -17,7 +24,7 @@ module DynFlags ( -- Dynamic flags DynFlag(..), DynFlags(..), - HscTarget(..), isObjectTarget, + HscTarget(..), isObjectTarget, defaultObjectTarget, GhcMode(..), isOneShot, GhcLink(..), isNoLink, PackageFlag(..), @@ -47,12 +54,14 @@ module DynFlags ( allFlags, -- misc stuff - machdepCCOpts, picCCOpts + machdepCCOpts, picCCOpts, + supportedLanguages, + compilerInfo, ) where #include "HsVersions.h" -import Module ( Module, mkModuleName, mkModule ) +import Module import PackageConfig import PrelNames ( mAIN ) #ifdef i386_TARGET_ARCH @@ -67,8 +76,8 @@ import CmdLineParser import Constants ( mAX_CONTEXT_REDUCTION_DEPTH ) import Panic ( panic, GhcException(..) ) import UniqFM ( UniqFM ) -import Util ( notNull, splitLongestPrefix, normalisePath ) -import Maybes ( fromJust, orElse ) +import Util +import Maybes ( orElse, fromJust ) import SrcLoc ( SrcSpan ) import Outputable import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) @@ -82,7 +91,7 @@ import Data.List ( isPrefixOf ) import Util ( split ) #endif -import Data.Char ( isUpper ) +import Data.Char import System.IO ( hPutStrLn, stderr ) -- ----------------------------------------------------------------------------- @@ -92,7 +101,18 @@ data DynFlag -- debugging flags = Opt_D_dump_cmm + | Opt_D_dump_cmmz + | Opt_D_dump_cmmz_pretty + | Opt_D_dump_cps_cmm + | Opt_D_dump_cvt_cmm | Opt_D_dump_asm + | Opt_D_dump_asm_native + | Opt_D_dump_asm_liveness + | Opt_D_dump_asm_coalesce + | Opt_D_dump_asm_regalloc + | Opt_D_dump_asm_regalloc_stages + | Opt_D_dump_asm_conflicts + | Opt_D_dump_asm_stats | Opt_D_dump_cpranal | Opt_D_dump_deriv | Opt_D_dump_ds @@ -131,14 +151,18 @@ data DynFlag | 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_DoStgLinting | Opt_DoCmmLinting + | Opt_DoAsmLinting - | Opt_WarnIsError -- -Werror; makes warnings fatal + | Opt_WarnIsError -- -Werror; makes warnings fatal | Opt_WarnDuplicateExports | Opt_WarnHiShadows + | Opt_WarnImplicitPrelude | Opt_WarnIncompletePatterns | Opt_WarnIncompletePatternsRecUpd | Opt_WarnMissingFields @@ -158,24 +182,56 @@ data DynFlag | Opt_WarnTabs -- language opts - | Opt_AllowOverlappingInstances - | Opt_AllowUndecidableInstances - | Opt_AllowIncoherentInstances + | Opt_OverlappingInstances + | Opt_UndecidableInstances + | Opt_IncoherentInstances | Opt_MonomorphismRestriction | Opt_MonoPatBinds | Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting - | Opt_GlasgowExts - | Opt_FFI + | Opt_ForeignFunctionInterface + | Opt_UnliftedFFITypes | Opt_PArr -- Syntactic support for parallel arrays | Opt_Arrows -- Arrow-notation syntax - | Opt_TH + | Opt_TemplateHaskell | Opt_ImplicitParams | Opt_Generics | Opt_ImplicitPrelude | Opt_ScopedTypeVariables + | Opt_UnboxedTuples | Opt_BangPatterns - | Opt_IndexedTypes + | Opt_TypeFamilies | Opt_OverloadedStrings + | Opt_DisambiguateRecordFields + | Opt_RecordWildCards + | Opt_RecordPuns + | Opt_ViewPatterns + | Opt_GADTs + | Opt_RelaxedPolyRec + | Opt_StandaloneDeriving + | Opt_DeriveDataTypeable + | Opt_TypeSynonymInstances + | Opt_FlexibleContexts + | Opt_FlexibleInstances + | Opt_ConstrainedClassMethods + | Opt_MultiParamTypeClasses + | Opt_FunctionalDependencies + | Opt_UnicodeSyntax + | Opt_PolymorphicComponents + | Opt_ExistentialQuantification + | Opt_MagicHash + | Opt_EmptyDataDecls + | Opt_KindSignatures + | Opt_PatternSignatures + | Opt_ParallelListComp + | Opt_GeneralizedNewtypeDeriving + | Opt_RecursiveDo + | Opt_PatternGuards + | Opt_LiberalTypeSynonyms + | Opt_Rank2Types + | Opt_RankNTypes + | Opt_TypeOperators + + | Opt_PrintExplicitForalls -- optimisation opts | Opt_Strictness @@ -192,6 +248,10 @@ data DynFlag | Opt_CaseMerge | Opt_UnboxStrictFields | Opt_DictsCheap + | Opt_RewriteRules + | Opt_Vectorise + | Opt_RegsGraph -- do graph coloring register allocation + | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation -- misc opts | Opt_Cpp @@ -208,6 +268,13 @@ data DynFlag | Opt_PrintBindResult | Opt_Haddock | Opt_Hpc_No_Auto + | Opt_BreakOnException + | Opt_BreakOnError + | Opt_PrintEvldWithShow + | Opt_GenManifest + | Opt_EmbedManifest + | Opt_RunCPSZ + | Opt_ConvertToZipCfgAndBack -- keeping stuff | Opt_KeepHiDiffs @@ -216,7 +283,7 @@ data DynFlag | Opt_KeepRawSFiles | Opt_KeepTmpFiles - deriving (Eq) + deriving (Eq, Show) data DynFlags = DynFlags { ghcMode :: GhcMode, @@ -259,6 +326,14 @@ data DynFlags = DynFlags { outputFile :: Maybe String, outputHi :: Maybe String, + -- | This is set by DriverPipeline.runPipeline based on where + -- its output is going. + dumpPrefix :: Maybe FilePath, + + -- | Override the dumpPrefix set by runPipeline. + -- Set by -ddump-file-prefix + dumpPrefixForce :: Maybe FilePath, + includePaths :: [String], libraryPaths :: [String], frameworkPaths :: [String], -- used on darwin only @@ -278,8 +353,8 @@ data DynFlags = DynFlags { opt_m :: [String], opt_a :: [String], opt_l :: [String], - opt_dll :: [String], opt_dep :: [String], + opt_windres :: [String], -- commands for particular phases pgm_L :: String, @@ -293,6 +368,7 @@ data DynFlags = DynFlags { pgm_dll :: (String,[Option]), pgm_T :: String, pgm_sysman :: String, + pgm_windres :: String, -- Package flags extraPkgConfs :: [FilePath], @@ -307,7 +383,7 @@ data DynFlags = DynFlags { -- 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 @@ -352,7 +428,7 @@ data GhcLink -- What to do in the link step, if there is one = NoLink -- Don't link at all | LinkBinary -- Link object code into a binary | LinkInMemory -- Use the in-memory dynamic linker - | MkDLL -- Make a DLL + | LinkDynLib -- Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) deriving Eq isNoLink :: GhcLink -> Bool @@ -365,7 +441,11 @@ data PackageFlag | IgnorePackage String deriving Eq -defaultHscTarget +defaultHscTarget = defaultObjectTarget + +-- | the 'HscTarget' value corresponding to the default way to create +-- object files on the current platform. +defaultObjectTarget | cGhcWithNativeCodeGen == "YES" = HscAsm | otherwise = HscC @@ -413,6 +493,8 @@ defaultDynFlags = outputFile = Nothing, outputHi = Nothing, + dumpPrefix = Nothing, + dumpPrefixForce = Nothing, includePaths = [], libraryPaths = [], frameworkPaths = [], @@ -422,14 +504,16 @@ defaultDynFlags = hpcDir = ".hpc", opt_L = [], - opt_P = [], + opt_P = (if opt_PIC + then ["-D__PIC__"] + else []), opt_F = [], opt_c = [], opt_a = [], opt_m = [], opt_l = [], - opt_dll = [], opt_dep = [], + opt_windres = [], extraPkgConfs = [], packageFlags = [], @@ -447,6 +531,9 @@ defaultDynFlags = Opt_DoAsmMangling, + Opt_GenManifest, + Opt_EmbedManifest, + -- on by default: Opt_PrintBindResult ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] @@ -489,9 +576,11 @@ getVerbFlag dflags | verbosity dflags >= 3 = "-v" | otherwise = "" -setObjectDir f d = d{ objectDir = f} -setHiDir f d = d{ hiDir = f} -setStubDir f d = d{ stubDir = f} +setObjectDir f d = d{ objectDir = Just f} +setHiDir f d = d{ hiDir = Just f} +setStubDir f d = d{ stubDir = Just f, includePaths = f : includePaths d } + -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file + -- #included from the .hc file when compiling with -fvia-C. setObjectSuf f d = d{ objectSuf = f} setHiSuf f d = d{ hiSuf = f} @@ -500,6 +589,8 @@ setHcSuf f d = d{ hcSuf = f} setOutputFile f d = d{ outputFile = f} setOutputHi f d = d{ outputHi = f} +setDumpPrefixForce f d = d { dumpPrefixForce = f} + -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"] -- Config.hs should really use Option. setPgmP f d = let (pgm:args) = words f in d{ pgm_P = (pgm, map Option args)} @@ -512,6 +603,7 @@ setPgms f d = d{ pgm_s = (f,[])} setPgma f d = d{ pgm_a = (f,[])} setPgml f d = d{ pgm_l = (f,[])} setPgmdll f d = d{ pgm_dll = (f,[])} +setPgmwindres f d = d{ pgm_windres = f} addOptL f d = d{ opt_L = f : opt_L d} addOptP f d = d{ opt_P = f : opt_P d} @@ -520,8 +612,8 @@ addOptc f d = d{ opt_c = f : opt_c d} addOptm f d = d{ opt_m = f : opt_m d} addOpta f d = d{ opt_a = f : opt_a d} addOptl f d = d{ opt_l = f : opt_l d} -addOptdll f d = d{ opt_dll = f : opt_dll d} addOptdep f d = d{ opt_dep = f : opt_dep d} +addOptwindres f d = d{ opt_windres = f : opt_windres d} addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d} @@ -548,24 +640,29 @@ data Option updOptLevel :: Int -> DynFlags -> DynFlags -- Set dynflags appropriate to the optimisation level updOptLevel n dfs - = dfs2{ optLevel = n } + = dfs2{ optLevel = final_n } where + final_n = max 0 (min 2 n) -- Clamp to 0 <= n <= 2 dfs1 = foldr (flip dopt_unset) dfs remove_dopts dfs2 = foldr (flip dopt_set) dfs1 extra_dopts - extra_dopts = [ f | (ns,f) <- optLevelFlags, n `elem` ns ] - remove_dopts = [ f | (ns,f) <- optLevelFlags, n `notElem` ns ] + extra_dopts = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ] + remove_dopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ] optLevelFlags :: [([Int], DynFlag)] optLevelFlags = [ ([0], Opt_IgnoreInterfacePragmas) , ([0], Opt_OmitInterfacePragmas) + , ([1,2], Opt_IgnoreAsserts) + , ([1,2], Opt_RewriteRules) -- Off for -O0; see Note [Scoping for Builtin rules] + -- in PrelRules , ([1,2], Opt_DoEtaReduction) , ([1,2], Opt_CaseMerge) , ([1,2], Opt_Strictness) , ([1,2], Opt_CSE) , ([1,2], Opt_FullLaziness) + , ([2], Opt_LiberateCase) , ([2], Opt_SpecConstr) @@ -605,6 +702,16 @@ minusWallOpts Opt_WarnOrphans ] +-- minuswRemovesOpts should be every warning option +minuswRemovesOpts + = minusWallOpts ++ + [Opt_WarnImplicitPrelude, + Opt_WarnIncompletePatternsRecUpd, + Opt_WarnSimplePatterns, + Opt_WarnMonomorphism, + Opt_WarnTabs + ] + -- ----------------------------------------------------------------------------- -- CoreToDo: abstraction of core-to-core passes to run. @@ -631,6 +738,7 @@ data CoreToDo -- These are diff core-to-core passes, | CoreCSE | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules -- matching this string + | CoreDoVectorisation | CoreDoNothing -- Useful when building up | CoreDoPasses [CoreToDo] -- lists of these things @@ -666,6 +774,7 @@ getCoreToDo dflags spec_constr = dopt Opt_SpecConstr dflags liberate_case = dopt Opt_LiberateCase dflags rule_check = ruleCheck dflags + vectorisation = dopt Opt_Vectorise dflags core_todo = if opt_level == 0 then @@ -693,6 +802,15 @@ getCoreToDo dflags MaxSimplifierIterations max_iter ], + + -- We run vectorisation here for now, but we might also try to run + -- it later + runWhen vectorisation (CoreDoPasses [ + CoreDoVectorisation, + CoreDoSimplify SimplGently + [NoCaseOfCase, + MaxSimplifierIterations max_iter]]), + -- Specialisation is best done before full laziness -- so that overloaded functions have all their dictionary lambdas manifest CoreDoSpecialising, @@ -836,6 +954,7 @@ dynamic_flags = [ , ( "pgma" , HasArg (upd . setPgma) ) , ( "pgml" , HasArg (upd . setPgml) ) , ( "pgmdll" , HasArg (upd . setPgmdll) ) + , ( "pgmwindres" , HasArg (upd . setPgmwindres) ) , ( "optL" , HasArg (upd . addOptL) ) , ( "optP" , HasArg (upd . addOptP) ) @@ -844,8 +963,8 @@ dynamic_flags = [ , ( "optm" , HasArg (upd . addOptm) ) , ( "opta" , HasArg (upd . addOpta) ) , ( "optl" , HasArg (upd . addOptl) ) - , ( "optdll" , HasArg (upd . addOptdll) ) , ( "optdep" , HasArg (upd . addOptdep) ) + , ( "optwindres" , HasArg (upd . addOptwindres) ) , ( "split-objs" , NoArg (if can_split then setDynFlag Opt_SplitObjs @@ -854,12 +973,11 @@ dynamic_flags = [ -------- Linking ---------------------------------------------------- , ( "c" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) , ( "no-link" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) -- Dep. - , ( "-mk-dll" , NoArg (upd $ \d -> d{ ghcLink=MkDLL } )) + , ( "shared" , NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } )) ------- Libraries --------------------------------------------------- , ( "L" , Prefix addLibraryPath ) - , ( "l" , AnySuffix (\s -> do upd (addOptl s) - upd (addOptdll s))) + , ( "l" , AnySuffix (\s -> do upd (addOptl s))) ------- Frameworks -------------------------------------------------- -- -framework-path should really be -F ... @@ -867,21 +985,27 @@ dynamic_flags = [ , ( "framework" , HasArg (upd . addCmdlineFramework) ) ------- Output Redirection ------------------------------------------ - , ( "odir" , HasArg (upd . setObjectDir . Just)) + , ( "odir" , HasArg (upd . setObjectDir)) , ( "o" , SepArg (upd . setOutputFile . Just)) , ( "ohi" , HasArg (upd . setOutputHi . Just )) , ( "osuf" , HasArg (upd . setObjectSuf)) , ( "hcsuf" , HasArg (upd . setHcSuf)) , ( "hisuf" , HasArg (upd . setHiSuf)) - , ( "hidir" , HasArg (upd . setHiDir . Just)) + , ( "hidir" , HasArg (upd . setHiDir)) , ( "tmpdir" , HasArg (upd . setTmpDir)) - , ( "stubdir" , HasArg (upd . setStubDir . Just)) + , ( "stubdir" , HasArg (upd . setStubDir)) + , ( "ddump-file-prefix", HasArg (upd . setDumpPrefixForce . Just)) ------- Keeping temporary files ------------------------------------- - , ( "keep-hc-file" , AnySuffix (\_ -> setDynFlag Opt_KeepHcFiles)) - , ( "keep-s-file" , AnySuffix (\_ -> setDynFlag Opt_KeepSFiles)) - , ( "keep-raw-s-file", AnySuffix (\_ -> setDynFlag Opt_KeepRawSFiles)) - , ( "keep-tmp-files" , AnySuffix (\_ -> setDynFlag Opt_KeepTmpFiles)) + -- These can be singular (think ghc -c) or plural (think ghc --make) + , ( "keep-hc-file" , NoArg (setDynFlag Opt_KeepHcFiles)) + , ( "keep-hc-files" , NoArg (setDynFlag Opt_KeepHcFiles)) + , ( "keep-s-file" , NoArg (setDynFlag Opt_KeepSFiles)) + , ( "keep-s-files" , NoArg (setDynFlag Opt_KeepSFiles)) + , ( "keep-raw-s-file" , NoArg (setDynFlag Opt_KeepRawSFiles)) + , ( "keep-raw-s-files", NoArg (setDynFlag Opt_KeepRawSFiles)) + -- This only makes sense as plural + , ( "keep-tmp-files" , NoArg (setDynFlag Opt_KeepTmpFiles)) ------- Miscellaneous ---------------------------------------------- , ( "no-hs-main" , NoArg (setDynFlag Opt_NoHsMain)) @@ -915,7 +1039,19 @@ dynamic_flags = [ , ( "dstg-stats", NoArg (setDynFlag Opt_StgStats)) , ( "ddump-cmm", setDumpFlag Opt_D_dump_cmm) + , ( "ddump-cmmz", setDumpFlag Opt_D_dump_cmmz) + , ( "ddump-cmmz-pretty", setDumpFlag Opt_D_dump_cmmz_pretty) + , ( "ddump-cps-cmm", setDumpFlag Opt_D_dump_cps_cmm) + , ( "ddump-cvt-cmm", setDumpFlag Opt_D_dump_cvt_cmm) , ( "ddump-asm", setDumpFlag Opt_D_dump_asm) + , ( "ddump-asm-native", setDumpFlag Opt_D_dump_asm_native) + , ( "ddump-asm-liveness", setDumpFlag Opt_D_dump_asm_liveness) + , ( "ddump-asm-coalesce", setDumpFlag Opt_D_dump_asm_coalesce) + , ( "ddump-asm-regalloc", setDumpFlag Opt_D_dump_asm_regalloc) + , ( "ddump-asm-conflicts", setDumpFlag Opt_D_dump_asm_conflicts) + , ( "ddump-asm-regalloc-stages", + setDumpFlag Opt_D_dump_asm_regalloc_stages) + , ( "ddump-asm-stats", setDumpFlag Opt_D_dump_asm_stats) , ( "ddump-cpranal", setDumpFlag Opt_D_dump_cpranal) , ( "ddump-deriv", setDumpFlag Opt_D_dump_deriv) , ( "ddump-ds", setDumpFlag Opt_D_dump_ds) @@ -948,16 +1084,18 @@ dynamic_flags = [ , ( "dsource-stats", setDumpFlag Opt_D_source_stats) , ( "dverbose-core2core", setDumpFlag Opt_D_verbose_core2core) , ( "dverbose-stg2stg", setDumpFlag Opt_D_verbose_stg2stg) - , ( "ddump-hi-diffs", setDumpFlag Opt_D_dump_hi_diffs) , ( "ddump-hi", setDumpFlag Opt_D_dump_hi) , ( "ddump-minimal-imports", setDumpFlag Opt_D_dump_minimal_imports) , ( "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)) , ( "dstg-lint", NoArg (setDynFlag Opt_DoStgLinting)) , ( "dcmm-lint", NoArg (setDynFlag Opt_DoCmmLinting)) + , ( "dasm-lint", NoArg (setDynFlag Opt_DoAsmLinting)) , ( "dshow-passes", NoArg (do setDynFlag Opt_ForceRecomp setVerbosity (Just 2)) ) , ( "dfaststring-stats", NoArg (setDynFlag Opt_D_faststring_stats)) @@ -968,16 +1106,17 @@ dynamic_flags = [ , ( "monly-3-regs", NoArg (upd (\s -> s{stolen_x86_regs = 3}) )) , ( "monly-4-regs", NoArg (upd (\s -> s{stolen_x86_regs = 4}) )) - ------ Warning opts ------------------------------------------------- - , ( "W" , NoArg (mapM_ setDynFlag minusWOpts) ) - , ( "Werror" , NoArg (setDynFlag Opt_WarnIsError) ) - , ( "Wall" , NoArg (mapM_ setDynFlag minusWallOpts) ) - , ( "Wnot" , NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */ - , ( "w" , NoArg (mapM_ unSetDynFlag minusWallOpts) ) + ------ Warning opts ------------------------------------------------- + , ( "W" , NoArg (mapM_ setDynFlag minusWOpts) ) + , ( "Werror", NoArg (setDynFlag Opt_WarnIsError) ) + , ( "Wwarn" , NoArg (unSetDynFlag Opt_WarnIsError) ) + , ( "Wall" , NoArg (mapM_ setDynFlag minusWallOpts) ) + , ( "Wnot" , NoArg (mapM_ unSetDynFlag minusWallOpts) ) -- DEPRECATED + , ( "w" , NoArg (mapM_ unSetDynFlag minuswRemovesOpts) ) ------ Optimisation flags ------------------------------------------ , ( "O" , NoArg (upd (setOptLevel 1))) - , ( "Onot" , NoArg (upd (setOptLevel 0))) + , ( "Onot" , NoArg (upd (setOptLevel 0))) -- deprecated , ( "O" , OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1)))) -- If the number is missing, use 1 @@ -993,93 +1132,233 @@ dynamic_flags = [ ------ Compiler flags ----------------------------------------------- - , ( "fasm", AnySuffix (\_ -> setObjTarget HscAsm) ) - , ( "fvia-c", NoArg (setObjTarget HscC) ) - , ( "fvia-C", NoArg (setObjTarget HscC) ) + , ( "fasm", NoArg (setObjTarget HscAsm) ) + , ( "fvia-c", NoArg (setObjTarget HscC) ) + , ( "fvia-C", NoArg (setObjTarget HscC) ) - , ( "fno-code", NoArg (setTarget HscNothing)) - , ( "fbyte-code", NoArg (setTarget HscInterpreted) ) - , ( "fobject-code", NoArg (setTarget defaultHscTarget) ) + , ( "fno-code", NoArg (setTarget HscNothing)) + , ( "fbyte-code", NoArg (setTarget HscInterpreted) ) + , ( "fobject-code", NoArg (setTarget defaultHscTarget) ) , ( "fglasgow-exts", NoArg (mapM_ setDynFlag glasgowExtsFlags) ) , ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) ) - - -- the rest of the -f* and -fno-* flags - , ( "fno-", PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) ) - , ( "f", PrefixPred (\f -> isFFlag f) (\f -> setDynFlag (getFFlag f)) ) + -- the rest of the -f* and -fno-* flags + , ( "f", PrefixPred (isFlag fFlags) + (\f -> setDynFlag (getFlag fFlags f)) ) + , ( "f", PrefixPred (isPrefFlag "no-" fFlags) + (\f -> unSetDynFlag (getPrefFlag "no-" fFlags f)) ) + + -- the -X* and -XNo* flags + , ( "X", PrefixPred (isFlag xFlags) + (\f -> setDynFlag (getFlag xFlags f)) ) + , ( "X", PrefixPred (isPrefFlag "No" xFlags) + (\f -> unSetDynFlag (getPrefFlag "No" xFlags f)) ) ] -- these -f flags can all be reversed with -fno- fFlags = [ - ( "warn-duplicate-exports", Opt_WarnDuplicateExports ), - ( "warn-hi-shadowing", Opt_WarnHiShadows ), - ( "warn-incomplete-patterns", Opt_WarnIncompletePatterns ), - ( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd ), - ( "warn-missing-fields", Opt_WarnMissingFields ), - ( "warn-missing-methods", Opt_WarnMissingMethods ), - ( "warn-missing-signatures", Opt_WarnMissingSigs ), - ( "warn-name-shadowing", Opt_WarnNameShadowing ), - ( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns ), - ( "warn-simple-patterns", Opt_WarnSimplePatterns ), - ( "warn-type-defaults", Opt_WarnTypeDefaults ), - ( "warn-monomorphism-restriction", Opt_WarnMonomorphism ), - ( "warn-unused-binds", Opt_WarnUnusedBinds ), - ( "warn-unused-imports", Opt_WarnUnusedImports ), - ( "warn-unused-matches", Opt_WarnUnusedMatches ), - ( "warn-deprecations", Opt_WarnDeprecations ), - ( "warn-orphans", Opt_WarnOrphans ), - ( "warn-tabs", Opt_WarnTabs ), - ( "fi", Opt_FFI ), -- support `-ffi'... - ( "ffi", Opt_FFI ), -- ...and also `-fffi' - ( "arrows", Opt_Arrows ), -- arrow syntax - ( "parr", Opt_PArr ), - ( "th", Opt_TH ), - ( "implicit-prelude", Opt_ImplicitPrelude ), - ( "scoped-type-variables", Opt_ScopedTypeVariables ), - ( "bang-patterns", Opt_BangPatterns ), - ( "overloaded-strings", Opt_OverloadedStrings ), - ( "indexed-types", Opt_IndexedTypes ), - ( "monomorphism-restriction", Opt_MonomorphismRestriction ), - ( "mono-pat-binds", Opt_MonoPatBinds ), - ( "extended-default-rules", Opt_ExtendedDefaultRules ), - ( "implicit-params", Opt_ImplicitParams ), - ( "allow-overlapping-instances", Opt_AllowOverlappingInstances ), - ( "allow-undecidable-instances", Opt_AllowUndecidableInstances ), - ( "allow-incoherent-instances", Opt_AllowIncoherentInstances ), - ( "generics", Opt_Generics ), - ( "strictness", Opt_Strictness ), - ( "full-laziness", Opt_FullLaziness ), - ( "liberate-case", Opt_LiberateCase ), - ( "spec-constr", Opt_SpecConstr ), - ( "cse", Opt_CSE ), - ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas ), - ( "omit-interface-pragmas", Opt_OmitInterfacePragmas ), - ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion ), - ( "ignore-asserts", Opt_IgnoreAsserts ), + ( "warn-dodgy-imports", Opt_WarnDodgyImports ), + ( "warn-duplicate-exports", Opt_WarnDuplicateExports ), + ( "warn-hi-shadowing", Opt_WarnHiShadows ), + ( "warn-implicit-prelude", Opt_WarnImplicitPrelude ), + ( "warn-incomplete-patterns", Opt_WarnIncompletePatterns ), + ( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd ), + ( "warn-missing-fields", Opt_WarnMissingFields ), + ( "warn-missing-methods", Opt_WarnMissingMethods ), + ( "warn-missing-signatures", Opt_WarnMissingSigs ), + ( "warn-name-shadowing", Opt_WarnNameShadowing ), + ( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns ), + ( "warn-simple-patterns", Opt_WarnSimplePatterns ), + ( "warn-type-defaults", Opt_WarnTypeDefaults ), + ( "warn-monomorphism-restriction", Opt_WarnMonomorphism ), + ( "warn-unused-binds", Opt_WarnUnusedBinds ), + ( "warn-unused-imports", Opt_WarnUnusedImports ), + ( "warn-unused-matches", Opt_WarnUnusedMatches ), + ( "warn-deprecations", Opt_WarnDeprecations ), + ( "warn-orphans", Opt_WarnOrphans ), + ( "warn-tabs", Opt_WarnTabs ), + ( "print-explicit-foralls", Opt_PrintExplicitForalls ), + ( "strictness", Opt_Strictness ), + ( "full-laziness", Opt_FullLaziness ), + ( "liberate-case", Opt_LiberateCase ), + ( "spec-constr", Opt_SpecConstr ), + ( "cse", Opt_CSE ), + ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas ), + ( "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 ), - ( "dicts-cheap", Opt_DictsCheap ), - ( "excess-precision", Opt_ExcessPrecision ), - ( "asm-mangling", Opt_DoAsmMangling ), - ( "print-bind-result", Opt_PrintBindResult ), - ( "force-recomp", Opt_ForceRecomp ), - ( "hpc-no-auto", Opt_Hpc_No_Auto ) + ( "do-eta-reduction", Opt_DoEtaReduction ), + ( "case-merge", Opt_CaseMerge ), + ( "unbox-strict-fields", Opt_UnboxStrictFields ), + ( "dicts-cheap", Opt_DictsCheap ), + ( "excess-precision", Opt_ExcessPrecision ), + ( "asm-mangling", Opt_DoAsmMangling ), + ( "print-bind-result", Opt_PrintBindResult ), + ( "force-recomp", Opt_ForceRecomp ), + ( "hpc-no-auto", Opt_Hpc_No_Auto ), + ( "rewrite-rules", Opt_RewriteRules ), + ( "break-on-exception", Opt_BreakOnException ), + ( "break-on-error", Opt_BreakOnError ), + ( "print-evld-with-show", Opt_PrintEvldWithShow ), + ( "run-cps", Opt_RunCPSZ ), + ( "convert-to-zipper-and-back", Opt_ConvertToZipCfgAndBack), + ( "vectorise", Opt_Vectorise ), + ( "regs-graph", Opt_RegsGraph), + ( "regs-iterative", Opt_RegsIterative), + -- Deprecated in favour of -XTemplateHaskell: + ( "th", Opt_TemplateHaskell ), + -- Deprecated in favour of -XForeignFunctionInterface: + ( "fi", Opt_ForeignFunctionInterface ), + -- Deprecated in favour of -XForeignFunctionInterface: + ( "ffi", Opt_ForeignFunctionInterface ), + -- Deprecated in favour of -XArrows: + ( "arrows", Opt_Arrows ), + -- Deprecated in favour of -XGenerics: + ( "generics", Opt_Generics ), + -- Deprecated in favour of -XImplicitPrelude: + ( "implicit-prelude", Opt_ImplicitPrelude ), + -- Deprecated in favour of -XBangPatterns: + ( "bang-patterns", Opt_BangPatterns ), + -- Deprecated in favour of -XMonomorphismRestriction: + ( "monomorphism-restriction", Opt_MonomorphismRestriction ), + -- Deprecated in favour of -XMonoPatBinds: + ( "mono-pat-binds", Opt_MonoPatBinds ), + -- Deprecated in favour of -XExtendedDefaultRules: + ( "extended-default-rules", Opt_ExtendedDefaultRules ), + -- Deprecated in favour of -XImplicitParams: + ( "implicit-params", Opt_ImplicitParams ), + -- Deprecated in favour of -XScopedTypeVariables: + ( "scoped-type-variables", Opt_ScopedTypeVariables ), + -- Deprecated in favour of -XPArr: + ( "parr", Opt_PArr ), + -- Deprecated in favour of -XOverlappingInstances: + ( "allow-overlapping-instances", Opt_OverlappingInstances ), + -- Deprecated in favour of -XUndecidableInstances: + ( "allow-undecidable-instances", Opt_UndecidableInstances ), + -- Deprecated in favour of -XIncoherentInstances: + ( "allow-incoherent-instances", Opt_IncoherentInstances ), + ( "gen-manifest", Opt_GenManifest ), + ( "embed-manifest", Opt_EmbedManifest ) ] +supportedLanguages :: [String] +supportedLanguages = map fst xFlags + +-- These -X flags can all be reversed with -XNo +xFlags :: [(String, DynFlag)] +xFlags = [ + ( "CPP", Opt_Cpp ), + ( "PatternGuards", Opt_PatternGuards ), + ( "UnicodeSyntax", Opt_UnicodeSyntax ), + ( "MagicHash", Opt_MagicHash ), + ( "PolymorphicComponents", Opt_PolymorphicComponents ), + ( "ExistentialQuantification", Opt_ExistentialQuantification ), + ( "KindSignatures", Opt_KindSignatures ), + ( "PatternSignatures", Opt_PatternSignatures ), + ( "EmptyDataDecls", Opt_EmptyDataDecls ), + ( "ParallelListComp", Opt_ParallelListComp ), + ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface ), + ( "UnliftedFFITypes", Opt_UnliftedFFITypes ), + ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms ), + ( "Rank2Types", Opt_Rank2Types ), + ( "RankNTypes", Opt_RankNTypes ), + ( "TypeOperators", Opt_TypeOperators ), + ( "RecursiveDo", Opt_RecursiveDo ), + ( "Arrows", Opt_Arrows ), + ( "PArr", Opt_PArr ), + ( "TemplateHaskell", Opt_TemplateHaskell ), + ( "Generics", Opt_Generics ), + -- On by default: + ( "ImplicitPrelude", Opt_ImplicitPrelude ), + ( "RecordWildCards", Opt_RecordWildCards ), + ( "RecordPuns", Opt_RecordPuns ), + ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields ), + ( "OverloadedStrings", Opt_OverloadedStrings ), + ( "GADTs", Opt_GADTs ), + ( "ViewPatterns", Opt_ViewPatterns), + ( "TypeFamilies", Opt_TypeFamilies ), + ( "BangPatterns", Opt_BangPatterns ), + -- On by default: + ( "MonomorphismRestriction", Opt_MonomorphismRestriction ), + -- On by default (which is not strictly H98): + ( "MonoPatBinds", Opt_MonoPatBinds ), + ( "RelaxedPolyRec", Opt_RelaxedPolyRec), + ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules ), + ( "ImplicitParams", Opt_ImplicitParams ), + ( "ScopedTypeVariables", Opt_ScopedTypeVariables ), + ( "UnboxedTuples", Opt_UnboxedTuples ), + ( "StandaloneDeriving", Opt_StandaloneDeriving ), + ( "DeriveDataTypeable", Opt_DeriveDataTypeable ), + ( "TypeSynonymInstances", Opt_TypeSynonymInstances ), + ( "FlexibleContexts", Opt_FlexibleContexts ), + ( "FlexibleInstances", Opt_FlexibleInstances ), + ( "ConstrainedClassMethods", Opt_ConstrainedClassMethods ), + ( "MultiParamTypeClasses", Opt_MultiParamTypeClasses ), + ( "FunctionalDependencies", Opt_FunctionalDependencies ), + ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving ), + ( "OverlappingInstances", Opt_OverlappingInstances ), + ( "UndecidableInstances", Opt_UndecidableInstances ), + ( "IncoherentInstances", Opt_IncoherentInstances ) + ] -glasgowExtsFlags = [ - Opt_GlasgowExts, - Opt_FFI, - Opt_ImplicitParams, - Opt_ScopedTypeVariables, - Opt_IndexedTypes ] +impliedFlags :: [(DynFlag, [DynFlag])] +impliedFlags = [ + ( Opt_GADTs, [Opt_RelaxedPolyRec] ) -- We want type-sig variables to be completely rigid for GADTs + ] -isFFlag f = f `elem` (map fst fFlags) -getFFlag f = fromJust (lookup f fFlags) +glasgowExtsFlags = [ + Opt_PrintExplicitForalls + , Opt_ForeignFunctionInterface + , Opt_UnliftedFFITypes + , Opt_GADTs + , Opt_ImplicitParams + , Opt_ScopedTypeVariables + , Opt_UnboxedTuples + , Opt_TypeSynonymInstances + , Opt_StandaloneDeriving + , Opt_DeriveDataTypeable + , Opt_FlexibleContexts + , Opt_FlexibleInstances + , Opt_ConstrainedClassMethods + , Opt_MultiParamTypeClasses + , Opt_FunctionalDependencies + , Opt_MagicHash + , Opt_PolymorphicComponents + , Opt_ExistentialQuantification + , Opt_UnicodeSyntax + , Opt_PatternGuards + , Opt_LiberalTypeSynonyms + , Opt_RankNTypes + , Opt_TypeOperators + , Opt_RecursiveDo + , Opt_ParallelListComp + , Opt_EmptyDataDecls + , Opt_KindSignatures + , Opt_PatternSignatures + , Opt_GeneralizedNewtypeDeriving + , Opt_TypeFamilies ] + +------------------ +isFlag :: [(String,a)] -> String -> Bool +isFlag flags f = any (\(ff,_) -> ff == f) flags + +isPrefFlag :: String -> [(String,a)] -> String -> Bool +isPrefFlag pref flags no_f + | Just f <- maybePrefixMatch pref no_f = isFlag flags f + | otherwise = False + +------------------ +getFlag :: [(String,a)] -> String -> a +getFlag flags f = case [ opt | (ff, opt) <- flags, ff == f] of + (o:os) -> o + [] -> panic ("get_flag " ++ f) + +getPrefFlag :: String -> [(String,a)] -> String -> a +getPrefFlag pref flags f = getFlag flags (fromJust (maybePrefixMatch pref f)) +-- We should only be passed flags which match the prefix -- ----------------------------------------------------------------------------- -- Parsing the dynamic flags. @@ -1100,10 +1379,18 @@ upd f = do dfs <- getCmdLineState putCmdLineState $! (f dfs) +-------------------------- setDynFlag, unSetDynFlag :: DynFlag -> DynP () -setDynFlag f = upd (\dfs -> dopt_set dfs f) +setDynFlag f = upd (\dfs -> foldl dopt_set (dopt_set dfs f) deps) + where + deps = [ d | (f', ds) <- impliedFlags, f' == f, d <- ds ] + -- When you set f, set the ones it implies + -- When you un-set f, however, we don't un-set the things it implies + -- (except for -fno-glasgow-exts, which is treated specially) + unSetDynFlag f = upd (\dfs -> dopt_unset dfs f) +-------------------------- setDumpFlag :: DynFlag -> OptKind DynP setDumpFlag dump_flag = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag) @@ -1162,15 +1449,16 @@ setOptLevel n dflags 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 (== '.') @@ -1289,6 +1577,18 @@ setOptHpcDir arg = upd $ \ d -> d{hpcDir = arg} ----------------------------------------------------------------------------- -- Via-C compilation stuff +-- There are some options that we need to pass to gcc when compiling +-- Haskell code via C, but are only supported by recent versions of +-- gcc. The configure script decides which of these options we need, +-- and puts them in the file "extra-gcc-opts" in $topdir, which is +-- read before each via-C compilation. The advantage of having these +-- in a separate file is that the file can be created at install-time +-- depending on the available gcc version, and even re-generated later +-- if gcc is upgraded. +-- +-- The options below are not dependent on the version of gcc, only the +-- platform. + machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations [String]) -- for registerised HC compilations machdepCCOpts dflags @@ -1328,23 +1628,9 @@ machdepCCOpts dflags sta = opt_Static in ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" --- , if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" +-- , if "mingw32" `isSuffixOf` cTARGETPLATFORM then "-mno-cygwin" else "" ], [ "-fno-defer-pop", -#ifdef HAVE_GCC_MNO_OMIT_LFPTR - -- Some gccs are configured with - -- -momit-leaf-frame-pointer on by default, and it - -- apparently takes precedence over - -- -fomit-frame-pointer, so we disable it first here. - "-mno-omit-leaf-frame-pointer", -#endif -#ifdef HAVE_GCC_HAS_NO_UNIT_AT_A_TIME - "-fno-unit-at-a-time", - -- unit-at-a-time doesn't do us any good, and screws - -- up -split-objs by moving the split markers around. - -- It's only turned on with -O2, but put it here just - -- in case someone uses -optc-O2. -#endif "-fomit-frame-pointer", -- we want -fno-builtin, because when gcc inlines -- built-in functions like memcpy() it tends to @@ -1363,13 +1649,6 @@ machdepCCOpts dflags -- and get in the way of -split-objs. Another option -- would be to throw them away in the mangler, but this -- is easier. -#ifdef HAVE_GCC_HAS_NO_UNIT_AT_A_TIME - "-fno-unit-at-a-time", - -- unit-at-a-time doesn't do us any good, and screws - -- up -split-objs by moving the split markers around. - -- It's only turned on with -O2, but put it here just - -- in case someone uses -optc-O2. -#endif "-fno-builtin" -- calling builtins like strlen() using the FFI can -- cause gcc to run out of regs, so use the external @@ -1404,15 +1683,18 @@ picCCOpts dflags -- in dynamic libraries. | opt_PIC - = ["-fno-common"] + = ["-fno-common", "-D__PIC__"] | otherwise = ["-mdynamic-no-pic"] #elif mingw32_TARGET_OS -- no -fPIC for Windows + | opt_PIC + = ["-D__PIC__"] + | otherwise = [] #else | opt_PIC - = ["-fPIC"] + = ["-fPIC", "-D__PIC__"] | otherwise = [] #endif @@ -1421,18 +1703,24 @@ picCCOpts dflags -- Splitting can_split :: Bool -can_split = -#if defined(i386_TARGET_ARCH) \ - || defined(x86_64_TARGET_ARCH) \ - || defined(alpha_TARGET_ARCH) \ - || defined(hppa_TARGET_ARCH) \ - || defined(m68k_TARGET_ARCH) \ - || defined(mips_TARGET_ARCH) \ - || defined(powerpc_TARGET_ARCH) \ - || defined(rs6000_TARGET_ARCH) \ - || defined(sparc_TARGET_ARCH) - True -#else - False -#endif +can_split = cSplitObjs == "YES" + +-- ----------------------------------------------------------------------------- +-- Compiler Info + +compilerInfo :: [(String, String)] +compilerInfo = [("Project name", cProjectName), + ("Project version", cProjectVersion), + ("Booter version", cBooterVersion), + ("Stage", cStage), + ("Interface file version", cHscIfaceFileVersion), + ("Have interpreter", cGhcWithInterpreter), + ("Object splitting", cSplitObjs), + ("Have native code generator", cGhcWithNativeCodeGen), + ("Support SMP", cGhcWithSMP), + ("Unregisterised", cGhcUnregisterised), + ("Tables next to code", cGhcEnableTablesNextToCode), + ("Win32 DLLs", cEnableWin32DLLs), + ("RTS ways", cGhcRTSWays), + ("Leading underscore", cLeadingUnderscore)]