Написать программу, исключающую в исходном тексте из каждого слова его окончание по словарю

;; Вспом. функция - взять n символов с конца строки
 
(defun strRight (stri n)
  (let ((l (strLen stri))) (strMid stri (- l n -1))))
 
==> strRight
 
(strRight "fffg" 3)
 
==> "ffg"
 
;; Решение:
 
(defun task (wdlist dict)
   (mapcar #'(lambda (wd)
             (let ((res wd))
               (dolist (w dict res)
                 (when (= 0 (strCmp (strRight wd (strLen w)) w)) 
                       (return (strMid wd 1 (- (strLen wd) (strLen w))))))))
           wdlist))
 
==> task
 
(task '("Кошка" "Мышка" "Бабка" "Дед" "Внучка" "Жучка") '("ка" "ко"))
 
==> ("Кош" "Мыш" "Баб" "Дед" "Внуч" "Жуч")

(defun strRight (stri n)
  (last stri n))
 
> (strRight '(1 2 3 4 5) 3)
(3 4 5)

(defun str-right (str n)
  (let* ((str-len (length  str))
         (str-pos (- str-len n))
         (result  (make-string n)))
    (loop
      for i from str-pos
      for j below n
      do (setf (char result j) (char str i)))
    result))
 
(str-right "abcde" 3)
; "cde"

(defun string-right (s n)
  (subseq s (- (length s) n)))
 
> (string-right "abcde" 3)
"cde"

(defmacro aif (test then &optional else)
  `(let ((it ,test))
     (if it ,then ,else)))
 
(defun suffixp (string suffix)
  (aif (search suffix string :from-end t)
      (= (length string) (+ it (length suffix)))))
 
(defun partial (fun arg &rest args)
  #'(lambda (&rest more-args)
      (apply fun arg (append args more-args))))
 
(defun drop-suffixes (words suffixes)
  (mapcar #'(lambda (word)
              (aif (find-if (partial #'suffixp word) suffixes)
                  (subseq word 0 (search it word :from-end t))
                word))
          words))

(defun string-right (s n)
  (subseq s (- (length s) n)))
 
(defun drop-suffix (s v &aux (m (length s)) (n (length (car v))))
  (cond ((null v) s)
        ((string= (string-right s n) (car v)) (subseq s 0 (- m n)))
        ((drop-suffix s (cdr v)))))
 
(defun drop-suffixes (w v &aux (v> (sort v #'string>)))
  (mapcar #'(lambda (s) (drop-suffix s v>)) w)) 
 
> (drop-suffixes '("nokia") '("kia" "okia"))
("n")