core: hashq-table: Refactor to be a record-like struct.

* src/hash.c (hash_table_printer): New function.
(make_hashq_type): New function.
* src/module.c (module_printer): Use it.
(make_module_type): New function.
(make_initial_module): Use them.

diff --git a/src/hash.c b/src/hash.c
index 84acb3611f08aa6075dc6e04261d14f93646076d..ea91a81d23190693b4f9111fa6043179cb5c6d4d 100644 (file)
--- a/src/hash.c
+++ b/src/hash.c
@@ -52,7 +52,8 @@ SCM
 hashq_ref (SCM table, SCM key, SCM dflt)
 {
   unsigned hash = hashq_ (key, 0);
-  SCM bucket = vector_ref_ (table, hash);
+  SCM buckets = struct_ref_ (table, 3);
+  SCM bucket = vector_ref_ (buckets, hash);
   SCM x = cell_f;
   if (TYPE (dflt) == TPAIR)
     x = CAR (dflt);
@@ -65,20 +66,63 @@ SCM
 hashq_set_x (SCM table, SCM key, SCM value)
 {
   unsigned hash = hashq_ (key, 0);
-  SCM bucket = vector_ref_ (table, hash);
+  SCM buckets = struct_ref_ (table, 3);
+  SCM bucket = vector_ref_ (buckets, hash);
   if (TYPE (bucket) != TPAIR)
     bucket = cell_nil;
   bucket = acons (key, value, bucket);
-  vector_set_x_ (table, hash, bucket);
+  vector_set_x_ (buckets, hash, bucket);
   return value;
 }
 
+SCM
+hash_table_printer (SCM table)
+{
+  fdputs ("#<", g_stdout); display_ (struct_ref_ (table, 0)); fdputc (' ', g_stdout);
+  fdputs ("size: ", g_stdout); display_ (struct_ref_ (table, 2)); fdputc (' ', g_stdout);
+  SCM buckets = struct_ref_ (table, 3);
+  fdputs ("buckets: ", g_stdout);
+  for (int i=0; i<LENGTH (buckets); i++)
+    {
+      SCM e = vector_ref_ (buckets, i);
+      if (e != cell_unspecified)
+        {
+          fdputc ('[', g_stdout);
+          while (TYPE (e) == TPAIR)
+            {
+              display_ (CAAR (e));
+              e = CDR (e);
+              if (TYPE (e) == TPAIR)
+                fdputc (' ', g_stdout);
+            }
+          fdputs ("]\n  ", g_stdout);
+        }
+    }
+  fdputc ('>', g_stdout);
+}
+
+SCM
+make_hashq_type () ///((internal))
+{
+  SCM hashq_type_name = cstring_to_symbol ("<hashq-table>");
+  SCM fields = cell_nil;
+  fields = cons (cstring_to_symbol ("buckets"), fields);
+  fields = cons (cstring_to_symbol ("size"), fields);
+  fields = cons (hashq_type_name, fields);
+  return make_struct (cstring_to_symbol ("record-type"), fields, cell_unspecified);
+}
+
 SCM
 make_hash_table_ (long size)
 {
   if (!size)
     size = 30 * 27;
-  return make_vector__ (size);
+  SCM buckets = make_vector__ (size);
+  SCM values = cell_nil;
+  values = cons (buckets, values);
+  values = cons (MAKE_NUMBER (size), values);
+  SCM hashq_type_name = cstring_to_symbol ("<hashq-table>");
+  return make_struct (hashq_type_name, values, cell_hash_table_printer);
 }
 
 SCM

diff --git a/src/module.c b/src/module.c
index 60c004125b6860078648ffae78e5b576a50a382d..92b0d8ca6b7aa4f3f7454009412105eb1700c32d 100644 (file)
--- a/src/module.c
+++ b/src/module.c
@@ -22,24 +22,35 @@ SCM struct_ref_ (SCM x, long i);
 SCM struct_set_x_ (SCM x, long i, SCM e);
 
 SCM
-make_initial_module (SCM a) ///((internal))
+make_module_type () ///(internal))
 {
+  SCM module_type_name = cstring_to_symbol ("<module>");
   SCM fields = cell_nil;
   fields = cons (cstring_to_symbol ("globals"), fields);
   fields = cons (cstring_to_symbol ("locals"), fields);
   fields = cons (cstring_to_symbol ("name"), fields);
-  fields = cons (cstring_to_symbol ("<module>"), fields);
-  SCM module_type = make_struct (cstring_to_symbol ("record-type"), fields, cell_unspecified);
+  fields = cons (module_type_name, fields);
+  return make_struct (cstring_to_symbol ("record-type"), fields, cell_unspecified);
+}
+
+SCM
+make_initial_module (SCM a) ///((internal))
+{
   SCM module_type_name = cstring_to_symbol ("<module>");
-  a = acons (module_type_name, module_type, a);
-  SCM values = cell_nil;
+  a = acons (module_type_name, make_module_type (), a);
+  SCM hashq_type_name = cstring_to_symbol ("<hashq-table>");
+  a = acons (hashq_type_name, make_hashq_type (), a);
+
   SCM name = cons (cstring_to_symbol ("boot"), cell_nil);
   SCM globals = make_hash_table_ (0);
-  values = cons (globals, values);
   SCM locals = cell_nil;
+
+  SCM values = cell_nil;
+  values = cons (globals, values);
   values = cons (locals, values);
   values = cons (name, values);
   SCM module = make_struct (module_type_name, values, cell_module_printer);
+
   r0 = cell_nil;
   r0 = cons (CAR (a), r0);
 
@@ -60,29 +71,13 @@ make_initial_module (SCM a) ///((internal))
 SCM
 module_printer (SCM module)
 {
-  eputs ("#<"); display_error_ (struct_ref_ (module, 0)); eputc (' ');
-  //eputs ("printer: "); display_error_ (struct_ref_ (module, 1)); eputc (' ');
-  eputs ("name: "); display_error_ (struct_ref_ (module, 2)); eputc (' ');
-  eputs ("locals: "); display_error_ (struct_ref_ (module, 3)); eputc (' ');
-  eputs ("globals:\n  ");
-  SCM v = struct_ref_ (m0, 4);
-  for (int i=0; i<LENGTH (v); i++)
-    {
-      SCM e = vector_ref_ (v, i);
-      if (e != cell_unspecified)
-        {
-          eputc ('[');
-          while (TYPE (e) == TPAIR)
-            {
-              display_error_ (CAAR (e));
-              e = CDR (e);
-              if (TYPE (e) == TPAIR)
-                eputc (' ');
-            }
-          eputs ("]\n  ");
-        }
-    }
-  eputc ('>');
+  fdputs ("#<", g_stdout); display_ (struct_ref_ (module, 0)); fdputc (' ', g_stdout);
+  fdputs ("name: ", g_stdout); display_ (struct_ref_ (module, 2)); fdputc (' ', g_stdout);
+  fdputs ("locals: ", g_stdout); display_ (struct_ref_ (module, 3)); fdputc (' ', g_stdout);
+  SCM table = struct_ref_ (m0, 4);
+  fdputs ("globals:\n  ", g_stdout);
+  display_ (table);
+  fdputc ('>', g_stdout);
 }
 
 SCM