Special functions

Discussion of Common Lisp
Post Reply
Suroy
Posts: 46
Joined: Sat Dec 19, 2009 11:20 am

Special functions

Post by Suroy » Mon May 31, 2010 5:53 am

Out of curiousity, is it possible to create special functions just like it is possible to create special variables?

Edit :never mind,it sort of is possible. Comments on code, will it work in every situation (i hope it does)

Code: Select all

(defmacro bind (functions &body body)
  (let ((gen-vars (loop repeat (length functions) collecting (gensym))))
    `(let ,(loop
	      for func in functions
	      for gen in gen-vars collecting `(,gen (symbol-function ',(first func))))
       (unwind-protect
	    (progn
	      ,@(loop for func in functions collecting
		     `(setf (symbol-function ',(first func))
			    ,(second func)))
	      ,@body)
	 (progn ,@(loop
		     for func in functions
		     for gen in gen-vars
		     collecting `(setf (symbol-function ',(first func))
				       ,gen)))))))


(bind ((cl::print (lambda (arg) (format t "boom ~A" arg))))
      (cl::print 'a))

Jasper
Posts: 209
Joined: Fri Oct 10, 2008 8:22 am
Location: Eindhoven, The Netherlands
Contact:

Re: Special functions

Post by Jasper » Mon May 31, 2010 6:44 am

Don't think that is thread-proof though. Don't think CL special functions inbuild, perhaps that is treating variables and functions differently arbitrary. No great loss though.. Btw, below example doesn't really show off specialness, but it could be done by flet.

We do treat functions and variables differently in practice too btw, lets say we want to add A and B if A<B and otherwise substract them, most people would write.

Code: Select all

(defun examp (a b)
  (if (< a b) (+ a b) (- a b)))
Instead of:

Code: Select all

(defun examp2 (a b)
   (funcall (if (< a b) #'+ #'-) a b))
The latter has less repeat and parenthesis. If it were a lisp-1 it would be shorter too. And it follows the describing sentence closer. Maybe it is infact more natural.

Suroy
Posts: 46
Joined: Sat Dec 19, 2009 11:20 am

Re: Special functions

Post by Suroy » Mon May 31, 2010 6:48 am

True, i wonder what would happen if i did that in a parallel thread, would probably mess it up. Oh well, dont know how to make anything like this thread proof, but i dont need to do that in my case :D

Suroy
Posts: 46
Joined: Sat Dec 19, 2009 11:20 am

Re: Special functions

Post by Suroy » Mon May 31, 2010 7:01 am

Oh wait, you can make it thread proof (well, sort of, if you only want the behavior to occur in a single thread, which is ok. If you intentially created a new thread you would have to rebind it, or create a macro which rebinds them automatically). Define the lambda function to default to its normal behavior if it is in a different thread than the one in which it was defined: so this assumes you can have access to a thread object to id the current thread, which doesn't change over the life of the thread. I think this is possible.

ramarren
Posts: 613
Joined: Sun Jun 29, 2008 4:02 am
Location: Warsaw, Poland
Contact:

Re: Special functions

Post by ramarren » Mon May 31, 2010 11:36 am

There is a paper on dynamically scoped functions by Pascal Constanza. I think there is an implementation somewhere inside the closer project, although I never really used any of that.

Suroy
Posts: 46
Joined: Sat Dec 19, 2009 11:20 am

Re: Special functions

Post by Suroy » Mon May 31, 2010 12:02 pm

Cool, ill have to take a look.

I think i have a thread safe version, assuming special variables are thread safe anyways. Now all that is left is to destroy some package locks, any compatability libraries out there for locks?:




Code: Select all

(defparameter *id* nil)

(defun localize-binding (other-func func id)
  (let ((args (gensym)))
    `(lambda (&rest ,args)
       (if (equalp *id* ',id)
	   (apply ,func ,args)
	   
	   (apply ,other-func ,args)))))

(defmacro bind (functions &body body)
  (let ((gen-vars (loop repeat (length functions) collecting (gensym)))
	(id (gensym)))
    `(let (,@(loop
		for func in functions
		for gen in gen-vars
		collecting `(,gen (symbol-function ',(first func))))
	   (*id* ',id))
       (unwind-protect
	    (progn
	      ,@(loop
		   for func in functions
		   for gen in gen-vars
		   collecting
		   `(setf (symbol-function ',(first func))
			  ,(localize-binding gen (second func) id)))
	      ,@body)
	 (progn
	   ,@(loop
		for func in functions
		for gen in gen-vars
		collecting `(setf (symbol-function ',(first func))
				  ,gen)))))))

(defun print-me (a) (print a))
(bind ((print (lambda (arg) (format t "BOOM ~A" arg))))
      (print-me 'manasdfasdf))


Post Reply