diff options
author | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2020-08-04 20:27:06 +0300 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-08-06 13:34:06 -0400 |
commit | 0ddb43848b9fc24f5404915f57dc504546e68292 (patch) | |
tree | c97286389bd66c683304c483d3a99f081eb216d7 | |
parent | 826d07db0e0f31fe2b2d2e0661be7f0cb3cde3c7 (diff) | |
download | haskell-0ddb43848b9fc24f5404915f57dc504546e68292.tar.gz |
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
-rw-r--r-- | compiler/GHC/Iface/Type.hs | 26 | ||||
-rw-r--r-- | testsuite/tests/polykinds/T18522-ppr.script | 4 | ||||
-rw-r--r-- | testsuite/tests/polykinds/T18522-ppr.stdout | 1 | ||||
-rw-r--r-- | testsuite/tests/polykinds/all.T | 1 |
4 files changed, 30 insertions, 2 deletions
diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs index 28a628344f..2a152074f0 100644 --- a/compiler/GHC/Iface/Type.hs +++ b/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 diff --git a/testsuite/tests/polykinds/T18522-ppr.script b/testsuite/tests/polykinds/T18522-ppr.script new file mode 100644 index 0000000000..54d3619c6e --- /dev/null +++ b/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 diff --git a/testsuite/tests/polykinds/T18522-ppr.stdout b/testsuite/tests/polykinds/T18522-ppr.stdout new file mode 100644 index 0000000000..241530bbed --- /dev/null +++ b/testsuite/tests/polykinds/T18522-ppr.stdout @@ -0,0 +1 @@ +T :: forall k -> (k ~ k) => forall j -> k -> j -> * diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 436bb9dbce..68bf260e64 100644 --- a/testsuite/tests/polykinds/all.T +++ b/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']) |