Commit e5b79a69 authored by Ian Lynagh's avatar Ian Lynagh

Add an extension to disable n+k patterns

parent 1bae6cc5
......@@ -226,6 +226,7 @@ data DynFlag
| Opt_ViewPatterns
| Opt_GADTs
| Opt_RelaxedPolyRec
| Opt_NPlusKPatterns
| Opt_StandaloneDeriving
| Opt_DeriveDataTypeable
......@@ -693,6 +694,7 @@ defaultDynFlags =
Opt_ImplicitPrelude,
Opt_MonomorphismRestriction,
Opt_NPlusKPatterns,
Opt_MethodSharing,
......@@ -1808,6 +1810,8 @@ xFlags = [
( "BangPatterns", Opt_BangPatterns, const Supported ),
-- On by default:
( "MonomorphismRestriction", Opt_MonomorphismRestriction, const Supported ),
-- On by default:
( "NPlusKPatterns", Opt_NPlusKPatterns, const Supported ),
-- On by default (which is not strictly H98):
( "MonoPatBinds", Opt_MonoPatBinds, const Supported ),
( "MonoLocalBinds", Opt_MonoLocalBinds, const Supported ),
......
......@@ -46,6 +46,7 @@
module Lexer (
Token(..), lexer, pragState, mkPState, PState(..),
P(..), ParseResult(..), getSrcLoc,
getPState,
failLocMsgP, failSpanMsgP, srcParseFail,
getMessages,
popContext, pushCurrentContext, setLastToken, setSrcLoc,
......@@ -1515,6 +1516,9 @@ failLocMsgP loc1 loc2 str = P $ \_ -> PFailed (mkSrcSpan loc1 loc2) (text str)
failSpanMsgP :: SrcSpan -> SDoc -> P a
failSpanMsgP span msg = P $ \_ -> PFailed span msg
getPState :: P PState
getPState = P $ \s -> POk s s
extension :: (Int -> Bool) -> P Bool
extension p = P $ \s -> POk s (p $! extsBitmap s)
......
......@@ -63,13 +63,14 @@ import RdrName ( RdrName, isRdrTyVar, isRdrTc, mkUnqual, rdrNameOcc,
import BasicTypes ( maxPrecedence, Activation, RuleMatchInfo,
InlinePragma(..), InlineSpec(..),
alwaysInlineSpec, neverInlineSpec )
import Lexer ( P, failSpanMsgP, extension, standaloneDerivingEnabled, bangPatEnabled )
import Lexer
import TysWiredIn ( unitTyCon )
import ForeignCall ( CCallConv(..), Safety, CCallTarget(..), CExportSpec(..),
DNCallSpec(..), DNKind(..), CLabelString )
import OccName ( srcDataName, varName, isDataOcc, isTcOcc,
occNameString )
import PrelNames ( forall_tv_RDR )
import DynFlags
import SrcLoc
import OrdList ( OrdList, fromOL )
import Bag ( Bag, emptyBag, snocBag, consBag, foldrBag )
......@@ -725,12 +726,14 @@ checkPat loc e args -- OK to let this happen even if bang-patterns
checkPat loc (L _ (HsApp f x)) args
= do { x <- checkLPat x; checkPat loc f (x:args) }
checkPat loc (L _ e) []
= do { p <- checkAPat loc e; return (L loc p) }
= do { pState <- getPState
; p <- checkAPat (dflags pState) loc e
; return (L loc p) }
checkPat loc _ _
= patFail loc
checkAPat :: SrcSpan -> HsExpr RdrName -> P (Pat RdrName)
checkAPat loc e = case e of
checkAPat :: DynFlags -> SrcSpan -> HsExpr RdrName -> P (Pat RdrName)
checkAPat dynflags loc e = case e of
EWildPat -> return (WildPat placeHolderType)
HsVar x | isQual x -> parseError loc ("Qualified variable in pattern: "
++ showRdrName x)
......@@ -766,7 +769,7 @@ checkAPat loc e = case e of
-- n+k patterns
OpApp (L nloc (HsVar n)) (L _ (HsVar plus)) _
(L _ (HsOverLit lit@(OverLit {ol_val = HsIntegral {}})))
| plus == plus_RDR
| dopt Opt_NPlusKPatterns dynflags && (plus == plus_RDR)
-> return (mkNPlusKPat (L nloc n) lit)
OpApp l op _fix r -> do l <- checkLPat l
......
......@@ -705,6 +705,12 @@
<entry>dynamic</entry>
<entry><option>-XMonomorphismRrestriction</option></entry>
</row>
<row>
<entry><option>-XNoNPlusKPatterns</option></entry>
<entry>Disable support for <literal>n+k</literal> patterns</entry>
<entry>dynamic</entry>
<entry><option>-XNPlusKPatterns</option></entry>
</row>
<row>
<entry><option>-XNoMonoPatBinds</option></entry>
<entry>Make <link linkend="monomorphism">pattern bindings polymorphic</link></entry>
......
......@@ -838,6 +838,19 @@ y)</literal> will not be coalesced.
</itemizedlist>
</para>
</sect2>
<!-- ===================== n+k patterns =================== -->
<sect2 id="n-k-patterns">
<title>n+k patterns</title>
<indexterm><primary><option>-XNoNPlusKPatterns</option></primary></indexterm>
<para>
<literal>n+k</literal> pattern support is enabled by default. To disable
it, you can use the <option>-XNoNPlusKPatterns</option> flag.
</para>
</sect2>
<!-- ===================== Recursive do-notation =================== -->
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment