From 9435f6a3ed7b211c92810d3e6470677d2b03c319 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 16 Jun 2017 20:41:25 -0700
Subject: New sequence classification system.

This will help simplify writing generic sequence code, while
allowing lists and vectors to be handled specially.

* lib.h (enum seq_kind, seq_kind_t): New enum and typedef.
(struct seq_info, seq_info_t): New struct and typedef.
(seq_kind_tab, seq_info): Declared.

* lib.c (seq_kind_tab): New global array.
(seq_info): New function.
---
 lib.c | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 lib.h | 13 +++++++++++++
 2 files changed, 73 insertions(+)

diff --git a/lib.c b/lib.c
index e71a9a73..99db73f0 100644
--- a/lib.c
+++ b/lib.c
@@ -150,6 +150,28 @@ int null_or_missing_p(val v);
 val default_null_arg(val arg);
 #endif
 
+const seq_kind_t seq_kind_tab[MAXTYPE+1] = {
+  SEQ_NIL,      /* NIL */
+  SEQ_NOTSEQ,   /* NUM */
+  SEQ_NOTSEQ,   /* CHR */
+  SEQ_VECLIKE,  /* LIT */
+  SEQ_LISTLIKE, /* CONS */
+  SEQ_VECLIKE,  /* STR */
+  SEQ_NOTSEQ,   /* SYM */
+  SEQ_NOTSEQ,   /* PKG */
+  SEQ_NOTSEQ,   /* FUN */
+  SEQ_VECLIKE,  /* VEC */
+  SEQ_LISTLIKE, /* LCONS */
+  SEQ_VECLIKE,  /* LSTR */
+  SEQ_NOTSEQ,   /* COBJ */
+  SEQ_NOTSEQ,   /* CPTR */
+  SEQ_NOTSEQ,   /* ENV */
+  SEQ_NOTSEQ,   /* BGNUM */
+  SEQ_NOTSEQ,   /* FLNUM */
+  SEQ_NOTSEQ,   /* RNG */
+  SEQ_VECLIKE,  /* BUF */
+};
+
 val identity(val obj)
 {
   return obj;
@@ -257,6 +279,44 @@ val typep(val obj, val type)
   return subtypep(typeof(obj), type);
 }
 
+seq_info_t seq_info(val obj)
+{
+  seq_info_t ret;
+  type_t to = type(obj);
+
+  if (to != COBJ) {
+    ret.obj = obj;
+    ret.type = to;
+    ret.kind = seq_kind_tab[to];
+    return ret;
+  }
+
+  ret.obj = obj = nullify(obj);
+
+  if (!obj || (ret.type = to = type(obj)) != COBJ) {
+    ret.kind = seq_kind_tab[to];
+  } else {
+    val cls = obj->co.cls;
+
+    if (cls == hash_s) {
+      ret.kind = SEQ_HASHLIKE;
+    } else if (cls == carray_s) {
+      ret.kind = SEQ_VECLIKE;
+    } else if (structp(cls)) {
+      if (maybe_slot(obj, length_s))
+        ret.kind = SEQ_VECLIKE;
+      if (maybe_slot(obj, car_s))
+        ret.kind = SEQ_LISTLIKE;
+      else
+      ret.kind = SEQ_NOTSEQ;
+    } else {
+      ret.kind = SEQ_NOTSEQ;
+    }
+  }
+
+  return ret;
+}
+
 val throw_mismatch(val obj, type_t t)
 {
   type_mismatch(lit("~s is not of type ~s"), obj, code2type(t), nao);
diff --git a/lib.h b/lib.h
index ea644448..24db79f1 100644
--- a/lib.h
+++ b/lib.h
@@ -345,6 +345,18 @@ typedef val *loc;
 #define mpush(val, lo) (push(val, lo))
 #endif
 
+typedef enum seq_kind {
+  SEQ_NIL, SEQ_LISTLIKE, SEQ_VECLIKE, SEQ_HASHLIKE, SEQ_NOTSEQ
+} seq_kind_t;
+
+typedef struct seq_info {
+  val obj;
+  type_t type;
+  seq_kind_t kind;
+} seq_info_t;
+
+extern const seq_kind_t seq_kind_tab[MAXTYPE+1];
+
 INLINE cnum tag(val obj) { return coerce(cnum, obj) & TAG_MASK; }
 INLINE int is_ptr(val obj) { return obj && tag(obj) == TAG_PTR; }
 INLINE int is_num(val obj) { return tag(obj) == TAG_NUM; }
@@ -486,6 +498,7 @@ val identity(val obj);
 val typeof(val obj);
 val subtypep(val sub, val sup);
 val typep(val obj, val type);
+seq_info_t seq_info(val cobj);
 val throw_mismatch(val obj, type_t);
 INLINE val type_check(val obj, type_t typecode)
 {
-- 
cgit v1.2.3