From 98ad36db6286960152b38d4d47a710b220cf808e Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Thu, 18 Jul 2013 13:41:27 +0200 Subject: Implement MACROLET. --- sb-eval2.lisp | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/sb-eval2.lisp b/sb-eval2.lisp index db8b301..816e462 100644 --- a/sb-eval2.lisp +++ b/sb-eval2.lisp @@ -346,6 +346,22 @@ (symbol (keywordify (first entry))))) (symbol (keywordify entry))))) +(declaim (ftype (function * eval-closure) prepare-lambda)) +(defun prepare-macro-lambda (name lambda-form context) + (destructuring-bind (lambda-list &rest body) + lambda-form + (let* ((whole (gensym "WHOLE")) + (env (gensym "ENV")) + (body-form (sb-kernel:parse-defmacro lambda-list + whole + body + name + 'macrolet + :environment env))) + (prepare-form `(lambda (,whole ,env) + ,body-form) + context)))) + (declaim (ftype (function * eval-closure) prepare-lambda)) (defun prepare-lambda (lambda-form context) (destructuring-bind (lambda-list &rest body) lambda-form @@ -840,7 +856,9 @@ (let ((bindings (mapcar (lambda (form) (cons (first form) (funcall - (prepare-lambda (rest form) context) + (prepare-macro-lambda (first form) + (rest form) + context) (make-null-environment)))) bindings))) (prepare-progn body (context-add-macros context bindings))))) @@ -883,7 +901,7 @@ (global-macro? (macro-function f))) (cond (local-macro? - (let ((macro-function (cdr local-macro?))) + (let ((macro-function local-macro?)) (prepare-form (funcall (the function macro-function) form (context->native-environment context)) -- cgit v1.2.3