Data commit

Task/Soundex/Common-Lisp/soundex.lisp

@@ -0,0 +1,22 @@
+(defun get-code (c)
+  (case c
+    ((#\B #\F #\P #\V) #\1)
+    ((#\C #\G #\J #\K
+      #\Q #\S #\X #\Z) #\2)
+    ((#\D #\T) #\3)
+    (#\L #\4)
+    ((#\M #\N) #\5)
+    (#\R #\6)))
+
+(defun soundex (s)
+  (if (zerop (length s))
+    ""
+    (let* ((l (coerce (string-upcase s) 'list))
+           (o (list (first l))))
+      (loop for c in (rest l)
+            for cg = (get-code c) and
+            for cp = #\Z then cg
+            when (and cg (not (eql cg cp))) do
+              (push cg o)
+            finally
+              (return (subseq (coerce (nreverse `(#\0 #\0 #\0 ,@o)) 'string) 0 4))))))