diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2016-09-07 06:09:08 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2016-09-07 06:09:08 -0700 |
| commit | 7409b670226a574119259a7a3d8597314954f12a (patch) | |
| tree | be4b01aa959e6d8b2d3a72417fb3e332656f9d92 /share | |
| parent | add0e86529a33fae5aa424c7d3f3bbc9854886c1 (diff) | |
| download | txr-7409b670226a574119259a7a3d8597314954f12a.tar.gz txr-7409b670226a574119259a7a3d8597314954f12a.tar.bz2 txr-7409b670226a574119259a7a3d8597314954f12a.zip | |
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.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/place.tl | 14 |
1 files changed, 9 insertions, 5 deletions
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))) |