From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 30 Apr 2017 06:44:01 +0000 (-0700)
Subject: Fix bugs in char-set->regexp rewrite.
X-Git-Tag: mit-scheme-pucked-9.2.12~14^2~106
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=932af14b98cde4e20fd9e887f4a61d35a03c886c;p=mit-scheme.git

Fix bugs in char-set->regexp rewrite.
---

diff --git a/src/runtime/regexp.scm b/src/runtime/regexp.scm
index 3f3cb6d1e..cd1b4d498 100644
--- a/src/runtime/regexp.scm
+++ b/src/runtime/regexp.scm
@@ -187,27 +187,22 @@ USA.
   (let ((chars (char-set-members char-set)))
     (if (pair? chars)
 	(if (pair? (cdr chars))
-	    (let ((ranges
-		   (push #\^ (pull #\- (pull #\] (compute-ranges chars))))))
-	      (let ((n
-		     (let loop ((ranges ranges) (n 2))
-		       (if (pair? ranges)
-			   (loop (cdr ranges)
-				 (fix:+ n (if (pair? (car ranges)) 3 1)))
-			   n))))
-		(let ((builder (string-builder)))
-		  (builder #\[)
-		  (let loop ((ranges ranges))
-		    (if (pair? ranges)
-			(let ((range (car ranges)))
-			  (if (pair? range)
-			      (begin
-				(builder (car range))
-				(builder #\-)
-				(builder (cdr range)))
-			      (builder range)))
-			(loop (cdr ranges))))
-		  (builder #\])
-		  (builder))))
+	    (let ((builder (string-builder)))
+	      (builder #\[)
+	      (let loop
+		  ((ranges
+		    (push #\^ (pull #\- (pull #\] (compute-ranges chars))))))
+		(if (pair? ranges)
+		    (begin
+		      (let ((range (car ranges)))
+			(if (pair? range)
+			    (begin
+			      (builder (car range))
+			      (builder #\-)
+			      (builder (cdr range)))
+			    (builder range)))
+		      (loop (cdr ranges)))))
+	      (builder #\])
+	      (builder))
 	    (re-quote-string (string (car chars))))
 	"")))
\ No newline at end of file