core: Add hash-map->list.

* src/hash.c (hash_buckets): New function.
* src/builtins.c (mes_builtins): Initialize it.
* include/mes/builtins.h: Declare it.
* mes/module/mes/scm.mes (hash-map->list): New procedure.
* tests/hash.test: Add a test.
* tests/gc.test: Bump arena size to handle more built-ins.

Co-authored-by: Timothy Sample <samplet@ngyro.com>

include/mes/builtins.h

@@ -71,6 +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_buckets (struct scm *table);
 /* src/lib.c */
 struct scm *type_ (struct scm *x);
 struct scm *car_ (struct scm *x);

mes/module/mes/scm.mes

@@ -2,6 +2,7 @@
 
 ;;; GNU Mes --- Maxwell Equations of Software
 ;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2022 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of GNU Mes.
 ;;;
@@ -199,6 +200,21 @@
 (define (hash-ref table key . rest)
   (core:hash-ref table key (and (pair? rest) (car rest))))
 
+(define (hash-map->list proc table)
+  (let ((buckets (hash-buckets table)))
+    (let loop ((i 0) (acc '()))
+      (if (>= i (vector-length buckets))
+          (reverse! acc)
+          (let ((alist (vector-ref buckets i)))
+            (loop (+ i 1)
+                  (if (eq? alist *unspecified*)
+                      acc
+                      (append-reverse (map (lambda (handle)
+                                             (proc (car handle)
+                                                   (cdr handle)))
+                                           alist)
+                                      acc))))))))
+
 
 ;; Vector
 (define (vector . rest) (list->vector rest))

src/builtins.c

@@ -181,6 +181,7 @@ mes_builtins (struct scm *a)            /*:((internal)) */
   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, "make-hash-table", -1, &make_hash_table, a);
+  a = init_builtin (builtin_type, "hash-buckets", 1, &hash_buckets, a);
   /* src/lib.c */
   a = init_builtin (builtin_type, "core:type", 1, &type_, a);
   a = init_builtin (builtin_type, "core:car", 1, &car_, a);

src/hash.c

@@ -216,3 +216,9 @@ make_hash_table (struct scm *x)              /*:((arity . n)) */
     }
   return make_hash_table_ (size);
 }
+
+struct scm *
+hash_buckets (struct scm *table)
+{
+  return struct_ref_ (table, 4);
+}

tests/gc.test

@@ -1,6 +1,6 @@
 #! /bin/sh
 # -*-scheme-*-
-MES_ARENA=10000
+MES_ARENA=20000
 MES_MAX_ARENA=$MES_ARENA
 export MES_ARENA
 export MES_MAX_ARENA

tests/hash.test

@@ -70,4 +70,14 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
     (and (eq? (hash-ref t "key" 'foo) 'foo)
          (eq? (hash-ref t "k2" 'foo) 'foo))))
 
+(pass-if "hash-map->list"
+  (let ((t (make-hash-table)))
+    (hash-set! t "first" 1)
+    (hash-set! t "second" 2)
+    (hash-set! t "third" 3)
+    (let ((a (hash-map->list cons t)))
+      (and (= (assoc-ref a "first") 1)
+           (= (assoc-ref a "second") 2)
+           (= (assoc-ref a "third") 3)))))
+
 (result 'report)