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
;;; functions.
(define *control-charset* (char-set-delete char-set:iso-control
(ascii->char 0)))
(define (parse-sre/context sre case-sensitive? cset? r c)
(let ((%bos (r 'bos)) (%eos (r 'eos))
(%bol (r 'bol)) (%eol (r 'eol))
@ -291,7 +288,7 @@
((hygn-memq? '(blank)) char-set:blank)
((hygn-memq? '(whitespace space white)) char-set:whitespace)
((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? '(ascii)) char-set:ascii)
(else (error "Illegal regular expression" sre)))))
@ -468,7 +465,6 @@
(switch char-set= cs
((char-set:punctuation) punct)
((char-set:iso-control) ctl)
((*control-charset*) ctl)
(else #f))))))))

View File

@ -361,22 +361,27 @@
;;; quadruple.
;;;
(define (translate-char-set cset)
(if (char-set-full? cset) (values "." 1 0 '#()) ; Full set
(define *nul* (ascii->char 0))
(let ((nchars (char-set-size cset))
(->bracket-string (lambda (cset in?)
(receive (loose ranges) (char-set->in-pair cset)
(hack-bracket-spec loose ranges in?)))))
(define (translate-char-set cset)
(if (char-set-full? cset)
(values "." 1 0 '#()) ; Full set
(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)))))
;; General case. Try both [...] and [^...].
(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+))
s- s+)
1 0 '#())))))))