[Maxima-discuss] proof of concept for iterating over hash tables

[Robert D. <rob...@gm...>]

Here's a proof of concept implementation for iterating over a hash
table using for-loop syntax. See the PS for a patch.

First create a Maxima hash table (undeclared array).

(%i1) foo[a, b]: 111 $
(%i2) foo[c, d]: 222 $
(%i3) foo[e, f]: 333 $

Now iterate over the key, value pairs. Variable kv holds both key and value.

(%i4) for kv in foo do print (kv[1], "-->", kv[2]);
[a, b] --> 111
[c, d] --> 222
[e, f] --> 333
(%o4)                               done

k is the key and v is the value. This makes use of the destructuring
assignment mechanism, which does things like [a, b]: [111, 222] to
assign 111 to a and 222 to b.

(%i5) for [k, v] in foo do print (k, "-->", v);
[a, b] --> 111
[c, d] --> 222
[e, f] --> 333
(%o5)                               done

Destructuring assignment again, but this time assign each of two keys
individually. Note that [[a, b], c]: [[11, 22], 33] assigns a: 11, b:
22, and c: 33.

(%i6) for [[k1, k2], v] in foo do print (k1, "and", k2, "-->", v);
a and b --> 111
c and d --> 222
e and f --> 333
(%o6)                               done

The code also works for value hash tables, as created by
make_array(hashed, ...) and use_fast_arrays: true.

What does anyone think of this stuff?

Robert

PS. Here's the patch. I wish to emphasize that THIS CODE IS FOR
DISCUSSION ONLY. IT MAY HAVE VARIOUS FLAWS AND CERTAINLY WILL NOT BE
COMMITTED WITHOUT FURTHER WORK. Anyway here it is.

git diff -- src/mlisp.lisp
diff --git a/src/mlisp.lisp b/src/mlisp.lisp
index e9a0bcd..6df019e 100644
--- a/src/mlisp.lisp
+++ b/src/mlisp.lisp
@@ -471,9 +471,9 @@ wrapper for this."
                            (cons (ncons fnname) lamvars))
                        (cons '(mlist) fnargs)))))
     (let ((var (car vars)))
-      (if (not (symbolp var))
+      #+nil (if (not (symbolp var))
          (merror (intl:gettext "Only symbols can be bound; found: ~M") var))
-      (let ((value (if (boundp var)
+      (let ((value #-nil (meval var) #+nil (if (boundp var)
                        (if (eq var '$errormsg)
                            ;; Do not take the actual value of $errormsg. It is
                            ;; always NIL at this point, but the value which
@@ -2229,11 +2229,31 @@ wrapper for this."
                        (merror (intl:gettext "do loop: illegal
'return': ~M") (car val)))
                       (t (return (car val))))))))

+(defun key-value-pairs-given-key-lists (x key-lists)
+  (mapcar (lambda (l) (list '(mlist) l (mfuncall '$arrayapply x l)))
key-lists))
+
+(defun key-value-pairs-for-hashed-array (x)
+  (let*
+    ((1-d-hash-table (gethash 'dim1 x))
+     (info (mfuncall '$arrayinfo x))
+     (keys-raw (cdddr info))
+     (key-lists (if 1-d-hash-table (mapcar (lambda (y) (cons '(mlist)
(list y))) keys-raw) keys-raw)))
+    (key-value-pairs-given-key-lists x key-lists)))
+
+(defun key-value-pairs-for-undeclared-array (x)
+  (let*
+    ((info (mfuncall '$arrayinfo x))
+     (key-lists (cdddr info)))
+    (key-value-pairs-given-key-lists x key-lists)))
+
 (defmspec mdoin (form)
   (setq form (cdr form))
   (funcall #'(lambda  (mdop my-var set test action)
               (setq set (if ($atom (setq set (format1 (meval (cadr form)))))
-                            (merror (intl:gettext "do loop: 'in'
argument must be a nonatomic expression; found: ~M") set)
+                            (cond
+                              ((hash-table-p set)
(key-value-pairs-for-hashed-array set))
+                              ((safe-mget set 'hashar)
(key-value-pairs-for-undeclared-array set))
+                              (t (merror (intl:gettext "do loop:
atomic 'in' argument must be a hashed or undeclared array; found: ~M")
set)))
                             (margs set))
                     test (list '(mor)
                                (if (car (cddddr form))