(Fchartablep, Fboolvectorp): New functions.

(syms_of_data): defsubr them.
(Faref, Faset, Fsequencep): Handle chartables and boolvectors.

1 files changed, 157 insertions, 3 deletions

diff --git a/src/data.c b/src/data.c
index 3efa4af16cc..6892af5836d 100644
--- a/src/data.c
+++ b/src/data.c
@@ -74,6 +74,7 @@ Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
 Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
 Lisp_Object Qbuffer_or_string_p;
 Lisp_Object Qboundp, Qfboundp;
+Lisp_Object Qchar_table_p;
 
 Lisp_Object Qcdr;
 Lisp_Object Qad_advice_info, Qad_activate;
@@ -314,6 +315,24 @@ DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, "T if OBJECT is a string.")
   return Qnil;
 }
 
+DEFUN ("char-table-p", Fchar_table_p, Schar_table_p, 1, 1, 0, "T if OBJECT is a char-table.")
+  (object)
+     Lisp_Object object;
+{
+  if (CHAR_TABLE_P (object))
+    return Qt;
+  return Qnil;
+}
+
+DEFUN ("bool-vector-p", Fbool_vector_p, Sbool_vector_p, 1, 1, 0, "T if OBJECT is a bool-vector.")
+  (object)
+     Lisp_Object object;
+{
+  if (BOOL_VECTOR_P (object))
+    return Qt;
+  return Qnil;
+}
+
 DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, "T if OBJECT is an array (string or vector).")
   (object)
      Lisp_Object object;
@@ -328,7 +347,8 @@ DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0,
   (object)
      register Lisp_Object object;
 {
-  if (CONSP (object) || NILP (object) || VECTORP (object) || STRINGP (object))
+  if (CONSP (object) || NILP (object) || VECTORP (object) || STRINGP (object)
+      || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object))
     return Qt;
   return Qnil;
 }
@@ -1480,7 +1500,8 @@ function chain of symbols.")
 
 DEFUN ("aref", Faref, Saref, 2, 2, 0,
   "Return the element of ARRAY at index INDEX.\n\
-ARRAY may be a vector or a string, or a byte-code object.  INDEX starts at 0.")
+ARRAY may be a vector, a string, a char-table, a bool-vector,\n\
+or a byte-code object.  INDEX starts at 0.")
   (array, idx)
      register Lisp_Object array;
      Lisp_Object idx;
@@ -1497,6 +1518,75 @@ ARRAY may be a vector or a string, or a byte-code object.  INDEX starts at 0.")
       XSETFASTINT (val, (unsigned char) XSTRING (array)->data[idxval]);
       return val;
     }
+  else if (BOOL_VECTOR_P (array))
+    {
+      int val;
+      int bits_per_char = INTBITS / sizeof (int);
+
+      if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size)
+        args_out_of_range (array, idx);
+
+      val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / bits_per_char];
+      return (val & (1 << (idxval % bits_per_char)) ? Qt : Qnil);
+    }
+  else if (CHAR_TABLE_P (array))
+    {
+      Lisp_Object val;
+
+      if (idxval < 0)
+        args_out_of_range (array, idx);
+#if 1
+      if ((unsigned) idxval >= CHAR_TABLE_ORDINARY_SLOTS)
+        args_out_of_range (array, idx);
+      return val = XCHAR_TABLE (array)->contents[idxval];
+#else /* 0 */
+      if ((unsigned) idxval < CHAR_TABLE_ORDINARY_SLOTS)
+        val = XCHAR_TABLE (array)->data[idxval];
+      else
+        {
+          int charset;
+          unsigned char c1, c2;
+          Lisp_Object val, temp;
+
+          BREAKUP_NON_ASCII_CHAR (idxval, charset, c1, c2);
+
+        try_parent_char_table:
+          val = XCHAR_TABLE (array)->contents[charset];
+          if (c1 == 0 || !CHAR_TABLE_P (val))
+            return val;
+
+          temp = XCHAR_TABLE (val)->contents[c1];
+          if (NILP (temp))
+            val = XCHAR_TABLE (val)->defalt;
+          else
+            val = temp;
+
+          if (NILP (val) && !NILP (XCHAR_TABLE (array)->parent))
+            {
+              array = XCHAR_TABLE (array)->parent;
+              goto try_parent_char_table;
+
+            }
+
+          if (c2 == 0 || !CHAR_TABLE_P (val))
+            return val;
+
+          temp = XCHAR_TABLE (val)->contents[c2];
+          if (NILP (temp))
+            val = XCHAR_TABLE (val)->defalt;
+          else
+            val = temp;
+
+          if (NILP (val) && !NILP (XCHAR_TABLE (array)->parent))
+            {
+              array = XCHAR_TABLE (array)->parent;
+              goto try_parent_char_table;
+            }
+
+          return val;
+        }
+#endif /* 0 */
+    }
   else
     {
       int size;
@@ -1524,7 +1614,8 @@ ARRAY may be a vector or a string.  IDX starts at 0.")
 
   CHECK_NUMBER (idx, 1);
   idxval = XINT (idx);
-  if (!VECTORP (array) && !STRINGP (array))
+  if (!VECTORP (array) && !STRINGP (array) && !BOOL_VECTOR_P (array)
+      && ! CHAR_TABLE_P (array))
     array = wrong_type_argument (Qarrayp, array);
   CHECK_IMPURE (array);
 
@@ -1534,6 +1625,64 @@ ARRAY may be a vector or a string.  IDX starts at 0.")
         args_out_of_range (array, idx);
       XVECTOR (array)->contents[idxval] = newelt;
     }
