From d60cf179530394ede8915175a3b28d258e1aade8 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 5 Oct 2001 15:43:04 +0000
Subject: [PATCH] Update copyright.  Add comment explaining contents of file. 
 Change logic since character sets are no longer represented as strings.  If
 character set is argument to CASE-FOLD, then case-fold it.

---
 v7/src/runtime/rexp.scm | 75 ++++++++++++++++++++++++-----------------
 1 file changed, 45 insertions(+), 30 deletions(-)

diff --git a/v7/src/runtime/rexp.scm b/v7/src/runtime/rexp.scm
index 94651a8d1..16a5081e0 100644
--- a/v7/src/runtime/rexp.scm
+++ b/v7/src/runtime/rexp.scm
@@ -1,30 +1,36 @@
-;;; -*-Scheme-*-
-;;;
-;;; $Id: rexp.scm,v 1.15 2000/07/08 00:41:45 cph Exp $
-;;;
-;;; Copyright (c) 2000 Massachusetts Institute of Technology
-;;;
-;;; This program is free software; you can redistribute it and/or
-;;; modify it under the terms of the GNU General Public License as
-;;; published by the Free Software Foundation; either version 2 of the
-;;; License, or (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program; if not, write to the Free Software
-;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+#| -*-Scheme-*-
+
+$Id: rexp.scm,v 1.16 2001/10/05 15:43:04 cph Exp $
+
+Copyright (c) 1988-2001 Massachusetts Institute of Technology
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or (at
+your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
+|#
 
 ;;;; List-based Regular Expressions
 
+;;; This is an abstraction layer upon regular expressions, to make
+;;; them easier to read and write.  Expressions written this way can
+;;; be compiled into ordinary regular expressions using REXP->REGEXP.
+
 (declare (usual-integrations))
 
 (define (rexp? rexp)
-  (or (char-set? rexp)
-      (string? rexp)
+  (or (string? rexp)
+      (char-set? rexp)
       (and (pair? rexp)
 	   (list? (cdr rexp))
 	   (let ((one-arg
@@ -109,7 +115,7 @@
 (define (rexp-groupify rexp)
   (let ((group (lambda () `(GROUP ,rexp)))
 	(no-group (lambda () (error "Expression can't be grouped:" rexp))))
-    (cond ((and (string? rexp) (not (char-set? rexp)))
+    (cond ((string? rexp)
 	   (case (string-length rexp)
 	     ((0) (no-group))
 	     ((1) rexp)
@@ -137,7 +143,7 @@
 (define (rexp-not-syntax-char type) `(NOT-SYNTAX-CHAR ,type))
 
 (define (rexp-case-fold rexp)
-  (cond ((and (string? rexp) (not (char-set? rexp)))
+  (cond ((or (string? rexp) (char-set? rexp))
 	 `(CASE-FOLD ,rexp))
 	((and (pair? rexp)
 	      (memq (car rexp) '(ALTERNATIVES SEQUENCE GROUP OPTIONAL * +))
@@ -151,10 +157,10 @@
 
 (define (rexp->regexp rexp)
   (let ((lose (lambda () (error "Malformed rexp:" rexp))))
-    (cond ((char-set? rexp)
-	   (char-set->regexp rexp))
-	  ((string? rexp)
+    (cond ((string? rexp)
 	   (re-quote-string rexp))
+	  ((char-set? rexp)
+	   (char-set->regexp rexp))
 	  ((and (pair? rexp) (list? (cdr rexp)))
 	   (let ((one-arg
 		  (lambda ()
@@ -179,9 +185,9 @@
 		 ((+) (string-append (rexp-arg) "+"))
 		 ((CASE-FOLD)
 		  (let ((arg (one-arg)))
-		    (if (and (string? arg) (not (char-set? arg)))
-			(case-fold-string arg)
-			(lose))))
+		    (cond ((string? arg) (case-fold-string arg))
+			  ((char-set? arg) (case-fold-char-et arg))
+			  (else (lose)))))
 		 ((ANY-CHAR) ".")
 		 ((LINE-START) "^")
 		 ((LINE-END) "$")
@@ -214,4 +220,13 @@
 			 (re-quote-string
 			  (substring s start index))
 			 parts))
-	    (apply string-append (reverse! parts)))))))
\ No newline at end of file
+	    (apply string-append (reverse! parts)))))))
+
+(define (case-fold-char-set c)
+  (let loop ((chars (char-set-members c)) (chars* '()))
+    (if (pair? chars)
+	(loop (cdr chars)
+	      (if (char-alphabetic? c)
+		  (cons* (char-upcase c) (char-downcase c) chars*)
+		  chars*))
+	(apply char-set chars*))))
\ No newline at end of file
-- 
2.25.1