diff options
| author | Andreas Herrmann <andreash87@gmx.ch> | 2018-06-07 13:24:52 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2018-06-07 18:06:29 -0400 |
| commit | 767536ccf95d8352d146b6544857b28d9c42937e (patch) | |
| tree | c0d3f6d4d6b6977ed9835c9e5617aba746765d57 /compiler | |
| parent | e7678d6a0607013749e9ba4d88df949ad1192765 (diff) | |
| download | haskell-767536ccf95d8352d146b6544857b28d9c42937e.tar.gz | |
Fix unparseable pretty-printing of promoted data cons
Previously we would print code which would not round-trip:
```
> :set -XDataKinds
> :set -XPolyKinds
> data Proxy k = Proxy
> _ :: Proxy '[ 'True ]
error:
Found hole: _ :: Proxy '['True]
> _ :: Proxy '['True]
error:
Invalid type signature: _ :: ...
Should be of form <variable> :: <type>
```
Test Plan: Validate with T14343
Reviewers: RyanGlScott, goldfire, bgamari, tdammers
Reviewed By: RyanGlScott, bgamari
Subscribers: tdammers, rwbarton, thomie, carter
GHC Trac Issues: #14343
Differential Revision: https://phabricator.haskell.org/D4746
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/iface/IfaceType.hs | 18 |
1 files changed, 15 insertions, 3 deletions
diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index 2524593663..e2e51d8c58 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -933,6 +933,15 @@ criteria are met: ------------------- +-- | Prefix a space if the given 'IfaceType' is a promoted 'TyCon'. +pprSpaceIfPromotedTyCon :: IfaceType -> SDoc -> SDoc +pprSpaceIfPromotedTyCon (IfaceTyConApp tyCon _) + = case ifaceTyConIsPromoted (ifaceTyConInfo tyCon) of + IsPromoted -> (space <>) + _ -> id +pprSpaceIfPromotedTyCon _ + = id + -- See equivalent function in TyCoRep.hs pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc -- Given a type-level list (t1 ': t2), see if we can print @@ -941,8 +950,8 @@ pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc pprIfaceTyList ctxt_prec ty1 ty2 = case gather ty2 of (arg_tys, Nothing) - -> char '\'' <> brackets (fsep (punctuate comma - (map (ppr_ty topPrec) (ty1:arg_tys)))) + -> char '\'' <> brackets (pprSpaceIfPromotedTyCon ty1 (fsep + (punctuate comma (map (ppr_ty topPrec) (ty1:arg_tys))))) (arg_tys, Just tl) -> maybeParen ctxt_prec funPrec $ hang (ppr_ty funPrec ty1) 2 (fsep [ colon <+> ppr_ty funPrec ty | ty <- arg_tys ++ [tl]]) @@ -1136,8 +1145,11 @@ pprTuple ctxt_prec ConstraintTuple IsNotPromoted ITC_Nil pprTuple _ sort IsPromoted args = let tys = tcArgsIfaceTypes args args' = drop (length tys `div` 2) tys + spaceIfPromoted = case args' of + arg0:_ -> pprSpaceIfPromotedTyCon arg0 + _ -> id in pprPromotionQuoteI IsPromoted <> - tupleParens sort (pprWithCommas pprIfaceType args') + tupleParens sort (spaceIfPromoted (pprWithCommas pprIfaceType args')) pprTuple _ sort promoted args = -- drop the RuntimeRep vars. |