Eliminate guarantee-substring.

diff --git a/src/runtime/chrsyn.scm b/src/runtime/chrsyn.scm
index cda8635971baaeab98eecf46abaac906e7729d43..c27370324b8cdd93a0e2f3d7b91f0d6969f3224a 100644 (file)
--- a/src/runtime/chrsyn.scm
+++ b/src/runtime/chrsyn.scm
@@ -149,21 +149,26 @@ USA.
   '#(" " "." "w" "_" "(" ")" "'" "\"" "$" "\\" "/" "<" ">"))
 
 (define (substring-find-next-char-of-syntax string start end table code)
-  (guarantee-substring string start end 'SUBSTRING-FIND-NEXT-CHAR-OF-SYNTAX)
-  (let loop ((index start))
-    (and (fix:< index end)
-        (if (char=? code (char->syntax-code table (string-ref string index)))
-            index
-            (loop (fix:+ index 1))))))
+  (guarantee 8-bit-string? string 'substring-find-next-char-of-syntax)
+  (let ((index
+        (string-find-first-index (syntax-code-predicate code)
+                                 (string-slice string start end))))
+    (and index
+        (fix:+ start index))))
 
 (define (substring-find-next-char-not-of-syntax string start end table code)
-  (guarantee-substring string start end
-                      'SUBSTRING-FIND-NEXT-CHAR-NOT-OF-SYNTAX)
-  (let loop ((index start))
-    (and (fix:< index end)
-        (if (char=? code (char->syntax-code table (string-ref string index)))
-            (loop (fix:+ index 1))
-            index))))
+  (guarantee 8-bit-string? string 'substring-find-next-char-not-of-syntax)
+  (let ((index
+        (string-find-first-index (let ((pred (syntax-code-predicate code)))
+                                   (lambda (char)
+                                     (not (pred char))))
+                                 (string-slice string start end))))
+    (and index
+        (fix:+ start index))))
+
+(define (syntax-code-predicate code)
+  (lambda (char)
+    (char=? code (char->syntax-code char))))
 
 (define (char->syntax-code table char)
   (string-ref (vector-ref char-syntax-codes

diff --git a/src/runtime/regsexp.scm b/src/runtime/regsexp.scm
index ef40f60095801974c3da58a82938ad990d5906ae..52e95a37132cdd7895e03dbf5b13cae3790ee31f 100644 (file)
--- a/src/runtime/regsexp.scm
+++ b/src/runtime/regsexp.scm
@@ -544,7 +544,7 @@ USA.
 
 (define (regsexp-match-input-port crsexp port)
   (let ((caller 'REGSEXP-MATCH-INPUT-PORT))
-    (guarantee-compiled-regsexp crsexp caller)
+    (guarantee compiled-regsexp? crsexp caller)
     (guarantee textual-input-port? port caller)
     (%top-level-match crsexp
                      (%char-source->position
@@ -585,21 +585,10 @@ USA.
 
 (define (regsexp-match-string crsexp string #!optional start end)
   (let ((caller 'REGSEXP-MATCH-STRING))
-    (guarantee-compiled-regsexp crsexp caller)
-    (guarantee-string string caller)
-    (let* ((end
-           (let ((length (string-length string)))
-             (if (default-object? end)
-                 length
-                 (begin
-                   (guarantee-substring-end-index end length caller)
-                   end))))
-          (start
-           (if (default-object? start)
-               0
-               (begin
-                 (guarantee-substring-start-index start end caller)
-                 start))))
+    (guarantee compiled-regsexp? crsexp caller)
+    (guarantee string? string caller)
+    (let* ((end (fix:end-index end (string-length string) caller))
+          (start (fix:start-index start end caller)))
       (%top-level-match crsexp
                        (cons start (%make-substring string start end))))))
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 83cceb90a5759e84c30b19bb8f536238bab1ee75..756737b5d7376f81d57ec116ac2b18d1100c0d83 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -974,17 +974,13 @@ USA.
          vector-8b-ref
          vector-8b-set!)
   (export ()
-         guarantee-substring
-         guarantee-substring-end-index
-         guarantee-substring-start-index
          string-search-all
          string-search-backward
          string-search-forward
          substring-search-all
          substring-search-backward
          substring-search-forward
-         substring?)
-  (initialization (initialize-package!)))
+         substring?))
 
 (define-package (runtime ustring)
   (files "ustring")
@@ -1029,6 +1025,7 @@ USA.
          substring=?)
   (export ()
          (substring string-copy)
+         8-bit-string?
          grapheme-cluster-length
          grapheme-cluster-slice
          list->string

diff --git a/src/runtime/string.scm b/src/runtime/string.scm
index 3b89c7b886b0155849861fe4d70e4b8292a01998..c39010c991f95c30a28f1816d4a034bd01307412 100644 (file)
--- a/src/runtime/string.scm
+++ b/src/runtime/string.scm
@@ -329,16 +329,6 @@ USA.
 (declare (integrate-operator guarantee-string))
 (define-guarantee string "string")
 
-(define-integrable (guarantee-2-strings object1 object2 procedure)
-  (if (not (and (string? object1) (string? object2)))
-      (guarantee-2-strings/fail object1 object2 procedure)))
-
-(define (guarantee-2-strings/fail object1 object2 procedure)
-  (cond ((not (string? object1))
-        (error:wrong-type-argument object1 "string" procedure))
-       ((not (string? object2))
-        (error:wrong-type-argument object2 "string" procedure))))
-
 (define-integrable (guarantee-string-index object caller)
   (if (not (index-fixnum? object))
       (error:wrong-type-argument object "string index" caller)))

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index f066bad343f186e37263ea562df3013f67d87bca..3923307b70db606667dcb700b90126f05fb75e60 100644 (file)
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -140,6 +140,7 @@ USA.
   (register-predicate! legacy-string? 'legacy-string '<= string?)
   (register-predicate! full-string? 'full-string '<= string?)
   (register-predicate! slice? 'string-slice '<= string?)
+  (register-predicate! 8-bit-string? '8-bit-string '<= string?)
   (register-predicate! ->string-component? '->string-component))
 \f
 ;;;; Strings
@@ -1280,6 +1281,10 @@ USA.
         (list 'fill-with grapheme-cluster-string? " ")
         (list 'clip? boolean? #t))))
 \f
+(define (8-bit-string? object)
+  (and (string? object)
+       (string-8-bit? object)))
+
 (define (string-8-bit? string)
   (receive (string start end) (translate-slice string 0 (string-length string))
     (if (legacy-string? string)