Change string regexp search procedures to make their returned indexes
authorChris Hanson <org/chris-hanson/cph>
Mon, 21 Jun 1999 20:58:56 +0000 (20:58 +0000)
committerChris Hanson <org/chris-hanson/cph>
Mon, 21 Jun 1999 20:58:56 +0000 (20:58 +0000)
consistent with the string search procedures.

v7/src/runtime/regexp.scm

index 73adb6cab3ed72e19898a78e0e7d85a350a463f2..35df4d185056a079651089c83915d41ec583637f 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: regexp.scm,v 1.1 1999/05/13 03:04:46 cph Exp $
+;;; $Id: regexp.scm,v 1.2 1999/06/21 20:58:56 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
 ;;;
@@ -83,7 +83,7 @@
                                 (list "\\)")
                                 (cons "\\|" (loop (cdr alternatives)))))))))))
 \f
-(define (make-substring-operation primitive)
+(define (make-substring-operation return-end? primitive)
   (lambda (regexp string start end #!optional case-fold? syntax-table)
     (let ((regexp
           (if (compiled-regexp? regexp)
                                   (if (default-object? case-fold?)
                                       #f
                                       case-fold?)))))
-      (primitive (compiled-regexp/byte-stream regexp)
-                (compiled-regexp/translation-table regexp)
-                (char-syntax-table/entries
-                 (if (or (default-object? syntax-table) (not syntax-table))
-                     standard-char-syntax-table
-                     syntax-table))
-                registers string start end))))
+      (and (primitive (compiled-regexp/byte-stream regexp)
+                     (compiled-regexp/translation-table regexp)
+                     (char-syntax-table/entries
+                      (if (or (default-object? syntax-table)
+                              (not syntax-table))
+                          standard-char-syntax-table
+                          syntax-table))
+                     registers string start end)
+          (vector-ref registers (if return-end? 10 0))))))
 
 (define re-substring-match
-  (make-substring-operation (ucode-primitive re-match-substring)))
+  (make-substring-operation #t (ucode-primitive re-match-substring)))
 
 (define re-substring-search-forward
-  (make-substring-operation (ucode-primitive re-search-substring-forward)))
+  (make-substring-operation #f (ucode-primitive re-search-substring-forward)))
 
 (define re-substring-search-backward
-  (make-substring-operation (ucode-primitive re-search-substring-backward)))
+  (make-substring-operation #t (ucode-primitive re-search-substring-backward)))
 
 (define (make-string-operation substring-operation)
   (lambda (regexp string #!optional case-fold? syntax-table)