From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 13 Apr 2000 18:00:53 +0000 (+0000)
Subject: Fix compiler warnings.
X-Git-Tag: 20090517-FFI~4029
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a637ee4ec8be27fd0c8a103a19cbb0cb97b3cf30;p=mit-scheme.git

Fix compiler warnings.
---

diff --git a/v7/src/imail/ed-ffi.scm b/v7/src/imail/ed-ffi.scm
index 460ec18a1..fb4923132 100644
--- a/v7/src/imail/ed-ffi.scm
+++ b/v7/src/imail/ed-ffi.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: ed-ffi.scm,v 1.3 2000/04/13 15:36:00 cph Exp $
+;;; $Id: ed-ffi.scm,v 1.4 2000/04/13 18:00:53 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -28,6 +28,6 @@
     ("imail-top" (edwin imail) edwin-syntax-table)
     ("imail-umail" (edwin imail) system-global-syntax-table)
     ("imail-util" (edwin imail) system-global-syntax-table)
-    ("rexp" (runtime rexp) system-global-syntax-table)
+    ("rexp" (edwin imail rexp) system-global-syntax-table)
     ("rfc822" (edwin imail) system-global-syntax-table)
-    ("url" (runtime url) system-global-syntax-table)))
\ No newline at end of file
+    ("url" (edwin imail url) system-global-syntax-table)))
\ No newline at end of file
diff --git a/v7/src/imail/imail-imap-url.scm b/v7/src/imail/imail-imap-url.scm
index 02139457e..dcaddb99a 100644
--- a/v7/src/imail/imail-imap-url.scm
+++ b/v7/src/imail/imail-imap-url.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-imap-url.scm,v 1.5 2000/04/13 16:58:39 cph Exp $
+;;; $Id: imail-imap-url.scm,v 1.6 2000/04/13 17:57:52 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -165,10 +165,12 @@
   (or (imap:match-quoted-string string start end)
       (imap:match-literal string start end)))
 
