From d552ef7c671dcb588d4aaf479988e0f9754a955d Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Mon, 15 Oct 2018 13:36:19 +0200 Subject: [PATCH] core: Add hashq-table type. src/hash.c: New file. src/module.c (char_hash, module_hash): Remove. * src/module.c (make_initial_module): Use hash primitives. (module_define_x): Likewise. (module_variable): Likewise. * build-aux/snarf.sh: Snarf it. * src/mes.c: Include it. --- build-aux/snarf.sh | 1 + src/hash.c | 94 ++++++++++++++++++++++++++++++++++++++++++++++ src/mes.c | 7 ++++ src/module.c | 41 ++------------------ 4 files changed, 105 insertions(+), 38 deletions(-) create mode 100644 src/hash.c diff --git a/build-aux/snarf.sh b/build-aux/snarf.sh index 98b6e3e3..a77677f4 100755 --- a/build-aux/snarf.sh +++ b/build-aux/snarf.sh @@ -28,6 +28,7 @@ if [ -n "$1" ]; then snarf=.mes fi trace "SNARF$snarf gc.c" ${srcdest}build-aux/mes-snarf.scm $1 src/gc.c +trace "SNARF$snarf hash.c" ${srcdest}build-aux/mes-snarf.scm $1 src/hash.c trace "SNARF$snarf lib.c" ${srcdest}build-aux/mes-snarf.scm $1 src/lib.c trace "SNARF$snarf math.c" ${srcdest}build-aux/mes-snarf.scm $1 src/math.c trace "SNARF$snarf mes.c" ${srcdest}build-aux/mes-snarf.scm $1 src/mes.c diff --git a/src/hash.c b/src/hash.c new file mode 100644 index 00000000..84acb361 --- /dev/null +++ b/src/hash.c @@ -0,0 +1,94 @@ +/* -*-comment-start: "//";comment-end:""-*- + * GNU Mes --- Maxwell Equations of Software + * Copyright © 2018 Jan (janneke) Nieuwenhuizen + * + * This file is part of GNU Mes. + * + * GNU Mes is free software; you can redistribute it and/or modify it + * under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or (at + * your option) any later version. + * + * GNU Mes is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with GNU Mes. If not, see . + */ + +SCM make_vector__ (long k); +SCM vector_ref_ (SCM x, long i); +SCM vector_set_x_ (SCM x, long i, SCM e); + +int +char_hash (int c) +{ + if (c >= 'a' && c <= 'z') + return c - 'a'; + return 27; +} + +int +hashq_ (SCM x, long size) +{ + int hash = char_hash (VALUE (CAR (STRING (x)))) * 27; + if (TYPE (CDR (STRING (x))) == TPAIR) + hash = hash + char_hash (VALUE (CADR (STRING (x)))); + else + hash = hash + char_hash (0); + assert (hash <= 756); + return hash; +} + +int +hashq (SCM x, SCM size) +{ + return hashq_ (x, VALUE (size)); +} + +SCM +hashq_ref (SCM table, SCM key, SCM dflt) +{ + unsigned hash = hashq_ (key, 0); + SCM bucket = vector_ref_ (table, hash); + SCM x = cell_f; + if (TYPE (dflt) == TPAIR) + x = CAR (dflt); + if (TYPE (bucket) == TPAIR) + x = assq (key, bucket); + return x; +} + +SCM +hashq_set_x (SCM table, SCM key, SCM value) +{ + unsigned hash = hashq_ (key, 0); + SCM bucket = vector_ref_ (table, hash); + if (TYPE (bucket) != TPAIR) + bucket = cell_nil; + bucket = acons (key, value, bucket); + vector_set_x_ (table, hash, bucket); + return value; +} + +SCM +make_hash_table_ (long size) +{ + if (!size) + size = 30 * 27; + return make_vector__ (size); +} + +SCM +make_hash_table (SCM x) +{ + long size = 0; + if (TYPE (x) == TPAIR) + { + assert (TYPE (x) == TNUMBER); + size = VALUE (x); + } + return make_hash_table_ (size); +} diff --git a/src/mes.c b/src/mes.c index 6bcff0bf..0eb439f3 100644 --- a/src/mes.c +++ b/src/mes.c @@ -279,6 +279,7 @@ int g_function = 0; #if !__GNUC__ || !_POSIX_SOURCE #include "gc.mes.h" +#include "hash.mes.h" #include "lib.mes.h" #include "math.mes.h" #include "mes.mes.h" @@ -289,6 +290,7 @@ int g_function = 0; #include "vector.mes.h" #else #include "gc.h" +#include "hash.h" #include "lib.h" #include "math.h" #include "mes.h" @@ -1619,6 +1621,7 @@ mes_g_stack (SCM a) ///((internal)) // Environment setup +#include "hash.c" #include "module.c" #include "posix.c" #include "math.c" @@ -2229,6 +2232,7 @@ a = acons (list_to_symbol (scm_getenv_.string), cell_getenv_, a); #include "mes.mes.i" // Do not sort: Order of these includes define builtins +#include "hash.mes.i" #include "module.mes.i" #include "posix.mes.i" #include "math.mes.i" @@ -2239,6 +2243,7 @@ a = acons (list_to_symbol (scm_getenv_.string), cell_getenv_, a); #include "reader.mes.i" #include "gc.mes.environment.i" +#include "hash.mes.environment.i" #include "lib.mes.environment.i" #include "math.mes.environment.i" #include "mes.mes.environment.i" @@ -2251,6 +2256,7 @@ a = acons (list_to_symbol (scm_getenv_.string), cell_getenv_, a); #include "mes.i" // Do not sort: Order of these includes define builtins +#include "hash.i" #include "module.i" #include "posix.i" #include "math.i" @@ -2261,6 +2267,7 @@ a = acons (list_to_symbol (scm_getenv_.string), cell_getenv_, a); #include "reader.i" #include "gc.environment.i" +#include "hash.environment.i" #include "lib.environment.i" #include "math.environment.i" #include "mes.environment.i" diff --git a/src/module.c b/src/module.c index 9f2aacbf..60c00412 100644 --- a/src/module.c +++ b/src/module.c @@ -18,11 +18,8 @@ * along with GNU Mes. If not, see . */ -SCM make_vector__ (long k); SCM struct_ref_ (SCM x, long i); SCM struct_set_x_ (SCM x, long i, SCM e); -SCM vector_ref_ (SCM x, long i); -SCM vector_set_x_ (SCM x, long i, SCM e); SCM make_initial_module (SCM a) ///((internal)) @@ -37,8 +34,7 @@ make_initial_module (SCM a) ///((internal)) a = acons (module_type_name, module_type, a); SCM values = cell_nil; SCM name = cons (cstring_to_symbol ("boot"), cell_nil); - //SCM globals = make_vector__ (28 * 27); - SCM globals = make_vector__ (30 * 27); + SCM globals = make_hash_table_ (0); values = cons (globals, values); SCM locals = cell_nil; values = cons (locals, values); @@ -89,28 +85,6 @@ module_printer (SCM module) eputc ('>'); } - - -int -char_hash (int c) -{ - if (c >= 'a' && c <= 'z') - return c - 'a'; - return 27; -} - -int -module_hash (SCM x) ///((internal)) -{ - int hash = char_hash (VALUE (CAR (STRING (x)))) * 27; - if (TYPE (CDR (STRING (x))) == TPAIR) - hash = hash + char_hash (VALUE (CADR (STRING (x)))); - else - hash = hash + char_hash (0); - assert (hash <= 756); - return hash; -} - SCM module_variable (SCM module, SCM name) { @@ -119,12 +93,9 @@ module_variable (SCM module, SCM name) SCM x = assq (name, locals); if (x == cell_f) { - int hash = module_hash (name); module = m0; SCM globals = struct_ref_ (module, 4); - SCM bucket = vector_ref_ (globals, hash); - if (TYPE (bucket) == TPAIR) - x = assq (name, bucket); + x = hashq_ref (globals, name, cell_f); } return x; } @@ -149,13 +120,7 @@ module_define_x (SCM module, SCM name, SCM value) { eputs ("module_define_x: "); display_error_ (name); eputs ("\n"); } - int hash = module_hash (name); module = m0; SCM globals = struct_ref_ (module, 4); - SCM bucket = vector_ref_ (globals, hash); - if (TYPE (bucket) != TPAIR) - bucket = cell_nil; - bucket = acons (name, value, bucket); - vector_set_x_ (globals, hash, bucket); - return cell_t; + return hashq_set_x (globals, name, value); }