Minor cleanups to regexp code.

diff --git a/src/runtime/optiondb.scm b/src/runtime/optiondb.scm
index 84b93321b4e2e2ffca069e3dac3b7462d07e91ee..963e5b399e572feb28eb047c75457081a7654f6d 100644 (file)
--- a/src/runtime/optiondb.scm
+++ b/src/runtime/optiondb.scm
@@ -78,17 +78,17 @@ USA.
    ))
 
 (define-load-option 'REGULAR-EXPRESSION
-  (standard-option-loader '(RUNTIME REGULAR-EXPRESSION-COMPILER)
-                         #F
+  (standard-option-loader '(runtime regular-expression-compiler)
+                         #f
                          "rgxcmp")
-  (standard-option-loader '(RUNTIME CHAR-SYNTAX)
-                         '(INITIALIZE-PACKAGE!)
+  (standard-option-loader '(runtime char-syntax)
+                         '(initialize-package!)
                          "chrsyn")
-  (standard-option-loader '(RUNTIME REGULAR-EXPRESSION)
-                         '(INITIALIZE-PACKAGE!)
+  (standard-option-loader '(runtime regular-expression)
+                         #f
                          "regexp")
-  (standard-option-loader '(RUNTIME REXP)
-                         #F
+  (standard-option-loader '(runtime rexp)
+                         #f
                          "rexp"))
 
 ;; HASH-TABLE is now always loaded.

diff --git a/src/runtime/regexp.scm b/src/runtime/regexp.scm
index cd1b4d498feb21a3b47bd789ead5071a3afc6aa3..c589ee459bb89ff6034426a652114cc3cdba2cf4 100644 (file)
--- a/src/runtime/regexp.scm
+++ b/src/runtime/regexp.scm
@@ -29,63 +29,58 @@ USA.
 
 (declare (usual-integrations))
 \f
-(define registers)
+(define-deferred registers (make-vector 20 #f))
 
-(define (initialize-package!)
-  (set! registers (make-vector 20 #f))
-  unspecific)
+(define (re-register? object)
+  (and (index-fixnum? object)
+       (fix:< object 10)))
 
-(define-structure (re-registers (type-descriptor <re-registers>))
-  (vector #f read-only #t))
+(define (re-registers)
+  (make-re-registers (vector-copy registers)))
 
-(define (guarantee-re-registers object procedure)
-  (if (not (re-registers? object))
-      (error:wrong-type-argument object "regular-expression registers"
-                                procedure))
-  (re-registers-vector object))
+(define (set-re-registers! regs)
+  (vector-copy! registers 0 (re-registers-vector regs)))
+
+(define-record-type <re-registers>
+    (make-re-registers vector)
+    re-registers?
+  (vector re-registers-vector))
 
 (define (re-match-start-index i #!optional regs)
-  (guarantee-re-register i 'RE-MATCH-START-INDEX)
+  (guarantee re-register? i 're-match-start-index)
   (vector-ref (if (or (default-object? regs) (not regs))
                  registers
-                 (guarantee-re-registers regs 'RE-MATCH-START-INDEX))
+                 (re-registers-vector regs))
              i))
 
 (define (re-match-end-index i #!optional regs)
-  (guarantee-re-register i 'RE-MATCH-END-INDEX)
-  (vector-ref (if (or (default-object? regs) (not regs))
+  (guarantee re-register? i 're-match-end-index)
+  (vector-ref (if (default-object? regs)
                  registers
-                 (guarantee-re-registers regs 'RE-MATCH-START-INDEX))
+                 (re-registers-vector regs))
              (fix:+ i 10)))
 
-(define (guarantee-re-register i operator)
-  (if (not (and (exact-nonnegative-integer? i) (< i 10)))
-      (error:wrong-type-argument i "regular-expression register" operator)))
-
-(define (re-registers)
-  (make-re-registers (vector-copy registers)))
-
-(define (set-re-registers! regs)
-  (let ((regs (guarantee-re-registers regs 'SET-RE-REGISTERS!)))
-    (do ((i 0 (fix:+ i 1)))
-       ((fix:= 20 i))
-      (vector-set! registers i (vector-ref regs i)))))
-
-(define (preserving-re-registers thunk)
-  (let ((registers* unspecific))
-    (dynamic-wind (lambda () (set! registers* (re-registers)) unspecific)
-                 thunk
-                 (lambda () (set-re-registers! registers*)))))
-
 (define (re-match-extract string regs i)
   (let ((start (re-match-start-index i regs))
        (end (re-match-end-index i regs)))
     (if (not (and start end))
-       (error:bad-range-argument i 'RE-MATCH-EXTRACT))
+       (error:bad-range-argument i 're-match-extract))
     (substring string start end)))
+
+(define (preserving-re-registers thunk)
+  (let ((registers* unspecific))
+    (dynamic-wind (lambda ()
+                   (set! registers* (re-registers))
+                   unspecific)
+                 thunk
+                 (lambda ()
+                   (set-re-registers! registers*)
+                   (set! registers*)
+                   unspecific))))
 \f
 (define (make-substring-operation primitive)
   (lambda (regexp string start end #!optional case-fold? syntax-table)
+    (guarantee 8-bit-string? string)
     (let ((regexp
           (if (compiled-regexp? regexp)
               regexp

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index b44bb16fc3ee66bcfd45cf64b73ef107c2cfa660..d5f210559124977c0c80b211288e87c9534eea8f 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -5254,8 +5254,6 @@ USA.
   (parent (runtime))
   (export ()
          char-set->regexp
-         guarantee-re-register
-         guarantee-re-registers
          preserving-re-registers
          re-match-end-index
          re-match-extract