;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; general-utilities
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun group (n lst)
  (labels ((rec (l acc)
             (let ((rest (nthcdr n l)))
               (if (null rest)
                 (cons l acc)
                 (rec rest
                      (cons (subseq l 0 n)
                            acc))))))
    (if (<= n 0)
      nil
      (nreverse (rec lst nil)))))

(defmacro abbrev (short long)
  `(defmacro ,short (&rest args)
     `(,',long ,@args)))

(defmacro abbrevs (&rest args)
  `(progn
     ,@(mapcar (lambda (pair) `(abbrev ,@pair))
               (group 2 args))))

(abbrevs
  dbind destructuring-bind
  mvbind multiple-value-bind)

(defun curry (fn &rest args)
  (lambda (&rest args2)
    (apply fn (append args args2))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; integer <-> bit list
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun bits-to-int (l)
  (reduce (lambda (x acc) (+ (* 2 acc) x))
          l :initial-value 0 :from-end t))

(defun int-to-bits (i)
  (if (<= i 0)
    nil
    (mvbind (q r) (truncate i 2)
      (cons r (int-to-bits q)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; body
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun fa (a b cin)
  (let ((key (list a b cin)))
    (cond ((equal key '(0 0 0)) `(0 0)) ; 0
          ((equal key '(1 0 0)) `(1 0)) ; 1
          ((equal key '(0 1 0)) `(1 0)) ; 1
          ((equal key '(1 1 0)) `(0 1)) ; 2
          ((equal key '(0 0 1)) `(1 0)) ; 1
          ((equal key '(1 0 1)) `(0 1)) ; 2
          ((equal key '(0 1 1)) `(0 1)) ; 2
          ((equal key '(1 1 1)) `(1 1)) ; 3
          (t `(x x)))))

(defun addc (as bs cin)
  (if (and (null as) (null bs))
    nil ; If carry bit was wanted, this line should be (list cin).
    (dbind (s c) (fa (if (null as) 0 (car as))
                     (if (null bs) 0 (car bs))
                     cin)
      (cons s (addc (cdr as) (cdr bs) c)))))

(defun mul (a b)
  (if (null b)
    nil
    (addc (mapcar (curry #'logand (car b))
                  a)
          (cons 0 (mul a (cdr b)))
          0)))

