Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-11 06:57:33 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Adding w/nocapture.

Browse source
This commit is contained in:
Alex Shinn 2014-05-19 21:59:10 +09:00
parent cccd4cfbc9
commit 614efb4c8b
2 changed files with 52 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
lib/chibi/regexp.scm
View file

@ -53,6 +53,7 @@
(define ~none 0)
(define ~ci? 1)
(define ~ascii? 2)
(define ~nocapture? 4)
(define (flag-set? flags i) (= i (bitwise-and flags i)))
(define (flag-join a b) (if b (bitwise-ior a b) a))
@ -803,25 +804,41 @@
((-> => submatch-named)
;; Named submatches just record the name for the current
;; match and rewrite as a non-named submatch.
(cond
((flag-set? flags ~nocapture?)
(->rx (cons 'seq (cddr sre)) flags next))
(else
(set! match-names
(cons (cons (cadr sre) (+ 1 current-match)) match-names))
(->rx (cons 'submatch (cddr sre)) flags next))
(->rx (cons 'submatch (cddr sre)) flags next))))
((*-> *=> submatch-named-list)
(cond
((flag-set? flags ~nocapture?)
(->rx (cons 'seq (cddr sre)) flags next))
(else
(set! match-names (cons (cons (cadr sre) current-match) match-names))
(->rx (cons 'submatch-list (cddr sre)) flags next))
(->rx (cons 'submatch-list (cddr sre)) flags next))))
(($ submatch)
;; A submatch wraps next with an epsilon transition before
;; next, setting the start and end index on the result and
;; wrapped next respectively.
(cond
((flag-set? flags ~nocapture?)
(->rx (cons 'seq (cdr sre)) flags next))
(else
(let ((num current-match)
(index current-index))
(set! current-match (+ current-match 1))
(set! current-index (+ current-index 2))
(set! match-rules `((,index . ,(+ index 1)) ,@match-rules))
(make-submatch-state (cons 'seq (cdr sre)) flags next index)))
(make-submatch-state (cons 'seq (cdr sre)) flags next index)))))
((*$ submatch-list)
;; A submatch-list wraps a range of submatch results into a
;; single match value.
(cond
((flag-set? flags ~nocapture?)
(->rx (cons 'seq (cdr sre)) flags next))
(else
(let* ((num current-match)
(index current-index))
(set! current-match (+ current-match 1))
@ -831,7 +848,7 @@
(n1 (->rx (cons 'submatch (cdr sre)) flags n2)))
(state-match-set! n2 (list index num current-match))
(state-match-rule-set! n2 'list)
n1)))
n1)))))
((~ - & / complement difference and char-range char-set)
(make-char-state (sre->char-set sre flags) ~none next))
((word)
@ -852,6 +869,8 @@
(->rx `(: ,@(cdr sre)) (flag-clear flags ~ascii?) next))
((w/ascii)
(->rx `(: ,@(cdr sre)) (flag-join flags ~ascii?) next))
((w/nocapture)
(->rx `(: ,@(cdr sre)) (flag-join flags ~nocapture?) next))
(else
(if (string? (car sre))
(make-char-state (sre->char-set sre flags) ~none next)

12
tests/regexp-tests.scm
View file

@ -146,6 +146,18 @@
'(: (* digit) ($ (* (/"af"))))
"12345beef")
(let ((number '($ (+ digit))))
(test '("555" "867" "5309")
(cdr
(regexp-match->list
(regexp-search `(: ,number "-" ,number "-" ,number)
"555-867-5309"))))
(test '("555" "5309")
(cdr
(regexp-match->list
(regexp-search `(: ,number "-" (w/nocapture ,number) "-" ,number)
"555-867-5309")))))
(test-re '("12345BeeF" "BeeF")
'(: (* digit) (w/nocase ($ (* (/"af")))))
"12345BeeF")