[GHC] #14742: Unboxed sums can treat Word#s as Int#s (was: Unboxed sums can treat Int#s as Word#s)
GHC
ghc-devs at haskell.org
Tue Jan 30 21:00:52 UTC 2018
#14742: Unboxed sums can treat Word#s as Int#s
-------------------------------------+-------------------------------------
Reporter: duog | Owner: (none)
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 8.2.2
Resolution: | Keywords: UnboxedSums
Operating System: Unknown/Multiple | Architecture:
| Unknown/Multiple
Type of failure: None/Unknown | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Description changed by duog:
Old description:
> Consider the following module:
> {{{
> {-# language MagicHash, UnboxedSums #-}
>
> {-# options_ghc -ddump-stg -dppr-debug -fprint-explicit-kinds -ddump-to-
> file #-}
>
> module Bug where
> import GHC.Prim
> import GHC.Types
>
> mkUnboxedSum :: () -> (# Float# | Int# #)
> mkUnboxedSum _ = (# | 9# #)
> {-# noinline mkUnboxedSum #-}
>
> foo :: Int
> foo = case mkUnboxedSum () of
> (# | i# #) -> I# i#
> (# f# | #) -> 8
> }}}
>
> The full .dump-stg is attached. An abbreviation of the case statement in
> foo is:
> {{{
> case (...)
> of
> (...)
> { ghc-prim:GHC.Prim.(#,,#){(w) d 89} ((us_g1h9{v} [lid] :: ghc-
> prim:GHC.Types.Any{(w) tc 35K}
> (ghc-prim:GHC.Prim.TYPE{(w) tc 32Q}
> 'ghc-prim:GHC.Types.WordRep{(w) d 63J}))
> :: ghc-
> prim:GHC.Types.Any{(w) tc 35K}
> (ghc-
> prim:GHC.Prim.TYPE{(w) tc 32Q}
> 'ghc-
> prim:GHC.Types.WordRep{(w) d 63J}))
> ((us_g1ha{v} [lid] :: ghc-
> prim:GHC.Types.Any{(w) tc 35K}
> (ghc-prim:GHC.Prim.TYPE{(w) tc 32Q}
> 'ghc-prim:GHC.Types.WordRep{(w) d 63J}))
> :: ghc-
> prim:GHC.Types.Any{(w) tc 35K}
> (ghc-
> prim:GHC.Prim.TYPE{(w) tc 32Q}
> 'ghc-
> prim:GHC.Types.WordRep{(w) d 63J}))
> ((us_g1hb{v} [lid] :: ghc-
> prim:GHC.Types.Any{(w) tc 35K}
> (ghc-prim:GHC.Prim.TYPE{(w) tc 32Q}
> 'ghc-prim:GHC.Types.FloatRep{(w) d 63V}))
> :: ghc-
> prim:GHC.Types.Any{(w) tc 35K}
> (ghc-
> prim:GHC.Prim.TYPE{(w) tc 32Q}
> 'ghc-
> prim:GHC.Types.FloatRep{(w) d 63V})) ->
> case
> (us_g1h9{v} [lid] :: ghc-prim:GHC.Types.Any{(w) tc 35K}
> (ghc-prim:GHC.Prim.TYPE{(w) tc
> 32Q}
> 'ghc-
> prim:GHC.Types.WordRep{(w) d 63J})) :: Prim IntRep
> of
> ((tag_g1hc{v} [lid] :: ghc-prim:GHC.Prim.Int#{(w) tc 3s})
> :: ghc-prim:GHC.Prim.Int#{(w) tc 3s})
> { __DEFAULT -> ghc-prim:GHC.Types.I#{(w) d 6i} [8#];
> 2# ->
> ghc-prim:GHC.Types.I#{(w) d 6i} [(us_g1ha{v} [lid] ::
> ghc-prim:GHC.Types.Any{(w) tc 35K}
> (ghc-prim:GHC.Prim.TYPE{(w) tc 32Q}
> 'ghc-prim:GHC.Types.WordRep{(w) d 63J}))];
> };
> }}}
>
> Note that:
> * `us_g1h9 :: Any (TYPE WordRep)`;
> * `us_g1ha :: Any (Type WordRep)`;
> * `tag_g1hc :: Int#`;
> * The `2#` alternative passes `us_g1ha` to an `I#` constructor.
>
> This seems wrong to me.
>
> It comes about because `slotPrimRep . primRepSlot` (in RepType) is not
> the identity.
>
> StgLint found this while I was working on ticket:14541
New description:
Consider the following module:
{{{
{-# language MagicHash, UnboxedSums #-}
{-# options_ghc -ddump-stg -dppr-debug -fprint-explicit-kinds -ddump-to-
file #-}
module Bug where
import GHC.Prim
import GHC.Types
mkUnboxedSum :: () -> (# Float# | Int# #)
mkUnboxedSum _ = (# | 9# #)
{-# noinline mkUnboxedSum #-}
foo :: Int
foo = case mkUnboxedSum () of
(# | i# #) -> I# i#
(# f# | #) -> 8
}}}
The full .dump-stg is attached. An abbreviation of the case statement in
foo is:
{{{
case (...)
of
(...)
{ ghc-prim:GHC.Prim.(#,,#){(w) d 89} ((us_g1h9{v} [lid] :: ghc-
prim:GHC.Types.Any{(w) tc 35K}
(ghc-
prim:GHC.Prim.TYPE{(w) tc 32Q}
'ghc-prim:GHC.Types.WordRep{(w) d 63J}))
:: ghc-
prim:GHC.Types.Any{(w) tc 35K}
(ghc-
prim:GHC.Prim.TYPE{(w) tc 32Q}
'ghc-
prim:GHC.Types.WordRep{(w) d 63J}))
((us_g1ha{v} [lid] :: ghc-
prim:GHC.Types.Any{(w) tc 35K}
(ghc-
prim:GHC.Prim.TYPE{(w) tc 32Q}
'ghc-prim:GHC.Types.WordRep{(w) d 63J}))
:: ghc-
prim:GHC.Types.Any{(w) tc 35K}
(ghc-
prim:GHC.Prim.TYPE{(w) tc 32Q}
'ghc-
prim:GHC.Types.WordRep{(w) d 63J}))
((us_g1hb{v} [lid] :: ghc-
prim:GHC.Types.Any{(w) tc 35K}
(ghc-
prim:GHC.Prim.TYPE{(w) tc 32Q}
'ghc-prim:GHC.Types.FloatRep{(w) d 63V}))
:: ghc-
prim:GHC.Types.Any{(w) tc 35K}
(ghc-
prim:GHC.Prim.TYPE{(w) tc 32Q}
'ghc-
prim:GHC.Types.FloatRep{(w) d 63V})) ->
case
(us_g1h9{v} [lid] :: ghc-prim:GHC.Types.Any{(w) tc 35K}
(ghc-prim:GHC.Prim.TYPE{(w) tc
32Q}
'ghc-
prim:GHC.Types.WordRep{(w) d 63J})) :: Prim IntRep
of
((tag_g1hc{v} [lid] :: ghc-prim:GHC.Prim.Int#{(w) tc 3s})
:: ghc-prim:GHC.Prim.Int#{(w) tc 3s})
{ __DEFAULT -> ghc-prim:GHC.Types.I#{(w) d 6i} [8#];
2# ->
ghc-prim:GHC.Types.I#{(w) d 6i} [(us_g1ha{v} [lid] ::
ghc-prim:GHC.Types.Any{(w) tc 35K}
(ghc-prim:GHC.Prim.TYPE{(w) tc 32Q}
'ghc-prim:GHC.Types.WordRep{(w) d 63J}))];
};
}}}
Note that:
* `us_g1h9 :: Any (TYPE WordRep)`;
* `us_g1ha :: Any (TYPE WordRep)`;
* `tag_g1hc :: Int#`;
* The `2#` alternative passes `us_g1ha` to an `I#` constructor.
This seems wrong to me.
It comes about because `slotPrimRep . primRepSlot` (in RepType) is not the
identity.
StgLint found this while I was working on ticket:14541
--
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14742#comment:1>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list