overloading-in-lisp.lisp

;;; quick and dirty C++ style overloading (assuming SBCL/CMUCL)
;;;
;;; disassemble FOO to verify that it doesn not go thu FROB, 
;;; but calls %FROB-SINGLE-FLOAT directly
;;;

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defvar *frob-specs* nil))

(defmacro deffrob (type lambda-list &body body)
  (let ((name (intern (format nil "%FROB-~A" type))))
    `(eval-when (:compile-toplevel :load-toplevel :execute)
       (push (cons ',type ',name) *frob-specs*)
       (defun ,name ,lambda-list ,@body))))

(deffrob fixnum (x y) (list :fixnum-frob x y))
(deffrob single-float (x y) (list :single-frob x y))

(macrolet ((seal ()
             `(progn (declaim (inline frob))
                     (defun frob (x y)
                       (etypecase x
                         ,@(mapcar (lambda (spec)
                                     `(,(car spec) (,(cdr spec) x y)))
                                   *frob-specs*))))))
  (seal))

(defun foo (x y)
  (declare (single-float x))
  (frob x y))