summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Builtin/Types.hs-boot2
-rw-r--r--compiler/GHC/Hs/Expr.hs2
-rw-r--r--compiler/GHC/Hs/Pat.hs2
-rw-r--r--compiler/GHC/Hs/Type.hs8
-rw-r--r--compiler/GHC/Iface/Type.hs10
-rw-r--r--testsuite/tests/printer/T22785.hs8
-rw-r--r--testsuite/tests/printer/T22785.stderr7
-rw-r--r--testsuite/tests/printer/all.T3
-rw-r--r--testsuite/tests/th/T17380.stderr12
-rw-r--r--testsuite/tests/th/T18612.stderr2
-rw-r--r--testsuite/tests/th/TH_Promoted1Tuple.stderr2
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
View Lorry Controller Status