Commit 5282bb17 authored by Alan Zimmerman's avatar Alan Zimmerman
Browse files

Parenthesize type/data families correctly for -ddump-splices

Fix a regression in the pretty-printed code for -ddump-splices, which regressed
since 8.0.

Closes trac issue #13550
parent ff84d052
......@@ -37,7 +37,7 @@ import Outputable
import MonadUtils ( foldrM )
import qualified Data.ByteString as BS
import Control.Monad( unless, liftM, ap )
import Control.Monad( unless, liftM, ap, (<=<) )
import Data.Maybe( catMaybes, fromMaybe, isNothing )
import Language.Haskell.TH as TH hiding (sigP)
......@@ -386,7 +386,7 @@ cvtDec (TH.PatSynSigD nm ty)
----------------
cvtTySynEqn :: Located RdrName -> TySynEqn -> CvtM (LTyFamInstEqn RdrName)
cvtTySynEqn tc (TySynEqn lhs rhs)
= do { lhs' <- mapM cvtType lhs
= do { lhs' <- mapM (wrap_apps <=< cvtType) lhs
; rhs' <- cvtType rhs
; returnL $ TyFamEqn { tfe_tycon = tc
, tfe_pats = mkHsImplicitBndrs lhs'
......@@ -433,7 +433,7 @@ cvt_tyinst_hdr :: TH.Cxt -> TH.Name -> [TH.Type]
cvt_tyinst_hdr cxt tc tys
= do { cxt' <- cvtContext cxt
; tc' <- tconNameL tc
; tys' <- mapM cvtType tys
; tys' <- mapM (wrap_apps <=< cvtType) tys
; return (cxt', tc', mkHsImplicitBndrs tys') }
----------------
......@@ -552,7 +552,8 @@ cvtSrcStrictness SourceStrict = SrcStrict
cvt_arg :: (TH.Bang, TH.Type) -> CvtM (LHsType RdrName)
cvt_arg (Bang su ss, ty)
= do { ty' <- cvtType ty
= do { ty'' <- cvtType ty
; ty' <- wrap_apps ty''
; let su' = cvtSrcUnpackedness su
; let ss' = cvtSrcStrictness ss
; returnL $ HsBangTy (HsSrcBang NoSourceText su' ss') ty' }
......
......@@ -205,3 +205,7 @@ T13199:
.PHONY: T13050p
T13050p:
$(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T13050p.hs
.PHONY: T13550
T13550:
$(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T13550.hs
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}
module Bug where
$([d| type family Foo a b
type instance Foo (Maybe a) b = Either (Maybe a) (Maybe b)
data family Bar a b
data instance Bar (Maybe a) b = BarMaybe (Maybe a) (Maybe b)
|])
{-
type instance Foo (Maybe a) b = Either (Maybe a) (Maybe b)
becomes
[TySynInstD Bug.Foo
(TySynEqn
[AppT
(ConT GHC.Base.Maybe)
(VarT a_6989586621679027317)
,VarT b_6989586621679027318]
(AppT
(AppT
(ConT Data.Either.Either)
(AppT
(ConT GHC.Base.Maybe)
(VarT a_6989586621679027317)
)
)
(AppT (ConT GHC.Base.Maybe) (VarT b_6989586621679027318))
)
)
]
data instance Bar (Maybe a) b = BarMaybe (Maybe a) (Maybe b)
becomes
[DataInstD [] Bug.Bar
[AppT
(ConT GHC.Base.Maybe)
(VarT a_6989586621679027707)
,VarT b_6989586621679027708
]
Nothing
[NormalC
BarMaybe_6989586621679027706
[(Bang
NoSourceUnpackedness
NoSourceStrictness
,AppT
(ConT GHC.Base.Maybe)
(VarT a_6989586621679027707)
)
,(Bang
NoSourceUnpackedness
NoSourceStrictness
,AppT
(ConT GHC.Base.Maybe)
(VarT b_6989586621679027708)
)
]
]
[]]
-}
T13550.hs:(6,3)-(11,6): Splicing declarations
[d| type family Foo a b
data family Bar a b
type instance Foo (Maybe a) b = Either (Maybe a) (Maybe b)
data instance Bar (Maybe a) b = BarMaybe (Maybe a) (Maybe b) |]
======>
type family Foo a b
type instance Foo (Maybe a) b = Either (Maybe a) (Maybe b)
data family Bar a b
data instance Bar (Maybe a) b = BarMaybe (Maybe a) (Maybe b)
T13550.ppr.hs:(5,3)-(8,69): Splicing declarations
[d| type family Foo a b
data family Bar a b
type instance Foo (Maybe a) b = Either (Maybe a) (Maybe b)
data instance Bar (Maybe a) b = BarMaybe (Maybe a) (Maybe b) |]
======>
type family Foo a b
type instance Foo (Maybe a) b = Either (Maybe a) (Maybe b)
data family Bar a b
data instance Bar (Maybe a) b = BarMaybe (Maybe a) (Maybe b)
......@@ -48,3 +48,4 @@ test('Ppr047', expect_fail, run_command, ['$MAKE -s --no-print-directory ppr047'
test('Ppr048', ignore_stderr, run_command, ['$MAKE -s --no-print-directory ppr048'])
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'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment