Commit e9f9ec1e authored by Ian Lynagh's avatar Ian Lynagh

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