diff options
author | Andreas Klebinger <klebinger.andreas@gmx.at> | 2022-09-27 00:10:47 +0200 |
---|---|---|
committer | Andreas Klebinger <klebinger.andreas@gmx.at> | 2022-11-25 14:02:15 +0100 |
commit | 3678fb2695d3fc2db8de0be3dca7dff0ccdec08a (patch) | |
tree | 538e88fba811a15d8a9d74af4e86b82f8ed59480 /compiler/GHC/Stg/Syntax.hs | |
parent | 13d627bbd0bc3dd30d672de341aa7f471be0aa2c (diff) | |
download | haskell-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.hs | 17 |
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 |