Pretty-printer no longer butchers function arrow fixity
authorAlan Zimmerman <alan.zimm@gmail.com>
Mon, 10 Jul 2017 11:00:36 +0000 (13:00 +0200)
committerAlan Zimmerman <alan.zimm@gmail.com>
Mon, 10 Jul 2017 11:03:45 +0000 (13:03 +0200)
It now correctly prints the parens around '(Int -> Int)' in

    {-# LANGUAGE TemplateHaskell #-}
    {-# OPTIONS_GHC -ddump-splices #-}
    module Bug where

    $([d| f :: Either Int (Int -> Int)
          f = undefined
        |])

Closes #13942

compiler/hsSyn/Convert.hs
testsuite/tests/printer/Makefile
testsuite/tests/printer/T13942.hs [new file with mode: 0644]
testsuite/tests/printer/T13942.stdout [new file with mode: 0644]
testsuite/tests/printer/all.T

index 8b7af27..8fc903b 100644 (file)
@@ -1330,6 +1330,7 @@ mk_apps head_ty (ty:tys) =
      ; mk_apps (HsAppTy head_ty' p_ty) tys }
   where
     add_parens t@(L _ HsAppTy{}) = returnL (HsParTy t)
+    add_parens t@(L _ HsFunTy{}) = returnL (HsParTy t)
     add_parens t                 = return t
 
 wrap_apps  :: LHsType GhcPs -> CvtM (LHsType GhcPs)
index 9cb968f..1c2f299 100644 (file)
@@ -209,3 +209,7 @@ T13050p:
 .PHONY: T13550
 T13550:
        $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T13550.hs
+
+.PHONY: T13942
+T13942:
+       $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T13942.hs
diff --git a/testsuite/tests/printer/T13942.hs b/testsuite/tests/printer/T13942.hs
new file mode 100644 (file)
index 0000000..8899e1c
--- /dev/null
@@ -0,0 +1,36 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}
+module T13942 where
+
+$([d| f :: Either Int (Int -> Int)
+      f = undefined
+    |])
+
+{-
+
+Note: to debug
+
+~/inplace/bin/ghc-stage2 --interactive
+load the following
+--------------------------------------
+import Language.Haskell.TH
+
+foo :: IO ()
+foo = do
+  r <- runQ ([d| f :: Either Int (Int -> Int)
+                 f = undefined
+             |])
+  print r
+
+----------------------------------------
+foo
+[SigD f_0 (AppT (AppT (ConT Data.Either.Either) (ConT GHC.Types.Int)) (AppT (AppT ArrowT (ConT GHC.Types.Int)) (ConT GHC.Types.Int)))
+,ValD (VarP f_0) (NormalB (VarE GHC.Err.undefined)) []]
+
+[SigD f_0
+  (AppT (AppT (ConT Data.Either.Either)
+              (ConT GHC.Types.Int))
+        (AppT (AppT ArrowT
+                    (ConT GHC.Types.Int))
+              (ConT GHC.Types.Int)))
+-}
diff --git a/testsuite/tests/printer/T13942.stdout b/testsuite/tests/printer/T13942.stdout
new file mode 100644 (file)
index 0000000..2d0f617
--- /dev/null
@@ -0,0 +1,12 @@
+T13942.hs:(5,3)-(7,6): Splicing declarations
+    [d| f :: Either Int (Int -> Int)
+        f = undefined |]
+  ======>
+    f :: Either Int (Int -> Int)
+    f = undefined
+T13942.ppr.hs:(4,3)-(5,22): Splicing declarations
+    [d| f :: Either Int (Int -> Int)
+        f = undefined |]
+  ======>
+    f :: Either Int (Int -> Int)
+    f = undefined
index c939e49..a71d6e3 100644 (file)
@@ -49,3 +49,4 @@ test('Ppr048', ignore_stderr, run_command, ['$MAKE -s --no-print-directory ppr04
 test('T13199', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T13199'])
 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'])