[Guile-commits] 66/69: Start porting srfi-60 off the bad bignum interfaces

[Andy Wingo]

wingo pushed a commit to branch wip-inline-digits
in repository guile.

commit 76e6a4a0e9890bbc061c41840e95e5c08d8b4b03
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Fri Jan 7 12:07:44 2022 +0100

    Start porting srfi-60 off the bad bignum interfaces
    
    * libguile/integers.h:
    * libguile/integers.c (scm_integer_scan1_i):
    (scm_integer_scan1_z): New internal functions.
    * libguile/srfi-60.c (scm_srfi60_log2_binary_factors): Use scan1
    functions.
    (scm_srfi60_copy_bit): Use integers lib.
---
 libguile/integers.c | 19 ++++++++++++++++++
 libguile/integers.h |  3 +++
 libguile/srfi-60.c  | 57 +++++++++--------------------------------------------
 3 files changed, 31 insertions(+), 48 deletions(-)

diff --git a/libguile/integers.c b/libguile/integers.c
index f6d33a21c..520cc6dbb 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -3168,3 +3168,22 @@ scm_integer_inexact_sqrt_z (struct scm_bignum *k)
   double result = ldexp (sqrt (signif), expon / 2);
   return negative ? -result : result;
 }
+
+SCM
+scm_integer_scan1_i (scm_t_inum n)
+{
+  if (n == 0)
+    return SCM_I_MAKINUM (-1);
+  n = n ^ (n-1);  /* 1 bits for each low 0 and lowest 1 */
+  return scm_integer_logcount_i (n >> 1);
+}
+
+SCM
+scm_integer_scan1_z (struct scm_bignum *n)
+{
+  mpz_t zn;
+  alias_bignum_to_mpz (n, zn);
+  unsigned long pos = mpz_scan1 (zn, 0L);
+  scm_remember_upto_here_1 (n);
+  return ulong_to_scm (pos);
+}
diff --git a/libguile/integers.h b/libguile/integers.h
index 470d3ea54..a232eb8cc 100644
--- a/libguile/integers.h
+++ b/libguile/integers.h
@@ -227,6 +227,9 @@ SCM_INTERNAL SCM scm_integer_floor_sqrt_z (struct 
scm_bignum *k);
 SCM_INTERNAL double scm_integer_inexact_sqrt_i (scm_t_inum k);
 SCM_INTERNAL double scm_integer_inexact_sqrt_z (struct scm_bignum *k);
 
+SCM_INTERNAL SCM scm_integer_scan1_i (scm_t_inum n);
+SCM_INTERNAL SCM scm_integer_scan1_z (struct scm_bignum *n);
+
 
 
 #endif  /* SCM_INTEGERS_H */
diff --git a/libguile/srfi-60.c b/libguile/srfi-60.c
index 578106e8e..9ee0fed53 100644
--- a/libguile/srfi-60.c
+++ b/libguile/srfi-60.c
@@ -1,6 +1,6 @@
 /* srfi-60.c --- Integers as Bits
 
-   Copyright 2005-2006,2008,2010,2014,2018
+   Copyright 2005-2006,2008,2010,2014,2018,2022
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -29,6 +29,7 @@
 #include "eq.h"
 #include "extensions.h"
 #include "gsubr.h"
+#include "integers.h"
 #include "list.h"
 #include "numbers.h"
 #include "pairs.h"
@@ -52,19 +53,9 @@ SCM_DEFINE (scm_srfi60_log2_binary_factors, 
"log2-binary-factors", 1, 0, 0,
   SCM ret = SCM_EOL;
 
   if (SCM_I_INUMP (n))
-    {
-      long nn = SCM_I_INUM (n);
-      if (nn == 0)
-        return SCM_I_MAKINUM (-1);
-      nn = nn ^ (nn-1);  /* 1 bits for each low 0 and lowest 1 */
-      return scm_logcount (SCM_I_MAKINUM (nn >> 1));
-    }
+    return scm_integer_scan1_i (SCM_I_INUM (n));
   else if (SCM_BIGP (n))
-    {
-      /* no need for scm_remember_upto_here_1 here, mpz_scan1 doesn't do
-         anything that could result in a gc */
-      return SCM_I_MAKINUM (mpz_scan1 (SCM_I_BIG_MPZ (n), 0L));
-    }
+    return scm_integer_scan1_z (scm_bignum (n));
   else
     SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
 
@@ -85,7 +76,6 @@ SCM_DEFINE (scm_srfi60_copy_bit, "copy-bit", 3, 0, 0,
            "@end example")
 #define FUNC_NAME s_scm_srfi60_copy_bit
 {
-  SCM r;
   unsigned long ii;
   int bb;
 
@@ -94,47 +84,18 @@ SCM_DEFINE (scm_srfi60_copy_bit, "copy-bit", 3, 0, 0,
 
   if (SCM_I_INUMP (n))
     {
-      long nn = SCM_I_INUM (n);
-
-      /* can't set high bit ii==SCM_LONG_BIT-1, that would change the sign,
-         which is not what's wanted */
-      if (ii < SCM_LONG_BIT-1)
-        {
-          nn &= ~(1L << ii);  /* zap bit at index */
-          nn |= ((long) bb << ii);   /* insert desired bit */
-          return scm_from_long (nn);
-        }
-      else
-        {
-          /* bits at ii==SCM_LONG_BIT-1 and above are all copies of the sign
-             bit, if this is already the desired "bit" value then no need to
-             make a new bignum value */
-          if (bb == (nn < 0))
-            return n;
-
-          r = scm_i_long2big (nn);
-          goto big;
-        }
+      if (scm_integer_logbit_ui (ii, SCM_I_INUM (n)) == bb)
+        return n;
     }
   else if (SCM_BIGP (n))
     {
-      /* if the bit is already what's wanted then no need to make a new
-         bignum */
-      if (bb == mpz_tstbit (SCM_I_BIG_MPZ (n), ii))
+      if (scm_integer_logbit_uz (ii, scm_bignum (n)) == bb)
         return n;
-
-      r = scm_i_clonebig (n, 1);
-    big:
-      if (bb)
-        mpz_setbit (SCM_I_BIG_MPZ (r), ii);
-      else
-        mpz_clrbit (SCM_I_BIG_MPZ (r), ii);
-
-      /* changing a high bit might put the result into range of a fixnum */
-      return scm_i_normbig (r);
     }
   else
     SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
+
+  return scm_logxor (n, ii == 0 ? SCM_INUM1 : scm_integer_lsh_iu (1, ii));
 }
 #undef FUNC_NAME