andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.
This commit is contained in:
Jan Nieuwenhuizen 2018-10-15 20:42:10 +02:00
parent 4ff9b36f26
commit b226a175f8
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
5 changed files with 40 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
mes/module/srfi/srfi-9.mes
View File

@ -1 +1 @@
srfi-9-vector.mes srfi-9-struct.mes

2
mes/module/srfi/srfi-9/gnu.mes
View File

@ -1 +1 @@
gnu-vector.mes gnu-struct.mes

25
src/hash.c
View File

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

4
src/mes.c
View File

@ -2415,9 +2415,9 @@ bload_env () ///((internal))
gc_peek_frame (); gc_peek_frame ();
g_symbols = r1; g_symbols = r1;
g_stdin = STDIN; g_stdin = STDIN;
// SCM a = struct_ref (r0, 3); // SCM a = struct_ref (r0, 4);
// a = mes_builtins (a); // a = mes_builtins (a);
// struct_set_x (r0, 3, a); // struct_set_x (r0, 4, a);
r0 = mes_builtins (r0); r0 = mes_builtins (r0);
if (g_debug > 3) if (g_debug > 3)

33
src/module.c
View File

@ -24,23 +24,29 @@ SCM struct_set_x_ (SCM x, long i, SCM e);
SCM SCM
make_module_type () ///(internal)) 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 module_type_name = cstring_to_symbol ("<module>");
SCM fields = cell_nil; SCM fields = cell_nil;
fields = cons (cstring_to_symbol ("globals"), fields); fields = cons (cstring_to_symbol ("globals"), fields);
fields = cons (cstring_to_symbol ("locals"), fields); fields = cons (cstring_to_symbol ("locals"), fields);
fields = cons (cstring_to_symbol ("name"), fields); fields = cons (cstring_to_symbol ("name"), fields);
fields = cons (module_type_name, fields);
fields = cons (fields, cell_nil); 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 SCM
make_initial_module (SCM a) ///((internal)) make_initial_module (SCM a) ///((internal))
{ {
SCM module_type_name = cstring_to_symbol ("<module>"); 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>"); 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 name = cons (cstring_to_symbol ("boot"), cell_nil);
SCM globals = make_hash_table_ (0); SCM globals = make_hash_table_ (0);
@ -50,11 +56,11 @@ make_initial_module (SCM a) ///((internal))
values = cons (globals, values); values = cons (globals, values);
values = cons (locals, values); values = cons (locals, values);
values = cons (name, 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 = cell_nil;
r0 = cons (CADR (a), r0);
r0 = cons (CAR (a), r0); r0 = cons (CAR (a), r0);
m0 = module; m0 = module;
while (TYPE (a) == TPAIR) while (TYPE (a) == TPAIR)
{ {
@ -72,10 +78,11 @@ make_initial_module (SCM a) ///((internal))
SCM SCM
module_printer (SCM module) module_printer (SCM module)
{ {
fdputs ("#<", g_stdout); display_ (struct_ref_ (module, 0)); fdputc (' ', g_stdout); //module = m0;
fdputs ("name: ", g_stdout); display_ (struct_ref_ (module, 2)); fdputc (' ', g_stdout); fdputs ("#<", g_stdout); display_ (struct_ref_ (module, 2)); fdputc (' ', g_stdout);
fdputs ("locals: ", g_stdout); display_ (struct_ref_ (module, 3)); fdputc (' ', g_stdout); fdputs ("name: ", g_stdout); display_ (struct_ref_ (module, 3)); fdputc (' ', g_stdout);
SCM table = struct_ref_ (m0, 4); fdputs ("locals: ", g_stdout); display_ (struct_ref_ (module, 4)); fdputc (' ', g_stdout);
SCM table = struct_ref_ (module, 5);
fdputs ("globals:\n ", g_stdout); fdputs ("globals:\n ", g_stdout);
display_ (table); display_ (table);
fdputc ('>', g_stdout); fdputc ('>', g_stdout);
@ -90,7 +97,7 @@ module_variable (SCM module, SCM name)
if (x == cell_f) if (x == cell_f)
{ {
module = m0; module = m0;
SCM globals = struct_ref_ (module, 4); SCM globals = struct_ref_ (module, 5);
x = hashq_ref (globals, name, cell_f); x = hashq_ref (globals, name, cell_f);
} }
return x; return x;
@ -117,6 +124,6 @@ module_define_x (SCM module, SCM name, SCM value)
eputs ("module_define_x: "); display_error_ (name); eputs ("\n"); eputs ("module_define_x: "); display_error_ (name); eputs ("\n");
} }
module = m0; module = m0;
SCM globals = struct_ref_ (module, 4); SCM globals = struct_ref_ (module, 5);
return hashq_set_x (globals, name, value); return hashq_set_x (globals, name, value);
} }