diff options
author | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2013-07-18 17:05:19 +0200 |
---|---|---|
committer | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2013-07-18 17:05:19 +0200 |
commit | 715deb36c56699c767cab746a7c6341f0f2446a3 (patch) | |
tree | 88d9e3350aadcc594da4e028c171ae544af4468a | |
parent | a054e735eda7cbe151679b1e10a369251c8cf613 (diff) |
CONTEXT->NATIVE-ENVIRONMENT: Handle macros and symbol macros.
This especially helps in the presence of SETF in that it makes stuff like the following expand correctly:
(let (foo)
(macrolet ((x () 'foo))
(setf (x) 10))
foo)
-rw-r--r-- | sb-eval2.lisp | 12 |
1 files changed, 10 insertions, 2 deletions
diff --git a/sb-eval2.lisp b/sb-eval2.lisp index ad1a709..2b67360 100644 --- a/sb-eval2.lisp +++ b/sb-eval2.lisp @@ -127,6 +127,9 @@ (dolist (new-go-tag new-go-tags) (setq go-tags (acons new-go-tag catch-tag go-tags)))) new-context)) +(defun context-collect (context f) + (let ((parent (context-parent context))) + (append (funcall f context) (and parent (context-collect parent f))))) (defun context-find-go-tag (context go-tag) (let ((parent (context-parent context))) (or (cdr (assoc (the symbol go-tag) (context-go-tags context))) @@ -519,8 +522,13 @@ (defun context->native-environment (context) ;;FIXME - (declare (ignore context)) - (sb-c::internal-make-lexenv nil nil nil nil nil nil nil nil nil nil nil)) + (let ((functions + (loop for (name . expander) in (context-collect context 'context-macros) + collect `(,name . (sb-c::macro . ,expander)))) + (vars + (loop for (name . form) in (context-collect context 'context-symbol-macros) + collect `(,name . (sb-c::macro . form))))) + (sb-c::internal-make-lexenv functions vars nil nil nil nil nil nil nil nil nil))) (defun native-environment->context (lexenv) ;;FIXME |