diff options
58 files changed, 712 insertions, 569 deletions
diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs index b0ef583482..691e087ac2 100644 --- a/compiler/basicTypes/MkId.hs +++ b/compiler/basicTypes/MkId.hs @@ -74,6 +74,7 @@ import DynFlags import Outputable import FastString import ListSetOps +import qualified GHC.LanguageExtensions as LangExt import Data.Maybe ( maybeToList ) @@ -622,7 +623,7 @@ dataConSrcToImplBang dataConSrcToImplBang dflags fam_envs arg_ty (HsSrcBang ann unpk NoSrcStrict) - | xopt Opt_StrictData dflags -- StrictData => strict field + | xopt LangExt.StrictData dflags -- StrictData => strict field = dataConSrcToImplBang dflags fam_envs arg_ty (HsSrcBang ann unpk SrcStrict) | otherwise -- no StrictData => lazy field @@ -771,13 +772,13 @@ isUnpackableType dflags fam_envs ty -- We'd get a black hole if we used dataConImplBangs attempt_unpack (HsSrcBang _ SrcUnpack NoSrcStrict) - = xopt Opt_StrictData dflags + = xopt LangExt.StrictData dflags attempt_unpack (HsSrcBang _ SrcUnpack SrcStrict) = True attempt_unpack (HsSrcBang _ NoSrcUnpack SrcStrict) = True -- Be conservative attempt_unpack (HsSrcBang _ NoSrcUnpack NoSrcStrict) - = xopt Opt_StrictData dflags -- Be conservative + = xopt LangExt.StrictData dflags -- Be conservative attempt_unpack _ = False {- diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 9932fb0dfb..1249806fdf 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -66,6 +66,7 @@ import DynFlags import FastString import Util import MonadUtils +import qualified GHC.LanguageExtensions as LangExt import Control.Monad {-********************************************************************** @@ -118,7 +119,7 @@ dsHsBind dflags ; let var' | inline_regardless = var `setIdUnfolding` mkCompulsoryUnfolding core_expr | otherwise = var ; let core_bind@(id,_) = makeCorePair dflags var' False 0 core_expr - force_var = if xopt Opt_Strict dflags + force_var = if xopt LangExt.Strict dflags then [id] else [] ; return (force_var, [core_bind]) } @@ -131,7 +132,7 @@ dsHsBind dflags ; rhs <- dsHsWrapper co_fn (mkLams args body') ; let core_binds@(id,_) = makeCorePair dflags fun False 0 rhs force_var = - if xopt Opt_Strict dflags + if xopt LangExt.Strict dflags && matchGroupArity matches == 0 -- no need to force lambdas then [id] else [] @@ -163,7 +164,7 @@ dsHsBind dflags , abs_ev_binds = ev_binds, abs_binds = binds }) | ABE { abe_wrap = wrap, abe_poly = global , abe_mono = local, abe_prags = prags } <- export - , not (xopt Opt_Strict dflags) -- handle strict binds + , not (xopt LangExt.Strict dflags) -- handle strict binds , not (anyBag (isBangedPatBind . unLoc) binds) -- in the next case = -- push type constraints deeper for pattern match check addDictsDs (toTcTypeBag (listToBag dicts)) $ diff --git a/compiler/deSugar/DsMonad.hs b/compiler/deSugar/DsMonad.hs index 20bae1fa05..befad44933 100644 --- a/compiler/deSugar/DsMonad.hs +++ b/compiler/deSugar/DsMonad.hs @@ -72,6 +72,7 @@ import FastString import Maybes import Var (EvVar) import GHC.Fingerprint +import qualified GHC.LanguageExtensions as LangExt import Data.IORef import Control.Monad @@ -208,7 +209,7 @@ initDs hsc_env mod rdr_env type_env fam_inst_env thing_inside else thing_inside } - checkLoadDAP = do { paEnabled <- xoptM Opt_ParallelArrays + checkLoadDAP = do { paEnabled <- xoptM LangExt.ParallelArrays ; return $ paEnabled && mod /= gHC_PARR' && moduleName mod /= dATA_ARRAY_PARALLEL_NAME diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs index 6d47af35d7..a90c8e6af9 100644 --- a/compiler/deSugar/DsUtils.hs +++ b/compiler/deSugar/DsUtils.hs @@ -72,6 +72,7 @@ import SrcLoc import Util import DynFlags import FastString +import qualified GHC.LanguageExtensions as LangExt import TcEvidence @@ -885,7 +886,7 @@ getUnBangedLPat dflags (L l (ParPat p)) getUnBangedLPat _ (L _ (BangPat p)) = (True,p) getUnBangedLPat dflags (L _ (LazyPat p)) - | xopt Opt_Strict dflags + | xopt LangExt.Strict dflags = (False,p) getUnBangedLPat dflags p - = (xopt Opt_Strict dflags,p) + = (xopt LangExt.Strict dflags,p) diff --git a/compiler/deSugar/MatchLit.hs b/compiler/deSugar/MatchLit.hs index 4e6b8aac53..8fe1b05383 100644 --- a/compiler/deSugar/MatchLit.hs +++ b/compiler/deSugar/MatchLit.hs @@ -43,8 +43,9 @@ import BasicTypes import DynFlags import Util import FastString -import Control.Monad +import qualified GHC.LanguageExtensions as LangExt +import Control.Monad import Data.Int #if __GLASGOW_HASKELL__ < 709 import Data.Traversable (traverse) @@ -184,7 +185,7 @@ warnAboutOverflowedLiterals dflags lit maxB = toInteger (maxBound :: a) sug | minB == -i -- Note [Suggest NegativeLiterals] , i > 0 - , not (xopt Opt_NegativeLiterals dflags) + , not (xopt LangExt.NegativeLiterals dflags) = ptext (sLit "If you are trying to write a large negative literal, use NegativeLiterals") | otherwise = Outputable.empty diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index f3c9eb077a..4692b21520 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -62,6 +62,7 @@ import MonadUtils import Platform import TcRnTypes import Hooks +import qualified GHC.LanguageExtensions as LangExt import Exception import System.Directory @@ -135,8 +136,8 @@ compileOne' m_tc_result mHscMessage location = ms_location summary input_fnpp = ms_hspp_file summary mod_graph = hsc_mod_graph hsc_env0 - needsTH = any (xopt Opt_TemplateHaskell . ms_hspp_opts) mod_graph - needsQQ = any (xopt Opt_QuasiQuotes . ms_hspp_opts) mod_graph + needsTH = any (xopt LangExt.TemplateHaskell . ms_hspp_opts) mod_graph + needsQQ = any (xopt LangExt.QuasiQuotes . ms_hspp_opts) mod_graph needsLinker = needsTH || needsQQ isDynWay = any (== WayDyn) (ways dflags0) isProfWay = any (== WayProf) (ways dflags0) @@ -231,8 +232,8 @@ compileOne' m_tc_result mHscMessage location = ms_location summary input_fn = expectJust "compile:hs" (ml_hs_file location) mod_graph = hsc_mod_graph hsc_env0 - needsTH = any (xopt Opt_TemplateHaskell . ms_hspp_opts) mod_graph - needsQQ = any (xopt Opt_QuasiQuotes . ms_hspp_opts) mod_graph + needsTH = any (xopt LangExt.TemplateHaskell . ms_hspp_opts) mod_graph + needsQQ = any (xopt LangExt.QuasiQuotes . ms_hspp_opts) mod_graph needsLinker = needsTH || needsQQ isDynWay = any (== WayDyn) (ways dflags0) isProfWay = any (== WayProf) (ways dflags0) @@ -841,7 +842,7 @@ runPhase (RealPhase (Cpp sf)) input_fn dflags0 setDynFlags dflags1 liftIO $ checkProcessArgsResult dflags1 unhandled_flags - if not (xopt Opt_Cpp dflags1) then do + if not (xopt LangExt.Cpp dflags1) then do -- we have to be careful to emit warnings only once. unless (gopt Opt_Pp dflags1) $ liftIO $ handleFlagWarnings dflags1 warns diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 63729182dc..3b531f58c4 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -22,7 +22,6 @@ module DynFlags ( DumpFlag(..), GeneralFlag(..), WarningFlag(..), - ExtensionFlag(..), Language(..), PlatformConstants(..), FatalMessager, LogAction, FlushOut(..), FlushErr(..), @@ -207,6 +206,7 @@ import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet import GHC.Foreign (withCString, peekCString) +import qualified GHC.LanguageExtensions as LangExt -- Note [Updating flag description in the User's Guide] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -559,116 +559,6 @@ instance Show SafeHaskellMode where instance Outputable SafeHaskellMode where ppr = text . show -data ExtensionFlag --- See Note [Updating flag description in the User's Guide] - = Opt_Cpp - | Opt_OverlappingInstances - | Opt_UndecidableInstances - | Opt_IncoherentInstances - | Opt_UndecidableSuperClasses - | Opt_MonomorphismRestriction - | Opt_MonoPatBinds - | Opt_MonoLocalBinds - | Opt_RelaxedPolyRec -- Deprecated - | Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting - | Opt_ForeignFunctionInterface - | Opt_UnliftedFFITypes - | Opt_InterruptibleFFI - | Opt_CApiFFI - | Opt_GHCForeignImportPrim - | Opt_JavaScriptFFI - | Opt_ParallelArrays -- Syntactic support for parallel arrays - | Opt_Arrows -- Arrow-notation syntax - | Opt_TemplateHaskell - | Opt_TemplateHaskellQuotes -- subset of TH supported by stage1, no splice - | Opt_QuasiQuotes - | Opt_ImplicitParams - | Opt_ImplicitPrelude - | Opt_ScopedTypeVariables - | Opt_AllowAmbiguousTypes - | Opt_UnboxedTuples - | Opt_BangPatterns - | Opt_TypeFamilies - | Opt_OverloadedStrings - | Opt_OverloadedLists - | Opt_NumDecimals - | Opt_DisambiguateRecordFields - | Opt_RecordWildCards - | Opt_RecordPuns - | Opt_ViewPatterns - | Opt_GADTs - | Opt_GADTSyntax - | Opt_NPlusKPatterns - | Opt_DoAndIfThenElse - | Opt_RebindableSyntax - | Opt_ConstraintKinds - | Opt_PolyKinds -- Kind polymorphism - | Opt_DataKinds -- Datatype promotion - | Opt_InstanceSigs - | Opt_ApplicativeDo - - | Opt_StandaloneDeriving - | Opt_DeriveDataTypeable - | Opt_AutoDeriveTypeable -- Automatic derivation of Typeable - | Opt_DeriveFunctor - | Opt_DeriveTraversable - | Opt_DeriveFoldable - | Opt_DeriveGeneric -- Allow deriving Generic/1 - | Opt_DefaultSignatures -- Allow extra signatures for defmeths - | Opt_DeriveAnyClass -- Allow deriving any class - | Opt_DeriveLift -- Allow deriving Lift - - | Opt_TypeSynonymInstances - | Opt_FlexibleContexts - | Opt_FlexibleInstances - | Opt_ConstrainedClassMethods - | Opt_MultiParamTypeClasses - | Opt_NullaryTypeClasses - | Opt_FunctionalDependencies - | Opt_UnicodeSyntax - | Opt_ExistentialQuantification - | Opt_MagicHash - | Opt_EmptyDataDecls - | Opt_KindSignatures - | Opt_RoleAnnotations - | Opt_ParallelListComp - | Opt_TransformListComp - | Opt_MonadComprehensions - | Opt_GeneralizedNewtypeDeriving - | Opt_RecursiveDo - | Opt_PostfixOperators - | Opt_TupleSections - | Opt_PatternGuards - | Opt_LiberalTypeSynonyms - | Opt_RankNTypes - | Opt_ImpredicativeTypes - | Opt_TypeOperators - | Opt_ExplicitNamespaces - | Opt_PackageImports - | Opt_ExplicitForAll - | Opt_AlternativeLayoutRule - | Opt_AlternativeLayoutRuleTransitional - | Opt_DatatypeContexts - | Opt_NondecreasingIndentation - | Opt_RelaxedLayout - | Opt_TraditionalRecordSyntax - | Opt_LambdaCase - | Opt_MultiWayIf - | Opt_BinaryLiterals - | Opt_NegativeLiterals - | Opt_DuplicateRecordFields - | Opt_OverloadedLabels - | Opt_EmptyCase - | Opt_PatternSynonyms - | Opt_PartialTypeSignatures - | Opt_NamedWildCards - | Opt_StaticPointers - | Opt_Strict - | Opt_StrictData - | Opt_TypeInType - | Opt_MonadFailDesugaring - deriving (Eq, Enum, Show) - type SigOf = Map ModuleName Module getSigOf :: DynFlags -> ModuleName -> Maybe Module @@ -844,9 +734,11 @@ data DynFlags = DynFlags { warnUnsafeOnLoc :: SrcSpan, trustworthyOnLoc :: SrcSpan, -- Don't change this without updating extensionFlags: - extensions :: [OnOff ExtensionFlag], + extensions :: [OnOff LangExt.Extension], -- extensionFlags should always be equal to -- flattenExtensionFlags language extensions + -- LangExt.Extension is defined in libraries/ghc-boot so that it can be used + -- by template-haskell extensionFlags :: IntSet, -- Unfolding control @@ -1683,32 +1575,32 @@ data OnOff a = On a -- OnOffs accumulate in reverse order, so we use foldr in order to -- process them in the right order -flattenExtensionFlags :: Maybe Language -> [OnOff ExtensionFlag] -> IntSet +flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> IntSet flattenExtensionFlags ml = foldr f defaultExtensionFlags where f (On f) flags = IntSet.insert (fromEnum f) flags f (Off f) flags = IntSet.delete (fromEnum f) flags defaultExtensionFlags = IntSet.fromList (map fromEnum (languageExtensions ml)) -languageExtensions :: Maybe Language -> [ExtensionFlag] +languageExtensions :: Maybe Language -> [LangExt.Extension] languageExtensions Nothing -- Nothing => the default case - = Opt_NondecreasingIndentation -- This has been on by default for some time - : delete Opt_DatatypeContexts -- The Haskell' committee decided to - -- remove datatype contexts from the - -- language: + = LangExt.NondecreasingIndentation -- This has been on by default for some time + : delete LangExt.DatatypeContexts -- The Haskell' committee decided to + -- remove datatype contexts from the + -- language: -- http://www.haskell.org/pipermail/haskell-prime/2011-January/003335.html (languageExtensions (Just Haskell2010)) -- NB: MonoPatBinds is no longer the default languageExtensions (Just Haskell98) - = [Opt_ImplicitPrelude, - Opt_MonomorphismRestriction, - Opt_NPlusKPatterns, - Opt_DatatypeContexts, - Opt_TraditionalRecordSyntax, - Opt_NondecreasingIndentation + = [LangExt.ImplicitPrelude, + LangExt.MonomorphismRestriction, + LangExt.NPlusKPatterns, + LangExt.DatatypeContexts, + LangExt.TraditionalRecordSyntax, + LangExt.NondecreasingIndentation -- strictly speaking non-standard, but we always had this -- on implicitly before the option was added in 7.1, and -- turning it off breaks code, so we're keeping it on for @@ -1717,15 +1609,15 @@ languageExtensions (Just Haskell98) ] languageExtensions (Just Haskell2010) - = [Opt_ImplicitPrelude, - Opt_MonomorphismRestriction, - Opt_DatatypeContexts, - Opt_TraditionalRecordSyntax, - Opt_EmptyDataDecls, - Opt_ForeignFunctionInterface, - Opt_PatternGuards, - Opt_DoAndIfThenElse, - Opt_RelaxedPolyRec] + = [LangExt.ImplicitPrelude, + LangExt.MonomorphismRestriction, + LangExt.DatatypeContexts, + LangExt.TraditionalRecordSyntax, + LangExt.EmptyDataDecls, + LangExt.ForeignFunctionInterface, + LangExt.PatternGuards, + LangExt.DoAndIfThenElse, + LangExt.RelaxedPolyRec] -- | Test whether a 'DumpFlag' is set dopt :: DumpFlag -> DynFlags -> Bool @@ -1791,19 +1683,19 @@ wopt_set dfs f = dfs{ warningFlags = IntSet.insert (fromEnum f) (warningFlags df wopt_unset :: DynFlags -> WarningFlag -> DynFlags wopt_unset dfs f = dfs{ warningFlags = IntSet.delete (fromEnum f) (warningFlags dfs) } --- | Test whether a 'ExtensionFlag' is set -xopt :: ExtensionFlag -> DynFlags -> Bool +-- | Test whether a 'LangExt.Extension' is set +xopt :: LangExt.Extension -> DynFlags -> Bool xopt f dflags = fromEnum f `IntSet.member` extensionFlags dflags --- | Set a 'ExtensionFlag' -xopt_set :: DynFlags -> ExtensionFlag -> DynFlags +-- | Set a 'LangExt.Extension' +xopt_set :: DynFlags -> LangExt.Extension -> DynFlags xopt_set dfs f = let onoffs = On f : extensions dfs in dfs { extensions = onoffs, extensionFlags = flattenExtensionFlags (language dfs) onoffs } --- | Unset a 'ExtensionFlag' -xopt_unset :: DynFlags -> ExtensionFlag -> DynFlags +-- | Unset a 'LangExt.Extension' +xopt_unset :: DynFlags -> LangExt.Extension -> DynFlags xopt_unset dfs f = let onoffs = Off f : extensions dfs in dfs { extensions = onoffs, @@ -1896,11 +1788,11 @@ combineSafeFlags a b | a == Sf_None = return b unsafeFlags, unsafeFlagsForInfer :: [(String, DynFlags -> SrcSpan, DynFlags -> Bool, DynFlags -> DynFlags)] unsafeFlags = [ ("-XGeneralizedNewtypeDeriving", newDerivOnLoc, - xopt Opt_GeneralizedNewtypeDeriving, - flip xopt_unset Opt_GeneralizedNewtypeDeriving) + xopt LangExt.GeneralizedNewtypeDeriving, + flip xopt_unset LangExt.GeneralizedNewtypeDeriving) , ("-XTemplateHaskell", thOnLoc, - xopt Opt_TemplateHaskell, - flip xopt_unset Opt_TemplateHaskell) + xopt LangExt.TemplateHaskell, + flip xopt_unset LangExt.TemplateHaskell) ] unsafeFlagsForInfer = unsafeFlags @@ -2240,7 +2132,7 @@ dynamic_flags :: [Flag (CmdLineP DynFlags)] dynamic_flags = [ defFlag "n" (NoArg (addWarn "The -n flag is deprecated and no longer has any effect")) - , defFlag "cpp" (NoArg (setExtensionFlag Opt_Cpp)) + , defFlag "cpp" (NoArg (setExtensionFlag LangExt.Cpp)) , defFlag "F" (NoArg (setGeneralFlag Opt_Pp)) , defFlag "#include" (HasArg (\s -> do @@ -3057,42 +2949,42 @@ fFlags = [ ] -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@ -fLangFlags :: [FlagSpec ExtensionFlag] +fLangFlags :: [FlagSpec LangExt.Extension] fLangFlags = [ -- See Note [Updating flag description in the User's Guide] -- See Note [Supporting CLI completion] - flagSpec' "th" Opt_TemplateHaskell + flagSpec' "th" LangExt.TemplateHaskell (\on -> deprecatedForExtension "TemplateHaskell" on >> checkTemplateHaskellOk on), - flagSpec' "fi" Opt_ForeignFunctionInterface + flagSpec' "fi" LangExt.ForeignFunctionInterface (deprecatedForExtension "ForeignFunctionInterface"), - flagSpec' "ffi" Opt_ForeignFunctionInterface + flagSpec' "ffi" LangExt.ForeignFunctionInterface (deprecatedForExtension "ForeignFunctionInterface"), - flagSpec' "arrows" Opt_Arrows + flagSpec' "arrows" LangExt.Arrows (deprecatedForExtension "Arrows"), - flagSpec' "implicit-prelude" Opt_ImplicitPrelude + flagSpec' "implicit-prelude" LangExt.ImplicitPrelude (deprecatedForExtension "ImplicitPrelude"), - flagSpec' "bang-patterns" Opt_BangPatterns + flagSpec' "bang-patterns" LangExt.BangPatterns (deprecatedForExtension "BangPatterns"), - flagSpec' "monomorphism-restriction" Opt_MonomorphismRestriction + flagSpec' "monomorphism-restriction" LangExt.MonomorphismRestriction (deprecatedForExtension "MonomorphismRestriction"), - flagSpec' "mono-pat-binds" Opt_MonoPatBinds + flagSpec' "mono-pat-binds" LangExt.MonoPatBinds (deprecatedForExtension "MonoPatBinds"), - flagSpec' "extended-default-rules" Opt_ExtendedDefaultRules + flagSpec' "extended-default-rules" LangExt.ExtendedDefaultRules (deprecatedForExtension "ExtendedDefaultRules"), - flagSpec' "implicit-params" Opt_ImplicitParams + flagSpec' "implicit-params" LangExt.ImplicitParams (deprecatedForExtension "ImplicitParams"), - flagSpec' "scoped-type-variables" Opt_ScopedTypeVariables + flagSpec' "scoped-type-variables" LangExt.ScopedTypeVariables (deprecatedForExtension "ScopedTypeVariables"), - flagSpec' "parr" Opt_ParallelArrays + flagSpec' "parr" LangExt.ParallelArrays (deprecatedForExtension "ParallelArrays"), - flagSpec' "PArr" Opt_ParallelArrays + flagSpec' "PArr" LangExt.ParallelArrays (deprecatedForExtension "ParallelArrays"), - flagSpec' "allow-overlapping-instances" Opt_OverlappingInstances + flagSpec' "allow-overlapping-instances" LangExt.OverlappingInstances (deprecatedForExtension "OverlappingInstances"), - flagSpec' "allow-undecidable-instances" Opt_UndecidableInstances + flagSpec' "allow-undecidable-instances" LangExt.UndecidableInstances (deprecatedForExtension "UndecidableInstances"), - flagSpec' "allow-incoherent-instances" Opt_IncoherentInstances + flagSpec' "allow-incoherent-instances" LangExt.IncoherentInstances (deprecatedForExtension "IncoherentInstances") ] @@ -3110,7 +3002,7 @@ supportedExtensions = concatMap toFlagSpecNamePair xFlags -- make sure that `ghc --supported-extensions` omits -- "TemplateHaskell" when it's known to be unsupported. See also -- GHC #11102 for rationale - | flagSpecFlag flg == Opt_TemplateHaskell = [noName] + | flagSpecFlag flg == LangExt.TemplateHaskell = [noName] #endif | otherwise = [name, noName] where @@ -3136,136 +3028,136 @@ safeHaskellFlags = [mkF Sf_Unsafe, mkF Sf_Trustworthy, mkF Sf_Safe] where mkF flag = flagSpec (show flag) flag -- | These -X<blah> flags can all be reversed with -XNo<blah> -xFlags :: [FlagSpec ExtensionFlag] +xFlags :: [FlagSpec LangExt.Extension] xFlags = [ -- See Note [Updating flag description in the User's Guide] -- See Note [Supporting CLI completion] -- Please keep the list of flags below sorted alphabetically - flagSpec "AllowAmbiguousTypes" Opt_AllowAmbiguousTypes, - flagSpec "AlternativeLayoutRule" Opt_AlternativeLayoutRule, + flagSpec "AllowAmbiguousTypes" LangExt.AllowAmbiguousTypes, + flagSpec "AlternativeLayoutRule" LangExt.AlternativeLayoutRule, flagSpec "AlternativeLayoutRuleTransitional" - Opt_AlternativeLayoutRuleTransitional, - flagSpec "Arrows" Opt_Arrows, - flagSpec "AutoDeriveTypeable" Opt_AutoDeriveTypeable, - flagSpec "BangPatterns" Opt_BangPatterns, - flagSpec "BinaryLiterals" Opt_BinaryLiterals, - flagSpec "CApiFFI" Opt_CApiFFI, - flagSpec "CPP" Opt_Cpp, - flagSpec "ConstrainedClassMethods" Opt_ConstrainedClassMethods, - flagSpec "ConstraintKinds" Opt_ConstraintKinds, - flagSpec "DataKinds" Opt_DataKinds, - flagSpec' "DatatypeContexts" Opt_DatatypeContexts + LangExt.AlternativeLayoutRuleTransitional, + flagSpec "Arrows" LangExt.Arrows, + flagSpec "AutoDeriveTypeable" LangExt.AutoDeriveTypeable, + flagSpec "BangPatterns" LangExt.BangPatterns, + flagSpec "BinaryLiterals" LangExt.BinaryLiterals, + flagSpec "CApiFFI" LangExt.CApiFFI, + flagSpec "CPP" LangExt.Cpp, + flagSpec "ConstrainedClassMethods" LangExt.ConstrainedClassMethods, + flagSpec "ConstraintKinds" LangExt.ConstraintKinds, + flagSpec "DataKinds" LangExt.DataKinds, + flagSpec' "DatatypeContexts" LangExt.DatatypeContexts (\ turn_on -> when turn_on $ deprecate $ "It was widely considered a misfeature, " ++ "and has been removed from the Haskell language."), - flagSpec "DefaultSignatures" Opt_DefaultSignatures, - flagSpec "DeriveAnyClass" Opt_DeriveAnyClass, - flagSpec "DeriveDataTypeable" Opt_DeriveDataTypeable, - flagSpec "DeriveFoldable" Opt_DeriveFoldable, - flagSpec "DeriveFunctor" Opt_DeriveFunctor, - flagSpec "DeriveGeneric" Opt_DeriveGeneric, - flagSpec "DeriveLift" Opt_DeriveLift, - flagSpec "DeriveTraversable" Opt_DeriveTraversable, - flagSpec "DisambiguateRecordFields" Opt_DisambiguateRecordFields, - flagSpec "DoAndIfThenElse" Opt_DoAndIfThenElse, - flagSpec' "DoRec" Opt_RecursiveDo + flagSpec "DefaultSignatures" LangExt.DefaultSignatures, + flagSpec "DeriveAnyClass" LangExt.DeriveAnyClass, + flagSpec "DeriveDataTypeable" LangExt.DeriveDataTypeable, + flagSpec "DeriveFoldable" LangExt.DeriveFoldable, + flagSpec "DeriveFunctor" LangExt.DeriveFunctor, + flagSpec "DeriveGeneric" LangExt.DeriveGeneric, + flagSpec "DeriveLift" LangExt.DeriveLift, + flagSpec "DeriveTraversable" LangExt.DeriveTraversable, + flagSpec "DisambiguateRecordFields" LangExt.DisambiguateRecordFields, + flagSpec "DoAndIfThenElse" LangExt.DoAndIfThenElse, + flagSpec' "DoRec" LangExt.RecursiveDo (deprecatedForExtension "RecursiveDo"), - flagSpec "DuplicateRecordFields" Opt_DuplicateRecordFields, - flagSpec "EmptyCase" Opt_EmptyCase, - flagSpec "EmptyDataDecls" Opt_EmptyDataDecls, - flagSpec "ExistentialQuantification" Opt_ExistentialQuantification, - flagSpec "ExplicitForAll" Opt_ExplicitForAll, - flagSpec "ExplicitNamespaces" Opt_ExplicitNamespaces, - flagSpec "ExtendedDefaultRules" Opt_ExtendedDefaultRules, - flagSpec "FlexibleContexts" Opt_FlexibleContexts, - flagSpec "FlexibleInstances" Opt_FlexibleInstances, - flagSpec "ForeignFunctionInterface" Opt_ForeignFunctionInterface, - flagSpec "FunctionalDependencies" Opt_FunctionalDependencies, - flagSpec "GADTSyntax" Opt_GADTSyntax, - flagSpec "GADTs" Opt_GADTs, - flagSpec "GHCForeignImportPrim" Opt_GHCForeignImportPrim, - flagSpec' "GeneralizedNewtypeDeriving" Opt_GeneralizedNewtypeDeriving + flagSpec "DuplicateRecordFields" LangExt.DuplicateRecordFields, + flagSpec "EmptyCase" LangExt.EmptyCase, + flagSpec "EmptyDataDecls" LangExt.EmptyDataDecls, + flagSpec "ExistentialQuantification" LangExt.ExistentialQuantification, + flagSpec "ExplicitForAll" LangExt.ExplicitForAll, + flagSpec "ExplicitNamespaces" LangExt.ExplicitNamespaces, + flagSpec "ExtendedDefaultRules" LangExt.ExtendedDefaultRules, + flagSpec "FlexibleContexts" LangExt.FlexibleContexts, + flagSpec "FlexibleInstances" LangExt.FlexibleInstances, + flagSpec "ForeignFunctionInterface" LangExt.ForeignFunctionInterface, + flagSpec "FunctionalDependencies" LangExt.FunctionalDependencies, + flagSpec "GADTSyntax" LangExt.GADTSyntax, + flagSpec "GADTs" LangExt.GADTs, + flagSpec "GHCForeignImportPrim" LangExt.GHCForeignImportPrim, + flagSpec' "GeneralizedNewtypeDeriving" LangExt.GeneralizedNewtypeDeriving setGenDeriving, - flagSpec "ImplicitParams" Opt_ImplicitParams, - flagSpec "ImplicitPrelude" Opt_ImplicitPrelude, - flagSpec "ImpredicativeTypes" Opt_ImpredicativeTypes, - flagSpec' "IncoherentInstances" Opt_IncoherentInstances + flagSpec "ImplicitParams" LangExt.ImplicitParams, + flagSpec "ImplicitPrelude" LangExt.ImplicitPrelude, + flagSpec "ImpredicativeTypes" LangExt.ImpredicativeTypes, + flagSpec' "IncoherentInstances" LangExt.IncoherentInstances setIncoherentInsts, - flagSpec "InstanceSigs" Opt_InstanceSigs, - flagSpec "ApplicativeDo" Opt_ApplicativeDo, - flagSpec "InterruptibleFFI" Opt_InterruptibleFFI, - flagSpec "JavaScriptFFI" Opt_JavaScriptFFI, - flagSpec "KindSignatures" Opt_KindSignatures, - flagSpec "LambdaCase" Opt_LambdaCase, - flagSpec "LiberalTypeSynonyms" Opt_LiberalTypeSynonyms, - flagSpec "MagicHash" Opt_MagicHash, - flagSpec "MonadComprehensions" Opt_MonadComprehensions, - flagSpec "MonadFailDesugaring" Opt_MonadFailDesugaring, - flagSpec "MonoLocalBinds" Opt_MonoLocalBinds, - flagSpec' "MonoPatBinds" Opt_MonoPatBinds + flagSpec "InstanceSigs" LangExt.InstanceSigs, + flagSpec "ApplicativeDo" LangExt.ApplicativeDo, + flagSpec "InterruptibleFFI" LangExt.InterruptibleFFI, + flagSpec "JavaScriptFFI" LangExt.JavaScriptFFI, + flagSpec "KindSignatures" LangExt.KindSignatures, + flagSpec "LambdaCase" LangExt.LambdaCase, + flagSpec "LiberalTypeSynonyms" LangExt.LiberalTypeSynonyms, + flagSpec "MagicHash" LangExt.MagicHash, + flagSpec "MonadComprehensions" LangExt.MonadComprehensions, + flagSpec "MonadFailDesugaring" LangExt.MonadFailDesugaring, + flagSpec "MonoLocalBinds" LangExt.MonoLocalBinds, + flagSpec' "MonoPatBinds" LangExt.MonoPatBinds (\ turn_on -> when turn_on $ deprecate "Experimental feature now removed; has no effect"), - flagSpec "MonomorphismRestriction" Opt_MonomorphismRestriction, - flagSpec "MultiParamTypeClasses" Opt_MultiParamTypeClasses, - flagSpec "MultiWayIf" Opt_MultiWayIf, - flagSpec "NPlusKPatterns" Opt_NPlusKPatterns, - flagSpec "NamedFieldPuns" Opt_RecordPuns, - flagSpec "NamedWildCards" Opt_NamedWildCards, - flagSpec "NegativeLiterals" Opt_NegativeLiterals, - flagSpec "NondecreasingIndentation" Opt_NondecreasingIndentation, - flagSpec' "NullaryTypeClasses" Opt_NullaryTypeClasses + flagSpec "MonomorphismRestriction" LangExt.MonomorphismRestriction, + flagSpec "MultiParamTypeClasses" LangExt.MultiParamTypeClasses, + flagSpec "MultiWayIf" LangExt.MultiWayIf, + flagSpec "NPlusKPatterns" LangExt.NPlusKPatterns, + flagSpec "NamedFieldPuns" LangExt.RecordPuns, + flagSpec "NamedWildCards" LangExt.NamedWildCards, + flagSpec "NegativeLiterals" LangExt.NegativeLiterals, + flagSpec "NondecreasingIndentation" LangExt.NondecreasingIndentation, + flagSpec' "NullaryTypeClasses" LangExt.NullaryTypeClasses (deprecatedForExtension "MultiParamTypeClasses"), - flagSpec "NumDecimals" Opt_NumDecimals, - flagSpec' "OverlappingInstances" Opt_OverlappingInstances + flagSpec "NumDecimals" LangExt.NumDecimals, + flagSpec' "OverlappingInstances" LangExt.OverlappingInstances setOverlappingInsts, - flagSpec "OverloadedLabels" Opt_OverloadedLabels, - flagSpec "OverloadedLists" Opt_OverloadedLists, - flagSpec "OverloadedStrings" Opt_OverloadedStrings, - flagSpec "PackageImports" Opt_PackageImports, - flagSpec "ParallelArrays" Opt_ParallelArrays, - flagSpec "ParallelListComp" Opt_ParallelListComp, - flagSpec "PartialTypeSignatures" Opt_PartialTypeSignatures, - flagSpec "PatternGuards" Opt_PatternGuards, - flagSpec' "PatternSignatures" Opt_ScopedTypeVariables + flagSpec "OverloadedLabels" LangExt.OverloadedLabels, + flagSpec "OverloadedLists" LangExt.OverloadedLists, + flagSpec "OverloadedStrings" LangExt.OverloadedStrings, + flagSpec "PackageImports" LangExt.PackageImports, + flagSpec "ParallelArrays" LangExt.ParallelArrays, + flagSpec "ParallelListComp" LangExt.ParallelListComp, + flagSpec "PartialTypeSignatures" LangExt.PartialTypeSignatures, + flagSpec "PatternGuards" LangExt.PatternGuards, + flagSpec' "PatternSignatures" LangExt.ScopedTypeVariables (deprecatedForExtension "ScopedTypeVariables"), - flagSpec "PatternSynonyms" Opt_PatternSynonyms, - flagSpec "PolyKinds" Opt_PolyKinds, - flagSpec "PolymorphicComponents" Opt_RankNTypes, - flagSpec "PostfixOperators" Opt_PostfixOperators, - flagSpec "QuasiQuotes" Opt_QuasiQuotes, - flagSpec "Rank2Types" Opt_RankNTypes, - flagSpec "RankNTypes" Opt_RankNTypes, - flagSpec "RebindableSyntax" Opt_RebindableSyntax, - flagSpec' "RecordPuns" Opt_RecordPuns + flagSpec "PatternSynonyms" LangExt.PatternSynonyms, + flagSpec "PolyKinds" LangExt.PolyKinds, + flagSpec "PolymorphicComponents" LangExt.RankNTypes, + flagSpec "PostfixOperators" LangExt.PostfixOperators, + flagSpec "QuasiQuotes" LangExt.QuasiQuotes, + flagSpec "Rank2Types" LangExt.RankNTypes, + flagSpec "RankNTypes" LangExt.RankNTypes, + flagSpec "RebindableSyntax" LangExt.RebindableSyntax, + flagSpec' "RecordPuns" LangExt.RecordPuns (deprecatedForExtension "NamedFieldPuns"), - flagSpec "RecordWildCards" Opt_RecordWildCards, - flagSpec "RecursiveDo" Opt_RecursiveDo, - flagSpec "RelaxedLayout" Opt_RelaxedLayout, - flagSpec' "RelaxedPolyRec" Opt_RelaxedPolyRec + flagSpec "RecordWildCards" LangExt.RecordWildCards, + flagSpec "RecursiveDo" LangExt.RecursiveDo, + flagSpec "RelaxedLayout" LangExt.RelaxedLayout, + flagSpec' "RelaxedPolyRec" LangExt.RelaxedPolyRec (\ turn_on -> unless turn_on $ deprecate "You can't turn off RelaxedPolyRec any more"), - flagSpec "RoleAnnotations" Opt_RoleAnnotations, - flagSpec "ScopedTypeVariables" Opt_ScopedTypeVariables, - flagSpec "StandaloneDeriving" Opt_StandaloneDeriving, - flagSpec "StaticPointers" Opt_StaticPointers, - flagSpec "Strict" Opt_Strict, - flagSpec "StrictData" Opt_StrictData, - flagSpec' "TemplateHaskell" Opt_TemplateHaskell + flagSpec "RoleAnnotations" LangExt.RoleAnnotations, + flagSpec "ScopedTypeVariables" LangExt.ScopedTypeVariables, + flagSpec "StandaloneDeriving" LangExt.StandaloneDeriving, + flagSpec "StaticPointers" LangExt.StaticPointers, + flagSpec "Strict" LangExt.Strict, + flagSpec "StrictData" LangExt.StrictData, + flagSpec' "TemplateHaskell" LangExt.TemplateHaskell checkTemplateHaskellOk, - flagSpec "TemplateHaskellQuotes" Opt_TemplateHaskellQuotes, - flagSpec "TraditionalRecordSyntax" Opt_TraditionalRecordSyntax, - flagSpec "TransformListComp" Opt_TransformListComp, - flagSpec "TupleSections" Opt_TupleSections, - flagSpec "TypeInType" Opt_TypeInType, - flagSpec "TypeFamilies" Opt_TypeFamilies, - flagSpec "TypeOperators" Opt_TypeOperators, - flagSpec "TypeSynonymInstances" Opt_TypeSynonymInstances, - flagSpec "UnboxedTuples" Opt_UnboxedTuples, - flagSpec "UndecidableInstances" Opt_UndecidableInstances, - flagSpec "UndecidableSuperClasses" Opt_UndecidableSuperClasses, - flagSpec "UnicodeSyntax" Opt_UnicodeSyntax, - flagSpec "UnliftedFFITypes" Opt_UnliftedFFITypes, - flagSpec "ViewPatterns" Opt_ViewPatterns + flagSpec "TemplateHaskellQuotes" LangExt.TemplateHaskellQuotes, + flagSpec "TraditionalRecordSyntax" LangExt.TraditionalRecordSyntax, + flagSpec "TransformListComp" LangExt.TransformListComp, + flagSpec "TupleSections" LangExt.TupleSections, + flagSpec "TypeInType" LangExt.TypeInType, + flagSpec "TypeFamilies" LangExt.TypeFamilies, + flagSpec "TypeOperators" LangExt.TypeOperators, + flagSpec "TypeSynonymInstances" LangExt.TypeSynonymInstances, + flagSpec "UnboxedTuples" LangExt.UnboxedTuples, + flagSpec "UndecidableInstances" LangExt.UndecidableInstances, + flagSpec "UndecidableSuperClasses" LangExt.UndecidableSuperClasses, + flagSpec "UnicodeSyntax" LangExt.UnicodeSyntax, + flagSpec "UnliftedFFITypes" LangExt.UnliftedFFITypes, + flagSpec "ViewPatterns" LangExt.ViewPatterns ] defaultFlags :: Settings -> [GeneralFlag] @@ -3321,57 +3213,57 @@ impliedGFlags = [(Opt_DeferTypeErrors, turnOn, Opt_DeferTypedHoles) impliedOffGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] impliedOffGFlags = [(Opt_Strictness, turnOff, Opt_WorkerWrapper)] -impliedXFlags :: [(ExtensionFlag, TurnOnFlag, ExtensionFlag)] +impliedXFlags :: [(LangExt.Extension, TurnOnFlag, LangExt.Extension)] impliedXFlags -- See Note [Updating flag description in the User's Guide] - = [ (Opt_RankNTypes, turnOn, Opt_ExplicitForAll) - , (Opt_ScopedTypeVariables, turnOn, Opt_ExplicitForAll) - , (Opt_LiberalTypeSynonyms, turnOn, Opt_ExplicitForAll) - , (Opt_ExistentialQuantification, turnOn, Opt_ExplicitForAll) - , (Opt_FlexibleInstances, turnOn, Opt_TypeSynonymInstances) - , (Opt_FunctionalDependencies, turnOn, Opt_MultiParamTypeClasses) - , (Opt_MultiParamTypeClasses, turnOn, Opt_ConstrainedClassMethods) -- c.f. Trac #7854 - - , (Opt_RebindableSyntax, turnOff, Opt_ImplicitPrelude) -- NB: turn off! - - , (Opt_GADTs, turnOn, Opt_GADTSyntax) - , (Opt_GADTs, turnOn, Opt_MonoLocalBinds) - , (Opt_TypeFamilies, turnOn, Opt_MonoLocalBinds) - - , (Opt_TypeFamilies, turnOn, Opt_KindSignatures) -- Type families use kind signatures - , (Opt_PolyKinds, turnOn, Opt_KindSignatures) -- Ditto polymorphic kinds - , (Opt_TypeInType, turnOn, Opt_DataKinds) - , (Opt_TypeInType, turnOn, Opt_PolyKinds) - , (Opt_TypeInType, turnOn, Opt_KindSignatures) + = [ (LangExt.RankNTypes, turnOn, LangExt.ExplicitForAll) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.ExplicitForAll) + , (LangExt.LiberalTypeSynonyms, turnOn, LangExt.ExplicitForAll) + , (LangExt.ExistentialQuantification, turnOn, LangExt.ExplicitForAll) + , (LangExt.FlexibleInstances, turnOn, LangExt.TypeSynonymInstances) + , (LangExt.FunctionalDependencies, turnOn, LangExt.MultiParamTypeClasses) + , (LangExt.MultiParamTypeClasses, turnOn, LangExt.ConstrainedClassMethods) -- c.f. Trac #7854 + + , (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude) -- NB: turn off! + + , (LangExt.GADTs, turnOn, LangExt.GADTSyntax) + , (LangExt.GADTs, turnOn, LangExt.MonoLocalBinds) + , (LangExt.TypeFamilies, turnOn, LangExt.MonoLocalBinds) + + , (LangExt.TypeFamilies, turnOn, LangExt.KindSignatures) -- Type families use kind signatures + , (LangExt.PolyKinds, turnOn, LangExt.KindSignatures) -- Ditto polymorphic kinds + , (LangExt.TypeInType, turnOn, LangExt.DataKinds) + , (LangExt.TypeInType, turnOn, LangExt.PolyKinds) + , (LangExt.TypeInType, turnOn, LangExt.KindSignatures) -- AutoDeriveTypeable is not very useful without DeriveDataTypeable - , (Opt_AutoDeriveTypeable, turnOn, Opt_DeriveDataTypeable) + , (LangExt.AutoDeriveTypeable, turnOn, LangExt.DeriveDataTypeable) -- We turn this on so that we can export associated type -- type synonyms in subordinates (e.g. MyClass(type AssocType)) - , (Opt_TypeFamilies, turnOn, Opt_ExplicitNamespaces) - , (Opt_TypeOperators, turnOn, Opt_ExplicitNamespaces) + , (LangExt.TypeFamilies, turnOn, LangExt.ExplicitNamespaces) + , (LangExt.TypeOperators, turnOn, LangExt.ExplicitNamespaces) - , (Opt_ImpredicativeTypes, turnOn, Opt_RankNTypes) + , (LangExt.ImpredicativeTypes, turnOn, LangExt.RankNTypes) -- Record wild-cards implies field disambiguation -- Otherwise if you write (C {..}) you may well get -- stuff like " 'a' not in scope ", which is a bit silly -- if the compiler has just filled in field 'a' of constructor 'C' - , (Opt_RecordWildCards, turnOn, Opt_DisambiguateRecordFields) + , (LangExt.RecordWildCards, turnOn, LangExt.DisambiguateRecordFields) - , (Opt_ParallelArrays, turnOn, Opt_ParallelListComp) + , (LangExt.ParallelArrays, turnOn, LangExt.ParallelListComp) - , (Opt_JavaScriptFFI, turnOn, Opt_InterruptibleFFI) + , (LangExt.JavaScriptFFI, turnOn, LangExt.InterruptibleFFI) - , (Opt_DeriveTraversable, turnOn, Opt_DeriveFunctor) - , (Opt_DeriveTraversable, turnOn, Opt_DeriveFoldable) + , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFunctor) + , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFoldable) -- Duplicate record fields require field disambiguation - , (Opt_DuplicateRecordFields, turnOn, Opt_DisambiguateRecordFields) + , (LangExt.DuplicateRecordFields, turnOn, LangExt.DisambiguateRecordFields) - , (Opt_TemplateHaskell, turnOn, Opt_TemplateHaskellQuotes) - , (Opt_Strict, turnOn, Opt_StrictData) + , (LangExt.TemplateHaskell, turnOn, LangExt.TemplateHaskellQuotes) + , (LangExt.Strict, turnOn, LangExt.StrictData) ] -- Note [Documenting optimisation flags] @@ -3528,39 +3420,39 @@ disableGlasgowExts :: DynP () disableGlasgowExts = do unSetGeneralFlag Opt_PrintExplicitForalls mapM_ unSetExtensionFlag glasgowExtsFlags -glasgowExtsFlags :: [ExtensionFlag] +glasgowExtsFlags :: [LangExt.Extension] glasgowExtsFlags = [ - Opt_ConstrainedClassMethods - , Opt_DeriveDataTypeable - , Opt_DeriveFoldable - , Opt_DeriveFunctor - , Opt_DeriveGeneric - , Opt_DeriveTraversable - , Opt_EmptyDataDecls - , Opt_ExistentialQuantification - , Opt_ExplicitNamespaces - , Opt_FlexibleContexts - , Opt_FlexibleInstances - , Opt_ForeignFunctionInterface - , Opt_FunctionalDependencies - , Opt_GeneralizedNewtypeDeriving - , Opt_ImplicitParams - , Opt_KindSignatures - , Opt_LiberalTypeSynonyms - , Opt_MagicHash - , Opt_MultiParamTypeClasses - , Opt_ParallelListComp - , Opt_PatternGuards - , Opt_PostfixOperators - , Opt_RankNTypes - , Opt_RecursiveDo - , Opt_ScopedTypeVariables - , Opt_StandaloneDeriving - , Opt_TypeOperators - , Opt_TypeSynonymInstances - , Opt_UnboxedTuples - , Opt_UnicodeSyntax - , Opt_UnliftedFFITypes ] + LangExt.ConstrainedClassMethods + , LangExt.DeriveDataTypeable + , LangExt.DeriveFoldable + , LangExt.DeriveFunctor + , LangExt.DeriveGeneric + , LangExt.DeriveTraversable + , LangExt.EmptyDataDecls + , LangExt.ExistentialQuantification + , LangExt.ExplicitNamespaces + , LangExt.FlexibleContexts + , LangExt.FlexibleInstances + , LangExt.ForeignFunctionInterface + , LangExt.FunctionalDependencies + , LangExt.GeneralizedNewtypeDeriving + , LangExt.ImplicitParams + , LangExt.KindSignatures + , LangExt.LiberalTypeSynonyms + , LangExt.MagicHash + , LangExt.MultiParamTypeClasses + , LangExt.ParallelListComp + , LangExt.PatternGuards + , LangExt.PostfixOperators + , LangExt.RankNTypes + , LangExt.RecursiveDo + , LangExt.ScopedTypeVariables + , LangExt.StandaloneDeriving + , LangExt.TypeOperators + , LangExt.TypeSynonymInstances + , LangExt.UnboxedTuples + , LangExt.UnicodeSyntax + , LangExt.UnliftedFFITypes ] foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt @@ -3729,11 +3621,11 @@ setWarningFlag f = upd (\dfs -> wopt_set dfs f) unSetWarningFlag f = upd (\dfs -> wopt_unset dfs f) -------------------------- -setExtensionFlag, unSetExtensionFlag :: ExtensionFlag -> DynP () +setExtensionFlag, unSetExtensionFlag :: LangExt.Extension -> DynP () setExtensionFlag f = upd (setExtensionFlag' f) unSetExtensionFlag f = upd (unSetExtensionFlag' f) -setExtensionFlag', unSetExtensionFlag' :: ExtensionFlag -> DynFlags -> DynFlags +setExtensionFlag', unSetExtensionFlag' :: LangExt.Extension -> DynFlags -> DynFlags setExtensionFlag' f dflags = foldr ($) (xopt_set dflags f) deps where deps = [ if turn_on then setExtensionFlag' d diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 965f7c1439..74860a1c03 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -341,6 +341,7 @@ import FastString import qualified Parser import Lexer import ApiAnnotation +import qualified GHC.LanguageExtensions as LangExt import System.Directory ( doesFileExist ) import Data.Maybe @@ -1047,7 +1048,7 @@ getModuleGraph = liftM hsc_mod_graph getSession -- have Template Haskell enabled whether it is actually needed or not. needsTemplateHaskell :: ModuleGraph -> Bool needsTemplateHaskell ms = - any (xopt Opt_TemplateHaskell . ms_hspp_opts) ms + any (xopt LangExt.TemplateHaskell . ms_hspp_opts) ms -- | Return @True@ <==> module is loaded. isLoaded :: GhcMonad m => ModuleName -> m Bool diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index d390c16817..f0dc3005f1 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -54,6 +54,7 @@ import StringBuffer import SysTools import UniqFM import Util +import qualified GHC.LanguageExtensions as LangExt import Data.Either ( rights, partitionEithers ) import qualified Data.Map as Map @@ -1986,7 +1987,7 @@ preprocessFile hsc_env src_fn mb_phase (Just (buf, _time)) | Just (Unlit _) <- mb_phase = True | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True -- note: local_opts is only required if there's no Unlit phase - | xopt Opt_Cpp dflags' = True + | xopt LangExt.Cpp dflags' = True | gopt Opt_Pp dflags' = True | otherwise = False diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index 35107c8bc3..3eef327f08 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -38,6 +38,7 @@ import Bag ( emptyBag, listToBag, unitBag ) import MonadUtils import Exception import BasicTypes +import qualified GHC.LanguageExtensions as LangExt import Control.Monad import System.IO @@ -83,7 +84,7 @@ getImports dflags buf filename source_filename = do ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc . ideclName . unLoc) ord_idecls - implicit_prelude = xopt Opt_ImplicitPrelude dflags + implicit_prelude = xopt LangExt.ImplicitPrelude dflags implicit_imports = mkPrelImports (unLoc mod) main_loc implicit_prelude imps convImport (L _ i) = (fmap sl_fs (ideclPkgQual i), ideclName i) diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 3f6fa8c6e0..084cd9ee5c 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -87,6 +87,9 @@ import Data.List import Data.Maybe import Data.Word +-- ghc-boot +import qualified GHC.LanguageExtensions as LangExt + -- bytestring import Data.ByteString (ByteString) @@ -1127,7 +1130,7 @@ varid span buf len = return $ L span keyword Just (ITstatic, _) -> do flags <- getDynFlags - if xopt Opt_StaticPointers flags + if xopt LangExt.StaticPointers flags then return $ L span ITstatic else return $ L span $ ITvarid fs Just (keyword, 0) -> do @@ -2117,39 +2120,39 @@ mkPState flags buf loc = annotations_comments = [] } where - bitmap = FfiBit `setBitIf` xopt Opt_ForeignFunctionInterface flags - .|. InterruptibleFfiBit `setBitIf` xopt Opt_InterruptibleFFI flags - .|. CApiFfiBit `setBitIf` xopt Opt_CApiFFI flags - .|. ParrBit `setBitIf` xopt Opt_ParallelArrays flags - .|. ArrowsBit `setBitIf` xopt Opt_Arrows flags - .|. ThBit `setBitIf` xopt Opt_TemplateHaskell flags - .|. ThQuotesBit `setBitIf` xopt Opt_TemplateHaskellQuotes flags - .|. QqBit `setBitIf` xopt Opt_QuasiQuotes flags - .|. IpBit `setBitIf` xopt Opt_ImplicitParams flags - .|. OverloadedLabelsBit `setBitIf` xopt Opt_OverloadedLabels flags - .|. ExplicitForallBit `setBitIf` xopt Opt_ExplicitForAll flags - .|. BangPatBit `setBitIf` xopt Opt_BangPatterns flags - .|. HaddockBit `setBitIf` gopt Opt_Haddock flags - .|. MagicHashBit `setBitIf` xopt Opt_MagicHash flags - .|. RecursiveDoBit `setBitIf` xopt Opt_RecursiveDo flags - .|. UnicodeSyntaxBit `setBitIf` xopt Opt_UnicodeSyntax flags - .|. UnboxedTuplesBit `setBitIf` xopt Opt_UnboxedTuples flags - .|. DatatypeContextsBit `setBitIf` xopt Opt_DatatypeContexts flags - .|. TransformComprehensionsBit `setBitIf` xopt Opt_TransformListComp flags - .|. TransformComprehensionsBit `setBitIf` xopt Opt_MonadComprehensions flags - .|. RawTokenStreamBit `setBitIf` gopt Opt_KeepRawTokenStream flags - .|. HpcBit `setBitIf` gopt Opt_Hpc flags - .|. AlternativeLayoutRuleBit `setBitIf` xopt Opt_AlternativeLayoutRule flags - .|. RelaxedLayoutBit `setBitIf` xopt Opt_RelaxedLayout flags - .|. SccProfilingOnBit `setBitIf` gopt Opt_SccProfilingOn flags - .|. NondecreasingIndentationBit `setBitIf` xopt Opt_NondecreasingIndentation flags - .|. SafeHaskellBit `setBitIf` safeImportsOn flags - .|. TraditionalRecordSyntaxBit `setBitIf` xopt Opt_TraditionalRecordSyntax flags - .|. ExplicitNamespacesBit `setBitIf` xopt Opt_ExplicitNamespaces flags - .|. LambdaCaseBit `setBitIf` xopt Opt_LambdaCase flags - .|. BinaryLiteralsBit `setBitIf` xopt Opt_BinaryLiterals flags - .|. NegativeLiteralsBit `setBitIf` xopt Opt_NegativeLiterals flags - .|. PatternSynonymsBit `setBitIf` xopt Opt_PatternSynonyms flags + bitmap = FfiBit `setBitIf` xopt LangExt.ForeignFunctionInterface flags + .|. InterruptibleFfiBit `setBitIf` xopt LangExt.InterruptibleFFI flags + .|. CApiFfiBit `setBitIf` xopt LangExt.CApiFFI flags + .|. ParrBit `setBitIf` xopt LangExt.ParallelArrays flags + .|. ArrowsBit `setBitIf` xopt LangExt.Arrows flags + .|. ThBit `setBitIf` xopt LangExt.TemplateHaskell flags + .|. ThQuotesBit `setBitIf` xopt LangExt.TemplateHaskellQuotes flags + .|. QqBit `setBitIf` xopt LangExt.QuasiQuotes flags + .|. IpBit `setBitIf` xopt LangExt.ImplicitParams flags + .|. OverloadedLabelsBit `setBitIf` xopt LangExt.OverloadedLabels flags + .|. ExplicitForallBit `setBitIf` xopt LangExt.ExplicitForAll flags + .|. BangPatBit `setBitIf` xopt LangExt.BangPatterns flags + .|. HaddockBit `setBitIf` gopt Opt_Haddock flags + .|. MagicHashBit `setBitIf` xopt LangExt.MagicHash flags + .|. RecursiveDoBit `setBitIf` xopt LangExt.RecursiveDo flags + .|. UnicodeSyntaxBit `setBitIf` xopt LangExt.UnicodeSyntax flags + .|. UnboxedTuplesBit `setBitIf` xopt LangExt.UnboxedTuples flags + .|. DatatypeContextsBit `setBitIf` xopt LangExt.DatatypeContexts flags + .|. TransformComprehensionsBit `setBitIf` xopt LangExt.TransformListComp flags + .|. TransformComprehensionsBit `setBitIf` xopt LangExt.MonadComprehensions flags + .|. RawTokenStreamBit `setBitIf` gopt Opt_KeepRawTokenStream flags + .|. HpcBit `setBitIf` gopt Opt_Hpc flags + .|. AlternativeLayoutRuleBit `setBitIf` xopt LangExt.AlternativeLayoutRule flags + .|. RelaxedLayoutBit `setBitIf` xopt LangExt.RelaxedLayout flags + .|. SccProfilingOnBit `setBitIf` gopt Opt_SccProfilingOn flags + .|. NondecreasingIndentationBit `setBitIf` xopt LangExt.NondecreasingIndentation flags + .|. SafeHaskellBit `setBitIf` safeImportsOn flags + .|. TraditionalRecordSyntaxBit `setBitIf` xopt LangExt.TraditionalRecordSyntax flags + .|. ExplicitNamespacesBit `setBitIf` xopt LangExt.ExplicitNamespaces flags + .|. LambdaCaseBit `setBitIf` xopt LangExt.LambdaCase flags + .|. BinaryLiteralsBit `setBitIf` xopt LangExt.BinaryLiterals flags + .|. NegativeLiteralsBit `setBitIf` xopt LangExt.NegativeLiterals flags + .|. PatternSynonymsBit `setBitIf` xopt LangExt.PatternSynonyms flags -- setBitIf :: ExtBits -> Bool -> ExtsBitmap b `setBitIf` cond | cond = xbit b @@ -2238,7 +2241,7 @@ srcParseErr dflags buf len (text "Perhaps you need a 'let' in a 'do' block?" $$ text "e.g. 'let x = 5' instead of 'x = 5'") where token = lexemeToString (offsetBytes (-len) buf) len - th_enabled = xopt Opt_TemplateHaskell dflags + th_enabled = xopt LangExt.TemplateHaskell dflags -- Report a parse failure, giving the span of the previous token as -- the location of the error. This is the entry point for errors @@ -2309,7 +2312,7 @@ alternativeLayoutRuleToken t justClosedExplicitLetBlock <- getJustClosedExplicitLetBlock setJustClosedExplicitLetBlock False dflags <- getDynFlags - let transitional = xopt Opt_AlternativeLayoutRuleTransitional dflags + let transitional = xopt LangExt.AlternativeLayoutRuleTransitional dflags thisLoc = getLoc t thisCol = srcSpanStartCol thisLoc newLine = srcSpanStartLine thisLoc > srcSpanEndLine lastLoc diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 06be056575..6606e3fac1 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -83,6 +83,7 @@ import TysWiredIn ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilD import Util ( looksLikePackageName ) import Prelude +import qualified GHC.LanguageExtensions as LangExt } {- Last updated: 18 Nov 2015 @@ -3315,14 +3316,14 @@ fileSrcSpan = do -- Hint about the MultiWayIf extension hintMultiWayIf :: SrcSpan -> P () hintMultiWayIf span = do - mwiEnabled <- liftM ((Opt_MultiWayIf `xopt`) . dflags) getPState + mwiEnabled <- liftM ((LangExt.MultiWayIf `xopt`) . dflags) getPState unless mwiEnabled $ parseErrorSDoc span $ text "Multi-way if-expressions need MultiWayIf turned on" -- Hint about if usage for beginners hintIf :: SrcSpan -> String -> P (LHsExpr RdrName) hintIf span msg = do - mwiEnabled <- liftM ((Opt_MultiWayIf `xopt`) . dflags) getPState + mwiEnabled <- liftM ((LangExt.MultiWayIf `xopt`) . dflags) getPState if mwiEnabled then parseErrorSDoc span $ text $ "parse error in if statement" else parseErrorSDoc span $ text $ "parse error in if statement: "++msg @@ -3339,7 +3340,7 @@ hintExplicitForall span = do ] namedWildCardsEnabled :: P Bool -namedWildCardsEnabled = liftM ((Opt_NamedWildCards `xopt`) . dflags) getPState +namedWildCardsEnabled = liftM ((LangExt.NamedWildCards `xopt`) . dflags) getPState {- %************************************************************************ diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index e8687acb6c..cc8a8ec21c 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -92,6 +92,7 @@ import Maybes import Util import ApiAnnotation import Data.List +import qualified GHC.LanguageExtensions as LangExt #if __GLASGOW_HASKELL__ < 709 import Control.Applicative ((<$>)) @@ -812,7 +813,7 @@ checkAPat msg loc e0 = do -- n+k patterns OpApp (L nloc (HsVar (L _ n))) (L _ (HsVar (L _ plus))) _ (L lloc (HsOverLit lit@(OverLit {ol_val = HsIntegral {}}))) - | xopt Opt_NPlusKPatterns dynflags && (plus == plus_RDR) + | xopt LangExt.NPlusKPatterns dynflags && (plus == plus_RDR) -> return (mkNPlusKPat (L nloc n) (L lloc lit)) OpApp l op _fix r -> do l <- checkLPat msg l @@ -966,7 +967,7 @@ checkDoAndIfThenElse :: LHsExpr RdrName checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr | semiThen || semiElse = do pState <- getPState - unless (xopt Opt_DoAndIfThenElse (dflags pState)) $ do + unless (xopt LangExt.DoAndIfThenElse (dflags pState)) $ do parseErrorSDoc (combineLocs guardExpr elseExpr) (text "Unexpected semi-colons in conditional:" $$ nest 4 expr @@ -1086,7 +1087,7 @@ splitTildeApps (t : rest) = t : concatMap go rest checkMonadComp :: P (HsStmtContext Name) checkMonadComp = do pState <- getPState - return $ if xopt Opt_MonadComprehensions (dflags pState) + return $ if xopt LangExt.MonadComprehensions (dflags pState) then MonadComp else ListComp diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs index c2a45b0fd8..5acf9a3f34 100644 --- a/compiler/rename/RnBinds.hs +++ b/compiler/rename/RnBinds.hs @@ -48,9 +48,11 @@ import Bag import Util import Outputable import FastString -import Data.List ( partition, sort ) import Maybes ( orElse ) +import qualified GHC.LanguageExtensions as LangExt + import Control.Monad +import Data.List ( partition, sort ) #if __GLASGOW_HASKELL__ < 709 import Data.Traversable ( traverse ) #endif @@ -476,7 +478,7 @@ rnBind sig_fn bind@(FunBind { fun_id = name = do { let plain_name = unLoc name ; (matches', rhs_fvs) <- bindSigTyVarsFV (sig_fn plain_name) $ - -- bindSigTyVars tests for Opt_ScopedTyVars + -- bindSigTyVars tests for LangExt.ScopedTyVars rnMatchGroup (FunRhs plain_name) rnLExpr matches ; let is_infix = isInfixFunBind bind @@ -623,7 +625,7 @@ rnPatSynBind _sig_fn bind@(PSB { psb_id = L _ name , psb_def = pat , psb_dir = dir }) -- invariant: no free vars here when it's a FunBind - = do { pattern_synonym_ok <- xoptM Opt_PatternSynonyms + = do { pattern_synonym_ok <- xoptM LangExt.PatternSynonyms ; unless pattern_synonym_ok (addErr patternSynonymErr) ; ((pat', details'), fvs1) <- rnPat PatSyn pat $ \pat' -> do @@ -781,7 +783,7 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs -- Rename the bindings RHSs. Again there's an issue about whether the -- type variables from the class/instance head are in scope. -- Answer no in Haskell 2010, but yes if you have -XScopedTypeVariables - ; scoped_tvs <- xoptM Opt_ScopedTypeVariables + ; scoped_tvs <- xoptM LangExt.ScopedTypeVariables ; (binds'', bind_fvs) <- maybe_extend_tyvar_env scoped_tvs $ do { binds_w_dus <- mapBagM (rnLBind (mkSigTvFn other_sigs')) binds' ; let bind_fvs = foldrBag (\(_,_,fv1) fv2 -> fv1 `plusFV` fv2) @@ -881,7 +883,7 @@ renameSig ctxt sig@(TypeSig vs ty) ; return (TypeSig new_vs new_ty, fvs) } renameSig ctxt sig@(ClassOpSig is_deflt vs ty) - = do { defaultSigs_on <- xoptM Opt_DefaultSignatures + = do { defaultSigs_on <- xoptM LangExt.DefaultSignatures ; when (is_deflt && not defaultSigs_on) $ addErr (defaultSigErr sig) ; new_v <- mapM (lookupSigOccRn ctxt sig) vs @@ -1017,7 +1019,7 @@ rnMatchGroup :: Outputable (body RdrName) => HsMatchContext Name -> MatchGroup RdrName (Located (body RdrName)) -> RnM (MatchGroup Name (Located (body Name)), FreeVars) rnMatchGroup ctxt rnBody (MG { mg_alts = L _ ms, mg_origin = origin }) - = do { empty_case_ok <- xoptM Opt_EmptyCase + = do { empty_case_ok <- xoptM LangExt.EmptyCase ; when (null ms && not empty_case_ok) (addErr (emptyCaseErr ctxt)) ; (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt rnBody) ms ; return (mkMatchGroupName origin new_ms, ms_fvs) } @@ -1097,7 +1099,7 @@ rnGRHS' :: HsMatchContext Name -> GRHS RdrName (Located (body RdrName)) -> RnM (GRHS Name (Located (body Name)), FreeVars) rnGRHS' ctxt rnBody (GRHS guards rhs) - = do { pattern_guards_allowed <- xoptM Opt_PatternGuards + = do { pattern_guards_allowed <- xoptM LangExt.PatternGuards ; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) rnLExpr guards $ \ _ -> rnBody rhs diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index 4337dbb7b1..954eebb06b 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -83,6 +83,7 @@ import Data.List import Data.Function ( on ) import ListSetOps ( minusList ) import Constants ( mAX_TUPLE_SIZE ) +import qualified GHC.LanguageExtensions as LangExt {- ********************************************************* @@ -302,7 +303,7 @@ lookupTopBndrRn_maybe rdr_name -- See Note [Type and class operator definitions] let occ = rdrNameOcc rdr_name ; when (isTcOcc occ && isSymOcc occ) - (do { op_ok <- xoptM Opt_TypeOperators + (do { op_ok <- xoptM LangExt.TypeOperators ; unless op_ok (addErr (opDeclErr rdr_name)) }) ; env <- getGlobalRdrEnv @@ -712,7 +713,7 @@ lookupOccRn rdr_name lookupKindOccRn :: RdrName -> RnM Name -- Looking up a name occurring in a kind lookupKindOccRn rdr_name - = do { typeintype <- xoptM Opt_TypeInType + = do { typeintype <- xoptM LangExt.TypeInType ; if | typeintype -> lookupTypeOccRn rdr_name -- With -XNoTypeInType, treat any usage of * in kinds as in scope -- this is a dirty hack, but then again so was the old * kind. @@ -734,7 +735,7 @@ lookup_demoted :: RdrName -> DynFlags -> RnM Name lookup_demoted rdr_name dflags | Just demoted_rdr <- demoteRdrName rdr_name -- Maybe it's the name of a *data* constructor - = do { data_kinds <- xoptM Opt_DataKinds + = do { data_kinds <- xoptM LangExt.DataKinds ; mb_demoted_name <- lookupOccRn_maybe demoted_rdr ; case mb_demoted_name of Nothing -> unboundNameX WL_Any rdr_name star_info @@ -760,7 +761,7 @@ lookup_demoted rdr_name dflags star_info | is_star rdr_name || is_uni_star rdr_name - = if xopt Opt_TypeInType dflags + = if xopt LangExt.TypeInType dflags then text "NB: With TypeInType, you must import" <+> ppr rdr_name <+> text "from Data.Kind" else empty @@ -1528,7 +1529,7 @@ lookupIfThenElse :: RnM (Maybe (SyntaxExpr Name), FreeVars) -- case we desugar directly rather than calling an existing function -- Hence the (Maybe (SyntaxExpr Name)) return type lookupIfThenElse - = do { rebindable_on <- xoptM Opt_RebindableSyntax + = do { rebindable_on <- xoptM LangExt.RebindableSyntax ; if not rebindable_on then return (Nothing, emptyFVs) else do { ite <- lookupOccRn (mkVarUnqual (fsLit "ifThenElse")) @@ -1537,7 +1538,7 @@ lookupIfThenElse lookupSyntaxName :: Name -- The standard name -> RnM (SyntaxExpr Name, FreeVars) -- Possibly a non-standard name lookupSyntaxName std_name - = do { rebindable_on <- xoptM Opt_RebindableSyntax + = do { rebindable_on <- xoptM LangExt.RebindableSyntax ; if not rebindable_on then return (HsVar (noLoc std_name), emptyFVs) else @@ -1548,7 +1549,7 @@ lookupSyntaxName std_name lookupSyntaxNames :: [Name] -- Standard names -> RnM ([HsExpr Name], FreeVars) -- See comments with HsExpr.ReboundNames lookupSyntaxNames std_names - = do { rebindable_on <- xoptM Opt_RebindableSyntax + = do { rebindable_on <- xoptM LangExt.RebindableSyntax ; if not rebindable_on then return (map (HsVar . noLoc) std_names, emptyFVs) else @@ -1692,7 +1693,8 @@ checkShadowedOccs (global_env,local_env) get_loc_occ ns -- punning or wild-cards are on (cf Trac #2723) is_shadowed_gre gre | isRecFldGRE gre = do { dflags <- getDynFlags - ; return $ not (xopt Opt_RecordPuns dflags || xopt Opt_RecordWildCards dflags) } + ; return $ not (xopt LangExt.RecordPuns dflags + || xopt LangExt.RecordWildCards dflags) } is_shadowed_gre _other = return True {- diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 11d03f4d6a..c52073215a 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -45,6 +45,7 @@ import SrcLoc import FastString import Control.Monad import TysWiredIn ( nilDataConName ) +import qualified GHC.LanguageExtensions as LangExt {- ************************************************************************ @@ -95,7 +96,7 @@ rnUnboundVar v ; return (HsVar (noLoc n), emptyFVs) } } rnExpr (HsVar (L l v)) - = do { opt_DuplicateRecordFields <- xoptM Opt_DuplicateRecordFields + = do { opt_DuplicateRecordFields <- xoptM LangExt.DuplicateRecordFields ; mb_name <- lookupOccRn_overloaded opt_DuplicateRecordFields v ; case mb_name of { Nothing -> rnUnboundVar v ; @@ -119,7 +120,7 @@ rnExpr (HsOverLabel v) = return (HsOverLabel v, emptyFVs) rnExpr (HsLit lit@(HsString src s)) - = do { opt_OverloadedStrings <- xoptM Opt_OverloadedStrings + = do { opt_OverloadedStrings <- xoptM LangExt.OverloadedStrings ; if opt_OverloadedStrings then rnExpr (HsOverLit (mkHsIsString src s placeHolderType)) else do { @@ -231,7 +232,7 @@ rnExpr (HsDo do_or_lc (L l stmts) _) ; return ( HsDo do_or_lc (L l stmts') placeHolderType, fvs ) } rnExpr (ExplicitList _ _ exps) - = do { opt_OverloadedLists <- xoptM Opt_OverloadedLists + = do { opt_OverloadedLists <- xoptM LangExt.OverloadedLists ; (exps', fvs) <- rnExprs exps ; if opt_OverloadedLists then do { @@ -301,7 +302,7 @@ rnExpr (HsType a) ; return (HsType t, fvT) } rnExpr (ArithSeq _ _ seq) - = do { opt_OverloadedLists <- xoptM Opt_OverloadedLists + = do { opt_OverloadedLists <- xoptM LangExt.OverloadedLists ; (new_seq, fvs) <- rnArithSeq seq ; if opt_OverloadedLists then do { @@ -681,7 +682,7 @@ postProcessStmtsForApplicativeDo ctxt stmts -- rearrange the statements using ApplicativeStmt if -- -XApplicativeDo is on. Also strip out the FreeVars attached -- to each Stmt body. - ado_is_on <- xoptM Opt_ApplicativeDo + ado_is_on <- xoptM LangExt.ApplicativeDo ; let is_do_expr | DoExpr <- ctxt = True | otherwise = False ; if ado_is_on && is_do_expr @@ -779,7 +780,7 @@ rnStmt ctxt rnBody (L loc (BindStmt pat body _ _)) thing_inside -- The binders do not scope over the expression ; (bind_op, fvs1) <- lookupStmtName ctxt bindMName - ; xMonadFailEnabled <- fmap (xopt Opt_MonadFailDesugaring) getDynFlags + ; xMonadFailEnabled <- fmap (xopt LangExt.MonadFailDesugaring) getDynFlags ; let failFunction | xMonadFailEnabled = failMName | otherwise = failMName_preMFP ; (fail_op, fvs2) <- lookupSyntaxName failFunction @@ -1088,7 +1089,7 @@ rn_rec_stmt rnBody _ (L loc (BindStmt pat' body _ _), fv_pat) = do { (body', fv_expr) <- rnBody body ; (bind_op, fvs1) <- lookupSyntaxName bindMName - ; xMonadFailEnabled <- fmap (xopt Opt_MonadFailDesugaring) getDynFlags + ; xMonadFailEnabled <- fmap (xopt LangExt.MonadFailDesugaring) getDynFlags ; let failFunction | xMonadFailEnabled = failMName | otherwise = failMName_preMFP ; (fail_op, fvs2) <- lookupSyntaxName failFunction @@ -1763,7 +1764,7 @@ okParStmt dflags ctxt stmt okDoStmt dflags ctxt stmt = case stmt of RecStmt {} - | Opt_RecursiveDo `xopt` dflags -> IsValid + | LangExt.RecursiveDo `xopt` dflags -> IsValid | ArrowExpr <- ctxt -> IsValid -- Arrows allows 'rec' | otherwise -> NotValid (ptext (sLit "Use RecursiveDo")) BindStmt {} -> IsValid @@ -1778,10 +1779,10 @@ okCompStmt dflags _ stmt LetStmt {} -> IsValid BodyStmt {} -> IsValid ParStmt {} - | Opt_ParallelListComp `xopt` dflags -> IsValid + | LangExt.ParallelListComp `xopt` dflags -> IsValid | otherwise -> NotValid (ptext (sLit "Use ParallelListComp")) TransStmt {} - | Opt_TransformListComp `xopt` dflags -> IsValid + | LangExt.TransformListComp `xopt` dflags -> IsValid | otherwise -> NotValid (ptext (sLit "Use TransformListComp")) RecStmt {} -> emptyInvalid LastStmt {} -> emptyInvalid -- Should not happen (dealt with by checkLastStmt) @@ -1794,7 +1795,7 @@ okPArrStmt dflags _ stmt LetStmt {} -> IsValid BodyStmt {} -> IsValid ParStmt {} - | Opt_ParallelListComp `xopt` dflags -> IsValid + | LangExt.ParallelListComp `xopt` dflags -> IsValid | otherwise -> NotValid (ptext (sLit "Use ParallelListComp")) TransStmt {} -> emptyInvalid RecStmt {} -> emptyInvalid @@ -1804,7 +1805,7 @@ okPArrStmt dflags _ stmt --------- checkTupleSection :: [LHsTupArg RdrName] -> RnM () checkTupleSection args - = do { tuple_section <- xoptM Opt_TupleSections + = do { tuple_section <- xoptM LangExt.TupleSections ; checkErr (all tupArgPresent args || tuple_section) msg } where msg = ptext (sLit "Illegal tuple section: use TupleSections") diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index 18f2365c92..26bef9130e 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -46,6 +46,7 @@ import ListSetOps import Id import Type import PatSyn +import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Data.Either ( partitionEithers, isRight, rights ) @@ -198,7 +199,7 @@ rnImportDecl this_mod = setSrcSpan loc $ do when (isJust mb_pkg) $ do - pkg_imports <- xoptM Opt_PackageImports + pkg_imports <- xoptM LangExt.PackageImports when (not pkg_imports) $ addErr packageImportErr -- If there's an error in loadInterface, (e.g. interface @@ -543,7 +544,7 @@ getLocalNonValBinders fixity_env hs_instds = inst_decls, hs_fords = foreign_decls }) = do { -- Process all type/class decls *except* family instances - ; overload_ok <- xoptM Opt_DuplicateRecordFields + ; overload_ok <- xoptM LangExt.DuplicateRecordFields ; (tc_avails, tc_fldss) <- fmap unzip $ mapM (new_tc overload_ok) (tyClGroupConcat tycl_decls) ; traceRn (text "getLocalNonValBinders 1" <+> ppr tc_avails) diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs index 88496d496b..641d86dc7e 100644 --- a/compiler/rename/RnPat.hs +++ b/compiler/rename/RnPat.hs @@ -45,7 +45,6 @@ import TcRnMonad import TcHsSyn ( hsOverLitName ) import RnEnv import RnTypes -import DynFlags import PrelNames import TyCon ( tyConName ) import ConLike @@ -62,6 +61,8 @@ import FastString import Literal ( inCharRange ) import TysWiredIn ( nilDataCon ) import DataCon +import qualified GHC.LanguageExtensions as LangExt + import Control.Monad ( when, liftM, ap ) import Data.Ratio @@ -376,7 +377,7 @@ rnPatAndThen mk (SigPatIn pat sig) rnPatAndThen mk (LitPat lit) | HsString src s <- lit - = do { ovlStr <- liftCps (xoptM Opt_OverloadedStrings) + = do { ovlStr <- liftCps (xoptM LangExt.OverloadedStrings) ; if ovlStr then rnPatAndThen mk (mkNPat (noLoc (mkHsIsString src s placeHolderType)) @@ -410,7 +411,7 @@ rnPatAndThen mk (AsPat rdr pat) ; return (AsPat new_name pat') } rnPatAndThen mk p@(ViewPat expr pat _ty) - = do { liftCps $ do { vp_flag <- xoptM Opt_ViewPatterns + = do { liftCps $ do { vp_flag <- xoptM LangExt.ViewPatterns ; checkErr vp_flag (badViewPat p) } -- Because of the way we're arranging the recursive calls, -- this will be in the right context @@ -424,13 +425,13 @@ rnPatAndThen mk (ConPatIn con stuff) -- rnConPatAndThen takes care of reconstructing the pattern -- The pattern for the empty list needs to be replaced by an empty explicit list pattern when overloaded lists is turned on. = case unLoc con == nameRdrName (dataConName nilDataCon) of - True -> do { ol_flag <- liftCps $ xoptM Opt_OverloadedLists + True -> do { ol_flag <- liftCps $ xoptM LangExt.OverloadedLists ; if ol_flag then rnPatAndThen mk (ListPat [] placeHolderType Nothing) else rnConPatAndThen mk con stuff} False -> rnConPatAndThen mk con stuff rnPatAndThen mk (ListPat pats _ _) - = do { opt_OverloadedLists <- liftCps $ xoptM Opt_OverloadedLists + = do { opt_OverloadedLists <- liftCps $ xoptM LangExt.OverloadedLists ; pats' <- rnLPatsAndThen mk pats ; case opt_OverloadedLists of True -> do { (to_list_name,_) <- liftCps $ lookupSyntaxName toListName @@ -530,8 +531,8 @@ rnHsRecFields -- This is used for record construction and pattern-matching, but not updates. rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) - = do { pun_ok <- xoptM Opt_RecordPuns - ; disambig_ok <- xoptM Opt_DisambiguateRecordFields + = do { pun_ok <- xoptM LangExt.RecordPuns + ; disambig_ok <- xoptM LangExt.DisambiguateRecordFields ; parent <- check_disambiguation disambig_ok mb_con ; flds1 <- mapM (rn_fld pun_ok parent) flds ; mapM_ (addErr . dupFieldErr ctxt) dup_flds @@ -579,7 +580,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) rn_dotdot (Just n) (Just con) flds -- ".." on record construction / pat match = ASSERT( n == length flds ) do { loc <- getSrcSpanM -- Rather approximate - ; dd_flag <- xoptM Opt_RecordWildCards + ; dd_flag <- xoptM LangExt.RecordWildCards ; checkErr dd_flag (needFlagDotDot ctxt) ; (rdr_env, lcl_env) <- getRdrEnvs ; con_fields <- lookupConstructorFields con @@ -654,8 +655,8 @@ rnHsRecUpdFields :: [LHsRecUpdField RdrName] -> RnM ([LHsRecUpdField Name], FreeVars) rnHsRecUpdFields flds - = do { pun_ok <- xoptM Opt_RecordPuns - ; overload_ok <- xoptM Opt_DuplicateRecordFields + = do { pun_ok <- xoptM LangExt.RecordPuns + ; overload_ok <- xoptM LangExt.DuplicateRecordFields ; (flds1, fvss) <- mapAndUnzipM (rn_fld pun_ok overload_ok) flds ; mapM_ (addErr . dupFieldErr HsRecFieldUpd) dup_flds @@ -770,7 +771,7 @@ generalizeOverLitVal lit = lit rnOverLit :: HsOverLit t -> RnM (HsOverLit Name, FreeVars) rnOverLit origLit - = do { opt_NumDecimals <- xoptM Opt_NumDecimals + = do { opt_NumDecimals <- xoptM LangExt.NumDecimals ; let { lit@(OverLit {ol_val=val}) | opt_NumDecimals = origLit {ol_val = generalizeOverLitVal (ol_val origLit)} | otherwise = origLit diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index e6b735211f..b8db843a99 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -48,6 +48,7 @@ import DynFlags import HscTypes ( HscEnv, hsc_dflags ) import ListSetOps ( findDupsEq, removeDups ) import Digraph ( SCC, flattenSCC, stronglyConnCompFromEdgedVertices ) +import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Data.List ( sortBy ) @@ -171,7 +172,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, -- (H) Rename Everything else (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ; - (rn_rule_decls, src_fvs3) <- setXOptM Opt_ScopedTypeVariables $ + (rn_rule_decls, src_fvs3) <- setXOptM LangExt.ScopedTypeVariables $ rnList rnHsRuleDecls rule_decls ; -- Inside RULES, scoped type variables are on (rn_vect_decls, src_fvs4) <- rnList rnHsVectDecl vect_decls ; @@ -810,7 +811,7 @@ Here 'k' is in scope in the kind signature, just like 'x'. rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars) rnSrcDerivDecl (DerivDecl ty overlap) - = do { standalone_deriv_ok <- xoptM Opt_StandaloneDeriving + = do { standalone_deriv_ok <- xoptM LangExt.StandaloneDeriving ; unless standalone_deriv_ok (addErr standaloneDerivErr) ; (ty', fvs) <- rnLHsInstType (text "In a deriving declaration") ty ; return (DerivDecl ty' overlap, fvs) } @@ -1769,7 +1770,7 @@ add gp loc (SpliceD splice@(SpliceDecl _ flag)) ds -- (i.e. a naked top level expression) case flag of ExplicitSplice -> return () - ImplicitSplice -> do { th_on <- xoptM Opt_TemplateHaskell + ImplicitSplice -> do { th_on <- xoptM LangExt.TemplateHaskell ; unless th_on $ setSrcSpan loc $ failWith badImplicitSplice } diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs index 3c7695bd29..8f87d730d8 100644 --- a/compiler/rename/RnSplice.hs +++ b/compiler/rename/RnSplice.hs @@ -26,7 +26,6 @@ import BasicTypes ( TopLevelFlag, isTopLevel ) import Outputable import Module import SrcLoc -import DynFlags import RnTypes ( rnLHsType ) import Control.Monad ( unless, when ) @@ -37,6 +36,7 @@ import TcEnv ( checkWellStaged ) import THNames ( liftName ) #ifdef GHCI +import DynFlags import FastString import ErrUtils ( dumpIfSet_dyn_printer ) import TcEnv ( tcMetaTy ) @@ -49,6 +49,8 @@ import {-# SOURCE #-} TcExpr ( tcMonoExpr ) import {-# SOURCE #-} TcSplice ( runMetaD, runMetaE, runMetaP, runMetaT, tcTopSpliceExpr ) #endif +import qualified GHC.LanguageExtensions as LangExt + {- ************************************************************************ * * @@ -61,7 +63,7 @@ rnBracket :: HsExpr RdrName -> HsBracket RdrName -> RnM (HsExpr Name, FreeVars) rnBracket e br_body = addErrCtxt (quotationCtxtDoc br_body) $ do { -- Check that -XTemplateHaskellQuotes is enabled and available - thQuotesEnabled <- xoptM Opt_TemplateHaskellQuotes + thQuotesEnabled <- xoptM LangExt.TemplateHaskellQuotes ; unless thQuotesEnabled $ failWith ( vcat [ text "Syntax error on" <+> ppr e diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index 4f7c291a89..822f6a9f40 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -52,6 +52,8 @@ import BasicTypes ( compareFixity, funTyFixity, negateFixity, import Outputable import FastString import Maybes +import qualified GHC.LanguageExtensions as LangExt + import Data.List ( nubBy ) import Control.Monad ( unless, when ) @@ -409,7 +411,7 @@ rnHsTyKi what doc (HsFunTy ty1 ty2) ; return (res_ty, fvs1 `plusFV` fvs2) } rnHsTyKi what doc listTy@(HsListTy ty) - = do { data_kinds <- xoptM Opt_DataKinds + = do { data_kinds <- xoptM LangExt.DataKinds ; when (not data_kinds && isRnKindLevel what) (addErr (dataKindsErr what listTy)) ; (ty', fvs) <- rnLHsTyKi what doc ty @@ -417,7 +419,7 @@ rnHsTyKi what doc listTy@(HsListTy ty) rnHsTyKi what doc t@(HsKindSig ty k) = do { checkTypeInType what t - ; kind_sigs_ok <- xoptM Opt_KindSignatures + ; kind_sigs_ok <- xoptM LangExt.KindSignatures ; unless kind_sigs_ok (badKindSigErr doc ty) ; (ty', fvs1) <- rnLHsTyKi what doc ty ; (k', fvs2) <- rnLHsKind doc k @@ -431,7 +433,7 @@ rnHsTyKi what doc t@(HsPArrTy ty) -- Unboxed tuples are allowed to have poly-typed arguments. These -- sometimes crop up as a result of CPR worker-wrappering dictionaries. rnHsTyKi what doc tupleTy@(HsTupleTy tup_con tys) - = do { data_kinds <- xoptM Opt_DataKinds + = do { data_kinds <- xoptM LangExt.DataKinds ; when (not data_kinds && isRnKindLevel what) (addErr (dataKindsErr what tupleTy)) ; (tys', fvs) <- mapFvRn (rnLHsTyKi what doc) tys @@ -439,7 +441,7 @@ rnHsTyKi what doc tupleTy@(HsTupleTy tup_con tys) -- Ensure that a type-level integer is nonnegative (#8306, #8412) rnHsTyKi what _ tyLit@(HsTyLit t) - = do { data_kinds <- xoptM Opt_DataKinds + = do { data_kinds <- xoptM LangExt.DataKinds ; unless data_kinds (addErr (dataKindsErr what tyLit)) ; when (negLit t) (addErr negLitErr) ; checkTypeInType what tyLit @@ -536,14 +538,14 @@ rnHsTyKi _ _ (HsCoreTy ty) rnHsTyKi what doc ty@(HsExplicitListTy k tys) = do { checkTypeInType what ty - ; data_kinds <- xoptM Opt_DataKinds + ; data_kinds <- xoptM LangExt.DataKinds ; unless data_kinds (addErr (dataKindsErr what ty)) ; (tys', fvs) <- mapFvRn (rnLHsTyKi what doc) tys ; return (HsExplicitListTy k tys', fvs) } rnHsTyKi what doc ty@(HsExplicitTupleTy kis tys) = do { checkTypeInType what ty - ; data_kinds <- xoptM Opt_DataKinds + ; data_kinds <- xoptM LangExt.DataKinds ; unless data_kinds (addErr (dataKindsErr what ty)) ; (tys', fvs) <- mapFvRn (rnLHsTyKi what doc) tys ; return (HsExplicitTupleTy kis tys', fvs) } @@ -604,7 +606,7 @@ rnLTyVar (L loc rdr_name) rnHsTyOp :: Outputable a => RnTyKiWhat -> a -> Located RdrName -> RnM (Located Name, FreeVars) rnHsTyOp what overall_ty (L loc op) - = do { ops_ok <- xoptM Opt_TypeOperators + = do { ops_ok <- xoptM LangExt.TypeOperators ; op' <- rnTyVar what op ; unless (ops_ok || op' == starKindTyConName @@ -690,7 +692,7 @@ checkTypeInType :: Outputable ty -> RnM () checkTypeInType what ty | isRnKindLevel what - = do { type_in_type <- xoptM Opt_TypeInType + = do { type_in_type <- xoptM LangExt.TypeInType ; unless type_in_type $ addErr (text "Illegal kind:" <+> ppr ty $$ text "Did you mean to enable TypeInType?") } @@ -718,7 +720,7 @@ bindSigTyVarsFV :: [Name] -- with a separate type signature, to bring its tyvars into scope -- With no -XScopedTypeVariables, this is a no-op bindSigTyVarsFV tvs thing_inside - = do { scoped_tyvars <- xoptM Opt_ScopedTypeVariables + = do { scoped_tyvars <- xoptM LangExt.ScopedTypeVariables ; if not scoped_tyvars then thing_inside else @@ -815,7 +817,7 @@ bindLHsTyVarBndr doc mb_assoc kv_names tv_names hs_tv_bndr thing_inside do { check_dup lv rdr -- check for -XKindSignatures - ; sig_ok <- xoptM Opt_KindSignatures + ; sig_ok <- xoptM LangExt.KindSignatures ; unless sig_ok (badKindSigErr doc kind) -- deal with kind vars in the user-written kind @@ -864,11 +866,11 @@ bindImplicitKvs doc mb_assoc free_kvs tv_names thing_inside (bound_kvs, new_kvs) = partitionWith part_kvs free_kvs -- check whether we're mixing types & kinds illegally - ; type_in_type <- xoptM Opt_TypeInType + ; type_in_type <- xoptM LangExt.TypeInType ; unless type_in_type $ mapM_ (check_tv_used_in_kind tv_names) bound_kvs - ; poly_kinds <- xoptM Opt_PolyKinds + ; poly_kinds <- xoptM LangExt.PolyKinds ; unless poly_kinds $ addErr (badKindBndrs doc new_kvs) @@ -1577,7 +1579,7 @@ extract_tv t_or_k ltv@(L _ tv) acc mixedVarsErr :: Located RdrName -> RnM () mixedVarsErr (L loc tv) - = do { typeintype <- xoptM Opt_TypeInType + = do { typeintype <- xoptM LangExt.TypeInType ; unless typeintype $ addErrAt loc $ text "Variable" <+> quotes (ppr tv) <+> text "used as both a kind and a type" $$ diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index ed12eff883..fba320c564 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -56,6 +56,8 @@ import SrcLoc import DynFlags import Util import Outputable +import qualified GHC.LanguageExtensions as LangExt + import Control.Monad( unless ) import Data.Maybe( isJust ) @@ -409,8 +411,8 @@ getOverlapFlag :: Maybe OverlapMode -> TcM OverlapFlag -- set the OverlapMode to 'm' getOverlapFlag overlap_mode = do { dflags <- getDynFlags - ; let overlap_ok = xopt Opt_OverlappingInstances dflags - incoherent_ok = xopt Opt_IncoherentInstances dflags + ; let overlap_ok = xopt LangExt.OverlappingInstances dflags + incoherent_ok = xopt LangExt.IncoherentInstances dflags use x = OverlapFlag { isSafeOverlap = safeLanguageOn dflags , overlapMode = x } default_oflag | incoherent_ok = use (Incoherent "") diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs index 8c577d85a7..56751d5349 100644 --- a/compiler/typecheck/TcBinds.hs +++ b/compiler/typecheck/TcBinds.hs @@ -60,6 +60,7 @@ import FastString import Type(mkStrLitTy, tidyOpenType) import PrelNames( mkUnboundName, gHC_PRIM ) import TcValidity (checkValidType) +import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Data.List (partition) @@ -806,7 +807,7 @@ chooseInferredQuantifiers inferred_theta tau_tvs | pred <- my_theta , all (not . (`eqType` pred)) annotated_theta ] final_theta = annotated_theta ++ inferred_diff - ; partial_sigs <- xoptM Opt_PartialTypeSignatures + ; partial_sigs <- xoptM LangExt.PartialTypeSignatures ; warn_partial_sigs <- woptM Opt_WarnPartialTypeSignatures ; msg <- mkLongErrAt loc (mk_msg inferred_diff partial_sigs) empty ; traceTc "completeTheta" $ @@ -1898,7 +1899,7 @@ decideGeneralisationPlan dflags type_env bndr_names lbinds sig_fn -- be polymorphic, because we are going to force them -- See Trac #4498, #8762 - mono_restriction = xopt Opt_MonomorphismRestriction dflags + mono_restriction = xopt LangExt.MonomorphismRestriction dflags && any restricted binds is_closed_ns :: NameSet -> Bool -> Bool @@ -1923,7 +1924,7 @@ decideGeneralisationPlan dflags type_env bndr_names lbinds sig_fn -- These won't be in the local type env. -- Ditto class method etc from the current module - mono_local_binds = xopt Opt_MonoLocalBinds dflags + mono_local_binds = xopt LangExt.MonoLocalBinds dflags && not closed_flag closed_flag = foldr (is_closed_ns . bind_fvs) True binds diff --git a/compiler/typecheck/TcDefaults.hs b/compiler/typecheck/TcDefaults.hs index fc62fe361a..fb43bebf45 100644 --- a/compiler/typecheck/TcDefaults.hs +++ b/compiler/typecheck/TcDefaults.hs @@ -17,11 +17,11 @@ import TcSimplify import TcMType import TcType import PrelNames -import DynFlags import SrcLoc import Data.Maybe import Outputable import FastString +import qualified GHC.LanguageExtensions as LangExt tcDefaults :: [LDefaultDecl Name] -> TcM (Maybe [Type]) -- Defaulting types to heave @@ -46,7 +46,7 @@ tcDefaults [L _ (DefaultDecl [])] tcDefaults [L locn (DefaultDecl mono_tys)] = setSrcSpan locn $ addErrCtxt defaultDeclCtxt $ - do { ovl_str <- xoptM Opt_OverloadedStrings + do { ovl_str <- xoptM LangExt.OverloadedStrings ; num_class <- tcLookupClass numClassName ; is_str_class <- tcLookupClass isStringClassName ; let deflt_clss | ovl_str = [num_class, is_str_class] diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index d8245acb2c..94b94e7327 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -62,6 +62,7 @@ import Outputable import FastString import Bag import Pair +import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Data.List @@ -395,10 +396,10 @@ renameDeriv is_boot inst_infos bagBinds | otherwise = discardWarnings $ -- Discard warnings about unused bindings etc - setXOptM Opt_EmptyCase $ -- Derived decls (for empty types) can have - -- case x of {} - setXOptM Opt_ScopedTypeVariables $ -- Derived decls (for newtype-deriving) can - setXOptM Opt_KindSignatures $ -- used ScopedTypeVariables & KindSignatures + setXOptM LangExt.EmptyCase $ -- Derived decls (for empty types) can have + -- case x of {} + setXOptM LangExt.ScopedTypeVariables $ -- Derived decls (for newtype-deriving) can + setXOptM LangExt.KindSignatures $ -- used ScopedTypeVariables & KindSignatures do { -- Bring the extra deriving stuff into scope -- before renaming the instances themselves @@ -1105,27 +1106,27 @@ sideConditions mtheta cls | cls_key == enumClassKey = Just (cond_std `andCond` cond_isEnumeration) | cls_key == ixClassKey = Just (cond_std `andCond` cond_enumOrProduct cls) | cls_key == boundedClassKey = Just (cond_std `andCond` cond_enumOrProduct cls) - | cls_key == dataClassKey = Just (checkFlag Opt_DeriveDataTypeable `andCond` + | cls_key == dataClassKey = Just (checkFlag LangExt.DeriveDataTypeable `andCond` cond_std `andCond` cond_args cls) - | cls_key == functorClassKey = Just (checkFlag Opt_DeriveFunctor `andCond` + | cls_key == functorClassKey = Just (checkFlag LangExt.DeriveFunctor `andCond` cond_vanilla `andCond` cond_functorOK True False) - | cls_key == foldableClassKey = Just (checkFlag Opt_DeriveFoldable `andCond` + | cls_key == foldableClassKey = Just (checkFlag LangExt.DeriveFoldable `andCond` cond_vanilla `andCond` cond_functorOK False True) -- Functor/Fold/Trav works ok -- for rank-n types - | cls_key == traversableClassKey = Just (checkFlag Opt_DeriveTraversable `andCond` + | cls_key == traversableClassKey = Just (checkFlag LangExt.DeriveTraversable `andCond` cond_vanilla `andCond` cond_functorOK False False) - | cls_key == genClassKey = Just (checkFlag Opt_DeriveGeneric `andCond` + | cls_key == genClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond` cond_vanilla `andCond` cond_RepresentableOk) - | cls_key == gen1ClassKey = Just (checkFlag Opt_DeriveGeneric `andCond` + | cls_key == gen1ClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond` cond_vanilla `andCond` cond_Representable1Ok) - | cls_key == liftClassKey = Just (checkFlag Opt_DeriveLift `andCond` + | cls_key == liftClassKey = Just (checkFlag LangExt.DeriveLift `andCond` cond_vanilla `andCond` cond_args cls) | otherwise = Nothing @@ -1141,7 +1142,7 @@ canDeriveAnyClass :: DynFlags -> TyCon -> Class -> Maybe SDoc -- Just s: we can't, reason s -- Precondition: the class is not one of the standard ones canDeriveAnyClass dflags _tycon clas - | not (xopt Opt_DeriveAnyClass dflags) + | not (xopt LangExt.DeriveAnyClass dflags) = Just (ptext (sLit "Try enabling DeriveAnyClass")) | not (any (target_kind `tcEqKind`) [ liftedTypeKind, typeToTypeKind ]) = Just (ptext (sLit "The last argument of class") <+> quotes (ppr clas) @@ -1316,7 +1317,7 @@ cond_functorOK allowFunctions allowExQuantifiedLastTyVar (_, rep_tc, _) functions = ptext (sLit "must not contain function types") wrong_arg = ptext (sLit "must use the type variable only as the last argument of a data type") -checkFlag :: ExtensionFlag -> Condition +checkFlag :: LangExt.Extension -> Condition checkFlag flag (dflags, _, _) | xopt flag dflags = IsValid | otherwise = NotValid why @@ -1472,8 +1473,8 @@ mkNewTypeEqn dflags overlap_mode tvs , ptext (sLit "Defaulting to the DeriveAnyClass strategy for instantiating") <+> ppr cls ]) go_for_it where - newtype_deriving = xopt Opt_GeneralizedNewtypeDeriving dflags - deriveAnyClass = xopt Opt_DeriveAnyClass dflags + newtype_deriving = xopt LangExt.GeneralizedNewtypeDeriving dflags + deriveAnyClass = xopt LangExt.DeriveAnyClass dflags go_for_it = mk_data_eqn overlap_mode tvs cls cls_tys tycon tc_args rep_tycon rep_tc_args mtheta bale_out = bale_out' newtype_deriving @@ -2016,8 +2017,8 @@ genInst spec@(DS { ds_tvs = tvs, ds_tc = rep_tycon { ib_binds = gen_Newtype_binds loc clas tvs tys rhs_ty , ib_tyvars = map Var.varName tvs -- Scope over bindings , ib_pragmas = [] - , ib_extensions = [ Opt_ImpredicativeTypes - , Opt_RankNTypes ] + , ib_extensions = [ LangExt.ImpredicativeTypes + , LangExt.RankNTypes ] , ib_derived = True } } , emptyBag , Just $ getName $ head $ tyConDataCons rep_tycon ) } diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs index 31ddf7dd35..5ea521edf0 100644 --- a/compiler/typecheck/TcEnv.hs +++ b/compiler/typecheck/TcEnv.hs @@ -97,6 +97,8 @@ import FastString import ListSetOps import Util import Maybes( MaybeErr(..) ) +import qualified GHC.LanguageExtensions as LangExt + import Data.IORef import Data.List @@ -625,8 +627,8 @@ tcGetDefaultTys :: TcM ([Type], -- Default types Bool)) -- True <=> Use extended defaulting rules tcGetDefaultTys = do { dflags <- getDynFlags - ; let ovl_strings = xopt Opt_OverloadedStrings dflags - extended_defaults = xopt Opt_ExtendedDefaultRules dflags + ; let ovl_strings = xopt LangExt.OverloadedStrings dflags + extended_defaults = xopt LangExt.ExtendedDefaultRules dflags -- See also Trac #1974 flags = (ovl_strings, extended_defaults) @@ -707,10 +709,10 @@ data InstBindings a , ib_pragmas :: [LSig a] -- User pragmas recorded for generating -- specialised instances - , ib_extensions :: [ExtensionFlag] -- Any extra extensions that should - -- be enabled when type-checking this - -- instance; needed for - -- GeneralizedNewtypeDeriving + , ib_extensions :: [LangExt.Extension] -- Any extra extensions that should + -- be enabled when type-checking + -- this instance; needed for + -- GeneralizedNewtypeDeriving , ib_derived :: Bool -- True <=> This code was generated by GHC from a deriving clause diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index e23c750434..672b499cad 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -47,6 +47,7 @@ import DynFlags import StaticFlags ( opt_PprStyle_Debug ) import ListSetOps ( equivClasses ) import Maybes +import qualified GHC.LanguageExtensions as LangExt import Control.Monad ( when ) import Data.List ( partition, mapAccumL, nub, sortBy ) @@ -126,7 +127,7 @@ reportUnsolved wanted | warn_holes = HoleWarn | otherwise = HoleDefer - ; partial_sigs <- xoptM Opt_PartialTypeSignatures + ; partial_sigs <- xoptM LangExt.PartialTypeSignatures ; warn_partial_sigs <- woptM Opt_WarnPartialTypeSignatures ; let type_holes | not partial_sigs = HoleError | warn_partial_sigs = HoleWarn diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index a7c4795a48..980424225c 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -69,6 +69,8 @@ import Outputable import FastString import Control.Monad import Class(classTyCon) +import qualified GHC.LanguageExtensions as LangExt + import Data.Function import Data.List import qualified Data.Set as Set @@ -416,8 +418,8 @@ tcExpr expr@(SectionR op arg2) res_ty tcExpr expr@(SectionL arg1 op) res_ty = do { (op', op_ty) <- tcInferFun op ; dflags <- getDynFlags -- Note [Left sections] - ; let n_reqd_args | xopt Opt_PostfixOperators dflags = 1 - | otherwise = 2 + ; let n_reqd_args | xopt LangExt.PostfixOperators dflags = 1 + | otherwise = 2 ; (co_fn, (arg1_ty:arg_tys), op_res_ty) <- unifyOpFunTysWrap op n_reqd_args op_ty ; co_res <- unifyType (Just expr) (mkFunTys arg_tys op_res_ty) res_ty diff --git a/compiler/typecheck/TcForeign.hs b/compiler/typecheck/TcForeign.hs index 454cde4d70..4d474d4206 100644 --- a/compiler/typecheck/TcForeign.hs +++ b/compiler/typecheck/TcForeign.hs @@ -59,6 +59,7 @@ import SrcLoc import Bag import FastString import Hooks +import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Data.Maybe @@ -309,7 +310,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh return $ CImport (L lc cconv') (L ls safety) mh (CFunction target) src | cconv == PrimCallConv = do dflags <- getDynFlags - checkTc (xopt Opt_GHCForeignImportPrim dflags) + checkTc (xopt LangExt.GHCForeignImportPrim dflags) (text "Use GHCForeignImportPrim to allow `foreign import prim'.") checkCg checkCOrAsmOrLlvmOrInterp checkCTarget target diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index 51f3c2f561..ee7038d546 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -56,6 +56,8 @@ import SrcLoc import Bag import Outputable import Util +import qualified GHC.LanguageExtensions as LangExt + #if __GLASGOW_HASKELL__ < 709 import Data.Traversable ( traverse ) #endif @@ -1479,7 +1481,7 @@ zonkTvCollecting :: TyVarSet -> TcRef TyVarSet -> UnboundTyVarZonker -- This variant collects unbound type variables in a mutable variable -- Works on both types and kinds zonkTvCollecting kind_vars unbound_tv_set tv - = do { poly_kinds <- xoptM Opt_PolyKinds + = do { poly_kinds <- xoptM LangExt.PolyKinds ; if tv `elemVarSet` kind_vars && not poly_kinds then defaultKindVar tv else do { ty_or_tv <- zonkQuantifiedTyVarOrType tv ; case ty_or_tv of diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 9fd74d1fa6..28d1d3fda1 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -70,8 +70,6 @@ import VarEnv import TysWiredIn import BasicTypes import SrcLoc -import DynFlags ( ExtensionFlag( Opt_DataKinds, Opt_MonoLocalBinds - , Opt_TypeInType ) ) import Constants ( mAX_CTUPLE_SIZE ) import ErrUtils( MsgDoc ) import Unique @@ -81,6 +79,7 @@ import Outputable import FastString import PrelNames hiding ( wildCardName ) import Pair +import qualified GHC.LanguageExtensions as LangExt import Data.Maybe import Control.Monad @@ -321,7 +320,7 @@ tcLHsType ty = addTypeCtxt ty (tc_infer_lhs_type typeLevelMode ty) -- or if NoMonoLocalBinds is set. Otherwise, nope. decideKindGeneralisationPlan :: Type -> TcM Bool decideKindGeneralisationPlan ty - = do { mono_locals <- xoptM Opt_MonoLocalBinds + = do { mono_locals <- xoptM LangExt.MonoLocalBinds ; in_scope <- getInLocalScope ; let fvs = tyCoVarsOfTypeList ty should_gen = not mono_locals || all (not . in_scope . getName) fvs @@ -980,7 +979,7 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon ; case thing of ATyVar _ tv -> return (mkTyVarTy tv, tyVarKind tv) - AThing kind -> do { data_kinds <- xoptM Opt_DataKinds + AThing kind -> do { data_kinds <- xoptM LangExt.DataKinds ; unless (isTypeLevel (mode_level mode) || data_kinds) $ promotionErr name NoDataKinds @@ -992,8 +991,8 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon -- But this is a terribly large amount of work! Not worth it. AGlobal (ATyCon tc) - -> do { type_in_type <- xoptM Opt_TypeInType - ; data_kinds <- xoptM Opt_DataKinds + -> do { type_in_type <- xoptM LangExt.TypeInType + ; data_kinds <- xoptM LangExt.DataKinds ; unless (isTypeLevel (mode_level mode) || data_kinds || isKindTyCon tc) $ @@ -1005,10 +1004,10 @@ tcTyVar mode name -- Could be a tyvar, a tycon, or a datacon ; return (mkTyConApp tc [], tyConKind tc) } AGlobal (AConLike (RealDataCon dc)) - -> do { data_kinds <- xoptM Opt_DataKinds + -> do { data_kinds <- xoptM LangExt.DataKinds ; unless (data_kinds || specialPromotedDc dc) $ promotionErr name NoDataKinds - ; type_in_type <- xoptM Opt_TypeInType + ; type_in_type <- xoptM LangExt.TypeInType ; unless ( type_in_type || ( isTypeLevel (mode_level mode) && isLegacyPromotableDataCon dc ) || diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs index 587fa9fa78..3b931711c3 100644 --- a/compiler/typecheck/TcInstDcls.hs +++ b/compiler/typecheck/TcInstDcls.hs @@ -59,6 +59,7 @@ import Outputable import SrcLoc import Util import BooleanFormula ( isUnsatisfied, pprBooleanFormulaNice ) +import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Maybes @@ -587,7 +588,7 @@ tcFamInstDeclCombined mb_clsinfo fam_tc_lname = do { -- Type family instances require -XTypeFamilies -- and can't (currently) be in an hs-boot file ; traceTc "tcFamInstDecl" (ppr fam_tc_lname) - ; type_families <- xoptM Opt_TypeFamilies + ; type_families <- xoptM LangExt.TypeFamilies ; is_boot <- tcIsHsBootOrSig -- Are we compiling an hs-boot file? ; checkTc type_families $ badFamInstDecl fam_tc_lname ; checkTc (not is_boot) $ badBootFamInstDeclErr @@ -1239,7 +1240,7 @@ tcMethods dfun_id clas tyvars dfun_ev_vars inst_tys mapAndUnzip3M tc_item op_items ; return (ids, listToBag binds, listToBag (catMaybes mb_implics)) } where - set_exts :: [ExtensionFlag] -> TcM a -> TcM a + set_exts :: [LangExt.Extension] -> TcM a -> TcM a set_exts es thing = foldr setXOptM thing es hs_sig_fn = mkHsSigFun sigs @@ -1413,7 +1414,7 @@ mkMethIds sig_fn clas tyvars dfun_ev_vars inst_tys sel_id Just lhs_ty -- There is a signature in the instance declaration -- See Note [Instance method signatures] -> setSrcSpan (getLoc (hsSigType lhs_ty)) $ - do { inst_sigs <- xoptM Opt_InstanceSigs + do { inst_sigs <- xoptM LangExt.InstanceSigs ; checkTc inst_sigs (misplacedInstSig sel_name lhs_ty) ; sig_ty <- tcHsSigType (FunSigCtxt sel_name False) lhs_ty ; let poly_sig_ty = mkInvSigmaTy tyvars theta sig_ty diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index c044d20b0d..3f50eb94cc 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -56,6 +56,7 @@ import Pair (Pair(..)) import Unique( hasKey ) import DynFlags import Util +import qualified GHC.LanguageExtensions as LangExt {- ********************************************************************** @@ -1768,7 +1769,7 @@ matchClassInst dflags inerts clas tys loc -- First check whether there is an in-scope Given that could -- match this constraint. In that case, do not use top-level -- instances. See Note [Instance and Given overlap] - | not (xopt Opt_IncoherentInstances dflags) + | not (xopt LangExt.IncoherentInstances dflags) , not (naturallyCoherentClass clas) , let matchable_givens = matchableGivens loc pred inerts , not (isEmptyBag matchable_givens) diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 10248c4354..b0776f64e3 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -100,7 +100,7 @@ import FastString import SrcLoc import Bag import Pair -import DynFlags +import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Maybes @@ -765,7 +765,7 @@ quantifyTyVars gbl_tvs (Pair dep_tkvs nondep_tkvs) -- to *, and zonk the tyvars as usual. Notice that this -- may make quantifyTyVars return a shorter list -- than it was passed, but that's ok - ; poly_kinds <- xoptM Opt_PolyKinds + ; poly_kinds <- xoptM LangExt.PolyKinds ; dep_vars2 <- if poly_kinds then return dep_kvs else do { let (meta_kvs, skolem_kvs) = partition is_meta dep_kvs diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs index cd0f029eb5..323adceaaa 100644 --- a/compiler/typecheck/TcMatches.hs +++ b/compiler/typecheck/TcMatches.hs @@ -40,6 +40,7 @@ import SrcLoc import FastString import DynFlags import PrelNames (monadFailClassName) +import qualified GHC.LanguageExtensions as LangExt -- Create chunkified tuple tybes for monad comprehensions import MkCore @@ -890,8 +891,8 @@ tcMonadFailOp orig pat fail_op res_ty | otherwise = do { -- Issue MonadFail warnings - rebindableSyntax <- xoptM Opt_RebindableSyntax - ; desugarFlag <- xoptM Opt_MonadFailDesugaring + rebindableSyntax <- xoptM LangExt.RebindableSyntax + ; desugarFlag <- xoptM LangExt.MonadFailDesugaring ; missingWarning <- woptM Opt_WarnMissingMonadFailInstance ; if | rebindableSyntax && (desugarFlag || missingWarning) -> warnRebindableClash pat diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs index 074532276e..6b22aa6bf6 100644 --- a/compiler/typecheck/TcPat.hs +++ b/compiler/typecheck/TcPat.hs @@ -48,6 +48,7 @@ import Util import Outputable import FastString import Maybes( orElse ) +import qualified GHC.LanguageExtensions as LangExt import Control.Monad {- @@ -674,8 +675,8 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty arg_pats thing_inside LamPat mc -> PatSkol (RealDataCon data_con) mc LetPat {} -> UnkSkol -- Doesn't matter - ; gadts_on <- xoptM Opt_GADTs - ; families_on <- xoptM Opt_TypeFamilies + ; gadts_on <- xoptM LangExt.GADTs + ; families_on <- xoptM LangExt.TypeFamilies ; checkTc (no_equalities || gadts_on || families_on) (text "A pattern match on a GADT requires the" <+> text "GADTs or TypeFamilies language extension") diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 07d519376e..6fc26f85eb 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -106,6 +106,7 @@ import Maybes import Util import Bag import Inst (tcGetInsts) +import qualified GHC.LanguageExtensions as LangExt import Control.Monad @@ -303,7 +304,7 @@ tcRnModuleTcRnM hsc_env hsc_src setGblEnv (tcg_env { tcg_self_boot = boot_info }) $ do { -- Deal with imports; first add implicit prelude - implicit_prelude <- xoptM Opt_ImplicitPrelude; + implicit_prelude <- xoptM LangExt.ImplicitPrelude; let { prel_imports = mkPrelImports (moduleName this_mod) prel_imp_loc implicit_prelude import_decls } ; @@ -2052,7 +2053,7 @@ tcRnType :: HscEnv -> IO (Messages, Maybe (Type, Kind)) tcRnType hsc_env normalise rdr_type = runTcInteractive hsc_env $ - setXOptM Opt_PolyKinds $ -- See Note [Kind-generalise in tcRnType] + setXOptM LangExt.PolyKinds $ -- See Note [Kind-generalise in tcRnType] do { (HsWC { hswc_wcs = wcs, hswc_body = rn_type }, _fvs) <- rnHsWcType GHCiCtx (mkHsWildCardBndrs rdr_type) -- The type can have wild cards, but no implicit diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index 0fc310f3ed..5797b8e8ac 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -51,6 +51,8 @@ import Util import Annotations import BasicTypes( TopLevelFlag ) +import qualified GHC.LanguageExtensions as LangExt + import Control.Exception import Data.IORef import Control.Monad @@ -302,7 +304,7 @@ setEnvs (gbl_env, lcl_env) = updEnv (\ env -> env { env_gbl = gbl_env, env_lcl = -- Command-line flags -xoptM :: ExtensionFlag -> TcRnIf gbl lcl Bool +xoptM :: LangExt.Extension -> TcRnIf gbl lcl Bool xoptM flag = do { dflags <- getDynFlags; return (xopt flag dflags) } doptM :: DumpFlag -> TcRnIf gbl lcl Bool @@ -314,7 +316,7 @@ goptM flag = do { dflags <- getDynFlags; return (gopt flag dflags) } woptM :: WarningFlag -> TcRnIf gbl lcl Bool woptM flag = do { dflags <- getDynFlags; return (wopt flag dflags) } -setXOptM :: ExtensionFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a +setXOptM :: LangExt.Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a setXOptM flag = updEnv (\ env@(Env { env_top = top }) -> env { env_top = top { hsc_dflags = xopt_set (hsc_dflags top) flag}} ) @@ -339,7 +341,7 @@ whenWOptM :: WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl () whenWOptM flag thing_inside = do b <- woptM flag when b thing_inside -whenXOptM :: ExtensionFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl () +whenXOptM :: LangExt.Extension -> TcRnIf gbl lcl () -> TcRnIf gbl lcl () whenXOptM flag thing_inside = do b <- xoptM flag when b thing_inside diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index c6aae95baa..94ea445217 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -17,8 +17,7 @@ module TcSimplify( import Bag import Class ( Class, classKey, classTyCon ) -import DynFlags ( ExtensionFlag( Opt_AllowAmbiguousTypes ) - , WarningFlag ( Opt_WarnMonomorphism ) +import DynFlags ( WarningFlag ( Opt_WarnMonomorphism ) , DynFlags( solverIterations ) ) import Inst import ListSetOps @@ -46,6 +45,7 @@ import VarSet import BasicTypes ( IntWithInf, intGtLimit ) import ErrUtils ( emptyMessages ) import FastString +import qualified GHC.LanguageExtensions as LangExt import Control.Monad ( when, unless ) import Data.List ( partition ) @@ -390,7 +390,7 @@ simplifyAmbiguityCheck ty wanteds -- Normally report all errors; but with -XAllowAmbiguousTypes -- report only insoluble ones, since they represent genuinely -- inaccessible code - ; allow_ambiguous <- xoptM Opt_AllowAmbiguousTypes + ; allow_ambiguous <- xoptM LangExt.AllowAmbiguousTypes ; traceTc "reportUnsolved(ambig) {" empty ; tc_lvl <- TcM.getTcLevel ; unless (allow_ambiguous && not (insolubleWC tc_lvl final_wc)) diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index 5d47028825..2074100f84 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -108,6 +108,7 @@ import qualified Language.Haskell.TH.Syntax as TH -- Because GHC.Desugar might not be in the base library of the bootstrapping compiler import GHC.Desugar ( AnnotationWrapper(..) ) +import qualified Data.IntSet as IntSet import qualified Data.Map as Map import Data.Dynamic ( fromDynamic, toDyn ) import Data.Typeable ( typeOf, Typeable, typeRep ) @@ -850,6 +851,11 @@ instance TH.Quasi TcM where th_state_var <- fmap tcg_th_state getGblEnv updTcRef th_state_var (\m -> Map.insert (typeOf x) (toDyn x) m) + qIsExtEnabled = xoptM + + qExtsEnabled = do + dflags <- hsc_dflags <$> getTopEnv + return $ map toEnum $ IntSet.elems $ extensionFlags dflags {- ************************************************************************ diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 7523c6a263..30447a413f 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -66,6 +66,7 @@ import DynFlags import FastString import Unique import BasicTypes +import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Data.List @@ -875,7 +876,7 @@ tcDataDefn rec_info -- Knot-tied; don't look at this eagerly ; stupid_tc_theta <- solveEqualities $ tcHsContext ctxt ; stupid_theta <- zonkTcTypeToTypes emptyZonkEnv stupid_tc_theta - ; kind_signatures <- xoptM Opt_KindSignatures + ; kind_signatures <- xoptM LangExt.KindSignatures ; is_boot <- tcIsHsBootOrSig -- Are we compiling an hs-boot file? -- Check that we don't use kind signatures without Glasgow extensions @@ -1329,7 +1330,7 @@ Relevant tickets: #3699 and #10586. dataDeclChecks :: Name -> NewOrData -> ThetaType -> [LConDecl Name] -> TcM Bool dataDeclChecks tc_name new_or_data stupid_theta cons = do { -- Check that we don't use GADT syntax in H98 world - gadtSyntax_ok <- xoptM Opt_GADTSyntax + gadtSyntax_ok <- xoptM LangExt.GADTSyntax ; let gadt_syntax = consUseGadtSyntax cons ; checkTc (gadtSyntax_ok || not gadt_syntax) (badGadtDecl tc_name) @@ -1344,7 +1345,7 @@ dataDeclChecks tc_name new_or_data stupid_theta cons -- Check that there's at least one condecl, -- or else we're reading an hs-boot file, or -XEmptyDataDecls - ; empty_data_decls <- xoptM Opt_EmptyDataDecls + ; empty_data_decls <- xoptM LangExt.EmptyDataDecls ; is_boot <- tcIsHsBootOrSig -- Are we compiling an hs-boot file? ; checkTc (not (null cons) || empty_data_decls || is_boot) (emptyConDeclsErr tc_name) @@ -1998,8 +1999,8 @@ checkValidTyCon tc ; traceTc "cvtc2" (ppr tc) ; dflags <- getDynFlags - ; existential_ok <- xoptM Opt_ExistentialQuantification - ; gadt_ok <- xoptM Opt_GADTs + ; existential_ok <- xoptM LangExt.ExistentialQuantification + ; gadt_ok <- xoptM LangExt.GADTs ; let ex_ok = existential_ok || gadt_ok -- Data cons can have existential context ; mapM_ (checkValidDataCon dflags ex_ok tc) data_cons @@ -2146,7 +2147,7 @@ checkValidDataCon dflags existential_ok tc con ctxt = ConArgCtxt (dataConName con) check_bang (HsSrcBang _ _ SrcLazy, _, n) - | not (xopt Opt_StrictData dflags) + | not (xopt LangExt.StrictData dflags) = addErrTc (bad_bang n (ptext (sLit "Lazy annotation (~) without StrictData"))) check_bang (HsSrcBang _ want_unpack strict_mark, rep_bang, n) @@ -2160,7 +2161,7 @@ checkValidDataCon dflags existential_ok tc con = addWarnTc (bad_bang n (ptext (sLit "Ignoring unusable UNPACK pragma"))) where is_strict = case strict_mark of - NoSrcStrict -> xopt Opt_StrictData dflags + NoSrcStrict -> xopt LangExt.StrictData dflags bang -> isSrcStrict bang check_bang _ @@ -2204,11 +2205,11 @@ checkNewDataCon con ------------------------------- checkValidClass :: Class -> TcM () checkValidClass cls - = do { constrained_class_methods <- xoptM Opt_ConstrainedClassMethods - ; multi_param_type_classes <- xoptM Opt_MultiParamTypeClasses - ; nullary_type_classes <- xoptM Opt_NullaryTypeClasses - ; fundep_classes <- xoptM Opt_FunctionalDependencies - ; undecidable_super_classes <- xoptM Opt_UndecidableSuperClasses + = do { constrained_class_methods <- xoptM LangExt.ConstrainedClassMethods + ; multi_param_type_classes <- xoptM LangExt.MultiParamTypeClasses + ; nullary_type_classes <- xoptM LangExt.NullaryTypeClasses + ; fundep_classes <- xoptM LangExt.FunctionalDependencies + ; undecidable_super_classes <- xoptM LangExt.UndecidableSuperClasses -- Check that the class is unary, unless multiparameter type classes -- are enabled; also recognize deprecated nullary type classes @@ -2292,7 +2293,7 @@ checkFamFlag :: Name -> TcM () -- The parser won't even parse them, but I suppose a GHC API -- client might have a go! checkFamFlag tc_name - = do { idx_tys <- xoptM Opt_TypeFamilies + = do { idx_tys <- xoptM LangExt.TypeFamilies ; checkTc idx_tys err_msg } where err_msg = hang (ptext (sLit "Illegal family declaration for") <+> quotes (ppr tc_name)) @@ -2343,7 +2344,7 @@ checkValidRoleAnnots role_annots tc \decl@(L loc (RoleAnnotDecl _ the_role_annots)) -> addRoleAnnotCtxt name $ setSrcSpan loc $ do - { role_annots_ok <- xoptM Opt_RoleAnnotations + { role_annots_ok <- xoptM LangExt.RoleAnnotations ; checkTc role_annots_ok $ needXRoleAnnotations tc ; checkTc (vis_vars `equalLength` the_role_annots) (wrongNumberOfRoles vis_vars decl) @@ -2351,7 +2352,7 @@ checkValidRoleAnnots role_annots tc -- Representational or phantom roles for class parameters -- quickly lead to incoherence. So, we require -- IncoherentInstances to have them. See #8773. - ; incoherent_roles_ok <- xoptM Opt_IncoherentInstances + ; incoherent_roles_ok <- xoptM LangExt.IncoherentInstances ; checkTc ( incoherent_roles_ok || (not $ isClassTyCon tc) || (all (== Nominal) vis_roles)) diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 6b148cf05f..bbd7bc26c4 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -209,6 +209,7 @@ import Outputable import FastString import ErrUtils( Validity(..), MsgDoc, isValid ) import FV +import qualified GHC.LanguageExtensions as LangExt import Data.IORef import Control.Monad (liftM, ap) @@ -1586,7 +1587,7 @@ canUnifyWithPolyType dflags details = case details of MetaTv { mtv_info = ReturnTv } -> True -- See Note [ReturnTv] MetaTv { mtv_info = SigTv } -> False - MetaTv { mtv_info = TauTv } -> xopt Opt_ImpredicativeTypes dflags + MetaTv { mtv_info = TauTv } -> xopt LangExt.ImpredicativeTypes dflags _other -> True -- We can have non-meta tyvars in given constraints @@ -2304,7 +2305,7 @@ unlifted_only = ptext (sLit "foreign import prim only accepts simple unlifted ty validIfUnliftedFFITypes :: DynFlags -> Validity validIfUnliftedFFITypes dflags - | xopt Opt_UnliftedFFITypes dflags = IsValid + | xopt LangExt.UnliftedFFITypes dflags = IsValid | otherwise = NotValid (ptext (sLit "To marshal unlifted types, use UnliftedFFITypes")) {- diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 4579686ab7..333b8d6b73 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -54,6 +54,7 @@ import Outputable import FastString import BasicTypes import Module +import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Data.Maybe @@ -197,7 +198,7 @@ checkAmbiguity ctxt ty -- Solve the constraints eagerly because an ambiguous type -- can cause a cascade of further errors. Since the free -- tyvars are skolemised, we can safely use tcSimplifyTop - ; allow_ambiguous <- xoptM Opt_AllowAmbiguousTypes + ; allow_ambiguous <- xoptM LangExt.AllowAmbiguousTypes ; (_wrap, wanted) <- addErrCtxt (mk_msg allow_ambiguous) $ captureConstraints $ tcSubType_NC ctxt ty ty @@ -289,7 +290,7 @@ checkValidType :: UserTypeCtxt -> Type -> TcM () -- Not used for instance decls; checkValidInstance instead checkValidType ctxt ty = do { traceTc "checkValidType" (ppr ty <+> text "::" <+> ppr (typeKind ty)) - ; rankn_flag <- xoptM Opt_RankNTypes + ; rankn_flag <- xoptM LangExt.RankNTypes ; let gen_rank :: Rank -> Rank gen_rank r | rankn_flag = ArbitraryRank | otherwise = r @@ -351,7 +352,7 @@ check_kind :: TidyEnv -> UserTypeCtxt -> TcType -> TcM () check_kind env ctxt ty | TySynCtxt {} <- ctxt , returnsConstraintKind actual_kind - = do { ck <- xoptM Opt_ConstraintKinds + = do { ck <- xoptM LangExt.ConstraintKinds ; if ck then when (isConstraintKind actual_kind) (do { dflags <- getDynFlags @@ -490,7 +491,7 @@ check_syn_tc_app env ctxt rank ty tc tys -- type Foo a = Tree [a] -- f :: Foo a b -> ... = do { -- See Note [Liberal type synonyms] - ; liberal <- xoptM Opt_LiberalTypeSynonyms + ; liberal <- xoptM LangExt.LiberalTypeSynonyms ; if not liberal || isTypeFamilyTyCon tc then -- For H98 and synonym families, do check the type args mapM_ check_arg tys @@ -515,10 +516,10 @@ check_syn_tc_app env ctxt rank ty tc tys check_ubx_tuple :: TidyEnv -> UserTypeCtxt -> KindOrType -> [KindOrType] -> TcM () check_ubx_tuple env ctxt ty tys - = do { ub_tuples_allowed <- xoptM Opt_UnboxedTuples + = do { ub_tuples_allowed <- xoptM LangExt.UnboxedTuples ; checkTcM ub_tuples_allowed (ubxArgTyErr env ty) - ; impred <- xoptM Opt_ImpredicativeTypes + ; impred <- xoptM LangExt.ImpredicativeTypes ; let rank' = if impred then ArbitraryRank else tyConArgMonoType -- c.f. check_arg_type -- However, args are allowed to be unlifted, or @@ -548,7 +549,7 @@ check_arg_type :: TidyEnv -> UserTypeCtxt -> Rank -> KindOrType -> TcM () check_arg_type _ _ _ (CoercionTy {}) = return () check_arg_type env ctxt rank ty - = do { impred <- xoptM Opt_ImpredicativeTypes + = do { impred <- xoptM LangExt.ImpredicativeTypes ; let rank' = case rank of -- Predictive => must be monotype MustBeMonoType -> MustBeMonoType -- Monotype, regardless _other | impred -> ArbitraryRank @@ -700,13 +701,14 @@ check_eq_pred env dflags pred tc tys = -- Equational constraints are valid in all contexts if type -- families are permitted do { checkTc (length tys == tyConArity tc) (tyConArityErr tc tys) - ; checkTcM (xopt Opt_TypeFamilies dflags || xopt Opt_GADTs dflags) + ; checkTcM (xopt LangExt.TypeFamilies dflags + || xopt LangExt.GADTs dflags) (eqPredTyErr env pred) } check_tuple_pred :: Bool -> TidyEnv -> DynFlags -> UserTypeCtxt -> PredType -> [PredType] -> TcM () check_tuple_pred under_syn env dflags ctxt pred ts = do { -- See Note [ConstraintKinds in predicates] - checkTcM (under_syn || xopt Opt_ConstraintKinds dflags) + checkTcM (under_syn || xopt LangExt.ConstraintKinds dflags) (predTupleErr env pred) ; mapM_ (check_pred_help under_syn env dflags ctxt) ts } -- This case will not normally be executed because without @@ -720,14 +722,14 @@ check_irred_pred under_syn env dflags ctxt pred -- see Note [ConstraintKinds in predicates] -- But (X t1 t2) is always ok because we just require ConstraintKinds -- at the definition site (Trac #9838) - failIfTcM (not under_syn && not (xopt Opt_ConstraintKinds dflags) + failIfTcM (not under_syn && not (xopt LangExt.ConstraintKinds dflags) && hasTyVarHead pred) (predIrredErr env pred) -- Make sure it is OK to have an irred pred in this context -- See Note [Irreducible predicates in superclasses] ; failIfTcM (is_superclass ctxt - && not (xopt Opt_UndecidableInstances dflags) + && not (xopt LangExt.UndecidableInstances dflags) && has_tyfun_head pred) (predSuperClassErr env pred) } where @@ -773,8 +775,8 @@ check_class_pred env dflags ctxt pred cls tys where check_arity = checkTc (classArity cls == length tys) (tyConArityErr (classTyCon cls) tys) - flexible_contexts = xopt Opt_FlexibleContexts dflags - undecidable_ok = xopt Opt_UndecidableInstances dflags + flexible_contexts = xopt LangExt.FlexibleContexts dflags + undecidable_ok = xopt LangExt.UndecidableInstances dflags arg_tys_ok = case ctxt of SpecInstCtxt -> True -- {-# SPECIALISE instance Eq (T Int) #-} is fine @@ -931,15 +933,15 @@ checkValidInstHead ctxt clas cls_args -- but not for SPECIALISE isntance pragmas ; let ty_args = filterOutInvisibleTypes (classTyCon clas) cls_args ; unless spec_inst_prag $ - do { checkTc (xopt Opt_TypeSynonymInstances dflags || + do { checkTc (xopt LangExt.TypeSynonymInstances dflags || all tcInstHeadTyNotSynonym ty_args) (instTypeErr clas cls_args head_type_synonym_msg) - ; checkTc (xopt Opt_FlexibleInstances dflags || + ; checkTc (xopt LangExt.FlexibleInstances dflags || all tcInstHeadTyAppAllTyVars ty_args) (instTypeErr clas cls_args head_type_args_tyvars_msg) - ; checkTc (xopt Opt_MultiParamTypeClasses dflags || + ; checkTc (xopt LangExt.MultiParamTypeClasses dflags || length ty_args == 1 || -- Only count type arguments - (xopt Opt_NullaryTypeClasses dflags && + (xopt LangExt.NullaryTypeClasses dflags && null ty_args)) (instTypeErr clas cls_args head_one_type_msg) } @@ -1068,7 +1070,7 @@ checkValidInstance ctxt hs_type ty -- e.g. Bar a => Bar Int is ambiguous, but it also fails -- the termination condition, because 'a' appears more often -- in the constraint than in the head - ; undecidable_ok <- xoptM Opt_UndecidableInstances + ; undecidable_ok <- xoptM LangExt.UndecidableInstances ; traceTc "cvi" (ppr undecidable_ok $$ ppr ty) ; if undecidable_ok then checkAmbiguity ctxt ty @@ -1400,7 +1402,7 @@ checkValidTyFamEqn mb_clsinfo fam_tc tvs cvs typats rhs loc ; check_lifted env rhs -- We have a decidable instance unless otherwise permitted - ; undecidable_ok <- xoptM Opt_UndecidableInstances + ; undecidable_ok <- xoptM LangExt.UndecidableInstances ; unless undecidable_ok $ mapM_ addErrTc (checkFamInstRhs typats (tcTyFamInsts rhs)) diff --git a/docs/users_guide/7.12.1-notes.rst b/docs/users_guide/7.12.1-notes.rst index 79bed2c16d..0604fef7e3 100644 --- a/docs/users_guide/7.12.1-notes.rst +++ b/docs/users_guide/7.12.1-notes.rst @@ -290,6 +290,11 @@ Template Haskell ``dataD`` and ``newtypeD`` now take a ``CxtQ`` instead of a ``[Name]`` for the list of derived classes. +- ``isExtEnabled`` can now be used to determine whether a language extension + is enabled in the ``Q`` monad. Similarly, ``extsEnabled`` can be used to list + all enabled language extensions. + + Runtime system ~~~~~~~~~~~~~~ @@ -416,6 +421,9 @@ ghc-boot Haskell, as defined by GHC. (These functions were moved from ``Lexeme`` in ``ghc``.) +- Added ``GHC.LanguageExtensions`` which contains a type listing all + supported language extensions. + ghc-prim ~~~~~~~~ diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 0727d6b629..43c789b26e 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -62,6 +62,7 @@ import Maybes ( orElse, expectJust ) import NameSet import Panic hiding ( showException ) import Util +import qualified GHC.LanguageExtensions as LangExt -- Haskell Libraries import System.Console.Haskeline as Haskeline @@ -380,8 +381,8 @@ interactiveUI config srcs maybe_exprs = do -- as the global DynFlags, plus -XExtendedDefaultRules and -- -XNoMonomorphismRestriction. dflags <- getDynFlags - let dflags' = (`xopt_set` Opt_ExtendedDefaultRules) - . (`xopt_unset` Opt_MonomorphismRestriction) + let dflags' = (`xopt_set` LangExt.ExtendedDefaultRules) + . (`xopt_unset` LangExt.MonomorphismRestriction) $ dflags GHC.setInteractiveDynFlags dflags' @@ -859,7 +860,7 @@ checkInputForLayout :: String -> InputT GHCi (Maybe String) -> InputT GHCi (Maybe String) checkInputForLayout stmt getStmt = do dflags' <- getDynFlags - let dflags = xopt_set dflags' Opt_AlternativeLayoutRule + let dflags = xopt_set dflags' LangExt.AlternativeLayoutRule st0 <- getGHCiState let buf' = stringToStringBuffer stmt loc = mkRealSrcLoc (fsLit (progname st0)) (line_number st0) 1 @@ -1962,7 +1963,7 @@ setGHCContextFromGHCiState = do iidecls <- filterM (tryBool.checkAdd) (transient_ctx st ++ remembered_ctx st) dflags <- GHC.getSessionDynFlags GHC.setContext $ - if xopt Opt_ImplicitPrelude dflags && not (any isPreludeImport iidecls) + if xopt LangExt.ImplicitPrelude dflags && not (any isPreludeImport iidecls) then iidecls ++ [implicitPreludeImport] else iidecls -- XXX put prel at the end, so that guessCurrentModule doesn't pick it up. @@ -2371,7 +2372,7 @@ showImports = do prel_imp | any isPreludeImport (rem_ctx ++ trans_ctx) = [] - | not (xopt Opt_ImplicitPrelude dflags) = [] + | not (xopt LangExt.ImplicitPrelude dflags) = [] | otherwise = ["import Prelude -- implicit"] trans_comment s = s ++ " -- added automatically" diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in index 4f67e479c7..90b8a55e5b 100644 --- a/ghc/ghc-bin.cabal.in +++ b/ghc/ghc-bin.cabal.in @@ -33,6 +33,7 @@ Executable ghc directory >= 1 && < 1.3, process >= 1 && < 1.5, filepath >= 1 && < 1.5, + ghc-boot, ghc if os(windows) Build-Depends: Win32 diff --git a/libraries/ghc-boot/GHC/LanguageExtensions.hs b/libraries/ghc-boot/GHC/LanguageExtensions.hs new file mode 100644 index 0000000000..b108013f4b --- /dev/null +++ b/libraries/ghc-boot/GHC/LanguageExtensions.hs @@ -0,0 +1,122 @@ +----------------------------------------------------------------------------- +-- | +-- Module : GHC.LanguageExtensions +-- Copyright : (c) The GHC Team +-- +-- Maintainer : ghc-devs@haskell.org +-- Portability : portable +-- +-- A data type defining the language extensions supported by GHC. +-- +module GHC.LanguageExtensions ( Extension(..) ) where + +-- | The language extensions known to GHC. +data Extension +-- See Note [Updating flag description in the User's Guide] in DynFlags + = Cpp + | OverlappingInstances + | UndecidableInstances + | IncoherentInstances + | UndecidableSuperClasses + | MonomorphismRestriction + | MonoPatBinds + | MonoLocalBinds + | RelaxedPolyRec -- Deprecated + | ExtendedDefaultRules -- Use GHC's extended rules for defaulting + | ForeignFunctionInterface + | UnliftedFFITypes + | InterruptibleFFI + | CApiFFI + | GHCForeignImportPrim + | JavaScriptFFI + | ParallelArrays -- Syntactic support for parallel arrays + | Arrows -- Arrow-notation syntax + | TemplateHaskell + | TemplateHaskellQuotes -- subset of TH supported by stage1, no splice + | QuasiQuotes + | ImplicitParams + | ImplicitPrelude + | ScopedTypeVariables + | AllowAmbiguousTypes + | UnboxedTuples + | BangPatterns + | TypeFamilies + | TypeInType + | OverloadedStrings + | OverloadedLists + | NumDecimals + | DisambiguateRecordFields + | RecordWildCards + | RecordPuns + | ViewPatterns + | GADTs + | GADTSyntax + | NPlusKPatterns + | DoAndIfThenElse + | RebindableSyntax + | ConstraintKinds + | PolyKinds -- Kind polymorphism + | DataKinds -- Datatype promotion + | InstanceSigs + | ApplicativeDo + + | StandaloneDeriving + | DeriveDataTypeable + | AutoDeriveTypeable -- Automatic derivation of Typeable + | DeriveFunctor + | DeriveTraversable + | DeriveFoldable + | DeriveGeneric -- Allow deriving Generic/1 + | DefaultSignatures -- Allow extra signatures for defmeths + | DeriveAnyClass -- Allow deriving any class + | DeriveLift -- Allow deriving Lift + + | TypeSynonymInstances + | FlexibleContexts + | FlexibleInstances + | ConstrainedClassMethods + | MultiParamTypeClasses + | NullaryTypeClasses + | FunctionalDependencies + | UnicodeSyntax + | ExistentialQuantification + | MagicHash + | EmptyDataDecls + | KindSignatures + | RoleAnnotations + | ParallelListComp + | TransformListComp + | MonadComprehensions + | GeneralizedNewtypeDeriving + | RecursiveDo + | PostfixOperators + | TupleSections + | PatternGuards + | LiberalTypeSynonyms + | RankNTypes + | ImpredicativeTypes + | TypeOperators + | ExplicitNamespaces + | PackageImports + | ExplicitForAll + | AlternativeLayoutRule + | AlternativeLayoutRuleTransitional + | DatatypeContexts + | NondecreasingIndentation + | RelaxedLayout + | TraditionalRecordSyntax + | LambdaCase + | MultiWayIf + | BinaryLiterals + | NegativeLiterals + | DuplicateRecordFields + | OverloadedLabels + | EmptyCase + | PatternSynonyms + | PartialTypeSignatures + | NamedWildCards + | StaticPointers + | Strict + | StrictData + | MonadFailDesugaring + deriving (Eq, Enum, Show) diff --git a/libraries/ghc-boot/ghc-boot.cabal b/libraries/ghc-boot/ghc-boot.cabal index 98929b7f83..7f0f14fc8c 100644 --- a/libraries/ghc-boot/ghc-boot.cabal +++ b/libraries/ghc-boot/ghc-boot.cabal @@ -36,6 +36,7 @@ Library exposed-modules: GHC.Lexeme GHC.PackageDb + GHC.LanguageExtensions build-depends: base >= 4 && < 5, binary >= 0.7 && < 0.8, diff --git a/libraries/template-haskell/Language/Haskell/TH.hs b/libraries/template-haskell/Language/Haskell/TH.hs index 61f142670e..a41faf5fb1 100644 --- a/libraries/template-haskell/Language/Haskell/TH.hs +++ b/libraries/template-haskell/Language/Haskell/TH.hs @@ -26,6 +26,9 @@ module Language.Haskell.TH( ParentName, Arity, Unlifted, + -- *** Language extension lookup + Extension(..), + extsEnabled, isExtEnabled, -- *** Name lookup lookupTypeName, -- :: String -> Q (Maybe Name) lookupValueName, -- :: String -> Q (Maybe Name) diff --git a/libraries/template-haskell/Language/Haskell/TH/LanguageExtensions.hs b/libraries/template-haskell/Language/Haskell/TH/LanguageExtensions.hs new file mode 100644 index 0000000000..8a64490676 --- /dev/null +++ b/libraries/template-haskell/Language/Haskell/TH/LanguageExtensions.hs @@ -0,0 +1,22 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Language.Haskell.TH.LanguageExtensions +-- Copyright : (c) The University of Glasgow 2015 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : portable +-- +-- Language extensions known to GHC +-- +----------------------------------------------------------------------------- + +module Language.Haskell.TH.LanguageExtensions + ( Extension(..) + ) where + +-- This module exists primarily to avoid inserting a massive list of language +-- extensions into the already quite large Haddocks for Language.Haskell.TH + +import GHC.LanguageExtensions (Extension(..)) diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index 8e51e094f6..a9a8c39ab2 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -23,7 +23,11 @@ -- ----------------------------------------------------------------------------- -module Language.Haskell.TH.Syntax where +module Language.Haskell.TH.Syntax + ( module Language.Haskell.TH.Syntax + -- * Language extensions + , module Language.Haskell.TH.LanguageExtensions + ) where import Data.Data hiding (Fixity(..)) #if __GLASGOW_HASKELL__ < 709 @@ -39,6 +43,7 @@ import Data.Word import Data.Ratio import GHC.Generics ( Generic ) import GHC.Lexeme ( startsVarSym, startsVarId ) +import Language.Haskell.TH.LanguageExtensions #ifdef HAS_NATURAL import Numeric.Natural @@ -90,6 +95,9 @@ class (Applicative m, Monad m) => Quasi m where qPutQ :: Typeable a => a -> m () + qIsExtEnabled :: Extension -> m Bool + qExtsEnabled :: m [Extension] + ----------------------------------------------------- -- The IO instance of Quasi -- @@ -123,6 +131,8 @@ instance Quasi IO where qAddModFinalizer _ = badIO "addModFinalizer" qGetQ = badIO "getQ" qPutQ _ = badIO "putQ" + qIsExtEnabled _ = badIO "isExtEnabled" + qExtsEnabled = badIO "extsEnabled" qRunIO m = m @@ -424,14 +434,22 @@ addTopDecls ds = Q (qAddTopDecls ds) addModFinalizer :: Q () -> Q () addModFinalizer act = Q (qAddModFinalizer (unQ act)) --- | Get state from the Q monad. +-- | Get state from the 'Q' monad. getQ :: Typeable a => Q (Maybe a) getQ = Q qGetQ --- | Replace the state in the Q monad. +-- | Replace the state in the 'Q' monad. putQ :: Typeable a => a -> Q () putQ x = Q (qPutQ x) +-- | Determine whether the given language extension is enabled in the 'Q' monad. +isExtEnabled :: Extension -> Q Bool +isExtEnabled ext = Q (qIsExtEnabled ext) + +-- | List all enabled language extensions. +extsEnabled :: Q [Extension] +extsEnabled = Q qExtsEnabled + instance Quasi Q where qNewName = newName qReport = report @@ -450,6 +468,8 @@ instance Quasi Q where qAddModFinalizer = addModFinalizer qGetQ = getQ qPutQ = putQ + qIsExtEnabled = isExtEnabled + qExtsEnabled = extsEnabled ---------------------------------------------------- diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal index d4dd81e0a5..ad51144d68 100644 --- a/libraries/template-haskell/template-haskell.cabal +++ b/libraries/template-haskell/template-haskell.cabal @@ -41,6 +41,7 @@ Library Language.Haskell.TH.PprLib Language.Haskell.TH.Quote Language.Haskell.TH.Syntax + Language.Haskell.TH.LanguageExtensions other-modules: Language.Haskell.TH.Lib.Map diff --git a/testsuite/tests/ghc-api/T10508_api.hs b/testsuite/tests/ghc-api/T10508_api.hs index afe8e50e73..d0b8b0a946 100644 --- a/testsuite/tests/ghc-api/T10508_api.hs +++ b/testsuite/tests/ghc-api/T10508_api.hs @@ -2,6 +2,7 @@ module Main where import DynFlags import GHC +import qualified GHC.LanguageExtensions as LangExt import Control.Monad (forM_) import Control.Monad.IO.Class (liftIO) @@ -14,7 +15,7 @@ main = do dflags <- getSessionDynFlags setSessionDynFlags $ dflags `gopt_unset` Opt_ImplicitImportQualified - `xopt_unset` Opt_ImplicitPrelude + `xopt_unset` LangExt.ImplicitPrelude forM_ exprs $ \expr -> handleSourceError printException $ do diff --git a/testsuite/tests/th/T10820.hs b/testsuite/tests/th/T10820.hs new file mode 100644 index 0000000000..0e53bbde72 --- /dev/null +++ b/testsuite/tests/th/T10820.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE LiberalTypeSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE MagicHash #-} + +module Main where + +import Language.Haskell.TH.Syntax +import GHC.LanguageExtensions + +main = do + print $(isExtEnabled Cpp >>= lift) + print $(isExtEnabled LiberalTypeSynonyms >>= lift) + print $(isExtEnabled RankNTypes >>= lift) + print $(isExtEnabled TypeSynonymInstances >>= lift) + print $(isExtEnabled MagicHash >>= lift) diff --git a/testsuite/tests/th/T10820.stdout b/testsuite/tests/th/T10820.stdout new file mode 100644 index 0000000000..8a39f7a810 --- /dev/null +++ b/testsuite/tests/th/T10820.stdout @@ -0,0 +1,5 @@ +False +True +True +False +True
\ No newline at end of file diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 11b0ac21b1..af8531c8b1 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -369,3 +369,4 @@ test('T10819', extra_clean(['T10819_Lib.hi', 'T10819_Lib.o']), multimod_compile, ['T10819.hs', '-v0 ' + config.ghc_th_way_flags]) +test('T10820', normal, compile_and_run, ['-v0']) diff --git a/utils/haddock b/utils/haddock -Subproject 0fc8cfd532f5dfd12b5504f44a2b3c9fb659cd8 +Subproject d4657f07912416a1b14ddb517696f8ef3ffb85a diff --git a/utils/mkUserGuidePart/Main.hs b/utils/mkUserGuidePart/Main.hs index 11283c0b95..b30cc8f01d 100644 --- a/utils/mkUserGuidePart/Main.hs +++ b/utils/mkUserGuidePart/Main.hs @@ -1,7 +1,6 @@ module Main (main) where import DynFlags -import Data.List (stripPrefix) import Control.Monad (forM_) import Types hiding (flag) import Table @@ -43,11 +42,7 @@ whatGlasgowExtsDoes = unlines $ [ ".. hlist::", ""] ++ map ((" * "++) . parseExt) glasgowExtsFlags where - parseExt f - | Just ext <- stripPrefix "Opt_" (show f) - = inlineCode $ "-X" ++ ext - | otherwise - = error ("Can't parse extension: " ++ show f) + parseExt ext = inlineCode $ "-X" ++ show ext -- | Generate a reference table of the given set of flags. This is used in -- the users guide. |