From 3dfbeb9c8d6cf1631df1c3799f4aca7636540893 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Wed, 13 Nov 2019 08:16:47 +0100 Subject: [PATCH] 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 | 1 + include/mes/mes.h | 4 +++- src/builtins.c | 1 + src/gc.c | 2 ++ src/hash.c | 33 +++++++++++++++++++++++---------- src/module.c | 4 ++-- src/symbol.c | 4 ++++ 7 files changed, 36 insertions(+), 13 deletions(-) diff --git a/include/mes/builtins.h b/include/mes/builtins.h index 41fa68ee..14f0f8a6 100644 --- a/include/mes/builtins.h +++ b/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); diff --git a/include/mes/mes.h b/include/mes/mes.h index 5311887f..9836b906 100644 --- a/include/mes/mes.h +++ b/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); diff --git a/src/builtins.c b/src/builtins.c index e7c679d6..5b5dee69 100644 --- a/src/builtins.c +++ b/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 */ diff --git a/src/gc.c b/src/gc.c index ef046af3..4f733b4c 100644 --- a/src/gc.c +++ b/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; diff --git a/src/hash.c b/src/hash.c index d9d9e08e..f898b41e 100644 --- a/src/hash.c +++ b/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 * diff --git a/src/module.c b/src/module.c index 413910ff..7a86022f 100644 --- a/src/module.c +++ b/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); diff --git a/src/symbol.c b/src/symbol.c index 9f622287..157274cd 100644 --- a/src/symbol.c +++ b/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;