[Git][ghc/ghc][wip/T18653] Fix printing of promoted unboxed tuples (#18653)

[Krzysztof Gogolewski]

Krzysztof Gogolewski pushed to branch wip/T18653 at Glasgow Haskell Compiler / GHC


Commits:
02191891 by Krzysztof Gogolewski at 2020-09-16T19:41:37+02:00
Fix printing of promoted unboxed tuples (#18653)

- - - - -


6 changed files:

- compiler/GHC/Builtin/Types.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Iface/Type.hs
- + testsuite/tests/ghci/scripts/T18653.script
- + testsuite/tests/ghci/scripts/T18653.stdout
- testsuite/tests/ghci/scripts/all.T


Changes:

=====================================
compiler/GHC/Builtin/Types.hs
=====================================
@@ -1018,7 +1018,9 @@ mk_tuple Unboxed arity = (tycon, tuple_con)
                          UnboxedTuple flavour
 
     -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
-    -- Kind:  forall (k1:RuntimeRep) (k2:RuntimeRep). TYPE k1 -> TYPE k2 -> #
+    -- Example: the kind of (#,#) is
+    --        forall (k1::RuntimeRep) (k2::RuntimeRep). TYPE k1 -> TYPE k2 ->
+    --                                                  TYPE (TupleRep '[k1, k2])
     tc_binders = mkTemplateTyConBinders (replicate arity runtimeRepTy)
                                         (\ks -> map tYPE ks)
 


=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -189,8 +189,8 @@ toIfaceTypeX fr (TyConApp tc tys)
 
   | Just dc <- isPromotedDataCon_maybe tc
   , isBoxedTupleDataCon dc
-  , n_tys == 2*arity
-  = IfaceTupleTy BoxedTuple IsPromoted (toIfaceTcArgsX fr tc (drop arity tys))
+  , n_tys == arity
+  = IfaceTupleTy BoxedTuple IsPromoted (toIfaceTcArgsX fr tc tys)
 
   | tc `elem` [ eqPrimTyCon, eqReprPrimTyCon, heqTyCon ]
   , (k1:k2:_) <- tys


=====================================
compiler/GHC/Iface/Type.hs
=====================================
@@ -1573,7 +1573,18 @@ pprTuple ctxt_prec sort promoted args =
   case promoted of
     IsPromoted
       -> let tys = appArgsIfaceTypes args
-             args' = drop (length tys `div` 2) tys
+             -- For promoted boxed tuples, drop half of the type arguments:
+             -- display '(,) @Type @(Type -> Type) Int Maybe
+             -- as      '(Int, Maybe)
+             -- For promoted unboxed tuples, additionally drop RuntimeRep vars;
+             -- display '(#,#) @LiftedRep @LiftedRep @Type @(Type -> Type) Int Maybe
+             -- as      '(# Int, Maybe #)
+             -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
+             -- and ticket #18653
+             toDrop = case sort of
+                        UnboxedTuple -> 2 * length tys `div` 3
+                        _            ->     length tys `div` 2
+             args' = drop toDrop tys
              spaceIfPromoted = case args' of
                arg0:_ -> pprSpaceIfPromotedTyCon arg0
                _ -> id


=====================================
testsuite/tests/ghci/scripts/T18653.script
=====================================
@@ -0,0 +1,3 @@
+:set -XDataKinds -XUnboxedTuples
+:kind! '(#,,,#) Int Char Bool Maybe
+:kind! '(,,,) Int Char Bool Maybe


=====================================
testsuite/tests/ghci/scripts/T18653.stdout
=====================================
@@ -0,0 +1,4 @@
+'(#,,,#) Int Char Bool Maybe :: (# *, *, *, * -> * #)
+= '(# Int, Char, Bool, Maybe #)
+'(,,,) Int Char Bool Maybe :: (*, *, *, * -> *)
+= '(Int, Char, Bool, Maybe)


=====================================
testsuite/tests/ghci/scripts/all.T
=====================================
@@ -319,3 +319,4 @@ test('T17431', normal, ghci_script, ['T17431.script'])
 test('T17549', normal, ghci_script, ['T17549.script'])
 test('T17669', [extra_run_opts('-fexternal-interpreter -fobject-code'), expect_broken(17669)], ghci_script, ['T17669.script'])
 test('T18644', normal, ghci_script, ['T18644.script'])
+test('T18653', normal, ghci_script, ['T18653.script'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02191891c080137a161c7861706db3dd484254d1

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02191891c080137a161c7861706db3dd484254d1
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/20200916/e16a46d2/attachment-0001.html>