|
From: Robert D. <rob...@gm...> - 2025-11-18 07:49:59
|
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))
|