Define instance MulHi {Int,Word}64 even on 32-bit arch

Bodigrim · Nov 12, 2023 · 78cf851 · 78cf851
1 parent 2ef3523
commit 78cf851
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 16 deletions.
diff --git a/src/Numeric/QuoteQuot.hs b/src/Numeric/QuoteQuot.hs
@@ -118,10 +118,11 @@ instance MulHi Word16 where
 instance MulHi Word32 where
   mulHi x y = fromIntegral ((fromIntegral x * fromIntegral y :: Word64) `shiftR` 32)
 
-#if WORD_SIZE_IN_BITS == 64
+-- | This instance is not efficient on 32-bit architecture.
 instance MulHi Word64 where
-  mulHi x y = fromIntegral (fromIntegral x `mulHi` fromIntegral y :: Word)
-#endif
+  mulHi x y
+    | finiteBitSize x == 64 = fromIntegral (fromIntegral x `mulHi` fromIntegral y :: Word)
+    | otherwise = defaultMulHi x y
 
 instance MulHi Word where
   mulHi (W# x) (W# y) = let !(# hi, _ #) = timesWord2# x y in W# hi
@@ -135,10 +136,11 @@ instance MulHi Int16 where
 instance MulHi Int32 where
   mulHi x y = fromIntegral ((fromIntegral x * fromIntegral y :: Int64) `shiftR` 32)
 
-#if WORD_SIZE_IN_BITS == 64
+-- | This instance is not efficient on 32-bit architecture.
 instance MulHi Int64 where
-  mulHi x y = fromIntegral (fromIntegral x `mulHi` fromIntegral y :: Int)
-#endif
+  mulHi x y
+    | finiteBitSize x == 64 = fromIntegral (fromIntegral x `mulHi` fromIntegral y :: Int)
+    | otherwise = defaultMulHi x y
 
 instance MulHi Int where
   mulHi (I# x) (I# y) = let !(# _, hi, _ #) = timesInt2# x y in I# hi
@@ -189,7 +191,7 @@ interpretAST ast n = go ast
   where
     go = \case
       Arg       -> n
-      MulHi x k -> fromInteger $ (toInteger (go x) * toInteger k) `shiftR` finiteBitSize k
+      MulHi x k -> defaultMulHi (go x) k
       MulLo x k -> go x * k
       Add x y   -> go x + go y
       Sub x y   -> go x - go y
@@ -198,6 +200,9 @@ interpretAST ast n = go ast
       CmpGE x k -> if go x >= k then 1 else 0
       CmpLT x k -> if go x <  k then 1 else 0
 
+defaultMulHi :: (Integral a, FiniteBits a) => a -> a -> a
+defaultMulHi x y = fromInteger $ (toInteger x * toInteger y) `shiftR` finiteBitSize x
+
 -- | Embed 'AST' into Haskell expression.
 quoteAST ::
 #if MIN_VERSION_template_haskell(2,17,0)

diff --git a/tests/Test.hs b/tests/Test.hs
@@ -128,17 +128,12 @@ testQuotes = testGroup "Quotes"
   [ testGroup "Word8"  testQuotes(Word8)
   , testGroup "Word16" testQuotes(Word16)
   , testGroup "Word32" testQuotes(Word32)
-#if WORD_SIZE_IN_BITS == 64
   , testGroup "Word64" testQuotes(Word64)
-#endif
   , testGroup "Word"   testQuotes(Word)
-
   , testGroup "Int8"   testQuotes(Int8)
   , testGroup "Int16"  testQuotes(Int16)
   , testGroup "Int32"  testQuotes(Int32)
-#if WORD_SIZE_IN_BITS == 64
   , testGroup "Int64"  testQuotes(Int64)
-#endif
   , testGroup "Int"    testQuotes(Int)
   ]
 
@@ -148,16 +143,12 @@ testMulHi = testGroup "MulHi"
   , testGroup "Word8"   (mkTestsMulHi (Proxy @Word8))
   , testGroup "Word16"  (mkTestsMulHi (Proxy @Word16))
   , testGroup "Word32"  (mkTestsMulHi (Proxy @Word32))
-#if WORD_SIZE_IN_BITS == 64
   , testGroup "Word64"  (mkTestsMulHi (Proxy @Word64))
-#endif
   , testGroup "Int"     (mkTestsMulHi (Proxy @Int))
   , testGroup "Int8"    (mkTestsMulHi (Proxy @Int8))
   , testGroup "Int16"   (mkTestsMulHi (Proxy @Int16))
   , testGroup "Int32"   (mkTestsMulHi (Proxy @Int32))
-#if WORD_SIZE_IN_BITS == 64
   , testGroup "Int64"   (mkTestsMulHi (Proxy @Int64))
-#endif
   ]
 
 mkTestsMulHi