From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Michael Heerdegen Newsgroups: gmane.emacs.devel Subject: Re: Help with recursive destructive function Date: Thu, 10 May 2018 19:08:00 +0200 Message-ID: <87vabvbfrj.fsf@web.de> References: <87efiqzzd2.fsf@ericabrahamsen.net> <87bmdu3mtf.fsf@web.de> <87zi1e9kju.fsf@web.de> <87o9hs3aht.fsf@ericabrahamsen.net> <87bmds9qcg.fsf@web.de> <87k1sg185t.fsf@ericabrahamsen.net> <044bdbf1-39a2-0e71-ec79-3d375d9109c8@gmail.com> <877eof1k7y.fsf@ericabrahamsen.net> <87wowe2sql.fsf@web.de> <877eoe2dma.fsf@ericabrahamsen.net> <87tvrgqnug.fsf@web.de> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1525972013 8261 195.159.176.226 (10 May 2018 17:06:53 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Thu, 10 May 2018 17:06:53 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) Cc: emacs-devel@gnu.org To: Eric Abrahamsen Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Thu May 10 19:06:49 2018 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fGp1j-00020X-Qz for ged-emacs-devel@m.gmane.org; Thu, 10 May 2018 19:06:48 +0200 Original-Received: from localhost ([::1]:34840 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fGp3r-0007yi-00 for ged-emacs-devel@m.gmane.org; Thu, 10 May 2018 13:08:59 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:41637) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fGp3C-0007yS-2w for emacs-devel@gnu.org; Thu, 10 May 2018 13:08:19 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fGp37-0003ZD-2p for emacs-devel@gnu.org; Thu, 10 May 2018 13:08:18 -0400 Original-Received: from mout.web.de ([217.72.192.78]:37963) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1fGp36-0003Ye-Ob for emacs-devel@gnu.org; Thu, 10 May 2018 13:08:12 -0400 Original-Received: from drachen.dragon ([188.110.196.170]) by smtp.web.de (mrweb102 [213.165.67.124]) with ESMTPSA (Nemesis) id 0M2MYq-1eOzTR24qi-00s95A; Thu, 10 May 2018 19:08:01 +0200 In-Reply-To: <87tvrgqnug.fsf@web.de> (Michael Heerdegen's message of "Thu, 10 May 2018 03:52:07 +0200") X-Provags-ID: V03:K1:LTJWXrRVtR0gbzUabK0JKm+kZqxMcE9EMfj+HxaYSHyMifs/VJX Noquu30pNzK33X+MyeADwl/ZCT8EOjnTHjRIHLViG6NTSLecfGCrHS64CJU3Bpb3+0VOH/u kowc6uXNyiLGqXZlIAJirsOVVXKwNYU5zx5eAI8VguQBzupiz/GQ8MQLP5y/0Rd1L1PliDM vG4OGBCc/04LtNPJOt46Q== X-UI-Out-Filterresults: notjunk:1;V01:K0:5QgtNTeRAEw=:rcAsm6XO9x8XxYmwomd2KL MoUeaAhK6H815/98sdws1tA0oKIHq1GsVrA2/PMj08BKUlHnyC6OGpH8Irg5+jIcoR1/nsBLt b+8DCFXMLkrlxoqokGAZLNdPp73f/5IlTTRSbIsO4TsIiXa1FIth9vb95gcjuVmeOLvjaOFyX rjEvsN8hk/I60NCbGc7BW+Jv2qw7mSjVszCorPM46wbM+14y/vSLlmL0eRCWJodUqYHgVOX1K 35ryMREiqSE8gq9LEYrAckIdQoeREtAwMdBtBfH6h0cuXNzwPCacxmA9Ezfy8jMgfWXdXLCC8 yj+mvoFgOS0cFWxAsFKZEa0rGdVw/77Uy1xSupg0lncvTJjyAGP3Sm1j6jWDIZeYBS81rKp6N 6hR/v0Zt9hOSMLY2zKXV/68F7x5BWmaC6dDk9rDdpefizVslSDkEjKOh4tIFeHYN7AMu/dGr0 57PBiSXpIUT78448GFuLIdIOP6o0xT6lvRDc52zN3w1esyLjE1FRktSLbRlgF4TTYiB2ymbsr UK2JTVqI21GDl1BwzXBWfaUrDsB4nH6jLIcAsdkUjuDkXo9okscfBOYe4bCaV7WXXRDgnKoab DSRQXpJ9ZIbsU20tv17VG2sVlKnAGY/2Aflxk8PpEgXg2PBLmyehJ0UofZX5YC9kG3qGhZWIi /3XGkdzIW/14fgBkA+vwVsuX0S3Le/Uib8/JTN1HUjm4HRm/n05RBj+uuxo6lC3Gk9IdrMOEN D1c4Zz4U3KF4CrRGJO7mD38iWPlMrVwN8qrbM7evl6ccvaC4PhHPVIrsU5V1W1Qqnu8QwwVh X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] [fuzzy] X-Received-From: 217.72.192.78 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:225206 Archived-At: I 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.