[alexandria-devel] Implementation of DELETE-FROM-PLIST

[James M. Lawrence]

On Sat, Feb 23, 2013 at 4:09 AM, Robert Smith <quad at symbo1ics.com> wrote:
>
> (defun delete-from-plist (plist &rest keys)
>   "Delete all keys and pairs indicated by KEYS from the plist PLIST."
>   (labels ((assert-proper-plist (x)
>              (assert x () "Expected a proper plist, got ~S" plist))
>            (bad-key-p (key)
>              (member key keys :test #'eq))
>            (find-first ()
>              "Find the first cons in PLIST to keep."
>              (loop :for the-cons :on plist :by #'cddr
>                    :unless (prog1 (bad-key-p (car the-cons))
>                              (assert-proper-plist (cdr the-cons)))
>                      :do (return the-cons)
>                    :finally (return nil))))
>     (declare (inline assert-proper-plist
>                      bad-key-p
>                      find-first))
>     ;; Find the first good key and delete any bad key-value pairs
>     ;; between it and the start.
>     (let ((first (find-first)))
>       (unless (eq first plist)
>         (setf (cddr plist)
>               first))
>
>       ;; At this point, we know FIRST points to the first key
>       ;; which exists, or NIL.
>       (loop :with last-good := first    ; Keep the last good key
>             :for the-cons :on (cddr first) :by #'cddr
>             :do (progn
>                   (assert-proper-plist (cdr the-cons))
>                   (if (bad-key-p (car the-cons))
>                       (setf (cddr last-good)
>                             (cddr the-cons))
>                       (setf last-good the-cons)))
>             :finally (return first)))))

Using two loops seems awkward to me. How about one?

(defun delete-from-plist (plist &rest keys)
  (loop with head = plist
        with tail = nil
        for (key . rest) on plist by #'cddr
        do (assert rest () "Expected a proper plist, got ~S" plist)
           (if (member key keys :test #'eq)
               (let ((next (cdr rest)))
                 (if tail
                     (setf (cdr tail) next)
                     (setf head next)))
               (setf tail rest))
        finally (return head)))