From - Thu Jun 04 06:41:28 1998
Path: fstgal00.tu-graz.ac.at!aconews.univie.ac.at!newscore.univie.ac.at!news-spur1.maxwell.syr.edu!news.maxwell.syr.edu!news.eecs.umich.edu!news.bu.edu!not-for-mail
From: David Bakhash <cadet@bu.edu>
Newsgroups: comp.lang.lisp
Subject: a useful macro
Date: 24 May 1998 19:28:59 -0400
Organization: Boston University
Lines: 40
Message-ID: <cxjd8d3p7t0.fsf@hawk.bu.edu>
NNTP-Posting-Host: hawk.bu.edu
X-Newsreader: Gnus v5.5/XEmacs 20.3 - "Vatican City"

Hey,

Just passed the first test of this macro.  Don't know if it works so
well, but I thought I'd post it.  I think it's potentially useful.  I
wish there was a place on the net that had a bunch of little goodies
like this one.  I think this is a neato idea, and can speed up lots of 
different types of functions.

(defmacro defmemoized (name param-list &rest body)
  (let* ((docstring (and (stringp (car body)) (> (length body) 1) (car body)))
	 (param-length (length param-list))
	 (test-function (if (< param-length 2) #'eql #'equal))
	 (hash-key (if (< param-length 2)
		       (car param-list)
		     `(list ,@param-list))))
    (if docstring (setq body (cdr body)))
    `(let ((cache (make-hash-table :test ,test-function)))
       (defun ,name ,param-list
	 (or (gethash ,hash-key cache)
	     (setf (gethash ,hash-key cache)
	       ,@body))))))

so with this, you can do something like:

(defmemoized fact (n)
  (if (= n 0)
      1
    (* n (fact (1- n)))))

Macroexpanded once, it will yield

(let ((cache (make-hash-table :test #<function eql>)))
  (defun fact (n)
    (or (gethash n cache) (setf (gethash n cache) (if (= n 0) 1 (* n (fact (1- n))))))))

In the example, the function `fib' is non-ideal because it uses
recursion, but at at least it's memoized.  pretty cool, in my opinion,
though no computer-science breakthroughs here.

dave