From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 13 Apr 2000 16:14:40 +0000 (+0000)
Subject: When ALTERNATIVES appears within SEQUENCE, it must be GROUPed.
X-Git-Tag: 20090517-FFI~4035
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=15599f4a9a9f4c57f12fcbe681231a0ff0218884;p=mit-scheme.git

When ALTERNATIVES appears within SEQUENCE, it must be GROUPed.
---

diff --git a/v7/src/imail/rexp.scm b/v7/src/imail/rexp.scm
index 7992610c6..1616098de 100644
--- a/v7/src/imail/rexp.scm
+++ b/v7/src/imail/rexp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: rexp.scm,v 1.3 2000/04/13 15:55:56 cph Exp $
+;;; $Id: rexp.scm,v 1.4 2000/04/13 16:14:40 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -81,18 +81,12 @@
 	  ((char-set? rexp)
 	   (char-set->regexp rexp))
 	  ((and (pair? rexp) (list? (cdr rexp)))
-	   (let ((n-args
-		  (lambda ()
-		    (map rexp->regexp (cdr rexp))))
-		 (one-arg
+	   (let ((one-arg
 		  (lambda ()
 		    (if (not (fix:= 1 (length (cdr rexp))))
 			(lose))
 		    (cadr rexp))))
-	     (let ((alternatives
-		    (lambda ()
-		      (separated-append (n-args) "\\|")))
-		   (group-arg
+	     (let ((repeat-arg
 		    (lambda ()
 		      (rexp->regexp (rexp-groupify (one-arg)))))
 		   (syntax-type
@@ -102,12 +96,22 @@
 			    (cdr entry)
 			    (lose))))))
 	       (case (car rexp)
-		 ((ALTERNATIVES) (alternatives))
-		 ((SEQUENCE) (apply string-append (n-args)))
-		 ((GROUP) (group-arg))
-		 ((?) (string-append (group-arg) "?"))
-		 ((*) (string-append (group-arg) "*"))
-		 ((+) (string-append (group-arg) "+"))
+		 ((ALTERNATIVES)
+		  (separated-append (map rexp->regexp (cdr rexp)) "\\|"))
+		 ((SEQUENCE)
+		  (apply string-append
+			 (map (lambda (rexp)
+				(rexp->regexp
+				 (if (and (pair? rexp)
+					  (eq? (car rexp) 'ALTERNATIVES))
+				     (rexp-group rexp)
+				     rexp)))
+			      (cdr rexp))))
+		 ((GROUP)
+		  (string-append "\\(" (rexp->regexp (one-arg)) "\\)"))
+		 ((?) (string-append (repeat-arg) "?"))
+		 ((*) (string-append (repeat-arg) "*"))
+		 ((+) (string-append (repeat-arg) "+"))
 		 ((ANY-CHAR) ".")
 		 ((LINE-START) "^")
 		 ((LINE-END) "$")
diff --git a/v7/src/runtime/rexp.scm b/v7/src/runtime/rexp.scm
index 7992610c6..1616098de 100644
--- a/v7/src/runtime/rexp.scm
+++ b/v7/src/runtime/rexp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: rexp.scm,v 1.3 2000/04/13 15:55:56 cph Exp $
+;;; $Id: rexp.scm,v 1.4 2000/04/13 16:14:40 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -81,18 +81,12 @@
 	  ((char-set? rexp)
 	   (char-set->regexp rexp))
 	  ((and (pair? rexp) (list? (cdr rexp)))
-	   (let ((n-args
-		  (lambda ()
-		    (map rexp->regexp (cdr rexp))))
-		 (one-arg
+	   (let ((one-arg
 		  (lambda ()
 		    (if (not (fix:= 1 (length (cdr rexp))))
 			(lose))
 		    (cadr rexp))))
-	     (let ((alternatives
-		    (lambda ()
-		      (separated-append (n-args) "\\|")))
-		   (group-arg
+	     (let ((repeat-arg
 		    (lambda ()
 		      (rexp->regexp (rexp-groupify (one-arg)))))
 		   (syntax-type
@@ -102,12 +96,22 @@
 			    (cdr entry)
 			    (lose))))))
 	       (case (car rexp)
-		 ((ALTERNATIVES) (alternatives))
-		 ((SEQUENCE) (apply string-append (n-args)))
-		 ((GROUP) (group-arg))
-		 ((?) (string-append (group-arg) "?"))
-		 ((*) (string-append (group-arg) "*"))
-		 ((+) (string-append (group-arg) "+"))
+		 ((ALTERNATIVES)
+		  (separated-append (map rexp->regexp (cdr rexp)) "\\|"))
+		 ((SEQUENCE)
+		  (apply string-append
+			 (map (lambda (rexp)
+				(rexp->regexp
+				 (if (and (pair? rexp)
+					  (eq? (car rexp) 'ALTERNATIVES))
+				     (rexp-group rexp)
+				     rexp)))
+			      (cdr rexp))))
+		 ((GROUP)
+		  (string-append "\\(" (rexp->regexp (one-arg)) "\\)"))
+		 ((?) (string-append (repeat-arg) "?"))
+		 ((*) (string-append (repeat-arg) "*"))
+		 ((+) (string-append (repeat-arg) "+"))
 		 ((ANY-CHAR) ".")
 		 ((LINE-START) "^")
 		 ((LINE-END) "$")