Implement RE-MATCH-DATA and SET-RE-MATCH-DATA! to allow more general

control over match data.

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 903877c5b9dc058abcf92ee4e64140d66ab1289b..dce420e0e514e97667e613dd715ade08baf6da70 100644 (file)
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.138 1993/10/06 02:40:26 cph Exp $
+$Id: edwin.pkg,v 1.139 1993/10/11 11:39:37 cph Exp $
 
 Copyright (c) 1989-1993 Massachusetts Institute of Technology
 
@@ -540,6 +540,7 @@ MIT in each case. |#
          delete-match
          preserving-match-data
          re-match-buffer-forward
+         re-match-data
          re-match-end
          re-match-end-index
          re-match-forward
@@ -558,7 +559,8 @@ MIT in each case. |#
          re-substitute-registers
          replace-match
          search-backward
-         search-forward))
+         search-forward
+         set-re-match-data!))
 
 (define-package (edwin regular-expression-compiler)
   (files "rgxcmp")

diff --git a/v7/src/edwin/regexp.scm b/v7/src/edwin/regexp.scm
index 1356325d47602a6376b33b872c5661dfa681d179..ec8406d82df2ee71f7c41e936039613c51061736 100644 (file)
--- a/v7/src/edwin/regexp.scm
+++ b/v7/src/edwin/regexp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: regexp.scm,v 1.64 1993/08/13 23:40:21 cph Exp $
+;;;    $Id: regexp.scm,v 1.65 1993/10/11 11:39:30 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
 ;;;
@@ -78,40 +78,43 @@
        (error "No match group"))
     group))
 
+(define (re-match-data)
+  (let ((group (object-unhash match-group)))
+    (cons group
+         (if group
+             (let ((v (make-vector 20 false)))
+               (do ((i 0 (+ i 1)))
+                   ((= i 20))
+                 (let ((index (vector-ref registers i)))
+                   (if index
+                       (vector-set!
+                        v i
+                        ;; Start marks are right-inserting,
+                        ;; end marks are left-inserting.
+                        (make-permanent-mark group index (>= i 10))))))
+               v)
+             (vector-copy registers)))))
+
+(define (set-re-match-data! data)
+  (let ((group (car data))
+       (marks (cdr data)))
+    (set! match-group (if group (group-hash-number group) hash-of-false))
+    (set! registers
+         (if group
+             (vector-map marks
+                         (lambda (mark)
+                           (and mark
+                                (let ((index (mark-index mark)))
+                                  (mark-temporary! mark)
+                                  index))))
+             marks)))
+  unspecific)
+
 (define (preserving-match-data thunk)
-  (let ((group unspecific)
-       (marks unspecific))
-    (unwind-protect
-     (lambda ()
-       (set! group (object-unhash match-group))
-       (set! marks
-            (if group
-                (let ((v (make-vector 20 false)))
-                  (do ((i 0 (+ i 1)))
-                      ((= i 20))
-                    (let ((index (vector-ref registers i)))
-                      (if index
-                          (vector-set!
-                           v i
-                           ;; Start marks are right-inserting,
-                           ;; end marks are left-inserting.
-                           (make-permanent-mark group index (>= i 10))))))
-                  v)
-                (vector-copy registers)))
-       unspecific)
-     thunk
-     (lambda ()
-       (set! match-group (if group (group-hash-number group) hash-of-false))
-       (set! registers
-            (if group
-                (vector-map marks
-                  (lambda (mark)
-                    (and mark
-                         (let ((index (mark-index mark)))
-                           (mark-temporary! mark)
-                           index))))
-                marks))
-       unspecific))))
+  (let ((data unspecific))
+    (unwind-protect (lambda () (set! data (re-match-data)) unspecific)
+                   thunk
+                   (lambda () (set-re-match-data! data)))))
 
 (define-integrable (syntax-table-argument syntax-table)
   (syntax-table/entries (or syntax-table standard-syntax-table)))
@@ -187,8 +190,7 @@
          pattern
          (re-translation-table case-fold-search)
          (syntax-table-argument syntax-table)
-         registers
-         group start end)))
+         registers group start end)))
     (set! match-group (compute-match-group group index))
     index))
 
@@ -199,8 +201,7 @@
          pattern
          (re-translation-table case-fold-search)
          (syntax-table-argument syntax-table)
-         registers
-         group start end)))
+         registers group start end)))
     (set! match-group (compute-match-group group index))
     index))
 
@@ -211,8 +212,7 @@
          pattern
          (re-translation-table case-fold-search)
          (syntax-table-argument syntax-table)
-         registers
-         group start end)))
+         registers group start end)))
     (set! match-group (compute-match-group group index))
     index))
 
@@ -232,8 +232,7 @@
    pattern
    (re-translation-table case-fold-search)
    (syntax-table-argument syntax-table)
-   registers
-   string start end))
+   registers string start end))
 
 (define (re-search-string-forward pattern case-fold-search syntax-table string)
   (re-search-substring-forward pattern case-fold-search syntax-table
@@ -246,8 +245,7 @@
    pattern
    (re-translation-table case-fold-search)
    (syntax-table-argument syntax-table)
-   registers
-   string start end))
+   registers string start end))
 
 (define (re-search-string-backward pattern case-fold-search syntax-table
                                   string)
@@ -261,8 +259,7 @@
    pattern
    (re-translation-table case-fold-search)
    (syntax-table-argument syntax-table)
-   registers
-   string start end))
+   registers string start end))
 \f
 (define (search-forward string start end #!optional case-fold-search)
   (%re-search string start end