X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=fb873917a3a9de76373ac7c6b8c1c156cd86363e;hb=d04e338c3b78fb76341e374bf776b14cbca78bd1;hp=df4052cff4d2824efefd24302faa92c8a37dd3da;hpb=e1b45af148b2db08518a543f58c28a60c1f815b6;p=ghc-hetmet.git

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index df4052c..fb87391 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1,6 +1,5 @@
 
 {-# 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
@@ -61,6 +60,8 @@ module DynFlags (
     compilerInfo,
   ) where
 
+-- XXX This define is a bit of a hack, and should be done more nicely
+#define FAST_STRING_NOT_NEEDED 1
 #include "HsVersions.h"
 
 import Module
@@ -87,11 +88,6 @@ import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
 import Data.IORef	( readIORef )
 import Control.Exception ( throwDyn )
 import Control.Monad	( when )
-#ifdef mingw32_TARGET_OS
-import Data.List	( isPrefixOf )
-#else
-import Util		( split )
-#endif
 
 import Data.Char
 import System.FilePath
@@ -197,6 +193,7 @@ data DynFlag
    | Opt_PArr				-- Syntactic support for parallel arrays
    | Opt_Arrows				-- Arrow-notation syntax
    | Opt_TemplateHaskell
+   | Opt_QuasiQuotes
    | Opt_ImplicitParams
    | Opt_Generics
    | Opt_ImplicitPrelude 
@@ -445,7 +442,7 @@ data GhcLink	-- What to do in the link step, if there is one
 
 isNoLink :: GhcLink -> Bool
 isNoLink NoLink = True
-isNoLink other  = False
+isNoLink _      = False
 
 data PackageFlag
   = ExposePackage  String
@@ -453,10 +450,12 @@ data PackageFlag
   | IgnorePackage  String
   deriving Eq
 
+defaultHscTarget :: HscTarget
 defaultHscTarget = defaultObjectTarget
 
 -- | the 'HscTarget' value corresponding to the default way to create
 -- object files on the current platform.
+defaultObjectTarget :: HscTarget
 defaultObjectTarget
   | cGhcWithNativeCodeGen == "YES" 	=  HscAsm
   | otherwise				=  HscC
@@ -467,6 +466,7 @@ data DynLibLoader
   | SystemDependent
   deriving Eq
 
+initDynFlags :: DynFlags -> IO DynFlags
 initDynFlags dflags = do
  -- someday these will be dynamic flags
  ways <- readIORef v_Ways
@@ -478,6 +478,7 @@ initDynFlags dflags = do
 	rtsBuildTag	= rts_build_tag
 	}
 
+defaultDynFlags :: DynFlags
 defaultDynFlags =
      DynFlags {
 	ghcMode			= CompManager,
@@ -597,6 +598,14 @@ getVerbFlag dflags
   | verbosity dflags >= 3  = "-v" 
   | otherwise =  ""
 
+setObjectDir, setHiDir, setStubDir, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
+         setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,
+         addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptdep, addOptwindres,
+         addCmdlineFramework, addHaddockOpts
+   :: String -> DynFlags -> DynFlags
+setOutputFile, setOutputHi, setDumpPrefixForce
+   :: Maybe String -> DynFlags -> DynFlags
+
 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 }
@@ -708,6 +717,7 @@ optLevelFlags
 -- -----------------------------------------------------------------------------
 -- Standard sets of warning options
 
+standardWarnings :: [DynFlag]
 standardWarnings
     = [ Opt_WarnDeprecations,
 	Opt_WarnOverlappingPatterns,
@@ -716,6 +726,7 @@ standardWarnings
 	Opt_WarnDuplicateExports
       ]
 
+minusWOpts :: [DynFlag]
 minusWOpts
     = standardWarnings ++ 
       [	Opt_WarnUnusedBinds,
@@ -725,6 +736,7 @@ minusWOpts
 	Opt_WarnDodgyImports
       ]
 
+minusWallOpts :: [DynFlag]
 minusWallOpts
     = minusWOpts ++
       [	Opt_WarnTypeDefaults,
@@ -735,6 +747,7 @@ minusWallOpts
       ]
 
 -- minuswRemovesOpts should be every warning option
