From 65552dafe1fa966d1f1033347e8d216957977cae Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 1 Oct 1996 05:55:55 +0000
Subject: [PATCH] Eliminate duplicate bindings differing only in case in
 bindings lists.

---
 v7/src/edwin/comtab.scm | 52 ++++++++++++++++++++++-------------------
 1 file changed, 28 insertions(+), 24 deletions(-)

diff --git a/v7/src/edwin/comtab.scm b/v7/src/edwin/comtab.scm
index 30513ae4f..16ca00d28 100644
--- a/v7/src/edwin/comtab.scm
+++ b/v7/src/edwin/comtab.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: comtab.scm,v 1.66 1994/03/18 21:51:28 cph Exp $
+;;;	$Id: comtab.scm,v 1.67 1996/10/01 05:55:55 cph Exp $
 ;;;
-;;;	Copyright (c) 1986, 1989-94 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -325,28 +325,32 @@
   key)
 
 (define (comtab-alist* comtab)
-  (list-transform-negative
-      (let ((vector (comtab-vector comtab))
-	    (alist (comtab-alist comtab)))
-	(if (vector? vector)
-	    (let ((end (vector-length vector)))
-	      (let loop ((index 0))
-		(if (< index end)
-		    (let ((datum (vector-ref vector index)))
-		      (if datum
-			  (cons (cons (integer->char index) datum)
-				(loop (+ index 1)))
-			  (loop (+ index 1))))
-		    alist)))
-	    alist))
-    (lambda (entry)
-      (let ((key (car entry)))
-	(and (char? key)
-	     (char-upper-case? key)
-	     (let ((datum (cdr entry)))
-	       (and (pair? datum)
-		    (eq? comtab (car datum))
-		    (eqv? (char-downcase key) (cdr datum)))))))))
+  (let ((alist
+	 (let ((vector (comtab-vector comtab))
+	       (alist (comtab-alist comtab)))
+	   (if (vector? vector)
+	       (let ((end (vector-length vector)))
+		 (let loop ((index 0))
+		   (if (< index end)
+		       (let ((datum (vector-ref vector index)))
+			 (if datum
+			     (cons (cons (integer->char index) datum)
+				   (loop (+ index 1)))
+			     (loop (+ index 1))))
+		       alist)))
+	       alist))))
+    (list-transform-negative alist
+      (lambda (entry)
+	(let ((key (car entry)))
+	  (and (char? key)
+	       (char-upper-case? (char-base key))
+	       (let ((datum (cdr entry)))
+		 (or (and (comtab-alias? datum)
+			  (eq? comtab (car datum))
+			  (eqv? (char-downcase key) (cdr datum)))
+		     (let ((entry* (assv (char-downcase key) alist)))
+		       (and entry*
+			    (equal? datum (cdr entry*))))))))))))
 
 (define (comtab->alist comtab)
   (let loop ((prefix '()) (comtab comtab))
-- 
2.25.1