From a5fb3b1b14227481d74cf70cce8f1f9f70a3218d Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Mon, 21 Dec 2020 23:00:43 -0500
Subject: [PATCH] Allow (vector?) to recognize and disregard record types

---
 include/cyclone/runtime.h     |  9 ++++++++-
 runtime.c                     | 14 +++++++++++++-
 scheme/base.sld               | 27 +++++++++++++--------------
 scheme/cyclone/primitives.sld |  2 +-
 4 files changed, 35 insertions(+), 17 deletions(-)

diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h
index e0b3c271..20babd1c 100644
--- a/include/cyclone/runtime.h
+++ b/include/cyclone/runtime.h
@@ -476,7 +476,14 @@ object Cyc_is_integer(object o);
 //object Cyc_is_cond_var(object o);
 //object Cyc_is_symbol(object o);
 //object Cyc_is_string(object o);
-#define Cyc_is_vector(o)     (make_boolean(is_object_type(o) && ((list) o)->tag == vector_tag))
+object Cyc_is_record(object o);
+#define Cyc_is_vector_not_record_type(o)     \
+  (make_boolean(is_object_type(o) && \
+                ((vector) o)->tag == vector_tag && \
+                ( ((vector) o)->num_elements == 0 || \
+                  ((vector) o)->elements[0] != Cyc_RECORD_MARKER ) \
+                ))
+#define Cyc_is_vector(o)     (make_boolean(is_object_type(o) && ((vector) o)->tag == vector_tag))
 #define Cyc_is_bytevector(o) (make_boolean(is_object_type(o) && ((list) o)->tag == bytevector_tag))
 #define Cyc_is_port(o)       (make_boolean(is_object_type(o) && ((list) o)->tag == port_tag))
 #define Cyc_is_mutex(o)      (make_boolean(is_object_type(o) && ((list) o)->tag == mutex_tag))
diff --git a/runtime.c b/runtime.c
index 8e17ab44..e5da978d 100644
--- a/runtime.c
+++ b/runtime.c
@@ -1990,6 +1990,18 @@ object Cyc_is_integer(object o)
 //  return boolean_f;
 //}
 
+object Cyc_is_record(object o)
+{
+  vector v = o;
+  if (is_object_type(o) && 
+      v->tag == vector_tag &&
+      v->num_elements > 0 &&
+      v->elements[0] == Cyc_RECORD_MARKER) {
+    return boolean_t;
+  }
+  return boolean_f;
+}
+
 object Cyc_is_procedure(void *data, object o)
 {
   int tag;
@@ -5099,7 +5111,7 @@ void _bytevector_127(void *data, object cont, object args)
 void _vector_127(void *data, object cont, object args)
 {
   Cyc_check_num_args(data, "vector?", 1, args);
-  return_closcall1(data, cont, Cyc_is_vector(car(args)));
+  return_closcall1(data, cont, Cyc_is_vector_not_record_type(car(args)));
 }
 
 void _string_127(void *data, object cont, object args)
diff --git a/scheme/base.sld b/scheme/base.sld
index 3233515a..66c80a9e 100644
--- a/scheme/base.sld
+++ b/scheme/base.sld
@@ -1978,12 +1978,7 @@
   (vector record-marker name field-tags))
 (define (make-type-predicate pred name)
   (lambda (obj)
-    (and (vector? obj)
-         (= (vector-length obj) 3)
-         (or
-          (equal? (vector-ref obj 0) record-marker)
-          (equal? (vector-ref obj 0) (list 'record-marker))
-         )
+    (and (record? obj)
          (equal? (vector-ref obj 1) name))))
 (define (make-constructor make name)
   (lambda args
@@ -2029,14 +2024,18 @@
       (and (not (null? lis))
            (if (eq? e (car lis)) n (lp (cdr lis) (+ n 1)))))))
 
-(define (record? obj)
-  (and (vector? obj)
-       (> (vector-length obj) 0)
-       (or 
-        (equal? record-marker (vector-ref obj 0))
-        (equal? (list 'record-marker) (vector-ref obj 0))
-       ) 
-       ))
+;(define (record? obj)
+;  (and (vector? obj)
+;       (> (vector-length obj) 0)
+;       (or 
+;        (equal? record-marker (vector-ref obj 0))
+;        (equal? (list 'record-marker) (vector-ref obj 0))
+;       ) 
+;       ))
+
+(define-c record?
+  "(void *data, int argc, closure _, object k, object obj)"
+  " return_closcall1(data, k, Cyc_is_record(obj)); ")
 
 (define (is-a? obj rtype)
   (and (record? obj)
diff --git a/scheme/cyclone/primitives.sld b/scheme/cyclone/primitives.sld
index 8d7e5ced..b4616f8e 100644
--- a/scheme/cyclone/primitives.sld
+++ b/scheme/cyclone/primitives.sld
@@ -680,7 +680,7 @@
          ((eq? p 'procedure?)    "Cyc_is_procedure")
          ((eq? p 'Cyc-macro?)    "Cyc_is_macro")
          ((eq? p 'port?)         "Cyc_is_port")
-         ((eq? p 'vector?)       "Cyc_is_vector")
+         ((eq? p 'vector?)       "Cyc_is_vector_not_record_type")
          ((eq? p 'bytevector?)   "Cyc_is_bytevector")
          ((eq? p 'string?)       "Cyc_is_string")
          ((eq? p 'eof-object?)   "Cyc_is_eof_object")