Rubbish literals for all representations (#18983)

This patch cleans up the complexity around WW's `mk_absent_let` by
broadening the scope of `LitRubbish`. Rubbish literals now store the
`PrimRep` they represent and are ultimately lowered in Cmm.
This in turn allows absent literals of `VecRep` or `VoidRep`. The latter
allows absent literals for unlifted coercions, as requested in #18983.

I took the liberty to rewrite and clean up `Note [Absent fillers]` and
`Note [Rubbish values]` to account for the new implementation and to
make them more orthogonal in their description.

I didn't add a new regression test, as `T18982` already contains the
test in the ticket and its test output changes as expected.

Fixes #18983.

13 files changed, 148 insertions, 89 deletions

diff --git a/compiler/GHC/StgToCmm/ArgRep.hs b/compiler/GHC/StgToCmm/ArgRep.hs
index 8fc1796d6f..2ec0e177e8 100644
--- a/compiler/GHC/StgToCmm/ArgRep.hs
+++ b/compiler/GHC/StgToCmm/ArgRep.hs
@@ -87,7 +87,7 @@ toArgRep platform rep = case rep of
                            PW8 -> N
    FloatRep          -> F
    DoubleRep         -> D
-   (VecRep len elem) -> case len*primElemRepSizeB elem of
+   (VecRep len elem) -> case len*primElemRepSizeB platform elem of
                            16 -> V16
                            32 -> V32
                            64 -> V64
diff --git a/compiler/GHC/StgToCmm/Env.hs b/compiler/GHC/StgToCmm/Env.hs
index ebfff0185f..5f4ef641c4 100644
--- a/compiler/GHC/StgToCmm/Env.hs
+++ b/compiler/GHC/StgToCmm/Env.hs
@@ -17,7 +17,6 @@ module GHC.StgToCmm.Env (
 
         bindArgsToRegs, bindToReg, rebindToReg,
         bindArgToReg, idToReg,
-        getArgAmode, getNonVoidArgAmodes,
         getCgIdInfo,
         maybeLetNoEscape,
     ) where
@@ -26,10 +25,8 @@ module GHC.StgToCmm.Env (
 
 import GHC.Prelude
 
-import GHC.Core.TyCon
 import GHC.Platform
 import GHC.StgToCmm.Monad
-import GHC.StgToCmm.Utils
 import GHC.StgToCmm.Closure
 
 import GHC.Cmm.CLabel
@@ -40,7 +37,6 @@ import GHC.Cmm.Utils
 import GHC.Types.Id
 import GHC.Cmm.Graph
 import GHC.Types.Name
-import GHC.Stg.Syntax
 import GHC.Core.Type
 import GHC.Builtin.Types.Prim
 import GHC.Types.Unique.FM
@@ -162,22 +158,6 @@ cgLookupPanic id
               ])
 
 
---------------------
-getArgAmode :: NonVoid StgArg -> FCode CmmExpr
-getArgAmode (NonVoid (StgVarArg var)) = idInfoToAmode <$> getCgIdInfo var
-getArgAmode (NonVoid (StgLitArg lit)) = CmmLit <$> cgLit lit
-
-getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr]
--- NB: Filters out void args,
---     so the result list may be shorter than the argument list
-getNonVoidArgAmodes [] = return []
-getNonVoidArgAmodes (arg:args)
-  | isVoidRep (argPrimRep arg) = getNonVoidArgAmodes args
-  | otherwise = do { amode  <- getArgAmode (NonVoid arg)
-                   ; amodes <- getNonVoidArgAmodes args
-                   ; return ( amode : amodes ) }
-
-
 ------------------------------------------------------------------------
 --        Interface functions for binding and re-binding names
 ------------------------------------------------------------------------
diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs
index 1b57fc3813..dbc2a9ea06 100644
--- a/compiler/GHC/StgToCmm/Expr.hs
+++ b/compiler/GHC/StgToCmm/Expr.hs
@@ -10,7 +10,7 @@
 --
 -----------------------------------------------------------------------------
 
