X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=7b06a48dd0646f499df48eab5d15a6b33f3920ca;hb=bda0a4f655b2f9892d2778b0ab1b5d437c392226;hp=5a0040113c205938ebca0801a48d1ef7b23f3eb2;hpb=5e05865dffed03c40b5d15831d26f903d5d73ede;p=ghc-hetmet.git

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 5a00401..7b06a48 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -177,6 +177,9 @@ data DynFlag
    | Opt_BangPatterns
    | Opt_TypeFamilies
    | Opt_OverloadedStrings
+   | Opt_DisambiguateRecordFields
+   | Opt_RecordDotDot
+   | Opt_RecordPuns
    | Opt_GADTs
    | Opt_RelaxedPolyRec			-- -X=RelaxedPolyRec
 
@@ -558,13 +561,14 @@ 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
@@ -1025,7 +1029,8 @@ dynamic_flags = [
   ,  ( "f", 		PrefixPred (isNoFlag fFlags) (\f -> unSetDynFlag (getNoFlag fFlags f)) )
 
 	-- For now, allow -X flags with -f; ToDo: report this as deprecated
-  ,  ( "f",		PrefixPred (isFlag xFlags) (\f ->  setDynFlag (getFlag fFlags f)) )
+  ,  ( "f",		PrefixPred (isFlag xFlags) (\f ->  setDynFlag (getFlag xFlags f)) )
+  ,  ( "f", 		PrefixPred (isNoFlag xFlags) (\f -> unSetDynFlag (getNoFlag xFlags f)) )
 
 	-- the rest of the -X* and -Xno-* flags
   ,  ( "X",		PrefixPred (isFlag xFlags)   (\f -> setDynFlag   (getFlag xFlags f)) )
@@ -1117,6 +1122,7 @@ impliedFlags = [
 
 glasgowExtsFlags = [ Opt_GlasgowExts 
 		   , Opt_FFI 
+		   , Opt_GADTs
 		   , Opt_ImplicitParams 
 		   , Opt_ScopedTypeVariables
 		   , Opt_TypeFamilies ]
@@ -1138,10 +1144,12 @@ getFlag, getNoFlag :: [(String,a)] -> String -> a
 
 getFlag flags f = get_flag flags (normaliseFlag f)
 
-getNoFlag flags f = getFlag flags (fromJust (noFlag_maybe (normaliseFlag f)))
+getNoFlag flags f = get_flag flags (fromJust (noFlag_maybe (normaliseFlag f)))
 			-- The flag should be a no-flag already
 
-get_flag flags nf = head [ opt | (ff, opt) <- flags, normaliseFlag ff == nf]
+get_flag flags nf = case [ opt | (ff, opt) <- flags, normaliseFlag ff == nf] of
+			(o:os) -> o
+			[]     -> panic ("get_flag " ++ nf)
 
 ------------------
 noFlag_maybe :: String -> Maybe String