;; Register bitness.
(defconstant +bitness+ 32)
 
(defun flatten (l)
  "Flatten a tree."
  (cond ((null l) nil)
        ((atom l) (list l))
        (t (mapcan #'flatten l))))
 
(defun make-reg (reg-name bitness)
  "Make algebraic representation of a register (bits in descending majority)"
  (loop for i from (1- bitness) downto 0 collect
       (make-symbol (format nil "~A~A" reg-name i))))
 
(defun integer-to-reg (n &optional (pad-width +bitness+))
  "Generate algebraic represenation of the given integer n."
  (let* ((bits '())
         (integer-bitness (integer-length n))
         (pad-bitness (- pad-width integer-bitness)))
    (dotimes (index integer-bitness bits)
      (push (if (logbitp index n) 1 0) bits))
    ;; Append padding zeros, if required to make full width:
    (loop repeat pad-bitness do (push 0 bits))
    bits))
 
(defun RL11 (reg)
  "Rotate given register leftward by 11."
  (append
   (subseq reg 11)
   (subseq reg 0 11)))
 
(defmacro reg-xor (&rest regs)
  "Make algebraic representation of the xor of given registers."
  `(map 'list #'(lambda (&rest args) (cons 'xor args)) ,@regs))
 
(defun print-reg (reg stream)
  "Print algebraic register as table, in descending bit majority"
  (let ((l (1- (length reg))))
    (loop for i from 0 upto l do
         (format stream "[bit:~2d] : ~A~%" i
                 (nth (- l i) reg)))))
 
;; Define the input registers
(defvar *A* (make-reg "a" +bitness+))
(defvar *B* (make-reg "b" +bitness+))
(defvar *C* (make-reg "c" +bitness+))
(defvar *D* (make-reg "d" +bitness+))
(defvar *E* (make-reg "e" +bitness+))
(defvar *F* (make-reg "f" +bitness+))
(defvar *G* (make-reg "g" +bitness+))
(defvar *H* (make-reg "h" +bitness+))
 
;; Serpent's 'goldenratio' turd
(defconstant +serpent-const+ #x9E3779B9)
 
;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; from serpent.ada: ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; for I in 0..7 loop
;;   W(-8+I) := Bytes_To_Word(K(4*I .. 4*I+3));
;; end loop;
;; for I in 0..131 loop
;;   W(I) := Rotate_Left(W(I-8) xor W(I-5) xor W(I-3) xor W(I-1) xor
;;           16#9e3779b9# xor Unsigned_32(I), 11);
;; end loop;
 
(defun simplify-term (term)
  "Simplify algebraic term containing XOR, constants, and registers."
  (let ((constants '())
        (variables '())
        (flattened-term (remove 'XOR (flatten term))))
    (loop for subterm in flattened-term do
         (if (numberp subterm)
             (push subterm constants)
             (push subterm variables)))
    (cons 'XOR
          (let ((constant-term (apply #'logxor constants)))
            (if (zerop constant-term)
                variables
                (cons constant-term variables))))))
 
(defun cancel-xor-subterms (expr)
  "Cancel subterms of flat equation which appear even number of times."
  (let ((subterms (cdr expr))) ;; lose the 'XOR
    (cons 'XOR
          (remove-duplicates
           (loop for subterm in subterms
              when (oddp (count subterm subterms))
              collect subterm)))))
 
(defun simplify-reg (reg)
  "Simplify every bit's equation, in a register."
  (loop for bit in reg collect
       (cancel-xor-subterms
        (simplify-term bit))))
 
;; Memoization for recurrence terms
(defvar *recurr-memo* (make-hash-table))
 
(defun get-memo (k)
  "Get memoized term k, if it exists"
  (gethash k *recurr-memo*))
 
(defun put-memo (k term)
  "Memoize k-th term."
  (setf (gethash k *recurr-memo*) term))
 
(defun serpent-recurrence (k)
  "Generate k-th term of the Serpent key-expander recurrence equation."
  (let ((memo (get-memo k)))
    (if memo
        memo
        (put-memo
         k
         (case k
           ;; The key terms:
           (-8 *A*) (-7 *B*) (-6 *C*) (-5 *D*) (-4 *E*) (-3 *F*) (-2 *G*) (-1 *H*)
           ;; Any other term:
           (t
            (simplify-reg
             (RL11 (reg-xor
                    (integer-to-reg (logxor +serpent-const+ k))
                    (serpent-recurrence (- k 8))
                    (serpent-recurrence (- k 5))
                    (serpent-recurrence (- k 3))
                    (serpent-recurrence (- k 1)))))))))))
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Print recurrence terms from 0 to 131:
 
(with-open-file (stream "serpent_with_reduction.txt"
                        :direction :output
                        :if-exists :overwrite
                        :if-does-not-exist :create)
  (loop for k from 0 upto 131 do
       (progn
         (format stream "~%Serpent W(~A):~%" k)
         (print-reg (serpent-recurrence k) stream))))
 
(quit)