Re: [alexandria-devel] Implementation of DELETE-FROM-PLIST
James M. Lawrence llmjj...@gmail.com writes: 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))) I mention this for completeness and novelty, not for suitability: (defun sans (plist rest keys) (let ((sans ())) (loop (let ((tail (nth-value 2 (get-properties plist keys ;; this is how it ends (unless tail (return (nreconc sans plist))) ;; copy all the unmatched keys (loop until (eq plist tail) do (push (pop plist) sans) (push (pop plist) sans)) ;; skip the matched key (setq plist (cddr plist)) I don't think I've seen GET-PROPERTIES and NRECONC outside this function. I got it from here: http://xach.com/naggum/articles/3247672165664225%40naggum.no.html Zach ___ alexandria-devel mailing list alexandria-devel@common-lisp.net http://lists.common-lisp.net/cgi-bin/mailman/listinfo/alexandria-devel
Re: [alexandria-devel] Implementation of DELETE-FROM-PLIST
Zach Beane x...@xach.com writes: James M. Lawrence llmjj...@gmail.com writes: 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))) I mention this for completeness and novelty, not for suitability: (defun sans (plist rest keys) (let ((sans ())) (loop (let ((tail (nth-value 2 (get-properties plist keys ;; this is how it ends (unless tail (return (nreconc sans plist))) ;; copy all the unmatched keys (loop until (eq plist tail) do (push (pop plist) sans) (push (pop plist) sans)) ;; skip the matched key (setq plist (cddr plist)) I don't think I've seen GET-PROPERTIES and NRECONC outside this function. I got it from here: http://xach.com/naggum/articles/3247672165664225%40naggum.no.html If striving for shortness: (defun delete-from-plist (plist rest keys) (dolist (key keys plist) (remf plist key))) -- With best regards, Stas. ___ alexandria-devel mailing list alexandria-devel@common-lisp.net http://lists.common-lisp.net/cgi-bin/mailman/listinfo/alexandria-devel
Re: [alexandria-devel] Implementation of DELETE-FROM-PLIST
Looks good! Much cleaner/better. -Robert On Sun, Feb 24, 2013 at 6:30 AM, James M. Lawrence llmjj...@gmail.com wrote: On Sat, Feb 23, 2013 at 4:09 AM, Robert Smith q...@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))) ___ alexandria-devel mailing list alexandria-devel@common-lisp.net http://lists.common-lisp.net/cgi-bin/mailman/listinfo/alexandria-devel ___ alexandria-devel mailing list alexandria-devel@common-lisp.net http://lists.common-lisp.net/cgi-bin/mailman/listinfo/alexandria-devel
