mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Implement scm_logtest with new integer library

Browse source 
* libguile/integers.c (scm_integer_logtest_ii, scm_integer_logtest_zi)
(scm_integer_logtest_zz): New internal functions.
* libguile/integers.h: Declare the new internal functions.
* libguile/numbers.c (scm_logtest): Use new internal functions.
This commit is contained in:
Andy Wingo 2021-12-19 10:54:47 +01:00
parent 459163fca1
commit 6298d73115
3 changed files with 28 additions and 39 deletions
Download patch file Download diff file Expand all files Collapse all files

19
libguile/integers.c
View file

@ -27,6 +27,7 @@
#include <stdio.h> #include <stdio.h>
#include <verify.h> #include <verify.h>
#include "boolean.h"
#include "numbers.h" #include "numbers.h"
#include "integers.h" #include "integers.h"
@ -1989,3 +1990,21 @@ scm_integer_logxor_zz (SCM x, SCM y)
scm_remember_upto_here_2 (x, y); scm_remember_upto_here_2 (x, y);
return take_mpz (result); return take_mpz (result);
} }
int
scm_integer_logtest_ii (scm_t_inum x, scm_t_inum y)
{
return (x & y) ? 1 : 0;
}
int
scm_integer_logtest_zi (SCM x, scm_t_inum y)
{
return scm_is_eq (scm_integer_logand_zi (x, y), SCM_INUM0);
}
int
scm_integer_logtest_zz (SCM x, SCM y)
{
return scm_is_eq (scm_integer_logand_zz (x, y), SCM_INUM0);
}

4
libguile/integers.h
View file

@ -144,6 +144,10 @@ SCM_INTERNAL SCM scm_integer_logxor_ii (scm_t_inum x, scm_t_inum y);
SCM_INTERNAL SCM scm_integer_logxor_zi (SCM x, scm_t_inum y); SCM_INTERNAL SCM scm_integer_logxor_zi (SCM x, scm_t_inum y);
SCM_INTERNAL SCM scm_integer_logxor_zz (SCM x, SCM y); SCM_INTERNAL SCM scm_integer_logxor_zz (SCM x, SCM y);
SCM_INTERNAL int scm_integer_logtest_ii (scm_t_inum x, scm_t_inum y);
SCM_INTERNAL int scm_integer_logtest_zi (SCM x, scm_t_inum y);
SCM_INTERNAL int scm_integer_logtest_zz (SCM x, SCM y);
#endif /* SCM_INTEGERS_H */ #endif /* SCM_INTEGERS_H */

44
libguile/numbers.c
View file

@ -3112,56 +3112,22 @@ SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0,
"@end lisp") "@end lisp")
#define FUNC_NAME s_scm_logtest #define FUNC_NAME s_scm_logtest
{ {
scm_t_inum nj;
if (SCM_I_INUMP (j)) if (SCM_I_INUMP (j))
{ {
nj = SCM_I_INUM (j);
if (SCM_I_INUMP (k)) if (SCM_I_INUMP (k))
{ return scm_from_bool (scm_integer_logtest_ii (SCM_I_INUM (j),
scm_t_inum nk = SCM_I_INUM (k); SCM_I_INUM (k)));
return scm_from_bool (nj & nk);
}
else if (SCM_BIGP (k)) else if (SCM_BIGP (k))
{ return scm_from_bool (scm_integer_logtest_zi (k, SCM_I_INUM (j)));
intbig:
if (nj == 0)
return SCM_BOOL_F;
{
SCM result;
mpz_t nj_z;
mpz_init_set_si (nj_z, nj);
mpz_and (nj_z, nj_z, SCM_I_BIG_MPZ (k));
scm_remember_upto_here_1 (k);
result = scm_from_bool (mpz_sgn (nj_z) != 0);
mpz_clear (nj_z);
return result;
}
}
else else
SCM_WRONG_TYPE_ARG (SCM_ARG2, k); SCM_WRONG_TYPE_ARG (SCM_ARG2, k);
} }
else if (SCM_BIGP (j)) else if (SCM_BIGP (j))
{ {
if (SCM_I_INUMP (k)) if (SCM_I_INUMP (k))
{ return scm_from_bool (scm_integer_logtest_zi (j, SCM_I_INUM (k)));
SCM_SWAP (j, k);
nj = SCM_I_INUM (j);
goto intbig;
}
else if (SCM_BIGP (k)) else if (SCM_BIGP (k))
{ return scm_from_bool (scm_integer_logtest_zz (j, k));
SCM result;
mpz_t result_z;
mpz_init (result_z);
mpz_and (result_z,
SCM_I_BIG_MPZ (j),
SCM_I_BIG_MPZ (k));
scm_remember_upto_here_2 (j, k);
result = scm_from_bool (mpz_sgn (result_z) != 0);
mpz_clear (result_z);
return result;
}
else else
SCM_WRONG_TYPE_ARG (SCM_ARG2, k); SCM_WRONG_TYPE_ARG (SCM_ARG2, k);
} }