[commit: ghc] master: Use isTrue# around primitive comparisons in integer-gmp (7e70c06)

git at git.haskell.org git at git.haskell.org
Sun Jul 26 03:34:22 UTC 2015


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/7e70c063ad88052ca5f2586eb07e5d1571956acd/ghc

>---------------------------------------------------------------

commit 7e70c063ad88052ca5f2586eb07e5d1571956acd
Author: Reid Barton <rwbarton at gmail.com>
Date:   Sat Jul 25 23:00:52 2015 -0400

    Use isTrue# around primitive comparisons in integer-gmp
    
    Summary:
    The form
      case na# ==# nb# of
        0# -> ...
        _  -> ...
    sometimes generates convoluted assembly, see #10676.
    timesInt2Integer was the most spectacular offender, especially as
    it is a rather cheap function overall (no calls to gmp).
    
    I checked a few instances and some of the old generated assembly
    was fine already, but I changed them all for consistency. The new
    form is also more consistent with use of these primops in general.
    
    Test Plan: validate
    
    Reviewers: hvr, bgamari, goldfire, austin
    
    Reviewed By: hvr
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D1094


>---------------------------------------------------------------

7e70c063ad88052ca5f2586eb07e5d1571956acd
 libraries/integer-gmp/src/GHC/Integer/Type.hs | 60 +++++++++++++--------------
 1 file changed, 30 insertions(+), 30 deletions(-)

diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs
index 5670bb4..88d1923 100644
--- a/libraries/integer-gmp/src/GHC/Integer/Type.hs
+++ b/libraries/integer-gmp/src/GHC/Integer/Type.hs
@@ -460,23 +460,23 @@ sqrInteger (Jn# bn) = Jp# (sqrBigNat bn)
 
 -- | Construct 'Integer' from the product of two 'Int#'s
 timesInt2Integer :: Int# -> Int# -> Integer
-timesInt2Integer x# y# = case (# x# >=# 0#, y# >=# 0# #) of
-    (# 0#, 0# #) -> case timesWord2# (int2Word# (negateInt# x#))
+timesInt2Integer x# y# = case (# isTrue# (x# >=# 0#), isTrue# (y# >=# 0#) #) of
+    (# False, False #) -> case timesWord2# (int2Word# (negateInt# x#))
                                      (int2Word# (negateInt# y#)) of
         (# 0##,l #) -> inline wordToInteger l
         (# h  ,l #) -> Jp# (wordToBigNat2 h l)
 
-    (#  _, 0# #) -> case timesWord2# (int2Word# x#)
+    (#  True, False #) -> case timesWord2# (int2Word# x#)
                                      (int2Word# (negateInt# y#)) of
         (# 0##,l #) -> wordToNegInteger l
         (# h  ,l #) -> Jn# (wordToBigNat2 h l)
 
-    (# 0#,  _ #) -> case timesWord2# (int2Word# (negateInt# x#))
+    (# False,  True #) -> case timesWord2# (int2Word# (negateInt# x#))
                                      (int2Word# y#) of
         (# 0##,l #) -> wordToNegInteger l
         (# h  ,l #) -> Jn# (wordToBigNat2 h l)
 
-    (#  _,  _ #) -> case timesWord2# (int2Word# x#)
+    (#  True,  True #) -> case timesWord2# (int2Word# x#)
                                      (int2Word# y#) of
         (# 0##,l #) -> inline wordToInteger l
         (# h  ,l #) -> Jp# (wordToBigNat2 h l)
@@ -1104,9 +1104,9 @@ orBigNat x@(BN# x#) y@(BN# y#)
     ior' a# na# b# nb# = do -- na >= nb
         mbn@(MBN# mba#) <- newBigNat# na#
         _ <- liftIO (c_mpn_ior_n mba# a# b# nb#)
-        _ <- case na# ==# nb# of
-            0# -> svoid (copyWordArray# a# nb# mba# nb# (na# -# nb#))
-            _  -> return ()
+        _ <- case isTrue# (na# ==# nb#) of
+            False -> svoid (copyWordArray# a# nb# mba# nb# (na# -# nb#))
+            True  -> return ()
         unsafeFreezeBigNat# mbn
 
     nx# = sizeofBigNat# x
@@ -1123,10 +1123,10 @@ xorBigNat x@(BN# x#) y@(BN# y#)
     xor' a# na# b# nb# = do -- na >= nb
         mbn@(MBN# mba#) <- newBigNat# na#
         _ <- liftIO (c_mpn_xor_n mba# a# b# nb#)
-        case na# ==# nb# of
-            0# -> do _ <- svoid (copyWordArray# a# nb# mba# nb# (na# -# nb#))
-                     unsafeFreezeBigNat# mbn
-            _  -> unsafeRenormFreezeBigNat# mbn
+        case isTrue# (na# ==# nb#) of
+            False -> do _ <- svoid (copyWordArray# a# nb# mba# nb# (na# -# nb#))
+                        unsafeFreezeBigNat# mbn
+            True  -> unsafeRenormFreezeBigNat# mbn
 
     nx# = sizeofBigNat# x
     ny# = sizeofBigNat# y
@@ -1139,9 +1139,9 @@ andnBigNat x@(BN# x#) y@(BN# y#)
   | True = runS $ do
       mbn@(MBN# mba#) <- newBigNat# nx#
       _ <- liftIO (c_mpn_andn_n mba# x# y# n#)
-      _ <- case nx# ==# n# of
-            0# -> svoid (copyWordArray# x# n# mba# n# (nx# -# n#))
-            _  -> return ()
+      _ <- case isTrue# (nx# ==# n#) of
+            False -> svoid (copyWordArray# x# n# mba# n# (nx# -# n#))
+            True  -> return ()
       unsafeRenormFreezeBigNat# mbn
   where
     n# | isTrue# (nx# <# ny#) = nx#
@@ -1249,9 +1249,9 @@ gcdBigNat x@(BN# x#) y@(BN# y#)
         mbn@(MBN# mba#) <- newBigNat# nb#
         I# rn'# <- liftIO (c_mpn_gcd# mba# a# na# b# nb#)
         let rn# = narrowGmpSize# rn'#
-        case rn# ==# nb# of
-            0# -> unsafeShrinkFreezeBigNat# mbn rn#
-            _  -> unsafeFreezeBigNat# mbn
+        case isTrue# (rn# ==# nb#) of
+            False -> unsafeShrinkFreezeBigNat# mbn rn#
+            True  -> unsafeFreezeBigNat# mbn
 
     nx# = sizeofBigNat# x
     ny# = sizeofBigNat# y
@@ -1284,9 +1284,9 @@ gcdExtSBigNat x y = case runS go of (g,s) -> (# g, s #)
             sn#  = absI# ssn#
         s' <- unsafeShrinkFreezeBigNat# s sn#
         g' <- unsafeRenormFreezeBigNat# g
-        case ssn# >=# 0# of
-            0# -> return ( g', NegBN s' )
-            _  -> return ( g', PosBN s' )
+        case isTrue# (ssn# >=# 0#) of
+            False -> return ( g', NegBN s' )
+            True  -> return ( g', PosBN s' )
 
     !(BN# x#) = absSBigNat x
     !(BN# y#) = absSBigNat y
@@ -1351,9 +1351,9 @@ powModSBigNat b e m@(BN# m#) = runS $ do
     r@(MBN# r#) <- newBigNat# mn#
     I# rn_# <- liftIO (integer_gmp_powm# r# b# bn# e# en# m# mn#)
     let rn# = narrowGmpSize# rn_#
-    case rn# ==# mn# of
-        0# -> unsafeShrinkFreezeBigNat# r rn#
-        _  -> unsafeFreezeBigNat# r
+    case isTrue# (rn# ==# mn#) of
+        False -> unsafeShrinkFreezeBigNat# r rn#
+        True  -> unsafeFreezeBigNat# r
   where
     !(BN# b#) = absSBigNat b
     !(BN# e#) = absSBigNat e
@@ -1413,9 +1413,9 @@ recipModSBigNat x m@(BN# m#) = runS $ do
     r@(MBN# r#) <- newBigNat# mn#
     I# rn_# <- liftIO (integer_gmp_invert# r# x# xn# m# mn#)
     let rn# = narrowGmpSize# rn_#
-    case rn# ==# mn# of
-        0# -> unsafeShrinkFreezeBigNat# r rn#
-        _  -> unsafeFreezeBigNat# r
+    case isTrue# (rn# ==# mn#) of
+        False -> unsafeShrinkFreezeBigNat# r rn#
+        True  -> unsafeFreezeBigNat# r
   where
     !(BN# x#) = absSBigNat x
     xn# = ssizeofSBigNat# x
@@ -1850,9 +1850,9 @@ isValidBigNat# :: BigNat -> Int#
 isValidBigNat# (BN# ba#)
   = (szq# ># 0#) `andI#` (szr# ==# 0#) `andI#` isNorm#
   where
-    isNorm# = case szq# ># 1# of
-                1# -> (indexWordArray# ba# (szq# -# 1#)) `neWord#` 0##
-                _  -> 1#
+    isNorm#
+      | isTrue# (szq# ># 1#) = (indexWordArray# ba# (szq# -# 1#)) `neWord#` 0##
+      | True                 = 1#
 
     sz# = sizeofByteArray# ba#
 



More information about the ghc-commits mailing list