diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2019-06-17 19:21:21 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2019-06-17 19:21:21 -0700 |
| commit | 240fe7755984ed0a68cdab10bed11d2fae4e2802 (patch) | |
| tree | 41ba5f08ae90419af34846cda2bb2b0b6a89d687 /share | |
| parent | 0163732bfa72363ac2184722f253f377df0023f6 (diff) | |
| download | txr-240fe7755984ed0a68cdab10bed11d2fae4e2802.tar.gz txr-240fe7755984ed0a68cdab10bed11d2fae4e2802.tar.bz2 txr-240fe7755984ed0a68cdab10bed11d2fae4e2802.zip | |
defset: fix non-hygienic Lisp-1 evaluation.
* share/txr/stdlib/defset.tl (defset-expander): In code that
binds user-supplied variables and contains a user-supplied
form that refers to those variables, we can't use code like
(op list (gensym)) or [mapcar car ...]. These are susceptible
to capture of the symbols list and car.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/defset.tl | 14 |
1 files changed, 7 insertions, 7 deletions
diff --git a/share/txr/stdlib/defset.tl b/share/txr/stdlib/defset.tl index f665814b..1aee478a 100644 --- a/share/txr/stdlib/defset.tl +++ b/share/txr/stdlib/defset.tl @@ -69,18 +69,18 @@ ^(defplace (,name . ,args) body (,getter ,setter (tree-bind (,*params) ,args - (let* ((,gpf-pairs (mapcar (op list (gensym)) (list ,*fixpars))) + (let* ((,gpf-pairs (mapcar (op (fun list) (gensym)) (list ,*fixpars))) (,gpr-pairs (if ',restpar (if (consp ,restpar) - (mapcar (op list (gensym)) ,restpar) + (mapcar (op (fun list) (gensym)) ,restpar) (list (list (gensym) ,restpar))))) - (,ext-pairs (mapcar (op list (gensym)) (list ,*extsyms))) - (,pgens [mapcar car ,gpf-pairs]) - (,rgens [mapcar car ,gpr-pairs]) - (,egens [mapcar car ,ext-pairs]) + (,ext-pairs (mapcar (op (fun list) (gensym)) (list ,*extsyms))) + (,pgens (mapcar (fun car) ,gpf-pairs)) + (,rgens (mapcar (fun car) ,gpr-pairs)) + (,egens (mapcar (fun car) ,ext-pairs)) (,all-pairs (append ,gpf-pairs ,gpr-pairs ,ext-pairs)) (,agens (collect-each ((a ,args)) - (let ((p [pos a ,all-pairs eq cadr])) + (let ((p (pos a ,all-pairs (fun eq) (fun cadr)))) (if p (car (del [,all-pairs p])) a))))) |