+minuswRemovesOpts :: [DynFlag]
 minuswRemovesOpts
     = minusWallOpts ++
       [Opt_WarnImplicitPrelude,
@@ -791,7 +804,7 @@ data FloatOutSwitches
 -- The core-to-core pass ordering is derived from the DynFlags:
 runWhen :: Bool -> CoreToDo -> CoreToDo
 runWhen True  do_this = do_this
-runWhen False do_this = CoreDoNothing
+runWhen False _       = CoreDoNothing
 
 runMaybe :: Maybe a -> (a -> CoreToDo) -> CoreToDo
 runMaybe (Just x) f = f x
@@ -1205,6 +1218,7 @@ dynamic_flags = [
 
 -- these -f<blah> flags can all be reversed with -fno-<blah>
 
+fFlags :: [(String, DynFlag)]
 fFlags = [
   ( "warn-dodgy-imports",               Opt_WarnDodgyImports ),
   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports ),
@@ -1319,6 +1333,7 @@ xFlags = [
   ( "Arrows",                           Opt_Arrows ),
   ( "PArr",                             Opt_PArr ),
   ( "TemplateHaskell",                  Opt_TemplateHaskell ),
+  ( "QuasiQuotes",                      Opt_QuasiQuotes ),
   ( "Generics",                         Opt_Generics ),
   -- On by default:
   ( "ImplicitPrelude",                  Opt_ImplicitPrelude ),
@@ -1361,6 +1376,7 @@ impliedFlags = [
 							-- 	Note [Scoped tyvars] in TcBinds
   ]
 
+glasgowExtsFlags :: [DynFlag]
 glasgowExtsFlags = [
              Opt_PrintExplicitForalls
            , Opt_ForeignFunctionInterface
@@ -1406,7 +1422,7 @@ isPrefFlag pref flags no_f
 ------------------
 getFlag :: [(String,a)] -> String -> a
 getFlag flags f = case [ opt | (ff, opt) <- flags, ff == f] of
-                      (o:os) -> o
+                      (o:_)  -> o
                       []     -> panic ("get_flag " ++ f)
 
 getPrefFlag :: String -> [(String,a)] -> String -> a
@@ -1453,10 +1469,13 @@ setDumpFlag dump_flag
 setVerbosity :: Maybe Int -> DynP ()
 setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
 
+addCmdlineHCInclude :: String -> DynP ()
 addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})
 
+extraPkgConf_ :: FilePath -> DynP ()
 extraPkgConf_  p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
 
+exposePackage, hidePackage, ignorePackage :: String -> DynP ()
 exposePackage p = 
   upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s })
 hidePackage p = 
@@ -1464,6 +1483,7 @@ hidePackage p =
 ignorePackage p = 
   upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
 
+setPackageName :: String -> DynFlags -> DynFlags
 setPackageName p
   | Nothing <- unpackPackageId pid
   = throwDyn (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
@@ -1474,6 +1494,7 @@ setPackageName p
 
 -- If we're linking a binary, then only targets that produce object
 -- code are allowed (requests for other target types are ignored).
+setTarget :: HscTarget -> DynP ()
 setTarget l = upd set
   where 
    set dfs 
@@ -1484,6 +1505,7 @@ setTarget l = upd set
 -- used by -fasm and -fvia-C, which switch from one to the other, but
 -- not from bytecode to object-code.  The idea is that -fasm/-fvia-C
 -- can be safely used in an OPTIONS_GHC pragma.
+setObjTarget :: HscTarget -> DynP ()
 setObjTarget l = upd set
   where 
    set dfs 
@@ -1518,6 +1540,8 @@ setMainIs arg
 -----------------------------------------------------------------------------
 -- Paths & Libraries
 
+addImportPath, addLibraryPath, addIncludePath, addFrameworkPath :: FilePath -> DynP ()
+
 -- -i on its own deletes the import paths
 addImportPath "" = upd (\s -> s{importPaths = []})
 addImportPath p  = upd (\s -> s{importPaths = importPaths s ++ splitPathList p})
@@ -1532,7 +1556,10 @@ addIncludePath p =
 addFrameworkPath p = 
   upd (\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p})
 
+#ifndef mingw32_TARGET_OS
+split_marker :: Char
 split_marker = ':'   -- not configurable (ToDo)
+#endif
 
 splitPathList :: String -> [String]
 splitPathList s = filter notNull (splitUp s)
@@ -1576,7 +1603,7 @@ splitPathList s = filter notNull (splitUp s)
     -- finding the next split marker.
     findNextPath xs = 
         case break (`elem` split_markers) xs of
-	   (p, d:ds) -> (p, ds)
+           (p, _:ds) -> (p, ds)
 	   (p, xs)   -> (p, xs)
 
     split_markers :: [Char]
@@ -1640,7 +1667,7 @@ setOptHpcDir arg  = upd $ \ d -> d{hpcDir = arg}
 
 machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations
 			      [String]) -- for registerised HC compilations
-machdepCCOpts dflags
+machdepCCOpts _dflags
 #if alpha_TARGET_ARCH
 	=       ( ["-w", "-mieee"
 #ifdef HAVE_THREADED_RTS_SUPPORT
@@ -1673,7 +1700,7 @@ machdepCCOpts dflags
       --
       -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
       --   the fp (%ebp) for our register maps.
-	=  let n_regs = stolen_x86_regs dflags
+	=  let n_regs = stolen_x86_regs _dflags
 	       sta = opt_Static
 	   in
 	            ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
@@ -1721,7 +1748,7 @@ machdepCCOpts dflags
 #endif
 
 picCCOpts :: DynFlags -> [String]
-picCCOpts dflags
+picCCOpts _dflags
 #if darwin_TARGET_OS
       -- Apple prefers to do things the other way round.
       -- PIC is on by default.