1 ;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-mock; -*-
5 ;;; dynamic rebinding of functions
7 (defun maybe-fdefinition (name)
8 "If NAME is FBOUNDP, return its FDEFINITION, else NIL."
9 (and (fboundp name) (fdefinition name)))
11 (defun set-fdefinition (name value)
12 "FUNCALLABLE expansion of (SETF (FDEFINITION NAME) VALUE)."
13 (setf (fdefinition name) value))
15 (defun set-or-unbind-fdefinition (name value)
16 "If VALUE is true, set the FDEFINITION of NAME to it, else FMAKUNBOUND
18 (if value (set-fdefinition name value) (fmakunbound name)))
20 (defun call-with-function-bindings (functions values function
21 &optional (previous (mapcar #'maybe-fdefinition functions)))
22 "Calls FUNCTION while temporarily binding all FUNCTIONS to VALUES.
26 (mapc #'set-fdefinition functions values)
28 (mapc #'set-or-unbind-fdefinition functions previous)))
30 (defmacro progf (functions values &body body)
31 "Like PROGV, but for FUNCTIONS."
32 `(call-with-function-bindings ,functions ,values (lambda () ,@body)))
34 (defmacro dflet ((&rest definitions) &body body)
35 "Like FLET, but dynamically sets the FDEFINITIONS during the duration of
38 ',(mapcar #'car definitions)
40 ,.(mapcar (lambda (definition)
41 `(lambda ,(cadr definition)