mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 17:50:29 +02:00
Code Activity

VM calls =? through intrinsic

Browse source 
* libguile/intrinsics.c (numerically_equal_p): New intrinsic.
* libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS): Declare new
  intrinsic.
* libguile/vm-engine.c (=?): Call through intrinsic.
This commit is contained in:
Andy Wingo 2018-05-08 14:16:02 +02:00
parent 0a8a7e9fd0
commit 007fcf699f
3 changed files with 9 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

7
libguile/intrinsics.c
View file

@ -214,6 +214,12 @@ less_p (SCM a, SCM b)
return SCM_F_COMPARE_NONE; return SCM_F_COMPARE_NONE;
} }
static int
numerically_equal_p (SCM a, SCM b)
{
return scm_is_true (scm_num_eq_p (a, b));
}
void void
scm_bootstrap_intrinsics (void) scm_bootstrap_intrinsics (void)
{ {
@ -255,6 +261,7 @@ scm_bootstrap_intrinsics (void)
scm_vm_intrinsics.rsh_immediate = rsh_immediate; scm_vm_intrinsics.rsh_immediate = rsh_immediate;
scm_vm_intrinsics.heap_numbers_equal_p = scm_i_heap_numbers_equal_p; scm_vm_intrinsics.heap_numbers_equal_p = scm_i_heap_numbers_equal_p;
scm_vm_intrinsics.less_p = less_p; scm_vm_intrinsics.less_p = less_p;
scm_vm_intrinsics.numerically_equal_p = numerically_equal_p;
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
"scm_init_intrinsics", "scm_init_intrinsics",

1
libguile/intrinsics.h
View file

@ -81,6 +81,7 @@ typedef enum scm_compare (*scm_t_compare_from_scm_scm_intrinsic) (SCM, SCM);
M(scm_from_scm_uimm, rsh_immediate, "rsh/immediate", RSH_IMMEDIATE) \ M(scm_from_scm_uimm, rsh_immediate, "rsh/immediate", RSH_IMMEDIATE) \
M(bool_from_scm_scm, heap_numbers_equal_p, "heap-numbers-equal?", HEAP_NUMBERS_EQUAL_P) \ M(bool_from_scm_scm, heap_numbers_equal_p, "heap-numbers-equal?", HEAP_NUMBERS_EQUAL_P) \
M(compare_from_scm_scm, less_p, "<?", LESS_P) \ M(compare_from_scm_scm, less_p, "<?", LESS_P) \
M(bool_from_scm_scm, numerically_equal_p, "=?", NUMERICALLY_EQUAL_P) \
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */ /* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
enum scm_vm_intrinsic enum scm_vm_intrinsic

2
libguile/vm-engine.c
View file

@ -2879,7 +2879,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
y = SP_REF (b); y = SP_REF (b);
SYNC_IP (); SYNC_IP ();
if (scm_is_true (scm_num_eq_p (x, y))) if (scm_vm_intrinsics.numerically_equal_p (x, y))
vp->compare_result = SCM_F_COMPARE_EQUAL; vp->compare_result = SCM_F_COMPARE_EQUAL;
else else
vp->compare_result = SCM_F_COMPARE_NONE; vp->compare_result = SCM_F_COMPARE_NONE;