diff options
author | Andrei Borzenkov <andreyborzenkov2002@gmail.com> | 2023-01-17 17:22:54 +0400 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-01-18 22:26:43 -0500 |
commit | 14b5982a3aea351e4b01c5804ebd4d4629ba6bab (patch) | |
tree | ef1fd598914a6625b90c28cc71cb7041c03cc823 | |
parent | 154889dbfbef62ad58a28df4171bf767cc690c2a (diff) | |
download | haskell-14b5982a3aea351e4b01c5804ebd4d4629ba6bab.tar.gz |
Fix printing of promoted MkSolo datacon (#22785)
Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo,
and Solo was turned into a pattern synonym for backwards compatibility.
Since pattern synonyms can not be promoted, the old code that pretty-printed
promoted single-element tuples started producing ill-typed code:
t :: Proxy ('Solo Int)
This fails with "Pattern synonym ‘Solo’ used as a type"
The solution is to track the distinction between type constructors and data
constructors more carefully when printing single-element tuples.
-rw-r--r-- | compiler/GHC/Builtin/Types.hs-boot | 2 | ||||
-rw-r--r-- | compiler/GHC/Hs/Expr.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Hs/Pat.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Hs/Type.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Iface/Type.hs | 10 | ||||
-rw-r--r-- | testsuite/tests/printer/T22785.hs | 8 | ||||
-rw-r--r-- | testsuite/tests/printer/T22785.stderr | 7 | ||||
-rw-r--r-- | testsuite/tests/printer/all.T | 3 | ||||
-rw-r--r-- | testsuite/tests/th/T17380.stderr | 12 | ||||
-rw-r--r-- | testsuite/tests/th/T18612.stderr | 2 | ||||
-rw-r--r-- | testsuite/tests/th/TH_Promoted1Tuple.stderr | 2 |
11 files changed, 39 insertions, 19 deletions
diff --git a/compiler/GHC/Builtin/Types.hs-boot b/compiler/GHC/Builtin/Types.hs-boot index b066283ffe..857de8e10b 100644 --- a/compiler/GHC/Builtin/Types.hs-boot +++ b/compiler/GHC/Builtin/Types.hs-boot @@ -64,7 +64,7 @@ unrestrictedFunTyCon :: TyCon multMulTyCon :: TyCon tupleTyConName :: TupleSort -> Arity -> Name - +tupleDataConName :: Boxity -> Arity -> Name integerTy, naturalTy :: Type diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs index ed0280cb18..31d67c308c 100644 --- a/compiler/GHC/Hs/Expr.hs +++ b/compiler/GHC/Hs/Expr.hs @@ -545,7 +545,7 @@ ppr_expr (SectionR _ op expr) ppr_expr (ExplicitTuple _ exprs boxity) -- Special-case unary boxed tuples so that they are pretty-printed as - -- `Solo x`, not `(x)` + -- `MkSolo x`, not `(x)` | [Present _ expr] <- exprs , Boxed <- boxity = hsep [text (mkTupleStr Boxed dataName 1), ppr expr] diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs index 39a788aab5..bc0b51457e 100644 --- a/compiler/GHC/Hs/Pat.hs +++ b/compiler/GHC/Hs/Pat.hs @@ -350,7 +350,7 @@ pprPat (SigPat _ pat ty) = ppr pat <+> dcolon <+> ppr ty pprPat (ListPat _ pats) = brackets (interpp'SP pats) pprPat (TuplePat _ pats bx) -- Special-case unary boxed tuples so that they are pretty-printed as - -- `Solo x`, not `(x)` + -- `MkSolo x`, not `(x)` | [pat] <- pats , Boxed <- bx = hcat [text (mkTupleStr Boxed dataName 1), pprParendLPat appPrec pat] diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs index 053042d4a1..313b8e8fe2 100644 --- a/compiler/GHC/Hs/Type.hs +++ b/compiler/GHC/Hs/Type.hs @@ -104,7 +104,7 @@ import GHC.Parser.Annotation import GHC.Types.Fixity ( LexicalFixity(..) ) import GHC.Types.Id ( Id ) import GHC.Types.SourceText -import GHC.Types.Name( Name, NamedThing(getName), tcName ) +import GHC.Types.Name( Name, NamedThing(getName), tcName, dataName ) import GHC.Types.Name.Reader ( RdrName ) import GHC.Types.Var ( VarBndr, visArgTypeLike ) import GHC.Core.TyCo.Rep ( Type(..) ) @@ -1170,9 +1170,9 @@ ppr_mono_ty (HsExplicitListTy _ prom tys) | otherwise = brackets (interpp'SP tys) ppr_mono_ty (HsExplicitTupleTy _ tys) -- Special-case unary boxed tuples so that they are pretty-printed as - -- `'Solo x`, not `'(x)` + -- `'MkSolo x`, not `'(x)` | [ty] <- tys - = quote $ sep [text (mkTupleStr Boxed tcName 1), ppr_mono_lty ty] + = quote $ sep [text (mkTupleStr Boxed dataName 1), ppr_mono_lty ty] | otherwise = quote $ parens (maybeAddSpace tys $ interpp'SP tys) ppr_mono_ty (HsTyLit _ t) = ppr t @@ -1235,7 +1235,7 @@ hsTypeNeedsParens p = go_hs_ty go_hs_ty (HsSpliceTy{}) = False go_hs_ty (HsExplicitListTy{}) = False -- Special-case unary boxed tuple applications so that they are - -- parenthesized as `Proxy ('Solo x)`, not `Proxy 'Solo x` (#18612) + -- parenthesized as `Proxy ('MkSolo x)`, not `Proxy 'MkSolo x` (#18612) -- See Note [One-tuples] in GHC.Builtin.Types go_hs_ty (HsExplicitTupleTy _ [_]) = p >= appPrec diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs index 608a16af4b..2b45a712e6 100644 --- a/compiler/GHC/Iface/Type.hs +++ b/compiler/GHC/Iface/Type.hs @@ -72,6 +72,7 @@ import {-# SOURCE #-} GHC.Builtin.Types ( coercibleTyCon, heqTyCon , constraintKindTyConName , tupleTyConName + , tupleDataConName , manyDataConTyCon , liftedRepTyCon, liftedDataConTyCon ) import GHC.Core.Type ( isRuntimeRepTy, isMultiplicityTy, isLevityTy, funTyFlagTyCon ) @@ -1745,9 +1746,12 @@ pprTuple ctxt_prec sort promoted args = -- `Solo x`, not `(x)` | [_] <- args_wo_runtime_reps , BoxedTuple <- sort - = let unit_tc_info = mkIfaceTyConInfo promoted IfaceNormalTyCon - unit_tc = IfaceTyCon (tupleTyConName sort 1) unit_tc_info in - pprPrecIfaceType ctxt_prec $ IfaceTyConApp unit_tc args + = let solo_tc_info = mkIfaceTyConInfo promoted IfaceNormalTyCon + tupleName = case promoted of + IsPromoted -> tupleDataConName (tupleSortBoxity sort) + NotPromoted -> tupleTyConName sort + solo_tc = IfaceTyCon (tupleName 1) solo_tc_info in + pprPrecIfaceType ctxt_prec $ IfaceTyConApp solo_tc args | otherwise = ppr_args_w_parens diff --git a/testsuite/tests/printer/T22785.hs b/testsuite/tests/printer/T22785.hs new file mode 100644 index 0000000000..1db6b7d88d --- /dev/null +++ b/testsuite/tests/printer/T22785.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DataKinds #-} +module T22785 where +import Data.Proxy +import Data.Tuple + + +p :: Proxy ('MkSolo Int) +p = Proxy :: Proxy Int diff --git a/testsuite/tests/printer/T22785.stderr b/testsuite/tests/printer/T22785.stderr new file mode 100644 index 0000000000..05bf7bfb3d --- /dev/null +++ b/testsuite/tests/printer/T22785.stderr @@ -0,0 +1,7 @@ + +T22785.hs:8:5: [GHC-83865] + Couldn't match type ‘Int’ with ‘MkSolo Int’ + Expected: Proxy (MkSolo Int) + Actual: Proxy Int + In the expression: Proxy :: Proxy Int + In an equation for ‘p’: p = Proxy :: Proxy Int diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T index 409c9f2b13..cc4e4b3324 100644 --- a/testsuite/tests/printer/all.T +++ b/testsuite/tests/printer/all.T @@ -187,4 +187,5 @@ test('T22488_docHead', normal, compile_and_run, ['-package ghc']) test('T20531', extra_files(['T20531_defs.hs']), ghci_script, ['T20531.script']) test('T20531_red_ticks', extra_files(['T20531_defs.hs']), ghci_script, ['T20531_red_ticks.script']) test('HsDocTy', [ignore_stderr, req_ppr_deps], makefile_test, ['HsDocTy']) -test('Test22765', [ignore_stderr, req_ppr_deps], makefile_test, ['Test22765'])
\ No newline at end of file +test('Test22765', [ignore_stderr, req_ppr_deps], makefile_test, ['Test22765']) +test('T22785', normal, compile_fail, ['']) diff --git a/testsuite/tests/th/T17380.stderr b/testsuite/tests/th/T17380.stderr index d1f4684062..b5e79ffb63 100644 --- a/testsuite/tests/th/T17380.stderr +++ b/testsuite/tests/th/T17380.stderr @@ -25,17 +25,17 @@ T17380.hs:18:7: error: [GHC-83865] T17380.hs:21:8: error: [GHC-83865] • Couldn't match type: Maybe String - with: 'Solo (Maybe String) - Expected: Proxy ('Solo (Maybe String)) + with: MkSolo (Maybe String) + Expected: Proxy (MkSolo (Maybe String)) Actual: Proxy (Maybe String) • In the expression: Proxy :: Proxy (Maybe String) In an equation for ‘quuz’: quuz = Proxy :: Proxy (Maybe String) T17380.hs:24:8: error: [GHC-83865] - • Couldn't match type: 'Solo (Maybe String) + • Couldn't match type: MkSolo (Maybe String) with: Maybe String Expected: Proxy (Maybe String) - Actual: Proxy ('Solo (Maybe String)) - • In the expression: Proxy :: Proxy ('Solo Maybe String) + Actual: Proxy (MkSolo (Maybe String)) + • In the expression: Proxy :: Proxy ('MkSolo Maybe String) In an equation for ‘fred’: - fred = Proxy :: Proxy ('Solo Maybe String) + fred = Proxy :: Proxy ('MkSolo Maybe String) diff --git a/testsuite/tests/th/T18612.stderr b/testsuite/tests/th/T18612.stderr index 0865ddc17b..b710dc3b39 100644 --- a/testsuite/tests/th/T18612.stderr +++ b/testsuite/tests/th/T18612.stderr @@ -1,7 +1,7 @@ T18612.hs:14:11-68: Splicing type conT ''Proxy `appT` (promotedTupleT 1 `appT` (tupleT 0)) ======> - Proxy ('Solo ()) + Proxy ('MkSolo ()) T18612.hs:(10,7)-(11,75): Splicing type arrowT `appT` (conT ''Identity `appT` (tupleT 1 `appT` (tupleT 0))) `appT` (conT ''Identity `appT` (tupleT 1 `appT` (tupleT 0))) diff --git a/testsuite/tests/th/TH_Promoted1Tuple.stderr b/testsuite/tests/th/TH_Promoted1Tuple.stderr index bd71507e2e..2453cb26d5 100644 --- a/testsuite/tests/th/TH_Promoted1Tuple.stderr +++ b/testsuite/tests/th/TH_Promoted1Tuple.stderr @@ -1,3 +1,3 @@ TH_Promoted1Tuple.hs:7:2: error: - Illegal type: ‘'Solo Int’ Perhaps you intended to use DataKinds + Illegal type: ‘'MkSolo Int’ Perhaps you intended to use DataKinds |