Напишите функцию format+ - Lisp

Формулировка задачи:

Напишите функцию format+, которая поддерживает все возможности функции format, но вдобавок позволяет обрабатывать форматную директиву ~z, предназначенную для форматирования страхового номера индивидуального лицевого счета (СНИЛС) гражданина РФ. СНИЛС должен форматироваться следующим образом: ABC-DEF-GHI-CC, где ABC, DEF и GHI – группы из трех цифр, а CC (контрольная сумма) – группа из двух цифр. Контрольная сумма рассчитывается следующим образом: 1. Находится сумма произведений цифр номера на номер их позиции, то есть A*9+B*8+C*7+D*6+E*5+F*4+G*3+H*2+I. 2. Находится остаток от деления суммы на 101 и из него берутся две младших цифры, они и являются контрольной суммой. Аргументом директивы ~z может являться либо целое положительное число, либо строка. Если в числе не хватает значащих цифр, то слева оно дополняется нулями до 11 разрядов. Строка может содержать не более 11 десятичных цифр. В случае недопустимых аргументов и других ошибок считать СНИЛС неправильно сформированным и отображать как [bad SNILS]. Примеры форматирования с помощью директивы ~z: (format+ t "Vasya's ~a = ~z" "SNILS" "00202203341") ==> Vasya's SNILS = 002-022-033-41 (format+ nil "~d: ~z, ~d: ~z" 1 120344511 2 "111abc22233344") ==> "1: [bad SNILS], 2: [bad SNILS]" Замечание: Для упрощения задания можно считать, что директива ~z не поддерживается внутри условной директивы ~[, внутри циклов ~{ и в сочетании с директивами выбора аргументов типа ~:* Подсказка: Разумеется, реализовывать самостоятельно все директивы функции format не нужно. Нужно обработать директиву ~z и затем передать новую форматную строку и измененный список аргументов в функцию format.

Решение задачи: «Напишите функцию format+»

Листинг программы

(defun check-dig (s)
  (dotimes (i (length s) t)
     (when (null (search (subseq s i (+ i 1)) "0123456789")) (return nil))))
 
(defun check-sum (n)
  (let ((c 1)
        (s 0))
    (dotimes (i 9 (mod (mod s 101) 100))
       (setf s (+ s (* c (mod n 10))))
       (setf n (truncate (/ n 10)))
       (setf c (+ c 1)))))
 
(defun fsnils (snils)
  (let ((sn 0)
        (ds "")
        (cs 0))
    (cond ((not (or (integerp snils) (stringp snils))) "[bad SNILS]")
          ((and (integerp snils) (> snils 99999999999)) "[bad SNILS]")
          ((and (stringp snils) (not (check-dig snils))) "[bad SNILS]")           
          (t (when (stringp snils) (setf sn (parse-integer snils))
                                   (setf ds (format nil "~11,'0d" sn)))
             (when (integerp snils)(setf ds (format nil "~11,'0d" snils)))                      
             (setf cs (check-sum (truncate (/ (parse-integer ds) 100))))
             (if (/= cs  (mod (parse-integer ds) 100)) "[bad SNILS]"
                 (concatenate 'string (subseq ds 0 3) "-" 
                                      (subseq ds 3 6) "-"
                                      (subseq ds 6 9) "-"
                                      (format nil "~2d" cs)))))))
 
(defun prepro (fstr arglist)
  (let ((fstro "")
        (argo nil)
        (pz 0))        
    (loop 
          (setf pz (search "~z" fstr))
          (when (null pz) (return (list (concatenate 'string fstro fstr) (append argo arglist))))
          (setf pz (search "~" fstr))
          (when (null pz) (return (list (concatenate 'string fstro fstr) (append argo arglist))))
          (when (plusp pz) (setf fstro (concatenate 'string fstro (subseq fstr 0 pz)))
                           (setf fstr (subseq fstr pz)))
          (cond ((string= "z" (subseq fstr 1 2))
                 (setf fstro (concatenate 'string fstro (fsnils (car arglist))))
                 (setf fstr (subseq fstr 2))
                 (setf arglist (cdr arglist)))
                (t (setf fstro (concatenate 'string fstro (subseq fstr 0 2)))
                   (setf fstr (subseq fstr 2))
                   (setf argo (append argo (list (car arglist))))
                   (setf arglist (cdr arglist)))))))
                   
(defun format+ (to fstr &rest arglist)
  (let ((p (prepro fstr arglist)))
    (apply #'format (append  (list to (car p)) (cadr p)))))

Объяснение кода листинга программы

Функция check-dig принимает строку s и возвращает nil, если строка не является допустимым контрольным числом, иначе возвращает t.
Функция check-sum принимает число n и возвращает контрольную сумму в виде строки.
Функция fsnils принимает строку snils и возвращает строку с проверенным и отформатированным контрольным числом.
Функция prepro принимает строку fstr и список аргументов arglist и возвращает список, где первый элемент - отформатированная строка без значений, второй элемент - список аргументов без значений.
Функция format+ принимает символ to, строку fstr и список аргументов arglist и возвращает отформатированную строку.