Adding valid-sre?.

This commit is contained in:
Alex Shinn 2013-12-17 16:00:09 +09:00
parent 5ac68d65eb
commit db79366b7e
2 changed files with 30 additions and 5 deletions

View file

@ -578,6 +578,9 @@
(else (else
(lp (cddr ls) (cons (cons (car ls) (cadr ls)) res)))))) (lp (cddr ls) (cons (cons (car ls) (cadr ls)) res))))))
(define (every pred ls)
(or (null? ls) (and (pred (car ls)) (every pred (cdr ls)))))
(define (char-set-sre? sre) (define (char-set-sre? sre)
(or (char? sre) (or (char? sre)
(and (string? sre) (= 1 (string-length sre))) (and (string? sre) (= 1 (string-length sre)))
@ -587,10 +590,32 @@
(memq (car sre) (memq (car sre)
'(char-set / char-range & and ~ complement - difference)) '(char-set / char-range & and ~ complement - difference))
(and (memq (car sre) '(|\|| or)) (and (memq (car sre) '(|\|| or))
(let lp ((ls (cdr sre))) (every char-set-sre? (cdr sre)))))))
(or (null? ls)
(and (char-set-sre? (car ls)) (define (valid-sre? x)
(lp (cdr ls)))))))))) (or (regexp? x)
(string? x)
(char-set-sre? x)
(and (pair? x)
(memq (car x)
'(|\|| or : seq $ submatch *$ submatch-list ? optional
* zero-or-more + one-or-more ?? non-greedy-optional
*? non-greedy-zero-or-more +? non-greedy-one-or-more
look-ahead neg-look-ahead look-behind neg-look-behind
w/case w/nocase w/unicode w/ascii word word+))
(every valid-sre? (cdr x)))
(and (pair? x)
(memq (car x)
'(>= -> => submatch-named *-> *=> submatch-named-list))
(pair? (cdr x))
(every valid-sre? (cddr x)))
(and (pair? x)
(memq (car x) '(** repeated **? non-greedy-repeated))
(pair? (cdr x))
(pair? (cddr x))
(or (not (cadr x)) (integer? (cadr x)))
(or (not (car (cddr x))) (integer? (car (cddr x))))
(every valid-sre? (cdr (cddr x))))))
(define (sre->char-set sre . o) (define (sre->char-set sre . o)
(let ((flags (if (pair? o) (car o) ~none))) (let ((flags (if (pair? o) (car o) ~none)))

View file

@ -1,6 +1,6 @@
(define-library (chibi regexp) (define-library (chibi regexp)
(export regexp regexp? rx regexp->sre char-set->sre (export regexp regexp? valid-sre? rx regexp->sre char-set->sre
regexp-matches regexp-matches? regexp-search regexp-matches regexp-matches? regexp-search
regexp-replace regexp-replace-all regexp-replace regexp-replace-all
regexp-fold regexp-extract regexp-split regexp-fold regexp-extract regexp-split