mes: Switch to srfi-9 based on structs.

* mes/module/srfi/srfi-9.mes: Swap symlink to srfi-9-struct.mes.
* mes/module/srfi/srfi-9/gnu.mes: Swap symlink to gnu-struct.mes.
* src/module.c (make_module_type): Update to match srfi-9-struct
records.  Update users.
* src/hash.c (make_hashq_type): Likewise.

diff --git a/mes/module/srfi/srfi-9.mes b/mes/module/srfi/srfi-9.mes
index 863cd6f08550639a3724306ec8a5a23613866341..4c97fa1a899fbc3575813a840f8bf700883ef0dc 120000 (symlink)
--- a/mes/module/srfi/srfi-9.mes
+++ b/mes/module/srfi/srfi-9.mes
@@ -1 +1 @@
-srfi-9-vector.mes
\ No newline at end of file
+srfi-9-struct.mes
\ No newline at end of file

diff --git a/mes/module/srfi/srfi-9/gnu.mes b/mes/module/srfi/srfi-9/gnu.mes
index d5857c7817683f4d3abd851bcbab5dcfb4a6da64..248435f2313e146c58b4fc86ff2f81bc9e9f347e 120000 (symlink)
--- a/mes/module/srfi/srfi-9/gnu.mes
+++ b/mes/module/srfi/srfi-9/gnu.mes
@@ -1 +1 @@
-gnu-vector.mes
\ No newline at end of file
+gnu-struct.mes
\ No newline at end of file

