mes: Add hash-for-each. WIP! split me: fixup hash/make-hash table hacks.
* mes/module/mes/scm.mes (hash-for-each): New function. * mes/module/mes/type-0.mes (cell:type-name): Resurrect. * src/hash.c (hash_): Hack: allow non-string keys. (make_hash_table_type): Rename from make_hash_type. WIP (hash_table_p): New function. (hash_clear_x): New function. * src/module.c (make_module_type): Rewrite. (module_p): x (get_pre_modules_obarray): x
This commit is contained in:
parent
0f4b0ae04f
commit
524d6fd5ed
|
@ -71,7 +71,9 @@ struct scm *hashq_set_x (struct scm *table, struct scm *key, struct scm *value);
|
|||
struct scm *hash_set_x (struct scm *table, struct scm *key, struct scm *value);
|
||||
struct scm *hash_table_printer (struct scm *table);
|
||||
struct scm *make_hash_table (struct scm *x);
|
||||
struct scm *hash_table_p (struct scm *x);
|
||||
struct scm *hash_map_to_list (struct scm *proc, struct scm *table);
|
||||
struct scm *hash_clear_x (struct scm *table);
|
||||
/* src/lib.c */
|
||||
struct scm *type_ (struct scm *x);
|
||||
struct scm *car_ (struct scm *x);
|
||||
|
@ -99,10 +101,12 @@ struct scm *logxor (struct scm *x);
|
|||
struct scm *ash (struct scm *n, struct scm *count);
|
||||
/* src/module.c */
|
||||
struct scm *make_module_type ();
|
||||
struct scm *module_p (struct scm *module);
|
||||
struct scm *module_printer (struct scm *module);
|
||||
struct scm *module_variable (struct scm *module, struct scm *name);
|
||||
struct scm *module_ref (struct scm *module, struct scm *name);
|
||||
struct scm *module_define_x (struct scm *module, struct scm *name, struct scm *value);
|
||||
struct scm *get_pre_modules_obarray ();
|
||||
/* src/posix.c */
|
||||
struct scm *abort_ ();
|
||||
struct scm *exit_ (struct scm *x);
|
||||
|
|
|
@ -139,7 +139,7 @@ struct scm *make_value_cell (long type, long car, long cdr);
|
|||
struct scm *make_char (int n);
|
||||
struct scm *make_continuation (long n);
|
||||
struct scm *make_hash_table_ (long size);
|
||||
struct scm *make_hashq_type ();
|
||||
struct scm *make_hash_table_type ();
|
||||
struct scm *make_initial_module (struct scm *a);
|
||||
struct scm *make_macro (struct scm *name, struct scm *x);
|
||||
struct scm *make_number (long n);
|
||||
|
|
|
@ -205,6 +205,11 @@
|
|||
(define (hash-fold proc init table)
|
||||
(fold proc init (hash-map->list cons table)))
|
||||
|
||||
(define (hash-for-each proc table)
|
||||
(hash-map->list proc table)
|
||||
;;(hash-fold (lambda (key value x) (proc key value)) #f table)
|
||||
*unspecified*)
|
||||
|
||||
|
||||
;; Variable
|
||||
(define (make-undefined-variable)
|
||||
|
|
|
@ -45,7 +45,7 @@
|
|||
(cons <cell:broken-heart> (quote <cell:broken-heart>))))
|
||||
|
||||
(define (cell:type-name x)
|
||||
(cond ((assq (core:type x) cell:type-alist) => cdr)))
|
||||
(assq-ref cell:type-alist (core:type x)))
|
||||
|
||||
(define (bytes? x)
|
||||
(eq? (core:type x) <cell:bytes>))
|
||||
|
|
|
@ -180,8 +180,10 @@ mes_builtins (struct scm *a) /*:((internal)) */
|
|||
a = init_builtin (builtin_type, "hashq-set!", 3, &hashq_set_x, a);
|
||||
a = init_builtin (builtin_type, "hash-set!", 3, &hash_set_x, a);
|
||||
a = init_builtin (builtin_type, "hash-table-printer", 1, &hash_table_printer, a);
|
||||
a = init_builtin (builtin_type, "hash-table?", 1, &hash_table_p, a);
|
||||
a = init_builtin (builtin_type, "make-hash-table", -1, &make_hash_table, a);
|
||||
a = init_builtin (builtin_type, "hash-map->list", 2, &hash_map_to_list, a);
|
||||
a = init_builtin (builtin_type, "hash-clear!", 1, &hash_clear_x, a);
|
||||
/* src/lib.c */
|
||||
a = init_builtin (builtin_type, "core:type", 1, &type_, a);
|
||||
a = init_builtin (builtin_type, "core:car", 1, &car_, a);
|
||||
|
@ -209,10 +211,12 @@ mes_builtins (struct scm *a) /*:((internal)) */
|
|||
a = init_builtin (builtin_type, "ash", 2, &ash, a);
|
||||
/* src/module.c */
|
||||
a = init_builtin (builtin_type, "make-module-type", 0, &make_module_type, a);
|
||||
a = init_builtin (builtin_type, "module?", 1, &module_p, a);
|
||||
a = init_builtin (builtin_type, "module-printer", 1, &module_printer, a);
|
||||
a = init_builtin (builtin_type, "module-variable", 2, &module_variable, a);
|
||||
a = init_builtin (builtin_type, "module-ref", 2, &module_ref, a);
|
||||
a = init_builtin (builtin_type, "module-define!", 3, &module_define_x, a);
|
||||
a = init_builtin (builtin_type, "%get-pre-modules-obarray", 0, &get_pre_modules_obarray, a);
|
||||
/* src/posix.c */
|
||||
a = init_builtin (builtin_type, "abort", 0, &abort_, a);
|
||||
a = init_builtin (builtin_type, "exit", 1, &exit_, a);
|
||||
|
|
55
src/hash.c
55
src/hash.c
|
@ -46,13 +46,9 @@ hashq_ (struct scm *x, long size)
|
|||
int
|
||||
hash_ (struct scm *x, long size)
|
||||
{
|
||||
if (x->type != TSTRING)
|
||||
{
|
||||
eputs ("hash_ failed, not a string:");
|
||||
display_error_ (x);
|
||||
assert_msg (0, "0");
|
||||
}
|
||||
return hash_cstring (cell_bytes (x->string), size);
|
||||
if (x->type == TSTRING)
|
||||
return hash_cstring (cell_bytes (x->string), size);
|
||||
return 0;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
|
@ -175,15 +171,21 @@ hash_table_printer (struct scm *table)
|
|||
fdputc ('>', __stdout);
|
||||
}
|
||||
|
||||
struct scm *scm_hash_table_type; /* FIXME: gc */
|
||||
|
||||
struct scm *
|
||||
make_hashq_type () /*:((internal)) */
|
||||
make_hash_table_type () /*:((internal)) */
|
||||
{
|
||||
struct scm *fields = cell_nil;
|
||||
fields = cons (cell_symbol_buckets, fields);
|
||||
fields = cons (cell_symbol_size, fields);
|
||||
fields = cons (fields, cell_nil);
|
||||
fields = cons (cell_symbol_hashq_table, fields);
|
||||
return make_struct (cell_symbol_record_type, fields, cell_unspecified);
|
||||
if (scm_hash_table_type == 0)
|
||||
{
|
||||
struct scm *fields = cell_nil;
|
||||
fields = cons (cell_symbol_buckets, fields);
|
||||
fields = cons (cell_symbol_size, fields);
|
||||
fields = cons (fields, cell_nil);
|
||||
fields = cons (cell_symbol_hashq_table, fields);
|
||||
scm_hash_table_type = make_struct (cell_symbol_record_type, fields, cell_unspecified);
|
||||
}
|
||||
return scm_hash_table_type; /* FIXME: gc */
|
||||
}
|
||||
|
||||
struct scm *
|
||||
|
@ -191,7 +193,7 @@ make_hash_table_ (long size)
|
|||
{
|
||||
if (size == 0)
|
||||
size = 100;
|
||||
struct scm *hashq_type = make_hashq_type ();
|
||||
struct scm *type = make_hash_table_type ();
|
||||
|
||||
struct scm *buckets = make_vector_ (size, cell_unspecified);
|
||||
struct scm *values = cell_nil;
|
||||
|
@ -199,8 +201,17 @@ make_hash_table_ (long size)
|
|||
values = cons (make_number (size), values);
|
||||
values = cons (cell_symbol_hashq_table, values);
|
||||
/*FIXME: symbol/printer
|
||||
return make_struct (hashq_type, values, cstring_to_symbol ("hash-table-printer");*/
|
||||
return make_struct (hashq_type, values, cell_unspecified);
|
||||
return make_struct (type, values, cstring_to_symbol ("hash-table-printer");*/
|
||||
return make_struct (type, values, cell_unspecified);
|
||||
}
|
||||
|
||||
struct scm *
|
||||
hash_table_p (struct scm *table)
|
||||
{
|
||||
if (table->type == TSTRUCT
|
||||
&& struct_ref_ (table, 0) == scm_hash_table_type)
|
||||
return cell_t;
|
||||
return cell_f;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
|
@ -238,3 +249,13 @@ hash_map_to_list (struct scm *proc, struct scm *table)
|
|||
}
|
||||
return lst;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
hash_clear_x (struct scm *table)
|
||||
{
|
||||
struct scm *s = struct_ref_ (table, 3);
|
||||
long size = s->value;
|
||||
struct scm *buckets = make_vector_ (size, cell_unspecified);
|
||||
struct_set_x_ (table, 4, buckets);
|
||||
return cell_unspecified;
|
||||
}
|
||||
|
|
39
src/module.c
39
src/module.c
|
@ -21,16 +21,31 @@
|
|||
#include "mes/lib.h"
|
||||
#include "mes/mes.h"
|
||||
|
||||
struct scm *scm_module_type; /* FIXME: gc */
|
||||
|
||||
struct scm *
|
||||
make_module_type () /*:(internal)) */
|
||||
{
|
||||
struct 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 (fields, cell_nil);
|
||||
fields = cons (cell_symbol_module, fields);
|
||||
return make_struct (cell_symbol_record_type, fields, cell_unspecified);
|
||||
if (scm_module_type == 0)
|
||||
{
|
||||
struct 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 (fields, cell_nil);
|
||||
fields = cons (cell_symbol_module, fields);
|
||||
scm_module_type = make_struct (cell_symbol_record_type, fields, cell_unspecified);
|
||||
}
|
||||
return scm_module_type;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
module_p (struct scm *module)
|
||||
{
|
||||
if (module->type == TSTRUCT
|
||||
&& struct_ref_ (module, 0) == scm_module_type)
|
||||
return cell_t;
|
||||
return cell_f;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
|
@ -39,8 +54,8 @@ make_initial_module (struct scm *a) /*:((internal)) */
|
|||
struct scm *module_type = make_module_type ();
|
||||
a = acons (cell_symbol_module, module_type, a);
|
||||
|
||||
struct scm *hashq_type = make_hashq_type ();
|
||||
a = acons (cell_symbol_hashq_table, hashq_type, a);
|
||||
struct scm *hash_table_type = make_hash_table_type ();
|
||||
a = acons (cell_symbol_hashq_table, hash_table_type, a);
|
||||
|
||||
struct scm *name = cons (cstring_to_symbol ("boot"), cell_nil);
|
||||
struct scm *globals = make_hash_table_ (0);
|
||||
|
@ -114,3 +129,9 @@ module_define_x (struct scm *module, struct scm *name, struct scm *value)
|
|||
struct scm *globals = struct_ref_ (module, 5);
|
||||
return hashq_set_x (globals, name, value);
|
||||
}
|
||||
|
||||
struct scm *
|
||||
get_pre_modules_obarray () /*:((name . "%get-pre-modules-obarray")) */
|
||||
{
|
||||
return R0;
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue