From 9be3a082474c16719ad80ae17b9e349c25358c5c Mon Sep 17 00:00:00 2001
From: Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io>
Date: Mon, 28 Mar 2022 15:59:04 +0200
Subject: Fixes to rubbish literals

* In CoreToStg, the application 'RUBBISH[rep] x' was simplified
  to 'RUBBISH[rep]'. But it is possible that the result of the function
  is represented differently than the function.
* In Unarise, 'LitRubbish (primRepToType prep)'
  is incorrect: LitRubbish takes a RuntimeRep such as IntRep,
  while primRepToType returns a type such as Any @(TYPE IntRep). Use
  primRepToRuntimeRep instead.
  This code is never run in the testsuite.
* In StgToByteCode, all rubbish literals were assumed to be boxed.
  This code predates representation-polymorphic RubbishLit and I think
  it was not updated.

I don't have a testcase for any of those issues, but the code looks
wrong.
---
 compiler/GHC/CoreToStg.hs     | 6 +++++-
 compiler/GHC/Stg/Unarise.hs   | 2 +-
 compiler/GHC/StgToByteCode.hs | 4 +++-
 compiler/GHC/Types/RepType.hs | 2 +-
 4 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/compiler/GHC/CoreToStg.hs b/compiler/GHC/CoreToStg.hs
index 79be8e6e11..268c427f09 100644
--- a/compiler/GHC/CoreToStg.hs
+++ b/compiler/GHC/CoreToStg.hs
@@ -402,7 +402,11 @@ coreToStgExpr expr@(App _ _)
   = case app_head of
       Var f -> coreToStgApp f args ticks -- Regular application
       Lit l | isLitRubbish l             -- If there is LitRubbish at the head,
-            -> return (StgLit l)         --    discard the arguments
+                                         --    discard the arguments
+                                         --    Recompute representation, because in
+                                         --    '(RUBBISH[rep] x) :: (T :: TYPE rep2)'
+                                         --    rep might not be equal to rep2
+            -> return (StgLit $ LitRubbish $ getRuntimeRep (exprType expr))
 
       _     -> pprPanic "coreToStgExpr - Invalid app head:" (ppr expr)
     where
diff --git a/compiler/GHC/Stg/Unarise.hs b/compiler/GHC/Stg/Unarise.hs
index 23c2646f73..30234fe57c 100644
--- a/compiler/GHC/Stg/Unarise.hs
+++ b/compiler/GHC/Stg/Unarise.hs
@@ -456,7 +456,7 @@ unariseRubbish_maybe (LitRubbish rep)
   = Nothing   -- Single, non-void PrimRep. Nothing to do!
 
   | otherwise -- Multiple reps, possibly with VoidRep. Eliminate via elimCase
-  = Just [ StgLitArg (LitRubbish (primRepToType prep))
+  = Just [ StgLitArg (LitRubbish (primRepToRuntimeRep prep))
          | prep <- preps, not (isVoidRep prep) ]
   where
     preps = runtimeRepPrimRep (text "unariseRubbish_maybe") rep
diff --git a/compiler/GHC/StgToByteCode.hs b/compiler/GHC/StgToByteCode.hs
index 0d6af799de..c3a1d6ff94 100644
--- a/compiler/GHC/StgToByteCode.hs
+++ b/compiler/GHC/StgToByteCode.hs
@@ -1722,7 +1722,9 @@ pushLiteral padded lit =
         LitChar {}      -> code WordRep
         LitNullAddr     -> code AddrRep
         LitString {}    -> code AddrRep
-        LitRubbish {}   -> code WordRep
+        LitRubbish rep  -> case runtimeRepPrimRep (text "pushLiteral") rep of
+                             [pr] -> code pr
+                             _    -> pprPanic "pushLiteral" (ppr lit)
         LitNumber nt _  -> case nt of
           LitNumInt     -> code IntRep
           LitNumWord    -> code WordRep
diff --git a/compiler/GHC/Types/RepType.hs b/compiler/GHC/Types/RepType.hs
index b565bd7400..e09164dc9a 100644
--- a/compiler/GHC/Types/RepType.hs
+++ b/compiler/GHC/Types/RepType.hs
@@ -13,7 +13,7 @@ module GHC.Types.RepType
     -- * Type representation for the code generator
     typePrimRep, typePrimRep1,
     runtimeRepPrimRep, typePrimRepArgs,
-    PrimRep(..), primRepToType,
+    PrimRep(..), primRepToRuntimeRep, primRepToType,
     countFunRepArgs, countConRepArgs, dataConRuntimeRepStrictness,
     tyConPrimRep, tyConPrimRep1,
 
-- 
cgit v1.2.1