[plt-scheme] detecting duplicate internal definitions

On May 10, Doug Orleans wrote:
> This is both a Swindle bug report and a macro question/feature-request.
> 
> I think this should work in Swindle, but it doesn't:
> 
> Welcome to MzScheme version 206.1, Copyright (c) 2004 PLT Scheme, Inc.
> > (require (lib "swindle.ss" "swindle")) ;version 20040114
> => (error-print-width 999)
> => (defmethod (f x) x)
> => (let () (defmethod (f (x = 1)) 0) (defmethod (f (x = 0)) 1) (f 0))

This is really an ugly hack, I never really expected it to do the
right thing.  Maybe the best thing would be to make it try to define a
generic only when it is being used as a top level form, forcing you to
use explicit `defgeneric' and `add-method' otherwise?


> [...] the bug is in `method-def-adder' in "clos.ss":
> 
>        (if (or
>             [...]
>             ;; local definition -- don't know which is first => no define
>             (eq? 'lexical (syntax-local-context)))
>          (syntax/loc stx (add-method name method-make))
> 
> As of a few versions ago, `syntax-local-context' no longer returns
> 'lexical for internal definitions; it returns a list of values
> identiifying the scopes.  I think you can just change this to
> (list? (syntax-local-context)) and it should do the right thing.

Thanks.  However, changing this doesn't work -- the second `defmethod'
gets a syntax-local-context of 'expression...  Changing it to

  (or ...
      (list? (syntax-local-context))
      (eq? 'expression (syntax-local-context)))

seems to be better, but still not the right thing -- since it will
always make it not define the generic.  Omitting the `list?' seems
promising, but that turns the first one to a definition, so the second
one will also get a list context and will try to redefine the generic.


> Now here's my macro question: if `f' hadn't been defined at the top
> level, would there be any way to do the right thing here?  Namely, the
> first `defmethod' should define a generic, but the second one should
> not.  Can a macro get at the other bindings in the same
> internal-definition context to see whether a variable has already been
> bound?  If not, would this be something easy to enable?  Perhaps the
> list returned by `syntax-local-context' could be an alist instead?
> I.e. (cdar (syntax-local-context)) would be the list of identifiers
> already bound in the innermost internal definition context.  Forgive
> me if I'm being naive about why this would be impossible (or a bad
> idea)...

*sigh*, as I said, I don't think that this is too reliable, but I
tried something that seems like it might work.  The idea is to keep a
mapping from the definition context to things that were already
defined as generics.  This seems to work except that it fails when you
do use defgeneric since that doesn't update the table.  I don't know
if this is worth a solution...

(defsyntax method-def-adder
  (let ((defgeneric-contexts (make-hash-table 'weak)))
    (lambda (stx)
      (syntax-case stx ()
        ((_ qualifier name args body ...) (identifier? #'name)
         ;; always make it with no name so add-method will add it
         (with-syntax ((method-make
                        (syntax/loc stx
                          (qualified-method qualifier args body ...))))
           (if (or
                ;; not enabled
                (not (syntax-e
                      ((syntax-local-value #'-defmethod-create-generics-))))
                ;; defined symbol or second module binding
                (identifier-binding #'name)
                ;; local definition -- don't know which is first => no define
                (let ((ctx (syntax-local-context)))
                  (or (eq? 'expression ctx)
                      (and (pair? ctx)
                           (let ((cs (hash-table-get defgeneric-contexts
                                                     (car ctx)
                                                     (lambda () '()))))
                             (or
                              ;; already defined, only add method
                              (ormap (lambda (c)
                                       (module-identifier=? #'name c))
                                     cs)
                              ;; new definition: remember it
                              (begin (hash-table-put! defgeneric-contexts
                                                      (car ctx)
                                                      (cons #'name cs))
                                     #f)))))))
             (syntax/loc stx (add-method name method-make))
             ;; top-level or first module binding
             (syntax/loc stx
               (define name ; trick: try using exising generic
                 (let ((g (generic name)))
                   (add-method g method-make)
                   g))))))))))


-- 
          ((lambda (x) (x x)) (lambda (x) (x x)))          Eli Barzilay:
                  http://www.barzilay.org/                 Maze is Life!