X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=bf456c97af75ef7600f3b05576e50be16eba9c73;hp=76fafb35cc5bd49187d2032bf2596c4f5c3b54cd;hb=6a05ec5ef5373f61b7f9f5bdc344483417fa801b;hpb=1116b8749571c660d446258481e4e74798bbb864

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 76fafb3..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
@@ -13,13 +20,6 @@
 --
 -----------------------------------------------------------------------------
 
-{-# 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(..),
@@ -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
@@ -224,7 +226,7 @@ data DynFlag
    | Opt_GeneralizedNewtypeDeriving
    | Opt_RecursiveDo
    | Opt_PatternGuards
-   | Opt_PartiallyAppliedClosedTypeSynonyms
+   | Opt_LiberalTypeSynonyms
    | Opt_Rank2Types
    | Opt_RankNTypes
    | Opt_TypeOperators
@@ -381,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
@@ -574,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}
@@ -981,15 +985,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 -------------------------------------
@@ -1085,6 +1089,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))
@@ -1257,8 +1262,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 ),
@@ -1274,6 +1278,7 @@ xFlags = [
   ( "DisambiguateRecordFields",         Opt_DisambiguateRecordFields ),
   ( "OverloadedStrings",                Opt_OverloadedStrings ),
   ( "GADTs",                            Opt_GADTs ),
+  ( "ViewPatterns",                     Opt_ViewPatterns),
   ( "TypeFamilies",                     Opt_TypeFamilies ),
   ( "BangPatterns",                     Opt_BangPatterns ),
   -- On by default:
@@ -1325,7 +1330,7 @@ glasgowExtsFlags = [
            , Opt_ExistentialQuantification
            , Opt_UnicodeSyntax
            , Opt_PatternGuards
-           , Opt_PartiallyAppliedClosedTypeSynonyms
+           , Opt_LiberalTypeSynonyms
            , Opt_RankNTypes
            , Opt_TypeOperators
            , Opt_RecursiveDo
@@ -1444,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 (== '.')