Commit c1e25536 authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

Expose enabled language extensions to TH

This exposes `template-haskell` functions for querying the language
extensions which are enabled when compiling a module,

- an `isExtEnabled` function to check whether an extension is enabled
- an `extsEnabled` function to obtain a full list of enabled extensions

To avoid code duplication this adds a `GHC.LanguageExtensions` module to
`ghc-boot` and moves `DynFlags.ExtensionFlag` into it. A happy
consequence of this is that the ungainly `DynFlags` lost around 500
lines. Moreover, flags corresponding to language extensions are now
clearly distinguished from other flags due to the `LangExt.*` prefix.

Updates haddock submodule.

This fixes #10820.

Test Plan: validate

Reviewers: austin, spinda, hvr, goldfire, alanz

Reviewed By: goldfire

Subscribers: mpickering, RyanGlScott, hvr, simonpj, thomie

Differential Revision: https://phabricator.haskell.org/D1200

GHC Trac Issues: #10820
parent 28638dfe
......@@ -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
{-
......
......@@ -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)) $
......
......@@ -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
......
......@@ -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)
......@@ -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
......
......@@ -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
......
This diff is collapsed.
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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
{-
%************************************************************************
......
......@@ -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
......
......@@ -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
......
......@@ -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
{-
......
......@@ -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")
......
......@@ -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)
......
......@@ -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}