Pepare to GHC 7.8

Author: knsd

cbits/gmp-extras.cmm

@@ -1,3 +1,70 @@
+#if __GLASGOW_HASKELL__ >= 707
+#include "Cmm.h"
+#include "GmpDerivedConstants.h"
+
+// TODO(superbobry): in the future release the syntax for calling
+// foreign funcations will CHANGE.
+
+import "integer-gmp" __gmpz_init_set;
+import "integer-gmp" __gmpz_popcount;
+import "integer-gmp" __gmpz_setbit;
+import "integer-gmp" __gmpz_clrbit;
+
+#define GMP_TAKE1_UL1_RET1(name,mp_fun)                         \
+name (W_ ws1, P_ d1, W_ wul)                                    \
+{                                                               \
+  CInt s1;                                                      \
+  CLong ul;                                                     \
+  W_ mp_tmp;                                                    \
+  W_ mp_result;                                                 \
+                                                                \
+  /* call doYouWantToGC() */                                    \
+again:                                                          \
+  STK_CHK_GEN_N (2 * SIZEOF_MP_INT);                            \
+  MAYBE_GC(again);                                              \
+                                                                \
+  s1 = W_TO_INT(ws1);                                           \
+  ul = W_TO_LONG(wul);                                          \
+                                                                \
+  mp_tmp     = Sp - 1 * SIZEOF_MP_INT;                          \
+  mp_result  = Sp - 2 * SIZEOF_MP_INT;                          \
+  MP_INT__mp_alloc(mp_tmp) = W_TO_INT(BYTE_ARR_WDS(d1));        \
+  MP_INT__mp_size(mp_tmp)  = (s1);                              \
+  MP_INT__mp_d(mp_tmp)     = BYTE_ARR_CTS(d1);                  \
+                                                                \
+  ccall __gmpz_init_set(mp_result "ptr", mp_tmp "ptr");         \
+                                                                \
+  /* Perform the operation */                                   \
+  ccall mp_fun(mp_result "ptr", ul);                            \
+                                                                \
+  return(TO_W_(MP_INT__mp_size(mp_result)),                     \
+         MP_INT__mp_d(mp_result) - SIZEOF_StgArrWords);         \
+}
+
+GMP_TAKE1_UL1_RET1(integer_cmm_setBitIntegerzh,   __gmpz_setbit)
+GMP_TAKE1_UL1_RET1(integer_cmm_clearBitIntegerzh, __gmpz_clrbit)
+
+integer_cmm_popCountIntegerzh (W_ ws, W_ d)
+{
+  CInt s, res;
+  W_ mp_tmp;
+
+again:
+  STK_CHK_P_LL(SIZEOF_MP_INT, integer_cmm_popCountIntegerzh, R2);
+  MAYBE_GC(again);
+
+  s = W_TO_INT(ws);
+
+  mp_tmp = Sp - 1 * SIZEOF_MP_INT;
+  MP_INT__mp_alloc(mp_tmp) = W_TO_INT(BYTE_ARR_WDS(d));
+  MP_INT__mp_size(mp_tmp)  = (s);
+  MP_INT__mp_d(mp_tmp)     = BYTE_ARR_CTS(d);
+
+  (res) = foreign "C" __gmpz_popcount(mp_tmp "ptr");
+
+  return (TO_W_(res));
+}
+#else
 #include "Cmm.h"
 #include "GmpDerivedConstants.h"
 
@@ -89,3 +156,4 @@ integer_cmm_popCountIntegerzh
 
   RET_N(TO_W_(res));
 }
+#endif

src/GHC/Integer/GMP/TypeExt.hs

@@ -21,26 +21,32 @@ import GHC.Prim (Int#, (/=#), (>=#), (<#), (-#),
 import GHC.Integer.GMP.PrimExt (popCountInteger#, testBitInteger#,
                                 setBitInteger#, clearBitInteger#)
 
+#if __GLASGOW_HASKELL__ >= 707
+import GHC.Exts (isTrue#)
+#else
+isTrue# = id
+#endif
+
 popCountInteger :: Integer -> Int#
 popCountInteger (S# i)   = word2Int# (popCnt# (int2Word# i))
 popCountInteger (J# s d) = popCountInteger# s d
 {-# NOINLINE popCountInteger #-}
 
 testBitInteger :: Integer -> Int# -> Bool
 testBitInteger (S# j) i
-    | i <# 0# = False
-    | i <# (WORD_SIZE_IN_BITS# -# 1#) =
+    | isTrue# (i <# 0#) = False
+    | isTrue# (i <# (WORD_SIZE_IN_BITS# -# 1#)) =
         let !mask = 1# `uncheckedIShiftL#` i in
-        word2Int# (int2Word# j `and#` int2Word# mask) /=# 0#
+        isTrue# (word2Int# (int2Word# j `and#` int2Word# mask) /=# 0#)
     | otherwise =
         let !(# s, d #) = int2Integer# j in testBitInteger (J# s d) i
-testBitInteger (J# s d) i = testBitInteger# s d i /=# 0#
+testBitInteger (J# s d) i = isTrue# (testBitInteger# s d i /=# 0#)
 {-# NOINLINE testBitInteger #-}
 
 setBitInteger :: Integer -> Int# -> Integer
 setBitInteger (S# j) i
-    | i <# 0# = S# j
-    | i <# (WORD_SIZE_IN_BITS# -# 1#) =
+    | isTrue# (i <# 0#) = S# j
+    | isTrue# (i <# (WORD_SIZE_IN_BITS# -# 1#)) =
         let !mask = 1# `uncheckedIShiftL#` i in
         S# (word2Int# (int2Word# j `or#` int2Word# mask))
     | otherwise =
@@ -51,12 +57,12 @@ setBitInteger (J# s d) i =
 
 clearBitInteger :: Integer -> Int# -> Integer
 clearBitInteger (S# j) i
-    | i <# 0# || i >=# (WORD_SIZE_IN_BITS# -# 1#) = S# j
+    | isTrue# (i <# 0#) || isTrue# (i >=# (WORD_SIZE_IN_BITS# -# 1#)) = S# j
     | otherwise =
         let !mask =
                 int2Word# (1# `uncheckedIShiftL#` i) `xor#`
                 int2Word# (negateInt# 1#)
         in S# (word2Int# (int2Word# j `and#` mask))
 clearBitInteger (J# s d) i =
     let !(# s', d' #) = clearBitInteger# s d i in J# s' d'
-{-# NOINLINE clearBitInteger #-}
+{-# NOINLINE clearBitInteger #-}