mes: hash: Guile interface compatibility.
* src/hash.c (hashq_get_handle): Remove the dflt argument. (hashq_ref): Rename this... (hashq_ref_): ...to this, update for hashq_get_handle, and handle the dflt argument directly. (hash_ref): Rename this... (hash_ref_): ...to this, and fix handling of the dflt argument. * include/mes/builtins.h: Update accordingly. * src/eval-apply.c (macro_get_handle): Update for hashq_get_handle. * src/module.c (module_variable): Likewise. * src/builtins.c (mes_builtins): Set hashq-get-handle argument count to 2; rename hashq-ref to core:hashq-ref; and rename hash-ref to core:hash-ref. * mes/module/mes/scm.mes (hashq-ref, hash-ref): New procedures. * tests/hash.test: Add some tests. Co-authored-by: Timothy Sample <samplet@ngyro.com>
This commit is contained in:
parent
eac19abd29
commit
3339cd11dd
|
@ -64,9 +64,9 @@ struct scm *gc ();
|
|||
/* src/hash.c */
|
||||
struct scm *hashq (struct scm *x, struct scm *size);
|
||||
struct scm *hash (struct scm *x, struct scm *size);
|
||||
struct scm *hashq_get_handle (struct scm *table, struct scm *key, struct scm *dflt);
|
||||
struct scm *hashq_ref (struct scm *table, struct scm *key, struct scm *dflt);
|
||||
struct scm *hash_ref (struct scm *table, struct scm *key, struct scm *dflt);
|
||||
struct scm *hashq_get_handle (struct scm *table, struct scm *key);
|
||||
struct scm *hashq_ref_ (struct scm *table, struct scm *key, struct scm *dflt);
|
||||
struct scm *hash_ref_ (struct scm *table, struct scm *key, struct scm *dflt);
|
||||
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);
|
||||
|
|
|
@ -190,6 +190,15 @@
|
|||
(lambda args
|
||||
(proc (apply (apply compose rest) args)))))
|
||||
|
||||
|
||||
;; Hash
|
||||
|
||||
(define (hashq-ref table key . rest)
|
||||
(core:hashq-ref table key (and (pair? rest) (car rest))))
|
||||
|
||||
(define (hash-ref table key . rest)
|
||||
(core:hash-ref table key (and (pair? rest) (car rest))))
|
||||
|
||||
|
||||
;; Vector
|
||||
(define (vector . rest) (list->vector rest))
|
||||
|
|
|
@ -174,9 +174,9 @@ mes_builtins (struct scm *a) /*:((internal)) */
|
|||
/* src/hash.c */
|
||||
a = init_builtin (builtin_type, "hashq", 2, &hashq, a);
|
||||
a = init_builtin (builtin_type, "hash", 2, &hash, a);
|
||||
a = init_builtin (builtin_type, "hashq-get-handle", 3, &hashq_get_handle, a);
|
||||
a = init_builtin (builtin_type, "hashq-ref", 3, &hashq_ref, a);
|
||||
a = init_builtin (builtin_type, "hash-ref", 3, &hash_ref, a);
|
||||
a = init_builtin (builtin_type, "hashq-get-handle", 2, &hashq_get_handle, a);
|
||||
a = init_builtin (builtin_type, "core:hashq-ref", 3, &hashq_ref_, a);
|
||||
a = init_builtin (builtin_type, "core:hash-ref", 3, &hash_ref_, a);
|
||||
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);
|
||||
|
|
|
@ -158,7 +158,7 @@ struct scm *
|
|||
macro_get_handle (struct scm *name) /*:((internal)) */
|
||||
{
|
||||
if (name->type == TSYMBOL)
|
||||
return hashq_get_handle (g_macros, name, cell_nil);
|
||||
return hashq_get_handle (g_macros, name);
|
||||
return cell_f;
|
||||
}
|
||||
|
||||
|
|
18
src/hash.c
18
src/hash.c
|
@ -70,7 +70,7 @@ hash (struct scm *x, struct scm *size)
|
|||
}
|
||||
|
||||
struct scm *
|
||||
hashq_get_handle (struct scm *table, struct scm *key, struct scm *dflt)
|
||||
hashq_get_handle (struct scm *table, struct scm *key)
|
||||
{
|
||||
struct scm *s = struct_ref_ (table, 3);
|
||||
long size = s->value;
|
||||
|
@ -78,38 +78,38 @@ hashq_get_handle (struct scm *table, struct scm *key, struct scm *dflt)
|
|||
struct scm *buckets = struct_ref_ (table, 4);
|
||||
struct scm *bucket = vector_ref_ (buckets, hash);
|
||||
struct scm *x = cell_f;
|
||||
if (dflt->type == TPAIR)
|
||||
x = dflt->car;
|
||||
if (bucket->type == TPAIR)
|
||||
x = assq (key, bucket);
|
||||
return x;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
hashq_ref (struct scm *table, struct scm *key, struct scm *dflt)
|
||||
hashq_ref_ (struct scm *table, struct scm *key, struct scm *dflt)
|
||||
{
|
||||
struct scm *x = hashq_get_handle (table, key, dflt);
|
||||
struct scm *x = hashq_get_handle (table, key);
|
||||
if (x != cell_f)
|
||||
x = x->cdr;
|
||||
else
|
||||
x = dflt;
|
||||
return x;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
hash_ref (struct scm *table, struct scm *key, struct scm *dflt)
|
||||
hash_ref_ (struct scm *table, struct scm *key, struct scm *dflt)
|
||||
{
|
||||
struct scm *s = struct_ref_ (table, 3);
|
||||
long size = s->value;
|
||||
unsigned hash = hash_ (key, size);
|
||||
struct scm *buckets = struct_ref_ (table, 4);
|
||||
struct scm *bucket = vector_ref_ (buckets, hash);
|
||||
struct scm *x = cell_f;
|
||||
if (dflt->type == TPAIR)
|
||||
x = dflt->car;
|
||||
struct scm *x = dflt;
|
||||
if (bucket->type == TPAIR)
|
||||
{
|
||||
x = assoc (key, bucket);
|
||||
if (x != cell_f)
|
||||
x = x->cdr;
|
||||
else
|
||||
x = dflt;
|
||||
}
|
||||
return x;
|
||||
}
|
||||
|
|
|
@ -93,7 +93,7 @@ module_variable (struct scm *module, struct scm *name)
|
|||
{
|
||||
module = M0;
|
||||
struct scm *globals = struct_ref_ (module, 5);
|
||||
x = hashq_get_handle (globals, name, cell_f);
|
||||
x = hashq_get_handle (globals, name);
|
||||
}
|
||||
return x;
|
||||
}
|
||||
|
|
|
@ -114,7 +114,7 @@ keyword_to_string (struct scm *keyword)
|
|||
struct scm *
|
||||
string_to_symbol (struct scm *string)
|
||||
{
|
||||
struct scm *x = hash_ref (g_symbols, string, cell_f);
|
||||
struct scm *x = hash_ref_ (g_symbols, string, cell_f);
|
||||
if (x == cell_f)
|
||||
x = make_symbol (string);
|
||||
return x;
|
||||
|
|
|
@ -34,4 +34,40 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
|
|||
(pass-if "make-hash-table" (make-hash-table))
|
||||
(pass-if "make-hash-table with size" (make-hash-table 10))
|
||||
|
||||
(pass-if "symbol key round trip with ref"
|
||||
(let ((t (make-hash-table)))
|
||||
(hashq-set! t 'key 'value)
|
||||
(eq? (hashq-ref t 'key) 'value)))
|
||||
|
||||
(pass-if "string key round trip with ref"
|
||||
(let ((t (make-hash-table)))
|
||||
(hash-set! t "key" 'value)
|
||||
(eq? (hash-ref t "key") 'value)))
|
||||
|
||||
(pass-if "round trip with handle"
|
||||
(let ((t (make-hash-table)))
|
||||
(hashq-set! t 'key 'value)
|
||||
(equal? (hashq-get-handle t 'key) '(key . value))))
|
||||
|
||||
(pass-if "hashq-set! leaves other values alone"
|
||||
(let ((t (make-hash-table)))
|
||||
(hashq-set! t 'k1 'v1)
|
||||
(hashq-set! t 'k2 'v2)
|
||||
(hashq-set! t 'k1 'v3)
|
||||
(and (eq? (hashq-ref t 'k1) 'v3)
|
||||
(eq? (hashq-ref t 'k2) 'v2))))
|
||||
|
||||
(pass-if "hashq-ref with default"
|
||||
(let ((t (make-hash-table)))
|
||||
(eq? (hashq-ref t 'key 'value) 'value)))
|
||||
|
||||
(pass-if "hash-ref with default"
|
||||
(let ((t (make-hash-table 10)))
|
||||
;; Currently, Mes only looks at the first two characters when
|
||||
;; hashing. Taking advantage of this, we can try and test with and
|
||||
;; without hash collisions.
|
||||
(hash-set! t "ke" 'bar)
|
||||
(and (eq? (hash-ref t "key" 'foo) 'foo)
|
||||
(eq? (hash-ref t "k2" 'foo) 'foo))))
|
||||
|
||||
(result 'report)
|
||||
|
|
Loading…
Reference in New Issue