Problem: The program works correctly most of the time,
however on occasions the data needs to be processed
differently in unexpected ways. The differences are
always slight and usually apply to one particular set
of data. The functions that need altering could be
anywhere in the processing code. I have given a bit
of thought to _temporarily_ replacing the functions
with lambdas included in the data and came up with
this:
(defmacro function-replace(fns &body body)
(let ((fn (gensym))(oldfns (gensym))
(result (gensym))(list (gensym)))
`(let ((,list ,fns)(,result)(,oldfns '()))
(dolist (,fn ,list)
(push (symbol-function (first ,fn))
,oldfns)
(setf (symbol-function (first ,fn))
(second ,fn)))
(unwind-protect (setf ,result ,@body)
(dolist (,fn (reverse ,list))
(setf (symbol-function (first ,fn))
(pop ,oldfns))))
,result))))
;;; Test functions
(defun bar(x)(+ x 3))
(defun baz(x)(* x 24))
(defun foo(x)(bar x))
(defun fubar(x)
(function-replace `((bar ,#'baz))
(foo x)))
----------Testrun----------
CL-USER 21 > (foo 5)
8
CL-USER 22 > (fubar 5)
120
CL-USER 23 > (foo 5)
8
Is there a better way to do this? I've aimed for a
let-like look to the syntax on purpose (viewing a
function as if it were a special variable).
I was thinking of using it along these lines:
(defmacro process-data (data fns)
`(function-replace ,fns
(process-data-main ,data)))
(defun do-run(...)
(do ...
(update-data(process-data(load-data...)))))
Also, how do I protect the first dolist in the case of an
error? I'd like to provide a graceful recovery.
--------
Geoff
"Geoff Summerhayes" <·············@hNoOtSmPaAiMl.com> wrote in message
························@news3.calgary.shaw.ca...
[snip]
> of thought to _temporarily_ replacing the functions
> with lambdas included in the data and came up with
> this:
>
> (defmacro function-replace(fns &body body)
> (let ((fn (gensym))(oldfns (gensym))
> (result (gensym))(list (gensym)))
> `(let ((,list ,fns)(,result)(,oldfns '()))
> (dolist (,fn ,list)
> (push (symbol-function (first ,fn))
> ,oldfns)
> (setf (symbol-function (first ,fn))
> (second ,fn)))
> (unwind-protect (setf ,result ,@body)
> (dolist (,fn (reverse ,list))
> (setf (symbol-function (first ,fn))
> (pop ,oldfns))))
> ,result))))
>
[snip]
> Is there a better way to do this? I've aimed for a
> let-like look to the syntax on purpose (viewing a
> function as if it were a special variable).
> I was thinking of using it along these lines:
>
That seems like a fine idea. (I did not look at the code any harder than it
took to know what you intended) I might rename it though, something like
with-substituted-functions or with-rebound-functions so it is clear the change
is only within the scope of the macro.
> (defmacro process-data (data fns)
> `(function-replace ,fns
> (process-data-main ,data)))
>
Why is process-data a macro?
--
Coby
(remove #\space "coby . beck @ opentechgroup . com")
"Coby Beck" <·····@mercury.bc.ca> wrote in message
······························@typhoon.tampabay.rr.com...
>
>
> That seems like a fine idea. (I did not look at the code any harder than
it
> took to know what you intended) I might rename it though, something like
> with-substituted-functions or with-rebound-functions so it is clear the
change
> is only within the scope of the macro.
>
Agreed, a much better name.
My original thought was flet,
but someone beat me to it. :-)
> > (defmacro process-data (data fns)
> > `(function-replace ,fns
> > (process-data-main ,data)))
> >
>
> Why is process-data a macro?
>
Numerous drafts, changed the internals,didn't
change to defun.
Hmm.. Looking at it now, I have got a couple
of ideas to beef this up a bit, will post results
later.
Geoff
In article <···················@news3.calgary.shaw.ca>,
Geoff Summerhayes <·············@hNoOtSmPaAiMl.com> wrote:
>Problem: The program works correctly most of the time,
>however on occasions the data needs to be processed
>differently in unexpected ways. The differences are
>always slight and usually apply to one particular set
>of data. The functions that need altering could be
>anywhere in the processing code. I have given a bit
>of thought to _temporarily_ replacing the functions
>with lambdas included in the data and came up with
>this:
>
>(defmacro function-replace(fns &body body)
> (let ((fn (gensym))(oldfns (gensym))
> (result (gensym))(list (gensym)))
> `(let ((,list ,fns)(,result)(,oldfns '()))
> (dolist (,fn ,list)
> (push (symbol-function (first ,fn))
> ,oldfns)
> (setf (symbol-function (first ,fn))
> (second ,fn)))
> (unwind-protect (setf ,result ,@body)
> (dolist (,fn (reverse ,list))
> (setf (symbol-function (first ,fn))
> (pop ,oldfns))))
> ,result))))
>
>;;; Test functions
>(defun bar(x)(+ x 3))
>
>(defun baz(x)(* x 24))
>
>(defun foo(x)(bar x))
>
>(defun fubar(x)
> (function-replace `((bar ,#'baz))
> (foo x)))
>
>----------Testrun----------
>CL-USER 21 > (foo 5)
>8
>
>CL-USER 22 > (fubar 5)
>120
>
>CL-USER 23 > (foo 5)
>8
>
>Is there a better way to do this? I've aimed for a
It seems like a reasonable approach to me.
>let-like look to the syntax on purpose (viewing a
>function as if it were a special variable).
>I was thinking of using it along these lines:
If you look around, I think you should be able to find a LETF macro. It's
like LET, except that it allows generalized variables in place of
variables. With that, you could do:
(defun fubar (x)
(letf (((symbol-function 'bar) #'baz))
(foo x)))
To simplify the notation, you could still have your FUNCTION-REPLACE macro,
but it would just have to expand into a LETF, which would do the hard part.
>Also, how do I protect the first dolist in the case of an
>error? I'd like to provide a graceful recovery.
You need to move the first dolist into the unwind-protect:
(defmacro function-replace(fns &body body)
(let ((fn (gensym))
(oldfns (gensym))
(list (gensym)))
`(let ((,list ,fns)
(,oldfns '()))
(dolist (,fn ,list)
(push (cons (first ,fn) (symbol-function (first ,fn)))
,oldfns))
(unwind-protect
(progn
(dolist (,fn ,list)
(setf (symbol-function (first ,fn))
(second ,fn)))
,@body)
(dolist (,fn ,oldfns)
(setf (symbol-function (first ,fn))
(second ,fn)))))))
I changed OLDFNS from a stack into an association list; otherwise, the
saving and restoring could get out of sync. I also got rid of the RESULT
variable, since UNWIND-PROTECT automatically returns what its body returns,
including handling multiple values properly.
--
Barry Margolin, ······@genuity.net
Genuity, Woburn, MA
*** DON'T SEND TECHNICAL QUESTIONS DIRECTLY TO ME, post them to newsgroups.
Please DON'T copy followups to me -- I'll assume it wasn't posted to the group.
Barry Margolin <······@genuity.net> writes:
> In article <···················@news3.calgary.shaw.ca>,
> Geoff Summerhayes <·············@hNoOtSmPaAiMl.com> wrote:
> >Problem: The program works correctly most of the time,
> >however on occasions the data needs to be processed
> >differently in unexpected ways. The differences are
> >always slight and usually apply to one particular set
> >of data. The functions that need altering could be
> >anywhere in the processing code. I have given a bit
> >of thought to _temporarily_ replacing the functions
> >with lambdas included in the data and came up with
> >this:
> >
> >(defmacro function-replace(fns &body body)
I've done something similar, but I think my approach is nicer
esthetically:
> >(defun fubar(x)
> > (function-replace `((bar ,#'baz))
> > (foo x)))
(defun fubar (x)
(flet ((bar (x) (baz x)))
(declare (special (function bar)))
(foo x)))
Of course, that symbol is UTILITIES:FLET, not COMMON-LISP:FLET. It
expands like:
(felt ((foo (x) (bar x))
(bar (x) (foo x)))
(declare (special (function bar)))
...)
=>
(let ((=old-bar= (symbol-function bar))
(=new-bar= (lambda (x) (foo x))))
(flet ((foo (x) (bar x))
(bar (&rest args) (apply =new-bar= args)))
(unwind-protect
(progn (setf (symbol-function bar) =new-bar=)
...)
(setf (symbol-function bar) =old-bar=))))
This has the advantage of working in a situation like:
(flet ((foo (x) ...))
...
(flet ((foo (x) ...))
(declare (special (function foo)))
...
(foo y) ; call the innermost foo, not the one from the first flet
...))
--
/|_ .-----------------------.
,' .\ / | No to Imperialist war |
,--' _,' | Wage class war! |
/ / `-----------------------'
( -. |
| ) |
(`-. '--.)
`. )----'