[commit: ghc] master: Parenthesize (() :: Constraint) in argument position (99c556d)

git at git.haskell.org git at git.haskell.org
Sat Mar 3 18:52:01 UTC 2018


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/99c556d2bb0594fd718622906168d2ea25a0bf06/ghc

>---------------------------------------------------------------

commit 99c556d2bb0594fd718622906168d2ea25a0bf06
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Sat Mar 3 13:48:38 2018 -0500

    Parenthesize (() :: Constraint) in argument position
    
    Summary:
    A simple oversight in the pretty-printer lead to a special
    case for `() :: Constraint` not being parenthesized correctly when
    used in an argument position. Easily fixed with a `maybeParen`.
    
    Test Plan: make test TEST=T14796
    
    Reviewers: alanz, goldfire, bgamari, simonpj
    
    Reviewed By: bgamari, simonpj
    
    Subscribers: simonpj, rwbarton, thomie, carter
    
    GHC Trac Issues: #14796
    
    Differential Revision: https://phabricator.haskell.org/D4408


>---------------------------------------------------------------

99c556d2bb0594fd718622906168d2ea25a0bf06
 compiler/iface/IfaceType.hs                | 15 ++++++++-------
 testsuite/tests/ghci/scripts/T14796.script |  3 +++
 testsuite/tests/ghci/scripts/T14796.stdout |  1 +
 testsuite/tests/ghci/scripts/all.T         |  1 +
 4 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs
index 62b33cd..0c5922e 100644
--- a/compiler/iface/IfaceType.hs
+++ b/compiler/iface/IfaceType.hs
@@ -595,7 +595,7 @@ ppr_ty :: TyPrec -> IfaceType -> SDoc
 ppr_ty _         (IfaceFreeTyVar tyvar) = ppr tyvar  -- This is the main reson for IfaceFreeTyVar!
 ppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar  -- See Note [TcTyVars in IfaceType]
 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = pprTyTcApp ctxt_prec tc tys
-ppr_ty _         (IfaceTupleTy i p tys) = pprTuple i p tys
+ppr_ty ctxt_prec (IfaceTupleTy i p tys) = pprTuple ctxt_prec i p tys
 ppr_ty _         (IfaceLitTy n)         = pprIfaceTyLit n
         -- Function types
 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
@@ -889,7 +889,7 @@ pprTyTcApp' ctxt_prec tc tys dflags style
   | IfaceTupleTyCon arity sort <- ifaceTyConSort info
   , not (debugStyle style)
   , arity == ifaceVisTcArgsLength tys
-  = pprTuple sort (ifaceTyConIsPromoted info) tys
+  = pprTuple ctxt_prec sort (ifaceTyConIsPromoted info) tys
 
   | IfaceSumTyCon arity <- ifaceTyConSort info
   = pprSum arity (ifaceTyConIsPromoted info) tys
@@ -1017,18 +1017,19 @@ pprSum _arity is_promoted args
     in pprPromotionQuoteI is_promoted
        <> sumParens (pprWithBars (ppr_ty TopPrec) args')
 
-pprTuple :: TupleSort -> IsPromoted -> IfaceTcArgs -> SDoc
-pprTuple ConstraintTuple IsNotPromoted ITC_Nil
-  = text "() :: Constraint"
+pprTuple :: TyPrec -> TupleSort -> IsPromoted -> IfaceTcArgs -> SDoc
+pprTuple ctxt_prec ConstraintTuple IsNotPromoted ITC_Nil
+  = maybeParen ctxt_prec TyConPrec $
+    text "() :: Constraint"
 
 -- All promoted constructors have kind arguments
-pprTuple sort IsPromoted args
+pprTuple _ sort IsPromoted args
   = let tys = tcArgsIfaceTypes args
         args' = drop (length tys `div` 2) tys
     in pprPromotionQuoteI IsPromoted <>
        tupleParens sort (pprWithCommas pprIfaceType args')
 
-pprTuple sort promoted args
+pprTuple _ sort promoted args
   =   -- drop the RuntimeRep vars.
       -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
     let tys   = tcArgsIfaceTypes args
diff --git a/testsuite/tests/ghci/scripts/T14796.script b/testsuite/tests/ghci/scripts/T14796.script
new file mode 100644
index 0000000..9a85d44
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T14796.script
@@ -0,0 +1,3 @@
+:set -XGADTs -XConstraintKinds -XTypeApplications
+data ECC ctx f a where ECC :: ctx => f a -> ECC ctx f a
+:t ECC @() @[] @()
diff --git a/testsuite/tests/ghci/scripts/T14796.stdout b/testsuite/tests/ghci/scripts/T14796.stdout
new file mode 100644
index 0000000..c8bb219
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T14796.stdout
@@ -0,0 +1 @@
+ECC @() @[] @() :: [()] -> ECC (() :: Constraint) [] ()
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 997203f..dcce723 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -264,3 +264,4 @@ test('T13963', normal, ghci_script, ['T13963.script'])
 test('T14342', [extra_hc_opts("-XOverloadedStrings -XRebindableSyntax")],
                ghci_script, ['T14342.script'])
 test('T14676', extra_files(['../prog002']), ghci_script, ['T14676.script'])
+test('T14796', normal, ghci_script, ['T14796.script'])



More information about the ghc-commits mailing list