Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 13:49:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Simplifying or patterns into char-sets when possible.

Browse source
This commit is contained in:
Alex Shinn 2013-12-08 23:53:31 +09:00
parent 85c7fb9990
commit badc6765f0
1 changed files with 20 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
lib/chibi/regexp.scm
View file

@ -578,6 +578,20 @@
(else (else
(lp (cddr ls) (cons (cons (car ls) (cadr ls)) res)))))) (lp (cddr ls) (cons (cons (car ls) (cadr ls)) res))))))
(define (char-set-sre? sre)
(or (char? sre)
(and (string? sre) (= 1 (string-length sre)))
(lookup-char-set sre ~none)
(and (pair? sre)
(or (string? (car sre))
(memq (car sre)
'(char-set / char-range & and ~ complement - difference))
(and (memq (car sre) '(|\|| or))
(let lp ((ls (cdr sre)))
(or (null? ls)
(and (char-set-sre? (car ls))
(lp (cdr ls))))))))))
(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)))
(define (->cs sre) (sre->char-set sre flags)) (define (->cs sre) (sre->char-set sre flags))
@ -585,6 +599,10 @@
((lookup-char-set sre flags)) ((lookup-char-set sre flags))
((char-set? sre) (char-set-ci sre)) ((char-set? sre) (char-set-ci sre))
((char? sre) (char-set-ci (char-set sre))) ((char? sre) (char-set-ci (char-set sre)))
((string? sre)
(if (= 1 (string-length sre))
(string->char-set sre)
(error "only single char strings can be char-sets")))
((pair? sre) ((pair? sre)
(if (string? (car sre)) (if (string? (car sre))
(string->char-set (car sre)) (string->char-set (car sre))
@ -713,6 +731,8 @@
(cond (cond
((null? (cdr sre)) ((null? (cdr sre))
#f) #f)
((char-set-sre? sre)
(make-char-state (sre->char-set sre) flags next))
((null? (cddr sre)) ((null? (cddr sre))
(->rx (cadr sre) flags next)) (->rx (cadr sre) flags next))
(else (else