summaryrefslogtreecommitdiff
path: root/compiler/GHC/Stg/Syntax.hs
diff options
context:
space:
mode:
authorAndreas Klebinger <klebinger.andreas@gmx.at>2022-09-27 00:10:47 +0200
committerAndreas Klebinger <klebinger.andreas@gmx.at>2022-11-25 14:02:15 +0100
commit3678fb2695d3fc2db8de0be3dca7dff0ccdec08a (patch)
tree538e88fba811a15d8a9d74af4e86b82f8ed59480 /compiler/GHC/Stg/Syntax.hs
parent13d627bbd0bc3dd30d672de341aa7f471be0aa2c (diff)
downloadhaskell-wip/fix-ubx-cast.tar.gz
Properly cast values when writing/reading unboxed sums.wip/fix-ubx-cast
Unboxed sums might store a Int8# value as Int64#. This patch makes sure we keep track of the actual value type. See Note [Casting slot arguments] for the details.
Diffstat (limited to 'compiler/GHC/Stg/Syntax.hs')
-rw-r--r--compiler/GHC/Stg/Syntax.hs17
1 files changed, 14 insertions, 3 deletions
diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs
index 4956920fb1..07fc35b5eb 100644
--- a/compiler/GHC/Stg/Syntax.hs
+++ b/compiler/GHC/Stg/Syntax.hs
@@ -87,7 +87,7 @@ import GHC.Core.Ppr( {- instances -} )
import GHC.Builtin.PrimOps ( PrimOp, PrimCall )
import GHC.Core.TyCon ( PrimRep(..), TyCon )
import GHC.Core.Type ( Type )
-import GHC.Types.RepType ( typePrimRep1 )
+import GHC.Types.RepType ( typePrimRep1, typePrimRep )
import GHC.Utils.Panic.Plain
{-
@@ -740,12 +740,23 @@ pprStgTopBinding = pprGenStgTopBinding
pprStgTopBindings :: OutputablePass pass => StgPprOpts -> [GenStgTopBinding pass] -> SDoc
pprStgTopBindings = pprGenStgTopBindings
+pprIdWithRep :: Id -> SDoc
+pprIdWithRep v = ppr v <> pprTypeRep (idType v)
+
+pprTypeRep :: Type -> SDoc
+pprTypeRep ty =
+ ppUnlessOption sdocSuppressStgReps $
+ char ':' <> case typePrimRep ty of
+ [r] -> ppr r
+ r -> ppr r
+
+
instance Outputable StgArg where
ppr = pprStgArg
pprStgArg :: StgArg -> SDoc
-pprStgArg (StgVarArg var) = ppr var
-pprStgArg (StgLitArg con) = ppr con
+pprStgArg (StgVarArg var) = pprIdWithRep var
+pprStgArg (StgLitArg con) = ppr con <> pprTypeRep (literalType con)
instance OutputablePass pass => Outputable (GenStgExpr pass) where
ppr = pprStgExpr panicStgPprOpts