From d54c96afdf73a91dd4cbd11acdb5dfde0a3c98ae Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Wed, 13 Nov 2019 08:04:26 +0100 Subject: [PATCH] Revert "mes: Add hash-for-each. WIP! split me: fixup hash/make-hash table hacks." This reverts commit ef63ad04f8d412b168bb3696f79d677f5501a9db. --- include/mes/builtins.h | 4 --- include/mes/mes.h | 2 +- mes/module/mes/scm.mes | 5 ---- mes/module/mes/type-0.mes | 2 +- src/builtins.c | 4 --- src/hash.c | 55 ++++++++++++--------------------------- src/module.c | 39 +++++++-------------------- 7 files changed, 28 insertions(+), 83 deletions(-) diff --git a/include/mes/builtins.h b/include/mes/builtins.h index affab4ca..41fa68ee 100644 --- a/include/mes/builtins.h +++ b/include/mes/builtins.h @@ -71,9 +71,7 @@ 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); @@ -101,12 +99,10 @@ 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); diff --git a/include/mes/mes.h b/include/mes/mes.h index bf783eb2..5311887f 100644 --- a/include/mes/mes.h +++ b/include/mes/mes.h @@ -133,7 +133,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_hash_table_type (); +struct scm *make_hashq_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); diff --git a/mes/module/mes/scm.mes b/mes/module/mes/scm.mes index d8625a57..9909c426 100644 --- a/mes/module/mes/scm.mes +++ b/mes/module/mes/scm.mes @@ -205,11 +205,6 @@ (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) diff --git a/mes/module/mes/type-0.mes b/mes/module/mes/type-0.mes index 083a26b6..beefbf06 100644 --- a/mes/module/mes/type-0.mes +++ b/mes/module/mes/type-0.mes @@ -45,7 +45,7 @@ (cons (quote )))) (define (cell:type-name x) - (assq-ref cell:type-alist (core:type x))) + (cond ((assq (core:type x) cell:type-alist) => cdr))) (define (bytes? x) (eq? (core:type x) )) diff --git a/src/builtins.c b/src/builtins.c index b36aece7..e7c679d6 100644 --- a/src/builtins.c +++ b/src/builtins.c @@ -180,10 +180,8 @@ 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); @@ -211,12 +209,10 @@ 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); diff --git a/src/hash.c b/src/hash.c index 404cad55..a7977ec6 100644 --- a/src/hash.c +++ b/src/hash.c @@ -46,9 +46,13 @@ hashq_ (struct scm *x, long size) int hash_ (struct scm *x, long size) { - if (x->type == TSTRING) - return hash_cstring (cell_bytes (x->string), size); - return 0; + 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); } struct scm * @@ -172,21 +176,15 @@ hash_table_printer (struct scm *table) fdputc ('>', __stdout); } -struct scm *scm_hash_table_type; /* FIXME: gc */ - struct scm * -make_hash_table_type () /*:((internal)) */ +make_hashq_type () /*:((internal)) */ { - 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 *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); } struct scm * @@ -194,7 +192,7 @@ make_hash_table_ (long size) { if (size == 0) size = 100; - struct scm *type = make_hash_table_type (); + struct scm *hashq_type = make_hashq_type (); struct scm *buckets = make_vector_ (size, cell_unspecified); struct scm *values = cell_nil; @@ -202,17 +200,8 @@ make_hash_table_ (long size) values = cons (make_number (size), values); values = cons (cell_symbol_hashq_table, values); /*FIXME: symbol/printer - 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; + return make_struct (hashq_type, values, cstring_to_symbol ("hash-table-printer");*/ + return make_struct (hashq_type, values, cell_unspecified); } struct scm * @@ -250,13 +239,3 @@ 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; -} diff --git a/src/module.c b/src/module.c index d20d7584..413910ff 100644 --- a/src/module.c +++ b/src/module.c @@ -21,31 +21,16 @@ #include "mes/lib.h" #include "mes/mes.h" -struct scm *scm_module_type; /* FIXME: gc */ - struct scm * make_module_type () /*:(internal)) */ { - 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 *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); } struct scm * @@ -54,8 +39,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 *hash_table_type = make_hash_table_type (); - a = acons (cell_symbol_hashq_table, hash_table_type, a); + struct scm *hashq_type = make_hashq_type (); + a = acons (cell_symbol_hashq_table, hashq_type, a); struct scm *name = cons (cstring_to_symbol ("boot"), cell_nil); struct scm *globals = make_hash_table_ (0); @@ -129,9 +114,3 @@ 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; -}