Remove places.h generation hack.

* Makefile (GEN_HDRS, LISP_TO_C_STRING): Variables removed.
(%.h: %.tl): Rule removed. The place.h header is no longer
generated from place.tl.

* lisplib.c (place_instantiate): Load place.tl from stdlib directory,
rather than obtaining it from a string literal in generated header
place.h.

* place.tl: Moved to share/txr/stdlib directory.

* genvim.txr: Refer to place.tl in stdlib.

1 files changed, 557 insertions, 0 deletions

diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl
new file mode 100644
index 00000000..83c2d813
--- /dev/null
+++ b/share/txr/stdlib/place.tl
@@ -0,0 +1,557 @@
+;; Copyright 2015
+;; Kaz Kylheku <kaz@kylheku.com>
+;; Vancouver, Canada
+;; All rights reserved.
+;;
+;; Redistribution of this software in source and binary forms, with or without
+;; modification, is permitted provided that the following two conditions are met.
+;;
+;; Use of this software in any manner constitutes agreement with the disclaimer
+;; which follows the two conditions.
+;;
+;; 1. Redistributions of source code must retain the above copyright
+;;    notice, this list of conditions and the following disclaimer.
+;; 2. Redistributions in binary form must reproduce the above copyright
+;;    notice, this list of conditions and the following disclaimer in
+;;    the documentation and/or other materials provided with the
+;;    distribution.
+;;
+;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
+;; WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL THE
+;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DAMAGES, HOWEVER CAUSED,
+;; AND UNDER ANY THEORY OF LIABILITY, ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(progn
+  (macro-time
+    (defvar *place-clobber-expander* (hash))
+    (defvar *place-update-expander* (hash))
+    (defvar *place-delete-expander* (hash))
+    (defvar sys:*lisp1* nil)
+
+    (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-val (u-expr :env e)
+      (let ((e-expr (macroexpand u-expr e)))
+        (if (and (symbolp e-expr) (not (constantp e-expr)))
+          (caseq (lexical-lisp1-binding e e-expr)
+            (:fun ^(fun ,u-expr))
+            (:var u-expr)
+            (nil (if (boundp e-expr)
+                   u-expr
+                   ^(sys:lisp1-value ,u-expr)))
+            (t (sys:eval-err "sys:l1-val: invalid case")))
+          u-expr)))
+
+    (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)))
+
+    (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)))
+         ,op-body))
+
+    (defun sys:sym-delete-expander (deleter-name
+                                    place-expr . op-body)
+      ^(macrolet ((,deleter-name (:env env)
+                    (when (lexical-var-p env ',place-expr)
+                      (sys:eval-err "~s is a lexical variable, thus not deletable"
+                                    ',place-expr))
+                    ^(prog1
+                       (symbol-value ',',place-expr)
+                       (makunbound ',',place-expr))))
+         ,*op-body))
+
+    (defun get-update-expander (place)
+      (cond
+        ((symbolp place) (fun sys:sym-update-expander))
+        ((consp place) (or [*place-update-expander* (car place)]
+                           (sys:eval-err "~s is not an assignable place" place)))
+        (t (sys:eval-err "form ~s is not syntax denoting an assignable place" place))))
+
+    (defun get-clobber-expander (place)
+      (cond
+        ((symbolp place) (fun sys:sym-clobber-expander))
+        ((consp place) (or [*place-clobber-expander* (car place)]
+                           (iflet ((fun [*place-update-expander* (car place)]))
+                              (op apply fun (gensym) @1 @2 @rest))
+                           (sys:eval-err "~s is not an assignable place" place)))
+        (t (sys:eval-err "form ~s is not syntax denoting an assignable place" place))))
+
+    (defun get-delete-expander (place)
+      (cond
+        ((symbolp place) (fun sys:sym-delete-expander))
+        ((consp place) (or [*place-delete-expander* (car place)]
+                           (sys:eval-err "~s is not a deletable place" place)))
+        (t (sys:eval-err "form ~s is not syntax denoting a deletable place" place)))))
+
+  (defmacro rlet (bindings :env e . body)
+    (let ((exp-bindings (mapcar (aret ^(,@1 ,(macroexpand @2 e))) bindings)))
+      (let ((renames [keep-if constantp exp-bindings second])
+            (regular [remove-if constantp exp-bindings second]))
+        (cond ((and renames regular)
+                ^(symacrolet ,renames
+                   (let ,regular ,*body)))
+              (renames ^(symacrolet ,renames ,*body))
+              (regular ^(let ,regular ,*body))
+              (t ^(progn ,*body))))))
+
+  (defmacro with-gensyms (syms . body)
+    ^(let ,(zip syms (repeat '((gensym)))) ,*body))
+
+  (macro-time
+    (defun call-update-expander (getter setter unex-place env body)
+      (let* ((place (sys:expand unex-place env))
+             (expander (get-update-expander place)))
+        [expander getter setter place body]))
+
+    (defun call-clobber-expander (ssetter unex-place env body)
+      (let* ((place (sys:expand unex-place env))
+             (expander (get-clobber-expander place)))
+        [expander ssetter place body]))
+
+    (defun call-delete-expander (deleter unex-place env body)
+      (let* ((place (sys:expand unex-place env))
+             (expander (get-delete-expander place)))
+        [expander deleter place body])))
+
+  (defmacro with-update-expander ((getter setter) unex-place env body)
+    ^(with-gensyms (,getter ,setter)
+       (call-update-expander ,getter ,setter ,unex-place ,env ,body)))
+
+  (defmacro with-clobber-expander ((ssetter) unex-place env body)
+    ^(with-gensyms (,ssetter)
+       (call-clobber-expander ,ssetter ,unex-place ,env ,body)))
+
+  (defmacro with-delete-expander ((deleter) unex-place env body)
+    ^(with-gensyms (,deleter)
+       (call-delete-expander ,deleter ,unex-place ,env ,body)))
+
+  (defmacro set (:env env . place-value-pairs)
+    (let ((assign-forms (mapcar (tb ((place : (value nil value-present-p)))
+                                  (unless value-present-p
+                                    (sys:eval-err "set: arguments must be pairs"))
+                                  (with-clobber-expander (ssetter) place env
+                                     ^(,ssetter ,value)))
+                                (tuples 2 place-value-pairs))))
+      (if (cdr assign-forms)
+        ^(progn ,*assign-forms)
+        (car assign-forms))))
+
+  (defmacro pset (:env env . place-value-pairs)
+    (let ((len (length place-value-pairs)))
+      (cond
+        ((oddp len) (sys:eval-err "pset: arguments must be pairs"))
+        ((<= len 2) ^(set ,*place-value-pairs))
+        (t (let* ((pvtgs (mapcar (tb ((a b))
+                                   (list a b (gensym) (gensym) (gensym)))
+                                 (tuples 2 place-value-pairs)))
+                  (ls (reduce-left (tb ((lets stores) (place value temp getter setter))
+                                       (list ^((,temp ,value) ,*lets)
+                                             ^((,setter ,temp) ,*stores)))
+                                   pvtgs '(nil nil)))
+                  (lets (first ls))
+                  (stores (second ls))
+                  (body-form ^(let (,*lets) ,*stores)))
+             (reduce-left (tb (accum-form (place value temp getter setter))
+                            (call-update-expander getter setter
+                                                  place env accum-form))
+                          pvtgs body-form))))))
+
+  (defmacro zap (place :env env)
+    (with-update-expander (getter setter) place env
+      ^(prog1 (,getter) (,setter nil))))
+
+  (defmacro flip (place :env env)
+    (with-update-expander (getter setter) place env
+      ^(,setter (not (,getter)))))
+
+  (defmacro inc (place : (delta 1) :env env)
+    (with-update-expander (getter setter) place env
+      (caseql delta
+        (0 ^(,setter (,getter)))
+        (1 ^(,setter (succ (,getter))))
+        (2 ^(,setter (ssucc (,getter))))
+        (3 ^(,setter (sssucc (,getter))))
+        (t ^(,setter (+ (,getter) ,delta))))))
+
+  (defmacro dec (place : (delta 1) :env env)
+    (with-update-expander (getter setter) place env
+      (caseql delta
+        (0 ^(,setter (,getter)))
+        (1 ^(,setter (pred (,getter))))
+        (2 ^(,setter (ppred (,getter))))
+        (3 ^(,setter (pppred (,getter))))
+        (t ^(,setter (- (,getter) ,delta))))))
+
+  (defmacro swap (place-0 place-1 :env env)
+    (with-gensyms (tmp)
+      (with-update-expander (getter-0 setter-0) place-0 env
+        (with-update-expander (getter-1 setter-1) place-1 env
+          ^(let ((,tmp (,getter-0)))
+             (,setter-0 (,getter-1))
+             (,setter-1 ,tmp))))))
+
+  (defmacro push (new-item place :env env)
+    (with-gensyms (new-sym)
+      ^(let ((,new-sym ,new-item))
+         ,(with-update-expander (getter setter) place env
+            ^(,setter (cons ,new-sym (,getter)))))))
+
+  (defmacro pop (place :env env)
+    (with-gensyms (tmp)
+      (with-update-expander (getter setter) place env
+        ^(let ((,tmp (,getter)))
+           (prog1 (car ,tmp) (,setter (cdr ,tmp)))))))
+
+  (defmacro pushnew (new-item place :env env :
+                              (testfun :)
+                              (keyfun :))
+    (with-update-expander (getter setter) place env
+      (with-gensyms (new-item-sym old-list-sym)
+        ^(let ((,new-item-sym ,new-item))
+           ,(with-update-expander (getter setter) place env
+              ^(let ((,old-list-sym (,getter)))
+                 (if (member ,new-item-sym ,old-list-sym ,testfun ,keyfun)
+                   ,old-list-sym
+                   (,setter (cons ,new-item-sym ,old-list-sym)))))))))
+
+  (defmacro shift (:env env . places)
+    (tree-case places
+      (() (sys:eval-err "shift: need at least two arguments"))
+      ((place) (sys:eval-err "shift: need at least two arguments"))
+      ((place newvalue)
+       (with-update-expander (getter setter) place env
+          ^(prog1 (,getter) (,setter ,newvalue))))
+      ((place . others)
+        (with-update-expander (getter setter) place env
+          ^(prog1 (,getter) (,setter (shift ,*others)))))))
+
+  (defmacro rotate (:env env . places)
+    (tree-case places
+      (() ())
+      ((fplace) fplace)
+      ((fplace . rplaces)
+       (with-gensyms (tmp)
+         (with-update-expander (getter-f setter-f) fplace env
+           ^(let ((,tmp (,getter-f)))
+              (,setter-f (shift ,*rplaces ,tmp))
+              ,tmp))))))
+
+  (defmacro del (place :env env)
+    (with-delete-expander (deleter) place env
+      ^(,deleter)))
+
+  (defmacro defplace (place-destructuring-args body-sym
+                      (getter-sym setter-sym update-body) :
+                      ((ssetter-sym clobber-body))
+                      ((deleter-sym delete-body)))
+    (symacrolet ((name (car place-destructuring-args))
+                 (args (cdr place-destructuring-args)))
+      (unless (and name
+                   (symbolp name)
+                   (not (keywordp name))
+                   (not (eq t name)))
+        (sys:eval-err "~s: ~s cannot be used as a place name"
+                  'defplace name))
+      (with-gensyms (place)
+        ^(macro-time
+           (sethash *place-update-expander* ',name
+             (lambda (,getter-sym ,setter-sym ,place ,body-sym)
+               (tree-bind ,args (cdr ,place)
+                  ,update-body)))
+           ,*(if ssetter-sym
+              ^((sethash *place-clobber-expander* ',name
+                  (lambda (,ssetter-sym ,place ,body-sym)
+                    (tree-bind ,args (cdr ,place)
+                       ,clobber-body)))))
+           ,*(if deleter-sym
+               ^((sethash *place-delete-expander* ',name
+                   (lambda (,deleter-sym ,place ,body-sym)
+                     (tree-bind ,args (cdr ,place)
+                        ,delete-body)))))))))
+
+  (defplace (car cell) body
+    (getter setter
+      (with-gensyms (cell-sym)
+        ^(rlet ((,cell-sym ,cell))
+           (macrolet ((,getter () ^(car ,',cell-sym))
+                      (,setter (val) ^(sys:rplaca ,',cell-sym ,val)))
+             ,body))))
+    (ssetter
+      ^(macrolet ((,ssetter (val) ^(sys:rplaca ,',cell ,val)))
+        ,body))
+    (deleter
+      ^(macrolet ((,deleter () ^(pop ,',cell)))
+         ,body)))
+
+  (defplace (cdr cell) body
+    (getter setter
+      (with-gensyms (cell-sym)
+        ^(rlet ((,cell-sym ,cell))
+           (macrolet ((,getter () ^(cdr ,',cell-sym))
+                      (,setter (val) ^(sys:rplacd ,',cell-sym ,val)))
+             ,body))))
+    (ssetter
+      ^(macrolet ((,ssetter (val) ^(sys:rplacd ,',cell ,val)))
+         ,body))
+    (deleter
+      ^(macrolet ((,deleter () ^(zap (cdr ,',cell))))
+         ,body)))
+
+   (defplace (vecref vector index :whole args) body
+     (getter setter
+       (with-gensyms (vec-sym ind-sym)
+         ^(rlet ((,vec-sym ,vector)
+                 (,ind-sym ,index))
+            (macrolet ((,getter () ^(vecref ,',vec-sym ,',ind-sym))
+                       (,setter (val) ^(refset ,',vec-sym ,',ind-sym ,val)))
+               ,body))))
+     (ssetter
+       ^(macrolet ((,ssetter (val) ^(refset ,*',args ,val)))
+          ,body))
+     (deleter
+       (with-gensyms (vec-sym ind-sym)
+         ^(rlet ((,vec-sym ,vector)
+                 (,ind-sym ,index))
+            (macrolet ((,deleter ()
+                          ^(prog1 (vecref ,',vec-sym ,',ind-sym)
+                                  (replace-vec ,',vec-sym nil
+                                               ,',ind-sym (succ ,',ind-sym)))))
+              ,body)))))
+
+   (defplace (chr-str string index :whole args) body
+     (getter setter
+       (with-gensyms (str-sym ind-sym)
+         ^(rlet ((,str-sym ,string)
+                 (,ind-sym ,index))
+            (macrolet ((,getter () ^(chr-str ,',str-sym ,',ind-sym))
+                       (,setter (val) ^(chr-str-set ,',str-sym ,',ind-sym ,val)))
+               ,body))))
+     (ssetter
+       ^(macrolet ((,ssetter (val) ^(chr-str-set ,*',args ,val)))
+          ,body))
+     (deleter
+       (with-gensyms (str-sym ind-sym)
+         ^(rlet ((,str-sym ,string)
+                 (,ind-sym ,index))
+            (macrolet ((,deleter ()
+                          ^(prog1 (chr-str ,',str-sym ,',ind-sym)
+                                  (replace-str ,',str-sym nil
+                                               ,',ind-sym (succ ,',ind-sym)))))
+              ,body)))))
+
+   (defplace (ref seq index :whole args) body
+     (getter setter
+       (with-gensyms (seq-sym ind-sym)
+         ^(rlet ((,seq-sym ,seq)
+                 (,ind-sym ,index))
+            (macrolet ((,getter () ^(ref ,',seq-sym ,',ind-sym))
+                       (,setter (val) ^(refset ,',seq-sym ,',ind-sym ,val)))
+               ,body))))
+     (ssetter
+       ^(macrolet ((,ssetter (val) ^(refset ,*',args ,val)))
+          ,body))
+     (deleter
+       (with-gensyms (seq-sym ind-sym)
+         ^(rlet ((,seq-sym ,seq)
+                 (,ind-sym ,index))
+            (macrolet ((,deleter ()
+                          ^(prog1 (ref ,',seq-sym ,',ind-sym)
+                                  (replace ,',seq-sym nil
+                                           ,',ind-sym (succ ,',ind-sym)))))
+              ,body)))))
+
+   (defplace (gethash hash key : (default nil have-default-p)) body
+     (getter setter
+       (with-gensyms (entry-sym)
+         ^(let ((,entry-sym (inhash ,hash ,key ,default)))
+            (macrolet ((,getter () ^(cdr ,',entry-sym))
+                       (,setter (val) ^(sys:rplacd ,',entry-sym ,val)))
+               ,body))))
+     :
+     (deleter
+       ^(macrolet ((,deleter ()
+                     (if ,have-default-p
+                       (with-gensyms (entry-sym
+                                      dfl-sym)
+                         ^(rlet ((,entry-sym (inhash ,',hash ,',key))
+                                 (,dfl-sym ,',default))
+                            (if ,entry-sym
+                              (remhash ,',hash ,',key)
+                              ,dfl-sym)))
+                       ^(remhash ,',hash ,',key))))
+          ,body)))
+
+   (defplace (dwim obj-place index : (default nil have-default-p) :env env) body
+     (getter setter
+       (with-gensyms (ogetter-sym osetter-sym obj-sym
+                      oldval-sym newval-sym
+                      index-sym index-sym
+                      oldval-sym dflval-sym)
+         (let ((sys:*lisp1* (or (symbolp obj-place) sys:*lisp1*)))
+           (with-update-expander (ogetter-sym osetter-sym) obj-place nil
+             ^(rlet ((,obj-sym (,ogetter-sym))
+                     (,index-sym (sys:l1-val ,index))
+                     ,*(if have-default-p
+                         ^((,dflval-sym (sys:l1-val ,default)))))
+                (let ((,oldval-sym [,obj-sym
+                                   ,index-sym
+                                   ,*(if have-default-p ^(,dflval-sym))]))
+                  (macrolet ((,getter () ',oldval-sym)
+                             (,setter (val)
+                                ^(rlet ((,',newval-sym ,val))
+                                   (,',osetter-sym
+                                     (sys:dwim-set ,',obj-sym
+                                                   ,',index-sym ,',newval-sym))
+                                   ,',newval-sym)))
+                     ,body)))))))
+     (ssetter
+       (with-gensyms (osetter-sym ogetter-sym
+                      obj-sym newval-sym index-sym)
+         (let ((sys:*lisp1* (or (symbolp obj-place) sys:*lisp1*)))
+           (with-update-expander (ogetter-sym osetter-sym) obj-place nil
+             ^(macrolet ((,ssetter (val)
+                          ^(rlet ((,',obj-sym (,',ogetter-sym))
+                                  (,',index-sym (sys:l1-val ,',index))
+                                  (,',newval-sym ,val))
+                             (,',osetter-sym
+                               (sys:dwim-set ,',obj-sym
+                                             ,*(if ,have-default-p
+                                                 ^((prog1
+                                                     ,',index-sym
+                                                     (sys:l1-val ,',default)))
+                                                 ^(,',index-sym))
+                                             ,',newval-sym))
+                             ,',newval-sym)))
+                  ,body)))))
+
+     (deleter
+       (with-gensyms (osetter-sym ogetter-sym
+                      obj-sym index-sym oldval-sym
+                      dflval-sym)
+         (let ((sys:*lisp1* (or (symbolp obj-place) sys:*lisp1*)))
+           (with-update-expander (ogetter-sym osetter-sym) obj-place nil
+             ^(macrolet ((,deleter ()  ;; todo: place must not have optional val
+                          ^(rlet ((,',obj-sym (,',ogetter-sym)))
+                             (let* ((,',index-sym (sys:l1-val ,',index))
+                                    (,',oldval-sym [,',obj-sym
+                                                    ,',index-sym
+                                                    ,*(if ,have-default-p
+                                                        ^(,',default))]))
+                               (progn
+                                 (,',osetter-sym
+                                   (sys:dwim-del ,',obj-sym ,',index-sym))
+                                 ,',oldval-sym)))))
+                  ,body))))))
+
+   (defplace (force promise) body
+     (getter setter
+       (with-gensyms (promise-sym)
+         ^(rlet ((,promise-sym ,promise))
+             (macrolet ((,getter ()
+                           ^(force ,',promise-sym))
+                        (,setter (val)
+                           ^(set (car (cdr ,',promise-sym)) ,val)))
+               ,body))))
+     (ssetter
+       (with-gensyms (promise-sym)
+         ^(rlet ((,promise-sym ,promise))
+            (macrolet ((,ssetter (val)
+                         ^(prog1
+                            (set (car (cdr ,',promise-sym)) ,val)
+                            (set (car ,',promise-sym) 'sys:promise-forced))))
+              ,body)))))
+
+   (defplace (errno) body
+     (getter setter
+       ^(macrolet ((,getter () '(errno))
+                   (,setter (val-expr)
+                      (with-gensyms (val-sym)
+                        ^(rlet ((,val-sym ,val-expr))
+                            (progn (errno ,val-sym) ,val-sym)))))
+          ,body)))
+
+   (defplace (fun sym) body
+     (getter setter
+       ^(macrolet ((,getter () ^(fun ,',sym))
+                   (,setter (val) ^(sys:setqf ,',sym ,val)))
+          ,*body))
+     :
+     (deleter
+       ^(macrolet ((,deleter (:env env)
+                      (when (lexical-fun-p env ',sym)
+                        (sys:eval-err "~s is a lexical function, \
+                                      \ thus not deletable"
+                                    ',sym))
+                       ^(fmakunbound ',',sym)))
+          ,*body)))
+
+   (defun sys:get-fb (sym)
+     (or (gethash sys:top-fb sym)
+         (sys:eval-err "unbound function ~s" sym)))
+
+   (defplace (symbol-function sym-expr) body
+     (getter setter
+       (with-gensyms (binding-sym)
+         ^(let ((,binding-sym (sys:get-fb ,sym-expr)))
+             (macrolet ((,getter () ^(cdr ,',binding-sym))
+                        (,setter (val) ^(sys:rplacd ,',binding-sym ,val)))
+               ,*body))))
+     :
+     (deleter
+       ^(macrolet ((,deleter () ^(fmakunbound ,',sym-expr)))
+          ,*body)))
+
+   (defun sys:get-vb (sym)
+     (or (gethash sys:top-vb sym)
+         (sys:eval-err "unbound variable ~s" sym)))
+
+   (defplace (symbol-value sym-expr) body
+     (getter setter
+       (with-gensyms (binding-sym)
+         ^(let ((,binding-sym (sys:get-vb ,sym-expr)))
+             (macrolet ((,getter () ^(cdr ,',binding-sym))
+                        (,setter (val) ^(sys:rplacd ,',binding-sym ,val)))
+               ,*body))))
+     :
+     (deleter
+       ^(macrolet ((,deleter () ^(makunbound ,',sym-expr)))
+          ,*body)))
+
+   (macro-time
+     (each ((from '(car cdr))
+            (to '(first rest)))
+       (each ((table (list *place-update-expander*
+                           *place-clobber-expander*
+                           *place-delete-expander*)))
+         (set [table to] [table from]))))
+
+   (defmacro define-modify-macro (name lambda-list function)
+     (let ((cleaned-lambda-list (mapcar [iffi consp car]
+                                        (remql : lambda-list))))
+       (with-gensyms (place-sym args-sym)
+         ^(defmacro ,name (:env env ,place-sym ,*lambda-list)
+            (with-update-expander (getter setter) ,place-sym env
+              ^(,setter (,',function (,getter) ,,*cleaned-lambda-list))))))))