22 lines
741 B
Plaintext
22 lines
741 B
Plaintext
(de soundex (Str)
|
|
(pack
|
|
(pad -4
|
|
(cons
|
|
(uppc (char (char Str)))
|
|
(head 3
|
|
(let Last NIL
|
|
(extract
|
|
'((C)
|
|
(and
|
|
(setq C
|
|
(case (uppc C)
|
|
(`(chop "BFPV") "1")
|
|
(`(chop "CGJKQSXZ") "2")
|
|
(("D" "T") "3")
|
|
("L" "4")
|
|
(("M" "N") "5")
|
|
("R" "6") ) )
|
|
(<> Last C)
|
|
(setq Last C) ) )
|
|
(cdr (chop Str)) ) ) ) ) ) ) )
|