Вычитание списков в двоичной системе счисления

(defun razr (l1 l2)
(cond
    ...
(let ((l (length l1)))
 
)
)
 
(defun inv (l2)
  (cond ((null l2) nil)
        ((= (car l2) 0) (cons 1 (inv (cdr l2)))) (t (cons 0 (inv (cdr l2))))
        ((cons (car l2) (inv (cdr l2))))
    )
)
 
(defun add (l1 l2)
(cond 
( (> (length l1) (length l2)) (razr l1 l2))
(inv l2)
)

(defun binary-abstract (w)
  (format nil "~b" (reduce #'- (mapcar #'(lambda (a) (parse-integer (write-to-string a) :radix 2)) w))))
 
> (binary-abstract '(110101 100101))
"10000"

(defun align-bin (lst n)
   (cond ((= n (length lst)) lst)
         ((> n (length lst)) (cons 0 (align-bin lst (- n 1))))
         (t (raiseerror "Ошибка при вызове align-bin"))))
 
 
(defun inv-bin (lst)
  (cond ((null lst) nil)
        (t (cons (- 1 (car lst)) (inv-bin (cdr lst))))))
         
(defun sub-bin (L1 L2)
  (let* ((Res nil)
         (Resn nil) 
         (Sh 0) 
         (z  0)
         (ml (max (length L1) (length L2)))
         (A1 (reverse (align-bin L1 ml)))
         (A2 (reverse (inv-bin (align-bin L2 ml)))))
        (dotimes (i ml Res)
          (setq z (+ Sh (car A1) (car A2)))
          (setq Res (append Res (list (% z 2))))
          (setq Sh (\ z 2))
          (setq A1 (cdr A1))
          (setq A2 (cdr A2))
        )
        (if (= Sh 0) 
            (reverse (inv-bin Res))
            (progn
             (dotimes (i ml Resn)
               (setq z (+ Sh (car Res)))
               (setq Resn (append Resn (list (% z 2))))
               (setq Sh (\ z 2))
               (setq Res (cdr Res))
             )
             (reverse (if (> Sh 0) (inv-bin (resn)) resn))
            )
        )
))
    
 
(sub-bin '(1 1 1 1) '(1 0 1))  ;; 15 - 5
 
==> (1 0 1 0) ;; =10
 
(sub-bin '(1 1 1 1) '(1 1)) ;; 15 - 3
 
==> (1 1 0 0) ;; = 12

(defun binadd (x y)
(reverse (preobr (add (reverse x) (reverse y))))
)
 
(defun preobr (x)
(cond 
((null x) x)
((null (cdr x))
(cond
((< (car x) 2) x)
(t (list (- (car x) 2) 1))))
 
(t (cons
(cond
((< (car x) 2) (car x))
(t (- (car x) 2)))
(preobr 
(cond
((< (car x) 2) (cdr x))
(t (rplaca (cdr x) (+ (cadr x) 1))))
)))
)
)
 
(defun add (x y)
(cond 
((null x) (if 
(null y) nil 
y)) 
((null y) (if 
(null x) nil 
x))
(t (cons (+ (car x) (car y)) (add (cdr x) (cdr y))))
)
)

(defun b (x y)
(reverse (preobr (add (reverse x) (reverse y))))
)
 
(defun preobr (x)
(cond 
((null x) x)
((null (cdr x))
(cond
((< (car x) 2) x)
(t (list (- (car x) 2) 1))))
 
(t (cons
(cond
((> (car x) -1) (car x))
(t (+ (car x) 2)))
(preobr 
(cond
((> (car x) -1) (cdr x))
(t (rplaca (cdr x) (- (cadr x) 1))))
)))
)
)
 
(defun add (x y)
(cond 
((null x) (if 
(null y) nil 
y)) 
((null y) (if 
(null x) nil 
x))
(t (cons (- (car x) (car y)) (add (cdr x) (cdr y))))
)
)

(defun del-zero (lst)
  (cond ((= 1 (length lst)) lst)
        ((= 0 (car lst)) (del-zero (cdr lst)))
        ((= 1 (car lst)) lst)))
 
==> del-zero
 
(del-zero '(0 0 1 0 1))
 
==> (1 0 1)