define-generic-safe

[Clinton Ebadi]

It doesn't seem like define-generic should do (make <generic> #:name ,name) 
for a generic when you define-generic on an existing generic. There should 
probably be something like a destroy-generic! procedure to erase a generics 
methods, but since that doesn't exist I modified define-generic to create 
define-generic-safe that doesn't do anything to the generic if it is already 
a generic. This is just a simple one line change, but other people might find 
it useful.

For the 1.6 release branch

(define define-generic-safe
  (procedure->macro
    (lambda (exp env)
      (let ((name (cadr exp)))
        (cond ((not (symbol? name))
               (goops-error "bad generic function name: ~S" name))
              ((defined? name env)
               `(define ,name
                  (if (is-a? ,name <generic>)
                    ,name ; changed line
                    (ensure-generic ,name ',name))))
              (else
               `(define ,name (make <generic> #:name ',name))))))))

For cvs HEAD (I think it works, but I can't get HEAD to finish compiling 
because it gives "lt-guile: relocation error: 
/usr/local/lib/libqthreads.so.15: undefined symbol: __bb_init_func" at the 
end of the compile).

(define define-generic-safe
  (procedure->memoizing-macro
   (lambda (exp env)
     (let ((name (cadr exp)))
       (cond ((not (symbol? name))
              (goops-error "bad generic function name: ~S" name))
             ((top-level-env? env)
              `(let* ((var (module-ensure-local-variable!
                            (current-module) ',name))
                      (old (and (variable-bound? var) (variable-ref var))))
                 (if (or (not old) (is-a? old <generic>))
                   (variable-set! var ,name) ; changed line
                   (variable-set! var (ensure-generic old ',name)))))
             (else
              `(define ,name (make <generic> #:name ',name))))))))

-- 
http://unknownlamer.org
Flag Burner.