Commit 9a82b1ff authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Add an extension for GHC's layout-rule relaxations

Still TODO: Add the other relaxation (#1060) and update the alternative
layout rule to use the extension.
parent dc03e1ed
...@@ -361,6 +361,7 @@ data ExtensionFlag ...@@ -361,6 +361,7 @@ data ExtensionFlag
| Opt_AlternativeLayoutRule | Opt_AlternativeLayoutRule
| Opt_AlternativeLayoutRuleTransitional | Opt_AlternativeLayoutRuleTransitional
| Opt_DatatypeContexts | Opt_DatatypeContexts
| Opt_RelaxedLayout
deriving (Eq, Show) deriving (Eq, Show)
-- | Contains not only a collection of 'DynFlag's but also a plethora of -- | Contains not only a collection of 'DynFlag's but also a plethora of
...@@ -794,6 +795,7 @@ languageExtensions Nothing ...@@ -794,6 +795,7 @@ languageExtensions Nothing
-- In due course I'd like Opt_MonoLocalBinds to be on by default -- In due course I'd like Opt_MonoLocalBinds to be on by default
-- But NB it's implied by GADTs etc -- But NB it's implied by GADTs etc
-- SLPJ September 2010 -- SLPJ September 2010
: Opt_RelaxedLayout -- This has been on by default for some time
: languageExtensions (Just Haskell2010) : languageExtensions (Just Haskell2010)
languageExtensions (Just Haskell98) languageExtensions (Just Haskell98)
...@@ -1591,6 +1593,7 @@ xFlags = [ ...@@ -1591,6 +1593,7 @@ xFlags = [
( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, nop ), ( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, nop ),
( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, nop ), ( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, nop ),
( "DatatypeContexts", Opt_DatatypeContexts, nop ), ( "DatatypeContexts", Opt_DatatypeContexts, nop ),
( "RelaxedLayout", Opt_RelaxedLayout, nop ),
( "MonoLocalBinds", Opt_MonoLocalBinds, nop ), ( "MonoLocalBinds", Opt_MonoLocalBinds, nop ),
( "RelaxedPolyRec", Opt_RelaxedPolyRec, ( "RelaxedPolyRec", Opt_RelaxedPolyRec,
\ turn_on -> if not turn_on \ turn_on -> if not turn_on
......
...@@ -1107,10 +1107,12 @@ new_layout_context strict span _buf _len = do ...@@ -1107,10 +1107,12 @@ new_layout_context strict span _buf _len = do
(AI l _) <- getInput (AI l _) <- getInput
let offset = srcLocCol l let offset = srcLocCol l
ctx <- getContext ctx <- getContext
relaxed <- extension relaxedLayout
let strict' = strict || not relaxed
case ctx of case ctx of
Layout prev_off : _ | Layout prev_off : _ |
(strict && prev_off >= offset || (strict' && prev_off >= offset ||
not strict && prev_off > offset) -> do not strict' && prev_off > offset) -> do
-- token is indented to the left of the previous context. -- token is indented to the left of the previous context.
-- we must generate a {} sequence now. -- we must generate a {} sequence now.
pushLexState layout_left pushLexState layout_left
...@@ -1761,6 +1763,8 @@ recBit :: Int ...@@ -1761,6 +1763,8 @@ recBit :: Int
recBit = 22 -- rec recBit = 22 -- rec
alternativeLayoutRuleBit :: Int alternativeLayoutRuleBit :: Int
alternativeLayoutRuleBit = 23 alternativeLayoutRuleBit = 23
relaxedLayoutBit :: Int
relaxedLayoutBit = 24
always :: Int -> Bool always :: Int -> Bool
always _ = True always _ = True
...@@ -1804,6 +1808,8 @@ oldQualOps :: Int -> Bool ...@@ -1804,6 +1808,8 @@ oldQualOps :: Int -> Bool
oldQualOps flags = not (newQualOps flags) oldQualOps flags = not (newQualOps flags)
alternativeLayoutRule :: Int -> Bool alternativeLayoutRule :: Int -> Bool
alternativeLayoutRule flags = testBit flags alternativeLayoutRuleBit alternativeLayoutRule flags = testBit flags alternativeLayoutRuleBit
relaxedLayout :: Int -> Bool
relaxedLayout flags = testBit flags relaxedLayoutBit
-- PState for parsing options pragmas -- PState for parsing options pragmas
-- --
...@@ -1857,6 +1863,7 @@ mkPState flags buf loc = ...@@ -1857,6 +1863,7 @@ mkPState flags buf loc =
.|. rawTokenStreamBit `setBitIf` dopt Opt_KeepRawTokenStream flags .|. rawTokenStreamBit `setBitIf` dopt Opt_KeepRawTokenStream flags
.|. newQualOpsBit `setBitIf` xopt Opt_NewQualifiedOperators flags .|. newQualOpsBit `setBitIf` xopt Opt_NewQualifiedOperators flags
.|. alternativeLayoutRuleBit `setBitIf` xopt Opt_AlternativeLayoutRule flags .|. alternativeLayoutRuleBit `setBitIf` xopt Opt_AlternativeLayoutRule flags
.|. relaxedLayoutBit `setBitIf` xopt Opt_RelaxedLayout flags
-- --
setBitIf :: Int -> Bool -> Int setBitIf :: Int -> Bool -> Int
b `setBitIf` cond | cond = bit b b `setBitIf` cond | cond = bit b
......
Supports Markdown
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