From: Taylor R Campbell <campbell@mumble.net>
Date: Sat, 6 Mar 2010 20:32:27 +0000 (-0500)
Subject: Fix (CHAR-SET->REGEXP (CHAR-SET <char>)).
X-Git-Tag: 20100708-Gtk~128
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=57cf68a1921cc18197c06ce2813eb036f4ebc120;p=mit-scheme.git

Fix (CHAR-SET->REGEXP (CHAR-SET <char>)).

Factor LET binding in RE-QUOTE-STRING's definition to the top level.
Perhaps CHAR-SET:RE-SPECIAL ought to be exported.
---

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