@(do (defun get-code (c)
       (caseq 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* ((su (upcase-str s))
                (o [su 0]))
           (for ((i 1) (l (length su)) cp cg)
                ((< i l) [`@{o}000` 0 4])
                ((inc i) (set cp cg))
             (set cg (get-code [su i]))
             (if (and cg (not (eql cg cp)))
               (set o `@o@cg`)))))))
@(next :args)
@(repeat)
@arg
@  (output)
@arg -> @(soundex arg)
@  (end)
@(end)