From 5145dd3aa0c02c9fc496d1432fc4410674206e1d Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:31 -0800
Subject: Import Upstream version 3a2

---
 soundex.scm | 56 +++++++++++++++++++++++++++-----------------------------
 1 file changed, 27 insertions(+), 29 deletions(-)

(limited to 'soundex.scm')

diff --git a/soundex.scm b/soundex.scm
index 6d73341..9853401 100644
--- a/soundex.scm
+++ b/soundex.scm
@@ -3,44 +3,44 @@
 ;
 ; This code is in the public domain.
 
-;Date: Mon, 2 May 94 13:45:39 -0500
-
 ; Taken from Knuth, Vol. 3 "Sorting and searching", pp 391--2
 
+;;; 2003-01-26  L.J. Buitinck converted to use dotted pairs for codes.
+
 (require 'common-list-functions)
 ;@
 (define SOUNDEX
   (let* ((letters-to-omit
-          (list #\A #\E #\H #\I #\O #\U #\W #\Y))
+          '(#\A #\E #\H #\I #\O #\U #\W #\Y))
          (codes
-          (list (list #\B #\1)
-                (list #\F #\1)
-                (list #\P #\1)
-                (list #\V #\1)
-                ;;
-                (list #\C #\2)
-                (list #\G #\2)
-                (list #\J #\2)
-                (list #\K #\2)
-                (list #\Q #\2)
-                (list #\S #\2)
-                (list #\X #\2)
-                (list #\Z #\2)
-                ;;
-                (list #\D #\3)
-                (list #\T #\3)
-                ;;
-                (list #\L #\4)
-                ;;
-                (list #\M #\5)
-                (list #\N #\5)
-                ;;
-                (list #\R #\6)))
+          '((#\B . #\1)
+            (#\F . #\1)
+            (#\P . #\1)
+            (#\V . #\1)
+            ;;
+            (#\C . #\2)
+            (#\G . #\2)
+            (#\J . #\2)
+            (#\K . #\2)
+            (#\Q . #\2)
+            (#\S . #\2)
+            (#\X . #\2)
+            (#\Z . #\2)
+            ;;
+            (#\D . #\3)
+            (#\T . #\3)
+            ;;
+            (#\L . #\4)
+            ;;
+            (#\M . #\5)
+            (#\N . #\5)
+            ;;
+            (#\R . #\6)))
          (xform
           (lambda (c)
             (let ((code (assv c codes)))
               (if code
-                  (cadr code)
+                  (cdr code)
                   c)))))
     (lambda (name)
       (let ((char-list
@@ -78,5 +78,3 @@
                          (loop (cons #\0 rev-chars)))
                         ((< 4 len)
                          (loop (cdr rev-chars))))))))))))
-
-
-- 
cgit v1.2.3