diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2016-09-07 06:10:13 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2016-09-07 06:10:13 -0700 |
| commit | 703e6ec56c8cd1eb33b6572fde69c454587c0beb (patch) | |
| tree | a90cb70c71bbc85a50ac6a14ba5c2c0ddbcf7f8e | |
| parent | 7409b670226a574119259a7a3d8597314954f12a (diff) | |
| download | txr-703e6ec56c8cd1eb33b6572fde69c454587c0beb.tar.gz txr-703e6ec56c8cd1eb33b6572fde69c454587c0beb.tar.bz2 txr-703e6ec56c8cd1eb33b6572fde69c454587c0beb.zip | |
Bugfix: x not macro-expanded in (set [x i] y).
* share/txr/stdlib/place.tl (sys:l1-setq): Expand sym, because
it might not be a symbol. If it isn't a symbol, just generate
a set.
(dwim): Unconditionally bind sys:*lisp1* to t, whether
or not the unexpanded place is a symbol. It could expand to
a symbol. The context is lisp-1 if it does that.
| -rw-r--r-- | share/txr/stdlib/place.tl | 23 |
1 files changed, 13 insertions, 10 deletions
diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl index c4e15f7f..6437ac45 100644 --- a/share/txr/stdlib/place.tl +++ b/share/txr/stdlib/place.tl @@ -34,13 +34,16 @@ (defun sys:eval-err (. params) (throwf 'eval-error . params)) - (defmacro sys:l1-setq (sym new-val :env e) - (caseq (lexical-lisp1-binding e sym) - (:var ^(sys:setq ,sym ,new-val)) - (:symacro (sys:eval-err "sys:l1-setq: invalid use on symbol macro")) - (t (if (boundp sym) - ^(sys:setq ,sym ,new-val) - ^(sys:lisp1-setq ,sym ,new-val))))) + (defmacro sys:l1-setq (u-expr new-val :env e) + (let ((e-expr (macroexpand u-expr e))) + (if (symbolp e-expr) + (caseq (lexical-lisp1-binding e e-expr) + (:var ^(sys:setq ,e-expr ,new-val)) + (:symacro (sys:eval-err "sys:l1-setq: invalid use on symbol macro")) + (t (if (boundp e-expr) + ^(sys:setq ,e-expr ,new-val) + ^(sys:lisp1-setq ,e-expr ,new-val)))) + ^(set ,u-expr ,new-val)))) (defmacro sys:l1-val (u-expr :env e) (let ((e-expr (macroexpand u-expr e))) @@ -500,7 +503,7 @@ oldval-sym newval-sym index-sym index-sym oldval-sym dflval-sym) - (let ((sys:*lisp1* (or (symbolp obj-place) sys:*lisp1*))) + (let ((sys:*lisp1* t)) (with-update-expander (ogetter-sym osetter-sym) obj-place nil ^(rlet ((,index-sym (sys:l1-val ,index)) ,*(if have-default-p @@ -518,7 +521,7 @@ (ssetter (with-gensyms (osetter-sym ogetter-sym obj-sym newval-sym index-sym) - (let ((sys:*lisp1* (or (symbolp obj-place) sys:*lisp1*))) + (let ((sys:*lisp1* t)) (with-update-expander (ogetter-sym osetter-sym) obj-place nil ^(macrolet ((,ssetter (val) ^(rlet ((,',index-sym (sys:l1-val ,',index)) @@ -538,7 +541,7 @@ (with-gensyms (osetter-sym ogetter-sym obj-sym index-sym oldval-sym dflval-sym) - (let ((sys:*lisp1* (or (symbolp obj-place) sys:*lisp1*))) + (let ((sys:*lisp1* t)) (with-update-expander (ogetter-sym osetter-sym) obj-place nil ^(macrolet ((,deleter () ;; todo: place must not have optional val ^(rlet ((,',obj-sym (,',ogetter-sym))) |