[Git][ghc/ghc][master] Fix a typo in Lint

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
bfa5698b by Simon Peyton Jones at 2020-06-28T09:21:32-04:00
Fix a typo in Lint

This simple error in GHC.Core.Litn.lintJoinLams meant that
Lint reported bogus errors.

Fixes #18399

- - - - -


3 changed files:

- compiler/GHC/Core/Lint.hs
- + testsuite/tests/simplCore/should_compile/T18399.hs
- testsuite/tests/simplCore/should_compile/all.T


Changes:

=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -727,15 +727,15 @@ lintJoinLams :: JoinArity -> Maybe Id -> CoreExpr -> LintM (LintedType, UsageEnv
 lintJoinLams join_arity enforce rhs
   = go join_arity rhs
   where
-    go 0 rhs             = lintCoreExpr rhs
-    go n (Lam var expr)  = lintLambda var $ go (n-1) expr
+    go 0 expr            = lintCoreExpr expr
+    go n (Lam var body)  = lintLambda var $ go (n-1) body
       -- N.B. join points can be cast. e.g. we consider ((\x -> ...) `cast` ...)
       -- to be a join point at join arity 1.
-    go n _other | Just bndr <- enforce -- Join point with too few RHS lambdas
-                = failWithL $ mkBadJoinArityMsg bndr join_arity n rhs
-                | otherwise -- Future join point, not yet eta-expanded
-                = markAllJoinsBad $ lintCoreExpr rhs
-                  -- Body of lambda is not a tail position
+    go n expr | Just bndr <- enforce -- Join point with too few RHS lambdas
+              = failWithL $ mkBadJoinArityMsg bndr join_arity n rhs
+              | otherwise -- Future join point, not yet eta-expanded
+              = markAllJoinsBad $ lintCoreExpr expr
+                -- Body of lambda is not a tail position
 
 lintIdUnfolding :: Id -> Type -> Unfolding -> LintM ()
 lintIdUnfolding bndr bndr_ty uf


=====================================
testsuite/tests/simplCore/should_compile/T18399.hs
=====================================
@@ -0,0 +1,5 @@
+module Bug where
+
+f :: p b d -> (a -> b) -> (c -> d) -> p a c -> p b d
+{-# INLINE f #-}
+f = const . const . const


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -329,3 +329,4 @@ test('T18231', [ only_ways(['optasm']), grep_errmsg(r'^[\w\.]+ ::.*->.*') ], com
 test('T17673', [ only_ways(['optasm']), grep_errmsg(r'^\w+\.\$wf') ], compile, ['-ddump-simpl -dsuppress-uniques -dppr-cols=9999'])
 test('T18078', [ only_ways(['optasm']), grep_errmsg(r'^\w+\.\$wf') ], compile, ['-ddump-simpl -dsuppress-uniques -dppr-cols=9999'])
 test('T18347', normal, compile, ['-dcore-lint -O'])
+test('T18399', normal, compile, ['-dcore-lint -O'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bfa5698b1ab0190820a2df19487d3d72d3a7924d

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bfa5698b1ab0190820a2df19487d3d72d3a7924d
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200628/e283150f/attachment-0001.html>