From ecc7822b90dc5bf0b95d3a6985d4b977f6e94774 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 30 Jun 2017 20:59:31 -0700
Subject: ffi: new ffi-type-operator-p and ffi-type-p.

* ffi.c (ffi_type_operator_p, ffi_type_p): New functions.
(ffi_init): Register ffi-type-operator-p and ffi-type-p
intrinsics.

* ffi.h (ffi_type_operator_p, ffi_type_p): Declared.

* txr.1: Documented.
---
 ffi.c | 18 ++++++++++++++++++
 ffi.h |  2 ++
 txr.1 | 35 +++++++++++++++++++++++++++++++++++
 3 files changed, 55 insertions(+)

diff --git a/ffi.c b/ffi.c
index 3c8a1c8c..8170cb8b 100644
--- a/ffi.c
+++ b/ffi.c
@@ -3591,6 +3591,22 @@ excess:
             self, syntax, nao);
 }
 
+val ffi_type_operator_p(val sym)
+{
+  return tnil(sym == struct_s || sym == union_s || sym == array_s ||
+              sym == zarray_s || sym == ptr_in_s || sym == ptr_in_d_s ||
+              sym == ptr_out_s || sym == ptr_out_d_s || sym == ptr_s ||
+              sym == ptr_out_s_s || sym == buf_s || sym == buf_d_s ||
+              sym == cptr_s || sym == carray_s || sym == sbit_s ||
+              sym == ubit_s || sym == bit_s || sym == enum_s ||
+              sym == enumed_s || sym == align_s || sym == bool_s);
+}
+
+val ffi_type_p(val sym)
+{
+  return tnil(gethash(ffi_typedef_hash, sym));
+}
+
 static void ffi_init_types(void)
 {
 #if UCHAR_MAX == CHAR_MAX
@@ -5416,6 +5432,8 @@ void ffi_init(void)
   ffi_call_desc_s = intern(lit("ffi-call-desc"), user_package);
   ffi_closure_s = intern(lit("ffi-closure"), user_package);
   reg_fun(intern(lit("ffi-type-compile"), user_package), func_n1(ffi_type_compile));
+  reg_fun(intern(lit("ffi-type-operator-p"), user_package), func_n1(ffi_type_operator_p));
+  reg_fun(intern(lit("ffi-type-p"), user_package), func_n1(ffi_type_p));
 #if HAVE_LIBFFI
   reg_fun(intern(lit("ffi-make-call-desc"), user_package), func_n4(ffi_make_call_desc));
   reg_fun(intern(lit("ffi-call"), user_package), func_n2v(ffi_call_wrap));
diff --git a/ffi.h b/ffi.h
index 232337a1..c0e343bf 100644
--- a/ffi.h
+++ b/ffi.h
@@ -72,6 +72,8 @@ extern val bool_s;
 extern val ffi_type_s, ffi_call_desc_s, ffi_closure_s;
 
 val ffi_type_compile(val syntax);
+val ffi_type_operator_p(val sym);
+val ffi_type_p(val sym);
 val ffi_make_call_desc(val ntotal, val nfixed, val rettype, val argtypes);
 val ffi_make_closure(val fun, val call_desc, val safe_p_in, val abort_ret_in);
 mem_t *ffi_closure_get_fptr(val closure);
diff --git a/txr.1 b/txr.1
index 14eda774..89c7b37b 100644
--- a/txr.1
+++ b/txr.1
@@ -55865,6 +55865,41 @@ argument types match.
     (#<ffi-type str> #<ffi-type int>)>
 .cble
 
+.coNP Function @ ffi-type-operator-p
+.synb
+.mets (ffi-type-operator-p << symbol )
+.syne
+.desc
+The
+.code ffi-type-operator-p
+function return
+.code t
+if
+.meta symbol
+is a type operator symbol: a symbol used in the first position of
+a recognized compound type form in the FFI type system.
+
+Otherwise, it returns
+.codn nil .
+
+.coNP Function @ ffi-type-p
+.synb
+.mets (ffi-type-p << symbol )
+.syne
+.desc
+The
+.code ffi-type-p
+function returns
+.code t
+if
+.meta symbol
+denotes a type in the FFI type system: either a built-in type or
+an alias type name established by
+.codn typedef .
+
+Otherwise, it returns
+.codn nil .
+
 .coNP Function @ ffi-make-closure
 .synb
 .mets (ffi-make-closure < lisp-fun < call-desc
-- 
cgit v1.2.3