More pervasive fix for ASCII NUL problem.

This commit is contained in:
sperber 2002-02-16 18:04:49 +00:00
parent ab09c6e08b
commit d77257ae6b
2 changed files with 15 additions and 14 deletions

View File

@ -114,9 +114,6 @@
;;; returns a regexp value. R and C are low-level macro rename and compare ;;; returns a regexp value. R and C are low-level macro rename and compare
;;; functions. ;;; functions.
(define *control-charset* (char-set-delete char-set:iso-control
(ascii->char 0)))
(define (parse-sre/context sre case-sensitive? cset? r c) (define (parse-sre/context sre case-sensitive? cset? r c)
(let ((%bos (r 'bos)) (%eos (r 'eos)) (let ((%bos (r 'bos)) (%eos (r 'eos))
(%bol (r 'bol)) (%eol (r 'eol)) (%bol (r 'bol)) (%eol (r 'eol))
@ -291,7 +288,7 @@
((hygn-memq? '(blank)) char-set:blank) ((hygn-memq? '(blank)) char-set:blank)
((hygn-memq? '(whitespace space white)) char-set:whitespace) ((hygn-memq? '(whitespace space white)) char-set:whitespace)
((hygn-memq? '(printing print)) char-set:printing) ((hygn-memq? '(printing print)) char-set:printing)
((hygn-memq? '(control cntrl)) *control-charset*) ((hygn-memq? '(control cntrl)) char-set:iso-control)
((hygn-memq? '(hex-digit xdigit hex)) char-set:hex-digit) ((hygn-memq? '(hex-digit xdigit hex)) char-set:hex-digit)
((hygn-memq? '(ascii)) char-set:ascii) ((hygn-memq? '(ascii)) char-set:ascii)
(else (error "Illegal regular expression" sre))))) (else (error "Illegal regular expression" sre)))))
@ -468,7 +465,6 @@
(switch char-set= cs (switch char-set= cs
((char-set:punctuation) punct) ((char-set:punctuation) punct)
((char-set:iso-control) ctl) ((char-set:iso-control) ctl)
((*control-charset*) ctl)
(else #f)))))))) (else #f))))))))

View File

@ -361,22 +361,27 @@
;;; quadruple. ;;; quadruple.
;;; ;;;
(define (translate-char-set cset) (define *nul* (ascii->char 0))
(if (char-set-full? cset) (values "." 1 0 '#()) ; Full set
(let ((nchars (char-set-size cset)) (define (translate-char-set cset)
(->bracket-string (lambda (cset in?) (if (char-set-full? cset)
(receive (loose ranges) (char-set->in-pair cset) (values "." 1 0 '#()) ; Full set
(hack-bracket-spec loose ranges in?))))) (let* ((cset (char-set-delete cset *nul*))
(nchars (char-set-size cset))
(->bracket-string (lambda (cset in?)
(receive (loose ranges) (char-set->in-pair cset)
(hack-bracket-spec loose ranges in?)))))
(? ((= 0 nchars) (values "[^\000-\177]" 1 0 '#())) ; Empty set (? ((= 0 nchars) (values "[^\000-\177]" 1 0 '#())) ; Empty set
((= 1 nchars) ; Singleton set ((= 1 nchars) ; Singleton set
(translate-string (string (car (char-set->list cset))))) (translate-string (string (car (char-set->list cset)))))
;; General case. Try both [...] and [^...]. ;; General case. Try both [...] and [^...].
(else (let ((s- (->bracket-string cset #t)) (else (let ((s- (->bracket-string cset #t))
(s+ (->bracket-string (char-set-complement cset) #f))) (s+ (->bracket-string
(char-set-delete (char-set-complement cset) *nul*)
#f)))
(values (if (< (string-length s-) (string-length s+)) (values (if (< (string-length s-) (string-length s+))
s- s+) s- s+)
1 0 '#()))))))) 1 0 '#())))))))