Hello,
Has anyone written a ``wrapping'' function?
This is what I mean. (BTW, I use akcl.)
I need to selectively monitor the execution times of various functions at
runtime. Thus some way of modifying the code at runtime is needed.
The functions are compiled, so the short-cut of defining lambda-blocks won't
work. I wrote up the following pieces of code:
(defun monitor_1fun (fname)
(if (fboundp fname)
(if (get fname 'monitored)
(progn (format T "function ~A is already being monitored~%" fname)
NIL)
(progn (si:fset (setq f (gentemp)) (symbol-function fname))
(si:putprop fname f 'monitored)
(eval `(defun ,fname (&rest args)
(start_bench ',fname)
(myfuncall ',f args)
(end_bench ',fname)))
(setq *Monitor_List* (cons fname *Monitor_List*))
*Monitor_List*))
(progn (format T "function ~A is not bound~%" fname)
NIL)))
(defun myfuncall (old_fun args)
(eval `(funcall (function ,old_fun) ,@args)))
However, the two defun's (thus two eval's of the args) are causing problems.
Does anyone see what's wrong with the above routines (and corrections?)?
It may be an obvious error, but I am too sleepy and the brain is not meeting
its specs...ZZZZZ
thanks in advance for any help.
Wei Jen Yeh ···@cs.purdue.edu
Department of Computer Science
Purdue University
West Lafayette, Indiana
--
Wei Jen Yeh ···@cs.purdue.edu
Department of Computer Science
Purdue University
West Lafayette, Indiana
In article <·····@medusa.cs.purdue.edu> ···@cs.purdue.EDU (Wei Jen Yeh) writes:
Hello,
Has anyone written a ``wrapping'' function?
This is what I mean. (BTW, I use akcl.)
I need to selectively monitor the execution times of various functions at
runtime. Thus some way of modifying the code at runtime is needed.
The functions are compiled, so the short-cut of defining lambda-blocks won't
work. I wrote up the following pieces of code:
(defun monitor_1fun (fname)
(if (fboundp fname)
(if (get fname 'monitored)
(progn (format T "function ~A is already being monitored~%" fname)
NIL)
(progn (si:fset (setq f (gentemp)) (symbol-function fname))
(si:putprop fname f 'monitored)
(eval `(defun ,fname (&rest args)
(start_bench ',fname)
(myfuncall ',f args)
(end_bench ',fname)))
(setq *Monitor_List* (cons fname *Monitor_List*))
*Monitor_List*))
(progn (format T "function ~A is not bound~%" fname)
NIL)))
(defun myfuncall (old_fun args)
(eval `(funcall (function ,old_fun) ,@args)))
However, the two defun's (thus two eval's of the args) are causing problems.
Does anyone see what's wrong with the above routines (and corrections?)?
It may be an obvious error, but I am too sleepy and the brain is not meeting
its specs...ZZZZZ
thanks in advance for any help.
--
Wei Jen Yeh ···@cs.purdue.edu
Department of Computer Science
Purdue University
West Lafayette, Indiana
You have made one error in myfuncall, it should be defined as:
(defun myfuncall (old_fun args)
(eval `(funcall (function ,old_fun) ',@args)))
--------------------------------------^---------
Note the extra ' which you have to include since the argument is already
evaluated.
With the above definition of monitor_1fun the value returned by the wrapper
isn't what the wrapped function returned. Maybe you should use prog1 like
this:
(eval `(defun ,fname (&rest args)
(start_bench ',fname)
(prog1 (myfuncall ',f args)
(end_bench ',fname))))
I wondered why you had to use eval, maybe I didn't understand what you meant
when you wrote:
The functions are compiled, so the short-cut of defining lambda-blocks
won't work. I wrote up the following pieces of code:
Did you mean that the wrapper-function were supposed to be compiled? Anyway
here's my version of monitor:
(defun halmonitor (fname)
(if (fboundp fname)
(if (get fname 'monitored)
(progn (format T "function ~A is already being monitored~%" fname)
NIL)
(setf (get fname 'monitored) (symbol-function fname)
(symbol-function fname)
#'(lambda (&rest args)
(start_bench fname)
(prog1
(apply (get fname 'monitored) args)
(end_bench fname)))
*Monitor_List* (cons fname *Monitor_List*)))
(progn (format T "function ~A is not bound~%" fname)
NIL)))
I use setf heavily because it is more portable than using si:-functions. The
old definition of fname is put in the property list. The new definition is a
closure over the variable holding fname so it can be referenced be the
wrapper-function. Also I use apply instead of funcall and return the value of
the monitored function.
To unmonitor 'fname use
(setf (symbol-function 'fname) (get 'fname 'monitored))
Any comments on the above code, I think it's cleaner and additionally it
should be faster since it doesn't use eval at all.
--
- haltraet (@idt.unit.no)
In article <·····@medusa.cs.purdue.edu> ···@cs.purdue.EDU (Wei Jen Yeh) writes:
> Has anyone written a ``wrapping'' function?
Some Lisps include an "advice" mechanism, which is specifically for
adding temporary wrappers around functions.
>This is what I mean. (BTW, I use akcl.)
I don't know whether AKCL has advice. I know Symbolics and Lucid both do,
and I think Franz does.
>I need to selectively monitor the execution times of various functions at
>runtime. Thus some way of modifying the code at runtime is needed.
>The functions are compiled, so the short-cut of defining lambda-blocks won't
>work. I wrote up the following pieces of code:
I'm not crazy about your code (always be wary about using EVAL), but it
looks like it should work. Here's my (untested) version:
(defun monitor_1fun (fname)
(if (fboundp fname)
(if (get fname 'monitored)
(error "Function ~A is already being monitored." fname)
(let ((old-function (symbol-function fname)))
(setf (get fname 'monitored) old-function) ; no need to use SI:PUTPROP
(setf (symbol-function fname) ;no need for SI:FSET
#'(lambda (&rest args)
(start_bench fname) ; the beauty of lexical vars!
(apply old-function args) ; your MYFUNCALL == APPLY
(end_bench fname)))
(push fname *monitor_list*)
*monitor_list*))
(error "Function ~A is not defined." fname)))
(defun unmonitor_1fun (fname)
(let ((old-function (get fname 'monitored)))
(if old-function
(progn
(setf (symbol-function fname) old-function)
(remprop fname 'monitored)
(setq *monitor_list* (delete fname *monitor_list*)))
(error "Function ~A is not being monitored" fname))))
--
Barry Margolin, Thinking Machines Corp.
······@think.com
{uunet,harvard}!think!barmar
Using "advise" or mechanisms like it to monitor performance often
doesn't work if the time-to-execute the advice exceeds the time spent
in the function being monitored.
There have been a number of clever schemes that attempt to compensate
for this "Heisenburg effect" (measurement interfering with phenomena
being measured), but most are pretty unsatisfactory.
The Interlisp "breakdown" program did this. (Introduced sometime
between 1970 and 75).
--
Larry Masinter (········@parc.xerox.com)
Xerox Palo Alto Research Center (PARC)
3333 Coyote Hill Road; Palo Alto, CA USA 94304
Phone: (415) 494-4365 Fax: (415) 494-4333
Thanks to Barry for his solutions. I enclosed his solutions with a minor
modification to make the modified function return the same value as the
old one does. (It may not work for functions returning multiple values.)
My thanks also go to others for pointing out the "advice" function (which
akcl does not have), and Mark Kantrowitz for providing info on a metering
package.
(defun monitor_1fun (fname)
(if (fboundp fname)
(if (get fname 'monitored)
(error "Function ~A is already being monitored." fname)
(let ((old-function (symbol-function fname)))
(setf (get fname 'monitored) old-function)
(setf (symbol-function fname)
#'(lambda (&rest args)
(prog2 (start_bench fname)
(apply old-function args)
(end_bench fname))))
(push fname *monitor_list*)
*monitor_list*))
(error "Function ~A is not defined." fname)))
(defun unmonitor_1fun (fname)
(let ((old-function (get fname 'monitored)))
(if old-function
(progn
(setf (symbol-function fname) old-function)
(remprop fname 'monitored)
(setq *monitor_list* (delete fname *monitor_list*)))
(error "Function ~A is not being monitored" fname))))
> --
> Barry Margolin, Thinking Machines Corp.
>
> ······@think.com
Wei Jen Yeh ···@cs.purdue.edu
Department of Computer Science
Purdue University
West Lafayette, Indiana
--
Wei Jen Yeh ···@cs.purdue.edu
Department of Computer Science
Purdue University
West Lafayette, Indiana
···@cs.purdue.EDU (Wei Jen Yeh) writes:
> (It may not work for functions returning multiple values.)
It won't, but that is easy to fix. Just use multiple-value-prog1
instead of the prog2:
(progn
(start_bench fname)
(multiple-value-prog1
(apply old-function args)
(end_bench fname)))
-William Lott
CMU Common Lisp Group