Bnumberp support

diff --git a/src/comp.c b/src/comp.c
index 7bdf1a8615c6aad172a70438f75d4ea08b5e773a..fd7e7beda1e81dd2fd00faf34e866988a9e1feb2 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -504,6 +504,12 @@ emit_CONSP (gcc_jit_rvalue *obj)
   return emit_TAGGEDP (obj, Lisp_Cons);
 }
 
+static gcc_jit_rvalue *
+emit_FLOATP (gcc_jit_rvalue *obj)
+{
+  return emit_TAGGEDP (obj, Lisp_Float);
+}
+
 static gcc_jit_rvalue *
 emit_BIGNUMP (gcc_jit_rvalue *obj)
 {
@@ -592,6 +598,18 @@ emit_INTEGERP (gcc_jit_rvalue *obj)
                                        emit_BIGNUMP (obj));
 }
 
+static gcc_jit_rvalue *
+emit_NUMBERP (gcc_jit_rvalue *obj)
+{
+  return gcc_jit_context_new_binary_op (comp.ctxt,
+                                       NULL,
+                                       GCC_JIT_BINARY_OP_LOGICAL_OR,
+                                       comp.bool_type,
+                                       emit_INTEGERP(obj),
+                                       emit_cast (comp.bool_type,
+                                                  emit_FLOATP (obj)));
+}
+
 static gcc_jit_rvalue *
 emit_make_fixnum (gcc_jit_block *block, gcc_jit_rvalue *obj)
 {
@@ -1866,7 +1884,13 @@ compile_f (const char *f_name, ptrdiff_t bytestr_length,
        CASE_CALL_NARGS (rem, 2);
 
        case Bnumberp:
-         error ("Bnumberp not supported");
+         POP1;
+         res = emit_NUMBERP (args[0]);
+         res = gcc_jit_context_new_call (comp.ctxt,
+                                         NULL,
+                                         comp.bool_to_lisp_obj,
+                                         1, &res);
+         PUSH_RVAL (res);
          break;
 
        case Bintegerp:

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 99dce77dc295bec0a4bdba9e71a88cda855b084f..9d1ee65e4ee11f370d27762b1569807299e6f435 100644 (file)
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -289,14 +289,23 @@
   (defun comp-tests-integerp-f (x)
     ;; Bintegerp
     (integerp x))
+  (defun comp-tests-numberp-f (x)
+    ;; Bnumberp
+    (numberp x))
 
   (byte-compile #'comp-tests-integerp-f)
   (native-compile #'comp-tests-integerp-f)
+  (byte-compile #'comp-tests-numberp-f)
+  (native-compile #'comp-tests-numberp-f)
 
   (should (eq (comp-tests-integerp-f 1) t))
   (should (eq (comp-tests-integerp-f '(1)) nil))
   (should (eq (comp-tests-integerp-f 3.5) nil))
-  (should (eq (comp-tests-integerp-f (1+ most-negative-fixnum)) t)))
+  (should (eq (comp-tests-integerp-f (1+ most-negative-fixnum)) t))
+
+  (should (eq (comp-tests-numberp-f 1) t))
+  (should (eq (comp-tests-numberp-f 'a) nil))
+  (should (eq (comp-tests-numberp-f 3.5) t)))
 
 (ert-deftest comp-tests-gc ()
   "Try to do some longer computation to let the gc kick in."