Re: Help with recursive destructive function

[Michael Heerdegen]

I <address@hidden> write:

> I tweaked it a bit and extended the idea for arrays.  Hope the comments
> are helpful.  Uses seq.el and cl-lib.

Here is a new version.  Changes:

- Uses gv places as references.

- Handles hash tables.  Therefore defines a place expressions to make
hash table keys setf'able (because I guess there are cases where you
need to modify hash table keys and not only values).

- Distinguishes modifying vs processing things.  Now the stack only
contains trees to process instead of refs.


#+begin_src emacs-lisp
;; -*- lexical-binding: t -*-

(eval-when-compile (require 'cl-lib))
(require 'seq)

(defun deep-edit-hash-key (key table)
  "Special place to make hash-table keys setf'able."
  (ignore table)
  key)

(gv-define-setter deep-edit-hash-key (new-key key table)
  (let ((val (make-symbol "val")))
    `(let ((,val (gethash ,key ,table)))
       (remhash ,key ,table)
       (puthash ,new-key ,val ,table))))


(defun deep-edit (needs-edit-predicate should-traverse-predicate data)
  ;; DATA is the structure to process.
  ;;
  ;; NEEDS-EDIT-PREDICATE is a function accepting one argument THING
  ;; that returns non-nil when THING is something to be replaced.  The
  ;; non-nil return value should be a function that when called with the
  ;; THING as argument returns the replacement for THING.  Example:
  ;; (lambda (thing) (and (stringp thing) #'upcase)) as
  ;; NEEDS-EDIT-PREDICATE would cause all strings to be replaced with
  ;; the upcased version.
  ;;
  ;; SHOULD-TRAVERSE-PREDICATE should return non-nil when the argument
  ;; needs to be traversed.
  (let ((stack (list data)))
    (cl-flet ((handle-refs
               (lambda (refs)
                 (dolist (ref refs)
                   (let ((val (gv-deref ref)))
                     (if-let ((modify-fun (funcall needs-edit-predicate val)))
                         (cl-callf (lambda (x) (funcall modify-fun x))
                             (gv-deref ref))
                       (when (funcall should-traverse-predicate val)
                         (push val stack))))))))
      (while stack
        (let ((current (pop stack)))
          (cond
           ((consp current)
            (handle-refs `(,(gv-ref (car current))
                           ,(gv-ref (cdr current)))))
           ((and (arrayp current) (not (stringp current)))
            (handle-refs
             (mapcar (lambda (idx) (gv-ref (aref current idx)))
                     (number-sequence 0 (1- (length current))))))
           ((hash-table-p current)
            (let ((refs '()))
              (maphash (lambda (key _val)
                         ;; Order matters here!
                         (push (gv-ref (gethash key current))            refs)
                         (push (gv-ref (deep-edit-hash-key key current)) refs))
                       current)
              (handle-refs (nreverse refs))))))))))

;; Example to try:
(let* ((a-hash-table (make-hash-table))
       (tree `("a" "b" "c"
               (2 ("d" . 3))
               (4 . "e")
               "f"
               (("g" . "h")
                (["i" "j"
                  ("k" "l")
                  nil
                  []
                  ,a-hash-table])))))
  (puthash 'a "a"          a-hash-table)
  (puthash 'b (list 2 "b") a-hash-table)
  (puthash "c" 3           a-hash-table)
  (puthash '(4 "d") "ddd"  a-hash-table)
  (deep-edit
   (lambda (thing) (and (stringp thing) #'upcase))
   (lambda (thing) (or (consp thing)
                       (arrayp thing)
                       (hash-table-p thing)))
   tree)
  tree)
#+end_src


Michael.