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?)
(let lp ((loose0 loose) (ranges0 ranges) (end-hyphen? #f))
;; 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<)))
;; If ] opens or closes a range, shrink it out.
;; If - opens a range, shrink it out.
(receive (loose ranges)
(let recur ((ranges ranges))
(if (pair? ranges)
(let* ((range (car ranges))
(start (car range))
(end (cdr range))
(ranges (cdr ranges)))
(receive (new-loose new-ranges) (recur ranges)
(receive (new-loose0 new-ranges0)
(? ((char=? #\] start)
(shrink-range-start range))
(let recur ((ranges ranges))
(if (pair? ranges)
(let* ((range (car ranges))
(start (car range))
(end (cdr range))
(ranges (cdr ranges)))
(receive (new-loose new-ranges) (recur ranges)
(receive (new-loose0 new-ranges0)
(? ((char=? #\] start)
(shrink-range-start range))
((char=? #\] end)
(shrink-range-end range))
((char=? #\] end)
(shrink-range-end range))
((char=? #\- start)
(shrink-range-start range))
((char=? #\- start)
(shrink-range-start range))
(else (values '() (list range))))
(values (append new-loose0 new-loose)
(append new-ranges0 new-ranges)))))
(values loose '())))
(else (values '() (list range))))
(values (append new-loose0 new-loose)
(append new-ranges0 new-ranges)))))
(values loose '())))
(? ((or (not (equal? loose0 loose)) ; Loop if anything changed.
(not (equal? ranges0 ranges)))
(lp loose ranges end-hyphen?))
(let ((loose (sort-list loose loose<=)) ; Sort loose chars and ranges.
(ranges (sort-list ranges range<)))
;; If the first range opens with .=:, and the last loose char is [,
;; shrink it out & loop.
((and (pair? ranges)
(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?)))
(? ((or (not (equal? loose0 loose)) ; Loop if anything changed.
(not (equal? ranges0 ranges)))
(lp loose ranges end-hyphen?))
;; If there are no loose chars, the first range begins with ^, and
;; we're doing an IN range, shrink out the ^.
((and in? (null? loose) (pair? ranges) (char=? #\^ (caar ranges)))
(receive (new-loose new-ranges) (shrink-range-start (car ranges))
(lp (append new-loose loose) (append new-ranges ranges) end-hyphen?)))
;; If the first range opens with .=:, and the last loose char is [,
;; shrink it out & loop.
((and (pair? ranges)
(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 both [ and - are in the loose char set,
;; pull - out as special end-hypen.
((and (pair? loose)
(pair? (cdr loose))
(char=? (car loose) #\[)
(char=? (car loose) #\-))
(lp (cons (car loose) (cddr loose)) ranges #t))
;; If there are no loose chars, the first range begins with ^, and
;; we're doing an IN range, shrink out the ^.
((and in? (null? loose) (pair? ranges) (char=? #\^ (caar ranges)))
(receive (new-loose new-ranges) (shrink-range-start (car ranges))
(lp (append new-loose loose) (append new-ranges ranges) end-hyphen?)))
;; 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))
"]")))))))
;; If both [ and - are in the loose char set,
;; pull - out as special end-hypen.
((and (pair? loose)
(pair? (cdr loose))
(char=? (car loose) #\[)
(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))
"]"))))))))