Guest User

Untitled

a guest
Jun 20th, 2018
71
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.31 KB | None | 0 0
  1.  
  2. (defun defmethods-args-expander (args specifiers)
  3. (when (< (length args) (length specifiers))
  4. (error "Too many specifiers"))
  5. (labels
  6. ((inner (ar sr acc)
  7. (if (null ar)
  8. (nreverse acc)
  9. (inner (cdr ar)
  10. (cdr sr)
  11. (cons
  12. (if (null sr)
  13. (car ar)
  14. (list (car ar) (car sr)))
  15. acc)))))
  16. (inner args specifiers nil)))
  17.  
  18. (defun defmethods-clause-expander (name args clause)
  19. (destructuring-bind (specifiers &rest definition)
  20. clause
  21. (unless (listp specifiers)
  22. (setf specifiers (list specifiers)))
  23. `(defmethod ,name
  24. ,(defmethods-args-expander args specifiers)
  25. ,@definition)))
  26.  
  27. (defmacro defmethods (name (&rest args) &body clauses)
  28. (when (null args)
  29. (error "There is no argument"))
  30. `(progn
  31. ,@(mapcar
  32. #'(lambda (clause)
  33. (defmethods-clause-expander name args clause))
  34. clauses)))
  35.  
  36. (defgeneric size (object))
  37.  
  38. (defmethods size (object)
  39. (list (length object))
  40. (integer (integer-length object))
  41. (file-stream (file-length object)))
  42.  
  43. (defgeneric ref (object place))
  44.  
  45. (defmethods ref (object place)
  46. ((sequence integer) (elt object place))
  47. ((simple-vector integer) (svref object place))
  48. ((array integer) (aref object place))
  49. ((array list) (apply #'aref object place))
  50. ((list integer) (nth place object))
  51. ((list T) (assoc place object)))
Add Comment
Please, Sign In to add comment