diff options
| -rw-r--r-- | autoload.c | 4 | ||||
| -rw-r--r-- | stdlib/match.tl | 24 | ||||
| -rw-r--r-- | tests/011/patmatch.tl | 34 | ||||
| -rw-r--r-- | txr.1 | 189 |
4 files changed, 250 insertions, 1 deletions
@@ -853,6 +853,10 @@ static val match_set_entries(val fun) lit("each-match"), lit("append-matches"), lit("keep-matches"), lit("each-match-product"), lit("append-match-products"), lit("keep-match-products"), + lit("each-match-case"), lit("collect-match-cases"), + lit("append-match-cases"), lit("keep-match-cases"), + lit("each-match-case-product"), lit("collect-match-case-products"), + lit("append-match-case-products"), lit("keep-match-case-products"), lit("match-error"), nil }; diff --git a/stdlib/match.tl b/stdlib/match.tl index 97fe8828..f389d81b 100644 --- a/stdlib/match.tl +++ b/stdlib/match.tl @@ -1188,3 +1188,27 @@ (defmacro keep-match-products (:form f pat-seq-pairs . body) (each-match-expander f pat-seq-pairs ^((list (progn ,*body))) 'maprend)) + +(defmacro each-match-case (exprs . tuple-matches) + ^(mapdo (lambda-match ,*tuple-matches) ,*exprs)) + +(defmacro collect-match-cases (exprs . tuple-matches) + ^(map (lambda-match ,*tuple-matches) ,*exprs)) + +(defmacro append-match-cases (exprs . tuple-matches) + ^(mappend (lambda-match ,*tuple-matches) ,*exprs)) + +(defmacro keep-match-cases (exprs . tuple-matches) + ^(mappend [chand (lambda-match ,*tuple-matches) list] ,*exprs)) + +(defmacro each-match-case-product (exprs . tuple-matches) + ^(maprodo (lambda-match ,*tuple-matches) ,*exprs)) + +(defmacro collect-match-case-products (exprs . tuple-matches) + ^(maprod (lambda-match ,*tuple-matches) ,*exprs)) + +(defmacro append-match-case-products (exprs . tuple-matches) + ^(maprend (lambda-match ,*tuple-matches) ,*exprs)) + +(defmacro keep-match-case-products (exprs . tuple-matches) + ^(maprend [chand (lambda-match ,*tuple-matches) list] ,*exprs)) diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl index 6995ac5f..f8c951e9 100644 --- a/tests/011/patmatch.tl +++ b/tests/011/patmatch.tl @@ -526,6 +526,40 @@ datum) (42)) (mtest + (build + (each-match-case ((list 1 2 3) (list 'a 'b 'c)) + ((1 @b) (add b)))) + (a) + (build + (each-match-case-product ((list 1 2 3) (list 'a 'b 'c)) + ((1 @b) (add b)))) + (a b c)) + +(mtest + (collect-match-cases ((list 1 2 3) (list 1 2 3)) + ((@a @b) (if (= 4 (+ a b)) (list a b)))) + (nil (2 2) nil) + (collect-match-case-products ((list 1 2 3) (list 1 2 3)) + ((@a @b) (if (= 4 (+ a b)) (list a b)))) + (nil nil (1 3) nil (2 2) nil (3 1) nil nil)) + +(mtest + (append-match-cases ((list 1 2 3) (list 1 2 3)) + ((@a @b) (if (= 4 (+ a b)) (list a b)))) + (2 2) + (append-match-case-products ((list 1 2 3) (list 1 2 3)) + ((@a @b) (if (= 4 (+ a b)) (list a b)))) + (1 3 2 2 3 1)) + +(mtest + (keep-match-cases ((list 1 2 3) (list 1 2 3)) + ((@a @b) (if (= 4 (+ a b)) (list a b)))) + ((2 2)) + (keep-match-case-products ((list 1 2 3) (list 1 2 3)) + ((@a @b) (if (= 4 (+ a b)) (list a b)))) + ((1 3) (2 2) (3 1))) + +(mtest (when-match ^#J~a 42.0 a) 42.0 (when-match ^#J[~a, ~b] #J[true, false] (list a b)) (t nil) (when-match ^#J{"x" : ~y, ~(symbolp @y) : ~datum} @@ -47939,7 +47939,8 @@ and provides a way to define a top-level function using the same concept. Additionally, there exist -.code each-match +.codn each-match , +.code each-match-case and .code while-match macro families. @@ -51008,6 +51009,192 @@ and --> ((1 2) (1 4) (3 2) (3 4) (5 2) (5 4)) .brev +.coNP Macros @ each-match-case and @ each-match-case-product +.synb +.mets (each-match-case <> ({ sequence }*) << clause *) +.mets (each-match-case-product <> ({ sequence }*) << clause *) +.syne +.desc +The +.code each-match-case +macro arranges for the iteration over tuples of elements +selected from multiple sequences. These tuples are matched +against clauses in the same manner as the +.code match-tuple-case +macro. + +The +.code each-match-case-product +iterates over product tuples instead of parallel tuples. + +Each +.meta sequence +is expected to evaluate to a sequence. + +Each +.meta clause +should express a tuple match, in the style of +.code lambda-match +or +.codn match-tuple-case . + +The macros can be understood in terms of the following transformations: + +.verb + (each-match-case (expr ...) + clause ...) + + <--> + + (mapdo (lambda-match clause ...) expr ...) + +.brev + +and: + +.verb + (each-match-case-product (expr ...) + clause ...) + + <--> + + (maprodo (lambda-match clause ...) expr ...) +.brev + +Like the +.code each +and +.code each-match +macros, these return +.codn nil . + +.TP* Examples: + +.verb + (each-match-case ('(1 1 2 3 1 4) '(a b c c d e)) + ((1 @x) (put-line `1 paired with @x`)) + ((@x c) (put-line `@x listed with c`)) + (@else (put-line `other case @else`))) + 1 paired with a + 1 paired with b + 2 listed with c + 3 listed with c + 1 paired with d + other case 4 e + + (each-match-case-product (0..25 0..25) + ((1 24) (put-line `of course 1 times 24 is 24`)) + ((24 1) (put-line `unsurprisingly, 24 times 1 is 24`)) + ((@a @b) (if (= 24 (* a b)) (put-line `@a times @b makes 24`)))) + of course 1 times 24 is 24 + 2 times 12 makes 24 + 3 times 8 makes 24 + 4 times 6 makes 24 + 6 times 4 makes 24 + 8 times 3 makes 24 + 12 times 2 makes 24 + unsurprisingly, 24 times 1 is 24 +.brev + +.coNP Macros @ collect-match-cases and @ collect-match-case-products +.synb +.mets (collect-match-cases <> ({ sequence }*) << clause *) +.mets (collect-match-case-products <> ({ sequence }*) << clause *) +.syne +.desc +The +.code collect-match-cases +and +.code collect-match-case-products +macros are similar to +.code each-match-case +and +.codn each-match-case-product , +respectively, with identical argument syntax. + +Rather than returning +.codn nil , +these macros returns a list of the values produced by the +.meta clause +sequence. + +For each iteration in which no matching +.meta clause +is found, the value collected is +.codn nil . + +.TP* Examples: + +.verb + (collect-match-cases ('(1 1 2 3 1 4) '(a b c c d e)) + ((1 @x) `1 paired with @x`) + ((@x c) `@x listed with c`)) + -> ("1 paired with a" "1 paired with b" + "2 listed with c" "3 listed with c" + nil) +.brev + +Here, the returned list includes +.code nil +because the elements +.code 4 +and +.code e +did not match any clause. + +Note: the macros +.code keep-match-cases +and +.code keep-match-case-products +can be used to collect elements such that +.code nil +values are excluded. + +.coNP Macros @ append-match-cases and @ append-match-case-products +.synb +.mets (append-match-cases <> ({ sequence }*) << clause *) +.mets (append-match-case-products <> ({ sequence }*) << clause *) +.syne +.desc +The +.code append-match-cases +and +.code append-match-case-products +macros are similar to +.code collect-match-cases +and +.codn collect-match-case-products , +respectively, with identical argument syntax. + +Rather than returning a list of the values produced by the +.meta clause +sequence in each iteration, these macros returns a list produced by appending +those values sequence, as if by the +.code append +function. + +.coNP Macros @ keep-match-cases and @ keep-match-case-products +.synb +.mets (keep-match-cases <> ({ sequence }*) << clause *) +.mets (keep-match-case-products <> ({ sequence }*) << clause *) +.syne +.desc +The +.code keep-match-cases +and +.code keep-match-case-products +macros are similar to +.code collect-match-cases +and +.codn collect-match-case-products , +respectively, with identical argument syntax. + +Rather than returning a list of all the values produced by the +.meta clause +sequence in each iteration, these macros return a list which excludes any +.meta nil +values. + .coNP Macro @ while-match .synb .mets (while-match < pattern < expr << form *) |