Remove sys:*lisp1* hack from place expansion.

Instead of using a special variable hack to pass down the
request to treat a form as Lisp-1 if it happens to be a
symbol, we now wrap the form in ^(sys:l1-val ,form).  We
define sys:l1-val as a place. In the case when form is a
symbol with no lexical binding, requiring the special Lisp-1
treatment, sys:l1-val produces ^(sys:lisp1-value, form).
We define that as a place also, and that takes care of
everything.

* share/txr/stdlib/place.tl (sys:*lisp1*): Special variable
removed.
(sys:sym-update-expander, sys:sym-clobber-expander): Do not
test sys:*lisp1*; just produce a sys:setq form for updating a
symbolic place.
(call-update-expander, call-clobber-expander,
call-delete-expander): Drop the bugfix in the previous commit:
re-binding of sys:*lisp1* to nil
(defplace sys:l1-val, defplace sys:lisp1-value): New places.
(defplace dwim): Do not bind sys:*lisp1*. Wrap obj-place
in a sys:l1-val form, thereby annotating it so that it
receives the right sort of place expander.

1 files changed, 32 insertions, 24 deletions

diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl
index 13bfc258..ffe5aa91 100644
--- a/share/txr/stdlib/place.tl
+++ b/share/txr/stdlib/place.tl
@@ -29,7 +29,6 @@
   (defvar *place-update-expander* (hash))
   (defvar *place-delete-expander* (hash))
   (defvar *place-macro* (hash))
-  (defvar sys:*lisp1* nil)
   (defvar sys:*pl-env* nil)
 
   (defun sys:eval-err (. params)
@@ -60,21 +59,15 @@
 
   (defun sys:sym-update-expander (getter-name setter-name
                                   place-expr op-body)
-    (if sys:*lisp1*
-      ^(macrolet ((,getter-name () ^(sys:l1-val ,',place-expr))
-                  (,setter-name (val-expr) ^(sys:l1-setq ,',place-expr
-                                                         ,val-expr)))
-         ,op-body)
-      ^(macrolet ((,getter-name () ',place-expr)
-                  (,setter-name (val-expr) ^(sys:setq ,',place-expr
-                                                      ,val-expr)))
-         ,op-body)))
+    ^(macrolet ((,getter-name () ',place-expr)
+                (,setter-name (val-expr) ^(sys:setq ,',place-expr
+                                                    ,val-expr)))
+       ,op-body))
 
   (defun sys:sym-clobber-expander (simple-setter-name
                                    place-expr op-body)
     ^(macrolet ((,simple-setter-name (val-expr)
-                   ^(,(if sys:*lisp1* 'sys:l1-setq 'sys:setq)
-                      ,',place-expr ,val-expr)))
+                   ^(sys:setq ,',place-expr ,val-expr)))
        ,op-body))
 
   (defun sys:sym-delete-expander (deleter-name
@@ -182,7 +175,6 @@
     (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)))
@@ -191,7 +183,6 @@
     (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)))
@@ -200,7 +191,6 @@
     (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))))
@@ -439,6 +429,24 @@
                 (,setter (val) ^(sys:setq ,'(sys:var ,arg) ,val)))
        ,body)))
 
+(defplace (sys:l1-val arg) body
+  (getter setter
+    ^(macrolet ((,getter () ^(sys:l1-val ,',arg))
+                (,setter (val) ^(sys:l1-setq ,',arg ,val)))
+         ,body))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:l1-setq ,',arg ,val)))
+       ,body)))
+
+(defplace (sys:lisp1-value arg) body
+  (getter setter
+    ^(macrolet ((,getter () ^(sys:lisp1-value ,',arg))
+                (,setter (val) ^(sys:lisp1-setq ,',arg ,val)))
+         ,body))
+  (ssetter
+    ^(macrolet ((,ssetter (val) ^(sys:lisp1-setq ,',arg ,val)))
+       ,body)))
+
 (defplace (car cell) body
   (getter setter
     (with-gensyms (cell-sym)
@@ -670,10 +678,10 @@
 (defplace (dwim obj-place :env env . args) body
   (getter setter
     (with-gensyms (ogetter-sym osetter-sym obj-sym newval-sym)
-      (let ((arg-syms (mapcar (ret (gensym)) args))
-            (sys:*lisp1* t))
+      (let ((arg-syms (mapcar (ret (gensym)) args)))
         (if (place-form-p obj-place sys:*pl-env*)
-          (with-update-expander (ogetter-sym osetter-sym) obj-place sys:*pl-env*
+          (with-update-expander (ogetter-sym osetter-sym)
+                                ^(sys:l1-val ,obj-place) sys:*pl-env*
             ^(rlet ((,obj-sym (,ogetter-sym))
                     ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2))) arg-syms args))
                (macrolet ((,getter ()
@@ -697,10 +705,10 @@
                ,body))))))
   (ssetter
     (with-gensyms (osetter-sym ogetter-sym obj-sym newval-sym)
-      (let ((arg-syms (mapcar (ret (gensym)) args))
-            (sys:*lisp1* t))
+      (let ((arg-syms (mapcar (ret (gensym)) args)))
         (if (place-form-p obj-place sys:*pl-env*)
-          (with-update-expander (ogetter-sym osetter-sym) obj-place sys:*pl-env*
+          (with-update-expander (ogetter-sym osetter-sym)
+                                ^(sys:l1-val ,obj-place) sys:*pl-env*
             ^(macrolet ((,ssetter (val)
                          ^(rlet ((,',obj-sym (,',ogetter-sym))
                                  ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2)))
@@ -725,10 +733,10 @@
 
   (deleter
     (with-gensyms (osetter-sym ogetter-sym obj-sym oldval-sym)
-      (let ((arg-syms (mapcar (ret (gensym)) args))
-            (sys:*lisp1* t))
+      (let ((arg-syms (mapcar (ret (gensym)) args)))
         (if (place-form-p obj-place sys:*pl-env*)
-          (with-update-expander (ogetter-sym osetter-sym) obj-place sys:*pl-env*
+          (with-update-expander (ogetter-sym osetter-sym)
+                                ^(sys:l1-val ,obj-place) sys:*pl-env*
             ^(macrolet ((,deleter ()
                          ^(rlet ((,',obj-sym (,',ogetter-sym))
                                  ,*(mapcar (ret ^(,@1 (sys:l1-val ,@2)))