diff options
| -rw-r--r-- | share/txr/stdlib/match.tl | 14 | ||||
| -rw-r--r-- | tests/011/patmatch.tl | 6 |
2 files changed, 15 insertions, 5 deletions
diff --git a/share/txr/stdlib/match.tl b/share/txr/stdlib/match.tl index 0c10dfb1..80750e6c 100644 --- a/share/txr/stdlib/match.tl +++ b/share/txr/stdlib/match.tl @@ -867,7 +867,7 @@ ^@(with ,npos (+ ,pos ,len)) ^@(require @nil (str= ,txt (sub-str ,str ,pos ,npos))) - (quasi-match vlist (cdr args) vars str npos)))) + (quasi-match vlist rest vars str npos)))) ;; `@var` (new binding) (((@(eq 'sys:var) @sym)) (list ^@(with ,sym (sub-str ,str ,pos t)))) @@ -905,14 +905,19 @@ ^@(with ,sym (sub-str ,str ,pos ,npos)) (quasi-match vlist rest (cons sym vars) str npos)))) ;; `@{var}txt` (new binding) + (((@(eq 'sys:var) @sym) @(stringp @txt)) + (with-gensyms (len end) + (list ^@(require @(with ,end (search-str ,str ,txt ,pos)) + ,end (eql (+ ,end ,(len txt)) (len ,str))) + ^@(with ,sym (sub-str ,str ,pos ,end))))) + ;; `@{var}txt...` (new binding) (((@(eq 'sys:var) @sym) @(stringp @txt) . @rest) (with-gensyms (len end npos) (list* ^@(require @(with ,end (search-str ,str ,txt ,pos)) ,end) ^@(with ,npos (+ ,end ,(len txt))) ^@(with ,sym (sub-str ,str ,pos ,end)) - (quasi-match vlist (cdr rest) (cons sym vars) - str npos)))) + (quasi-match vlist rest (cons sym vars) str npos)))) ;; `@var0@var1` (unbound followed by bound) (((@(eq 'sys:var) @sym) (@(eq 'sys:var) @(bound-p vlist vars @bsym) . @mods) @@ -923,8 +928,7 @@ ,end) ^@(with ,npos (+ ,end (len ,txt))) ^@(with ,sym (sub-str ,str ,pos ,end)) - (quasi-match vlist (cdr rest) (cons sym vars) - str npos)))) + (quasi-match vlist rest (cons sym vars) str npos)))) ;; `@{var whatever}@...`(new binding, unsupported modifiers) (((@(eq 'sys:var) @sym @mods . @nil) . @rest) (compile-error *match-form* diff --git a/tests/011/patmatch.tl b/tests/011/patmatch.tl index ad9015db..c40d5ea5 100644 --- a/tests/011/patmatch.tl +++ b/tests/011/patmatch.tl @@ -348,6 +348,12 @@ (test (when-match `@a-$` "a-$" a) "a") (test (when-match `#@a-$` "#a-$" a) "a") +(test (when-match `#@a-$` "#a-$$" a) nil) +(test (when-match `#@a-$` "#a-" a) nil) +(test (when-match `#@{a #/ab*c/}` "#abbbc" a) "abbbc") +(test (when-match `#@{a #/ab*c/}d` "#abbbcd" a) "abbbc") +(test (when-match `#@{a 3}@b` "#abb" a) "abb") +(test (when-match `#@{a 3}@b` "#abbbc" (list a b)) ("abb" "bc")) (compile-only (eval-only |