diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2015-07-24 18:22:36 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2015-07-24 18:22:36 -0700 |
| commit | 5243b933a609af037a5e39f76ea7d61b07bd1343 (patch) | |
| tree | f1b93394a0c5d237db72a1f26fe652309fc2bf59 /share | |
| parent | 18f21b3f0e4ceee9a202d5b58c0997891e57092d (diff) | |
| download | txr-5243b933a609af037a5e39f76ea7d61b07bd1343.tar.gz txr-5243b933a609af037a5e39f76ea7d61b07bd1343.tar.bz2 txr-5243b933a609af037a5e39f76ea7d61b07bd1343.zip | |
Bugfix: place-form-p must expand place macros.
* share/txr/stdlib/place.tl (place-form-p): Take
environment parameter. Expand the place form using sys:pl-expand.
* share/txr/stdlib/ifa.tl (ifa): Pass environment
to place-form-p.
(nthcdr): Pass environment down to place-form-p.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/ifa.tl | 2 | ||||
| -rw-r--r-- | share/txr/stdlib/place.tl | 12 |
2 files changed, 7 insertions, 7 deletions
diff --git a/share/txr/stdlib/ifa.tl b/share/txr/stdlib/ifa.tl index 1f79c208..c6a9abd2 100644 --- a/share/txr/stdlib/ifa.tl +++ b/share/txr/stdlib/ifa.tl @@ -47,7 +47,7 @@ (throwf 'eval-error "ifa: ambiguous situation: \ \ not clear what can be \"it\"")) (iflet ((it-form (macroexpand [args pos-candidate] e)) - (is-place (place-form-p it-form))) + (is-place (place-form-p it-form e))) (let ((before-it [args 0..pos-candidate]) (after-it [args (succ pos-candidate)..:])) (let* ((btemps (mapcar (ret (gensym) before-it))) diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl index f086ce31..398ecbe3 100644 --- a/share/txr/stdlib/place.tl +++ b/share/txr/stdlib/place.tl @@ -83,10 +83,10 @@ (makunbound ',',place-expr)))) ,*op-body)) - (defun place-form-p (place) - (when (or (bindable place) - (and (consp place) [*place-update-expander* (car place)])) - t)) + (defun place-form-p (unex-place env) + (let ((place (sys:pl-expand unex-place env))) + (or (bindable place) + (and (consp place) [*place-update-expander* (car place)] t)))) (defun get-update-expander (place) (cond @@ -355,10 +355,10 @@ (prog1 (cdr ,tmp) (,csetter (car ,tmp)))))))) ,body))) -(defplace (nthcdr index list) body +(defplace (nthcdr index list :env env) body (getter setter (with-gensyms (index-sym sentinel-head-sym parent-cell-sym) - (if (place-form-p list) + (if (place-form-p list env) (with-update-expander (lgetter lsetter) list nil ^(rlet ((,index-sym ,index)) (let* ((,sentinel-head-sym (cons nil (,lgetter))) |