Make dynamic sub-regexps of regexps involving repetition work.

This commit is contained in:
sperber 2002-10-30 12:13:20 +00:00
parent c7e49f9274
commit 20b65e6bfa
1 changed files with 26 additions and 8 deletions

View File

@ -143,6 +143,12 @@
(define (non-cset) ; Blow up if cset? is true.
(if cset? (error "Illegal SRE in char-class context." sre)))
(define (build-re-repeat from to stuff)
(let ((seq (parse-seq stuff)))
(if (static-regexp? seq)
(re-repeat from to seq)
`(,(r 're-repeat) ',from ',to ,(regexp->scheme seq r)))))
(? ((char? sre) (parse-char-re sre case-sensitive? cset?))
((string? sre) (parse-string-re sre case-sensitive? cset?))
@ -156,14 +162,26 @@
(let ((hygn-eq? (lambda (the-sym) (or (c (car sre) (r the-sym))
(c (car sre) the-sym)))))
(cond
((hygn-eq? '*) (non-cset) (re-repeat 0 #f (parse-seq (cdr sre))))
((hygn-eq? '+) (non-cset) (re-repeat 1 #f (parse-seq (cdr sre))))
((hygn-eq? '?) (non-cset) (re-repeat 0 1 (parse-seq (cdr sre))))
((hygn-eq? '=) (non-cset) (let ((n (cadr sre)))
(re-repeat n n (parse-seq (cddr sre)))))
((hygn-eq? '>=) (non-cset) (re-repeat (cadr sre) #f (parse-seq (cddr sre))))
((hygn-eq? '**) (non-cset) (re-repeat (cadr sre) (caddr sre)
(parse-seq (cdddr sre))))
((hygn-eq? '*)
(non-cset)
(build-re-repeat 0 #f (cdr sre)))
((hygn-eq? '+)
(non-cset)
(build-re-repeat 1 #f (cdr sre)))
((hygn-eq? '?)
(non-cset)
(build-re-repeat 0 1 (cdr sre)))
((hygn-eq? '=) ; ####
(non-cset)
(let ((n (cadr sre)))
(build-re-repeat n n (cddr sre))))
((hygn-eq? '>=)
(non-cset)
(build-re-repeat (cadr sre) #f (cddr sre)))
((hygn-eq? '**)
(non-cset)
(build-re-repeat (cadr sre) (caddr sre)
(cdddr sre)))
;; Choice is special wrt cset? because it's "polymorphic".
;; Note that RE-CHOICE guarantees to construct a char-set