Skip to content

Instantly share code, notes, and snippets.

@zkat

zkat/*slime-scratch*.txt

Last active October 5, 2015 22:17
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save zkat/2885508 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save zkat/2885508 to your computer and use it in GitHub Desktop.
Download ZIP
'mock' fdefinitions
Raw
*slime-scratch*.txt
(defmacro with-fdefinition ((name lambda-list &body tmp-body) &body body)
(let ((old-fdef-var (gensym "OLD-FDEF"))
(name-var (gensym "NAME")))
`(let* ((,name-var ',name)
(,old-fdef-var (fdefinition ,name-var)))
(unwind-protect
(progn
(setf (fdefinition ,name-var)
(lambda ,lambda-list ,@tmp-body))
,@body)
(setf (fdefinition ,name-var) ,old-fdef-var)))))
(defun gimme-1 () 1)
(defun print-gimme-1 () (print (gimme-1)))
(print-gimme-1) ; 1
(with-fdefinition (gimme-1 () 2) (print-gimme-1)) ; 2
Raw
gistfile1.lisp
(defmacro with-fdefinition ((name lambda-list &body tmp-body) &body body)
(let ((old-fdef-var (gensym "OLD-FDEF"))
(name-var (gensym "NAME")))
`(let* ((,name-var ',name)
(,old-fdef-var (fdefinition ,name-var)))
(unwind-protect
(progn
(setf (fdefinition ,name-var)
(lambda ,lambda-list ,@tmp-body))
,@body)
(setf (fdefinition ,name-var) ,old-fdef-var)))))
(defun gimme-1 () 1)
(defun print-gimme-1 () (print (gimme-1)))
(print-gimme-1) ; 1
(with-fdefinition (gimme-1 () 2) (print-gimme-1)) ; 2
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment