From f43fda4e635370689fc248bb7e94e5861151df2c Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 9 Jul 2021 08:21:15 -0700
Subject: defstruct: diagnose built-in type being redefined.

* eval.c (eval_init): Register built-in-type-p intrinsic.

* lib.c (buitin_type_p): Rename to built_in_type_p since the
word built-in is hyphenated. The function also tests
whether the argument is a COBJ class.
(cobj_class_exists): Function removed.

* stdlib/doc-syms.tl: Updated.

* stdlib/struct.tl (defstruct): Add built-in-type-p check.

* struct.c (make_struct_type): Call only built_in_type_p;
cobj_class_exists is gone.

* txr.1: Document built-in-type-p.
---
 eval.c             |  1 +
 lib.c              | 10 ++++------
 lib.h              |  3 +--
 stdlib/doc-syms.tl |  1 +
 stdlib/struct.tl   |  2 ++
 struct.c           |  2 +-
 txr.1              | 15 +++++++++++++++
 7 files changed, 25 insertions(+), 9 deletions(-)

diff --git a/eval.c b/eval.c
index 74dc4bf1..be559e6f 100644
--- a/eval.c
+++ b/eval.c
@@ -6771,6 +6771,7 @@ void eval_init(void)
   reg_fun(intern(lit("typeof"), user_package), func_n1(typeof));
   reg_fun(intern(lit("subtypep"), user_package), func_n2(subtypep));
   reg_fun(intern(lit("typep"), user_package), func_n2(typep));
+  reg_fun(intern(lit("built-in-type-p"), user_package), func_n1(built_in_type_p));
 
   reg_fun(intern(lit("atom"), user_package), func_n1(atom));
   reg_fun(intern(lit("null"), user_package), null_f);
diff --git a/lib.c b/lib.c
index 06f2ba71..b0f0a64f 100644
--- a/lib.c
+++ b/lib.c
@@ -209,7 +209,7 @@ static val code2type(int code)
   return nil;
 }
 
-val builtin_type_p(val sym)
+val built_in_type_p(val sym)
 {
   type_t i;
 
@@ -219,6 +219,9 @@ val builtin_type_p(val sym)
       return t;
   }
 
+  if (gethash(cobj_hash, sym))
+    return t;
+
   return nil;
 }
 
@@ -9206,11 +9209,6 @@ static void cobj_populate_hash(void)
     sethash(cobj_hash, ptr->cls_sym, num_fast(ptr - cobj_class));
 }
 
-int cobj_class_exists(val cls_sym)
-{
-  return gethash(cobj_hash, cls_sym) != nil;
-}
-
 val cobj(mem_t *handle, struct cobj_class *cls, struct cobj_ops *ops)
 {
   if (cls != 0) {
diff --git a/lib.h b/lib.h
index 077f5d98..a306830b 100644
--- a/lib.h
+++ b/lib.h
@@ -563,7 +563,7 @@ extern alloc_bytes_t malloc_bytes;
 extern alloc_bytes_t gc_bytes;
 
 val identity(val obj);
-val builtin_type_p(val sym);
+val built_in_type_p(val sym);
 val typeof(val obj);
 val subtypep(val sub, val sup);
 val typep(val obj, val type);
@@ -1100,7 +1100,6 @@ val length_str_lt(val str, val len);
 val length_str_le(val str, val len);
 struct cobj_class *cobj_register(val cls_sym);
 struct cobj_class *cobj_register_super(val cls_sym, struct cobj_class *super);
-int cobj_class_exists(val cls_sym);
 val cobj(mem_t *handle, struct cobj_class *cls, struct cobj_ops *ops);
 val cobjp(val obj);
 val cobjclassp(val obj, struct cobj_class *);
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl
index 829e418a..e1a5d5a0 100644
--- a/stdlib/doc-syms.tl
+++ b/stdlib/doc-syms.tl
@@ -233,6 +233,7 @@
       ("build" "N-01346AAA")
       ("build-list" "N-0315C467")
       ("buildn" "N-01346AAA")
+      ("built-in-type-p" "N-011BB3FF")
       ("butlast" "N-026BB6FA")
       ("butlastn" "N-01E2C334")
       ("caar" "N-001FA3CB")
diff --git a/stdlib/struct.tl b/stdlib/struct.tl
index bd62637f..9108ab02 100644
--- a/stdlib/struct.tl
+++ b/stdlib/struct.tl
@@ -39,6 +39,8 @@
                            (atom (list atom nil)))
     (unless (bindable name)
       (compile-error form "~s isn't a bindable symbol" name))
+    (if (built-in-type-p name)
+      (compile-warning form "~s is a built-in type" name))
     (unless (proper-listp slot-specs)
       (compile-error form "bad syntax: dotted form"))
     (let* ((instance-init-form nil)
diff --git a/struct.c b/struct.c
index aa6b86d1..2f643dae 100644
--- a/struct.c
+++ b/struct.c
@@ -439,7 +439,7 @@ val make_struct_type(val name, val supers,
 
   lisplib_try_load(name);
 
-  if (builtin_type_p(name) || cobj_class_exists(name))
+  if (built_in_type_p(name))
     uw_throwf(error_s, lit("~a: ~s is a built-in type"),
               self, name, nao);
 
diff --git a/txr.1 b/txr.1
index c36be80c..47d41801 100644
--- a/txr.1
+++ b/txr.1
@@ -19284,6 +19284,21 @@ always matches.  If such a clause is placed as the last clause of a
 it provides a fallback case, whose forms are evaluated if none of the
 previous clauses match.
 
+.coNP Function @ built-in-type-p
+.synb
+.mets (built-in-type-p << object )
+.syne
+.desc
+The
+.code built-in-type-p
+function returns
+.code t
+if
+.meta object
+is a symbol which is the name of a built-in type.
+For all other objects it returns
+.codn nil .
+
 .SS* Object Equivalence
 
 .coNP Functions @, identity @ identity* and @ use
-- 
cgit v1.2.3