diff options
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | share/txr/stdlib/ifa.tl | 2 | ||||
| -rw-r--r-- | share/txr/stdlib/place.tl | 12 |
3 files changed, 18 insertions, 7 deletions
@@ -1,5 +1,16 @@ 2015-07-24 Kaz Kylheku <kaz@kylheku.com> + 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. + +2015-07-24 Kaz Kylheku <kaz@kylheku.com> + * eval.c (op_quote): Improved diagnostic. 2015-07-23 Kaz Kylheku <kaz@kylheku.com> 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))) |