| 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: |
(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.