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 | |
| 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.
| -rw-r--r-- | compiler/GHC/Parser.y | 21 | ||||
| -rw-r--r-- | testsuite/tests/linear/should_fail/LinearNoExt.stderr | 9 |
2 files changed, 19 insertions, 11 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 diff --git a/testsuite/tests/linear/should_fail/LinearNoExt.stderr b/testsuite/tests/linear/should_fail/LinearNoExt.stderr index 9277e29ea5..e4afbd1048 100644 --- a/testsuite/tests/linear/should_fail/LinearNoExt.stderr +++ b/testsuite/tests/linear/should_fail/LinearNoExt.stderr @@ -1,10 +1,3 @@ LinearNoExt.hs:3:14: error: - Not in scope: type constructor or class ‘%’ - -LinearNoExt.hs:3:14: error: - Illegal operator ‘%’ in type ‘a % 1’ - Use TypeOperators to allow operators in types - -LinearNoExt.hs:3:15: error: - Illegal type: ‘1’ Perhaps you intended to use DataKinds + Enable LinearTypes to allow linear functions |