Add operations to do regular-expression search and match on strings.
authorChris Hanson <org/chris-hanson/cph>
Fri, 15 Mar 1991 23:27:48 +0000 (23:27 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 15 Mar 1991 23:27:48 +0000 (23:27 +0000)
v7/src/edwin/regexp.scm

index 1ee1b274dfb21a59cb2f6e09cd6a430b2a86c4fb..73a013e56cb5b0e5ebe870f4696ef7fcd7455685 100644 (file)
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/regexp.scm,v 1.48 1989/04/28 22:52:26 cph Rel $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/regexp.scm,v 1.49 1991/03/15 23:27:48 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
 (define registers (make-vector 20))
 
 (define (re-match-start i)
+  (let ((group (unhash match-group)))
+    (if (not group)
+       (error "No match registers" i))
+    (make-mark group (re-match-start-index i))))
+
+(define (re-match-start-index i)
   (if (or (negative? i) (> i 9))
-      (error "RE-MATCH-START: No such register" i)
-      (let ((group (unhash match-group)))
-       (if (not group)
-           (error "RE-MATCH-START: No match registers" i)
-           (make-mark group (vector-ref registers i))))))
+      (error "No such register" i))
+  (vector-ref registers i))
 
 (define (re-match-end i)
+  (let ((group (unhash match-group)))
+    (if (not group)
+       (error "No match registers" i))
+    (make-mark group (re-match-end-index i))))
+
+(define (re-match-end-index i)
   (if (or (negative? i) (> i 9))
-      (error "RE-MATCH-END: No such register" i)
-      (let ((group (unhash match-group)))
-       (if (not group)
-           (error "RE-MATCH-END: No match registers" i)
-           (make-mark group (vector-ref registers (+ i 10)))))))
+      (error "No such register" i))
+  (vector-ref registers (+ i 10)))
 
 (define (%re-finish group index)
   (if index
                                                                true))))
          (if index
              (make-mark (mark-group start) index)
-             (limit-mark-motion limit? end)))))))
\ No newline at end of file
+             (limit-mark-motion limit? end)))))))
+\f
+;;;; String Operations
+
+(define (re-match-string-forward pattern string)
+  (re-match-substring-forward pattern string 0 (string-length string)))
+
+(define (re-match-substring-forward pattern string start end)
+  ((ucode-primitive re-match-substring)
+   (re-compile-pattern pattern false)
+   (re-translation-table false)
+   (syntax-table/entries (ref-variable syntax-table))
+   registers
+   string start end))
+
+(define (re-match-string-forward-ci pattern string)
+  (re-match-substring-forward-ci pattern string 0 (string-length string)))
+
+(define (re-match-substring-forward-ci pattern string start end)
+  ((ucode-primitive re-match-substring)
+   (re-compile-pattern pattern true)
+   (re-translation-table false)
+   (syntax-table/entries (ref-variable syntax-table))
+   registers
+   string start end))
+
+(define (re-search-string-forward pattern string)
+  (re-search-substring-forward pattern string 0 (string-length string)))
+
+(define (re-search-substring-forward pattern string start end)
+  ((ucode-primitive re-search-substring-forward)
+   (re-compile-pattern pattern false)
+   (re-translation-table false)
+   (syntax-table/entries (ref-variable syntax-table))
+   registers
+   string start end))
+
+(define (re-search-string-forward-ci pattern string)
+  (re-search-substring-forward-ci pattern string 0 (string-length string)))
+
+(define (re-search-substring-forward-ci pattern string start end)
+  ((ucode-primitive re-search-substring-forward)
+   (re-compile-pattern pattern true)
+   (re-translation-table false)
+   (syntax-table/entries (ref-variable syntax-table))
+   registers
+   string start end))
\ No newline at end of file