What with all this discussion on generalized collections (and the much
earlier discussion on generalized references), I've put some of my
collection code on my utilities page, in the file REFS.TGZ.
Most of what's actually implemented there (REF accessor, iterating over
collection elements) was written as part of another project, and only
recently yanked out and turned into something hopefully reusable.
There's also a bunch of defgenerics defining a first crack at a general
collection protocol, but there isn't much in the way of implementation.
I'll be fleshing out the rest of the system as my project goes on, but
if anybody else is interested in a standardized collection system, I'd
appreciate any feedback, suggestions, or criticism. Hopefully STL
hasn't
polluted it too much :-)
Anyway, here's a summary of the what's currently in the proposed
protocol:
;;;
;;; Getters. Overloaded via compiler-macros for speed and
specializability.
;;;
(defgeneric ref-0 (col)
(:documentation "Get the value of a scalar generalized reference."))
(defgeneric ref-1 (col key1)
(:documentation "Get the value of a 1-key generalized reference."))
(defgeneric ref-2 (col key1 key2)
(:documentation "Get the value of a 2-key generalized reference."))
(defgeneric ref-3 (col key1 key2 key3)
(:documentation "Get the value of a 3-key generalized reference."))
(defgeneric ref-4 (col key1 key2 key3 key4)
(:documentation "Get the value of a 4-key generalized reference."))
(defgeneric ref (col &rest indices)
(:documentation "Get the value of a generalized reference."))
(defgeneric index (col keys)
(:documentation
"Get from COL the values corresponding to the elements in KEYS,
into an ordered collection of the same type as KEYS."))
;;;
;;; Setters. Overloaded via compiler-macros for speed and
specializability.
;;;
(defgeneric set-ref-0 (val col)
(:documentation "Set the value of a scalar generalized reference."))
(defgeneric set-ref-1 (val col key1)
(:documentation "Set the value of a 1-key generalized reference."))
(defgeneric set-ref-2 (val col key1 key2)
(:documentation "Set the value of a 2-key generalized reference."))
(defgeneric set-ref-3 (val col key1 key2 key3)
(:documentation "Set the value of a 3-key generalized reference."))
(defgeneric set-ref-4 (val col key1 key2 key3 key4)
(:documentation "Set the value of a 4-key generalized reference."))
(defgeneric set-ref (val col &rest indices)
(:documentation "Set the value of a generalized reference."))
(defgeneric set-index (vals col keys)
(:documentation
"Set into COL the values from vals with the corresponding keys from
KEYS.
KEYS, VALS, and COL may be different collection types."))
;;;
;;; Introspection
;;;
(defgeneric growablep (col)
(:documentation "Is the collection growable?"))
(defgeneric orderedp (col)
(:documentation "Is this collection inherently ordered?"))
(defgeneric sequential-access-time (col)
(:documentation
"What is the per-element access time for iterate-over-xxx operations.
Returns one of :constant :linear :logarithmic :unknown."))
(defgeneric random-access-time (col)
(:documentation
"What is the per-element access time for random accesses.
Returns one of :constant :linear :logarithmic :unknown."))
(defgeneric duplicate-keys-allowed-p (col)
(:documentation "Does this collection allow duplicate keys?"))
(defgeneric key-type (col)
(:documentation "Returns a type specifier suitable for keys in this
collection"))
(defgeneric value-type (col)
(:documentation "Returns a type specifier suitable for values in this
collection"))
(defgeneric valid-key-type-p (col type)
(:documentation "Is this type appropriate for use as a key in this
collection?"))
(defgeneric valid-value-type-p (col type)
(:documentation "Is this type appropriate for use as a value in this
collection?"))
;;;
;;; Misc operations
;;;
(defgeneric add-to (col key val)
(:documentation "Inserts key->val into a growable collection."))
(defgeneric insert-into (col key val)
(:documentation "Inserts key->val into a growable ordered
collection."))
(defgeneric delete-from (col key)
(:documentation "Deletes key from a growable collection"))
(defgeneric delete-multiple-from (col keycol)
(:documentation
"Deletes the values from KEYCOL from growable collection COL.
The two collections do not need to be the same type."))
(defgeneric push-front (col val)
(:documentation
"Pushes value to the front of an ordered growable collection.
Returns both the new key and the modified collection."))
(defgeneric pop-front (col)
(:documentation
"Pops a value from the front of an ordered growable collection.
Returns both the value and the modified collection."))
(defgeneric push-back (col val)
(:documentation
"Pushes the value to the back of an ordered growable collection.
Returns both the new key and the modified collection."))
(defgeneric pop-back (col)
(:documentation
"Pops a value from the back of an ordered growable collection.
Returns both the value and the modified collection."))
(defgeneric size (col)
(:documentation
"Returns the number of distinct keys that are active in the
collection."))
(defgeneric room-left (col)
(:documentation
"Returns a generalized boolean. If no more positions are available, it
returns nil. If some unknown number are available, it returns t. If a
finite number are available, it returns that number."))
(defgeneric keys (col)
(:documentation
"Returns a list of the distinct keys in the collection."))
(defgeneric keyp (col key)
(:documentation "Returns true if they key is present in the
collection."))
(defgeneric iterate-over-keys (col fxn)
(:documentation
"Iterate the function over the keys of the collection for
side-effect."))
(defgeneric iterate-over-values (col fxn)
(:documentation
"Iterate the function over the values of the collection for
side-effect."))
(defgeneric iterate-over-keys-and-values (col fxn)
(:documentation
"Iterate the function over the keys and values of the collection for
side-effect."))
(defgeneric map-over-keys (col fxn)
(:documentation
"Map the function over the keys of the collection,
into a new collection of the same type."))
(defgeneric map-over-values (col fxn)
(:documentation
"Map the function over the values of the collection,
into a new collection of the same type."))
(defgeneric map-over-keys-and-values (col fxn &key test-if)
(:documentation
"Map the function over the keys and values of the collection,
into a new collection of the same type."))
(defgeneric map-into-keys (newcol oldcol fxn)
(:documentation
"Destructively map the function over the keys of the collection,
into another collection of the same type."))
(defgeneric map-into-values (newcol oldcol fxn)
(:documentation
"Destructively map the function over the values of the collection,
into another collection of the same type."))
(defgeneric map-into-keys-and-values (newcol oldcol fxn &key test-if)
(:documentation
"Destructively map the function over the keys and values of the
collection,
into another collection of the same type."))
(defgeneric reduce-values (col fxn identity-value)
(:documentation
"Use the binary function to combine the values in the collection."))
--------------------------------------------------------------------
And here's a chunk of some of the generalized-reference implementation
as well as some of the protocol implementation for REFERENCE (ala ML)
and SEQUENCE classes.
--------------------------------------------------------------------
(define-compiler-macro ref (&whole whole ref &rest indices)
(let ((num-indices (length indices)))
(cond ((= num-indices 0)
(list 'ref-0 ref))
((= num-indices 1)
(list 'ref-1 ref (first indices)))
((= num-indices 2)
(list* 'ref-2 ref indices))
((= num-indices 3)
(list* 'ref-3 ref indices))
((= num-indices 4)
(list* 'ref-4 ref indices))
(t whole))))
(defsetf ref (ref &rest indices) (val)
(declare (ignore indices))
(let ((num-indices (length indices)))
(cond ((= num-indices 0)
(list 'set-ref-0 val ref))
((= num-indices 1)
(list 'set-ref-1 val ref (first indices)))
((= num-indices 2)
(list* 'set-ref-2 val ref indices))
((= num-indices 3)
(list* 'set-ref-3 val ref indices))
((= num-indices 4)
(list* 'set-ref-4 val ref indices))
(t (list* 'set-ref val ref indices)))))
(defmethod ref-0 (col) (ref col))
(defmethod ref-1 (col key1) (ref col key1))
(defmethod ref-2 (col key1 key2) (ref col key1 key2))
(defmethod ref-3 (col key1 key2 key3) (ref col key1 key2 key3))
(defmethod ref-4 (col key1 key2 key3 key4) (ref col key1 key2 key3
key4))
(defmethod set-ref-0 (val col) (set-ref val col))
(defmethod set-ref-1 (val col key1) (set-ref val col key1))
(defmethod set-ref-2 (val col key1 key2) (set-ref val col key1 key2))
(defmethod set-ref-3 (val col key1 key2 key3) (set-ref val col key1 key2
key3))
(defmethod set-ref-4 (val col key1 key2 key3 key4) (set-ref val col key1
key2 key3 key4))
(eval-when (eval load :compile-toplevel)
(defmacro defref (type (col &rest indices) &rest body)
#+:Symbolics (declare (zwei:indentation 3 1))
(expand-defref type col indices body))
#+:Lispworks (editor:setup-indent "defref" 2 2 8)
(defvar *fast-ref-syms*
'((0 . ref-0) (1 . ref-1) (2 . ref-2) (3 . ref-3) (4 . ref-4)))
(defvar *fast-setref-syms*
'((0 . set-ref-0) (1 . set-ref-1) (2 . set-ref-2) (3 . set-ref-3) (4
. set-ref-4)))
(defun expand-defref (type col indices body)
(let* ((num-indices (length indices))
(fast-ref-p (and (<= num-indices 4)
(not (member '&optional indices))
(not (member '&rest indices))))
(ref-sym (if fast-ref-p
(cdr (assoc num-indices *fast-ref-syms* :test
#'=))
'ref)))
`(defmethod ,ref-sym ((,col ,type) ,@indices)
,@body)))
(defmacro defsetref (type (col &rest indices) (value) &rest body)
#+:Symbolics (declare (zwei:indentation 3 1))
(expand-defsetref type col indices value body))
#+:Lispworks (editor:setup-indent "defsetref" 2 2 8)
(defun expand-defsetref (type col indices value body)
(let* ((num-indices (length indices))
(fast-set-ref-p (and (<= num-indices 4)
(not (member '&optional indices))
(not (member '&rest indices))))
(set-ref-sym (if fast-set-ref-p
(cdr (assoc num-indices *fast-setref-syms*
:test #'=))
'set-ref)))
`(progn
(defmethod ,set-ref-sym (,value (,col ,type) ,@indices)
,@body
,value))))
)
(defun (setf ref) (val ref &rest indices)
(apply #'set-ref (cons val (cons ref indices))))
(defun (setf index) (vals ref keys)
(set-index vals ref keys))
(defsetf index (ref keys) (vals)
`(set-index ,vals ,ref ,keys))
(defmacro do-keys ((keyvar collection &optional result) &rest body)
#+:Symbolics (declare (zwei:indentation 1 1))
`(progn
(iterate-over-keys ,collection #'(lambda (,keyvar) ,@body))
,result))
#+:Lispworks (editor:setup-indent "do-keys" 1 2 4)
(defmacro do-values ((valvar collection &optional result) &rest body)
#+:Symbolics (declare (zwei:indentation 1 1))
`(progn
(iterate-over-values ,collection #'(lambda (,valvar) ,@body))
,result))
#+:Lispworks (editor:setup-indent "do-values" 1 2 4)
(defmacro do-keys-and-values ((keyvar valvar collection &optional
result) &rest body)
#+:Symbolics (declare (zwei:indentation 1 1))
`(progn
(iterate-over-keys-and-values ,collection #'(lambda (,keyvar
,valvar) ,@body))
,result))
#+:Lispworks (editor:setup-indent "do-keys-and-values" 1 2 4)
;;;
;;; Scalars
;;;
(defstruct (reference (:constructor reference (val)))
val)
(defref reference (reference)
(declare (reference reference))
(reference-val reference))
(defsetref reference (reference) (val)
(declare (reference reference))
(setf (reference-val reference) val))
(defref reference (reference (key (eql 0)))
(declare (reference reference))
(reference-val reference))
(defsetref reference (reference (key (eql 0))) (val)
(declare (reference reference))
(setf (reference-val reference) val))
(defmethod growablep ((reference reference))
(declare (ignore reference))
nil)
(defmethod sequential-access-time ((reference reference))
(declare (ignore reference))
:constant)
(defmethod random-access-time ((reference reference))
(declare (ignore reference))
:constant)
(defmethod orderedp ((reference reference))
(declare (ignore reference))
t)
(defmethod duplicate-keys-allowed-p ((reference reference))
(declare (ignore reference))
nil)
;; add not supported
;; delete not supported
(defmethod keys ((reference reference))
(declare (ignore reference))
(list 0))
(defmethod keyp ((reference reference) key)
(declare (ignore reference))
(zerop key))
(defmethod size ((reference reference))
(declare (ignore reference))
1)
(defmethod iterate-over-keys ((reference reference) fxn)
(declare (ignore reference))
(funcall fxn 0))
(defmethod iterate-over-values ((reference reference) fxn)
(declare (reference reference))
(funcall fxn (reference-val reference)))
(defmethod iterate-over-keys-and-values ((reference reference) fxn)
(declare (reference reference))
(funcall fxn 0 (reference-val reference)))
;;;
;;; Sequences
;;;
(defref sequence (seq key)
(elt seq key))
(defsetref sequence (seq key) (val)
(setf (elt seq key) val))
(defref sequence (seq start end)
(subseq seq start end))
(defsetref sequence (seq start end) (val)
(setf (subseq start end) val))
;; no implementation of growablep
(defmethod sequential-access-time ((seq sequence))
(declare (ignore seq))
:constant)
;; no implementation of random-access-time
(defmethod orderedp ((seq sequence))
(declare (ignore seq))
t)
(defmethod duplicate-keys-allowed-p ((seq sequence))
(declare (ignore seq))
nil)
(defmethod keys ((seq sequence))
(let ((len (length seq)))
(loop for i from 0 below len
collect i)))
(defmethod keyp ((seq sequence) key)
(< key (length seq)))
(defmethod size ((seq sequence))
(length seq))
(defmethod iterate-over-keys ((seq sequence) fxn)
(dotimes (i (length seq))
(funcall fxn i)))
(defmethod iterate-over-values ((seq sequence) fxn)
(dotimes (i (length seq))
(funcall fxn (elt seq i))))
(defmethod iterate-over-keys-and-values ((seq sequence) fxn)
(dotimes (i (length seq))
(funcall fxn i (elt seq i))))
Whoops, sorry. It's been a long day.
http://www.geocities.com/mparker762/cl-utils.html
Michael Parker wrote:
>
> What with all this discussion on generalized collections (and the much
> earlier discussion on generalized references), I've put some of my
> collection code on my utilities page, in the file REFS.TGZ.
>
> Most of what's actually implemented there (REF accessor, iterating over
> collection elements) was written as part of another project, and only
> recently yanked out and turned into something hopefully reusable.
>
> There's also a bunch of defgenerics defining a first crack at a general
> collection protocol, but there isn't much in the way of implementation.
> I'll be fleshing out the rest of the system as my project goes on, but
> if anybody else is interested in a standardized collection system, I'd
> appreciate any feedback, suggestions, or criticism. Hopefully STL
> hasn't
> polluted it too much :-)
>
> Anyway, here's a summary of the what's currently in the proposed
> protocol:
>
> ;;;
> ;;; Getters. Overloaded via compiler-macros for speed and
> specializability.
> ;;;
> (defgeneric ref-0 (col)
> (:documentation "Get the value of a scalar generalized reference."))
>
> (defgeneric ref-1 (col key1)
> (:documentation "Get the value of a 1-key generalized reference."))
>
> (defgeneric ref-2 (col key1 key2)
> (:documentation "Get the value of a 2-key generalized reference."))
>
> (defgeneric ref-3 (col key1 key2 key3)
> (:documentation "Get the value of a 3-key generalized reference."))
>
> (defgeneric ref-4 (col key1 key2 key3 key4)
> (:documentation "Get the value of a 4-key generalized reference."))
>
> (defgeneric ref (col &rest indices)
> (:documentation "Get the value of a generalized reference."))
>
> (defgeneric index (col keys)
> (:documentation
> "Get from COL the values corresponding to the elements in KEYS,
> into an ordered collection of the same type as KEYS."))
>
> ;;;
> ;;; Setters. Overloaded via compiler-macros for speed and
> specializability.
> ;;;
> (defgeneric set-ref-0 (val col)
> (:documentation "Set the value of a scalar generalized reference."))
>
> (defgeneric set-ref-1 (val col key1)
> (:documentation "Set the value of a 1-key generalized reference."))
>
> (defgeneric set-ref-2 (val col key1 key2)
> (:documentation "Set the value of a 2-key generalized reference."))
>
> (defgeneric set-ref-3 (val col key1 key2 key3)
> (:documentation "Set the value of a 3-key generalized reference."))
>
> (defgeneric set-ref-4 (val col key1 key2 key3 key4)
> (:documentation "Set the value of a 4-key generalized reference."))
>
> (defgeneric set-ref (val col &rest indices)
> (:documentation "Set the value of a generalized reference."))
>
> (defgeneric set-index (vals col keys)
> (:documentation
> "Set into COL the values from vals with the corresponding keys from
> KEYS.
> KEYS, VALS, and COL may be different collection types."))
>
> ;;;
> ;;; Introspection
> ;;;
> (defgeneric growablep (col)
> (:documentation "Is the collection growable?"))
>
> (defgeneric orderedp (col)
> (:documentation "Is this collection inherently ordered?"))
>
> (defgeneric sequential-access-time (col)
> (:documentation
> "What is the per-element access time for iterate-over-xxx operations.
> Returns one of :constant :linear :logarithmic :unknown."))
>
> (defgeneric random-access-time (col)
> (:documentation
> "What is the per-element access time for random accesses.
> Returns one of :constant :linear :logarithmic :unknown."))
>
> (defgeneric duplicate-keys-allowed-p (col)
> (:documentation "Does this collection allow duplicate keys?"))
>
> (defgeneric key-type (col)
> (:documentation "Returns a type specifier suitable for keys in this
> collection"))
>
> (defgeneric value-type (col)
> (:documentation "Returns a type specifier suitable for values in this
> collection"))
>
> (defgeneric valid-key-type-p (col type)
> (:documentation "Is this type appropriate for use as a key in this
> collection?"))
>
> (defgeneric valid-value-type-p (col type)
> (:documentation "Is this type appropriate for use as a value in this
> collection?"))
>
> ;;;
> ;;; Misc operations
> ;;;
> (defgeneric add-to (col key val)
> (:documentation "Inserts key->val into a growable collection."))
>
> (defgeneric insert-into (col key val)
> (:documentation "Inserts key->val into a growable ordered
> collection."))
>
> (defgeneric delete-from (col key)
> (:documentation "Deletes key from a growable collection"))
>
> (defgeneric delete-multiple-from (col keycol)
> (:documentation
> "Deletes the values from KEYCOL from growable collection COL.
> The two collections do not need to be the same type."))
>
> (defgeneric push-front (col val)
> (:documentation
> "Pushes value to the front of an ordered growable collection.
> Returns both the new key and the modified collection."))
>
> (defgeneric pop-front (col)
> (:documentation
> "Pops a value from the front of an ordered growable collection.
> Returns both the value and the modified collection."))
>
> (defgeneric push-back (col val)
> (:documentation
> "Pushes the value to the back of an ordered growable collection.
> Returns both the new key and the modified collection."))
>
> (defgeneric pop-back (col)
> (:documentation
> "Pops a value from the back of an ordered growable collection.
> Returns both the value and the modified collection."))
>
> (defgeneric size (col)
> (:documentation
> "Returns the number of distinct keys that are active in the
> collection."))
>
> (defgeneric room-left (col)
> (:documentation
> "Returns a generalized boolean. If no more positions are available, it
> returns nil. If some unknown number are available, it returns t. If a
> finite number are available, it returns that number."))
>
> (defgeneric keys (col)
> (:documentation
> "Returns a list of the distinct keys in the collection."))
>
> (defgeneric keyp (col key)
> (:documentation "Returns true if they key is present in the
> collection."))
>
> (defgeneric iterate-over-keys (col fxn)
> (:documentation
> "Iterate the function over the keys of the collection for
> side-effect."))
>
> (defgeneric iterate-over-values (col fxn)
> (:documentation
> "Iterate the function over the values of the collection for
> side-effect."))
>
> (defgeneric iterate-over-keys-and-values (col fxn)
> (:documentation
> "Iterate the function over the keys and values of the collection for
> side-effect."))
>
> (defgeneric map-over-keys (col fxn)
> (:documentation
> "Map the function over the keys of the collection,
> into a new collection of the same type."))
>
> (defgeneric map-over-values (col fxn)
> (:documentation
> "Map the function over the values of the collection,
> into a new collection of the same type."))
>
> (defgeneric map-over-keys-and-values (col fxn &key test-if)
> (:documentation
> "Map the function over the keys and values of the collection,
> into a new collection of the same type."))
>
> (defgeneric map-into-keys (newcol oldcol fxn)
> (:documentation
> "Destructively map the function over the keys of the collection,
> into another collection of the same type."))
>
> (defgeneric map-into-values (newcol oldcol fxn)
> (:documentation
> "Destructively map the function over the values of the collection,
> into another collection of the same type."))
>
> (defgeneric map-into-keys-and-values (newcol oldcol fxn &key test-if)
> (:documentation
> "Destructively map the function over the keys and values of the
> collection,
> into another collection of the same type."))
>
> (defgeneric reduce-values (col fxn identity-value)
> (:documentation
> "Use the binary function to combine the values in the collection."))
>
> --------------------------------------------------------------------
>
> And here's a chunk of some of the generalized-reference implementation
> as well as some of the protocol implementation for REFERENCE (ala ML)
> and SEQUENCE classes.
>
> --------------------------------------------------------------------
>
> (define-compiler-macro ref (&whole whole ref &rest indices)
> (let ((num-indices (length indices)))
> (cond ((= num-indices 0)
> (list 'ref-0 ref))
> ((= num-indices 1)
> (list 'ref-1 ref (first indices)))
> ((= num-indices 2)
> (list* 'ref-2 ref indices))
> ((= num-indices 3)
> (list* 'ref-3 ref indices))
> ((= num-indices 4)
> (list* 'ref-4 ref indices))
> (t whole))))
>
> (defsetf ref (ref &rest indices) (val)
> (declare (ignore indices))
> (let ((num-indices (length indices)))
> (cond ((= num-indices 0)
> (list 'set-ref-0 val ref))
> ((= num-indices 1)
> (list 'set-ref-1 val ref (first indices)))
> ((= num-indices 2)
> (list* 'set-ref-2 val ref indices))
> ((= num-indices 3)
> (list* 'set-ref-3 val ref indices))
> ((= num-indices 4)
> (list* 'set-ref-4 val ref indices))
> (t (list* 'set-ref val ref indices)))))
>
> (defmethod ref-0 (col) (ref col))
> (defmethod ref-1 (col key1) (ref col key1))
> (defmethod ref-2 (col key1 key2) (ref col key1 key2))
> (defmethod ref-3 (col key1 key2 key3) (ref col key1 key2 key3))
> (defmethod ref-4 (col key1 key2 key3 key4) (ref col key1 key2 key3
> key4))
>
> (defmethod set-ref-0 (val col) (set-ref val col))
> (defmethod set-ref-1 (val col key1) (set-ref val col key1))
> (defmethod set-ref-2 (val col key1 key2) (set-ref val col key1 key2))
> (defmethod set-ref-3 (val col key1 key2 key3) (set-ref val col key1 key2
> key3))
> (defmethod set-ref-4 (val col key1 key2 key3 key4) (set-ref val col key1
> key2 key3 key4))
>
> (eval-when (eval load :compile-toplevel)
>
> (defmacro defref (type (col &rest indices) &rest body)
> #+:Symbolics (declare (zwei:indentation 3 1))
> (expand-defref type col indices body))
> #+:Lispworks (editor:setup-indent "defref" 2 2 8)
>
> (defvar *fast-ref-syms*
> '((0 . ref-0) (1 . ref-1) (2 . ref-2) (3 . ref-3) (4 . ref-4)))
> (defvar *fast-setref-syms*
> '((0 . set-ref-0) (1 . set-ref-1) (2 . set-ref-2) (3 . set-ref-3) (4
> . set-ref-4)))
>
> (defun expand-defref (type col indices body)
> (let* ((num-indices (length indices))
> (fast-ref-p (and (<= num-indices 4)
> (not (member '&optional indices))
> (not (member '&rest indices))))
> (ref-sym (if fast-ref-p
> (cdr (assoc num-indices *fast-ref-syms* :test
> #'=))
> 'ref)))
> `(defmethod ,ref-sym ((,col ,type) ,@indices)
> ,@body)))
>
>
> (defmacro defsetref (type (col &rest indices) (value) &rest body)
> #+:Symbolics (declare (zwei:indentation 3 1))
> (expand-defsetref type col indices value body))
> #+:Lispworks (editor:setup-indent "defsetref" 2 2 8)
>
> (defun expand-defsetref (type col indices value body)
> (let* ((num-indices (length indices))
> (fast-set-ref-p (and (<= num-indices 4)
> (not (member '&optional indices))
> (not (member '&rest indices))))
> (set-ref-sym (if fast-set-ref-p
> (cdr (assoc num-indices *fast-setref-syms*
> :test #'=))
> 'set-ref)))
> `(progn
> (defmethod ,set-ref-sym (,value (,col ,type) ,@indices)
> ,@body
> ,value))))
>
> )
>
> (defun (setf ref) (val ref &rest indices)
> (apply #'set-ref (cons val (cons ref indices))))
>
> (defun (setf index) (vals ref keys)
> (set-index vals ref keys))
>
> (defsetf index (ref keys) (vals)
> `(set-index ,vals ,ref ,keys))
>
> (defmacro do-keys ((keyvar collection &optional result) &rest body)
> #+:Symbolics (declare (zwei:indentation 1 1))
> `(progn
> (iterate-over-keys ,collection #'(lambda (,keyvar) ,@body))
> ,result))
> #+:Lispworks (editor:setup-indent "do-keys" 1 2 4)
>
> (defmacro do-values ((valvar collection &optional result) &rest body)
> #+:Symbolics (declare (zwei:indentation 1 1))
> `(progn
> (iterate-over-values ,collection #'(lambda (,valvar) ,@body))
> ,result))
> #+:Lispworks (editor:setup-indent "do-values" 1 2 4)
>
> (defmacro do-keys-and-values ((keyvar valvar collection &optional
> result) &rest body)
> #+:Symbolics (declare (zwei:indentation 1 1))
> `(progn
> (iterate-over-keys-and-values ,collection #'(lambda (,keyvar
> ,valvar) ,@body))
> ,result))
> #+:Lispworks (editor:setup-indent "do-keys-and-values" 1 2 4)
>
> ;;;
> ;;; Scalars
> ;;;
> (defstruct (reference (:constructor reference (val)))
> val)
>
> (defref reference (reference)
> (declare (reference reference))
> (reference-val reference))
> (defsetref reference (reference) (val)
> (declare (reference reference))
> (setf (reference-val reference) val))
>
> (defref reference (reference (key (eql 0)))
> (declare (reference reference))
> (reference-val reference))
> (defsetref reference (reference (key (eql 0))) (val)
> (declare (reference reference))
> (setf (reference-val reference) val))
>
> (defmethod growablep ((reference reference))
> (declare (ignore reference))
> nil)
> (defmethod sequential-access-time ((reference reference))
> (declare (ignore reference))
> :constant)
> (defmethod random-access-time ((reference reference))
> (declare (ignore reference))
> :constant)
> (defmethod orderedp ((reference reference))
> (declare (ignore reference))
> t)
> (defmethod duplicate-keys-allowed-p ((reference reference))
> (declare (ignore reference))
> nil)
>
> ;; add not supported
> ;; delete not supported
> (defmethod keys ((reference reference))
> (declare (ignore reference))
> (list 0))
> (defmethod keyp ((reference reference) key)
> (declare (ignore reference))
> (zerop key))
> (defmethod size ((reference reference))
> (declare (ignore reference))
> 1)
>
> (defmethod iterate-over-keys ((reference reference) fxn)
> (declare (ignore reference))
> (funcall fxn 0))
>
> (defmethod iterate-over-values ((reference reference) fxn)
> (declare (reference reference))
> (funcall fxn (reference-val reference)))
>
> (defmethod iterate-over-keys-and-values ((reference reference) fxn)
> (declare (reference reference))
> (funcall fxn 0 (reference-val reference)))
>
> ;;;
> ;;; Sequences
> ;;;
> (defref sequence (seq key)
> (elt seq key))
> (defsetref sequence (seq key) (val)
> (setf (elt seq key) val))
>
> (defref sequence (seq start end)
> (subseq seq start end))
> (defsetref sequence (seq start end) (val)
> (setf (subseq start end) val))
>
> ;; no implementation of growablep
> (defmethod sequential-access-time ((seq sequence))
> (declare (ignore seq))
> :constant)
> ;; no implementation of random-access-time
> (defmethod orderedp ((seq sequence))
> (declare (ignore seq))
> t)
> (defmethod duplicate-keys-allowed-p ((seq sequence))
> (declare (ignore seq))
> nil)
>
> (defmethod keys ((seq sequence))
> (let ((len (length seq)))
> (loop for i from 0 below len
> collect i)))
> (defmethod keyp ((seq sequence) key)
> (< key (length seq)))
> (defmethod size ((seq sequence))
> (length seq))
>
> (defmethod iterate-over-keys ((seq sequence) fxn)
> (dotimes (i (length seq))
> (funcall fxn i)))
>
> (defmethod iterate-over-values ((seq sequence) fxn)
> (dotimes (i (length seq))
> (funcall fxn (elt seq i))))
>
> (defmethod iterate-over-keys-and-values ((seq sequence) fxn)
> (dotimes (i (length seq))
> (funcall fxn i (elt seq i))))
From: Dr. Edmund Weitz
Subject: Re: generalized collections/generalized reference accessor (long)
Date:
Message-ID: <m33czuf2af.fsf@bird.agharta.de>
Michael Parker <·······@pdq.net> writes:
> Whoops, sorry. It's been a long day.
>
> http://www.geocities.com/mparker762/cl-utils.html
The download link doesn't work, too. Should be 'ref.tgz' instead of
'refs.tgz'.
Thanks for making this available,
Edi.
--
Dr. Edmund Weitz
Hamburg
Germany
The Common Lisp Cookbook
<http://cl-cookbook.sourceforge.net/>