, , . - , , . , , , , , , , ( ), , , , .
(defun find-element (element structure structure-p accessors &key (test 'eql))
(labels ((fe (thing path)
"If THING and ELEMENT are the same (under TEST), then
return PATH. Otherwise, if THING is a structure (as
checked with STRUCTURE-P), then iterate through
ACCESSORS and recurse on the result of each one
applied to THING."
(if (funcall test thing element)
;; return from the top level FIND-ELEMENT
;; call, not just from FE.
(return-from find-element path)
;; When THING is a structure, see what
;; each of the ACCESSORS returns, and
;; make a recursive call with it.
(when (funcall structure-p thing)
(dolist (accessor accessors)
(fe (funcall accessor thing)
(list* accessor path)))))))
;; Call the helper function
;; with an initial empty path
(fe structure '())))
, , , . :
(find-element 'waldo '(ralph waldo emerson) 'consp '(car cdr))
;=> (CAR CDR)
(car (cdr '(ralph waldo emerson))) waldo.
(find-element 'emerson '(ralph (waldo emerson)) 'consp '(first rest))
;=> (FIRST REST FIRST REST)
because (first (rest (first (rest '(ralph (waldo emerson))))))- emerson. Therefore, we solved the problem of obtaining a list of access functions. Now we need to create the actual expression. This is actually a fairly simple task using reduce:
(defun build-expression (accessor-path structure)
(reduce 'list accessor-path
:initial-value (list 'quote structure)
:from-end t))
This works the way we need it, while we also provide the structure. For instance:
(build-expression '(frog-on bump-on log-on hole-in bottom-of) '(the sea))
;=> (FROG-ON (BUMP-ON (LOG-ON (HOLE-IN (BOTTOM-OF '(THE SEA))))))
(build-expression '(branch-on limb-on tree-in bog-down-in) '(the valley o))
;=> (BRANCH-ON (LIMB-ON (TREE-IN (BOG-DOWN-IN '(THE VALLEY O)))))
Now we just need to put them together:
(defun where-is-waldo? (object)
(build-expression
(find-element 'waldo object 'consp '(first rest))
object))
This works the way we want:
(where-is-waldo? '(ralph waldo emerson))
;=> (FIRST (REST '(RALPH WALDO EMERSON)))
(where-is-waldo? '(mentor (ralph waldo emerson) (henry david thoreau)))
;=> (FIRST (REST (FIRST (REST '(MENTOR (RALPH WALDO EMERSON) (HENRY DAVID THOREAU))))))