diff options
author | Ryan Scott <ryan.gl.scott@gmail.com> | 2019-04-03 12:37:10 -0400 |
---|---|---|
committer | Ben Gamari <ben@well-typed.com> | 2019-04-09 16:21:35 -0400 |
commit | 20f8f2f98bd686b297e7290b2348ac7e937c1a5a (patch) | |
tree | a7189e29e05b901202e43c2a4575f302316ca61f | |
parent | 86ce5718b18a31d85c8321a6c37b0b150e8f3c29 (diff) | |
download | haskell-20f8f2f98bd686b297e7290b2348ac7e937c1a5a.tar.gz |
Use funPrec, not topPrec, to parenthesize GADT argument types
A simple oversight. Fixes #16527.
-rw-r--r-- | compiler/iface/IfaceSyn.hs | 21 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/T16527.hs | 7 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/T16527.script | 2 | ||||
-rw-r--r-- | testsuite/tests/ghci/scripts/T16527.stdout | 4 | ||||
-rwxr-xr-x | testsuite/tests/ghci/scripts/all.T | 1 |
5 files changed, 27 insertions, 8 deletions
diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs index 5478c941c0..562d816938 100644 --- a/compiler/iface/IfaceSyn.hs +++ b/compiler/iface/IfaceSyn.hs @@ -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 index 0000000000..d33071155a --- /dev/null +++ b/testsuite/tests/ghci/scripts/T16527.hs @@ -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 index 0000000000..90c3f71f84 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T16527.script @@ -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 index 0000000000..fd4e0ef735 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T16527.stdout @@ -0,0 +1,4 @@ +data T where + MkT1 :: (Int -> Int) -> T + MkT2 :: (forall a. Maybe a) -> T + -- Defined at T16527.hs:5:1 diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 1394a9af56..9ece912e1f 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -295,3 +295,4 @@ test('T15941', normal, ghci_script, ['T15941.script']) test('T16030', normal, ghci_script, ['T16030.script']) test('T11606', normal, ghci_script, ['T11606.script']) test('T16089', normal, ghci_script, ['T16089.script']) +test('T16527', normal, ghci_script, ['T16527.script']) |