diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-04-25 02:33:30 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-04-25 02:33:30 -0700 |
| commit | 2a0ec7b4e5cc388ab8963d961db9311331e8a5a5 (patch) | |
| tree | d1e1ce49fc571a817a70925fd81c9a18eb0b7850 | |
| parent | b8237da593d63f83dcf642322b3b2e2f4d72ae8b (diff) | |
| download | txr-2a0ec7b4e5cc388ab8963d961db9311331e8a5a5.tar.gz txr-2a0ec7b4e5cc388ab8963d961db9311331e8a5a5.tar.bz2 txr-2a0ec7b4e5cc388ab8963d961db9311331e8a5a5.zip | |
matcher: second round of quasi tests and fixes.
* share/txr/stdlib/match.tl (expan-quasi-match): Use rest
variable consistently instead of (cdr args). Two instances of
(cdr rest) should just be rest. New case added for variable
with no modifiers followed by text being the last item.
| -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 |