X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fparser%2FLexer.x;h=a4a343985a3ee64c216c74e519f1c111e9d92076;hp=3a001bd08eeeb341c47c9f5e36c309e9488985cf;hb=e9f9ec1e57d53b9302a395ce0d02c0fa59e28341;hpb=a3a7bba7445be24db313f89eb558b3c0fd55ed6e

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 3a001bd..a4a3439 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -1981,7 +1981,9 @@ alternativeLayoutRuleToken t
          mExpectingOCurly <- getAlrExpectingOCurly
          justClosedExplicitLetBlock <- getJustClosedExplicitLetBlock
          setJustClosedExplicitLetBlock False
-         let thisLoc = getLoc t
+         dflags <- getDynFlags
+         let transitional = dopt Opt_AlternativeLayoutRuleTransitional dflags
+             thisLoc = getLoc t
              thisCol = srcSpanStartCol thisLoc
              newLine = (lastLoc == noSrcSpan)
                     || (srcSpanStartLine thisLoc > srcSpanEndLine lastLoc)
@@ -2040,6 +2042,18 @@ alternativeLayoutRuleToken t
                  do setPendingImplicitTokens [t]
                     setALRContext ls
                     return (L thisLoc ITccurly)
+             -- This next case is to handle a transitional issue:
+             (ITwhere, ALRLayout _ col : ls, _)
+              | newLine && thisCol == col && transitional ->
+                 do addWarning Opt_WarnAlternativeLayoutRuleTransitional
+                               thisLoc
+                               (transitionalAlternativeLayoutWarning
+                                    "`where' clause at the same depth as implicit layout block")
+                    setALRContext ls
+                    setNextToken t
+                    -- Note that we use lastLoc, as we may need to close
+                    -- more layouts, or give a semicolon
+                    return (L lastLoc ITccurly)
              (_, ALRLayout _ col : ls, _)
               | newLine && thisCol == col ->
                  do setNextToken t
@@ -2090,6 +2104,11 @@ alternativeLayoutRuleToken t
              -- the other ITwhere case omitted; general case below covers it
              (_, _, _) -> return t
 
+transitionalAlternativeLayoutWarning :: String -> SDoc
+transitionalAlternativeLayoutWarning msg
+    = text "transitional layout will not be accepted in the future:"
+   $$ text msg
+
 isALRopen :: Token -> Bool
 isALRopen ITcase        = True
 isALRopen ITif          = True