summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2021-10-27 17:29:25 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-10-29 16:58:35 -0400
commitb0a1ed5579a7e80b744d16b0d78d4968284787d9 (patch)
tree59da5f09e9cff1b49b18852f1ad5f85eceee2075
parent7b67724bd1e6237f843241506d9650ea6f27cee2 (diff)
downloadhaskell-b0a1ed5579a7e80b744d16b0d78d4968284787d9.tar.gz
Add test for T15547 (#15547)
Fix #15547
-rw-r--r--testsuite/tests/numeric/should_compile/T15547.hs30
-rw-r--r--testsuite/tests/numeric/should_compile/T15547.stderr43
-rw-r--r--testsuite/tests/numeric/should_compile/all.T1
3 files changed, 74 insertions, 0 deletions
diff --git a/testsuite/tests/numeric/should_compile/T15547.hs b/testsuite/tests/numeric/should_compile/T15547.hs
new file mode 100644
index 0000000000..2db1c4ee20
--- /dev/null
+++ b/testsuite/tests/numeric/should_compile/T15547.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module T15547 where
+
+import GHC.TypeNats
+import Data.Proxy
+import GHC.Word
+import GHC.Exts
+
+nat2Word# :: KnownNat n => Proxy# n -> Word#
+nat2Word# p = case fromIntegral (natVal' p) of
+ W# w -> w
+
+foo (# #) = nat2Word# (proxy# :: Proxy# 18)
+
+
+-- functions from the ticket
+fd (_ :: Proxy n) = nat2Word# (proxy# @(Div (n + 63) 64))
+
+fm (_ :: Proxy n) = nat2Word# (proxy# @(Mod (n - 1) 64 + 1))
+
+fp (_ :: Proxy n) = nat2Word# (proxy# @(2^(Mod (n + 63) 64 + 1)))
+
+d (# #) = fd (Proxy @137)
+m (# #) = fm (Proxy @137)
+p (# #) = fp (Proxy @137)
diff --git a/testsuite/tests/numeric/should_compile/T15547.stderr b/testsuite/tests/numeric/should_compile/T15547.stderr
new file mode 100644
index 0000000000..f7eea977bd
--- /dev/null
+++ b/testsuite/tests/numeric/should_compile/T15547.stderr
@@ -0,0 +1,43 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+ = {terms: 40, types: 100, coercions: 56, joins: 0/0}
+
+nat2Word#
+ = \ @n $dKnownNat _ ->
+ integerToWord#
+ (integerFromNatural
+ ($dKnownNat `cast` <Co:5> :: KnownNat n ~R# Natural))
+
+foo = \ _ -> 18##
+
+fd
+ = \ @n $dKnownNat _ ->
+ integerToWord#
+ (integerFromNatural
+ ($dKnownNat
+ `cast` <Co:13> :: KnownNat (Div (n + 63) 64) ~R# Natural))
+
+d = \ _ -> 3##
+
+fm
+ = \ @n $dKnownNat _ ->
+ integerToWord#
+ (integerFromNatural
+ ($dKnownNat
+ `cast` <Co:17> :: KnownNat (Mod (n - 1) 64 + 1) ~R# Natural))
+
+m = \ _ -> 9##
+
+fp
+ = \ @n $dKnownNat _ ->
+ integerToWord#
+ (integerFromNatural
+ ($dKnownNat
+ `cast` <Co:21> :: KnownNat (2 ^ (Mod (n + 63) 64 + 1))
+ ~R# Natural))
+
+p = \ _ -> 512##
+
+
+
diff --git a/testsuite/tests/numeric/should_compile/all.T b/testsuite/tests/numeric/should_compile/all.T
index 4bcccaa521..0c22811cc8 100644
--- a/testsuite/tests/numeric/should_compile/all.T
+++ b/testsuite/tests/numeric/should_compile/all.T
@@ -18,3 +18,4 @@ test('T19769', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-b
test('T20347', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques'])
test('T20448', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques'])
test('T19641', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques'])
+test('T15547', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-binds -dsuppress-uniques'])