From 98466491da86fa8d1c5071beaefcd35c057a8e60 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 13 Oct 2016 06:44:38 -0700
Subject: Overhaul where funtion.

* lib.c (where): Implement faster ref-based access for vectors
and strings. Support abstract sequence structs.
---
 lib.c | 57 +++++++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 43 insertions(+), 14 deletions(-)

diff --git a/lib.c b/lib.c
index 5d40253e..a3b88366 100644
--- a/lib.c
+++ b/lib.c
@@ -8544,25 +8544,54 @@ val where(val func, val seq)
     seq = f;
   }
 
-  if (hashp(seq)) {
-    val hiter = hash_begin(seq);
-    val cell;
+  seq = nullify(seq);
 
-    while ((cell = hash_next(hiter)))
-      if (funcall1(func, cdr(cell)))
-        ptail = list_collect(ptail, car(cell));
-  } else {
-    val idx = zero;
+  switch (type(seq)) {
+  case COBJ:
+    if (seq->co.cls == hash_s) {
+      val hiter = hash_begin(seq);
+      val cell;
 
-    seq = nullify(seq);
+      while ((cell = hash_next(hiter)))
+        if (funcall1(func, cdr(cell)))
+          ptail = list_collect(ptail, car(cell));
+      break;
+    }
+    /* fallthrough */
+  case NIL:
+  case CONS:
+  case LCONS:
+    {
+      val idx = zero;
 
-    gc_hint(seq);
+      gc_hint(seq);
 
-    for (; seq; seq = cdr(seq), idx = plus(idx, one)) {
-      val elt = car(seq);
-      if (funcall1(func, elt))
-        ptail = list_collect(ptail, idx);
+      for (; seq; seq = cdr(seq), idx = plus(idx, one)) {
+        val elt = car(seq);
+        if (funcall1(func, elt))
+          ptail = list_collect(ptail, idx);
+      }
     }
+    break;
+  case LIT:
+  case STR:
+  case LSTR:
+  case VEC:
+    {
+      val idx;
+      val len = length(seq);
+
+      gc_hint(seq);
+
+      for (idx = zero; lt(idx, len); idx = plus(idx, one)) {
+        val elt = ref(seq, idx);
+        if (funcall1(func, elt))
+          ptail = list_collect(ptail, idx);
+      }
+    }
+    break;
+  default:
+    type_mismatch(lit("where: ~s is not a sequence"), seq, nao);
   }
 
   return out;
-- 
cgit v1.2.3