Re: Warning STklos feature: function redefination

From: Moises Lejter <mlm_at_cs.brown.edu>
Date: Sat, 29 Jul 1995 04:13:23 -0400

Instead of simply warning the programmer that an existing function is
about to be redefined, it seemed to me a better solution not to lose
the original definition of the function.

The following patches, one to gf.c, the other to stklos.stk, provide
an alternative. Once they are applied, the introduction of a new
generic by the same name as an existing function does not clobber that
function. Instead, the old definition is stashed away and used as the
last resort, for those function calls for which no method that matches
the arguments can be found.

As a result, existing code will not break if one accidentally (or
intentionally) introduces a new generic that overrides some function
in some library somewhere. In particular, this happen all over the
place, when some of the STklos classes are loaded into STk (I am still
in 2.1.6) - they redefine as generics some functions that were already
used by the core STk Tk support.

First patch (for gf.c)

---patch begins here---
diff -w -r1.2 gf.c
201a202
> return
204,205d204
< /* if we are here, it's because no-applicable-method hasn't signaled an error */
< return NIL;
237c236
< STk_apply_generic(VCELL(Intern("no-applicable-method")),

---
>         return STk_apply_generic(VCELL(Intern("no-applicable-method")),
239d237
<         return NIL;
-----patch ends here---
Second patch (for stklos.stk)
---patch begins here---
diff -w -r1.3 stklos.stk
33a34,36
> 
> (define *stklos:old-functions* (make-hash-table))
> 
87c90,97
<   `(define ,name (make <generic> :name ',name)))
---
>   (let ((new-method-name (gensym "stklos_")))
>     `(begin
>        (unless (symbol-bound? ',name)
>              (define ,name #f))
>        (let ((,new-method-name (make <generic> :name ',name)))
>        (when (or (procedure? ,name) (tk-command? ,name))
>              (hash-table-put! *stklos:old-functions* ,new-method-name ,name))
>        (set! ,name ,new-method-name)))))
328,331c338,351
< (define-method no-applicable-method ((gf <generic>) args)
<   (error "No applicable method for ~S\nin call ~S" 
<        gf 
<        (append (cons (slot-ref gf 'name) args))))
---
> ; Replaced by function introduced below that attempts to invoke prior
> ; function definition by the same name as the method, if there used to
> ; be such a thing.
> ;
> ; (define-method no-applicable-method ((gf <generic>) args)
> ;   (error "No applicable method for ~S\nin call ~S" 
> ;      gf 
> ;      (append (cons (slot-ref gf 'name) args))))
> 
> (define-method no-applicable-method (message (gf <generic>) args)
>   (let ((fn (hash-table-get *stklos:old-functions* gf #f)))
>     (if fn (apply fn args)
>       (error message gf (append (cons (slot-ref gf 'name) args))))))
> 
---patch ends here---
This are taken off of STk 2.1.6, once the previous patches I posted
are applied.  I suspect you could use patch to apply these, even if
you had not applied the previous ones.
I have not looked at 2.2, but I think the code should be pretty much
the same - certainly it seemed like the conflict between STklos and
the base Tk support was there...
Again, I think this is something the base distribution could use... :-)
Moises
-----------------------------------------------------------------------------
Internet/CSnet:   Moises_Lejter_at_brown.edu	BITNET:  mlm_at_browncs.BITNET
UUCP:    ...!uunet!cs.brown.edu!mlm		Phone:	 (401)863-7671
USmail:  Moises Lejter, Box 1910 Brown University, Providence RI 02912

Received on Sat Jul 29 1995 - 10:16:55 CEST