-
Notifications
You must be signed in to change notification settings - Fork 0
/
common-macros.lisp
24 lines (22 loc) · 1.25 KB
/
common-macros.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
(in-package #:extrinsicl)
(defparameter *common-macros*
'(when unless and or cond case ecase ccase incf decf push pop return
multiple-value-bind multiple-value-list multiple-value-setq nth-value
shiftf rotatef defmethod defvar defpackage defparameter defmacro
define-compiler-macro defun defclass define-condition defgeneric defsetf
deftype destructuring-bind declaim lambda prog prog* prog1 prog2
pushnew remf handler-case ignore-errors in-package check-type dolist
dotimes do do* setf psetf psetq restart-case typecase etypecase ctypecase
with-accessors with-input-from-string with-open-file with-open-stream
with-output-to-string with-simple-restart with-slots
do-symbols do-external-symbols do-all-symbols define-setf-expander))
(defun install-common-macros (client environment)
(loop for name in *common-macros*
for f = (common-macro-definitions:macro-function name)
when f
do (setf (clostrum:macro-function client environment name)
(let ((f f))
(declare (type (function (t t)) f))
(lambda (form environment)
(let ((common-macro-definitions:*client* client))
(funcall f form environment)))))))