[Git][ghc/ghc][wip/backports-9.6] Fix printing of promoted MkSolo datacon (#22785)

Ben Gamari (@bgamari) gitlab at gitlab.haskell.org
Thu Jan 26 21:00:58 UTC 2023



Ben Gamari pushed to branch wip/backports-9.6 at Glasgow Haskell Compiler / GHC


Commits:
f78d485b by Andrei Borzenkov at 2023-01-26T16:00:11-05:00
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.

(cherry picked from commit 14b5982a3aea351e4b01c5804ebd4d4629ba6bab)

- - - - -


11 changed files:

- compiler/GHC/Builtin/Types.hs-boot
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Iface/Type.hs
- + testsuite/tests/printer/T22785.hs
- + testsuite/tests/printer/T22785.stderr
- testsuite/tests/printer/all.T
- testsuite/tests/th/T17380.stderr
- testsuite/tests/th/T18612.stderr
- testsuite/tests/th/TH_Promoted1Tuple.stderr


Changes:

=====================================
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
 


=====================================
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]


=====================================
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]


=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -102,7 +102,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(..) )
@@ -1168,9 +1168,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
@@ -1233,7 +1233,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


=====================================
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 )
@@ -1750,9 +1751,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
 


=====================================
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


=====================================
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


=====================================
testsuite/tests/printer/all.T
=====================================
@@ -185,4 +185,5 @@ test('Test21805', [ignore_stderr, req_ppr_deps], makefile_test, ['Test21805'])
 test('T22488', normal, ghci_script, ['T22488.script'])
 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'])
\ No newline at end of file
+test('T20531_red_ticks', extra_files(['T20531_defs.hs']), ghci_script, ['T20531_red_ticks.script'])
+test('T22785', normal, compile_fail, [''])


=====================================
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)


=====================================
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)))


=====================================
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 it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f78d485b6cbd119c328d180f6f06e9279257606d

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f78d485b6cbd119c328d180f6f06e9279257606d
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/20230126/ba9e90ae/attachment-0001.html>


More information about the ghc-commits mailing list