diff options
| -rw-r--r-- | control-flow.lisp | 19 | ||||
| -rw-r--r-- | defun-1.lisp | 22 |
2 files changed, 32 insertions, 9 deletions
diff --git a/control-flow.lisp b/control-flow.lisp index c8c18cb..b03a666 100644 --- a/control-flow.lisp +++ b/control-flow.lisp @@ -19,7 +19,7 @@ (in-package #:common-lisp) (export '(identity constantly complement tagbody go block return-from - defconstant prog prog*)) + defconstant prog prog* macrolet flet)) (defun identity (x) @@ -158,3 +158,20 @@ ,@declarations (tagbody ,@body)))) + + +(defmacro macrolet (bindings &body body) + `(%macrolet ,(mapcar (lambda (binding) + `(,(car binding) + ,@(make-defmacro-body (cadr binding) + (cddr binding)))) + bindings) + ,@body)) + +(defmacro flet (bindings &body body) + `(%flet ,(mapcar (lambda (binding) + `(,(car binding) + ,@(make-defun-body (cadr binding) + (cddr binding)))) + bindings) + ,@body)) diff --git a/defun-1.lisp b/defun-1.lisp index d369ecb..51e9db0 100644 --- a/defun-1.lisp +++ b/defun-1.lisp @@ -21,29 +21,35 @@ (export '(defmacro defun)) -(%defmacro* defun (name lambda-list . body) +(%defun* make-defun-body (lambda-list body) (let ((lambda-sym (gensym))) - `(%defun ,name ,lambda-sym + `(,lambda-sym (d-b ,lambda-list nil nil ,lambda-sym ,@body)))) -(%defmacro* defmacro (name lambda-list . body) +(%defmacro* defun (name lambda-list . body) + `(%defun ,name + ,@(make-defun-body lambda-list body))) + +(%defun* make-defmacro-body (lambda-list body) (let ((arg-sym (gensym)) (lambda-sym (gensym)) (whole-sym (gensym)) (env-sym (gensym))) - `(%defmacro ,name ,arg-sym + `(,arg-sym (let ((,whole-sym (first ,arg-sym)) (,lambda-sym (cdr (first ,arg-sym))) (,env-sym (second ,arg-sym))) (d-b ,lambda-list ,env-sym ,whole-sym ,lambda-sym ,@body))))) +(%defmacro* defmacro (name lambda-list . body) + `(%defmacro ,name + ,@(make-defmacro-body lambda-list body))) + (%defmacro* lambda (lambda-list . body) - (let ((lambda-sym (gensym))) - `(%lambda ,lambda-sym - (d-b ,lambda-list nil nil ,lambda-sym - ,@body)))) + `(%lambda + ,@(make-defun-body lambda-list body))) (defun funcall (function &rest arguments) (apply function arguments)) |