core: Add hash-table?.

* include/mes/mes.h (scm_hash_table_type): New type.
* src/hash.c (make_hash_table_type): Rename from make_hash_type, and
initialize it.
* src/symbol.c (init_symbols): Add it to environment.

include/mes/builtins.h

@@ -71,6 +71,7 @@ struct scm *hashq_set_x (struct scm *table, struct scm *key, struct scm *value);
 struct scm *hash_set_x (struct scm *table, struct scm *key, struct scm *value);
 struct scm *hash_table_printer (struct scm *table);
 struct scm *make_hash_table (struct scm *x);
+struct scm *hash_table_p (struct scm *x);
 struct scm *hash_map_to_list (struct scm *proc, struct scm *table);
 /* src/lib.c */
 struct scm *type_ (struct scm *x);

include/mes/mes.h

@@ -105,6 +105,8 @@ struct timespec *g_start_time;
 struct timeval *__gettimeofday_time;
 struct timespec *__get_internal_run_time_ts;
 
+struct scm *scm_hash_table_type;
+
 struct scm *cast_charp_to_scmp (char const *i);
 struct scm **cast_charp_to_scmpp (char const *i);
 char *cast_voidp_to_charp (void const *i);
@@ -133,7 +135,7 @@ struct scm *make_value_cell (long type, long car, long cdr);
 struct scm *make_char (int n);
 struct scm *make_continuation (long n);
 struct scm *make_hash_table_ (long size);
-struct scm *make_hashq_type ();
+struct scm *make_hash_table_type ();
 struct scm *make_initial_module (struct scm *a);
 struct scm *make_macro (struct scm *name, struct scm *x);
 struct scm *make_number (long n);

src/builtins.c

@@ -180,6 +180,7 @@ mes_builtins (struct scm *a)            /*:((internal)) */
   a = init_builtin (builtin_type, "hashq-set!", 3, &hashq_set_x, a);
   a = init_builtin (builtin_type, "hash-set!", 3, &hash_set_x, a);
   a = init_builtin (builtin_type, "hash-table-printer", 1, &hash_table_printer, a);
+  a = init_builtin (builtin_type, "hash-table?", 1, &hash_table_p, a);
   a = init_builtin (builtin_type, "make-hash-table", -1, &make_hash_table, a);
   a = init_builtin (builtin_type, "hash-map->list", 2, &hash_map_to_list, a);
   /* src/lib.c */

src/gc.c

@@ -457,6 +457,7 @@ gc_flip ()
   g_symbols = g_symbols - dist;
   g_macros = g_macros - dist;
   g_ports = g_ports - dist;
+  scm_hash_table_type = scm_hash_table_type - dist;
   M0 = M0 - dist;
 
   long i;
@@ -628,6 +629,7 @@ gc_ ()
   g_symbols = gc_copy (g_symbols);
   g_macros = gc_copy (g_macros);
   g_ports = gc_copy (g_ports);
+  scm_hash_table_type = gc_copy (scm_hash_table_type);
   M0 = gc_copy (M0);
 
   long i;

src/hash.c

@@ -173,14 +173,18 @@ hash_table_printer (struct scm *table)
 }
 
 struct scm *
-make_hashq_type ()              /*:((internal)) */
+make_hash_table_type ()              /*:((internal)) */
 {
-  struct scm *fields = cell_nil;
-  fields = cons (cell_symbol_buckets, fields);
-  fields = cons (cell_symbol_size, fields);
-  fields = cons (fields, cell_nil);
-  fields = cons (cell_symbol_hashq_table, fields);
-  return make_struct (cell_symbol_record_type, fields, cell_unspecified);
+  if (scm_hash_table_type == 0)
+    {
+      struct scm *fields = cell_nil;
+      fields = cons (cell_symbol_buckets, fields);
+      fields = cons (cell_symbol_size, fields);
+      fields = cons (fields, cell_nil);
+      fields = cons (cell_symbol_hashq_table, fields);
+      scm_hash_table_type = make_struct (cell_symbol_record_type, fields, cell_unspecified);
+    }
+  return scm_hash_table_type;
 }
 
 struct scm *
@@ -188,7 +192,7 @@ make_hash_table_ (long size)
 {
   if (size == 0)
     size = 100;
-  struct scm *hashq_type = make_hashq_type ();
+  struct scm *type = make_hash_table_type ();
 
   struct scm *buckets = make_vector_ (size, cell_unspecified);
   struct scm *values = cell_nil;
@@ -196,8 +200,17 @@ make_hash_table_ (long size)
   values = cons (make_number (size), values);
   values = cons (cell_symbol_hashq_table, values);
   /*FIXME: symbol/printer
-    return make_struct (hashq_type, values, cstring_to_symbol ("hash-table-printer");*/
-  return make_struct (hashq_type, values, cell_unspecified);
+    return make_struct (type, values, cstring_to_symbol ("hash-table-printer");*/
+  return make_struct (type, values, cell_unspecified);
+}
+
+struct scm *
+hash_table_p (struct scm *table)
+{
+  if (table->type == TSTRUCT
+      && struct_ref_ (table, 0) == scm_hash_table_type)
+    return cell_t;
+  return cell_f;
 }
 
 struct scm *

src/module.c

@@ -39,8 +39,8 @@ make_initial_module (struct scm *a)     /*:((internal)) */
   struct scm *module_type = make_module_type ();
   a = acons (cell_symbol_module, module_type, a);
 
-  struct scm *hashq_type = make_hashq_type ();
-  a = acons (cell_symbol_hashq_table, hashq_type, a);
+  struct scm *hash_table_type = scm_hash_table_type;
+  a = acons (cell_symbol_hashq_table, hash_table_type, a);
 
   struct scm *name = cons (cstring_to_symbol ("boot"), cell_nil);
   struct scm *globals = make_hash_table_ (0);

src/symbol.c

@@ -217,6 +217,10 @@ init_symbols ()                  /*:((internal)) */
   a = acons (cell_type_vector, make_number (TVECTOR), a);
   a = acons (cell_type_broken_heart, make_number (TBROKEN_HEART), a);
 
+  /* types */
+  a = acons (cstring_to_symbol ("hash-table-type"), scm_hash_table_type, a);
+
+  /* the closure */
   a = acons (cell_closure, a, a);
 
   return a;