Use funPrec, not topPrec, to parenthesize GADT argument types
authorRyan Scott <ryan.gl.scott@gmail.com>
Wed, 3 Apr 2019 16:37:10 +0000 (12:37 -0400)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Thu, 4 Apr 2019 08:35:39 +0000 (04:35 -0400)
A simple oversight. Fixes #16527.

compiler/iface/IfaceSyn.hs
testsuite/tests/ghci/scripts/T16527.hs [new file with mode: 0644]
testsuite/tests/ghci/scripts/T16527.script [new file with mode: 0644]
testsuite/tests/ghci/scripts/T16527.stdout [new file with mode: 0644]
testsuite/tests/ghci/scripts/all.T

index 8ffa337..f284ae9 100644 (file)
@@ -1034,7 +1034,7 @@ pprIfaceConDecl ss gadt_style tycon tc_binders parent
     -- a compound field type is if it's preceded by a bang pattern.
     pprFieldArgTy (bang, ty) = ppr_arg_ty (bang_prec bang) bang ty
     -- If not using record syntax, a compound field type might need to be
-    -- parenthesize if one of the following holds:
+    -- parenthesized if one of the following holds:
     --
     -- 1. We're using Haskell98 syntax.
     -- 2. The field type is preceded with a bang pattern.
@@ -1046,18 +1046,23 @@ pprIfaceConDecl ss gadt_style tycon tc_binders parent
     -- If we're displaying the fields GADT-style, e.g.,
     --
     --   data Foo a where
-    --     MkFoo :: Maybe a -> Foo
+    --     MkFoo :: (Int -> Int) -> Maybe a -> Foo
     --
-    -- Then there is no inherent need to parenthesize compound fields like
-    -- `Maybe a` (bang patterns notwithstanding). If we're displaying the
-    -- fields Haskell98-style, e.g.,
+    -- Then we use `funPrec`, since that will ensure `Int -> Int` gets the
+    -- parentheses that it requires, but simple compound types like `Maybe a`
+    -- (which don't require parentheses in a function argument position) won't
+    -- get them, assuming that there are no bang patterns (see bang_prec).
     --
-    --   data Foo a = MkFoo (Maybe a)
+    -- If we're displaying the fields Haskell98-style, e.g.,
     --
-    -- Then we *must* parenthesize compound fields like (Maybe a).
+    --   data Foo a = MkFoo (Int -> Int) (Maybe a)
+    --
+    -- Then not only must we parenthesize `Int -> Int`, we must also
+    -- parenthesize compound fields like (Maybe a). Therefore, we pick
+    -- `appPrec`, which has higher precedence than `funPrec`.
     gadt_prec :: PprPrec
     gadt_prec
-      | gadt_style = topPrec
+      | gadt_style = funPrec
       | otherwise  = appPrec
 
     -- The presence of bang patterns or UNPACK annotations requires
diff --git a/testsuite/tests/ghci/scripts/T16527.hs b/testsuite/tests/ghci/scripts/T16527.hs
new file mode 100644 (file)
index 0000000..d330711
--- /dev/null
@@ -0,0 +1,7 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+module T16527 where
+
+data T where
+  MkT1 :: (Int -> Int) -> T
+  MkT2 :: (forall a. Maybe a) -> T
diff --git a/testsuite/tests/ghci/scripts/T16527.script b/testsuite/tests/ghci/scripts/T16527.script
new file mode 100644 (file)
index 0000000..90c3f71
--- /dev/null
@@ -0,0 +1,2 @@
+:load T16527
+:info T
diff --git a/testsuite/tests/ghci/scripts/T16527.stdout b/testsuite/tests/ghci/scripts/T16527.stdout
new file mode 100644 (file)
index 0000000..fd4e0ef
--- /dev/null
@@ -0,0 +1,4 @@
+data T where
+  MkT1 :: (Int -> Int) -> T
+  MkT2 :: (forall a. Maybe a) -> T
+       -- Defined at T16527.hs:5:1
index 115dfc5..eb0a3a5 100755 (executable)
@@ -294,3 +294,4 @@ test('T11606', normal, ghci_script, ['T11606.script'])
 test('T16089', normal, ghci_script, ['T16089.script'])
 test('T14828', normal, ghci_script, ['T14828.script'])
 test('T16376', normal, ghci_script, ['T16376.script'])
+test('T16527', normal, ghci_script, ['T16527.script'])