diff options
author | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2020-09-28 13:48:18 +0300 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-09-29 00:32:05 -0400 |
commit | bca4d36dd835c1c31c8f3364113586e1aedc6787 (patch) | |
tree | 6c6d5256bc07011e9f4d3b44e1d3dd641fb6d6b3 /compiler/GHC/Parser.y | |
parent | 5830a12c46e7227c276a8a71213057595ee4fc04 (diff) | |
download | haskell-bca4d36dd835c1c31c8f3364113586e1aedc6787.tar.gz |
Improve error messages for (a %m) without LinearTypes
Detect when the user forgets to enable the LinearTypes
extension and produce a better error message.
Steals the (a %m) syntax from TypeOperators, the workaround
is to write (a % m) instead.
Diffstat (limited to 'compiler/GHC/Parser.y')
-rw-r--r-- | compiler/GHC/Parser.y | 21 |
1 files changed, 18 insertions, 3 deletions
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index 12f5b8be3b..abfcc6fbff 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -68,7 +68,8 @@ import GHC.Prelude -- compiler/basicTypes import GHC.Types.Name.Reader -import GHC.Types.Name.Occurrence ( varName, dataName, tcClsName, tvName, startsWithUnderscore ) +import GHC.Types.Name.Occurrence ( varName, dataName, tcClsName, tvName, + occNameFS, startsWithUnderscore ) import GHC.Core.DataCon ( DataCon, dataConName ) import GHC.Types.SrcLoc import GHC.Unit.Module @@ -2082,7 +2083,8 @@ infixtype :: { forall b. DisambTD b => PV (Located b) } : ftype %shift { $1 } | ftype tyop infixtype { $1 >>= \ $1 -> $3 >>= \ $3 -> - mkHsOpTyPV $1 $2 $3 } + do { when (looksLikeMult $1 $2 $3) $ hintLinear (getLoc $2) + ; mkHsOpTyPV $1 $2 $3 } } | unpackedness infixtype { $2 >>= \ $2 -> mkUnpackednessPV $1 $2 } @@ -3923,12 +3925,25 @@ fileSrcSpan = do return (mkSrcSpan loc loc) -- Hint about linear types -hintLinear :: SrcSpan -> P () +hintLinear :: MonadP m => SrcSpan -> m () hintLinear span = do linearEnabled <- getBit LinearTypesBit unless linearEnabled $ addError span $ text "Enable LinearTypes to allow linear functions" +-- Does this look like (a %m)? +looksLikeMult :: LHsType GhcPs -> Located RdrName -> LHsType GhcPs -> Bool +looksLikeMult ty1 l_op ty2 + | Unqual op_name <- unLoc l_op + , occNameFS op_name == fsLit "%" + , Just ty1_pos <- getBufSpan (getLoc ty1) + , Just pct_pos <- getBufSpan (getLoc l_op) + , Just ty2_pos <- getBufSpan (getLoc ty2) + , bufSpanEnd ty1_pos /= bufSpanStart pct_pos + , bufSpanEnd pct_pos == bufSpanStart ty2_pos + = True + | otherwise = False + -- Hint about the MultiWayIf extension hintMultiWayIf :: SrcSpan -> P () hintMultiWayIf span = do |