diff --git a/src/hash.c b/src/hash.c
index c334103b95edb8119e6c5b4271405f345492e764..6ddae79adace858bfb1d667b26f5e5045a78f06d 100644 (file)
--- a/src/hash.c
+++ b/src/hash.c
@@ -52,7 +52,7 @@ SCM
 hashq_ref (SCM table, SCM key, SCM dflt)
 {
   unsigned hash = hashq_ (key, 0);
-  SCM buckets = struct_ref_ (table, 3);
+  SCM buckets = struct_ref_ (table, 4);
   SCM bucket = vector_ref_ (buckets, hash);
   SCM x = cell_f;
   if (TYPE (dflt) == TPAIR)
@@ -66,7 +66,7 @@ SCM
 hashq_set_x (SCM table, SCM key, SCM value)
 {
   unsigned hash = hashq_ (key, 0);
-  SCM buckets = struct_ref_ (table, 3);
+  SCM buckets = struct_ref_ (table, 4);
   SCM bucket = vector_ref_ (buckets, hash);
   if (TYPE (bucket) != TPAIR)
     bucket = cell_nil;
@@ -78,9 +78,9 @@ hashq_set_x (SCM table, SCM key, SCM 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 ("#<", g_stdout); display_ (struct_ref_ (table, 2)); fdputc (' ', g_stdout);
+  fdputs ("size: ", g_stdout); display_ (struct_ref_ (table, 3)); fdputc (' ', g_stdout);
+  SCM buckets = struct_ref_ (table, 4);
   fdputs ("buckets: ", g_stdout);
   for (int i=0; i<LENGTH (buckets); i++)
     {
@@ -104,13 +104,15 @@ hash_table_printer (SCM table)
 SCM
 make_hashq_type () ///((internal))
 {
+  SCM record_type_name = cstring_to_symbol ("<record-type>");
+  SCM record_type = record_type_name; // FIXME
   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);
   fields = cons (fields, cell_nil);
-  return make_struct (cstring_to_symbol ("<record-type>"), fields, cell_unspecified);
+  fields = cons (hashq_type_name, fields);
+  return make_struct (record_type, fields, cell_unspecified);
 }
 
 SCM
@@ -118,12 +120,17 @@ make_hash_table_ (long size)
 {
   if (!size)
     size = 30 * 27;
+  SCM hashq_type_name = cstring_to_symbol ("<hashq-table>");
+  SCM record_type_name = cstring_to_symbol ("<record-type>");
+  //SCM hashq_type = hashq_type_name; // FIXME
+  SCM hashq_type = make_hashq_type ();
+
   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);
+  values = cons (hashq_type_name, values);
+  return make_struct (hashq_type, values, cell_hash_table_printer);
 }
 
 SCM

diff --git a/src/mes.c b/src/mes.c
index c0876c957b18edb90ab0119c884571d08b3e8b9c..d8e79338b63fa2aefd18222b4d98b83e18b9d9ae 100644 (file)
--- a/src/mes.c
+++ b/src/mes.c
@@ -2415,9 +2415,9 @@ bload_env () ///((internal))
   gc_peek_frame ();
   g_symbols = r1;
   g_stdin = STDIN;
-  // SCM a = struct_ref (r0, 3);
+  // SCM a = struct_ref (r0, 4);
   // a = mes_builtins (a);
-  // struct_set_x (r0, 3, a);
+  // struct_set_x (r0, 4, a);
   r0 = mes_builtins (r0);
 
   if (g_debug > 3)

diff --git a/src/module.c b/src/module.c
index 001efd20c75b28dd7c731b33ef8f7ae06137358d..c0b737403bb7357744ad5fa69422bb7a5e34d1b2 100644 (file)
--- a/src/module.c
+++ b/src/module.c
@@ -24,23 +24,29 @@ SCM struct_set_x_ (SCM x, long i, SCM e);
 SCM
 make_module_type () ///(internal))
 {
+  SCM record_type_name = cstring_to_symbol ("<record-type>");
+  SCM record_type = record_type_name; // FIXME
   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 (module_type_name, fields);
   fields = cons (fields, cell_nil);
-  return make_struct (cstring_to_symbol ("<record-type>"), fields, cell_unspecified);
+  fields = cons (module_type_name, fields);
+  return make_struct (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, make_module_type (), a);
+  // SCM module_type = module_type_name; //FIXME
+  SCM module_type = make_module_type ();
+  a = acons (module_type_name, module_type, a);
+
+  SCM hashq_type = make_hashq_type ();
   SCM hashq_type_name = cstring_to_symbol ("<hashq-table>");
-  a = acons (hashq_type_name, make_hashq_type (), a);
+  a = acons (hashq_type_name, hashq_type, a);
 
   SCM name = cons (cstring_to_symbol ("boot"), cell_nil);
   SCM globals = make_hash_table_ (0);
@@ -50,11 +56,11 @@ make_initial_module (SCM a) ///((internal))
   values = cons (globals, values);
   values = cons (locals, values);
   values = cons (name, values);
-  SCM module = make_struct (module_type_name, values, cell_module_printer);
-
+  values = cons (module_type_name, values);
+  SCM module = make_struct (module_type, values, cell_module_printer);
   r0 = cell_nil;
+  r0 = cons (CADR (a), r0);
   r0 = cons (CAR (a), r0);
-
   m0 = module;
   while (TYPE (a) == TPAIR)
     {
@@ -72,10 +78,11 @@ make_initial_module (SCM a) ///((internal))
 SCM
 module_printer (SCM module)
 {
-  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);
+  //module = m0;
+  fdputs ("#<", g_stdout); display_ (struct_ref_ (module, 2)); fdputc (' ', g_stdout);
+  fdputs ("name: ", g_stdout); display_ (struct_ref_ (module, 3)); fdputc (' ', g_stdout);
+  fdputs ("locals: ", g_stdout); display_ (struct_ref_ (module, 4)); fdputc (' ', g_stdout);
+  SCM table = struct_ref_ (module, 5);
   fdputs ("globals:\n  ", g_stdout);
   display_ (table);
   fdputc ('>', g_stdout);
@@ -90,7 +97,7 @@ module_variable (SCM module, SCM name)
   if (x == cell_f)
     {
       module = m0;
-      SCM globals = struct_ref_ (module, 4);
+      SCM globals = struct_ref_ (module, 5);
       x = hashq_ref (globals, name, cell_f);
     }
   return x;
@@ -117,6 +124,6 @@ module_define_x (SCM module, SCM name, SCM value)
       eputs ("module_define_x: "); display_error_ (name); eputs ("\n");
     }
   module = m0;
-  SCM globals = struct_ref_ (module, 4);
+  SCM globals = struct_ref_ (module, 5);
   return hashq_set_x (globals, name, value);
 }