+(define imap:char-set:achar
+  (char-set-union url:char-set:unreserved
+		  (string->char-set "&=~")))
+
 (define imap:rexp:achar+
-  (rexp+ (rexp-alternatives (char-set-union url:char-set:unreserved
-					    (string->char-set "&=~"))
-			    url:rexp:escape)))
+  (rexp+ (rexp-alternatives imap:char-set:achar url:rexp:escape)))
 
 (define imap:rexp:bchar+
   (rexp+ (rexp-alternatives (char-set-union imap:char-set:achar
diff --git a/v7/src/imail/rexp.scm b/v7/src/imail/rexp.scm
index dcabc19fb..a54a4f255 100644
--- a/v7/src/imail/rexp.scm
+++ b/v7/src/imail/rexp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: rexp.scm,v 1.8 2000/04/13 16:56:49 cph Exp $
+;;; $Id: rexp.scm,v 1.9 2000/04/13 17:57:57 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -22,7 +22,7 @@
 
 (declare (usual-integrations))
 
-(define (rexp? object)
+(define (rexp? rexp)
   (or (string? rexp)
       (char-set? rexp)
       (and (pair? rexp)
@@ -133,15 +133,14 @@
 (define (rexp-not-syntax-char type) `(NOT-SYNTAX-CHAR ,type))
 
 (define (rexp-case-fold rexp)
-  (let ((lose (lambda () (error "Malformed rexp:" rexp))))
-    (cond ((string? rexp)
-	   `(CASE-FOLD rexp))
-	  ((and (pair? rexp)
-		(memq (car rexp) '(ALTERNATIVES SEQUENCE GROUP OPTIONAL * +))
-		(list? (cdr rexp)))
-	   (cons (car rexp)
-		 (map rexp-case-fold (cdr rexp))))
-	  (else rexp))))
+  (cond ((string? rexp)
+	 `(CASE-FOLD rexp))
+	((and (pair? rexp)
+	      (memq (car rexp) '(ALTERNATIVES SEQUENCE GROUP OPTIONAL * +))
+	      (list? (cdr rexp)))
+	 (cons (car rexp)
+	       (map rexp-case-fold (cdr rexp))))
+	(else rexp)))
 
 (define (rexp-compile rexp)
   (re-compile-pattern (rexp->regexp rexp) #f))
@@ -193,7 +192,7 @@
 		 ((NOT-SYNTAX-CHAR) (string-append "\\S" (syntax-type)))
 		 (else (lose))))))
 	  (else (lose)))))
-
+
 (define (case-fold-string s)
   (let ((end (string-length s)))
     (let loop ((start 0) (parts '()))
@@ -210,27 +209,4 @@
 			 (re-quote-string
 			  (substring s start index))
 			 parts))
-	    (apply string-append (reverse! parts)))))))
-
-(define (separated-append tokens separator)
-  (cond ((not (pair? tokens)) "")
-	((not (pair? (cdr tokens))) (car tokens))
-	(else
-	 (let ((string
-		(make-string
-		 (let ((ns (string-length separator)))
-		   (do ((tokens (cdr tokens) (cdr tokens))
-			(count (string-length (car tokens))
-			       (fix:+ count
-				      (fix:+ (string-length (car tokens))
-					     ns))))
-		       ((not (pair? tokens)) count))))))
-	   (let loop
-	       ((tokens (cdr tokens))
-		(index (string-move! (car tokens) string 0)))
-	     (if (pair? tokens)
-		 (loop (cdr tokens)
-		       (string-move! (car tokens)
-				     string
-				     (string-move! separator string index)))))
-	   string))))
\ No newline at end of file
+	    (apply string-append (reverse! parts)))))))
\ No newline at end of file
diff --git a/v7/src/runtime/rexp.scm b/v7/src/runtime/rexp.scm
index dcabc19fb..a54a4f255 100644
--- a/v7/src/runtime/rexp.scm
+++ b/v7/src/runtime/rexp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: rexp.scm,v 1.8 2000/04/13 16:56:49 cph Exp $
+;;; $Id: rexp.scm,v 1.9 2000/04/13 17:57:57 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -22,7 +22,7 @@
 
 (declare (usual-integrations))
 
-(define (rexp? object)
+(define (rexp? rexp)
   (or (string? rexp)
       (char-set? rexp)
       (and (pair? rexp)
@@ -133,15 +133,14 @@
 (define (rexp-not-syntax-char type) `(NOT-SYNTAX-CHAR ,type))
 
 (define (rexp-case-fold rexp)
-  (let ((lose (lambda () (error "Malformed rexp:" rexp))))
-    (cond ((string? rexp)
-	   `(CASE-FOLD rexp))
-	  ((and (pair? rexp)
-		(memq (car rexp) '(ALTERNATIVES SEQUENCE GROUP OPTIONAL * +))
-		(list? (cdr rexp)))
-	   (cons (car rexp)
-		 (map rexp-case-fold (cdr rexp))))
-	  (else rexp))))
+  (cond ((string? rexp)
+	 `(CASE-FOLD rexp))
+	((and (pair? rexp)
+	      (memq (car rexp) '(ALTERNATIVES SEQUENCE GROUP OPTIONAL * +))
+	      (list? (cdr rexp)))
+	 (cons (car rexp)
+	       (map rexp-case-fold (cdr rexp))))
+	(else rexp)))
 
 (define (rexp-compile rexp)
   (re-compile-pattern (rexp->regexp rexp) #f))
@@ -193,7 +192,7 @@
 		 ((NOT-SYNTAX-CHAR) (string-append "\\S" (syntax-type)))
 		 (else (lose))))))
 	  (else (lose)))))
-
+
 (define (case-fold-string s)
   (let ((end (string-length s)))
     (let loop ((start 0) (parts '()))
@@ -210,27 +209,4 @@
 			 (re-quote-string
 			  (substring s start index))
 			 parts))
-	    (apply string-append (reverse! parts)))))))
-
-(define (separated-append tokens separator)
-  (cond ((not (pair? tokens)) "")
-	((not (pair? (cdr tokens))) (car tokens))
-	(else
-	 (let ((string
-		(make-string
-		 (let ((ns (string-length separator)))
-		   (do ((tokens (cdr tokens) (cdr tokens))
-			(count (string-length (car tokens))
-			       (fix:+ count
-				      (fix:+ (string-length (car tokens))
-					     ns))))
-		       ((not (pair? tokens)) count))))))
-	   (let loop
-	       ((tokens (cdr tokens))
-		(index (string-move! (car tokens) string 0)))
-	     (if (pair? tokens)
-		 (loop (cdr tokens)
-		       (string-move! (car tokens)
-				     string
-				     (string-move! separator string index)))))
-	   string))))
\ No newline at end of file
+	    (apply string-append (reverse! parts)))))))
\ No newline at end of file