Generic functions for Gambit Scheme... in just 45 lines of code.

generics#.scm

(namespace ("generics#"
  dispatch-generic
  generic-methods-box
  ))

(define-macro (define-generic form)
  `(define ,(car form)
     (let (($methods (box '())))
       (lambda args
	 (dispatch-generic (unbox $methods) args)))))

(define-macro (add-method form . body)
  (let* ((generic-name (car form))
	 (args (cdr form))
	 (arg-names (map cadr args)))
    `(let (($methods (generic-methods-box ,generic-name)))
       (set-box! $methods (cons
			    (cons
			      (lambda ,arg-names
				(and ,@args))
			      (lambda ,arg-names
				,@body))
			    (unbox $methods))))))

generics.scm

(include "generics#.scm")

(define (dispatch-generic method-table args)
  (let method-loop ((methods-left method-table))
    (cond
      ((null? methods-left)
       (error (string-append
		"generic has no method which accepts "
		(object->string args))))
      ((apply (caar methods-left) args)
       (apply (cdar methods-left) args))
      (else
       (method-loop (cdr methods-left))))))

(define (generic-methods-box generic)
  (cond
    ((##interp-procedure? generic)
     (##vector-ref (##interp-procedure-rte generic) 1))
    ((##closure? generic)
     (##closure-ref generic 1))
    (else
     (error (string-append (object->string generic) " is not a generic")))))