Даны два двоичных числа в виде списков, нужно их сложить

(defun F (L1 L2)
 (reverse
  ((lambda (fdef)
    (funcall fdef fdef (reverse L1) (reverse L2)))
  '(lambda (fname b1 b2 &optional (flag 0))
    (if (or b1 b2)
     ((lambda (bit)
       (cons
        (rem bit 2)
        (funcall fname fname (cdr b1) (cdr b2) (if (> bit 1) 1 0))))
      (+ (cond ((car b1)) (0)) (cond ((car b2)) (0)) flag))
     (if (plusp flag) (cons flag nil)))))))

(defun f2 (x y)
    (
        cond ((null x) (if (null y) nil y))
            ((null y) (if (null x) nil x))
            (t (cons (+ (car x) (car y)) (f2 (cdr x) (cdr y))))
    )
)
 
(defun f (x)
    (
        cond ((null (cdr x)) (if (< (car x) 10) x (list (- (car x) 10) 1)))
            
        (t  (cons (if (< (car x) 10) (car x) (- (car x) 10)) (f (if (< (car x) 10) (cdr x) (rplaca (cdr x) (+ (cadr x) 1))))))
    )
)
 
 
(defun ff (x y)
    (
        reverse (f (f2 (reverse x) (reverse y)))
    )
)

(defun RAZDEL (X Y Z)
 (cond
  ((null X) T)
  ((null Y) nil)
  ((equal (car X) (car Y)) (RAZDEL (cdr X) Z (cdr Y)))))

(defun bin-add (lst1 lst2 &optional (sh 0))
  (cond ((null lst1) (if (zerop sh) lst2 (bin-add '(1) lst2)))
        ((null lst2) (if (zerop sh) lst1 (bin-add '(1) lst1)))
        (t (let* ((r  (+ sh (car (last lst1)) (car (last lst2))))
                  (v  (% r 2))
                  (sh (\ r 2)))
                 (append (bin-add (butlast lst1) (butlast lst2) sh) (list v))))))
 
==> bin-add
 
(bin-add '(1 0 1) '(1 0))
 
==> (1 1 1)
 
(bin-add '(1 0 1) '(1 1))
 
==> (1 0 0 0)
 
(bin-add '(1 0 1) '(1 0 1))
 
==> (1 0 1 0)
 
(bin-add '(1 0 1) '(1 1 1))
 
==> (1 1 0 0)

(defun binary-arithmetic (w)
  (format
   nil "~b"
   (reduce
    (car w)
    (mapcar
     #'(lambda (a)
         (parse-integer (write-to-string a) :radix 2))
     (cdr w)))))
 
> (binary-arithmetic  '(+ 1011 111001 101))
"1001001"

(defun deci-bin (n &optional ac)
  (if (zerop n) ac (deci-bin (floor (/ n 2)) (cons (mod n 2) ac))))
 
(defun bin-deci (w &optional (n 0))
  (if (null w) n (bin-deci (cdr w) (+ (car w) n n))))
 
(defun binary+ (&rest w)
  (deci-bin (reduce #'+ (mapcar #'bin-deci w))))
 
> (binary+  '(1 0 1 1) '(1 1 1 0 0 1) '(1 0 1))
(1 0 0 1 0 0 1)

(defun binary+ (a b)
  (do ((xs (reverse a) (cdr xs))
       (ys (reverse b) (cdr ys))
       (sh 0)
       result)
      ((and (null xs) (null ys))
       (when (> sh 0) (push sh result))
       result)
    (let* ((x (or (car xs) 0))
           (y (or (car ys) 0))
           (s (+ x y sh)))
      (push (rem s 2) result)
      (setf sh (ash s -1)))))
 
(binary+ '(1 0 1 0 0) '(1 1 0 0 0))
; (1 0 1 1 0 0)
 
(binary+ '(1 0 1 0 0) '(1 1 1 0 0))
; (1 1 0 0 0 0)

(defun deci-bin (n &optional ac)
  (if (zerop n)
      ac
      (deci-bin (floor (/ n 2)) (cons (mod n 2) ac))))
 
(defun bin (w)
  (read-from-string
   (apply
    #'concatenate
    'string
    "#b"
    (mapcar
     #'(lambda (a)
         (write-to-string a))
     w))))
 
(defun binary+ (&rest w)
  (deci-bin (reduce #'+ (mapcar #'bin w))))
 
> (binary+  '(1 0 1 1) '(1 1 1 0 0 1) '(1 0 1))
(1 0 0 1 0 0 1)