
Hello Haskellers, Does anyone know how to call popCnt64# from the GHC.Prim module? This was my failed attempt: λ> popCnt64# 1 <interactive>:14:11: Couldn't match kind ‘*’ with ‘#’ When matching types a0 :: * Word# :: # Expected type: Integer -> Word# Actual type: Integer -> a0 In the first argument of ‘popCnt64#’, namely ‘1’ In the expression: popCnt64# 1 In an equation for ‘it’: it = popCnt64# 1 -John

Here's an example:
{-# LANGUAGE MagicHash #-}
import GHC.Prim
import GHC.Types
import Data.Word
main :: IO ()
main = do
let word = 5 :: Word
res =
case word of
W# w -> W# (popCnt64# w)
print res
On Sun, Mar 20, 2016 at 12:19 PM, John Ky
Hello Haskellers,
Does anyone know how to call popCnt64# from the GHC.Prim module?
This was my failed attempt:
λ> popCnt64# 1
<interactive>:14:11: Couldn't match kind ‘*’ with ‘#’ When matching types a0 :: * Word# :: # Expected type: Integer -> Word# Actual type: Integer -> a0 In the first argument of ‘popCnt64#’, namely ‘1’ In the expression: popCnt64# 1 In an equation for ‘it’: it = popCnt64# 1
-John
_______________________________________________ Beginners mailing list Beginners@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners

Hi Michael,
Yes, that did the trick.
Thanks!
-John
On Mon, 21 Mar 2016 at 01:13 Michael Snoyman
Here's an example:
{-# LANGUAGE MagicHash #-} import GHC.Prim import GHC.Types import Data.Word
main :: IO () main = do let word = 5 :: Word res = case word of W# w -> W# (popCnt64# w) print res
On Sun, Mar 20, 2016 at 12:19 PM, John Ky
wrote: Hello Haskellers,
Does anyone know how to call popCnt64# from the GHC.Prim module?
This was my failed attempt:
λ> popCnt64# 1
<interactive>:14:11: Couldn't match kind ‘*’ with ‘#’ When matching types a0 :: * Word# :: # Expected type: Integer -> Word# Actual type: Integer -> a0 In the first argument of ‘popCnt64#’, namely ‘1’ In the expression: popCnt64# 1 In an equation for ‘it’: it = popCnt64# 1
-John
_______________________________________________ Beginners mailing list Beginners@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
_______________________________________________ Beginners mailing list Beginners@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners

Hi, In general, the problem is that GHCi is attempting to call `show` on the results of expressions you type in, but `show` (like any other polymorphic function; though you can look into "levity polymorphism" if you want to know more) can only accept values of types of kind * (boxed, lifted) - so it can print Word, but not Word#. If you wanted to stay in GHCi, you can do it like: Prelude> import GHC.Prim Prelude GHC.Prim> import GHC.Types Prelude GHC.Prim GHC.Types> :set -XMagicHash Prelude GHC.Prim GHC.Types> :t W# W# :: Word# -> Word Prelude GHC.Prim GHC.Types> :t popCnt64# popCnt64# :: Word# -> Word# Prelude GHC.Prim GHC.Types> let foo = (1 :: Word) Prelude GHC.Prim GHC.Types> :set -XBangPatterns Prelude GHC.Prim GHC.Types> let !(W# w) = foo in W# (popCnt64# w) 1 Best regards, Marcin Mrotek

Hi Marcin,
That explanation helps. Thanks!
-John
On Tue, 22 Mar 2016 at 18:25 Marcin Mrotek
Hi,
In general, the problem is that GHCi is attempting to call `show` on the results of expressions you type in, but `show` (like any other polymorphic function; though you can look into "levity polymorphism" if you want to know more) can only accept values of types of kind * (boxed, lifted) - so it can print Word, but not Word#.
If you wanted to stay in GHCi, you can do it like:
Prelude> import GHC.Prim Prelude GHC.Prim> import GHC.Types Prelude GHC.Prim GHC.Types> :set -XMagicHash Prelude GHC.Prim GHC.Types> :t W# W# :: Word# -> Word Prelude GHC.Prim GHC.Types> :t popCnt64# popCnt64# :: Word# -> Word# Prelude GHC.Prim GHC.Types> let foo = (1 :: Word) Prelude GHC.Prim GHC.Types> :set -XBangPatterns Prelude GHC.Prim GHC.Types> let !(W# w) = foo in W# (popCnt64# w) 1
Best regards, Marcin Mrotek _______________________________________________ Beginners mailing list Beginners@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
participants (3)
-
John Ky
-
Marcin Mrotek
-
Michael Snoyman