summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <code@mail.matthias.benkard.de>2013-07-18 17:05:19 +0200
committerMatthias Andreas Benkard <code@mail.matthias.benkard.de>2013-07-18 17:05:19 +0200
commit715deb36c56699c767cab746a7c6341f0f2446a3 (patch)
tree88d9e3350aadcc594da4e028c171ae544af4468a
parenta054e735eda7cbe151679b1e10a369251c8cf613 (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.lisp12
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