[Git][ghc/ghc][wip/t18522-b] Fix visible forall in ppr_ty (#18522)

[Vladislav Zavialov]

Vladislav Zavialov pushed to branch wip/t18522-b at Glasgow Haskell Compiler / GHC


Commits:
fdd1d02b by Vladislav Zavialov at 2020-08-04T22:34:42+03:00
Fix visible forall in ppr_ty (#18522)

Before this patch, this type:
  T :: forall k -> (k ~ k) => forall j -> k -> j -> Type
was printed incorrectly as:
  T :: forall k j -> (k ~ k) => k -> j -> Type

- - - - -


4 changed files:

- compiler/GHC/Iface/Type.hs
- + testsuite/tests/polykinds/T18522-ppr.script
- + testsuite/tests/polykinds/T18522-ppr.stdout
- testsuite/tests/polykinds/all.T


Changes:

=====================================
compiler/GHC/Iface/Type.hs
=====================================
@@ -441,6 +441,7 @@ splitIfaceSigmaTy ty
     (theta, tau)   = split_rho rho
 
     split_foralls (IfaceForAllTy bndr ty)
+        | isInvisibleArgFlag (binderArgFlag bndr)
         = case split_foralls ty of { (bndrs, rho) -> (bndr:bndrs, rho) }
     split_foralls rho = ([], rho)
 
@@ -448,6 +449,12 @@ splitIfaceSigmaTy ty
         = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }
     split_rho tau = ([], tau)
 
+splitIfaceReqForallTy :: IfaceType -> ([IfaceForAllBndr], IfaceType)
+splitIfaceReqForallTy (IfaceForAllTy bndr ty)
+  | isVisibleArgFlag (binderArgFlag bndr)
+  = case splitIfaceReqForallTy ty of { (bndrs, rho) -> (bndr:bndrs, rho) }
+splitIfaceReqForallTy rho = ([], rho)
+
 suppressIfaceInvisibles :: PrintExplicitKinds -> [IfaceTyConBinder] -> [a] -> [a]
 suppressIfaceInvisibles (PrintExplicitKinds True) _tys xs = xs
 suppressIfaceInvisibles (PrintExplicitKinds False) tys xs = suppress tys xs
@@ -1184,8 +1191,23 @@ pprIfaceSigmaType show_forall ty
   = hideNonStandardTypes ppr_fn ty
   where
     ppr_fn iface_ty =
-      let (tvs, theta, tau) = splitIfaceSigmaTy iface_ty
-       in ppr_iface_forall_part show_forall tvs theta (ppr tau)
+      let (invis_tvs, theta, tau) = splitIfaceSigmaTy iface_ty
+          (req_tvs, tau') = splitIfaceReqForallTy tau
+          -- splitIfaceSigmaTy is recursive, so it will gather the binders after
+          -- the theta, i.e.  forall a. theta => forall b. tau
+          -- will give you    ([a,b], theta, tau).
+          --
+          -- This isn't right when it comes to visible forall (see
+          --  testsuite/tests/polykinds/T18522-ppr),
+          -- so we split off required binders separately,
+          -- using splitIfaceReqForallTy.
+          --
+          -- An alternative solution would be to make splitIfaceSigmaTy
+          -- non-recursive (see #18458).
+          -- Then it could handle both invisible and required binders, and
+          -- splitIfaceReqForallTy wouldn't be necessary here.
+       in ppr_iface_forall_part show_forall invis_tvs theta $
+          sep [pprIfaceForAll req_tvs, ppr tau']
 
 pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
 pprUserIfaceForAll tvs


=====================================
testsuite/tests/polykinds/T18522-ppr.script
=====================================
@@ -0,0 +1,4 @@
+:set -XPolyKinds -XDataKinds -XRankNTypes -XTypeFamilies
+import Data.Kind (Type)
+type family T :: forall k -> (k ~ k) => forall j -> k -> j -> Type
+:k T


=====================================
testsuite/tests/polykinds/T18522-ppr.stdout
=====================================
@@ -0,0 +1 @@
+T :: forall k -> (k ~ k) => forall j -> k -> j -> *


=====================================
testsuite/tests/polykinds/all.T
=====================================
@@ -223,3 +223,4 @@ test('T18300', normal, compile_fail, [''])
 test('T18451', normal, compile_fail, [''])
 test('T18451a', normal, compile_fail, [''])
 test('T18451b', normal, compile_fail, [''])
+test('T18522-ppr', normal, ghci_script, ['T18522-ppr.script'])



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fdd1d02bf3a5a2a2e80b9717957883d561a5bdd9
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/20200804/40075eb3/attachment-0001.html>