From 9a82b1ffa35fa4c3927c66a1037a37d436cf6aac Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Sat, 20 Nov 2010 21:53:40 +0000
Subject: [PATCH] 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.

---
 compiler/main/DynFlags.hs |    3 +++
 compiler/parser/Lexer.x   |   11 +++++++++--
 2 files changed, 12 insertions(+), 2 deletions(-)

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