Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (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)))
Add Comment
Please, Sign In to add comment