scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix infinite recursion bug in HACK-BRACKET-SPEC: 

The LOOSE and RANGES lists weren't getting sorted in the fixpoint
comparison.
This commit is contained in:
sperber 2002-02-21 13:44:47 +00:00
parent be84d5ec47
commit 64cdef6fc7
1 changed files with 53 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

104
scsh/rx/posixstr.scm
View File

@ -560,66 +560,68 @@
(define (hack-bracket-spec loose ranges in?) (define (hack-bracket-spec loose ranges in?)
(let lp ((loose0 loose) (ranges0 ranges) (end-hyphen? #f)) (let lp ((loose0 loose) (ranges0 ranges) (end-hyphen? #f))
;; Repeat until stable: ;; Repeat until stable:
(let ((loose (sort-list loose0 loose<=)) ; Sort loose chars and ranges. (let ((loose (sort-list loose0 loose<=)) ; Sort loose chars and ranges.
(ranges (sort-list ranges0 range<))) (ranges (sort-list ranges0 range<)))
;; If ] opens or closes a range, shrink it out. ;; If ] opens or closes a range, shrink it out.
;; If - opens a range, shrink it out. ;; If - opens a range, shrink it out.
(receive (loose ranges) (receive (loose ranges)
(let recur ((ranges ranges)) (let recur ((ranges ranges))
(if (pair? ranges) (if (pair? ranges)
(let* ((range (car ranges)) (let* ((range (car ranges))
(start (car range)) (start (car range))
(end (cdr range)) (end (cdr range))
(ranges (cdr ranges))) (ranges (cdr ranges)))
(receive (new-loose new-ranges) (recur ranges) (receive (new-loose new-ranges) (recur ranges)
(receive (new-loose0 new-ranges0) (receive (new-loose0 new-ranges0)
(? ((char=? #\] start) (? ((char=? #\] start)
(shrink-range-start range)) (shrink-range-start range))
((char=? #\] end) ((char=? #\] end)
(shrink-range-end range)) (shrink-range-end range))
((char=? #\- start) ((char=? #\- start)
(shrink-range-start range)) (shrink-range-start range))
(else (values '() (list range)))) (else (values '() (list range))))
(values (append new-loose0 new-loose) (values (append new-loose0 new-loose)
(append new-ranges0 new-ranges))))) (append new-ranges0 new-ranges)))))
(values loose '()))) (values loose '())))
(? ((or (not (equal? loose0 loose)) ; Loop if anything changed. (let ((loose (sort-list loose loose<=)) ; Sort loose chars and ranges.
(not (equal? ranges0 ranges))) (ranges (sort-list ranges range<)))
(lp loose ranges end-hyphen?))
;; If the first range opens with .=:, and the last loose char is [, (? ((or (not (equal? loose0 loose)) ; Loop if anything changed.
;; shrink it out & loop. (not (equal? ranges0 ranges)))
((and (pair? ranges) (lp loose ranges end-hyphen?))
(memv (caar ranges) '(#\. #\= #\:))
(pair? loose)
(char=? #\[ (car (reverse loose))))
(receive (new-loose new-ranges)
(shrink-range-start (car ranges))
(lp (append new-loose loose) (append new-ranges (cdr ranges)) end-hyphen?)))
;; If there are no loose chars, the first range begins with ^, and ;; If the first range opens with .=:, and the last loose char is [,
;; we're doing an IN range, shrink out the ^. ;; shrink it out & loop.
((and in? (null? loose) (pair? ranges) (char=? #\^ (caar ranges))) ((and (pair? ranges)
(receive (new-loose new-ranges) (shrink-range-start (car ranges)) (memv (caar ranges) '(#\. #\= #\:))
(lp (append new-loose loose) (append new-ranges ranges) end-hyphen?))) (pair? loose)
(char=? #\[ (car (reverse loose))))
(receive (new-loose new-ranges)
(shrink-range-start (car ranges))
(lp (append new-loose loose) (append new-ranges (cdr ranges)) end-hyphen?)))
;; If both [ and - are in the loose char set, ;; If there are no loose chars, the first range begins with ^, and
;; pull - out as special end-hypen. ;; we're doing an IN range, shrink out the ^.
((and (pair? loose) ((and in? (null? loose) (pair? ranges) (char=? #\^ (caar ranges)))
(pair? (cdr loose)) (receive (new-loose new-ranges) (shrink-range-start (car ranges))
(char=? (car loose) #\[) (lp (append new-loose loose) (append new-ranges ranges) end-hyphen?)))
(char=? (car loose) #\-))
(lp (cons (car loose) (cddr loose)) ranges #t))
;; No change! Build the answer... ;; If both [ and - are in the loose char set,
(else (string-append (if in? "[" "[^") ;; pull - out as special end-hypen.
(list->string loose) ((and (pair? loose)
(apply string-append (pair? (cdr loose))
(map (lambda (r) (string (car r) #\- (cdr r))) (char=? (car loose) #\[)
ranges)) (char=? (car loose) #\-))
"]"))))))) (lp (cons (car loose) (cddr loose)) ranges #t))
;; No change! Build the answer...
(else (string-append (if in? "[" "[^")
(list->string loose)
(apply string-append
(map (lambda (r) (string (car r) #\- (cdr r)))
ranges))
"]"))))))))