From 04aafb7f66dff551d80040a53c482bde08bbc254 Mon Sep 17 00:00:00 2001
From: Andrea Corallo <andrea_corallo@yahoo.it>
Date: Sun, 16 Jun 2019 12:08:48 +0200
Subject: [PATCH] Bnumberp support

---
 src/comp.c             | 26 +++++++++++++++++++++++++-
 test/src/comp-tests.el | 11 ++++++++++-
 2 files changed, 35 insertions(+), 2 deletions(-)

diff --git a/src/comp.c b/src/comp.c
index 7bdf1a8615c..fd7e7beda1e 100644
--- 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 99dce77dc29..9d1ee65e4ee 100644
--- 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."
-- 
2.39.5