-module GHC.StgToCmm.Expr ( cgExpr ) where
+module GHC.StgToCmm.Expr ( cgExpr, cgLit ) where
 
 #include "HsVersions.h"
 
@@ -24,6 +24,7 @@ import GHC.StgToCmm.Env
 import GHC.StgToCmm.DataCon
 import GHC.StgToCmm.Prof (saveCurrentCostCentre, restoreCurrentCostCentre, emitSetCCC)
 import GHC.StgToCmm.Layout
+import GHC.StgToCmm.Lit
 import GHC.StgToCmm.Prim
 import GHC.StgToCmm.Hpc
 import GHC.StgToCmm.Ticky
@@ -115,8 +116,8 @@ cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do
 cgExpr (StgOpApp op args ty) = cgOpApp op args ty
 cgExpr (StgConApp con mn args _) = cgConApp con mn args
 cgExpr (StgTick t e)         = cgTick t >> cgExpr e
-cgExpr (StgLit lit)       = do cmm_lit <- cgLit lit
-                               emitReturn [CmmLit cmm_lit]
+cgExpr (StgLit lit)          = do cmm_expr <- cgLit lit
+                                  emitReturn [cmm_expr]
 
 cgExpr (StgLet _ binds expr) = do { cgBind binds;     cgExpr expr }
 cgExpr (StgLetNoEscape _ binds expr) =
diff --git a/compiler/GHC/StgToCmm/Expr.hs-boot b/compiler/GHC/StgToCmm/Expr.hs-boot
new file mode 100644
index 0000000000..5dd63a81dc
--- /dev/null
+++ b/compiler/GHC/StgToCmm/Expr.hs-boot
@@ -0,0 +1,7 @@
+module GHC.StgToCmm.Expr where
+
+import GHC.Cmm.Expr
+import GHC.StgToCmm.Monad
+import GHC.Types.Literal
+
+cgLit :: Literal -> FCode CmmExpr
diff --git a/compiler/GHC/StgToCmm/Foreign.hs b/compiler/GHC/StgToCmm/Foreign.hs
index 21c85d569c..95fa21d648 100644
--- a/compiler/GHC/StgToCmm/Foreign.hs
+++ b/compiler/GHC/StgToCmm/Foreign.hs
@@ -27,7 +27,6 @@ import GHC.Platform.Profile
 
 import GHC.Stg.Syntax
 import GHC.StgToCmm.Prof (storeCurCCS, ccsType)
-import GHC.StgToCmm.Env
 import GHC.StgToCmm.Monad
 import GHC.StgToCmm.Utils
 import GHC.StgToCmm.Closure
diff --git a/compiler/GHC/StgToCmm/Heap.hs b/compiler/GHC/StgToCmm/Heap.hs
index 62b9785ed6..16161cb028 100644
--- a/compiler/GHC/StgToCmm/Heap.hs
+++ b/compiler/GHC/StgToCmm/Heap.hs
@@ -32,7 +32,6 @@ import GHC.StgToCmm.Monad
 import GHC.StgToCmm.Prof (profDynAlloc, dynProfHdr, staticProfHdr)
 import GHC.StgToCmm.Ticky
 import GHC.StgToCmm.Closure
-import GHC.StgToCmm.Env
 
 import GHC.Cmm.Graph
 
diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs
index e45955d119..d10d7f6345 100644
--- a/compiler/GHC/StgToCmm/Layout.hs
+++ b/compiler/GHC/StgToCmm/Layout.hs
@@ -26,7 +26,8 @@ module GHC.StgToCmm.Layout (
         mkVirtConstrSizes,
         getHpRelOffset,
 
-        ArgRep(..), toArgRep, argRepSizeW -- re-exported from GHC.StgToCmm.ArgRep
+        ArgRep(..), toArgRep, argRepSizeW, -- re-exported from GHC.StgToCmm.ArgRep
+        getArgAmode, getNonVoidArgAmodes
   ) where
 
 
