From wen-sheng.xie at thomson.net  Mon Dec  5 01:14:23 2005
From: wen-sheng.xie at thomson.net (Xie Wen Sheng)
Date: Mon, 5 Dec 2005 09:14:23 +0800
Subject: [Small-cl-src] RE: a Clisp problem (Xie Wen Sheng)
Message-ID: <CE1F1B158B2B1C4080BA3F114B158B5B026849@szntsmail01.ap.thmulti.com>

Hi, All:

I got a solution from comp.lang.lisp:

Pascal Bourguignon:
(DEFUN COMBINE (ARGS)
  "
RETURN:  (elt args 0) x (elt args 1) x ... x (elt args (1- (length args)))
         = the set of tuples built taking one item in order from each list
           in args.
EXAMPLE: (COMBINE '((WWW FTP) (EXA) (COM ORG)))
           --> ((WWW EXA COM) (WWW EXA ORG) (FTP EXA COM) (FTP EXA ORG))
"
  (COND
   ((NULL ARGS) '(NIL))
   ((NULL (CAR ARGS)) (COMBINE (CDR ARGS)))
   ((CONSP (CAR ARGS))
    (MAPCAN (LAMBDA (ITEM) (COMBINE (cons ITEM (CDR ARGS))))
            (CAR ARGS)))
   (T
    (MAPCAN (LAMBDA (REST) (LIST (CONS (CAR ARGS) REST)))
            (COMBINE (CDR ARGS)))))) 

Tron3k:
(defun combine (lst)
    (if (endp lst)
        (list '())
        (loop with crest = (combine (rest lst))
              for item in (first lst)
              nconc (loop for items in crest
                          collect (cons item items))))) 

Thank you all.

XIE Wensheng


-----Original Message-----
From: small-cl-src-bounces at hexapodia.net
[mailto:small-cl-src-bounces at hexapodia.net]On Behalf Of
small-cl-src-request at hexapodia.net
Sent: Saturday, December 03, 2005 8:00 PM
To: small-cl-src at hexapodia.net
Subject: Small-cl-src Digest, Vol 10, Issue 1


Send Small-cl-src mailing list submissions to
	small-cl-src at hexapodia.net

To subscribe or unsubscribe via the World Wide Web, visit
	http://www.hexapodia.net/mailman/listinfo/small-cl-src
or, via email, send a message with subject or body 'help' to
	small-cl-src-request at hexapodia.net

You can reach the person managing the list at
	small-cl-src-owner at hexapodia.net

When replying, please edit your Subject line so it is more specific
than "Re: Contents of Small-cl-src digest..."


Today's Topics:

   1. a Clisp problem (Xie Wen Sheng)


----------------------------------------------------------------------

Message: 1
Date: Mon, 28 Nov 2005 16:22:54 +0800
From: "Xie Wen Sheng" <wen-sheng.xie at thomson.net>
Subject: [Small-cl-src] a Clisp problem
To: <small-cl-src at hexapodia.net>
Message-ID:
	<CE1F1B158B2B1C4080BA3F114B158B5B019013 at szntsmail01.ap.thmulti.com>
Content-Type: text/plain;	charset="iso-8859-1"

Hi ,All

I'm new to lisp, using GNU Clisp.

I have a problem when I do some Lisp programming training.

For example, for the list (a (b1 b2) c (d1 d2) (e1 e2 e3) f), I need a function to return all the possible combinations like:
((a b1 c d1 e1 f)
(a b1 c d1 e2 f)
(a b1 c d1 e3 f)
(a b1 c d2 e1 f)
(a b1 c d2 e2 f)
(a b1 c d2 e3 f)
(a b2 c d1 e1 f)
(a b2 c d1 e2 f)
(a b2 c d1 e3 f)
(a b2 c d2 e1 f)
(a b2 c d2 e2 f)
(a b2 c d2 e3 f))

My tries trended to be unsuccessful. Is it too easy to ask this here? If so, where is the forum for people like me?



best regards,

XIE Wensheng




------------------------------

_______________________________________________
Small-cl-src mailing list
Small-cl-src at hexapodia.net
http://www.hexapodia.net/mailman/listinfo/small-cl-src


End of Small-cl-src Digest, Vol 10, Issue 1
*******************************************



From bhyde at pobox.com  Sat Dec 10 03:38:30 2005
From: bhyde at pobox.com (Ben Hyde)
Date: Fri, 9 Dec 2005 22:38:30 -0500
Subject: [Small-cl-src] defun-with-cache
Message-ID: <0C57B69F-AC76-44A0-9DDE-73F7D8A4716A@pobox.com>

This is a lark.

Given a function:    (defun f (...) ...)

You can rewrite that into:   (defun-with-cache f (...) ...)

at which point a second call upon f with the same arguments will  
return the values returned the first time.  You can clear the cache  
by calling.
   (clear-cache-of-function 'f)

If I was to guess where this is likely to have a bug I'd pick rip- 
apart-arglist; who's job is to handle &optional, &rest, &keys, etc.   
If I was to pick the part likely to make the casual reader's brain  
hurt it would be body of defun-with-cache, which was pure fun to write.

It's fine if F returns multiple values.

This does what I need in the code where I'm using it, so "I think I'm  
happy."

   - ben


(defun rip-apart-arglist (arglist)
   (loop
       with binds = nil
       with call = nil
       with apply? = nil
       with keys? = nil
       finally (return (values
		       (nreverse binds)
		       (if apply?
			   (nreverse (cons apply? call))
			   (nreverse call))
		       apply?))
       for arg in arglist
       do
       (flet ((accumulate (var)
	       (push var binds)
	       (when (eq t apply?)
		 (setf apply? var)
		 (return-from accumulate))
	       (when keys?
		 (push (intern (symbol-name var) *keywork-package*)
		       call))
	       (push var call)))
	(cond
	  ((consp arg)
	   (accumulate (first arg)))
	  ((eq arg '&aux)
	   (finish))	
	  ((eq arg '&rest)
	   (setf apply? t))	
	  ((eq arg '&optional)
	   (setf apply? t))
	  ((eq arg '&allow-other-keys)
	   (setf apply? t))
	  ((eq arg '&key)
	   (setf keys? t))
	  ((symbolp arg)
	   (accumulate arg))))))

(defmacro cache-of-function (function-name)
   `(get ,function-name :cache-of-function))

(defun clear-cache-of-function (function-name)
   (clrhash (cache-of-function function-name)))

(defmacro defun-with-cache (name args &body body)
   (multiple-value-bind (binding call apply?)
       (rip-apart-arglist args)
     `(let ((#1=#:cache (make-hash-table :test #'equal)))
       (setf (cache-of-function ',name) #1#)
       (defun ,name ,args
	(flet ((,name ,args , at body))
	  (let ((#2=#:key (list , at binding)))
	    (values-list
	     (or (gethash #2# #1#)
		 (setf (gethash #2# #1#)
		       (multiple-value-list
			   ,@(if apply?
				 `((apply #',name , at call))
				 `((,name , at call)))))))))))))