+  else if (BOOL_VECTOR_P (array))
+    {
+      int val;
+      int bits_per_char = INTBITS / sizeof (int);
+
+      if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size)
+        args_out_of_range (array, idx);
+
+      val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / bits_per_char];
+
+      if (! NILP (newelt))
+        val |= 1 << (idxval % bits_per_char);
+      else
+        val &= ~(1 << (idxval % bits_per_char));
+      XBOOL_VECTOR (array)->data[idxval / bits_per_char] = val;
+    }
+  else if (CHAR_TABLE_P (array))
+    {
+      Lisp_Object val;
+
+      if (idxval < 0)
+        args_out_of_range (array, idx);
+#if 1
+      if (idxval >= CHAR_TABLE_ORDINARY_SLOTS)
+        args_out_of_range (array, idx);
+      XCHAR_TABLE (array)->contents[idxval] = newelt;
+      return newelt;
+#else /* 0 */
+      if (idxval < CHAR_TABLE_ORDINARY_SLOTS)
+        val = XCHAR_TABLE (array)->contents[idxval];
+      else
+        {
+          int charset;
+          unsigned char c1, c2;
+          Lisp_Object val, val2;
+
+          BREAKUP_NON_ASCII_CHAR (idxval, charset, c1, c2);
+
+          if (c1 == 0)
+            return XCHAR_TABLE (array)->contents[charset] = newelt;
+
+          val = XCHAR_TABLE (array)->contents[charset];
+          if (!CHAR_TABLE_P (val))
+            XCHAR_TABLE (array)->contents[charset]
+              = val = Fmake_char_table (Qnil);
+
+          if (c2 == 0)
+            return XCHAR_TABLE (val)->contents[c1] = newelt;
+
+          val2 = XCHAR_TABLE (val)->contents[c2];
+          if (!CHAR_TABLE_P (val2))
+            XCHAR_TABLE (val)->contents[charset]
+              = val2 = Fmake_char_table (Qnil);
+
+          return XCHAR_TABLE (val2)->contents[c2] = newelt;
+        }
+#endif /* 0 */
+    }
   else
     {
       if (idxval < 0 || idxval >= XSTRING (array)->size)
@@ -2232,6 +2381,8 @@ syms_of_data ()
   Qnumber_or_marker_p = intern ("number-or-marker-p");
 #endif /* LISP_FLOAT_TYPE */
 
+  Qchar_table_p = intern ("char-table-p");
+
   Qcdr = intern ("cdr");
 
   /* Handle automatic advice activation */
@@ -2416,6 +2567,7 @@ syms_of_data ()
   staticpro (&Qnumberp);
   staticpro (&Qnumber_or_marker_p);
 #endif /* LISP_FLOAT_TYPE */
+  staticpro (&Qchar_table_p);
 
   staticpro (&Qboundp);
   staticpro (&Qfboundp);
@@ -2474,6 +2626,8 @@ syms_of_data ()
   defsubr (&Ssymbolp);
   defsubr (&Sstringp);
   defsubr (&Svectorp);
+  defsubr (&Schar_table_p);
+  defsubr (&Sbool_vector_p);
   defsubr (&Sarrayp);
   defsubr (&Ssequencep);
   defsubr (&Sbufferp);