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
| Opt_WarnLazyUnliftedBindings
| Opt_WarnUnusedDoBind
| Opt_WarnWrongDoBind
| Opt_WarnAlternativeLayoutRuleTransitional
-- language opts
......@@ -252,6 +253,7 @@ data DynFlag
| Opt_NewQualifiedOperators
| Opt_ExplicitForAll
| Opt_AlternativeLayoutRule
| Opt_AlternativeLayoutRuleTransitional
| Opt_PrintExplicitForalls
......@@ -930,7 +932,8 @@ standardWarnings
Opt_WarnDuplicateExports,
Opt_WarnLazyUnliftedBindings,
Opt_WarnDodgyForeignImports,
Opt_WarnWrongDoBind
Opt_WarnWrongDoBind,
Opt_WarnAlternativeLayoutRuleTransitional
]
minusWOpts :: [DynFlag]
......@@ -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"),
( "warn-unused-do-bind", Opt_WarnUnusedDoBind, 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 ),
( "strictness", Opt_Strictness, const Supported ),
( "specialise", Opt_Specialise, const Supported ),
......@@ -1601,6 +1605,7 @@ xFlags = [
( "MonoPatBinds", Opt_MonoPatBinds, const Supported ),
( "ExplicitForAll", Opt_ExplicitForAll, const Supported ),
( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, const Supported ),
( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, const Supported ),
( "MonoLocalBinds", Opt_MonoLocalBinds, const Supported ),
( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ),
( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ),
......
......@@ -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
......
Markdown is supported
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