diff options
| author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:31 -0800 |
|---|---|---|
| committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:31 -0800 |
| commit | 5145dd3aa0c02c9fc496d1432fc4410674206e1d (patch) | |
| tree | 540afc30c51da085f5bd8ec3f4c89f6496e7900d /soundex.scm | |
| parent | 8466d8cfa486fb30d1755c4261b781135083787b (diff) | |
| download | slib-5145dd3aa0c02c9fc496d1432fc4410674206e1d.tar.gz slib-5145dd3aa0c02c9fc496d1432fc4410674206e1d.zip | |
Import Upstream version 3a2upstream/3a2
Diffstat (limited to 'soundex.scm')
| -rw-r--r-- | soundex.scm | 56 |
1 files changed, 27 insertions, 29 deletions
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)))))))))))) - - |