Paste number 10951: with-gensym

Paste number 10951: with-gensym
Pasted by: Russ
When:4 years, 11 months ago
Share:Tweet this! | http://paste.lisp.org/+8G7
Channel:None
Paste contents:
Raw Source | XML | Display As
(defun memoize (fn)
  (let ((cache (make-hash-table :test #'equal)))
    (lambda (&rest args)
      (multiple-value-bind (val win) (gethash args cache)
	(if win
	    val
	    (setf (gethash args cache)
		  (apply fn args)))))))


(defmacro with-gensym (l-list &body macro-body)
  (let ((symbol-hash (make-hash-table))
	 ;just a little crack to get a reference to unquote
	; for whatever reason i cant seem to get a ref to unquote
	(unq (caaadr '`(,'foo))))
    (labels ((fill-ht (sym-list)
	       (let ((symbol (car sym-list))
		     (rest-list (cdr sym-list)))
		 (setf (gethash symbol symbol-hash) (gensym))
		 (if rest-list
		     (fill-ht rest-list)))))
      (fill-ht l-list)
      (labels ((inline-gensyms (body)
		 (if (null body) '()
		     (let ((elem (first body))
			   (rest-list (rest body)))
		       (if (listp elem)
			   (cons (inline-gensyms elem) (inline-gensyms rest-list ))
			   (let ((in-hash (gethash elem symbol-hash)))
			     (if in-hash
				 (cons (list unq elem) (inline-gensyms rest-list))
				 (cons elem (inline-gensyms rest-list))))))))
	       (generate-output (list &optional outlist)
		 (let ((symbol (car list))
		       (rest-list (cdr list)))
		       (if rest-list
			   (generate-output rest-list
					    (cons `(,symbol (gensym)) outlist))
			   `(let ,(cons `(,symbol (gensym))  outlist) ,@(inline-gensyms macro-body))))))
	(generate-output l-list)))))




(defmacro defmemoized (sym lambda-list &body b)
  (with-gensym (fn mfn x)
    `(flet ((fn ,lambda-list ,@b)) ;this defines the desired function
      (let ((mfn (memoize #'fn)))  ;this memoizes the function 
	 ;;do the defun pointing to the memoized function.
	 (defun ,sym (&rest x) (apply mfn x))))))

;;Example:
;;function foo takes parameters x, y, and z. sleeps for x seconds then returns y + z.
(defmemoized foo (x y z) 
  (sleep x) 
  (+ y z))

(macroexpand '(defmemoized foo (x y z) 
  (sleep x) 
  (+ y z)))

(macroexpand '(with-gensym (fn mfn x)
  `(flet ((fn (test) body)) ;this defines the desired function
    (let ((mfn (memoize #'fn)))  ;this memoizes the function 
      ;;do the defun pointing to the memoized function.
      (defun foo (&rest x) (apply mfn x))))))

This paste has no annotations.

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.