From bae1a8b8d040c42df63436b60cd7d751abca9a76 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Thu, 2 Feb 2017 19:27:41 -0800 Subject: bugfix: limit depth of Lisp-1 treatment of places. This underscores why sys:*lisp1* is so hacky and should be removed. When we obtain the update, clobber or delete expander of a place which is the argument of a DWIM, requiring Lisp-1 treatment, we bind the sys:*lisp1* special. This alters the behavior of obtaining an expander for a symbolic place. Unfortunately, because call-update-expander (and friends) use sys:expand, all levels of the form are subject to place expansion with sys:*lisp1* bound to t. Example: (set [(car (inc a 2)) 10] "foo") Here, the (car ...) form is the place operand of the DWIM operator, and so sys:*lisp1* is set up around getting its expander. But then, oops, the a in (inc a 2) is also treated as Lisp-1, wrongly. These changes band-aid the situation. * share/txr/stdlib/place.tl (call-udpate-expander, call-clobber-expander, call-delete-expander): After retrieving the expander, bind sys:*lisp1* to nil so that its effect does not spill over into the sys:expand call which we apply to the expansion; i.e. reset sys:*lisp1* to nil around recursive expansion so that the Lisp-1 treatment is confined to depth 1. --- share/txr/stdlib/place.tl | 3 +++ 1 file changed, 3 insertions(+) diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl index b4828f95..13bfc258 100644 --- a/share/txr/stdlib/place.tl +++ b/share/txr/stdlib/place.tl @@ -182,6 +182,7 @@ (let* ((place (sys:pl-expand unex-place env)) (expander (get-update-expander place)) (sys:*pl-env* env) + (sys:*lisp1* nil) (expansion [expander getter setter place body]) (expansion-ex (sys:expand expansion env))) (sys:cp-origin expansion-ex place))) @@ -190,6 +191,7 @@ (let* ((place (sys:pl-expand unex-place env)) (expander (get-clobber-expander place)) (sys:*pl-env* env) + (sys:*lisp1* nil) (expansion [expander ssetter place body]) (expansion-ex (sys:expand expansion env))) (sys:cp-origin expansion-ex place))) @@ -198,6 +200,7 @@ (let* ((place (sys:pl-expand unex-place env)) (expander (get-delete-expander place)) (sys:*pl-env* env) + (sys:*lisp1* nil) (expansion [expander deleter place body]) (expansion-ex (sys:expand expansion env))) (sys:cp-origin expansion-ex place)))) -- cgit v1.2.3