diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2019-06-29 22:26:12 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2019-06-29 22:26:12 -0700 |
| commit | 259e4a0c51bc7d2e2d043e9af05b388b71c510fd (patch) | |
| tree | ef79331af21047bc1d2d171e86b38773dde1d8a6 /share | |
| parent | 33ab516588d6c0526ef2d77e1764c2004492a4ea (diff) | |
| download | txr-259e4a0c51bc7d2e2d043e9af05b388b71c510fd.tar.gz txr-259e4a0c51bc7d2e2d043e9af05b388b71c510fd.tar.bz2 txr-259e4a0c51bc7d2e2d043e9af05b388b71c510fd.zip | |
stdlib: pass env to constantp
* share/txr/stdlib/except.tl (catch**): Obtain macro
environment and pass to constantp.
* share/txr/stdlib/place.tl (last, butlast): Likewise.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/except.tl | 4 | ||||
| -rw-r--r-- | share/txr/stdlib/place.tl | 12 |
2 files changed, 8 insertions, 8 deletions
diff --git a/share/txr/stdlib/except.tl b/share/txr/stdlib/except.tl index 73ba253d..4ceba4cb 100644 --- a/share/txr/stdlib/except.tl +++ b/share/txr/stdlib/except.tl @@ -41,7 +41,7 @@ (let ((catch-syms [mapcar car catch-clauses])) ^(sys:catch ,catch-syms ,try-form nil ,*catch-clauses))) -(defmacro catch** (try-form . catch-clauses) +(defmacro catch** (:env menv try-form . catch-clauses) (let ((catch-syms [mapcar car catch-clauses]) sys-catch-clauses descs) (each ((cl catch-clauses)) @@ -50,7 +50,7 @@ (push desc descs))) (sys:setq sys-catch-clauses (nreverse sys-catch-clauses)) (sys:setq descs (nreverse descs)) - (let ((desc-expr (if [all descs constantp] + (let ((desc-expr (if [all descs (op constantp @1 menv)] ^'(,*[mapcar eval descs]) ^(list ,*descs)))) ^(sys:catch ,catch-syms ,try-form ,desc-expr ,*sys-catch-clauses)))) diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl index 6b295bc3..303548da 100644 --- a/share/txr/stdlib/place.tl +++ b/share/txr/stdlib/place.tl @@ -940,21 +940,21 @@ (define-place-macro ninth (obj) ^(ref ,obj 8)) (define-place-macro tenth (obj) ^(ref ,obj 9)) -(define-place-macro last (obj : (n nil have-n)) +(define-place-macro last (:env e obj : (n nil have-n)) (cond - ((and have-n (constantp n) (not (plusp n))) + ((and have-n (constantp n e) (not (plusp n))) ^(sub ,obj t t)) - ((and have-n (constantp n)) + ((and have-n (constantp n e)) ^(sub ,obj ,(- n) t)) (have-n ^(sub ,obj (- (max ,n 0)) t)) (t ^(sub ,obj -1 t)))) -(define-place-macro butlast (obj : (n nil have-n)) +(define-place-macro butlast (:env e obj : (n nil have-n)) (cond - ((and have-n (constantp n) (not (plusp n))) + ((and have-n (constantp n e) (not (plusp n))) obj) - ((and have-n (constantp n)) + ((and have-n (constantp n e)) ^(sub ,obj 0 ,(- n))) (have-n ^(sub ,obj 0 (- (max ,n 0)))) |