Commit 984b75de authored by Ryan Scott's avatar Ryan Scott

Fix #15941 by only special-casing visible infix applications

Summary:
The iface pretty-printer had a special case for an
application of an infix type constructor to two arguments. But this
didn't take the visibilities of the arguments into account, which
could lead to strange output like `@{LiftedRep} -> @{LiftedRep}` when
`-fprint-explicit-kinds` was enabled (#15941). The fix is relatively
straightforward: simply plumb through the visibilities of each
argument, and only trigger the special case for infix applications
if both arguments are visible (i.e., required).

Test Plan: make test TEST=T15941

Reviewers: goldfire, bgamari, monoidal

Reviewed By: goldfire, monoidal

Subscribers: simonpj, rwbarton, carter

GHC Trac Issues: #15941

Differential Revision: https://phabricator.haskell.org/D5375
parent 8f9f52d8
......@@ -8,6 +8,7 @@ This module defines interface types and binders
{-# LANGUAGE CPP, FlexibleInstances, BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TupleSections #-}
-- FlexibleInstances for Binary (DefMethSpec IfaceType)
module IfaceType (
......@@ -1334,9 +1335,23 @@ ppr_equality ctxt_prec tc args
pprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprIfaceCoTcApp ctxt_prec tc tys = ppr_iface_tc_app ppr_co ctxt_prec tc tys
ppr_iface_tc_app :: (PprPrec -> a -> SDoc) -> PprPrec -> IfaceTyCon -> [a] -> SDoc
pprIfaceCoTcApp ctxt_prec tc tys =
ppr_iface_tc_app (\prec (co, _) -> ppr_co prec co) ctxt_prec tc
(map (, Required) tys)
-- We are trying to re-use ppr_iface_tc_app here, which requires its
-- arguments to be accompanied by visibilities. But visibility is
-- irrelevant when printing coercions, so just default everything to
-- Required.
-- | Pretty-prints an application of a type constructor to some arguments
-- (whose visibilities are known). This is polymorphic (over @a@) since we use
-- this function to pretty-print two different things:
--
-- 1. Types (from `pprTyTcApp'`)
--
-- 2. Coercions (from 'pprIfaceCoTcApp')
ppr_iface_tc_app :: (PprPrec -> (a, ArgFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc
ppr_iface_tc_app pp _ tc [ty]
| tc `ifaceTyConHasKey` listTyConKey = pprPromotionQuote tc <> brackets (pp topPrec ty)
......@@ -1347,8 +1362,11 @@ ppr_iface_tc_app pp ctxt_prec tc tys
| not (isSymOcc (nameOccName (ifaceTyConName tc)))
= pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp appPrec) tys)
| [ty1,ty2] <- tys -- Infix, two arguments;
-- we know nothing of precedence though
| [ ty1@(_, Required)
, ty2@(_, Required) ] <- tys
-- Infix, two visible arguments (we know nothing of precedence though).
-- Don't apply this special case if one of the arguments is invisible,
-- lest we print something like (@LiftedRep -> @LiftedRep) (#15941).
= pprIfaceInfixApp ctxt_prec (ppr tc)
(pp opPrec ty1) (pp opPrec ty2)
......
:set -XKindSignatures -fprint-explicit-runtime-reps -fprint-explicit-kinds
type T = (->)
:info T
type T =
(->) @{'GHC.Types.LiftedRep} @{'GHC.Types.LiftedRep} :: * -> * -> *
-- Defined at <interactive>:2:1
......@@ -290,3 +290,4 @@ test('T15591', normal, ghci_script, ['T15591.script'])
test('T15743b', normal, ghci_script, ['T15743b.script'])
test('T15827', normal, ghci_script, ['T15827.script'])
test('T15898', normal, ghci_script, ['T15898.script'])
test('T15941', normal, ghci_script, ['T15941.script'])
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment