Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/742067003bfe91dbde91d1ff2e57c3182dabaa67 >--------------------------------------------------------------- commit 742067003bfe91dbde91d1ff2e57c3182dabaa67 Author: Ian Lynagh <[email protected]> Date: Mon Sep 26 23:32:04 2011 +0100 Define a TraditionalRecordSyntax extension; fixes #3356 This allows the extension (which is on by default) to be turned off, which gets us a small step closer to replacing Haskell98 records with something better. >--------------------------------------------------------------- compiler/main/DynFlags.hs | 4 ++++ compiler/parser/Lexer.x | 6 ++++++ compiler/parser/Parser.y.pp | 7 ++++--- compiler/parser/RdrHsSyn.lhs | 10 ++++++++++ 4 files changed, 24 insertions(+), 3 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 5e2f25a..3385c36 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -426,6 +426,7 @@ data ExtensionFlag | Opt_DatatypeContexts | Opt_NondecreasingIndentation | Opt_RelaxedLayout + | Opt_TraditionalRecordSyntax deriving (Eq, Show) -- | Contains not only a collection of 'DynFlag's but also a plethora of @@ -928,6 +929,7 @@ languageExtensions (Just Haskell98) Opt_MonomorphismRestriction, Opt_NPlusKPatterns, Opt_DatatypeContexts, + Opt_TraditionalRecordSyntax, Opt_NondecreasingIndentation -- strictly speaking non-standard, but we always had this -- on implicitly before the option was added in 7.1, and @@ -940,6 +942,7 @@ languageExtensions (Just Haskell2010) = [Opt_ImplicitPrelude, Opt_MonomorphismRestriction, Opt_DatatypeContexts, + Opt_TraditionalRecordSyntax, Opt_EmptyDataDecls, Opt_ForeignFunctionInterface, Opt_PatternGuards, @@ -1875,6 +1878,7 @@ xFlags = [ \ turn_on -> when turn_on $ deprecate "It was widely considered a misfeature, and has been removed from the Haskell language." ), ( "NondecreasingIndentation", AlwaysAllowed, Opt_NondecreasingIndentation, nop ), ( "RelaxedLayout", AlwaysAllowed, Opt_RelaxedLayout, nop ), + ( "TraditionalRecordSyntax", AlwaysAllowed, Opt_TraditionalRecordSyntax, nop ), ( "MonoLocalBinds", AlwaysAllowed, Opt_MonoLocalBinds, nop ), ( "RelaxedPolyRec", AlwaysAllowed, Opt_RelaxedPolyRec, \ turn_on -> if not turn_on diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 90e1e66..ec11cd5 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -55,6 +55,7 @@ module Lexer ( activeContext, nextIsEOF, getLexState, popLexState, pushLexState, extension, bangPatEnabled, datatypeContextsEnabled, + traditionalRecordSyntaxEnabled, addWarning, lexTokenStream ) where @@ -1783,6 +1784,8 @@ nondecreasingIndentationBit :: Int nondecreasingIndentationBit = 25 safeHaskellBit :: Int safeHaskellBit = 26 +traditionalRecordSyntaxBit :: Int +traditionalRecordSyntaxBit = 27 always :: Int -> Bool always _ = True @@ -1824,6 +1827,8 @@ relaxedLayout :: Int -> Bool relaxedLayout flags = testBit flags relaxedLayoutBit nondecreasingIndentation :: Int -> Bool nondecreasingIndentation flags = testBit flags nondecreasingIndentationBit +traditionalRecordSyntaxEnabled :: Int -> Bool +traditionalRecordSyntaxEnabled flags = testBit flags traditionalRecordSyntaxBit -- PState for parsing options pragmas -- @@ -1880,6 +1885,7 @@ mkPState flags buf loc = .|. relaxedLayoutBit `setBitIf` xopt Opt_RelaxedLayout flags .|. nondecreasingIndentationBit `setBitIf` xopt Opt_NondecreasingIndentation flags .|. safeHaskellBit `setBitIf` safeHaskellOn flags + .|. traditionalRecordSyntaxBit `setBitIf` xopt Opt_TraditionalRecordSyntax flags -- setBitIf :: Int -> Bool -> Int b `setBitIf` cond | cond = bit b diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 8e47383..9a25b7d 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -1032,7 +1032,7 @@ atype :: { LHsType RdrName } : gtycon { L1 (HsTyVar (unLoc $1)) } | tyvar { L1 (HsTyVar (unLoc $1)) } | strict_mark atype { LL (HsBangTy (unLoc $1) $2) } -- Constructor sigs only - | '{' fielddecls '}' { LL $ HsRecTy $2 } -- Constructor sigs only + | '{' fielddecls '}' {% checkRecordSyntax (LL $ HsRecTy $2) } -- Constructor sigs only | '(' ctype ',' comma_types1 ')' { LL $ HsTupleTy (HsBoxyTuple placeHolderKind) ($2:$4) } | '(#' comma_types1 '#)' { LL $ HsTupleTy HsUnboxedTuple $2 } | '[' ctype ']' { LL $ HsListTy $2 } @@ -1128,7 +1128,8 @@ gadt_constr :: { [LConDecl RdrName] } -- Returns a list because of: C,D :: ty -- Deprecated syntax for GADT record declarations | oqtycon '{' fielddecls '}' '::' sigtype {% do { cd <- mkDeprecatedGadtRecordDecl (comb2 $1 $6) $1 $3 $6 - ; return [cd] } } + ; cd' <- checkRecordSyntax cd + ; return [cd'] } } constrs :: { Located [LConDecl RdrName] } : maybe_docnext '=' constrs1 { L (comb2 $2 $3) (addConDocs (unLoc $3) $1) } @@ -1357,7 +1358,7 @@ aexp :: { LHsExpr RdrName } aexp1 :: { LHsExpr RdrName } : aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4) $3 - ; return (LL r) }} + ; checkRecordSyntax (LL r) }} | aexp2 { $1 } -- Here was the syntax for type applications that I was planning diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 7310ec3..6f47ea8 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -44,6 +44,7 @@ module RdrHsSyn ( checkValSig, -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl checkDoAndIfThenElse, checkKindName, + checkRecordSyntax, parseError, parseErrorSDoc, ) where @@ -531,6 +532,15 @@ checkDatatypeContext (Just (L loc c)) (text "Illegal datatype context (use -XDatatypeContexts):" <+> pprHsContext c) +checkRecordSyntax :: Outputable a => Located a -> P (Located a) +checkRecordSyntax lr@(L loc r) + = do allowed <- extension traditionalRecordSyntaxEnabled + if allowed + then return lr + else parseErrorSDoc loc + (text "Illegal record syntax (use -XTraditionalRecordSyntax):" <+> + ppr r) + checkTyClHdr :: LHsType RdrName -> P (Located RdrName, -- the head symbol (type or class name) [LHsType RdrName]) -- parameters of head symbol _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
