X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=bb8555ef65b528247aecdd955717c885b4a1d194;hp=a3330e74912a98180a03ffaa2cdae5734e1e42bb;hb=3998d13f096efb302cf83865b611746765596754;hpb=24b1e13657c3e06e7c97eeab9a6c4f2a0cdd9193 diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index a3330e7..bb8555e 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -83,7 +83,7 @@ import Panic import UniqFM ( UniqFM ) import Util import Maybes ( orElse ) -import SrcLoc ( SrcSpan ) +import SrcLoc import FastString import Outputable import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) @@ -202,7 +202,7 @@ data DynFlag | Opt_TemplateHaskell | Opt_QuasiQuotes | Opt_ImplicitParams - | Opt_Generics + | Opt_Generics -- "Derivable type classes" | Opt_ImplicitPrelude | Opt_ScopedTypeVariables | Opt_UnboxedTuples @@ -1626,7 +1626,6 @@ xFlags = [ ( "ImplicitParams", Opt_ImplicitParams, const Supported ), ( "ScopedTypeVariables", Opt_ScopedTypeVariables, const Supported ), - -- -XPatternSignatures is deprecated; now -XScopedTypeVariables enables pattern signatures ( "PatternSignatures", Opt_ScopedTypeVariables, deprecatedForLanguage "ScopedTypeVariables" ), @@ -1646,12 +1645,13 @@ xFlags = [ ( "PackageImports", Opt_PackageImports, const Supported ) ] -impliedFlags :: [(DynFlag, [DynFlag])] -impliedFlags = [ - ( Opt_GADTs, [Opt_RelaxedPolyRec] ) -- We want type-sig variables to - -- be completely rigid for GADTs - , ( Opt_ScopedTypeVariables, [Opt_RelaxedPolyRec] ) -- Ditto for scoped type variables; see - -- Note [Scoped tyvars] in TcBinds +impliedFlags :: [(DynFlag, DynFlag)] +impliedFlags + = [ (Opt_GADTs, Opt_RelaxedPolyRec) -- We want type-sig variables to + -- be completely rigid for GADTs + + , (Opt_ScopedTypeVariables, Opt_RelaxedPolyRec) -- Ditto for scoped type variables; see + -- Note [Scoped tyvars] in TcBinds ] glasgowExtsFlags :: [DynFlag] @@ -1691,7 +1691,8 @@ glasgowExtsFlags = [ -- ----------------------------------------------------------------------------- -- Parsing the dynamic flags. -parseDynamicFlags :: DynFlags -> [String] -> IO (DynFlags, [String], [String]) +parseDynamicFlags :: DynFlags -> [Located String] + -> IO (DynFlags, [Located String], [Located String]) parseDynamicFlags dflags args = do -- XXX Legacy support code -- We used to accept things like @@ -1700,14 +1701,13 @@ parseDynamicFlags dflags args = do -- optdep -f -optdepdepend -- optdep -f -optdep depend -- but the spaces trip up proper argument handling. So get rid of them. - let f ("-optdep" : x : xs) = ("-optdep" ++ x) : f xs + let f (L p "-optdep" : L _ x : xs) = (L p ("-optdep" ++ x)) : f xs f (x : xs) = x : f xs f xs = xs args' = f args let ((leftover, errs, warns), dflags') = runCmdLine (processArgs dynamic_flags args') dflags - when (not (null errs)) $ do - ghcError (UsageError (unlines errs)) + when (not (null errs)) $ ghcError $ errorsToGhcException errs return (dflags', leftover, warns) type DynP = CmdLineP DynFlags @@ -1719,10 +1719,13 @@ upd f = do -------------------------- setDynFlag, unSetDynFlag :: DynFlag -> DynP () -setDynFlag f = upd (\dfs -> foldl dopt_set (dopt_set dfs f) deps) +setDynFlag f = do { upd (\dfs -> dopt_set dfs f) + ; mapM_ setDynFlag deps } where - deps = [ d | (f', ds) <- impliedFlags, f' == f, d <- ds ] + deps = [ d | (f', d) <- impliedFlags, f' == f ] -- When you set f, set the ones it implies + -- NB: use setDynFlag recursively, in case the implied flags + -- implies further flags -- When you un-set f, however, we don't un-set the things it implies -- (except for -fno-glasgow-exts, which is treated specially)