@@ -42,6 +43,7 @@ import GHC.StgToCmm.Env
 import GHC.StgToCmm.ArgRep -- notably: ( slowCallPattern )
 import GHC.StgToCmm.Ticky
 import GHC.StgToCmm.Monad
+import GHC.StgToCmm.Lit
 import GHC.StgToCmm.Utils
 
 import GHC.Cmm.Graph
@@ -591,6 +593,24 @@ stdPattern reps
         _ -> Nothing
 
 -------------------------------------------------------------------------
+--        Amodes for arguments
+-------------------------------------------------------------------------
+
+getArgAmode :: NonVoid StgArg -> FCode CmmExpr
+getArgAmode (NonVoid (StgVarArg var)) = idInfoToAmode <$> getCgIdInfo var
+getArgAmode (NonVoid (StgLitArg lit)) = cgLit lit
+
+getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr]
+-- NB: Filters out void args,
+--     so the result list may be shorter than the argument list
+getNonVoidArgAmodes [] = return []
+getNonVoidArgAmodes (arg:args)
+  | isVoidRep (argPrimRep arg) = getNonVoidArgAmodes args
+  | otherwise = do { amode  <- getArgAmode (NonVoid arg)
+                   ; amodes <- getNonVoidArgAmodes args
+                   ; return ( amode : amodes ) }
+
+-------------------------------------------------------------------------
 --
 --        Generating the info table and code for a closure
 --
