Add `pointer?'.

* libguile/foreign.c (scm_pointer_p): New function.
* libguile/foreign.h (scm_pointer_p): New declaration.
* module/system/foreign.scm: Export `pointer?'.

* test-suite/tests/foreign.test ("null pointer")["pointer?"]: New
  test.
  ("make-pointer")["pointer?"]: New test.

* doc/ref/api-foreign.texi (Foreign Variables): Document `pointer?'.

doc/ref/api-foreign.texi

@@ -549,6 +549,10 @@ function that will be called when the pointer object becomes
 unreachable.
 @end deffn
 
+@deffn {Scheme Procedure} pointer? obj
+Return @code{#t} if @var{obj} is a pointer object, @code{#f} otherwise.
+@end deffn
+
 @defvr {Scheme Variable} %null-pointer
 A foreign pointer whose value is 0.
 @end defvr

libguile/foreign.c

@@ -100,6 +100,16 @@ pointer_finalizer_trampoline (GC_PTR ptr, GC_PTR data)
   finalizer (SCM_POINTER_VALUE (PTR2SCM (ptr)));
 }
 
+SCM_DEFINE (scm_pointer_p, "pointer?", 1, 0, 0,
+	    (SCM obj),
+	    "Return @code{#t} if @var{obj} is a pointer object, "
+	    "@code{#f} otherwise.\n")
+#define FUNC_NAME s_scm_pointer_p
+{
+  return scm_from_bool (SCM_POINTER_P (obj));
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_make_pointer, "make-pointer", 1, 1, 0,
 	    (SCM address, SCM finalizer),
 	    "Return a foreign pointer object pointing to @var{address}. "

libguile/foreign.h

@@ -66,6 +66,7 @@ SCM_API SCM scm_pointer_to_bytevector (SCM pointer, SCM type,
 SCM_API SCM scm_set_pointer_finalizer_x (SCM pointer, SCM finalizer);
 SCM_API SCM scm_bytevector_to_pointer (SCM bv, SCM offset);
 
+SCM_INTERNAL SCM scm_pointer_p (SCM obj);
 SCM_INTERNAL SCM scm_make_pointer (SCM address, SCM finalizer);
 SCM_INTERNAL void scm_i_pointer_print (SCM pointer, SCM port,
                                        scm_print_state *pstate);

module/system/foreign.scm

@@ -35,6 +35,7 @@
 
             %null-pointer
             null-pointer?
+            pointer?
             make-pointer
             pointer-address
 

test-suite/tests/foreign.test

@@ -30,6 +30,9 @@
 
 (with-test-prefix "null pointer"
 
+  (pass-if "pointer?"
+    (pointer? %null-pointer))
+
   (pass-if "zero"
     (= 0 (pointer-address %null-pointer)))
 
@@ -46,6 +49,9 @@
 
 (with-test-prefix "make-pointer"
 
+  (pass-if "pointer?"
+    (pointer? (make-pointer 123)))
+
   (pass-if "address preserved"
     (= 123 (pointer-address (make-pointer 123))))