FIX #1748: -main-is wasn't handling the case of a single hierarchical module
[ghc-hetmet.git] / compiler / main / DynFlags.hs
index c3d9c5d..65ddd2d 100644 (file)
@@ -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
 --
 -----------------------------------------------------------------------------
 
-{-# 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
-
 module DynFlags (
        -- Dynamic flags
        DynFlag(..),
@@ -91,7 +91,7 @@ import Data.List      ( isPrefixOf )
 import Util            ( split )
 #endif
 
-import Data.Char       ( isUpper )
+import Data.Char
 import System.IO        ( hPutStrLn, stderr )
 
 -- -----------------------------------------------------------------------------
@@ -102,6 +102,7 @@ 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
@@ -155,6 +156,7 @@ data DynFlag
    | Opt_DoCoreLinting
    | Opt_DoStgLinting
    | Opt_DoCmmLinting
+   | Opt_DoAsmLinting
 
    | Opt_WarnIsError                   -- -Werror; makes warnings fatal
    | Opt_WarnDuplicateExports
@@ -222,7 +224,7 @@ data DynFlag
    | Opt_GeneralizedNewtypeDeriving
    | Opt_RecursiveDo
    | Opt_PatternGuards
-   | Opt_PartiallyAppliedClosedTypeSynonyms
+   | Opt_LiberalTypeSynonyms
    | Opt_Rank2Types
    | Opt_RankNTypes
    | Opt_TypeOperators
@@ -246,7 +248,8 @@ data DynFlag
    | Opt_DictsCheap
    | Opt_RewriteRules
    | Opt_Vectorise
-   | Opt_RegsGraph
+   | Opt_RegsGraph                     -- do graph coloring register allocation
+   | Opt_RegsIterative                 -- do iterative coalescing graph coloring register allocation
 
    -- misc opts
    | Opt_Cpp
@@ -265,6 +268,7 @@ data DynFlag
    | Opt_Hpc_No_Auto
    | Opt_BreakOnException
    | Opt_BreakOnError
+   | Opt_PrintEvldWithShow
    | Opt_GenManifest
    | Opt_EmbedManifest
    | Opt_RunCPSZ
@@ -570,9 +574,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}
@@ -977,15 +983,15 @@ 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 -------------------------------------
@@ -1032,6 +1038,7 @@ dynamic_flags = [
 
   ,  ( "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)
@@ -1085,6 +1092,7 @@ dynamic_flags = [
   ,  ( "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))
@@ -1191,10 +1199,12 @@ fFlags = [
   ( "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:
@@ -1249,8 +1259,7 @@ xFlags = [
   ( "ParallelListComp",                 Opt_ParallelListComp ),
   ( "ForeignFunctionInterface",         Opt_ForeignFunctionInterface ),
   ( "UnliftedFFITypes",                 Opt_UnliftedFFITypes ),
-  ( "PartiallyAppliedClosedTypeSynonyms",
-    Opt_PartiallyAppliedClosedTypeSynonyms ),
+  ( "LiberalTypeSynonyms",             Opt_LiberalTypeSynonyms ),
   ( "Rank2Types",                       Opt_Rank2Types ),
   ( "RankNTypes",                       Opt_RankNTypes ),
   ( "TypeOperators",                    Opt_TypeOperators ),
@@ -1317,7 +1326,7 @@ glasgowExtsFlags = [
            , Opt_ExistentialQuantification
            , Opt_UnicodeSyntax
            , Opt_PatternGuards
-           , Opt_PartiallyAppliedClosedTypeSynonyms
+           , Opt_LiberalTypeSynonyms
            , Opt_RankNTypes
            , Opt_TypeOperators
            , Opt_RecursiveDo
@@ -1436,15 +1445,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 (== '.')