From 7409b670226a574119259a7a3d8597314954f12a Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 7 Sep 2016 06:09:08 -0700 Subject: Bugfix: nthcdr place not obtaining macro env. * share/txr/stdlib/place.tl (sys:*pl-env*): New special variable for passing macro-expansion environment to expanders. (call-update-expander, call-clobber-expander, call-delete-expander): bind sys:*pl-env* with passed-in env argument, so if the expander needs to itself recursively expand a macro, it has the macro-time env. (nthcdr): Do not try to capture :env parameter, because this will always be nil. Refer to sys:*pl-env* instead. --- share/txr/stdlib/place.tl | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) (limited to 'share') diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl index d34d03ed..c4e15f7f 100644 --- a/share/txr/stdlib/place.tl +++ b/share/txr/stdlib/place.tl @@ -29,6 +29,7 @@ (defvar *place-delete-expander* (hash)) (defvar *place-macro* (hash)) (defvar sys:*lisp1* nil) + (defvar sys:*pl-env* nil) (defun sys:eval-err (. params) (throwf 'eval-error . params)) @@ -155,17 +156,20 @@ (defun call-update-expander (getter setter unex-place env body) (let* ((place (sys:pl-expand unex-place env)) - (expander (get-update-expander place))) + (expander (get-update-expander place)) + (sys:*pl-env* env)) (sys:cp-origin [expander getter setter place body] place setter getter))) (defun call-clobber-expander (ssetter unex-place env body) (let* ((place (sys:pl-expand unex-place env)) - (expander (get-clobber-expander place))) + (expander (get-clobber-expander place)) + (sys:*pl-env* env)) (sys:cp-origin [expander ssetter place body] place ssetter))) (defun call-delete-expander (deleter unex-place env body) (let* ((place (sys:pl-expand unex-place env)) - (expander (get-delete-expander place))) + (expander (get-delete-expander place)) + (sys:*pl-env* env)) (sys:cp-origin [expander deleter place body] place deleter)))) (defmacro with-update-expander ((getter setter) unex-place env body) @@ -386,10 +390,10 @@ (prog1 (cdr ,tmp) (,csetter (car ,tmp)))))))) ,body))) -(defplace (nthcdr index list :env env) body +(defplace (nthcdr index list) body (getter setter (with-gensyms (index-sym sentinel-head-sym parent-cell-sym) - (if (place-form-p list env) + (if (place-form-p list sys:*pl-env*) (with-update-expander (lgetter lsetter) list nil ^(rlet ((,index-sym ,index)) (let* ((,sentinel-head-sym (cons nil (,lgetter))) -- cgit v1.2.3