From 57cf68a1921cc18197c06ce2813eb036f4ebc120 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Sat, 6 Mar 2010 15:32:27 -0500 Subject: [PATCH] Fix (CHAR-SET->REGEXP (CHAR-SET )). Factor LET binding in RE-QUOTE-STRING's definition to the top level. Perhaps CHAR-SET:RE-SPECIAL ought to be exported. --- src/runtime/regexp.scm | 2 +- src/runtime/rgxcmp.scm | 61 +++++++++++++++++++++--------------------- 2 files changed, 32 insertions(+), 31 deletions(-) diff --git a/src/runtime/regexp.scm b/src/runtime/regexp.scm index 6e3dd4090..b0e1254a0 100644 --- a/src/runtime/regexp.scm +++ b/src/runtime/regexp.scm @@ -211,5 +211,5 @@ USA. (fix:+ i 1))))) (string-set! s i #\]))) s))) - (re-quote-string (car chars))) + (re-quote-string (string (car chars)))) ""))) \ No newline at end of file diff --git a/src/runtime/rgxcmp.scm b/src/runtime/rgxcmp.scm index a28745c54..63565d205 100644 --- a/src/runtime/rgxcmp.scm +++ b/src/runtime/rgxcmp.scm @@ -218,36 +218,37 @@ USA. (substring-move! string i j result (fix:+ p 2)) (loop (fix:- n 255) j (fix:+ p 257))))))))))))) -(define re-quote-string - (let ((special (char-set #\[ #\] #\* #\. #\\ #\? #\+ #\^ #\$))) - (lambda (string) - (let ((end (string-length string))) - (let ((n - (let loop ((start 0) (n 0)) - (let ((index - (substring-find-next-char-in-set string start end - special))) - (if index - (loop (1+ index) (1+ n)) - n))))) - (if (zero? n) - string - (let ((result (string-allocate (+ end n)))) - (let loop ((start 0) (i 0)) - (let ((index - (substring-find-next-char-in-set string start end - special))) - (if index - (begin - (substring-move! string start index result i) - (let ((i (+ i (- index start)))) - (string-set! result i #\\) - (string-set! result - (1+ i) - (string-ref string index)) - (loop (1+ index) (+ i 2)))) - (substring-move! string start end result i)))) - result))))))) +(define char-set:re-special + (char-set #\[ #\] #\* #\. #\\ #\? #\+ #\^ #\$)) + +(define (re-quote-string string) + (let ((end (string-length string))) + (let ((n + (let loop ((start 0) (n 0)) + (let ((index + (substring-find-next-char-in-set string start end + char-set:re-special))) + (if index + (loop (1+ index) (1+ n)) + n))))) + (if (zero? n) + string + (let ((result (string-allocate (+ end n)))) + (let loop ((start 0) (i 0)) + (let ((index + (substring-find-next-char-in-set string start end + char-set:re-special))) + (if index + (begin + (substring-move! string start index result i) + (let ((i (+ i (- index start)))) + (string-set! result i #\\) + (string-set! result + (1+ i) + (string-ref string index)) + (loop (1+ index) (+ i 2)))) + (substring-move! string start end result i)))) + result))))) ;;;; Char-Set Compiler -- 2.25.1