diff options
Diffstat (limited to 'compiler/parser/RdrHsSyn.hs')
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 42 |
1 files changed, 20 insertions, 22 deletions
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 4338968ecf..c1777759da 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -108,7 +108,6 @@ import Maybes import Util import ApiAnnotation import Data.List -import qualified GHC.LanguageExtensions as LangExt import DynFlags ( WarningFlag(..) ) import Control.Monad @@ -880,7 +879,7 @@ equalsDots = text "= ..." checkDatatypeContext :: Maybe (LHsContext GhcPs) -> P () checkDatatypeContext Nothing = return () checkDatatypeContext (Just c) - = do allowed <- extension datatypeContextsEnabled + = do allowed <- getBit DatatypeContextsBit unless allowed $ parseErrorSDoc (getLoc c) (text "Illegal datatype context (use DatatypeContexts):" @@ -918,7 +917,7 @@ checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName) checkRecordSyntax :: Outputable a => Located a -> P (Located a) checkRecordSyntax lr@(dL->L loc r) - = do allowed <- extension traditionalRecordSyntaxEnabled + = do allowed <- getBit TraditionalRecordSyntaxBit if allowed then return lr else parseErrorSDoc loc @@ -930,8 +929,8 @@ checkRecordSyntax lr@(dL->L loc r) checkEmptyGADTs :: Located ([AddAnn], [LConDecl GhcPs]) -> P (Located ([AddAnn], [LConDecl GhcPs])) checkEmptyGADTs gadts@(dL->L span (_, [])) -- Empty GADT declaration. - = do opts <- fmap options getPState - if LangExt.GADTSyntax `extopt` opts -- GADTs implies GADTSyntax + = do gadtSyntax <- getBit GadtSyntaxBit -- GADTs implies GADTSyntax + if gadtSyntax then return gadts else parseErrorSDoc span $ vcat [ text "Illegal keyword 'where' in data declaration" @@ -995,8 +994,8 @@ checkBlockArguments expr = case unLoc expr of _ -> return () where check element = do - pState <- getPState - unless (extopt LangExt.BlockArguments (options pState)) $ + blockArguments <- getBit BlockArgumentsBit + unless blockArguments $ parseErrorSDoc (getLoc expr) $ text "Unexpected " <> text element <> text " in function application:" $$ nest 4 (ppr expr) @@ -1082,8 +1081,7 @@ checkPat msg loc e _ checkAPat :: SDoc -> SrcSpan -> HsExpr GhcPs -> P (Pat GhcPs) checkAPat msg loc e0 = do - pState <- getPState - let opts = options pState + nPlusKPatterns <- getBit NPlusKPatternsBit case e0 of EWildPat _ -> return (WildPat noExt) HsVar _ x -> return (VarPat noExt x) @@ -1119,7 +1117,7 @@ checkAPat msg loc e0 = do OpApp _ (dL->L nloc (HsVar _ (dL->L _ n))) (dL->L _ (HsVar _ (dL->L _ plus))) (dL->L lloc (HsOverLit _ lit@(OverLit {ol_val = HsIntegral {}}))) - | extopt LangExt.NPlusKPatterns opts && (plus == plus_RDR) + | nPlusKPatterns && (plus == plus_RDR) -> return (mkNPlusKPat (cL nloc n) (cL lloc lit)) OpApp _ l (dL->L cl (HsVar _ (dL->L _ c))) r | isDataOcc (rdrNameOcc c) -> do @@ -1285,8 +1283,8 @@ checkDoAndIfThenElse :: LHsExpr GhcPs -> P () checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr | semiThen || semiElse - = do pState <- getPState - unless (extopt LangExt.DoAndIfThenElse (options pState)) $ do + = do doAndIfThenElse <- getBit DoAndIfThenElseBit + unless doAndIfThenElse $ do parseErrorSDoc (combineLocs guardExpr elseExpr) (text "Unexpected semi-colons in conditional:" $$ nest 4 expr @@ -1356,7 +1354,7 @@ isFunLhs e = go e [] [] go e@(L loc (OpApp _ l (dL->L loc' (HsVar _ (dL->L _ op))) r)) es ann | Just (e',es') <- splitBang e - = do { bang_on <- extension bangPatEnabled + = do { bang_on <- getBit BangPatBit ; if bang_on then go e' (es' ++ es) ann else return (Just (cL loc' op, Infix, (l:r:es), ann)) } -- No bangs; behave just like the next case @@ -1837,15 +1835,15 @@ mergeDataCon all_xs = nest 2 (hsep . reverse $ map ppr all_xs') --------------------------------------------------------------------------- --- Check for monad comprehensions +-- | Check for monad comprehensions -- --- If the flag MonadComprehensions is set, return a `MonadComp' context, --- otherwise use the usual `ListComp' context +-- If the flag MonadComprehensions is set, return a 'MonadComp' context, +-- otherwise use the usual 'ListComp' context checkMonadComp :: P (HsStmtContext Name) checkMonadComp = do - pState <- getPState - return $ if extopt LangExt.MonadComprehensions (options pState) + monadComprehensions <- getBit MonadComprehensionsBit + return $ if monadComprehensions then MonadComp else ListComp @@ -2168,7 +2166,7 @@ mkModuleImpExp (dL->L l specname) subs = (\newName -> IEThingWith noExt (cL l newName) NoIEWildcard (wrapped xs) []) <$> nameT ImpExpAllWith xs -> - do allowed <- extension patternSynonymsEnabled + do allowed <- getBit PatternSynonymsBit if allowed then let withs = map unLoc xs @@ -2207,7 +2205,7 @@ mkModuleImpExp (dL->L l specname) subs = mkTypeImpExp :: Located RdrName -- TcCls or Var name space -> P (Located RdrName) mkTypeImpExp name = - do allowed <- extension explicitNamespacesEnabled + do allowed <- getBit ExplicitNamespacesBit if allowed then return (fmap (`setRdrNameSpace` tcClsName) name) else parseErrorSDoc (getLoc name) @@ -2263,7 +2261,7 @@ warnStarBndr span = addWarning Opt_WarnStarBinder span msg failOpFewArgs :: Located RdrName -> P a failOpFewArgs (dL->L loc op) = - do { star_is_type <- extension starIsTypeEnabled + do { star_is_type <- getBit StarIsTypeBit ; let msg = too_few $$ starInfo star_is_type op ; parseErrorSDoc loc msg } where @@ -2295,7 +2293,7 @@ parseErrorSDoc span s = failSpanMsgP span s -- | Hint about bang patterns, assuming @BangPatterns@ is off. hintBangPat :: SrcSpan -> HsExpr GhcPs -> P () hintBangPat span e = do - bang_on <- extension bangPatEnabled + bang_on <- getBit BangPatBit unless bang_on $ parseErrorSDoc span (text "Illegal bang-pattern (use BangPatterns):" $$ ppr e) |