diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2015-07-12 07:12:00 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2015-07-12 07:12:00 -0700 |
| commit | e1b76996ce822915896408e084695bda4bbcb465 (patch) | |
| tree | 769d03abf7f1cbab134ce725d866e974db40e2b5 | |
| parent | c8ae68c761a3b40ec9023e12d3efed679cca4055 (diff) | |
| download | txr-e1b76996ce822915896408e084695bda4bbcb465.tar.gz txr-e1b76996ce822915896408e084695bda4bbcb465.tar.bz2 txr-e1b76996ce822915896408e084695bda4bbcb465.zip | |
* share/txr/stdlib/ifa.tl (ifa): Use placelet to
allow "it" to be mutable when it denotes a place form.
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | share/txr/stdlib/ifa.tl | 19 |
2 files changed, 20 insertions, 4 deletions
@@ -1,5 +1,10 @@ 2015-07-12 Kaz Kylheku <kaz@kylheku.com> + * share/txr/stdlib/ifa.tl (ifa): Use placelet to + allow "it" to be mutable when it denotes a place form. + +2015-07-12 Kaz Kylheku <kaz@kylheku.com> + * share/txr/stdlib/place.tl (place-form-p): New function. * lisplib.c (place_set_entries): Add place-form-p to list of names. diff --git a/share/txr/stdlib/ifa.tl b/share/txr/stdlib/ifa.tl index bffe8246..1f79c208 100644 --- a/share/txr/stdlib/ifa.tl +++ b/share/txr/stdlib/ifa.tl @@ -46,10 +46,21 @@ (when (> n-candidate-args 1) (throwf 'eval-error "ifa: ambiguous situation: \ \ not clear what can be \"it\"")) - (let* ((temps (mapcar (ret (gensym)) args)) - (it-temp [temps pos-candidate])) - ^(let* (,*(zip temps args) (it ,it-temp)) - (if (,sym ,*temps) ,then ,else)))))))) + (iflet ((it-form (macroexpand [args pos-candidate] e)) + (is-place (place-form-p it-form))) + (let ((before-it [args 0..pos-candidate]) + (after-it [args (succ pos-candidate)..:])) + (let* ((btemps (mapcar (ret (gensym) before-it))) + (atemps (mapcar (ret (gensym) after-it)))) + ^(let (,*(zip btemps before-it)) + (placelet ((it ,it-form)) + (let (,*(zip atemps after-it)) + (if (,sym ,*atemps it ,*btemps) + ,then ,else)))))) + (let* ((temps (mapcar (ret (gensym)) args)) + (it-temp [temps pos-candidate])) + ^(let* (,*(zip temps args) (it ,it-temp)) + (if (,sym ,*temps) ,then ,else))))))))) (defmacro conda (. pairs) (tree-case pairs |