Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

use defgenerics to avoid style warnings

  • Loading branch information...
commit 4359bc9511603f50b4451751bbec42a4dd418a6f 1 parent 3a78a10
@bobbysmith007 bobbysmith007 authored
Showing with 113 additions and 100 deletions.
  1. +35 −29 access.lisp
  2. +78 −71 arg-list-manipulation.lisp
View
64 access.lisp
@@ -81,40 +81,46 @@
(or (eql x y)
(equalp (cast x) (cast y)))))
-(defmethod plist-val (id list &key (test #'equalper) (key #'identity))
- "get a value out of a plist based on its key"
- (iter (for (k v) on list by #'cddr)
- (if (funcall test (funcall key k) id)
- (return v))))
-
-(defmethod rem-plist-val (id list &key (test #'equalper) (key #'identity))
- "removes key & its value from plist returning
- (values plist (list-of-values-removed))"
- (iter
- (for (k v) on list by #'cddr)
- (cond ((funcall test (funcall key k) id)
- (collect v into removed))
- (T (collect k into plist)
- (collect v into plist)))
- (finally (return (values plist removed)))))
+(defgeneric plist-val (id list &key test key )
+ (:documentation "get a value out of a plist based on its key")
+ (:method (id list &key (test #'equalper) (key #'identity))
+ (iter (for (k v) on list by #'cddr)
+ (if (funcall test (funcall key k) id)
+ (return v)))))
+
+(defgeneric rem-plist-val (id list &key test key)
+ (:documentation
+ "removes key & its value from plist returning
+ (values plist (list-of-values-removed))")
+ (:method (id list &key (test #'equalper) (key #'identity))
+ (iter
+ (for (k v) on list by #'cddr)
+ (cond ((funcall test (funcall key k) id)
+ (collect v into removed))
+ (T (collect k into plist)
+ (collect v into plist)))
+ (finally (return (values plist removed))))))
(defmacro rem-plist-val! (id place &key (test #'equalper) (key #'identity))
`(setf ,place
(rem-plist-val ,id ,place :test ,test :key ,key)))
-(defmethod set-plist-val (new id list &key (test #'equalper) (key #'identity))
- (iter
- (with collected)
- (for (k v) on list by #'cddr)
- (collect k into res)
- (if (funcall test (funcall key k) id)
- (progn (setf collected T)
- (collect new into res))
- (collect v into res))
- (finally
- (unless collected
- (setf res (list* id new res)))
- (return res))))
+(defgeneric set-plist-val (new id list &key test key)
+ (:documentation "If a key exists in the plist, set its value, otherwise add
+ this key to the dictionary")
+ (:method (new id list &key (test #'equalper) (key #'identity))
+ (iter
+ (with collected)
+ (for (k v) on list by #'cddr)
+ (collect k into res)
+ (if (funcall test (funcall key k) id)
+ (progn (setf collected T)
+ (collect new into res))
+ (collect v into res))
+ (finally
+ (unless collected
+ (setf res (list* id new res)))
+ (return res)))))
(defmacro set-plist-val! (new id place &key (test #'equalper) (key #'identity))
`(setf ,place
View
149 arg-list-manipulation.lisp
@@ -1,79 +1,86 @@
(in-package :access)
-(defmethod arg-list-key-value (id arg-list &key (test #'equalper) (key #'identity))
- "Given an &rest value that contains a (partial) lambda list with keys somewhere in it,
- find the specified value for a given key"
- (iter (for (k v . rest) on arg-list)
- (unless (keywordp k) (next-iteration))
- (when (funcall test (funcall key k) id)
- (return v))))
+(defgeneric arg-list-key-value (id arg-list &key test key)
+ (:documentation
+ "Given an &rest value that contains a (partial) lambda list with keys somewhere in it,
+ find the specified value for a given key")
+ (:method (id arg-list &key (test #'equalper) (key #'identity))
+ (iter (for (k v . rest) on arg-list)
+ (unless (keywordp k) (next-iteration))
+ (when (funcall test (funcall key k) id)
+ (return v)))))
-(defmethod set-arg-list-key-value (new id arg-list
- &key (test #'equalper) (key #'identity) ensure?)
- "Set the keyword parameter id to the value new
- if ensure? then only set if it doesnt exist (in which case new acts as a default)"
- (cond
- ((< (length arg-list) 2)
- (append arg-list (list id new)))
- (t (iter
- (with skip?)
- (with len-1 = (- (length arg-list) 1))
- (for i from 0)
- (for (k v . rest) on arg-list)
- (when skip? (setf skip? nil) (next-iteration))
- (cond
- ;; we didnt get a keyword, so not it
- ((not (keywordp k))
- (collect k into res)
- ;; if we are the last possible spot to check for
- ;; keywords make sure we collect the final v
- (when (and (null rest) (= i len-1))
- (collect v into res)))
- ;; when we are the key to set
- ((funcall test (funcall key k) id)
- (collect k into res)
- (collect (if ensure? v new) into res)
- (appending rest into res)
- (finish))
- ;; got a keyword, but not the correct one
- (t (collect k into res)
- ;; dont collect v if it is not a valid part of the arg-list
- ;; eg: '(:A :B :C) shouldnt collect an extra nil
- (unless (= i len-1) (collect v into res))
- (setf skip? t)))
- (when (null rest)
- (setf skip? t)
- (collect id into res)
- (collect new into res))
- (finally (return res))))))
+(defgeneric set-arg-list-key-value (new id arg-list &key test key ensure?)
+ (:documentation
+ "Set the keyword parameter id to the value new
+ if ensure? then only set if it doesnt exist (in which case new acts as a default)")
+ (:method (new id arg-list &key (test #'equalper) (key #'identity) ensure?)
+ (cond
+ ((< (length arg-list) 2)
+ (append arg-list (list id new)))
+ (t (iter
+ (with skip?)
+ (with len-1 = (- (length arg-list) 1))
+ (for i from 0)
+ (for (k v . rest) on arg-list)
+ (when skip? (setf skip? nil) (next-iteration))
+ (cond
+ ;; we didnt get a keyword, so not it
+ ((not (keywordp k))
+ (collect k into res)
+ ;; if we are the last possible spot to check for
+ ;; keywords make sure we collect the final v
+ (when (and (null rest) (= i len-1))
+ (collect v into res)))
+ ;; when we are the key to set
+ ((funcall test (funcall key k) id)
+ (collect k into res)
+ (collect (if ensure? v new) into res)
+ (appending rest into res)
+ (finish))
+ ;; got a keyword, but not the correct one
+ (t (collect k into res)
+ ;; dont collect v if it is not a valid part of the arg-list
+ ;; eg: '(:A :B :C) shouldnt collect an extra nil
+ (unless (= i len-1) (collect v into res))
+ (setf skip? t)))
+ (when (null rest)
+ (setf skip? t)
+ (collect id into res)
+ (collect new into res))
+ (finally (return res)))))))
-(defmethod ensure-arg-list-key-value (default id arg-list &key (test #'equalper) (key #'identity))
- "Ensure that a specific keyword has a value (or default) in an appliable arg list"
- (set-arg-list-key-value default id arg-list :ensure? t :test test :key key ))
+(defgeneric ensure-arg-list-key-value (default id arg-list &key test key)
+ (:documentation
+ "Ensure that a specific keyword has a value (or default) in an appliable arg list")
+ (:method (default id arg-list &key (test #'equalper) (key #'identity))
+ (set-arg-list-key-value default id arg-list :ensure? t :test test :key key )))
-(defmethod rem-arg-list-key-value (id arg-list
- &key (test #'equalper) (key #'identity)
- &aux removed-val)
- "Remove a specific keyword and value from the "
- (values
- (iter
- (with skip?)
- (with len-1 = (- (length arg-list) 1))
- (for i from 0)
- (for (k v . rest) on arg-list)
- (when skip? (setf skip? nil) (next-iteration))
- ;; when we are not the key to remove
- (cond
- ((not (keywordp k))
- (collect k))
- ((not (funcall test (funcall key k) id))
- (setf skip? t)
- (collect k)
- (unless (= i len-1) (collect v)))
- (T
- (setf skip? t)
- (setf removed-val v))))
- removed-val))
+(defgeneric rem-arg-list-key-value (id arg-list &key test key)
+ (:documentation
+ "Remove a specific keyword and value from the ")
+ (:method (id arg-list
+ &key (test #'equalper) (key #'identity)
+ &aux removed-val)
+ (values
+ (iter
+ (with skip?)
+ (with len-1 = (- (length arg-list) 1))
+ (for i from 0)
+ (for (k v . rest) on arg-list)
+ (when skip? (setf skip? nil) (next-iteration))
+ ;; when we are not the key to remove
+ (cond
+ ((not (keywordp k))
+ (collect k))
+ ((not (funcall test (funcall key k) id))
+ (setf skip? t)
+ (collect k)
+ (unless (= i len-1) (collect v)))
+ (T
+ (setf skip? t)
+ (setf removed-val v))))
+ removed-val)))
(defmacro set-arg-list-key-value! (new ids place &key (test '#'equalper) (key '#'identity))
`(progn
Please sign in to comment.
Something went wrong with that request. Please try again.