X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=5d8922cd069cc14a1ba89b546389f5f83ee13a08;hb=e4ec08ed1808aa8b75e79d4a9261aaeb3df5df24;hp=a16b8b3ba805b789a236c3fd3f575b75d0499456;hpb=8af9e46751058eecc15d0251c5e250ebcb8367da;p=ghc-hetmet.git

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index a16b8b3..5d8922c 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -61,7 +61,7 @@ module DynFlags (
 
 #include "HsVersions.h"
 
-import Module		( Module, mkModuleName, mkModule, ModLocation )
+import Module
 import PackageConfig
 import PrelNames	( mAIN )
 #ifdef i386_TARGET_ARCH
@@ -91,7 +91,7 @@ import Data.List	( isPrefixOf )
 import Util		( split )
 #endif
 
-import Data.Char	( isUpper )
+import Data.Char
 import System.IO        ( hPutStrLn, stderr )
 
 -- -----------------------------------------------------------------------------
@@ -151,6 +151,7 @@ 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
@@ -203,6 +204,7 @@ data DynFlag
    | Opt_DisambiguateRecordFields
    | Opt_RecordWildCards
    | Opt_RecordPuns
+   | Opt_ViewPatterns
    | Opt_GADTs
    | Opt_RelaxedPolyRec
    | Opt_StandaloneDeriving
@@ -265,6 +267,7 @@ data DynFlag
    | Opt_HideAllPackages
    | Opt_PrintBindResult
    | Opt_Haddock
+   | Opt_HaddockOptions
    | Opt_Hpc_No_Auto
    | Opt_BreakOnException
    | Opt_BreakOnError
@@ -381,14 +384,16 @@ 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
   flags      		:: [DynFlag],
   
   -- message output
-  log_action            :: Severity -> SrcSpan -> PprStyle -> Message -> IO ()
+  log_action            :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),
+
+  haddockOptions :: Maybe String
  }
 
 data HscTarget
@@ -517,6 +522,7 @@ defaultDynFlags =
 	packageFlags		= [],
         pkgDatabase             = Nothing,
         pkgState                = panic "no package state yet: call GHC.setSessionDynFlags",
+  haddockOptions = Nothing,
 	flags = [ 
     	    Opt_ReadUserPackageConf,
     
@@ -615,6 +621,8 @@ addOptwindres f d = d{ opt_windres = f : opt_windres d}
 
 addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d}
 
+addHaddockOpts f d = d{ haddockOptions = Just f}
+
 -- -----------------------------------------------------------------------------
 -- Command-line options
 
@@ -1009,6 +1017,7 @@ 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) -----
@@ -1087,6 +1096,7 @@ dynamic_flags = [
   ,  ( "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))
@@ -1275,6 +1285,7 @@ xFlags = [
   ( "DisambiguateRecordFields",         Opt_DisambiguateRecordFields ),
   ( "OverloadedStrings",                Opt_OverloadedStrings ),
   ( "GADTs",                            Opt_GADTs ),
+  ( "ViewPatterns",                     Opt_ViewPatterns),
   ( "TypeFamilies",                     Opt_TypeFamilies ),
   ( "BangPatterns",                     Opt_BangPatterns ),
   -- On by default:
@@ -1445,15 +1456,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 (== '.')