summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2025-04-01 18:26:48 -0700
committerKaz Kylheku <kaz@kylheku.com>2025-04-01 18:26:48 -0700
commit00a1bcc7720c99c2e540af45af0a2d5238fae381 (patch)
treed330378434efc4325c7d918768930da76464d3f8
parent70dbd3666379cf35167785751e86c6780e400396 (diff)
downloadtxr-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.c4
-rw-r--r--tests/011/exphook.tl39
-rw-r--r--txr.117
3 files changed, 45 insertions, 15 deletions
diff --git a/eval.c b/eval.c
index 63026443..9cb982b3 100644
--- a/eval.c
+++ b/eval.c
@@ -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)))
diff --git a/txr.1 b/txr.1
index daace25b..b9a68529 100644
--- a/txr.1
+++ b/txr.1
@@ -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)