summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>2022-03-28 15:59:04 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-04-22 08:00:18 -0400
commitf435d55fe969e739eb92bbb681069020d0622137 (patch)
tree84816a862da56d35646f7f767195920a4f5cb9db /compiler
parent76bb8cb3fd0f376b6af4bff12c29cb4226c24a72 (diff)
downloadhaskell-f435d55fe969e739eb92bbb681069020d0622137.tar.gz
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.
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/CoreToStg.hs6
-rw-r--r--compiler/GHC/Stg/Unarise.hs2
-rw-r--r--compiler/GHC/StgToByteCode.hs4
-rw-r--r--compiler/GHC/Types/RepType.hs2
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,