从嵌套的plist树中获得可设置的位置?

Question

我有一个嵌套的pllist结构，例如:

(:title "A title"
:repeat (:row    #(:a :b :c)
:column #(:c :a :b))
:spec (:data my-data
:late t))

，我需要将:data设置为不同的值。挑战在于，这个键可能出现在树的任何位置，甚至可能比这个示例在树的更深处。它只会出现一次。我知道访问库，但不能使用它。我可以找到关键字很容易使用递归搜索:

(defun find-in-tree (item tree &key (test #'eql))
(labels ((find-in-tree-aux (tree)
(cond ((funcall test item tree)
(return-from find-in-tree tree))
((consp tree)
(find-in-tree-aux (car tree))
(find-in-tree-aux (cdr tree))))))
(find-in-tree-aux tree)))

但是我不太清楚当嵌套在树中时，是否有任何方法可以获得位置。最理想的是:

(setf (find-place-in-tree :data tree) 'foo)

就是我要找的。

任何想法?

Answer 1

我不能算出你的递归搜索器，所以我写了一个更简单的，它也解决了'项目是存在的，但值是nil'在通常的方式:

(defun find-in-tree (item tree &key (test #'eql))
;; really just use iterate here  
(labels ((fit-loop (tail)
(cond 
((null tail)
;; not there
(return-from find-in-tree (values nil nil)))
((null (rest tail))
;; not a plist
(error "botched plist"))
(t
(destructuring-bind (this val . more) tail
(cond
((funcall test this item)
;; gotit
(return-from find-in-tree (values val t)))
((consp val)
;; Search in the value if it's a list
(fit-loop val)
(fit-loop more))
(t
;; just keep down this list
(fit-loop more))))))))
(fit-loop tree)))

考虑到setf函数本质上是微不足道的，如果你不希望它添加条目(它不能总是这样做):

(defun (setf find-in-tree) (new item tree &key (test #'eql))
;; really just use iterate here  
(labels ((fit-loop (tail)
(cond 
((null tail)
(error "not in tree"))
((null (rest tail))
(error "botched plist"))
(t
(destructuring-bind (this val . more) tail
(cond
((funcall test this item)
(return-from find-in-tree
(car (setf (cdr tail) (cons new more)))))
((consp val)
(fit-loop val)
(fit-loop more))
(t
(fit-loop more))))))))
(fit-loop tree)))

Answer 2

这不是一个可设置的树。但是，对于嵌套plist，即使嵌套plist的键出现在多个位置，也可以构造类似set的就地突变宏。

plist-setf在嵌套列表中构造到所需键的路径。并将当前值替换为新值。在一个路径中，一个符号不应该出现两次。否则会出现严重的错误。

(defun plistp (l)
"Is `l` a plist?"
(loop for (k v) on l by #'cddr
always (symbolp k)))
(defun get-plist-paths (plist key &optional (acc '()))
"Which paths are in a nested plist for reaching key?"
(loop for (k v) on plist by #'cddr
nconcing (if (eq key k)
(list (reverse (cons key acc)))
(if (plistp v)
(get-plist-paths v key (cons k acc))
nil))))
(defun staple (plist plist-path)
"Given a plist-path, generate code to getf to this path."
(let ((res (list 'getf plist (car plist-path))))
(loop for s in (cdr plist-path)
do (setf res (cons 'getf (cons res (list s))))
finally (return res))))
(defun construct-call (plist plist-path new-value)
"Add to the generated code a `(setf ... new-value)."
`(setf ,(staple plist plist-path) ,new-value))
(defun construct-entire-call (plist-symbol plist key new-value)
"Generate the entire code for the macro."
(let ((plist-paths (get-plist-paths plist key)))
(cons 'progn
(loop for pp in plist-paths
collect (construct-call plist-symbol pp new-value)))))
(defmacro %plist-setf (plist key new-value)
"A macro to make the input of construct-entire-call more uniform."
`(construct-entire-call ',plist ,plist ,key ,new-value))
(defmacro plist-setf (plist key new-value)
"Automated setf of a key in a nested plist to set the location to the new-value."
(eval `(%plist-setf ,plist ,key ,new-value)))
;; the `eval` is needed to have an extra evaluation step here.
;; I am happy if someone can suggest a better alternative.
;; Or if someone can falsify its correctness here.

有些功能可以"解释"。通过一些例子:

(defparameter *pl* (list :points 5 :a (list :b 1 :c (list :d 0 :e 1) :f 2)))
(defparameter *pl1* (list :points 5 :a (list :b 1 :c (list :d 0 :e 1) :f 2 :e 3 :g (list :h 1 :e 1))))
(get-plist-path *pl1* :e)
;; => ((:A :C :E) (:A :E) (:A :G :E))
(construct-entire-call '*pl1* *pl1* :e 3)
;; (PROGN 
;;  (SETF (GETF (GETF (GETF *PL1* :A) :C) :E) 3) 
;;  (SETF (GETF (GETF *PL1* :A) :E) 3)
;;  (SETF (GETF (GETF (GETF *PL1* :A) :G) :E) 3))

(%plist-setf *pl1* :e 3)
;; (PROGN 
;;  (SETF (GETF (GETF (GETF *PL1* :A) :C) :E) 3) 
;;  (SETF (GETF (GETF *PL1* :A) :E) 3)
;;  (SETF (GETF (GETF (GETF *PL1* :A) :G) :E) 3))

用法:

(defparameter *pl1* (list :points 5 :a (list :b 1 :c (list :d 0 :e 1) :f 2 :e 3 :g (list :h 1 :e 1))))
(macroexpand-1 '(plist-setf *pl1* :e 3))
;; (PROGN 
;;   (SETF (GETF (GETF (GETF *PL1* :A) :C) :E) 3) 
;;   (SETF (GETF (GETF *PL1* :A) :E) 3)
;;   (SETF (GETF (GETF (GETF *PL1* :A) :G) :E) 3)) ;
;; T
*pl1*
;; => (:POINTS 5 :A (:B 1 :C (:D 0 :E 1) :F 2 :E 3 :G (:H 1 :E 1)))
;; after
(plist-setf *pl1* :e 3)
*pl1*
;; => (:POINTS 5 :A (:B 1 :C (:D 0 :E 3) :F 2 :E 3 :G (:H 1 :E 3)))

或者:

(defparameter *pl* (list :points 5 :a (list :b 1 :c (list :d 0 :e 1) :f 2)))
(macroexpand-1 '(plist-setf *pl* :e 3))
;; (PROGN (SETF (GETF (GETF (GETF *PL* :A) :C) :E) 3)) ;
;; T

*pl*
;; => (:POINTS 5 :A (:B 1 :C (:D 0 :E 1) :F 2))
(plist-setf *pl* :e 3)
*pl*
;; => (:POINTS 5 :A (:B 1 :C (:D 0 :E 3) :F 2))