Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 22:29:16 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Returning the first defined submatch with a given name when

Browse source 
there are multiple instances of the name.
This commit is contained in:
Alex Shinn 2014-05-08 15:39:24 -04:00
parent 89edcc85ae
commit 056eb0c6ce
2 changed files with 18 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
lib/chibi/regexp.scm
View file

@ -102,8 +102,14 @@
(vector-length (regexp-match-matches md))) (vector-length (regexp-match-matches md)))
(define (regexp-match-name-offset md name) (define (regexp-match-name-offset md name)
(cond ((assq name (regexp-match-names md)) => cdr) (let lp ((ls (regexp-match-names md)) (first #f))
(else (error "unknown match name" md name)))) (cond
((null? ls) (or first (error "unknown match name" md name)))
((eq? name (caar ls))
(if (regexp-match-submatch-start+end md (cdar ls))
(cdar ls)
(lp (cdr ls) (or first (cdar ls)))))
(else (lp (cdr ls) first)))))
(define (regexp-match-ref md n) (define (regexp-match-ref md n)
(vector-ref (regexp-match-matches md) (vector-ref (regexp-match-matches md)

10
tests/regexp-tests.scm
View file

@ -62,6 +62,16 @@
'(: (* (*$ (or "ab" "cd"))) "c") '(: (* (*$ (or "ab" "cd"))) "c")
"abcdc") "abcdc")
(test "ab"
(regexp-match-submatch
(regexp-matches '(or (-> foo "ab") (-> foo "cd")) "ab")
'foo))
(test "cd"
(regexp-match-submatch
(regexp-matches '(or (-> foo "ab") (-> foo "cd")) "cd")
'foo))
(test-re '("ababc" "abab") (test-re '("ababc" "abab")
'(: bos ($ (* "ab")) "c") '(: bos ($ (* "ab")) "c")
"ababc") "ababc")