[commit: ghc] wip/T14289: Pretty-printing of derived multi-parameter classes omits parentheses (61c83ff)

git at git.haskell.org git at git.haskell.org
Mon Oct 2 13:36:02 UTC 2017 

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

On branch  : wip/T14289
Link       : http://ghc.haskell.org/trac/ghc/changeset/61c83ffaa3649b12dfe8e95aaee8959c20925fec/ghc

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

commit 61c83ffaa3649b12dfe8e95aaee8959c20925fec
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date:   Sun Oct 1 19:36:03 2017 +0200

    Pretty-printing of derived multi-parameter classes omits parentheses
    
    Summary:
    Pretty printing a splice with an HsAppType in the deriving clause, such as
    
        $([d| data Foo a = Foo a deriving (C a) |])
    
    would omit the parens.
    
    Test Plan: ./validate
    
    Reviewers: RyanGlScott, austin, bgamari
    
    Subscribers: rwbarton, thomie
    
    GHC Trac Issues: #14289
    
    Differential Revision: https://phabricator.haskell.org/D4056


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

61c83ffaa3649b12dfe8e95aaee8959c20925fec
 compiler/hsSyn/HsDecls.hs                   |  2 ++
 testsuite/tests/parser/should_compile/all.T |  1 +
 testsuite/tests/printer/Makefile            |  8 ++++++
 testsuite/tests/printer/T14289.hs           | 32 ++++++++++++++++++++++
 testsuite/tests/printer/T14289.stdout       | 16 +++++++++++
 testsuite/tests/printer/T14289b.hs          | 42 +++++++++++++++++++++++++++++
 testsuite/tests/printer/T14289b.stdout      |  1 +
 testsuite/tests/printer/all.T               |  2 ++
 8 files changed, 104 insertions(+)

diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs
index ecb11a0..9b21913 100644
--- a/compiler/hsSyn/HsDecls.hs
+++ b/compiler/hsSyn/HsDecls.hs
@@ -1102,7 +1102,9 @@ instance (SourceTextX pass, OutputableBndrId pass)
         -- This complexity is to distinguish between
         --    deriving Show
         --    deriving (Show)
+        pp_dct [a@(HsIB { hsib_body = L _ HsAppTy{}  })] = parens (ppr a)
         pp_dct [a@(HsIB { hsib_body = L _ HsAppsTy{} })] = parens (ppr a)
+        pp_dct [a@(HsIB { hsib_body = L _ HsOpTy{}   })] = parens (ppr a)
         pp_dct [a] = ppr a
         pp_dct _   = parens (interpp'SP dct)
 
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index c008bd4..48e2b80 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -109,3 +109,4 @@ test('DumpRenamedAst',     normal, compile, ['-dsuppress-uniques -ddump-rn-ast']
 test('DumpTypecheckedAst', normal, compile, ['-dsuppress-uniques -ddump-tc-ast'])
 test('T13747', normal, compile, [''])
 test('T14189',     normal, compile, ['-dsuppress-uniques -ddump-rn-ast'])
+test('T14189tc',   normal, compile, ['-dsuppress-uniques -ddump-tc-ast'])
diff --git a/testsuite/tests/printer/Makefile b/testsuite/tests/printer/Makefile
index 1c2f299..36aa050 100644
--- a/testsuite/tests/printer/Makefile
+++ b/testsuite/tests/printer/Makefile
@@ -213,3 +213,11 @@ T13550:
 .PHONY: T13942
 T13942:
 	$(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T13942.hs
+
+.PHONY: T14289
+T14289:
+	$(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T14289.hs
+
+.PHONY: T14289b
+T14289b:
+	$(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T14289b.hs
diff --git a/testsuite/tests/printer/T14289.hs b/testsuite/tests/printer/T14289.hs
new file mode 100644
index 0000000..04b9176
--- /dev/null
+++ b/testsuite/tests/printer/T14289.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}
+
+import Language.Haskell.TH
+
+class C a b
+
+$([d| data Foo a = Foo a deriving (C a) |])
+
+{-
+
+Note: to debug
+
+~/inplace/bin/ghc-stage2 --interactive
+load the following
+----------------------------------------
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}
+
+import Language.Haskell.TH
+
+class C a b
+
+main :: IO ()
+main = putStrLn $([d| data Foo a = Foo a deriving (C a) |] >>= stringE . show)
+
+----------------------------------------
+
+-}
diff --git a/testsuite/tests/printer/T14289.stdout b/testsuite/tests/printer/T14289.stdout
new file mode 100644
index 0000000..3f0754a
--- /dev/null
+++ b/testsuite/tests/printer/T14289.stdout
@@ -0,0 +1,16 @@
+T14289.hs:10:3-42: Splicing declarations
+    [d| data Foo a
+          = Foo a
+          deriving (C a) |]
+  ======>
+    data Foo a
+      = Foo a
+      deriving (C a)
+T14289.ppr.hs:(7,3)-(9,25): Splicing declarations
+    [d| data Foo a
+          = Foo a
+          deriving (C a) |]
+  ======>
+    data Foo a
+      = Foo a
+      deriving (C a)
diff --git a/testsuite/tests/printer/T14289b.hs b/testsuite/tests/printer/T14289b.hs
new file mode 100644
index 0000000..3ff3980
--- /dev/null
+++ b/testsuite/tests/printer/T14289b.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeOperators #-}
+{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}
+
+import Language.Haskell.TH
+
+class (a `C` b) c
+
+$([d| data Foo a = Foo a deriving (y `C` z) |])
+
+{-
+
+Note: to debug
+
+~/inplace/bin/ghc-stage2 --interactive
+load the following
+----------------------------------------
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}
+
+import Language.Haskell.TH
+
+class (a `C` b) c
+
+main :: IO ()
+main
+  = putStrLn $([d| data Foo a = Foo a deriving (y `C` z) |] >>= stringE . show)
+
+----------------------------------------
+Bceomes
+
+
+[DataD [] Foo_0 [PlainTV a_2] Nothing
+  [NormalC Foo_1 [(Bang NoSourceUnpackedness NoSourceStrictness,VarT a_2)]]
+  [DerivClause Nothing
+      [AppT (AppT (ConT Main.C) (VarT y_6989586621679027885))
+            (VarT z_6989586621679027886)]]]
+
+-}
diff --git a/testsuite/tests/printer/T14289b.stdout b/testsuite/tests/printer/T14289b.stdout
new file mode 100644
index 0000000..9f26b63
--- /dev/null
+++ b/testsuite/tests/printer/T14289b.stdout
@@ -0,0 +1 @@
+Foo
\ No newline at end of file
diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T
index a71d6e3..43ab92b 100644
--- a/testsuite/tests/printer/all.T
+++ b/testsuite/tests/printer/all.T
@@ -50,3 +50,5 @@ test('T13199', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T1319
 test('T13050p', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T13050p'])
 test('T13550', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T13550'])
 test('T13942', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T13942'])
+test('T14289', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T14289'])
+test('T14289b', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T14289b'])

More information about the ghc-commits mailing list