Commit e9f9ec1e authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Add transitional rules for the alternative layout rule

If enabled, these accept more layout, but give warnings
parent a3a7bba7
...@@ -184,6 +184,7 @@ data DynFlag ...@@ -184,6 +184,7 @@ data DynFlag
| Opt_WarnLazyUnliftedBindings | Opt_WarnLazyUnliftedBindings
| Opt_WarnUnusedDoBind | Opt_WarnUnusedDoBind
| Opt_WarnWrongDoBind | Opt_WarnWrongDoBind
| Opt_WarnAlternativeLayoutRuleTransitional
-- language opts -- language opts
...@@ -252,6 +253,7 @@ data DynFlag ...@@ -252,6 +253,7 @@ data DynFlag
| Opt_NewQualifiedOperators | Opt_NewQualifiedOperators
| Opt_ExplicitForAll | Opt_ExplicitForAll
| Opt_AlternativeLayoutRule | Opt_AlternativeLayoutRule
| Opt_AlternativeLayoutRuleTransitional
| Opt_PrintExplicitForalls | Opt_PrintExplicitForalls
...@@ -930,7 +932,8 @@ standardWarnings ...@@ -930,7 +932,8 @@ standardWarnings
Opt_WarnDuplicateExports, Opt_WarnDuplicateExports,
Opt_WarnLazyUnliftedBindings, Opt_WarnLazyUnliftedBindings,
Opt_WarnDodgyForeignImports, Opt_WarnDodgyForeignImports,
Opt_WarnWrongDoBind Opt_WarnWrongDoBind,
Opt_WarnAlternativeLayoutRuleTransitional
] ]
minusWOpts :: [DynFlag] minusWOpts :: [DynFlag]
...@@ -1464,6 +1467,7 @@ fFlags = [ ...@@ -1464,6 +1467,7 @@ fFlags = [
const $ Deprecated "lazy unlifted bindings will be an error in GHC 6.14, and this flag will no longer exist"), const $ Deprecated "lazy unlifted bindings will be an error in GHC 6.14, and this flag will no longer exist"),
( "warn-unused-do-bind", Opt_WarnUnusedDoBind, const Supported ), ( "warn-unused-do-bind", Opt_WarnUnusedDoBind, const Supported ),
( "warn-wrong-do-bind", Opt_WarnWrongDoBind, const Supported ), ( "warn-wrong-do-bind", Opt_WarnWrongDoBind, const Supported ),
( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, const Supported ),
( "print-explicit-foralls", Opt_PrintExplicitForalls, const Supported ), ( "print-explicit-foralls", Opt_PrintExplicitForalls, const Supported ),
( "strictness", Opt_Strictness, const Supported ), ( "strictness", Opt_Strictness, const Supported ),
( "specialise", Opt_Specialise, const Supported ), ( "specialise", Opt_Specialise, const Supported ),
...@@ -1601,6 +1605,7 @@ xFlags = [ ...@@ -1601,6 +1605,7 @@ xFlags = [
( "MonoPatBinds", Opt_MonoPatBinds, const Supported ), ( "MonoPatBinds", Opt_MonoPatBinds, const Supported ),
( "ExplicitForAll", Opt_ExplicitForAll, const Supported ), ( "ExplicitForAll", Opt_ExplicitForAll, const Supported ),
( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, const Supported ), ( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, const Supported ),
( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, const Supported ),
( "MonoLocalBinds", Opt_MonoLocalBinds, const Supported ), ( "MonoLocalBinds", Opt_MonoLocalBinds, const Supported ),
( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ), ( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ),
( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ), ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ),
......
...@@ -1981,7 +1981,9 @@ alternativeLayoutRuleToken t ...@@ -1981,7 +1981,9 @@ alternativeLayoutRuleToken t
mExpectingOCurly <- getAlrExpectingOCurly mExpectingOCurly <- getAlrExpectingOCurly
justClosedExplicitLetBlock <- getJustClosedExplicitLetBlock justClosedExplicitLetBlock <- getJustClosedExplicitLetBlock
setJustClosedExplicitLetBlock False setJustClosedExplicitLetBlock False
let thisLoc = getLoc t dflags <- getDynFlags
let transitional = dopt Opt_AlternativeLayoutRuleTransitional dflags
thisLoc = getLoc t
thisCol = srcSpanStartCol thisLoc thisCol = srcSpanStartCol thisLoc
newLine = (lastLoc == noSrcSpan) newLine = (lastLoc == noSrcSpan)
|| (srcSpanStartLine thisLoc > srcSpanEndLine lastLoc) || (srcSpanStartLine thisLoc > srcSpanEndLine lastLoc)
...@@ -2040,6 +2042,18 @@ alternativeLayoutRuleToken t ...@@ -2040,6 +2042,18 @@ alternativeLayoutRuleToken t
do setPendingImplicitTokens [t] do setPendingImplicitTokens [t]
setALRContext ls setALRContext ls
return (L thisLoc ITccurly) 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, _) (_, ALRLayout _ col : ls, _)
| newLine && thisCol == col -> | newLine && thisCol == col ->
do setNextToken t do setNextToken t
...@@ -2090,6 +2104,11 @@ alternativeLayoutRuleToken t ...@@ -2090,6 +2104,11 @@ alternativeLayoutRuleToken t
-- the other ITwhere case omitted; general case below covers it -- the other ITwhere case omitted; general case below covers it
(_, _, _) -> return t (_, _, _) -> return t
transitionalAlternativeLayoutWarning :: String -> SDoc
transitionalAlternativeLayoutWarning msg
= text "transitional layout will not be accepted in the future:"
$$ text msg
isALRopen :: Token -> Bool isALRopen :: Token -> Bool
isALRopen ITcase = True isALRopen ITcase = True
isALRopen ITif = True isALRopen ITif = True
......
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