Fix swapped conditional arms in RE-COMPILE-CHAR-SET; then split off

part of it as RE-CHAR-PATTERN->SCALAR-VALUES.

diff --git a/src/runtime/rgxcmp.scm b/src/runtime/rgxcmp.scm
index 6f4caca18eb7547be60c2aea02c81d9a0e724f1d..c85dc018dd4e6810b817dd380d902f311a8e2ffd 100644 (file)
--- a/src/runtime/rgxcmp.scm
+++ b/src/runtime/rgxcmp.scm
@@ -259,6 +259,14 @@ USA.
 ;;; #\^ must appear anywhere except as the first character in the set.
 
 (define (re-compile-char-set pattern negate?)
+  (receive (scalar-values negate?*)
+      (re-char-pattern->scalar-values pattern)
+    (let ((char-set (scalar-values->char-set scalar-values)))
+      (if (if negate? (not negate?*) negate?*)
+         (char-set-invert char-set)
+         char-set))))
+
+(define (re-char-pattern->scalar-values pattern)
   (define (loop pattern scalar-values)
     (if (pair? pattern)
        (if (and (pair? (cdr pattern))
@@ -274,15 +282,10 @@ USA.
        scalar-values))
 
   (let ((pattern (string->list pattern)))
-    (receive (pattern negate?)
-       (if (and (pair? pattern)
-                (char=? (car pattern) #\^))
-           (values (cdr pattern) (not negate?))
-           (values pattern negate?))
-      (let ((char-set (scalar-values->char-set (loop pattern '()))))
-       (if negate?
-           char-set
-           (char-set-invert char-set))))))
+    (if (and (pair? pattern)
+            (char=? (car pattern) #\^))
+       (values (loop (cdr pattern) '()) #t)
+       (values (loop pattern '()) #f))))
 \f
 ;;;; Translation Tables
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index d4d6fe6c95504752f2df876bb3b47b4087e1be0b..cea35327b83fdef7e0fba2c318f4923c69a7e570 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -5083,6 +5083,7 @@ USA.
          compiled-regexp/byte-stream
          compiled-regexp/translation-table
          condition-type:re-compile-pattern
+         re-char-pattern->scalar-values
          re-compile-char
          re-compile-char-set
          re-compile-pattern