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.
This commit is contained in:
parent
999642052b
commit
8c0a517edf
52
src/hash.c
52
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
|
||||
|
|
53
src/module.c
53
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
|
||||
|
|
Loading…
Reference in a new issue