2010年11月3日水曜日

lengthとeltのgeneric-function版

Common Lispパッケージの内容を上書きするのはよろしく無いのではと思い、適当な名前でタイトル通りのものを書いてみました。

(defun defmethods-args-expander (args specifiers)
(when (< (length args) (length specifiers))
(error "Too many specifiers"))
(labels
((inner (ar sr acc)
(if (null ar)
(nreverse acc)
(inner (cdr ar)
(cdr sr)
(cons
(if (null sr)
(car ar)
(list (car ar) (car sr)))
acc)))))
(inner args specifiers nil)))

(defun defmethods-clause-expander (name args clause)
(destructuring-bind (specifiers &rest definition)
clause
(unless (listp specifiers)
(setf specifiers (list specifiers)))
`(defmethod ,name
,(defmethods-args-expander args specifiers)
,@definition)))

(defmacro defmethods (name (&rest args) &body clauses)
(when (null args)
(error "There is no argument"))
`(progn
,@(mapcar
#'(lambda (clause)
(defmethods-clause-expander name args clause))
clauses)))

(defgeneric size (object))

(defmethods size (object)
(list (length object))
(integer (integer-length object))
(file-stream (file-length object)))

(defgeneric ref (object place))

(defmethods ref (object place)
((sequence integer) (elt object place))
((simple-vector integer) (svref object place))
((array integer) (aref object place))
((array list) (apply #'aref object place))
((list integer) (nth place object))
((list T) (assoc place object)))

0 件のコメント:

コメントを投稿