diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2025-04-01 18:26:48 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2025-04-01 18:26:48 -0700 |
commit | 00a1bcc7720c99c2e540af45af0a2d5238fae381 (patch) | |
tree | d330378434efc4325c7d918768930da76464d3f8 | |
parent | 70dbd3666379cf35167785751e86c6780e400396 (diff) | |
download | txr-00a1bcc7720c99c2e540af45af0a2d5238fae381.tar.gz txr-00a1bcc7720c99c2e540af45af0a2d5238fae381.tar.bz2 txr-00a1bcc7720c99c2e540af45af0a2d5238fae381.zip |
expand-hook-combine: bugfix.
Here we fix bugs in expand-hook-combine, imrprove the tests
and make different recommendations in the manual about hook
order.
* eval.c (expand_hook_combine_fun): Fix incorrect tests
which cause the next function to be ignored.
* tests/011/exphook.tl: (pico-style-expand-hook): Needs tweak
to evaluate constantp using standard expansion (without
pico-style), so that pico-style can nest with ifx in either
order.
(pico-style): Now when we call expand-hook-combine
we give the new hook first, and the existing one next.
This behavior makes more sense as a default go-to strategy
because it gives priority to the innermost hook-based macro,
closest to the code.
(infix-expand-hook, ifx): Add test cases which test nesting of
hook-based macros.
* txr.1: Opposite recommendation made about chaining of
expand hooks: new first, fall back on old.
Example adjusted.
-rw-r--r-- | eval.c | 4 | ||||
-rw-r--r-- | tests/011/exphook.tl | 39 | ||||
-rw-r--r-- | txr.1 | 17 |
3 files changed, 45 insertions, 15 deletions
@@ -5564,13 +5564,13 @@ static val expand_hook_combine_fun(val env, val form, val menv, val type) if (first) { val nform = funcall3(first, form, menv, type); - if (nform) + if (nform != form) return nform; } if (next) { val nform = funcall3(next, form, menv, type); - if (nform) + if (nform != form) return nform; } diff --git a/tests/011/exphook.tl b/tests/011/exphook.tl index 8439ac56..7f745da9 100644 --- a/tests/011/exphook.tl +++ b/tests/011/exphook.tl @@ -2,16 +2,45 @@ (defun-match pico-style-expand-hook ((@(as form (@obj . @rest)) @nil nil) - (if (constantp obj) - ^(quote ,form) - form)) + (let ((*expand-hook* nil)) + (if (constantp obj) + ^(quote ,form) + form))) ((@form @nil @nil) form)) (defmacro pico-style (:env env . body) - (let ((*expand-hook* [expand-hook-combine *expand-hook* - pico-style-expand-hook])) + (let ((*expand-hook* [expand-hook-combine pico-style-expand-hook + *expand-hook*])) (expand ^(progn ,*body) env))) (mtest (pico-style (1 2 3)) (1 2 3) (pico-style (let ((a 0)) (cons a (1 2 3)))) (0 1 2 3)) + +(defun-match infix-expand-hook + ((@(as form (@x @y . @rest)) @nil nil) + (if (fboundp y) + ^(,y ,x ,*rest) + form)) + ((@form @nil @nil) form)) + +(defmacro ifx (:env env . body) + (let ((*expand-hook* [expand-hook-combine infix-expand-hook *expand-hook*])) + (expand ^(progn ,*body) env))) + +(test + (ifx (let ((a 1) (b 2) (c 3)) + (- ((a + b) * 3)))) + -9) + +(test + (ifx + (pico-style + ((1) cons (2)))) + ((1) . (2))) + +(test + (pico-style + (ifx + ((1) cons (2)))) + ((1) . (2))) @@ -44087,16 +44087,17 @@ rather than assign a value to it. Assigning an incorrect value to to it in a Listener session may be difficult to recover from, since it may render the Listener incapable of evaluating forms. -Note: it is recommended to capture the previous value of +Note: it is recommended for a hook to have access to the previous value of .code *expand-hook* -and call that function before performing any transformation of +and call that function in cases where +.meta form +the hook would decline to perform a transformation by returning .metn form . -If that function performs a transformation, indicated by -returning a different form, then return that form, only -performing local processing when that function has declined. The function .code expand-hook-combine -is provided which encapsulates this logic. +is provided which encapsulates this logic. It allows a hook to easily +insert itself before the other hooks, as recommended above, or +after the other hooks. .TP* Example @@ -44116,8 +44117,8 @@ is provided which encapsulates this logic. ;; hooks are tried first. (defmacro pico-style (:env env . body) - (let ((*expand-hook* [expand-hook-combine *expand-hook* - pico-style-expand-hook])) + (let ((*expand-hook* [expand-hook-combine pico-style-expand-hook + *expand-hook*])) (expand ^(progn ,*body) env))) ;; Under pico-style, (1 2 3) converts to '(1 2 3) |