From b226a175f8943fed274104c00122b62cf390c82b Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Mon, 15 Oct 2018 20:42:10 +0200 Subject: [PATCH] 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. --- mes/module/srfi/srfi-9.mes | 2 +- mes/module/srfi/srfi-9/gnu.mes | 2 +- src/hash.c | 25 ++++++++++++++++--------- src/mes.c | 4 ++-- src/module.c | 33 ++++++++++++++++++++------------- 5 files changed, 40 insertions(+), 26 deletions(-) diff --git a/mes/module/srfi/srfi-9.mes b/mes/module/srfi/srfi-9.mes index 863cd6f0..4c97fa1a 120000 --- 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 d5857c78..248435f2 120000 --- 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 c334103b..6ddae79a 100644 --- 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"); + SCM record_type = record_type_name; // FIXME SCM hashq_type_name = cstring_to_symbol (""); 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 (""), 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 (""); + SCM record_type_name = cstring_to_symbol (""); + //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 (""); - 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 c0876c95..d8e79338 100644 --- 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 001efd20..c0b73740 100644 --- 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 (""); + SCM record_type = record_type_name; // FIXME SCM module_type_name = cstring_to_symbol (""); 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 (""), 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 (""); - 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 (""); - 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); }