diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-04-19 20:16:10 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-04-19 20:16:10 -0700 |
commit | 8994babc7c49d3a118bb8341549fef209a21dcc2 (patch) | |
tree | 3c8cb9e07708e21d25e513f3b765a4ab8b9d941d /tests | |
parent | f264a0cbbb22d8dd012b8b56d9e88147e2e23eb8 (diff) | |
download | txr-8994babc7c49d3a118bb8341549fef209a21dcc2.tar.gz txr-8994babc7c49d3a118bb8341549fef209a21dcc2.tar.bz2 txr-8994babc7c49d3a118bb8341549fef209a21dcc2.zip |
matcher: first pattern macro, sme.
* lisplib.c (match_instantiate): Intern sme symbol.
* share/txr/stdlib/doc-syms.tl: Update with sme entry.
* share/txr/stdlib/match.tl (sme): New defmatch macro.
* tests/011/patmatch.tl: New tests for sme.
* txr.1: Documented.
Diffstat (limited to 'tests')
-rw-r--r-- | tests/011/patmatch.tl | 37 |
1 files changed, 37 insertions, 0 deletions
diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl index abad6b44..4be407fa 100644 --- a/tests/011/patmatch.tl +++ b/tests/011/patmatch.tl @@ -277,3 +277,40 @@ ((@a 2 @b) ^(2 ,a)))) (local 3 2 1))) (2 3)) + +(test + (when-match @(sme (1 2) (3 4) (5 . 6) m e) + '(1 2 3 4 5 . 6) + (list m e)) + ((3 4 5 . 6) (5 . 6))) + +(test + (when-match @(sme (1 2) (3 4) (5 . 6) m d) + '(1 2 abc 3 4 def 5 . 6) + (list m d)) + ((3 4 def 5 . 6) (5 . 6))) + +(test + (when-match @(sme (1 2 @x . @y) (4 @z) 6) + '(1 2 abc 3 4 def 5 . 6) + (list x y z)) + (abc (3 4 def 5 . 6) def)) + +(test (when-match @(sme (1 2) (2 3) (4)) '(1 2 3 4) t) nil) +(test (when-match @(sme (1 2) (3 4) (4)) '(1 2 3 4) t) nil) +(test (when-match @(sme (1 2) (2 3) (3 4)) '(1 2 3 4) t) nil) +(test (when-match @(sme (1 2 . @x) (3 . @y) (4)) '(1 2 3 4) t) t) +(test (when-match @(sme (1 2 . @x) (3 . @y) ()) '(1 2 3 4) t) t) +(test (when-match @(sme (1 2 . @x) (3 . @y) ()) '(1 2 3 4 . 5) t) nil) + +(test (when-match @(sme (1 @y) (@z @x @y @z) (@x @y)) '(1 2 3 1 2 3 1 2) + (list x y z)) + (1 2 3)) + +(test (when-match @(and @(sme (1 @x) (3) (7) m n) + @(with @(coll @(oddp @y)) (ldiff m n))) + '(1 2 3 4 5 6 7) + (list x y)) + (2 (3 5))) + +(test (when-match @(sme () () 5) 5 t) t) |