diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/main/DynFlags.hs | 9 | ||||
| -rw-r--r-- | compiler/parser/Lexer.x | 7 | ||||
| -rw-r--r-- | compiler/rename/RnExpr.lhs | 25 |
3 files changed, 22 insertions, 19 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index c45bb2df95..179a40c751 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -448,7 +448,6 @@ data ExtensionFlag | Opt_MonadComprehensions | Opt_GeneralizedNewtypeDeriving | Opt_RecursiveDo - | Opt_DoRec | Opt_PostfixOperators | Opt_TupleSections | Opt_PatternGuards @@ -2028,9 +2027,9 @@ xFlags = [ ( "ImpredicativeTypes", Opt_ImpredicativeTypes, nop), ( "TypeOperators", Opt_TypeOperators, nop ), ( "ExplicitNamespaces", Opt_ExplicitNamespaces, nop ), - ( "RecursiveDo", Opt_RecursiveDo, -- Enables 'mdo' - deprecatedForExtension "DoRec"), - ( "DoRec", Opt_DoRec, nop ), -- Enables 'rec' keyword + ( "RecursiveDo", Opt_RecursiveDo, nop ), -- Enables 'mdo' and 'rec' + ( "DoRec", Opt_RecursiveDo, + deprecatedForExtension "RecursiveDo" ), ( "Arrows", Opt_Arrows, nop ), ( "ParallelArrays", Opt_ParallelArrays, nop ), ( "TemplateHaskell", Opt_TemplateHaskell, checkTemplateHaskellOk ), @@ -2276,7 +2275,7 @@ glasgowExtsFlags = [ , Opt_RankNTypes , Opt_TypeOperators , Opt_ExplicitNamespaces - , Opt_DoRec + , Opt_RecursiveDo , Opt_ParallelListComp , Opt_EmptyDataDecls , Opt_KindSignatures diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index e40f7b2f11..2f9c75ca03 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -658,7 +658,8 @@ reservedWordsFM = listToUFM $ ( "capi", ITcapiconv, bit cApiFfiBit), ( "prim", ITprimcallconv, bit ffiBit), - ( "rec", ITrec, bit recBit), + ( "rec", ITrec, bit arrowsBit .|. + bit recursiveDoBit), ( "proc", ITproc, bit arrowsBit) ] @@ -1826,8 +1827,6 @@ inRulePragBit :: Int inRulePragBit = 19 rawTokenStreamBit :: Int rawTokenStreamBit = 20 -- producing a token stream with all comments included -recBit :: Int -recBit = 22 -- rec alternativeLayoutRuleBit :: Int alternativeLayoutRuleBit = 23 relaxedLayoutBit :: Int @@ -1937,8 +1936,6 @@ mkPState flags buf loc = .|. magicHashBit `setBitIf` xopt Opt_MagicHash flags .|. kindSigsBit `setBitIf` xopt Opt_KindSignatures flags .|. recursiveDoBit `setBitIf` xopt Opt_RecursiveDo flags - .|. recBit `setBitIf` xopt Opt_DoRec flags - .|. recBit `setBitIf` xopt Opt_Arrows flags .|. unicodeSyntaxBit `setBitIf` xopt Opt_UnicodeSyntax flags .|. unboxedTuplesBit `setBitIf` xopt Opt_UnboxedTuples flags .|. datatypeContextsBit `setBitIf` xopt Opt_DatatypeContexts flags diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index 7ff7c7adec..c5bf23fc3a 100644 --- a/compiler/rename/RnExpr.lhs +++ b/compiler/rename/RnExpr.lhs @@ -753,7 +753,7 @@ rnStmt ctxt (L _ (RecStmt { recS_stmts = rec_stmts })) thing_inside -- Step 3: Group together the segments to make bigger segments -- Invariant: in the result, no segment uses a variable -- bound in a later segment - grouped_segs = glomSegments segs_w_fwd_refs + grouped_segs = glomSegments ctxt segs_w_fwd_refs -- Step 4: Turn the segments into Stmts -- Use RecStmt when and only when there are fwd refs @@ -1101,15 +1101,20 @@ addFwdRefs pairs -- { rec { x <- ...y...; p <- z ; y <- ...x... ; -- q <- x ; z <- y } ; -- r <- x } +-- +-- NB. June 7 2012: We only glom segments that appear in +-- an explicit mdo; and leave those found in "do rec"'s intact. +-- See http://hackage.haskell.org/trac/ghc/ticket/4148 for +-- the discussion leading to this design choice. -glomSegments :: [Segment (LStmt Name)] -> [Segment [LStmt Name]] +glomSegments :: HsStmtContext Name -> [Segment (LStmt Name)] -> [Segment [LStmt Name]] -glomSegments [] = [] -glomSegments ((defs,uses,fwds,stmt) : segs) +glomSegments _ [] = [] +glomSegments ctxt ((defs,uses,fwds,stmt) : segs) -- Actually stmts will always be a singleton = (seg_defs, seg_uses, seg_fwds, seg_stmts) : others where - segs' = glomSegments segs + segs' = glomSegments ctxt segs (extras, others) = grab uses segs' (ds, us, fs, ss) = unzip4 extras @@ -1127,7 +1132,9 @@ glomSegments ((defs,uses,fwds,stmt) : segs) = (reverse yeses, reverse noes) where (noes, yeses) = span not_needed (reverse dus) - not_needed (defs,_,_,_) = not (intersectsNameSet defs uses) + not_needed (defs,_,_,_) = case ctxt of + MDoExpr -> not (intersectsNameSet defs uses) + _ -> False -- unless we're in mdo, we *need* everything ---------------------------------------------------- @@ -1297,9 +1304,9 @@ okParStmt dflags ctxt stmt okDoStmt dflags ctxt stmt = case stmt of RecStmt {} - | Opt_DoRec `xopt` dflags -> isOK - | ArrowExpr <- ctxt -> isOK -- Arrows allows 'rec' - | otherwise -> Just (ptext (sLit "Use -XDoRec")) + | Opt_RecursiveDo `xopt` dflags -> isOK + | ArrowExpr <- ctxt -> isOK -- Arrows allows 'rec' + | otherwise -> Just (ptext (sLit "Use -XRecursiveDo")) BindStmt {} -> isOK LetStmt {} -> isOK ExprStmt {} -> isOK |