[Git][ghc/ghc][wip/int-index/thtohs-parens] ThToHs: fix overzealous parenthesization

[Vladislav Zavialov (@int-index)]

Vladislav Zavialov pushed to branch wip/int-index/thtohs-parens at Glasgow Haskell Compiler / GHC


Commits:
ca30bf74 by Vladislav Zavialov at 2022-10-28T00:39:56+04:00
ThToHs: fix overzealous parenthesization

Before this patch, when converting from TH.Exp to LHsExpr GhcPs,
the compiler inserted more parentheses than required:

	((f a) (b + c)) d

This was happening because the LHS of the function application was
parenthesized as if it was the RHS.

Now we use funPrec and appPrec appropriately and produce sensibly
parenthesized expressions:

	f a (b + c) d

I also took the opportunity to remove the special case for LamE,
which was not special at all and simply duplicated code.

- - - - -


4 changed files:

- compiler/GHC/ThToHs.hs
- testsuite/tests/th/T13776.stderr
- testsuite/tests/th/T14681.stderr
- testsuite/tests/th/T17608.stderr


Changes:

=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -979,17 +979,13 @@ cvtl e = wrapLA (cvt e)
           l' <- cvt_lit l
           let e' = mk_expr l'
           if is_compound_lit l' then wrapParLA gHsPar e' else pure e'
-    cvt (AppE x@(LamE _ _) y) = do { x' <- cvtl x; y' <- cvtl y
-                                   ; return $ HsApp noComments (mkLHsPar x')
-                                                          (mkLHsPar y')}
-    cvt (AppE x y)            = do { x' <- cvtl x; y' <- cvtl y
-                                   ; return $ HsApp noComments (mkLHsPar x')
-                                                          (mkLHsPar y')}
-    cvt (AppTypeE e t) = do { e' <- cvtl e
-                            ; t' <- cvtType t
-                            ; let tp = parenthesizeHsType appPrec t'
+    cvt (AppE e1 e2)   = do { e1' <- parenthesizeHsExpr funPrec <$> cvtl e1
+                            ; e2' <- parenthesizeHsExpr appPrec <$> cvtl e2
+                            ; return $ HsApp noComments e1' e2' }
+    cvt (AppTypeE e t) = do { e' <- parenthesizeHsExpr funPrec <$> cvtl e
+                            ; t' <- parenthesizeHsType appPrec <$> cvtType t
                             ; return $ HsAppType noExtField e' noHsTok
-                                     $ mkHsWildCardBndrs tp }
+                                     $ mkHsWildCardBndrs t' }
     cvt (LamE [] e)    = cvt e -- Degenerate case. We convert the body as its
                                -- own expression to avoid pretty-printing
                                -- oddities that can result from zero-argument


=====================================
testsuite/tests/th/T13776.stderr
=====================================
@@ -5,7 +5,7 @@ T13776.hs:7:15-62: Splicing type
 T13776.hs:14:15-75: Splicing expression
     conE '(,) `appE` litE (integerL 1) `appE` litE (integerL 1)
   ======>
-    ((,) 1) 1
+    (,) 1 1
 T13776.hs:17:15-24: Splicing expression conE '[] ======> []
 T13776.hs:20:13-62: Splicing pattern
     conP '(,) [litP (integerL 1), litP (integerL 1)] ======> (,) 1 1


=====================================
testsuite/tests/th/T14681.stderr
=====================================
@@ -8,4 +8,4 @@ T14681.hs:(8,2)-(9,63): Splicing declarations
                          $ VarE '(+) `AppE` LitE (IntegerL (- 1))
                              `AppE` (LitE (IntegerL (- 1)))>]
   ======>
-    g = ((+) (-1)) (-1)
+    g = (+) (-1) (-1)


=====================================
testsuite/tests/th/T17608.stderr
=====================================
@@ -24,7 +24,7 @@ T17608.hs:(4,2)-(20,7): Splicing declarations
           infixl 4 `h`
           h :: () -> Bool -> Bool
           h _ _ = True
-        in (h ()) ((g ()) ())
+        in h () (g () ())
       where
           infixl 4 `g`
           g :: () -> () -> Bool



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ca30bf744e57d571332ae473362e6590208a88ae

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ca30bf744e57d571332ae473362e6590208a88ae
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221027/e64a57e1/attachment-0001.html>