[Git][ghc/ghc][master] Fix visibility when eta-reducing a type lambda

[Marge Bot (@marge-bot)]

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


Commits:
b8ebf876 by Matthew Craven at 2023-09-28T03:27:05-04:00
Fix visibility when eta-reducing a type lambda

Fixes #24014.

- - - - -


3 changed files:

- compiler/GHC/Core/Opt/Arity.hs
- + testsuite/tests/simplCore/should_compile/T24014.hs
- testsuite/tests/simplCore/should_compile/all.T


Changes:

=====================================
compiler/GHC/Core/Opt/Arity.hs
=====================================
@@ -2743,7 +2743,12 @@ tryEtaReduce rec_ids bndrs body eval_sd
     ok_arg bndr (Type arg_ty) co fun_ty
        | Just tv <- getTyVar_maybe arg_ty
        , bndr == tv  = case splitForAllForAllTyBinder_maybe fun_ty of
-           Just (Bndr _ vis, _) -> Just (mkHomoForAllCos [Bndr tv vis] co, [])
+           Just (Bndr _ vis, _) -> Just (fco, [])
+             where !fco = mkForAllCo tv vis coreTyLamForAllTyFlag kco co
+                   -- The lambda we are eta-reducing always has visibility
+                   -- 'coreTyLamForAllTyFlag' which may or may not match
+                   -- the visibility on the inner function (#24014)
+                   kco = mkNomReflCo (tyVarKind tv)
            Nothing -> pprPanic "tryEtaReduce: type arg to non-forall type"
                                (text "fun:" <+> ppr bndr
                                 $$ text "arg:" <+> ppr arg_ty


=====================================
testsuite/tests/simplCore/should_compile/T24014.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE ExplicitNamespaces, ScopedTypeVariables, RequiredTypeArguments #-}
+module T24014 where
+
+visId :: forall a -> a -> a
+visId (type a) x = x
+
+f :: forall a -> a -> a
+f (type x) = visId (type x)
+
+g :: forall a. a -> a
+g = visId (type a)


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -501,3 +501,4 @@ test('T23864', normal, compile, ['-O -dcore-lint -package ghc -Wno-gadt-mono-loc
 test('T23938', [extra_files(['T23938A.hs'])], multimod_compile, ['T23938', '-O -v0'])
 test('T23922a', normal, compile, ['-O'])
 test('T23952', [extra_files(['T23952a.hs'])], multimod_compile, ['T23952', '-v0 -O'])
+test('T24014', normal, compile, ['-dcore-lint'])



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b8ebf876d34e240413988d990e9208a12f9ca089
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/20230928/d8108033/attachment-0001.html>