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

@@ -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

src/hash.c

@@ -0,0 +1,94 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * GNU Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * 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 <http://www.gnu.org/licenses/>.
+ */
+
+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);
+}

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"

src/module.c

@@ -18,11 +18,8 @@
  * along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-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);
 }