esthlos-v_keccak 1 (in-package "CL-KECCAK")
esthlos-v_keccak 2
esthlos-v_keccak 3 (defun bit-chunk (bit-vector chunk-size)
esthlos-v_keccak 4 (assert (= 0 (mod (length bit-vector) chunk-size)))
esthlos-v_keccak 5 (let ((chunks '()))
esthlos-v_keccak 6 (dotimes (c (/ (length bit-vector) chunk-size))
esthlos-v_keccak 7 (push (subseq bit-vector
esthlos-v_keccak 8 (* c chunk-size)
esthlos-v_keccak 9 (* (1+ c) chunk-size))
esthlos-v_keccak 10 chunks))
esthlos-v_keccak 11 (nreverse chunks)))
esthlos-v_keccak 12
esthlos-v_keccak 13 (defun bit-pad-right (bv n)
esthlos-v_keccak 14 (do ((x (coerce bv 'list) (append x '(0))))
esthlos-v_keccak 15 ((>= (length x) n)
esthlos-v_keccak 16 (coerce x 'simple-bit-vector))))
esthlos-v_keccak 17
esthlos-v_keccak 18 (defun bit-vector-concatenate (bit-vector-sequence)
esthlos-v_keccak 19 (apply #'concatenate 'simple-bit-vector bit-vector-sequence))
esthlos-v_keccak 20
esthlos-v_keccak 21 (defun bit-vector-concatenate-uniform-vector (bit-vector-vector member-size)
esthlos-v_keccak 22 (let ((rtn (make-sequence 'simple-bit-vector
esthlos-v_keccak 23 (* member-size (length bit-vector-vector)))))
esthlos-v_keccak 24 (dotimes (i (length bit-vector-vector))
esthlos-v_keccak 25 (replace rtn
esthlos-v_keccak 26 (aref bit-vector-vector i)
esthlos-v_keccak 27 :start1 (* i member-size)
esthlos-v_keccak 28 :end1 (* (1+ i) member-size)))
esthlos-v_keccak 29 rtn))
esthlos-v_keccak 30
esthlos-v_keccak 31 (defun bit-vector-to-integer (bv)
esthlos-v_keccak 32 (reduce #'(lambda (a b) (+ a (* 2 b)))
esthlos-v_keccak 33 bv
esthlos-v_keccak 34 :from-end t))
esthlos-v_keccak 35
esthlos-v_keccak 36 (defun bit-vector-to-hex (bv)
esthlos-v_keccak 37 (apply #'concatenate
esthlos-v_keccak 38 'string
esthlos-v_keccak 39 (mapcar (lambda (n)
esthlos-v_keccak 40 (let ((s (write-to-string n :base 16)))
esthlos-v_keccak 41 (if (= (length s) 2)
esthlos-v_keccak 42 s
esthlos-v_keccak 43 (concatenate 'string "0" s))))
esthlos-v_keccak 44 (mapcar #'bit-vector-to-integer
esthlos-v_keccak 45 (bit-chunk bv 8)))))
esthlos-v_keccak 46
esthlos-v_keccak 47 (defun integer-to-bit-vector (n)
esthlos-v_keccak 48 (labels ((bit-array-iter (n array)
esthlos-v_keccak 49 (if (zerop n)
esthlos-v_keccak 50 array
esthlos-v_keccak 51 (multiple-value-bind (q r)
esthlos-v_keccak 52 (floor n 2)
esthlos-v_keccak 53 (bit-array-iter q
esthlos-v_keccak 54 (append array (list r)))))))
esthlos-v_keccak 55 (bit-pad-right (bit-array-iter n '()) 8)))
esthlos-v_keccak 56
esthlos-v_keccak 57 (defun file-to-bit-vector (filepath)
esthlos-v_keccak 58 (with-open-file (f filepath :direction :input :element-type 'bit)
esthlos-v_keccak 59 (bit-vector-concatenate-uniform-vector
esthlos-v_keccak 60 (map 'vector
esthlos-v_keccak 61 #'integer-to-bit-vector
esthlos-v_keccak 62 (let ((s (make-sequence 'list (file-length f))))
esthlos-v_keccak 63 (read-sequence s f)
esthlos-v_keccak 64 s))
esthlos-v_keccak 65 +bits-in-byte+)))