diff --git a/compiler/GHC/StgToCmm/Lit.hs b/compiler/GHC/StgToCmm/Lit.hs
new file mode 100644
index 0000000000..244a593f9a
--- /dev/null
+++ b/compiler/GHC/StgToCmm/Lit.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE CPP, LambdaCase #-}
+
+-----------------------------------------------------------------------------
+--
+-- Stg to C-- code generation: literals
+--
+-- (c) The University of Glasgow 2004-2006
+--
+-----------------------------------------------------------------------------
+
+module GHC.StgToCmm.Lit (
+    cgLit, mkSimpleLit,
+    newStringCLit, newByteStringCLit
+  ) where
+
+#include "HsVersions.h"
+
+import GHC.Prelude
+
+import GHC.Platform
+import GHC.StgToCmm.Monad
+import GHC.StgToCmm.Env
+import GHC.Cmm
+import GHC.Cmm.CLabel
+import GHC.Cmm.Utils
+
+import GHC.Types.Literal
+import GHC.Builtin.Types ( unitDataConId )
+import GHC.Core.TyCon
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
+import GHC.Utils.Panic
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as BS8
+import Data.Char (ord)
+
+newStringCLit :: String -> FCode CmmLit
+-- ^ Make a global definition for the string,
+-- and return its label
+newStringCLit str = newByteStringCLit (BS8.pack str)
+
+newByteStringCLit :: ByteString -> FCode CmmLit
+newByteStringCLit bytes
+  = do  { uniq <- newUnique
+        ; let (lit, decl) = mkByteStringCLit (mkStringLitLabel uniq) bytes
+        ; emitDecl decl
+        ; return lit }
+
+cgLit :: Literal -> FCode CmmExpr
+cgLit (LitString s) =
+  CmmLit <$> newByteStringCLit s
+ -- not unpackFS; we want the UTF-8 byte stream.
+cgLit (LitRubbish preps) =
+  case expectOnly "cgLit:Rubbish" preps of -- Note [Post-unarisation invariants]
+    VoidRep     -> panic "cgLit:VoidRep"   -- dito
+    LiftedRep   -> idInfoToAmode <$> getCgIdInfo unitDataConId
+    UnliftedRep -> idInfoToAmode <$> getCgIdInfo unitDataConId
+    AddrRep     -> cgLit LitNullAddr
+    VecRep n elem -> do
+      platform <- getPlatform
+      let elem_lit = mkSimpleLit platform (num_rep_lit (primElemRepToPrimRep elem))
+      pure (CmmLit (CmmVec (replicate n elem_lit)))
+    prep        -> cgLit (num_rep_lit prep)
+    where
+      num_rep_lit IntRep    = mkLitIntUnchecked 0
+      num_rep_lit Int8Rep   = mkLitInt8Unchecked 0
+      num_rep_lit Int16Rep  = mkLitInt16Unchecked 0
+      num_rep_lit Int32Rep  = mkLitInt32Unchecked 0
+      num_rep_lit Int64Rep  = mkLitInt64Unchecked 0
+      num_rep_lit WordRep   = mkLitWordUnchecked 0
+      num_rep_lit Word8Rep  = mkLitWord8Unchecked 0
+      num_rep_lit Word16Rep = mkLitWord16Unchecked 0
+      num_rep_lit Word32Rep = mkLitWord32Unchecked 0
+      num_rep_lit Word64Rep = mkLitWord64Unchecked 0
+      num_rep_lit FloatRep  = LitFloat 0
+      num_rep_lit DoubleRep = LitDouble 0
+      num_rep_lit other     = pprPanic "num_rep_lit: Not a num lit" (ppr other)
+cgLit other_lit = do
+  platform <- getPlatform
+  pure (CmmLit (mkSimpleLit platform other_lit))
+
+mkSimpleLit :: Platform -> Literal -> CmmLit
+mkSimpleLit platform = \case
+   (LitChar   c)                -> CmmInt (fromIntegral (ord c))
+                                          (wordWidth platform)
+   LitNullAddr                  -> zeroCLit platform
+   (LitNumber LitNumInt i)      -> CmmInt i (wordWidth platform)
+   (LitNumber LitNumInt8 i)     -> CmmInt i W8
+   (LitNumber LitNumInt16 i)    -> CmmInt i W16
+   (LitNumber LitNumInt32 i)    -> CmmInt i W32
+   (LitNumber LitNumInt64 i)    -> CmmInt i W64
+   (LitNumber LitNumWord i)     -> CmmInt i (wordWidth platform)
+   (LitNumber LitNumWord8 i)    -> CmmInt i W8
+   (LitNumber LitNumWord16 i)   -> CmmInt i W16
+   (LitNumber LitNumWord32 i)   -> CmmInt i W32
+   (LitNumber LitNumWord64 i)   -> CmmInt i W64
+   (LitFloat r)                 -> CmmFloat r W32
+   (LitDouble r)                -> CmmFloat r W64
+   (LitLabel fs ms fod)
+     -> let -- TODO: Literal labels might not actually be in the current package...
+            labelSrc = ForeignLabelInThisPackage
+        in CmmLabel (mkForeignLabel fs ms labelSrc fod)
+   other -> pprPanic "mkSimpleLit" (ppr other)
+
diff --git a/compiler/GHC/StgToCmm/Monad.hs b/compiler/GHC/StgToCmm/Monad.hs
index 98720a2f50..c2c3b93125 100644
--- a/compiler/GHC/StgToCmm/Monad.hs
+++ b/compiler/GHC/StgToCmm/Monad.hs
@@ -24,6 +24,8 @@ module GHC.StgToCmm.Monad (
         emitOutOfLine, emitAssign, emitStore,
         emitComment, emitTick, emitUnwind,
 
+        newTemp,
+
         getCmm, aGraphToGraph, getPlatform, getProfile,
         getCodeR, getCode, getCodeScoped, getHeapUsage,
         getCallOpts, getPtrOpts,
@@ -479,6 +481,10 @@ newUnique = do
         setState $ state { cgs_uniqs = us' }
         return u
 
+newTemp :: MonadUnique m => CmmType -> m LocalReg
+newTemp rep = do { uniq <- getUniqueM
+                 ; return (LocalReg uniq rep) }
+
 ------------------
 getInfoDown :: FCode CgInfoDownwards
 getInfoDown = FCode $ \info_down state -> (info_down,state)
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index 484863d37a..fbd08b55a9 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -25,7 +25,6 @@ import GHC.Platform.Profile
 
 import GHC.StgToCmm.Layout
 import GHC.StgToCmm.Foreign
-import GHC.StgToCmm.Env
 import GHC.StgToCmm.Monad
 import GHC.StgToCmm.Utils
 import GHC.StgToCmm.Ticky
diff --git a/compiler/GHC/StgToCmm/Prof.hs b/compiler/GHC/StgToCmm/Prof.hs
index f0b9b2ae8c..08a06f3242 100644
--- a/compiler/GHC/StgToCmm/Prof.hs
+++ b/compiler/GHC/StgToCmm/Prof.hs
@@ -36,6 +36,7 @@ import GHC.Platform.Profile
 import GHC.StgToCmm.Closure
 import GHC.StgToCmm.Utils
 import GHC.StgToCmm.Monad
+import GHC.StgToCmm.Lit
 import GHC.Runtime.Heap.Layout
 
 import GHC.Cmm.Graph
diff --git a/compiler/GHC/StgToCmm/Ticky.hs b/compiler/GHC/StgToCmm/Ticky.hs
index 44a99a0cae..e9e67f6b83 100644
--- a/compiler/GHC/StgToCmm/Ticky.hs
+++ b/compiler/GHC/StgToCmm/Ticky.hs
@@ -109,6 +109,7 @@ import GHC.StgToCmm.ArgRep    ( slowCallPattern , toArgRep , argRepString )
 import GHC.StgToCmm.Closure
 import GHC.StgToCmm.Utils
 import GHC.StgToCmm.Monad
+import GHC.StgToCmm.Lit       ( newStringCLit )
 
 import GHC.Stg.Syntax
 import GHC.Cmm.Expr
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs
index 86d8a8d842..35af67cc54 100644
--- a/compiler/GHC/StgToCmm/Utils.hs
+++ b/compiler/GHC/StgToCmm/Utils.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE LambdaCase #-}
 
 -----------------------------------------------------------------------------
 --
@@ -10,11 +9,10 @@
 -----------------------------------------------------------------------------
 
 module GHC.StgToCmm.Utils (
-        cgLit, mkSimpleLit,
         emitDataLits, emitRODataLits,
         emitDataCon,
         emitRtsCall, emitRtsCallWithResult, emitRtsCallGen,
-        assignTemp, newTemp,
+        assignTemp,
 
         newUnboxedTupleRegs,
 
@@ -38,7 +36,6 @@ module GHC.StgToCmm.Utils (
         cmmUntag, cmmIsTagged,
 
         addToMem, addToMemE, addToMemLblE, addToMemLbl,
-        newStringCLit, newByteStringCLit,
 
         -- * Update remembered set operations
         whenUpdRemSetEnabled,
@@ -55,6 +52,7 @@ import GHC.Prelude
 import GHC.Platform
 import GHC.StgToCmm.Monad
 import GHC.StgToCmm.Closure
+import GHC.StgToCmm.Lit (mkSimpleLit)
 import GHC.Cmm
 import GHC.Cmm.BlockId
 import GHC.Cmm.Graph as CmmGraph
@@ -74,7 +72,6 @@ import GHC.Types.Literal
 import GHC.Data.Graph.Directed
 import GHC.Utils.Misc
 import GHC.Types.Unique
-import GHC.Types.Unique.Supply (MonadUnique(..))
 import GHC.Driver.Session
 import GHC.Data.FastString
 import GHC.Utils.Outputable
@@ -83,10 +80,7 @@ import GHC.Types.RepType
 import GHC.Types.CostCentre
 import GHC.Types.IPE
 
-import Data.ByteString (ByteString)
-import qualified Data.ByteString.Char8 as BS8
 import qualified Data.Map as M
-import Data.Char
 import Data.List (sortBy)
 import Data.Ord
 import GHC.Types.Unique.Map
@@ -98,42 +92,6 @@ import GHC.Types.Unique.FM
 import GHC.Data.Maybe
 import Control.Monad
 
--------------------------------------------------------------------------
---
---      Literals
---
--------------------------------------------------------------------------
-
-cgLit :: Literal -> FCode CmmLit
-cgLit (LitString s) = newByteStringCLit s
- -- not unpackFS; we want the UTF-8 byte stream.
-cgLit other_lit     = do platform <- getPlatform
-                         return (mkSimpleLit platform other_lit)
-
-mkSimpleLit :: Platform -> Literal -> CmmLit
-mkSimpleLit platform = \case
-   (LitChar   c)                -> CmmInt (fromIntegral (ord c))
-                                          (wordWidth platform)
-   LitNullAddr                  -> zeroCLit platform
-   (LitNumber LitNumInt i)      -> CmmInt i (wordWidth platform)
-   (LitNumber LitNumInt8 i)     -> CmmInt i W8
-   (LitNumber LitNumInt16 i)    -> CmmInt i W16
-   (LitNumber LitNumInt32 i)    -> CmmInt i W32
-   (LitNumber LitNumInt64 i)    -> CmmInt i W64
-   (LitNumber LitNumWord i)     -> CmmInt i (wordWidth platform)
-   (LitNumber LitNumWord8 i)    -> CmmInt i W8
-   (LitNumber LitNumWord16 i)   -> CmmInt i W16
-   (LitNumber LitNumWord32 i)   -> CmmInt i W32
-   (LitNumber LitNumWord64 i)   -> CmmInt i W64
-   (LitFloat r)                 -> CmmFloat r W32
-   (LitDouble r)                -> CmmFloat r W64
-   (LitLabel fs ms fod)
-     -> let -- TODO: Literal labels might not actually be in the current package...
-            labelSrc = ForeignLabelInThisPackage
-        in CmmLabel (mkForeignLabel fs ms labelSrc fod)
-   -- NB: LitRubbish should have been lowered in "CoreToStg"
-   other -> pprPanic "mkSimpleLit" (ppr other)
-
 --------------------------------------------------------------------------
 --
 -- Incrementing a memory location
@@ -302,18 +260,6 @@ emitDataCon :: CLabel -> CmmInfoTable -> CostCentreStack -> [CmmLit] -> FCode ()
 emitDataCon lbl itbl ccs payload =
   emitDecl (CmmData (Section Data lbl) (CmmStatics lbl itbl ccs payload))
 
-newStringCLit :: String -> FCode CmmLit
--- Make a global definition for the string,
--- and return its label
-newStringCLit str = newByteStringCLit (BS8.pack str)
-
-newByteStringCLit :: ByteString -> FCode CmmLit
-newByteStringCLit bytes
-  = do  { uniq <- newUnique
-        ; let (lit, decl) = mkByteStringCLit (mkStringLitLabel uniq) bytes
-        ; emitDecl decl
-        ; return lit }
-
 -------------------------------------------------------------------------
 --
 --      Assigning expressions to temporaries
@@ -335,10 +281,6 @@ assignTemp e = do { platform <- getPlatform
                   ; emitAssign (CmmLocal reg) e
                   ; return reg }
 
-newTemp :: MonadUnique m => CmmType -> m LocalReg
-newTemp rep = do { uniq <- getUniqueM
-                 ; return (LocalReg uniq rep) }
-
 newUnboxedTupleRegs :: Type -> FCode ([LocalReg], [ForeignHint])
 -- Choose suitable local regs to use for the components
 -- of an unboxed tuple that we are about to return to
@@ -605,7 +547,6 @@ assignTemp' e
        emitAssign reg e
        return (CmmReg reg)
 
-
 ---------------------------------------------------------------------------
 -- Pushing to the update remembered set
 ---------------------------------------------------------------------------